pax_global_header00006660000000000000000000000064152106575770014531gustar00rootroot0000000000000052 comment=2732f29e98d1bcb0a636c05810873e6e3cfaab25 coq-record-update-0.3.7/000077500000000000000000000000001521065757700150565ustar00rootroot00000000000000coq-record-update-0.3.7/.gitattributes000066400000000000000000000000401521065757700177430ustar00rootroot00000000000000* text=auto *.sh text eol=lf coq-record-update-0.3.7/.github/000077500000000000000000000000001521065757700164165ustar00rootroot00000000000000coq-record-update-0.3.7/.github/workflows/000077500000000000000000000000001521065757700204535ustar00rootroot00000000000000coq-record-update-0.3.7/.github/workflows/coq-action.yml000066400000000000000000000014471521065757700232410ustar00rootroot00000000000000name: CI on: push: branches: - master tags: ["v*"] pull_request: schedule: # Tuesday 8am UTC (3am EST) - cron: "0 8 * * TUE" jobs: build: # the OS must be GNU/Linux to be able to use the docker-coq-action runs-on: ubuntu-latest strategy: matrix: rocq_version: - "dev" - "9.1" - "8.20" - "8.19" - "8.18" - "8.17" - "8.16" fail-fast: false steps: - uses: actions/checkout@v6 - uses: coq-community/docker-coq-action@v1 with: opam_file: "coq-record-update.opam" coq_version: ${{ matrix.rocq_version }} # See also: # https://github.com/coq-community/docker-coq-action#readme # https://github.com/erikmd/docker-coq-github-action-demo coq-record-update-0.3.7/.github/workflows/flake-build.yml000066400000000000000000000013461521065757700233610ustar00rootroot00000000000000name: Flake build # Controls when the action will run. on: # Triggers the workflow on push or pull request events but only for the main branch push: branches: [ master ] pull_request: branches: [ master ] # Allows you to run this workflow manually from the Actions tab workflow_dispatch: jobs: # This workflow contains a single job called "build" build: # The type of runner that the job will run on runs-on: ubuntu-latest # Steps represent a sequence of tasks that will be executed as part of the job steps: - uses: actions/checkout@v4 - uses: cachix/install-nix-action@v25 with: github_access_token: ${{ secrets.GITHUB_TOKEN }} - run: nix build - run: nix flake check coq-record-update-0.3.7/.gitignore000066400000000000000000000006071521065757700170510ustar00rootroot00000000000000*.vo *.vos *.vok *.glob .*.aux # auto-generated .coqdeps.d .Makefile.coq.d Makefile.coq Makefile.coq.conf .coq-native/ native_compute_profile_*.data # dune build files _build/ # generated timing files *.timing.diff *.after-timing *.before-timing *.timing time-of-build-after.log time-of-build-before.log time-of-build-both.log time-of-build-pretty.log # Nix-related build artifacts result coq-record-update-0.3.7/LICENSE000066400000000000000000000021031521065757700160570ustar00rootroot00000000000000The MIT License (MIT) Copyright 2020 Tej Chajed Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. coq-record-update-0.3.7/Makefile000066400000000000000000000032321521065757700165160ustar00rootroot00000000000000## this Makefile, as well as the test setup in Makefile.coq.local, is copied ## from std++ (https://gitlab.mpi-sws.org/iris/stdpp) # Forward most targets to Coq makefile (with some trick to make this phony) %: Makefile.coq phony +@$(MAKE) -f Makefile.coq $@ all: Makefile.coq +@$(MAKE) -f Makefile.coq all .PHONY: all clean: Makefile.coq +@$(MAKE) -f Makefile.coq clean find src tests \( -name "*.d" -o -name "*.vo" -o -name "*.vo[sk]" -o -name "*.aux" -o -name "*.cache" -o -name "*.glob" -o -name "*.vio" \) -print -delete || true rm -f Makefile.coq .lia.cache .PHONY: clean # Create Coq Makefile. Makefile.coq: _CoqProject Makefile "$(COQBIN)coq_makefile" -f _CoqProject -o Makefile.coq # Install build-dependencies build-dep/opam: opam Makefile @echo "# Creating build-dep package." @mkdir -p build-dep @sed build-dep/opam @fgrep builddep build-dep/opam >/dev/null || (echo "sed failed to fix the package name" && exit 1) # sanity check build-dep: build-dep/opam phony @# We want opam to not just instal the build-deps now, but to also keep satisfying these @# constraints. Otherwise, `opam upgrade` may well update some packages to versions @# that are incompatible with our build requirements. @# To achieve this, we create a fake opam package that has our build-dependencies as @# dependencies, but does not actually install anything itself. @echo "# Installing build-dep package." @opam install $(OPAMFLAGS) build-dep/ # Some files that do *not* need to be forwarded to Makefile.coq Makefile: ; _CoqProject: ; opam: ; # Phony wildcard targets phony: ; .PHONY: phony coq-record-update-0.3.7/Makefile.coq.local000066400000000000000000000035601521065757700203740ustar00rootroot00000000000000## this test configuration is copied ## from std++ (https://gitlab.mpi-sws.org/iris/stdpp) # use NO_TEST=1 to skip the tests NO_TEST:= # use MAKE_REF=1 to generate new reference files MAKE_REF:= # Run tests interleaved with main build. They have to be in the same target for this. real-all: $(if $(NO_TEST),,test) # the test suite TESTFILES:=$(shell find tests -name "*.v") NORMALIZER:=test-normalizer.sed test: $(TESTFILES:.v=.vo) .PHONY: test COQ_TEST=$(COQTOP) $(COQDEBUG) -batch -test-mode COQ_OLD=$(shell echo "$(COQ_VERSION)" | egrep "^8\.(14|15|16|17|18|19|20)\b" -q && echo 1) COQ_MINOR_VERSION:=$(shell echo "$(COQ_VERSION)" | egrep '^[0-9]+\.[0-9]+\b' -o) tests/.coqdeps.d: $(TESTFILES) $(SHOW)'COQDEP TESTFILES' $(HIDE)$(COQDEP) -dyndep var $(COQMF_COQLIBS_NOML) $^ $(redir_if_ok) -include tests/.coqdeps.d # Main test script (comments out-of-line because macOS otherwise barfs?!?) # - Determine reference file (`REF`). # - Print user-visible status line. # - Dump Coq output into a temporary file. # - Run `sed -i` on that file in a way that works on macOS. # - Either compare the result with the reference file, or move it over the reference file. # - Cleanup, and mark as done for make. $(TESTFILES:.v=.vo): %.vo: %.v $(if $(MAKE_REF),,%.ref) $(NORMALIZER) $(HIDE)if test -f $*".$(COQ_MINOR_VERSION).ref"; then \ REF=$*".$(COQ_MINOR_VERSION).ref"; \ else \ REF=$*".ref"; \ fi && \ echo "COQTEST$(if $(COQ_OLD), [no ref],$(if $(MAKE_REF), [make ref],)) $<$(if $(COQ_OLD),, (ref: $$REF))" && \ TMPFILE="$$(mktemp)" && \ $(TIMER) $(COQ_TEST) $(COQFLAGS) $(COQLIBS) -load-vernac-source $< > "$$TMPFILE" && \ sed -f $(NORMALIZER) "$$TMPFILE" > "$$TMPFILE".new && \ mv "$$TMPFILE".new "$$TMPFILE" && \ $(if $(COQ_OLD),true, \ $(if $(MAKE_REF),mv "$$TMPFILE" "$$REF",diff -u "$$REF" "$$TMPFILE") \ ) && \ rm -f "$$TMPFILE" && \ touch $@ coq-record-update-0.3.7/README.md000066400000000000000000000114441521065757700163410ustar00rootroot00000000000000# Coq record update library [![CI](https://github.com/tchajed/coq-record-update/actions/workflows/coq-action.yml/badge.svg)](https://github.com/tchajed/coq-record-update/actions/workflows/coq-action.yml) In a nutshell, this library automatically provides a generic way to update record fields. Here's a teaser example: ```coq From RecordUpdate Require Import RecordUpdate. Record X := mkX { A: nat; B: nat; C: bool; }. (* [set] operates on any record, allowing field updates *) Definition setAB a b x := set B (fun _ => b) (set A (fun _ => a) x). (* These updates can also make use of the original field value: *) Definition updateAB a b x := set B (Nat.add b) (set A (Nat.add a) x). (* You can also use notations for these things: *) Definition setAB' (a: nat) (b: nat) x := x <|A := a|> <|B := b|>. Definition updateAB' a b x := x <|A ::= Nat.add a|> <|B ::= Nat.add b|>. (* The notation also allows you to update nested fields by giving the "path" through several records: *) Record Inner := mkInner { n : nat }. Record Middle := mkMiddle { c : Inner }. Record Outer := mkOuter { b : Middle }. Definition setNested n' (x: Outer) := x <| b; c; n := n' |>. Definition incNested (x: Outer) := x <| b; c; n ::= S |>. ``` Coq has no record update syntax, nor does it create updaters for setting individual fields of a record. This small library automates creating such updaters. The library is based on a typeclass `Settable` that constructs a record from individual fields. It constructs this record using Ltac2. Using `Settable T`, the library can resolve the typeclass `Setter F` for all the fields `F` of `T`, so that a generic setter `set T A (F: T -> A) : forall {_:Setter F}, A -> T -> T` works. There is also a notation `x <| proj := v |>` for calling `set proj v x`. As a bonus, the `Setter F` typeclass includes some theorems showing the updater is correct. In addition, `Settable T` has a theorem showing that the fields are listed correctly. Together, these help catch bugs before they result in an incorrect implementation of `Setter`. ## Feedback and contributions If you have feedback or need some improvement to make this library useful to you, **please open an issue**. I do actively maintain it. ## Building and installing To build and install: ``` sh git clone https://github.com/tchajed/coq-record-update.git cd coq-record-update make # or make -j make install ``` ## Wait, what? How does that work? I'm glad you asked! There are three tricks here: 1. First, we represent the fields of the record. The representation is actually just an identity function for the record, but it re-constructs the record from its fields; for example, it might look like `fun x => mkX (A x) (B x) (C x)`. I think of this expression as the record's eta expansion, since it deconstructs the record and then re-assembles it. 2. The second trick is that we can take this identity function and make a small tweak to it to turn it into an updater for a single field: if we replace a field with `f: R -> T` in the eta expansion (where `R` is the record type and `T` is the field type), instead of putting the field back as-is, we can substitute some update function. To actually implement this substitution without doing it by hand, we use the `pattern` tactic. This is easiest to illustrate with an example: `pattern field2 in (fun x => mkX (field1 x) (field2 x) (field3 x))` evaluates to `(fun f => (fun x => mkX (field1 x) (f x) (field3 x))) field2`. The first function is essentially the updater we want! We can now extract it with a simple Ltac pattern match. We do make one tweak which is rather than allowing the user to pass any function of the whole record, of type `R -> T`, we only allow a function of the current field value, of type `T -> T`. 3. The final piece of the puzzle is to get all of this Ltac to run. Here we (abuse) typeclasses, in two ways. You might notice that the `set` function in coq-record-update is just part of the class `Setter r field`. To resolve that class, we use a tactic rather than user-provided instances, and that tactic implements the `pattern` trick --- the tactic is easy to install because typeclass resolution is just an `auto`-like search using the `typeclass_instances` hint database, and we can sneak a `Hint Extern` into that database. That's the first typeclass trick. The second is used to look up the record eta expansion when resolving `Setter r field`. Here we have the user write a typeclass `Settable r` with the eta expansion and in Ltac we look up the eta expansion and then unfold it to look at the syntax, since the actual expression is relevant and not just its use as a function. In fact, you can implement `Settable` by providing the identity function and then setting won't work because the Ltac can't do anything with it. It's pretty cool what you can do with Coq typeclasses. coq-record-update-0.3.7/_CoqProject000066400000000000000000000003621521065757700172120ustar00rootroot00000000000000-Q src RecordUpdate -arg -w -arg +deprecated-instance-without-locality -arg -w -arg +undeclared-scope -arg -w -arg -notation-incompatible-prefix -arg -w -arg -deprecated-since-9.0 src/RecordSet.v src/RecordEta.v src/RecordUpdate.v src/Lens.v coq-record-update-0.3.7/coq-record-update.opam000066400000000000000000000020251521065757700212510ustar00rootroot00000000000000# This file was generated from `meta.yml`, please do not edit manually. # Follow the instructions on https://github.com/coq-community/templates to regenerate. opam-version: "2.0" maintainer: "tchajed@gmail.com" version: "dev" homepage: "https://github.com/tchajed/coq-record-update" dev-repo: "git+https://github.com/tchajed/coq-record-update.git" bug-reports: "https://github.com/tchajed/coq-record-update/issues" license: "MIT" synopsis: "Generic support for updating record fields in Coq" description: """ While Coq provides projections for each field of a record, it has no convenient way to update a single field of a record. This library provides a generic way to update a field by name, where the user only has to implement a simple typeclass that lists out the record fields.""" build: [make "-j%{jobs}%"] install: [make "install"] depends: [ "coq" {(>= "8.14" & < "9.2") | (= "dev")} ] tags: [ "category:Computer Science/Data Types and Data Structures" "keyword:record" "logpath:RecordUpdate" ] authors: [ "Tej Chajed" ] coq-record-update-0.3.7/dune-project000066400000000000000000000000421521065757700173740ustar00rootroot00000000000000(lang dune 3.18) (using coq 0.10) coq-record-update-0.3.7/flake.lock000066400000000000000000000027301521065757700170140ustar00rootroot00000000000000{ "nodes": { "flake-utils": { "inputs": { "systems": "systems" }, "locked": { "lastModified": 1731533236, "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", "owner": "numtide", "repo": "flake-utils", "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", "type": "github" }, "original": { "owner": "numtide", "repo": "flake-utils", "type": "github" } }, "nixpkgs": { "locked": { "lastModified": 1740417204, "narHash": "sha256-2OoAzxdJN/SRDX3YuMHGHhvvsN6N5znpMS0DALRd18M=", "owner": "NixOS", "repo": "nixpkgs", "rev": "3e866679c4cb67f6bf164d09c96fa8e21e25716e", "type": "github" }, "original": { "owner": "NixOS", "ref": "release-24.11", "repo": "nixpkgs", "type": "github" } }, "root": { "inputs": { "flake-utils": "flake-utils", "nixpkgs": "nixpkgs" } }, "systems": { "locked": { "lastModified": 1681028828, "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", "owner": "nix-systems", "repo": "default", "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", "type": "github" }, "original": { "owner": "nix-systems", "repo": "default", "type": "github" } } }, "root": "root", "version": 7 } coq-record-update-0.3.7/flake.nix000066400000000000000000000031401521065757700166560ustar00rootroot00000000000000{ inputs = { nixpkgs.url = "github:NixOS/nixpkgs/release-24.11"; flake-utils.url = "github:numtide/flake-utils"; }; outputs = { self, nixpkgs, flake-utils, ... }: let coq-record-update = { lib, mkCoqDerivation, coq }: mkCoqDerivation rec { pname = "coq-record-update"; defaultVersion = "0.3.4"; release."0.3.4" = { src = lib.const (lib.cleanSourceWith { src = lib.cleanSource ./.; filter = let inherit (lib) hasSuffix; in path: type: (! hasSuffix ".gitignore" path) && (! hasSuffix "flake.nix" path) && (! hasSuffix "flake.lock" path) && (! hasSuffix "_build" path); }); }; }; in flake-utils.lib.eachDefaultSystem (system: let pkgs = import nixpkgs { inherit system; overlays = [ self.overlays.default ]; }; in { devShells = { coq-record-update = self.packages.${system}.coq-record-update; default = self.packages.${system}.coq-record-update; }; packages = { coq-record-update = pkgs.coqPackages_8_20.coq-record-update; default = self.packages.${system}.coq-record-update; }; }) // { # NOTE: To use this flake, apply the following overlay to nixpkgs and use # the injected package from its respective coqPackages_VER attribute set! overlays.default = final: prev: let injectPkg = name: set: prev.${name}.overrideScope (self: _: { coq-record-update = self.callPackage coq-record-update {}; }); in (nixpkgs.lib.mapAttrs injectPkg { inherit (final) coqPackages_8_20; }); }; } coq-record-update-0.3.7/meta.yml000066400000000000000000000020741521065757700165320ustar00rootroot00000000000000--- fullname: Record Update shortname: coq-record-update opam_name: coq-record-update organization: tchajed action: true community: false coqdoc: false synopsis: >- Generic support for updating record fields in Coq description: |- While Coq provides projections for each field of a record, it has no convenient way to update a single field of a record. This library provides a generic way to update a field by name, where the user only has to implement a simple typeclass that lists out the record fields. authors: - name: Tej Chajed initial: true maintainers: - name: Tej Chajed nickname: tchajed opam-file-maintainer: tchajed@gmail.com opam-file-version: dev license: fullname: MIT License identifier: MIT supported_coq_versions: text: 8.14 or later opam: '{(>= "8.14" & < "8.20~") | (= "dev")}' tested_coq_opam_versions: - version: dev - version: '8.19' - version: '8.18' - version: '8.17' - version: '8.15' - version: '8.14' namespace: RecordUpdate keywords: - name: record categories: - name: Computer Science/Data Types and Data Structures --- coq-record-update-0.3.7/src/000077500000000000000000000000001521065757700156455ustar00rootroot00000000000000coq-record-update-0.3.7/src/Lens.v000066400000000000000000000015421521065757700167370ustar00rootroot00000000000000From RecordUpdate Require Import RecordSet. (* borrowed from https://github.com/bedrocksystems/coq-lens/blob/master/theories/Lens.v, with a function to define a field lens based on the [Setter] typeclass. This isn't as convenient to use, since we can't generate a lens per field without the kind of metaprograming in meta-coq or using a Coq plugin. *) Record Lens A1 A2 T1 T2 := mkLens { view : A1 -> T1; over : (T1 -> T2) -> (A1 -> A2); }. Arguments view {_ _ _ _} _ _ : assert. Arguments over {_ _ _ _} _ _ _ : assert. Definition field_lens {A T} (proj: A -> T) `{!Setter proj} : Lens A A T T := {| view := proj; over := set proj; |}. Definition lens_compose {A1 A2 T1 T2 C1 C2} (l1 : Lens A1 A2 T1 T2) (l2 : Lens T1 T2 C1 C2) := {| view x := view l2 (view l1 x); over f := over l1 (over l2 f); |}. coq-record-update-0.3.7/src/RecordEta.v000066400000000000000000000057121521065757700177110ustar00rootroot00000000000000From Ltac2 Require Import Ltac2. (* adapted from https://github.com/mit-plv/coqutil/blob/3bd1bb3e58c1a5885a179732e81765ce2ae5f074/src/coqutil/Tactics/RecordEta.v *) Ltac2 mkApp(f: constr)(args: constr array) : constr := Constr.Unsafe.make (Constr.Unsafe.App f args). Ltac2 rec strip_foralls(t: constr) : binder list * constr := match Constr.Unsafe.kind t with | Constr.Unsafe.Prod b u => let (bs, body) := strip_foralls u in (b :: bs, body) | _ => ([], t) end. Ltac2 app_arg_count(t: constr) : int := match Constr.Unsafe.kind t with | Constr.Unsafe.App _f args => Array.length args | _ => 0 end. Ltac2 binder_to_field(qualification: ident list)(b: binder) : Std.reference := Option.get (Env.get (List.append qualification [Option.get (Constr.Binder.name b)])). Ltac2 field_names(ctor_ref: Std.reference): Std.reference list := let ctor_type := Constr.type (Env.instantiate ctor_ref) in let (binders, result) := strip_foralls ctor_type in let n_type_args := app_arg_count result in let field_name_binders := List.skipn n_type_args binders in List.map (binder_to_field (List.removelast (Env.path ctor_ref))) field_name_binders. Ltac2 constructor_of_record(t: constr) : Std.reference := match Constr.Unsafe.kind t with | Constr.Unsafe.Ind ind _inst => Std.ConstructRef (Constr.Unsafe.constructor ind 0) | _ => Control.throw (Invalid_argument (Some (Message.of_constr t))) end. Ltac2 eta(t: constr): constr := let (h, args) := match Constr.Unsafe.kind t with | Constr.Unsafe.App h args => (h, args) | _ => (* Array.make 0 instead of Array.empty for compat (<8.19 Array.empty takes unit argument) *) (t, Array.make 0 'Prop) end in let ctor := constructor_of_record h in let getters := List.map (fun (getterRef: Std.reference) => mkApp (Env.instantiate getterRef) args) (field_names ctor) in constr:(fun x: $t => ltac2:( let projections := List.map (fun getter => constr:($getter &x)) getters in let res := mkApp (mkApp (Env.instantiate ctor) args) (Array.of_list projections) in exact $res)). Ltac exact_eta := ltac2:(t |- let res := eta (Option.get (Ltac1.to_constr t)) in exact $res). (* Given a record type T, returns the "eta expansion" (fun x: T => {| field1 := field1 x; ... fieldN := fieldN x |}) *) Ltac eta T := constr:(ltac:(exact_eta T)). (* Given an expression r whose type is a record, returns {| field1 := field1 r; ... fieldN := fieldN r |} *) Ltac reconstruct_record r := let T := type of r in let e := eta T in eval cbv beta in (e r). Module __test. Record foo := mkFoo { A: nat; B: bool; C: unit; }. Definition foo_eta := ltac:(exact_eta foo). (* note: not a perfect test since we don't just want convertability but this exact constr *) Lemma foo_eta_ok : foo_eta = fun (x: foo) => mkFoo (A x) (B x) (C x). Proof. reflexivity. Qed. End __test. coq-record-update-0.3.7/src/RecordSet.v000066400000000000000000000105161521065757700177310ustar00rootroot00000000000000From RecordUpdate Require Import RecordEta. Set Implicit Arguments. (** Settable is a way of accessing a constructor for a record of type T. The syntactic form of this definition is important: it must be an eta-expanded version of T's constructor, written generically over the field accessors of T. The best way to do this for a record X := mkX { A; B; C} is [settable! mkX ]. *) Class Settable T := { mkT: T -> T; mkT_ok: forall x, mkT x = x }. Arguments mkT T mk : clear implicits, rename. Local Ltac solve_mkT_ok := lazymatch goal with | [ |- forall x, _ = _ ] => first [ solve [ let x := fresh "x" in intro x; destruct x; reflexivity ] | fail 1 "incorrect settable! declaration (perhaps fields are out-of-order?)" ] end. (** settable! creates an instance of Settable from a constructor and list of fields. *) Notation "'settable!' mk < f1 ; .. ; fn >" := (Build_Settable (fun x => .. (mk (f1 x)) .. (fn x)) ltac:(solve_mkT_ok)) (at level 0, mk at level 10, f1, fn at level 9, only parsing). Ltac solve_settable := lazymatch goal with | |- Settable ?R => let eta := RecordEta.eta R in refine (Build_Settable eta ltac:(solve_mkT_ok)) | _ => fail "not a Settable goal" end. #[global] Hint Extern 2 (Settable ?R) => solve_settable : typeclass_instances. (** [setter] creates a setter based on an eta-expanded record constructor and a particular field projection proj *) Local Ltac setter etaT proj := lazymatch etaT with | context[proj] => idtac | _ => fail 1 proj "is not a field" end; let set := (match eval pattern proj in etaT with | ?setter _ => constr:(fun f => setter (fun r => f (proj r))) end) in exact set. (* Combining the above, [getSetter'] looks up the eta-expanded version of T with the Settable typeclass, and calls [setter] to create a setter. *) Local Ltac get_setter T proj := match constr:(mkT T _) with | mkT _ ?updateable => let updateable := (eval hnf in updateable) in match updateable with | {| mkT := ?mk |} => setter mk proj end end. (* Setter provides a way to change a field given by a projection function, along with correctness conditions that require the projected field and only the projected field is modified. *) Class Setter {R T} (proj: R -> T) := set : (T -> T) -> R -> R. (* This command sets implicits and controls reduction behavior. [set] reduces under [simpl] and [cbn] if supplied all its arguments and the last argument (the record) is a constructor. *) #[global] Arguments set {R T} proj {Setter} _ !_ / : simpl nomatch. Class SetterWf {R T} (proj: R -> T) := { set_wf : Setter proj; set_get: forall v r, proj (set proj v r) = v (proj r); set_eq: forall f r, f (proj r) = proj r -> set proj f r = r; }. #[global] Existing Instance set_wf. Arguments set_wf {R T} proj {SetterWf}. Local Ltac SetterInstance_t := match goal with | |- @Setter ?T _ ?A => get_setter T A end. Local Ltac SetterWfInstance_t := match goal with | |- @SetterWf ?T _ ?A => unshelve notypeclasses refine (Build_SetterWf _ _ _); [ get_setter T A | let r := fresh in intros ? r; destruct r; reflexivity | let f := fresh in let r := fresh in intros f r; destruct r; cbv [set]; cbn; intros ->; reflexivity ] end. Global Hint Extern 1 (Setter _) => SetterInstance_t : typeclass_instances. Global Hint Extern 1 (SetterWf _) => SetterWfInstance_t : typeclass_instances. Module RecordSetNotations. Declare Scope record_set. Delimit Scope record_set with rs. Open Scope rs. Notation "x <| proj ::= f |>" := (set proj f x) (at level 12, f at next level, left associativity) : record_set. Notation "x <| proj := v |>" := (set proj (fun _ => v) x) (at level 12, left associativity) : record_set. Notation "x <| proj1 ; proj2 ; .. ; projn ::= f |>" := (set proj1 (set proj2 .. (set projn f) ..) x) (at level 12, f at next level, left associativity) : record_set. (* TODO: this notation and the one above have a common prefix. They do still have an effect, so the warning is disabled for now. *) Notation "x <| proj1 ; proj2 ; .. ; projn := v |>" := (set proj1 (set proj2 .. (set projn (fun _ => v)) ..) x) (at level 12, left associativity) : record_set. End RecordSetNotations. coq-record-update-0.3.7/src/RecordUpdate.v000066400000000000000000000001631521065757700204150ustar00rootroot00000000000000From RecordUpdate Require Import RecordEta. From RecordUpdate Require Export RecordSet. Export RecordSetNotations. coq-record-update-0.3.7/src/dune000066400000000000000000000002661521065757700165270ustar00rootroot00000000000000(coq.theory (name RecordUpdate) (package coq-record-update) (theories Stdlib Ltac2) (synopsis "Generic support for updating record fields in Coq") (flags -w -undeclared-scope)) coq-record-update-0.3.7/test-normalizer.sed000066400000000000000000000006661521065757700207220ustar00rootroot00000000000000# convert Windows line endings to UNIX line endings s/\r$// # adjust for https://github.com/coq/coq/pull/13656 s/subgoal/goal/g # remove these lines added in https://github.com/coq/coq/pull/14596 # (for backwards compatible output) /^Arguments/d # same PR adds additional blank lines /^$/d # locations in Fail added in https://github.com/coq/coq/pull/15174 /^File/d # extra space removed in https://github.com/coq/coq/pull/16130 s/= $/=/ coq-record-update-0.3.7/tests/000077500000000000000000000000001521065757700162205ustar00rootroot00000000000000coq-record-update-0.3.7/tests/Large.ref000066400000000000000000000000001521065757700177360ustar00rootroot00000000000000coq-record-update-0.3.7/tests/Large.v000066400000000000000000000205101521065757700174370ustar00rootroot00000000000000From RecordUpdate Require Import RecordUpdate. (* Test performance of a large record. Based on https://github.com/tchajed/coq-record-update/issues/56. *) (* 500 fields *) Record Rec := { field1: unit; field2: unit; field3: unit; field4: unit; field5: unit; field6: unit; field7: unit; field8: unit; field9: unit; field10: unit; field11: unit; field12: unit; field13: unit; field14: unit; field15: unit; field16: unit; field17: unit; field18: unit; field19: unit; field20: unit; field21: unit; field22: unit; field23: unit; field24: unit; field25: unit; field26: unit; field27: unit; field28: unit; field29: unit; field30: unit; field31: unit; field32: unit; field33: unit; field34: unit; field35: unit; field36: unit; field37: unit; field38: unit; field39: unit; field40: unit; field41: unit; field42: unit; field43: unit; field44: unit; field45: unit; field46: unit; field47: unit; field48: unit; field49: unit; field50: unit; field51: unit; field52: unit; field53: unit; field54: unit; field55: unit; field56: unit; field57: unit; field58: unit; field59: unit; field60: unit; field61: unit; field62: unit; field63: unit; field64: unit; field65: unit; field66: unit; field67: unit; field68: unit; field69: unit; field70: unit; field71: unit; field72: unit; field73: unit; field74: unit; field75: unit; field76: unit; field77: unit; field78: unit; field79: unit; field80: unit; field81: unit; field82: unit; field83: unit; field84: unit; field85: unit; field86: unit; field87: unit; field88: unit; field89: unit; field90: unit; field91: unit; field92: unit; field93: unit; field94: unit; field95: unit; field96: unit; field97: unit; field98: unit; field99: unit; field100: unit; field101: unit; field102: unit; field103: unit; field104: unit; field105: unit; field106: unit; field107: unit; field108: unit; field109: unit; field110: unit; field111: unit; field112: unit; field113: unit; field114: unit; field115: unit; field116: unit; field117: unit; field118: unit; field119: unit; field120: unit; field121: unit; field122: unit; field123: unit; field124: unit; field125: unit; field126: unit; field127: unit; field128: unit; field129: unit; field130: unit; field131: unit; field132: unit; field133: unit; field134: unit; field135: unit; field136: unit; field137: unit; field138: unit; field139: unit; field140: unit; field141: unit; field142: unit; field143: unit; field144: unit; field145: unit; field146: unit; field147: unit; field148: unit; field149: unit; field150: unit; field151: unit; field152: unit; field153: unit; field154: unit; field155: unit; field156: unit; field157: unit; field158: unit; field159: unit; field160: unit; field161: unit; field162: unit; field163: unit; field164: unit; field165: unit; field166: unit; field167: unit; field168: unit; field169: unit; field170: unit; field171: unit; field172: unit; field173: unit; field174: unit; field175: unit; field176: unit; field177: unit; field178: unit; field179: unit; field180: unit; field181: unit; field182: unit; field183: unit; field184: unit; field185: unit; field186: unit; field187: unit; field188: unit; field189: unit; field190: unit; field191: unit; field192: unit; field193: unit; field194: unit; field195: unit; field196: unit; field197: unit; field198: unit; field199: unit; field200: unit; field201: unit; field202: unit; field203: unit; field204: unit; field205: unit; field206: unit; field207: unit; field208: unit; field209: unit; field210: unit; field211: unit; field212: unit; field213: unit; field214: unit; field215: unit; field216: unit; field217: unit; field218: unit; field219: unit; field220: unit; field221: unit; field222: unit; field223: unit; field224: unit; field225: unit; field226: unit; field227: unit; field228: unit; field229: unit; field230: unit; field231: unit; field232: unit; field233: unit; field234: unit; field235: unit; field236: unit; field237: unit; field238: unit; field239: unit; field240: unit; field241: unit; field242: unit; field243: unit; field244: unit; field245: unit; field246: unit; field247: unit; field248: unit; field249: unit; field250: unit; field251: unit; field252: unit; field253: unit; field254: unit; field255: unit; field256: unit; field257: unit; field258: unit; field259: unit; field260: unit; field261: unit; field262: unit; field263: unit; field264: unit; field265: unit; field266: unit; field267: unit; field268: unit; field269: unit; field270: unit; field271: unit; field272: unit; field273: unit; field274: unit; field275: unit; field276: unit; field277: unit; field278: unit; field279: unit; field280: unit; field281: unit; field282: unit; field283: unit; field284: unit; field285: unit; field286: unit; field287: unit; field288: unit; field289: unit; field290: unit; field291: unit; field292: unit; field293: unit; field294: unit; field295: unit; field296: unit; field297: unit; field298: unit; field299: unit; field300: unit; field301: unit; field302: unit; field303: unit; field304: unit; field305: unit; field306: unit; field307: unit; field308: unit; field309: unit; field310: unit; field311: unit; field312: unit; field313: unit; field314: unit; field315: unit; field316: unit; field317: unit; field318: unit; field319: unit; field320: unit; field321: unit; field322: unit; field323: unit; field324: unit; field325: unit; field326: unit; field327: unit; field328: unit; field329: unit; field330: unit; field331: unit; field332: unit; field333: unit; field334: unit; field335: unit; field336: unit; field337: unit; field338: unit; field339: unit; field340: unit; field341: unit; field342: unit; field343: unit; field344: unit; field345: unit; field346: unit; field347: unit; field348: unit; field349: unit; field350: unit; field351: unit; field352: unit; field353: unit; field354: unit; field355: unit; field356: unit; field357: unit; field358: unit; field359: unit; field360: unit; field361: unit; field362: unit; field363: unit; field364: unit; field365: unit; field366: unit; field367: unit; field368: unit; field369: unit; field370: unit; field371: unit; field372: unit; field373: unit; field374: unit; field375: unit; field376: unit; field377: unit; field378: unit; field379: unit; field380: unit; field381: unit; field382: unit; field383: unit; field384: unit; field385: unit; field386: unit; field387: unit; field388: unit; field389: unit; field390: unit; field391: unit; field392: unit; field393: unit; field394: unit; field395: unit; field396: unit; field397: unit; field398: unit; field399: unit; field400: unit; field401: unit; field402: unit; field403: unit; field404: unit; field405: unit; field406: unit; field407: unit; field408: unit; field409: unit; field410: unit; field411: unit; field412: unit; field413: unit; field414: unit; field415: unit; field416: unit; field417: unit; field418: unit; field419: unit; field420: unit; field421: unit; field422: unit; field423: unit; field424: unit; field425: unit; field426: unit; field427: unit; field428: unit; field429: unit; field430: unit; field431: unit; field432: unit; field433: unit; field434: unit; field435: unit; field436: unit; field437: unit; field438: unit; field439: unit; field440: unit; field441: unit; field442: unit; field443: unit; field444: unit; field445: unit; field446: unit; field447: unit; field448: unit; field449: unit; field450: unit; field451: unit; field452: unit; field453: unit; field454: unit; field455: unit; field456: unit; field457: unit; field458: unit; field459: unit; field460: unit; field461: unit; field462: unit; field463: unit; field464: unit; field465: unit; field466: unit; field467: unit; field468: unit; field469: unit; field470: unit; field471: unit; field472: unit; field473: unit; field474: unit; field475: unit; field476: unit; field477: unit; field478: unit; field479: unit; field480: unit; field481: unit; field482: unit; field483: unit; field484: unit; field485: unit; field486: unit; field487: unit; field488: unit; field489: unit; field490: unit; field491: unit; field492: unit; field493: unit; field494: unit; field495: unit; field496: unit; field497: unit; field498: unit; field499: unit; field500: unit; }. (* takes ~1s on a fast laptop *) #[export] Instance EtaRec : Settable Rec := _. (* these should all be very fast *) Definition do_update_middle (x: Rec) (new: unit) : Rec := x <| field278 := tt |>. Definition do_update_first (x: Rec) (new: unit) : Rec := x <| field1 := tt |>. Definition do_update_last (x: Rec) (new: unit) : Rec := x <| field500 := tt |>. #[local] Instance field1_wf : SetterWf field1. Proof. apply _. Qed. coq-record-update-0.3.7/tests/LensTests.ref000066400000000000000000000000001521065757700206300ustar00rootroot00000000000000coq-record-update-0.3.7/tests/LensTests.v000066400000000000000000000006421521065757700203350ustar00rootroot00000000000000From RecordUpdate Require Import RecordUpdate Lens. Record X := mkX { A: nat; B: nat; C: bool; }. #[export] Instance etaX : Settable _ := settable! mkX . (* lenses require much more boilerplate than setters (if you want them to look like Haskell lenses) *) Definition _A := field_lens A. Definition _B := field_lens B. Definition _C := field_lens C. Definition set_A_to_3 (x:X) := over _A (fun _ => 3) x. coq-record-update-0.3.7/tests/ListNotationTests.ref000066400000000000000000000000001521065757700223560ustar00rootroot00000000000000coq-record-update-0.3.7/tests/ListNotationTests.v000066400000000000000000000011411521065757700220560ustar00rootroot00000000000000From RecordUpdate Require Import RecordSet. Require Import List. Import ListNotations. Import RecordSetNotations. Module GH4. Record foo := { a : bool ; b : bool }. Global Instance etaX_RtlExprs : Settable _ := settable! Build_foo . Definition bar := {| a := true ; b := true |}. Definition baz := bar<|a := false|>. End GH4. Definition l := [1; 2; 3]. Record foo := { a : list nat; b : list bool; }. #[export] Instance eta_foo : Settable _ := settable! Build_foo . Definition m_foo (x:foo) := x <| a := [1;2;3] |> <| b := [] |>. coq-record-update-0.3.7/tests/PrintingTests.ref000066400000000000000000000010661521065757700215360ustar00rootroot00000000000000setA = fun (x : X) (n : nat) => x <| B := n |> : X -> nat -> X updateA = fun (x : X) (n : nat) => x <| B ::= Nat.add n |> : X -> nat -> X setXB = fun n : Nested => n <| anX; B := 3 |> : Nested -> Nested updateXB = fun n : Nested => n <| anX; B ::= S |> : Nested -> Nested 1 goal ============================ {| anX := {| A := 2; B := 3 |}; aNat := 4 |} = {| anX := {| A := 2; B := 3 |}; aNat := 4 |} 1 goal ============================ {| anX := {| A := 3; B := 2 |}; aNat := 1 |} = {| anX := {| A := 3; B := 2 |}; aNat := 1 |} coq-record-update-0.3.7/tests/PrintingTests.v000066400000000000000000000016011521065757700212220ustar00rootroot00000000000000From RecordUpdate Require Import RecordUpdate. Record X := mkX { A: nat; B: nat; }. #[export] Instance etaX : Settable _ := settable! mkX . Definition setA (x:X) n := x <|B:=n|>. Print setA. Definition updateA (x:X) n := x <|B::=Nat.add n|>. Print updateA. Record Nested := mkNested { anX: X; aNat: nat; }. #[export] Instance etaNested : Settable _ := settable! mkNested . Definition setXB (n:Nested) := n <|anX; B:=3|>. Print setXB. Definition updateXB (n:Nested) := n <|anX; B::=S|>. Print updateXB. Lemma test_reduction : (mkNested (mkX 2 3) 7) <|aNat := 4|> = mkNested (mkX 2 3) 4. Proof. (* this should reduce the LHS to the RHS *) simpl. Show. reflexivity. Qed. Lemma test_reduction2 : (mkNested (mkX 2 3) 7) <|anX := mkX 3 2|> <|aNat := 1|> = mkNested (mkX 3 2) 1. Proof. (* this should reduce the LHS to the RHS *) cbn. Show. reflexivity. Qed. coq-record-update-0.3.7/tests/ReadmeExampleTests.ref000066400000000000000000000000001521065757700224400ustar00rootroot00000000000000coq-record-update-0.3.7/tests/ReadmeExampleTests.v000066400000000000000000000016001521065757700221400ustar00rootroot00000000000000From RecordUpdate Require Import RecordUpdate. Record X := mkX { A: nat; B: nat; C: bool; }. (* [set] operates on any record, allowing field updates *) Definition setAB a b x := set B (fun _ => b) (set A (fun _ => a) x). (* These updates can also make use of the original field value: *) Definition updateAB a b x := set B (Nat.add b) (set A (Nat.add a) x). (* You can also use notations for these things: *) Definition setAB' (a: nat) (b: nat) x := x <|A := a|> <|B := b|>. Definition updateAB' a b x := x <|A ::= Nat.add a|> <|B ::= Nat.add b|>. (* The notation also allows you to update nested fields by giving the "path" through several records: *) Record Inner := mkInner { n : nat }. Record Middle := mkMiddle { c : Inner }. Record Outer := mkOuter { b : Middle }. Definition setNested n' (x: Outer) := x <| b; c; n := n' |>. Definition incNested (x: Outer) := x <| b; c; n ::= S |>. coq-record-update-0.3.7/tests/RecordSetTests.ref000066400000000000000000000000001521065757700216210ustar00rootroot00000000000000coq-record-update-0.3.7/tests/RecordSetTests.v000066400000000000000000000070231521065757700213260ustar00rootroot00000000000000From RecordUpdate Require Import RecordSet. Set Implicit Arguments. Module SimpleExample. Record X := mkX { A: nat; B: nat; C: unit }. #[export] Instance etaX : Settable _ := settable! mkX . Import RecordSetNotations. Definition setAB a b x := x <|A := a|> <|B := b|>. Definition updateAB a b x := x <|A ::= plus a|> <|B ::= minus b|>. End SimpleExample. Module IndexedType. Record X {T} := mkX { A: T; B: T; C: unit }. Arguments X T : clear implicits. #[export] Instance etaX T: Settable (X T) := settable! (mkX (T:=T)) < A; B; C>. Import RecordSetNotations. Definition setAB T a b (x: X T) := x <|A := a|> <|B := b|>. End IndexedType. Module DependentExample. Record X := mkX { T: Type; A: T; B: nat }. #[export] Instance etaX : Settable X := settable! mkX . Import RecordSetNotations. Definition setB b x := x <|B := b|>. End DependentExample. Module WellFormedExample. Record X := mkX { A: nat; B: nat; C: unit }. #[export] Instance etaX : Settable _ := settable! mkX . Definition setAB a b x := set A (fun _ => a) (set B (fun _ => b) x). (* Resolving an instance for SetterWf proves some correctness properties of the setter. You can also require constructing this instance by accessing the setter through set_wf. *) #[export] Instance set_A : SetterWf A. Proof. apply _. Qed. Definition setAB_wf a b x := set_wf A (fun _ => a) (set_wf B (fun _ => b) x). End WellFormedExample. Module DependentWfExample. Record X := mkX { T: Type; A: T; B: nat }. #[export] Instance etaX : Settable X := settable! mkX . #[export] Instance set_A : SetterWf B. Proof. apply _. Qed. End DependentWfExample. Module NestedExample. Record C := mkC { n : nat }. Record B := mkB { c : C }. Record A := mkA { b : B }. #[export] Instance etaC : Settable _ := settable! mkC. #[export] Instance etaB : Settable _ := settable! mkB. #[export] Instance etaA : Settable _ := settable! mkA. Import RecordSetNotations. Definition setNested n' x := x <| b; c; n := n' |>. End NestedExample. Module TypeParameterExample. Record X T := mkX { a: nat; b: T; c: T * T; }. Arguments a {T}. Arguments b {T}. Arguments c {T}. #[export] Instance etaX T : Settable _ := settable! (@mkX T) . Import RecordSetNotations. Definition set_a (x:X unit) := x <| a := 3 |>. Definition set_b (x:X unit) := x <| b := tt |>. Definition set_b' {T} (x:X T) (v:T) := x <| b := v |>. Definition set_c {T} (x:X T) (v:T) := x <| c := (v,v) |>. End TypeParameterExample. Module TypeParameterLimitation. Record X T := mkX { a: nat; b: T; }. Arguments a {T}. Arguments b {T}. #[export] Instance etaX T : Settable _ := settable! (@mkX T) . Import RecordSetNotations. Definition set_a (x:X unit) := x <| a := 3 |>. Definition set_b {T} (x:X T) (v:T) := x <| b := v |>. (* unsupported by RecordUpdate: the pattern trick could do this in principle, but the type of [set] in the [Setter] typeclass is too restrictive to allow the change in X's type. We could give [Setter] a broader type (where the type of the record can change), but then I'd worry about type inference being underconstrained in the common case. *) Definition strong_update_to_b {T1 T2} (x: X T1) (v: T2) : X T2 := mkX (a x) v. End TypeParameterLimitation. coq-record-update-0.3.7/tests/RegressionTests.ref000066400000000000000000000007001521065757700220560ustar00rootroot00000000000000The command has indeed failed with message: The following term contains unresolved implicit arguments: (fun (r : X) (a : nat) => r <| getA := a |>) More precisely: - ?Setter: Cannot infer the implicit parameter Setter of set whose type is "Setter getA" (no type class instance found) in environment: r : X a : nat test = fun (s : ThreadState) (newRegs : Registers) => s <| Regs := newRegs |> : ThreadState -> Registers -> ThreadState coq-record-update-0.3.7/tests/RegressionTests.v000066400000000000000000000022561521065757700215570ustar00rootroot00000000000000From RecordUpdate Require Import RecordUpdate. Module GH2. Record X := mkX { A: nat;}. #[export] Instance etaX : Settable _ := settable! mkX . (* name r should not prevent finding a Setter A instance *) Definition setA (r : nat) x := x <|A := 32|>. End GH2. Module GH5. Record X := mkX { A: nat; }. #[export] Instance etaX : Settable _ := settable! mkX . Definition getA (x:X) := let 'mkX a := x in a. (* should not succeed, getA is not a projection *) Fail Definition setA (r: X) (a: nat) := set getA (fun _ => a) r. End GH5. Module GH10. Record X := mkX { A: nat; B: nat; x: bool; }. #[export] Instance etaX : Settable _ := settable! mkX . End GH10. Module GH13. Axiom Registers: Type. Axiom word: Type. Record ThreadState := mkThreadState { Regs: Registers; Pc: word; }. #[export] Instance ThreadStateSettable : Settable ThreadState := settable! mkThreadState . Definition test(s: ThreadState)(newRegs: Registers): ThreadState := s <| Regs := newRegs |>. (* should be printed with set notation, not update notation *) Print test. End GH13. coq-record-update-0.3.7/tests/SimpleRecordUpdate.ref000066400000000000000000000001731521065757700224520ustar00rootroot00000000000000(fun x : X => {| A := A x; B := B x; C := C x |}) (fun (f : nat -> nat) (x : X) => {| A := A x; B := f (B x); C := C x |}) coq-record-update-0.3.7/tests/SimpleRecordUpdate.v000066400000000000000000000142431521065757700221460ustar00rootroot00000000000000(*| ============================ How coq-record-update works ============================ A detailed explanation of how coq-record-update is implemented. This is a re-implementation that omits the safety checks in the actual implementation, so that the basic story is as clear as possible. This explanation interleaves a simplified re-implementation of the library with demo modules that demonstrate features as they are added. These demo modules each import the previous, but we hide that command to avoid cluttering the output. First, our basic goal is to implement the following typeclass for each record type `R` and projection function `proj`. The implicit arguments are set up so that setting a field `A` is as simple as `set A (fun a => a + 1) x`, which will increment the field `A` in a record `x`. |*) Class Setter {R T:Type} (proj: R -> T) := set : (T -> T) -> (R -> R). Arguments set {R T} proj {_} _ _ : assert. Global Hint Mode Setter - - + : typeclass_instances. Module demo1. (*| My favorite running example, a simple record with three fields. |*) Record X := mkX { A: nat; B: nat; C: bool; }. (*| With just the above definition, we would still need to implement the typeclass for every field of every record. Here's the particular form of implementation that we'll automate with this library. |*) #[export] Instance setA : Setter A := fun (f:nat -> nat) (x:X) => mkX (f (A x)) (B x) (C x). #[export] Instance setB : Setter B := fun (f:nat -> nat) (x:X) => mkX (A x) (f (B x)) (C x). #[export] Instance setC : Setter C := fun (f:bool -> bool) (x:X) => mkX (A x) (B x) (f (C x)). End demo1. (*| The basis for the automation will be to extract the common parts of the above, an "eta expansion" that doesn't set any fields but reconstructs a record from all of its fields. The user will provide the eta expansion by implementing the `Settable` typeclass. |*) Class Settable (R: Type) := mkRecord : R -> R. Arguments mkRecord R _ _ : assert, clear implicits. Global Hint Mode Settable + : typeclass_instances. Module demo2. Import demo1. (* .none *) (*| Here's how we intend to implement `Settable`. This is equal to `fun x => x`, but we won't actually call `mkRecord`, instead we'll look up the implementation of `Settable` and actually look at the definition (rather than using the instances opaquely). |*) #[export] Instance etaX : Settable X := fun x => mkX (A x) (B x) (C x). End demo2. (*| Looking up a typeclass instance is pretty simple if you think about it: we just typecheck `_ : Settable R`, which will trigger typeclass resolution to fill in the underscore! |*) Ltac get_eta R := let eta := eval hnf in (_ : Settable R) in eta. (*| Given an eta expansion (recall they look like `fun x => mkX (A x) (B x) (C x)`), we want to substitute an update function in the place of some projection function `proj`. The way we can do that is with the `pattern` tactic. Let's say we call `make_setter eta B`, where `eta` is the above eta expansion. `setter_r` factors it into `(fun B_f => mkX (A x) (B_f x) (C x)) B`. This is almost what we want, except the `set` function doesn't allow any function of the whole record, only of `B x`, so we actually use `fun r => f (B r)` as the replacement for `B` (note that this is just `f ∘ B`, expanded out). |*) Ltac make_setter eta proj := let setter_r := (eval pattern proj in eta) in lazymatch setter_r with | ?set_f _ => let setter := constr:(fun f => set_f (fun r => f (proj r))) in (* we can clean up the actual setter term by beta-reducing it *) let setter := (eval cbn beta in setter) in setter end. Module demo3. Import demo1 demo2. (* .none *) (*| Let's see what the above tactics do before we tie everything together into a nice user interface. Recall that we've already implemented `Settable X`, so `get_eta X` can look it up. |*) Goal True. (* .in .messages *) let eta := get_eta X in idtac eta. (* .in .messages .unfold *) let eta := get_eta X in let setter_B := make_setter eta B in idtac setter_B. (* .in .messages .unfold *) Abort. End demo3. (*| Finally, we want to use `make_setter` without any fancy syntax. The way we do that is to implement the `Setter` typeclass using Ltac, rather than the usual mechanism of adding definitions as instances. Instance resolution turns out to just be a (slightly modified) `eauto` search using the `typeclass_instances` hint database, so we can register a `Hint Extern` to use `make_setter` to resolve `Setter`. First we package up `get_eta` and `make_setter` into a single tactic that will solve goals of the form `Setter proj`, as long as `Settable` is implemented for the relevant record type. |*) Ltac solve_setter R proj := let eta := get_eta R in let setter := make_setter eta proj in exact setter. (*| Now we add `solve_setter` as a way to prove `Setter` during typeclass resolution. |*) Global Hint Extern 1 (@Setter ?R _ ?proj) => solve_setter R proj : typeclass_instances. (*| To make the library usable, we provide a notation that builds the eta expansion from a list of record fields, which is much easier to type than the actual eta expansion. |*) Notation "'settable!' mk < f1 ; .. ; fn >" := (fun x => .. (mk (f1 x)) .. (fn x)) (at level 0, mk at level 10, f1, fn at level 9, only parsing). Module demo4. Import demo1. (* .none *) (*| Before we had to write out the expansion of X carefully; now we can just list out the constructor and fields: |*) #[export] Instance etaX : Settable _ := settable! mkX . End demo4. (*| We also provide notations for the `set` function that make multiple updates, and updates to constants easier to read and write. |*) Notation "x <| proj ::= f |>" := (set proj f x) (at level 12, f at next level, left associativity, format "x <| proj ::= f |>"). Notation "x <| proj := v |>" := (set proj (fun _ => v) x) (at level 12, left associativity, format "x <| proj := v |>"). Module test. Record X := mkX { A: nat; B: nat; C: unit }. #[export] Instance eta : Settable X := settable! mkX . Definition setAB a b x := x <|A := a|> <|B := b|>. Definition updateAB a b x := x <|A ::= plus a|> <|B ::= minus b|>. End test. coq-record-update-0.3.7/tests/coqpl_2021.ref000066400000000000000000000030171521065757700205010ustar00rootroot000000000000001 goal f : nat -> nat x : X ============================ {| A := A x; B := f (B x); C := C x |} = {| A := A x; B := f (B x); C := C x |} 1 goal x : X ============================ 3 = 3 The command has indeed failed with message: The following term contains unresolved implicit arguments: (set Nat.add) More precisely: - ?Setter: Cannot infer the implicit parameter Setter of set whose type is "Setter Nat.add" (no type class instance found). The command has indeed failed with message: The following term contains unresolved implicit arguments: (set get_A) More precisely: - ?Setter: Cannot infer the implicit parameter Setter of set whose type is "Setter get_A" (no type class instance found). The command has indeed failed with message: In environment x : several_nats The term "Build_several_nats (nat1 x) (nat3 x)" has type "nat -> several_nats" while it is expected to have type "several_nats". The command has indeed failed with message: Tactic failure: incorrect settable! declaration (perhaps fields are out-of-order?). The command has indeed failed with message: Tactic failure: incorrect settable! declaration (perhaps fields are out-of-order?). The command has indeed failed with message: The following term contains unresolved implicit arguments: (fun (f : nat -> nat) (x : several_nats) => x <| nat1 ::= f |>) More precisely: - ?Setter: Cannot infer the implicit parameter Setter of set whose type is "Setter nat1" (no type class instance found) in environment: f : nat -> nat x : several_nats coq-record-update-0.3.7/tests/coqpl_2021.v000066400000000000000000000045421521065757700201760ustar00rootroot00000000000000From RecordUpdate Require Import RecordUpdate. Record X := mkX { A: nat; B: nat; C: bool }. (* you can omit the X; it's there to clarify the Settable class for the paper *) #[export] Instance: Settable X := settable! mkX . Definition add3_to_B x := set B (plus 3) x. Definition setB_to_3 x := set B (fun _ => 3) x. Definition setB_to_3_notation x := x <|B:=3|>. #[export] Instance set_B : Setter B := _. Theorem set_B_convertible_to f x : set_B f x = let a := x.(A) in let b' := f x.(B) in let c := x.(C) in mkX a b' c. Proof. reflexivity. Qed. Theorem set_B_is f x : set_B f x = mkX x.(A) (f x.(B)) x.(C). Proof. unfold set_B. Show. match goal with | |- ?x = ?x => reflexivity | _ => fail 1 "not an exact match" end. Qed. Theorem simpl_behavior x : (set A (fun _ => 2) (set B (fun _ => 3) x)).(B) = 3. Proof. simpl. Show. match goal with | |- ?x = ?x => reflexivity | _ => fail 1 "did not simplify correctly" end. Qed. Fail Definition error_not_field := set plus. Definition get_A x := A x. (* the Ltac produces a better error message, but typeclass resolution swallows up the error *) Fail Definition error_not_proj := set get_A. Record several_nats := { nat1: nat; nat2: nat; nat3: nat; }. Definition add2 (x:several_nats) := nat1 x + nat2 x. Definition nat1_synonym x := nat1 x. (* fails with a typechecking error, because the constructed identity function doesn't typecheck (we could do better by using tactics-in-terms to fail with a custom error message) *) Fail #[export] Instance: Settable _ := settable! Build_several_nats . (* fails because fields are out-of-order *) Fail #[export] Instance: Settable _ := settable! Build_several_nats . (* one of these just isn't a field, so the result isn't an identity function *) Fail #[export] Instance: Settable _ := settable! Build_several_nats . (* this isn't intentionally supported, but now we can only set nat1 via its synonym (actually, the only thing special about nat1 vs nat1_synonym is that Coq auto-generated nat1) *) #[export] Instance: Settable _ := settable! Build_several_nats . (* this no longer works because the Settable several_nats doesn't say anything about nat1 *) Fail Definition set_nat1 f (x: several_nats) := set nat1 f x. Definition set_nat1 f (x: several_nats) := set nat1_synonym f x.