aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore22
-rw-r--r--.ocamlformat1
-rw-r--r--.ocamlformat-ignore1
-rw-r--r--COPYING564
-rw-r--r--Makefile55
-rw-r--r--README.md383
-rw-r--r--_CoqProject31
-rw-r--r--axioms.nix22
-rw-r--r--bin/dune14
-rw-r--r--bin/main.ml26
-rw-r--r--bin/repl.ml52
-rw-r--r--bin/repl_cmd.ml178
-rw-r--r--bin/run.ml163
-rw-r--r--bin/settings.ml120
-rwxr-xr-xcloc-rocq.sh150
-rw-r--r--cloc.nix16
-rw-r--r--coverage.nix19
-rwxr-xr-xcoverage.sh9
-rw-r--r--default.nix27
-rw-r--r--dune-project22
-rw-r--r--explorer/.gitignore2
-rwxr-xr-xexplorer/generate.sh140
-rwxr-xr-xexplorer/tree.sh17
-rwxr-xr-xexplorer/upload-new.sh16
-rw-r--r--importdef.sexp1
-rw-r--r--lib/extraction/dune56
-rw-r--r--lib/extraction/extraction.ml18
-rw-r--r--lib/extraction/prelude.v52
-rw-r--r--lib/mininix/builtins.ml77
-rw-r--r--lib/mininix/builtins.nix302
-rw-r--r--lib/mininix/conv.ml96
-rw-r--r--lib/mininix/dune15
-rw-r--r--lib/mininix/import.ml54
-rw-r--r--lib/mininix/mininix.ml13
-rw-r--r--lib/mininix/mininix2nix.ml54
-rw-r--r--lib/mininix/nix2mininix.ml254
-rw-r--r--lib/mininix/run.ml17
-rw-r--r--lib/mininix/sexp.ml160
-rw-r--r--lib/nix/dune15
-rw-r--r--lib/nix/elaborator.ml208
-rw-r--r--lib/nix/lexer.mll315
-rw-r--r--lib/nix/nix.ml20
-rw-r--r--lib/nix/parser.mly310
-rw-r--r--lib/nix/printer.ml176
-rw-r--r--lib/nix/tokens.ml64
-rw-r--r--lib/nix/types.ml112
-rw-r--r--mininix.opam39
-rw-r--r--mininix.opam.locked131
-rw-r--r--nixpkgs-pinned.nix7
-rw-r--r--shell.nix21
-rw-r--r--test/dune7
-rw-r--r--test/test_mininix.ml319
-rw-r--r--test/testdata/binary-databin0 -> 1024 bytes
-rw-r--r--test/testdata/data1
-rw-r--r--test/testdata/dir1/a.nix1
-rw-r--r--test/testdata/dir2/a.nix1
-rw-r--r--test/testdata/dir2/b.nix1
-rw-r--r--test/testdata/dir3/a.nix1
-rw-r--r--test/testdata/dir3/b.nix1
-rw-r--r--test/testdata/dir3/c.nix1
-rw-r--r--test/testdata/dir4/a.nix1
-rw-r--r--test/testdata/dir4/c.nix1
-rw-r--r--test/testdata/eval-fail-abort.err.exp8
-rw-r--r--test/testdata/eval-fail-abort.nix1
-rw-r--r--test/testdata/eval-fail-addDrvOutputDependencies-empty-context.err.exp8
-rw-r--r--test/testdata/eval-fail-addDrvOutputDependencies-empty-context.nix1
-rw-r--r--test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.err.exp9
-rw-r--r--test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.nix18
-rw-r--r--test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.err.exp9
-rw-r--r--test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix9
-rw-r--r--test/testdata/eval-fail-addErrorContext-example.err.exp24
-rw-r--r--test/testdata/eval-fail-addErrorContext-example.flags1
-rw-r--r--test/testdata/eval-fail-addErrorContext-example.nix9
-rw-r--r--test/testdata/eval-fail-assert-equal-attrs-names-2.err.exp8
-rw-r--r--test/testdata/eval-fail-assert-equal-attrs-names-2.nix2
-rw-r--r--test/testdata/eval-fail-assert-equal-attrs-names.err.exp8
-rw-r--r--test/testdata/eval-fail-assert-equal-attrs-names.nix2
-rw-r--r--test/testdata/eval-fail-assert-equal-derivations-extra.err.exp26
-rw-r--r--test/testdata/eval-fail-assert-equal-derivations-extra.nix5
-rw-r--r--test/testdata/eval-fail-assert-equal-derivations.err.exp26
-rw-r--r--test/testdata/eval-fail-assert-equal-derivations.nix5
-rw-r--r--test/testdata/eval-fail-assert-equal-floats.err.exp22
-rw-r--r--test/testdata/eval-fail-assert-equal-floats.nix2
-rw-r--r--test/testdata/eval-fail-assert-equal-function-direct.err.exp9
-rw-r--r--test/testdata/eval-fail-assert-equal-function-direct.nix7
-rw-r--r--test/testdata/eval-fail-assert-equal-int-float.err.exp8
-rw-r--r--test/testdata/eval-fail-assert-equal-int-float.nix2
-rw-r--r--test/testdata/eval-fail-assert-equal-ints.err.exp22
-rw-r--r--test/testdata/eval-fail-assert-equal-ints.nix2
-rw-r--r--test/testdata/eval-fail-assert-equal-list-length.err.exp8
-rw-r--r--test/testdata/eval-fail-assert-equal-list-length.nix2
-rw-r--r--test/testdata/eval-fail-assert-equal-paths.err.exp8
-rw-r--r--test/testdata/eval-fail-assert-equal-paths.nix2
-rw-r--r--test/testdata/eval-fail-assert-equal-type-nested.err.exp22
-rw-r--r--test/testdata/eval-fail-assert-equal-type-nested.nix2
-rw-r--r--test/testdata/eval-fail-assert-equal-type.err.exp8
-rw-r--r--test/testdata/eval-fail-assert-equal-type.nix2
-rw-r--r--test/testdata/eval-fail-assert-nested-bool.err.exp74
-rw-r--r--test/testdata/eval-fail-assert-nested-bool.nix6
-rw-r--r--test/testdata/eval-fail-assert.err.exp30
-rw-r--r--test/testdata/eval-fail-assert.nix5
-rw-r--r--test/testdata/eval-fail-attr-name-type.err.exp21
-rw-r--r--test/testdata/eval-fail-attr-name-type.nix7
-rw-r--r--test/testdata/eval-fail-bad-string-interpolation-1.err.exp8
-rw-r--r--test/testdata/eval-fail-bad-string-interpolation-1.nix1
-rw-r--r--test/testdata/eval-fail-bad-string-interpolation-2.err.exp1
-rw-r--r--test/testdata/eval-fail-bad-string-interpolation-2.nix1
-rw-r--r--test/testdata/eval-fail-bad-string-interpolation-3.err.exp8
-rw-r--r--test/testdata/eval-fail-bad-string-interpolation-3.nix1
-rw-r--r--test/testdata/eval-fail-bad-string-interpolation-4.err.exp9
-rw-r--r--test/testdata/eval-fail-bad-string-interpolation-4.nix9
-rw-r--r--test/testdata/eval-fail-blackhole.err.exp14
-rw-r--r--test/testdata/eval-fail-blackhole.nix5
-rw-r--r--test/testdata/eval-fail-call-primop.err.exp10
-rw-r--r--test/testdata/eval-fail-call-primop.nix1
-rw-r--r--test/testdata/eval-fail-deepseq.err.exp20
-rw-r--r--test/testdata/eval-fail-deepseq.nix1
-rw-r--r--test/testdata/eval-fail-derivation-name.err.exp26
-rw-r--r--test/testdata/eval-fail-derivation-name.nix5
-rw-r--r--test/testdata/eval-fail-derivation-name.postprocess9
-rw-r--r--test/testdata/eval-fail-dup-dynamic-attrs.err.exp14
-rw-r--r--test/testdata/eval-fail-dup-dynamic-attrs.nix4
-rw-r--r--test/testdata/eval-fail-duplicate-traces.err.exp51
-rw-r--r--test/testdata/eval-fail-duplicate-traces.nix9
-rw-r--r--test/testdata/eval-fail-eol-1.err.exp6
-rw-r--r--test/testdata/eval-fail-eol-1.nix3
-rw-r--r--test/testdata/eval-fail-eol-2.err.exp6
-rw-r--r--test/testdata/eval-fail-eol-2.nix2
-rw-r--r--test/testdata/eval-fail-eol-3.err.exp6
-rw-r--r--test/testdata/eval-fail-eol-3.nix3
-rw-r--r--test/testdata/eval-fail-fetchTree-negative.err.exp8
-rw-r--r--test/testdata/eval-fail-fetchTree-negative.nix5
-rw-r--r--test/testdata/eval-fail-fetchurl-baseName-attrs-name.err.exp8
-rw-r--r--test/testdata/eval-fail-fetchurl-baseName-attrs-name.nix1
-rw-r--r--test/testdata/eval-fail-fetchurl-baseName-attrs.err.exp8
-rw-r--r--test/testdata/eval-fail-fetchurl-baseName-attrs.nix1
-rw-r--r--test/testdata/eval-fail-fetchurl-baseName.err.exp8
-rw-r--r--test/testdata/eval-fail-fetchurl-baseName.nix1
-rw-r--r--test/testdata/eval-fail-flake-ref-to-string-negative-integer.err.exp14
-rw-r--r--test/testdata/eval-fail-flake-ref-to-string-negative-integer.nix7
-rw-r--r--test/testdata/eval-fail-foldlStrict-strict-op-application.err.exp37
-rw-r--r--test/testdata/eval-fail-foldlStrict-strict-op-application.nix5
-rw-r--r--test/testdata/eval-fail-fromJSON-overflowing.err.exp8
-rw-r--r--test/testdata/eval-fail-fromJSON-overflowing.nix1
-rw-r--r--test/testdata/eval-fail-fromTOML-timestamps.err.exp8
-rw-r--r--test/testdata/eval-fail-fromTOML-timestamps.nix130
-rw-r--r--test/testdata/eval-fail-hashfile-missing.err.exp13
-rw-r--r--test/testdata/eval-fail-hashfile-missing.nix5
-rw-r--r--test/testdata/eval-fail-infinite-recursion-lambda.err.exp38
-rw-r--r--test/testdata/eval-fail-infinite-recursion-lambda.flags1
-rw-r--r--test/testdata/eval-fail-infinite-recursion-lambda.nix1
-rw-r--r--test/testdata/eval-fail-list.err.exp8
-rw-r--r--test/testdata/eval-fail-list.nix1
-rw-r--r--test/testdata/eval-fail-missing-arg.err.exp12
-rw-r--r--test/testdata/eval-fail-missing-arg.nix1
-rw-r--r--test/testdata/eval-fail-mutual-recursion.err.exp64
-rw-r--r--test/testdata/eval-fail-mutual-recursion.nix36
-rw-r--r--test/testdata/eval-fail-nested-list-items.err.exp9
-rw-r--r--test/testdata/eval-fail-nested-list-items.nix11
-rw-r--r--test/testdata/eval-fail-nonexist-path.err.exp1
-rw-r--r--test/testdata/eval-fail-nonexist-path.nix4
-rw-r--r--test/testdata/eval-fail-not-throws.err.exp14
-rw-r--r--test/testdata/eval-fail-not-throws.nix1
-rw-r--r--test/testdata/eval-fail-overflowing-add.err.exp6
-rw-r--r--test/testdata/eval-fail-overflowing-add.nix4
-rw-r--r--test/testdata/eval-fail-overflowing-div.err.exp23
-rw-r--r--test/testdata/eval-fail-overflowing-div.nix7
-rw-r--r--test/testdata/eval-fail-overflowing-mul.err.exp16
-rw-r--r--test/testdata/eval-fail-overflowing-mul.nix3
-rw-r--r--test/testdata/eval-fail-overflowing-sub.err.exp9
-rw-r--r--test/testdata/eval-fail-overflowing-sub.nix4
-rw-r--r--test/testdata/eval-fail-path-slash.err.exp6
-rw-r--r--test/testdata/eval-fail-path-slash.nix6
-rw-r--r--test/testdata/eval-fail-pipe-operators.err.exp5
-rw-r--r--test/testdata/eval-fail-pipe-operators.nix1
-rw-r--r--test/testdata/eval-fail-recursion.err.exp12
-rw-r--r--test/testdata/eval-fail-recursion.nix1
-rw-r--r--test/testdata/eval-fail-remove.err.exp15
-rw-r--r--test/testdata/eval-fail-remove.nix5
-rw-r--r--test/testdata/eval-fail-scope-5.err.exp28
-rw-r--r--test/testdata/eval-fail-scope-5.nix10
-rw-r--r--test/testdata/eval-fail-seq.err.exp14
-rw-r--r--test/testdata/eval-fail-seq.nix1
-rw-r--r--test/testdata/eval-fail-set-override.err.exp4
-rw-r--r--test/testdata/eval-fail-set-override.nix1
-rw-r--r--test/testdata/eval-fail-set.err.exp5
-rw-r--r--test/testdata/eval-fail-set.nix1
-rw-r--r--test/testdata/eval-fail-substring.err.exp8
-rw-r--r--test/testdata/eval-fail-substring.nix1
-rw-r--r--test/testdata/eval-fail-to-path.err.exp10
-rw-r--r--test/testdata/eval-fail-to-path.nix1
-rw-r--r--test/testdata/eval-fail-toJSON.err.exp50
-rw-r--r--test/testdata/eval-fail-toJSON.nix10
-rw-r--r--test/testdata/eval-fail-undeclared-arg.err.exp13
-rw-r--r--test/testdata/eval-fail-undeclared-arg.nix1
-rw-r--r--test/testdata/eval-fail-using-set-as-attr-name.err.exp14
-rw-r--r--test/testdata/eval-fail-using-set-as-attr-name.nix5
-rw-r--r--test/testdata/eval-okay-any-all.exp1
-rw-r--r--test/testdata/eval-okay-any-all.nix11
-rw-r--r--test/testdata/eval-okay-arithmetic.exp1
-rw-r--r--test/testdata/eval-okay-arithmetic.nix59
-rw-r--r--test/testdata/eval-okay-attrnames.exp1
-rw-r--r--test/testdata/eval-okay-attrnames.nix11
-rw-r--r--test/testdata/eval-okay-attrs.exp1
-rw-r--r--test/testdata/eval-okay-attrs.nix5
-rw-r--r--test/testdata/eval-okay-attrs2.exp1
-rw-r--r--test/testdata/eval-okay-attrs2.nix10
-rw-r--r--test/testdata/eval-okay-attrs3.exp1
-rw-r--r--test/testdata/eval-okay-attrs3.nix22
-rw-r--r--test/testdata/eval-okay-attrs4.exp1
-rw-r--r--test/testdata/eval-okay-attrs4.nix7
-rw-r--r--test/testdata/eval-okay-attrs5.exp1
-rw-r--r--test/testdata/eval-okay-attrs5.nix21
-rw-r--r--test/testdata/eval-okay-attrs6.exp1
-rw-r--r--test/testdata/eval-okay-attrs6.nix4
-rw-r--r--test/testdata/eval-okay-autoargs.exp1
-rw-r--r--test/testdata/eval-okay-autoargs.flags1
-rw-r--r--test/testdata/eval-okay-autoargs.nix15
-rw-r--r--test/testdata/eval-okay-backslash-newline-1.exp1
-rw-r--r--test/testdata/eval-okay-backslash-newline-1.nix2
-rw-r--r--test/testdata/eval-okay-backslash-newline-2.exp1
-rw-r--r--test/testdata/eval-okay-backslash-newline-2.nix2
-rw-r--r--test/testdata/eval-okay-baseNameOf.exp1
-rw-r--r--test/testdata/eval-okay-baseNameOf.nix32
-rw-r--r--test/testdata/eval-okay-builtins-add.exp1
-rw-r--r--test/testdata/eval-okay-builtins-add.nix8
-rw-r--r--test/testdata/eval-okay-builtins.exp1
-rw-r--r--test/testdata/eval-okay-builtins.nix12
-rw-r--r--test/testdata/eval-okay-callable-attrs.exp1
-rw-r--r--test/testdata/eval-okay-callable-attrs.nix1
-rw-r--r--test/testdata/eval-okay-catattrs.exp1
-rw-r--r--test/testdata/eval-okay-catattrs.nix1
-rw-r--r--test/testdata/eval-okay-closure.exp1
-rw-r--r--test/testdata/eval-okay-closure.exp.xml343
-rw-r--r--test/testdata/eval-okay-closure.nix13
-rw-r--r--test/testdata/eval-okay-comments.exp1
-rw-r--r--test/testdata/eval-okay-comments.nix59
-rw-r--r--test/testdata/eval-okay-concat.exp1
-rw-r--r--test/testdata/eval-okay-concat.nix1
-rw-r--r--test/testdata/eval-okay-concatmap.exp1
-rw-r--r--test/testdata/eval-okay-concatmap.nix5
-rw-r--r--test/testdata/eval-okay-concatstringssep.exp1
-rw-r--r--test/testdata/eval-okay-concatstringssep.nix8
-rw-r--r--test/testdata/eval-okay-context-introspection.exp1
-rw-r--r--test/testdata/eval-okay-context-introspection.nix59
-rw-r--r--test/testdata/eval-okay-context.exp1
-rw-r--r--test/testdata/eval-okay-context.nix6
-rw-r--r--test/testdata/eval-okay-convertHash.err.exp108
-rw-r--r--test/testdata/eval-okay-convertHash.exp1
-rw-r--r--test/testdata/eval-okay-convertHash.nix33
-rw-r--r--test/testdata/eval-okay-curpos.exp1
-rw-r--r--test/testdata/eval-okay-curpos.nix5
-rw-r--r--test/testdata/eval-okay-deepseq.exp1
-rw-r--r--test/testdata/eval-okay-deepseq.nix1
-rw-r--r--test/testdata/eval-okay-delayed-with-inherit.exp1
-rw-r--r--test/testdata/eval-okay-delayed-with-inherit.nix24
-rw-r--r--test/testdata/eval-okay-delayed-with.exp1
-rw-r--r--test/testdata/eval-okay-delayed-with.nix29
-rw-r--r--test/testdata/eval-okay-derivation-legacy.err.exp6
-rw-r--r--test/testdata/eval-okay-derivation-legacy.exp1
-rw-r--r--test/testdata/eval-okay-derivation-legacy.nix12
-rw-r--r--test/testdata/eval-okay-dynamic-attrs-2.exp1
-rw-r--r--test/testdata/eval-okay-dynamic-attrs-2.nix1
-rw-r--r--test/testdata/eval-okay-dynamic-attrs-bare.exp1
-rw-r--r--test/testdata/eval-okay-dynamic-attrs-bare.nix17
-rw-r--r--test/testdata/eval-okay-dynamic-attrs.exp1
-rw-r--r--test/testdata/eval-okay-dynamic-attrs.nix17
-rw-r--r--test/testdata/eval-okay-elem.exp1
-rw-r--r--test/testdata/eval-okay-elem.nix6
-rw-r--r--test/testdata/eval-okay-empty-args.exp1
-rw-r--r--test/testdata/eval-okay-empty-args.nix1
-rw-r--r--test/testdata/eval-okay-eq-derivations.exp1
-rw-r--r--test/testdata/eval-okay-eq-derivations.nix10
-rw-r--r--test/testdata/eval-okay-eq.exp1
-rw-r--r--test/testdata/eval-okay-eq.nix3
-rw-r--r--test/testdata/eval-okay-filter.exp1
-rw-r--r--test/testdata/eval-okay-filter.nix5
-rw-r--r--test/testdata/eval-okay-flake-ref-to-string.exp1
-rw-r--r--test/testdata/eval-okay-flake-ref-to-string.nix7
-rw-r--r--test/testdata/eval-okay-flatten.exp1
-rw-r--r--test/testdata/eval-okay-flatten.nix8
-rw-r--r--test/testdata/eval-okay-float.exp1
-rw-r--r--test/testdata/eval-okay-float.nix6
-rw-r--r--test/testdata/eval-okay-floor-ceil.exp1
-rw-r--r--test/testdata/eval-okay-floor-ceil.nix9
-rw-r--r--test/testdata/eval-okay-foldlStrict-lazy-elements.exp1
-rw-r--r--test/testdata/eval-okay-foldlStrict-lazy-elements.nix9
-rw-r--r--test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.exp1
-rw-r--r--test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.nix6
-rw-r--r--test/testdata/eval-okay-foldlStrict.exp1
-rw-r--r--test/testdata/eval-okay-foldlStrict.nix3
-rw-r--r--test/testdata/eval-okay-fromTOML-timestamps.exp1
-rw-r--r--test/testdata/eval-okay-fromTOML-timestamps.flags1
-rw-r--r--test/testdata/eval-okay-fromTOML-timestamps.nix130
-rw-r--r--test/testdata/eval-okay-fromTOML.exp1
-rw-r--r--test/testdata/eval-okay-fromTOML.nix208
-rw-r--r--test/testdata/eval-okay-fromjson-escapes.exp1
-rw-r--r--test/testdata/eval-okay-fromjson-escapes.nix3
-rw-r--r--test/testdata/eval-okay-fromjson.exp1
-rw-r--r--test/testdata/eval-okay-fromjson.nix41
-rw-r--r--test/testdata/eval-okay-functionargs.exp1
-rw-r--r--test/testdata/eval-okay-functionargs.exp.xml15
-rw-r--r--test/testdata/eval-okay-functionargs.nix80
-rw-r--r--test/testdata/eval-okay-getattrpos-functionargs.exp1
-rw-r--r--test/testdata/eval-okay-getattrpos-functionargs.nix4
-rw-r--r--test/testdata/eval-okay-getattrpos-undefined.exp1
-rw-r--r--test/testdata/eval-okay-getattrpos-undefined.nix1
-rw-r--r--test/testdata/eval-okay-getattrpos.exp1
-rw-r--r--test/testdata/eval-okay-getattrpos.nix6
-rw-r--r--test/testdata/eval-okay-getenv.exp1
-rw-r--r--test/testdata/eval-okay-getenv.nix1
-rw-r--r--test/testdata/eval-okay-groupBy.exp1
-rw-r--r--test/testdata/eval-okay-groupBy.nix5
-rw-r--r--test/testdata/eval-okay-hash.exp0
-rw-r--r--test/testdata/eval-okay-hashfile.exp1
-rw-r--r--test/testdata/eval-okay-hashfile.nix4
-rw-r--r--test/testdata/eval-okay-hashstring.exp1
-rw-r--r--test/testdata/eval-okay-hashstring.nix4
-rw-r--r--test/testdata/eval-okay-if.exp1
-rw-r--r--test/testdata/eval-okay-if.nix1
-rw-r--r--test/testdata/eval-okay-import.exp1
-rw-r--r--test/testdata/eval-okay-import.nix11
-rw-r--r--test/testdata/eval-okay-ind-string.exp1
-rw-r--r--test/testdata/eval-okay-ind-string.nix128
-rw-r--r--test/testdata/eval-okay-inherit-attr-pos.exp1
-rw-r--r--test/testdata/eval-okay-inherit-attr-pos.nix12
-rw-r--r--test/testdata/eval-okay-inherit-from.err.exp1
-rw-r--r--test/testdata/eval-okay-inherit-from.exp1
-rw-r--r--test/testdata/eval-okay-inherit-from.nix16
-rw-r--r--test/testdata/eval-okay-intersectAttrs.exp1
-rw-r--r--test/testdata/eval-okay-intersectAttrs.nix50
-rw-r--r--test/testdata/eval-okay-let.exp1
-rw-r--r--test/testdata/eval-okay-let.nix5
-rw-r--r--test/testdata/eval-okay-list.exp1
-rw-r--r--test/testdata/eval-okay-list.nix7
-rw-r--r--test/testdata/eval-okay-listtoattrs.exp1
-rw-r--r--test/testdata/eval-okay-listtoattrs.nix11
-rw-r--r--test/testdata/eval-okay-logic.exp1
-rw-r--r--test/testdata/eval-okay-logic.nix1
-rw-r--r--test/testdata/eval-okay-map.exp1
-rw-r--r--test/testdata/eval-okay-map.nix3
-rw-r--r--test/testdata/eval-okay-mapattrs.exp1
-rw-r--r--test/testdata/eval-okay-mapattrs.nix3
-rw-r--r--test/testdata/eval-okay-merge-dynamic-attrs.exp1
-rw-r--r--test/testdata/eval-okay-merge-dynamic-attrs.nix13
-rw-r--r--test/testdata/eval-okay-nested-with.exp1
-rw-r--r--test/testdata/eval-okay-nested-with.nix3
-rw-r--r--test/testdata/eval-okay-new-let.exp1
-rw-r--r--test/testdata/eval-okay-new-let.nix14
-rw-r--r--test/testdata/eval-okay-null-dynamic-attrs.exp1
-rw-r--r--test/testdata/eval-okay-null-dynamic-attrs.nix1
-rw-r--r--test/testdata/eval-okay-overrides.exp1
-rw-r--r--test/testdata/eval-okay-overrides.nix9
-rw-r--r--test/testdata/eval-okay-parse-flake-ref.exp1
-rw-r--r--test/testdata/eval-okay-parse-flake-ref.nix1
-rw-r--r--test/testdata/eval-okay-partition.exp1
-rw-r--r--test/testdata/eval-okay-partition.nix5
-rw-r--r--test/testdata/eval-okay-path-string-interpolation.exp1
-rw-r--r--test/testdata/eval-okay-path-string-interpolation.nix12
-rw-r--r--test/testdata/eval-okay-path.exp1
-rw-r--r--test/testdata/eval-okay-path.nix15
-rw-r--r--test/testdata/eval-okay-pathexists.exp1
-rw-r--r--test/testdata/eval-okay-pathexists.nix34
-rw-r--r--test/testdata/eval-okay-patterns.exp1
-rw-r--r--test/testdata/eval-okay-patterns.nix16
-rw-r--r--test/testdata/eval-okay-print.err.exp1
-rw-r--r--test/testdata/eval-okay-print.exp1
-rw-r--r--test/testdata/eval-okay-print.nix1
-rw-r--r--test/testdata/eval-okay-readDir.exp1
-rw-r--r--test/testdata/eval-okay-readDir.nix1
-rw-r--r--test/testdata/eval-okay-readFileType.exp1
-rw-r--r--test/testdata/eval-okay-readFileType.nix6
-rw-r--r--test/testdata/eval-okay-readfile.exp1
-rw-r--r--test/testdata/eval-okay-readfile.nix1
-rw-r--r--test/testdata/eval-okay-redefine-builtin.exp1
-rw-r--r--test/testdata/eval-okay-redefine-builtin.nix3
-rw-r--r--test/testdata/eval-okay-regex-match.exp1
-rw-r--r--test/testdata/eval-okay-regex-match.nix29
-rw-r--r--test/testdata/eval-okay-regex-split.exp1
-rw-r--r--test/testdata/eval-okay-regex-split.nix48
-rw-r--r--test/testdata/eval-okay-regression-20220122.exp1
-rw-r--r--test/testdata/eval-okay-regression-20220122.nix1
-rw-r--r--test/testdata/eval-okay-regression-20220125.exp1
-rw-r--r--test/testdata/eval-okay-regression-20220125.nix2
-rw-r--r--test/testdata/eval-okay-remove.exp1
-rw-r--r--test/testdata/eval-okay-remove.nix5
-rw-r--r--test/testdata/eval-okay-repeated-empty-attrs.exp1
-rw-r--r--test/testdata/eval-okay-repeated-empty-attrs.nix2
-rw-r--r--test/testdata/eval-okay-repeated-empty-list.exp1
-rw-r--r--test/testdata/eval-okay-repeated-empty-list.nix1
-rw-r--r--test/testdata/eval-okay-replacestrings.exp1
-rw-r--r--test/testdata/eval-okay-replacestrings.nix12
-rw-r--r--test/testdata/eval-okay-scope-1.exp1
-rw-r--r--test/testdata/eval-okay-scope-1.nix6
-rw-r--r--test/testdata/eval-okay-scope-2.exp1
-rw-r--r--test/testdata/eval-okay-scope-2.nix6
-rw-r--r--test/testdata/eval-okay-scope-3.exp1
-rw-r--r--test/testdata/eval-okay-scope-3.nix6
-rw-r--r--test/testdata/eval-okay-scope-4.exp1
-rw-r--r--test/testdata/eval-okay-scope-4.nix10
-rw-r--r--test/testdata/eval-okay-scope-6.exp1
-rw-r--r--test/testdata/eval-okay-scope-6.nix7
-rw-r--r--test/testdata/eval-okay-scope-7.exp1
-rw-r--r--test/testdata/eval-okay-scope-7.nix6
-rw-r--r--test/testdata/eval-okay-search-path.exp1
-rw-r--r--test/testdata/eval-okay-search-path.flags1
-rw-r--r--test/testdata/eval-okay-search-path.nix10
-rw-r--r--test/testdata/eval-okay-seq.exp1
-rw-r--r--test/testdata/eval-okay-seq.nix1
-rw-r--r--test/testdata/eval-okay-sort.exp1
-rw-r--r--test/testdata/eval-okay-sort.nix20
-rw-r--r--test/testdata/eval-okay-splitversion.exp1
-rw-r--r--test/testdata/eval-okay-splitversion.nix1
-rw-r--r--test/testdata/eval-okay-string.exp1
-rw-r--r--test/testdata/eval-okay-string.nix12
-rw-r--r--test/testdata/eval-okay-strings-as-attrs-names.exp1
-rw-r--r--test/testdata/eval-okay-strings-as-attrs-names.nix20
-rw-r--r--test/testdata/eval-okay-substring-context.exp1
-rw-r--r--test/testdata/eval-okay-substring-context.nix11
-rw-r--r--test/testdata/eval-okay-substring.exp1
-rw-r--r--test/testdata/eval-okay-substring.nix23
-rw-r--r--test/testdata/eval-okay-symlink-resolution.exp1
-rw-r--r--test/testdata/eval-okay-symlink-resolution.nix1
-rw-r--r--test/testdata/eval-okay-tail-call-1.exp-disabled1
-rw-r--r--test/testdata/eval-okay-tail-call-1.nix3
-rw-r--r--test/testdata/eval-okay-tojson.exp1
-rw-r--r--test/testdata/eval-okay-tojson.nix13
-rw-r--r--test/testdata/eval-okay-toxml.exp1
-rw-r--r--test/testdata/eval-okay-toxml.nix3
-rw-r--r--test/testdata/eval-okay-toxml2.exp1
-rw-r--r--test/testdata/eval-okay-toxml2.nix1
-rw-r--r--test/testdata/eval-okay-tryeval.exp1
-rw-r--r--test/testdata/eval-okay-tryeval.nix5
-rw-r--r--test/testdata/eval-okay-types.exp1
-rw-r--r--test/testdata/eval-okay-types.nix37
-rw-r--r--test/testdata/eval-okay-versions.exp1
-rw-r--r--test/testdata/eval-okay-versions.nix43
-rw-r--r--test/testdata/eval-okay-with.exp1
-rw-r--r--test/testdata/eval-okay-with.nix19
-rw-r--r--test/testdata/eval-okay-xml.exp.xml52
-rw-r--r--test/testdata/eval-okay-xml.nix21
-rw-r--r--test/testdata/eval-okay-zipAttrsWith.exp1
-rw-r--r--test/testdata/eval-okay-zipAttrsWith.nix9
-rw-r--r--test/testdata/importdef.sexp1
-rw-r--r--test/testdata/imported.nix3
-rw-r--r--test/testdata/imported2.nix1
-rw-r--r--test/testdata/lib.nix61
-rw-r--r--test/testdata/non-eval-fail-bad-drvPath.nix14
-rw-r--r--test/testdata/parse-fail-dup-attrs-1.err.exp6
-rw-r--r--test/testdata/parse-fail-dup-attrs-1.nix4
-rw-r--r--test/testdata/parse-fail-dup-attrs-2.err.exp6
-rw-r--r--test/testdata/parse-fail-dup-attrs-2.nix13
-rw-r--r--test/testdata/parse-fail-dup-attrs-3.err.exp6
-rw-r--r--test/testdata/parse-fail-dup-attrs-3.nix13
-rw-r--r--test/testdata/parse-fail-dup-attrs-4.err.exp6
-rw-r--r--test/testdata/parse-fail-dup-attrs-4.nix4
-rw-r--r--test/testdata/parse-fail-dup-attrs-7.err.exp6
-rw-r--r--test/testdata/parse-fail-dup-attrs-7.nix9
-rw-r--r--test/testdata/parse-fail-dup-formals.err.exp4
-rw-r--r--test/testdata/parse-fail-dup-formals.nix1
-rw-r--r--test/testdata/parse-fail-eof-in-string.err.exp5
-rw-r--r--test/testdata/parse-fail-eof-in-string.nix3
-rw-r--r--test/testdata/parse-fail-eof-pos.err.exp5
-rw-r--r--test/testdata/parse-fail-eof-pos.nix2
-rw-r--r--test/testdata/parse-fail-mixed-nested-attrs1.err.exp6
-rw-r--r--test/testdata/parse-fail-mixed-nested-attrs1.nix4
-rw-r--r--test/testdata/parse-fail-mixed-nested-attrs2.err.exp6
-rw-r--r--test/testdata/parse-fail-mixed-nested-attrs2.nix4
-rw-r--r--test/testdata/parse-fail-patterns-1.err.exp5
-rw-r--r--test/testdata/parse-fail-patterns-1.nix1
-rw-r--r--test/testdata/parse-fail-regression-20060610.err.exp6
-rw-r--r--test/testdata/parse-fail-regression-20060610.nix11
-rw-r--r--test/testdata/parse-fail-undef-var-2.err.exp6
-rw-r--r--test/testdata/parse-fail-undef-var-2.nix7
-rw-r--r--test/testdata/parse-fail-undef-var.err.exp5
-rw-r--r--test/testdata/parse-fail-undef-var.nix1
-rw-r--r--test/testdata/parse-fail-utf8.err.exp5
-rw-r--r--test/testdata/parse-fail-utf8.nix1
-rw-r--r--test/testdata/parse-okay-1.exp1
-rw-r--r--test/testdata/parse-okay-1.nix1
-rw-r--r--test/testdata/parse-okay-crlf.exp1
-rw-r--r--test/testdata/parse-okay-crlf.nix17
-rw-r--r--test/testdata/parse-okay-dup-attrs-5.exp1
-rw-r--r--test/testdata/parse-okay-dup-attrs-5.nix4
-rw-r--r--test/testdata/parse-okay-dup-attrs-6.exp1
-rw-r--r--test/testdata/parse-okay-dup-attrs-6.nix4
-rw-r--r--test/testdata/parse-okay-ind-string.exp1
-rw-r--r--test/testdata/parse-okay-ind-string.nix31
-rw-r--r--test/testdata/parse-okay-inherits.exp1
-rw-r--r--test/testdata/parse-okay-inherits.nix9
-rw-r--r--test/testdata/parse-okay-mixed-nested-attrs-1.exp1
-rw-r--r--test/testdata/parse-okay-mixed-nested-attrs-1.nix4
-rw-r--r--test/testdata/parse-okay-mixed-nested-attrs-2.exp1
-rw-r--r--test/testdata/parse-okay-mixed-nested-attrs-2.nix4
-rw-r--r--test/testdata/parse-okay-mixed-nested-attrs-3.exp1
-rw-r--r--test/testdata/parse-okay-mixed-nested-attrs-3.nix7
-rw-r--r--test/testdata/parse-okay-regression-20041027.exp1
-rw-r--r--test/testdata/parse-okay-regression-20041027.nix11
-rw-r--r--test/testdata/parse-okay-regression-751.exp1
-rw-r--r--test/testdata/parse-okay-regression-751.nix2
-rw-r--r--test/testdata/parse-okay-subversion.exp1
-rw-r--r--test/testdata/parse-okay-subversion.nix43
-rw-r--r--test/testdata/parse-okay-url.exp1
-rw-r--r--test/testdata/parse-okay-url.nix8
-rw-r--r--test/testdata/readDir/bar0
-rw-r--r--test/testdata/readDir/foo/git-hates-directories0
l---------test/testdata/readDir/ldir1
l---------test/testdata/readDir/linked1
l---------test/testdata/symlink-resolution/broken1
-rw-r--r--test/testdata/symlink-resolution/foo/lib/default.nix1
l---------test/testdata/symlink-resolution/foo/overlays1
-rw-r--r--test/testdata/symlink-resolution/overlays/overlay.nix1
-rw-r--r--theories/dune8
-rw-r--r--theories/dynlang/equiv.v154
-rw-r--r--theories/dynlang/interp.v49
-rw-r--r--theories/dynlang/interp_proofs.v426
-rw-r--r--theories/dynlang/operational.v41
-rw-r--r--theories/dynlang/operational_props.v33
-rw-r--r--theories/evallang/interp.v52
-rw-r--r--theories/evallang/interp_proofs.v478
-rw-r--r--theories/evallang/operational.v140
-rw-r--r--theories/evallang/operational_props.v33
-rw-r--r--theories/evallang/tests.v33
-rw-r--r--theories/lambda/interp.v44
-rw-r--r--theories/lambda/interp_proofs.v614
-rw-r--r--theories/lambda/operational.v38
-rw-r--r--theories/lambda/operational_props.v29
-rw-r--r--theories/nix/floats.v85
-rw-r--r--theories/nix/interp.v351
-rw-r--r--theories/nix/interp_proofs.v2690
-rw-r--r--theories/nix/notations.v43
-rw-r--r--theories/nix/operational.v527
-rw-r--r--theories/nix/operational_props.v680
-rw-r--r--theories/nix/tests.v185
-rw-r--r--theories/nix/wp.v143
-rw-r--r--theories/nix/wp_examples.v164
-rw-r--r--theories/res.v75
-rw-r--r--theories/utils.v275
538 files changed, 16716 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..00ce93e
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,22 @@
1*.aux
2*.glob
3*.vio
4*.vo
5*.vok
6*.vos
7.CoqMakefile.d
8.Makefile.coq.d
9.direnv
10.lia.cache
11Makefile.coq
12Makefile.coq.conf
13*#*.v#
14*~
15_build/
16_coverage/
17_opam/
18result
19mininix_history
20.vscode/
21.envrc
22mininix.install
diff --git a/.ocamlformat b/.ocamlformat
new file mode 100644
index 0000000..9ed4c26
--- /dev/null
+++ b/.ocamlformat
@@ -0,0 +1 @@
version = 0.27.0
diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore
new file mode 100644
index 0000000..fb55689
--- /dev/null
+++ b/.ocamlformat-ignore
@@ -0,0 +1 @@
lib/mininix/extraction.*
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..412a78c
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,564 @@
1License information for this artifact
2=====================================
3
4This artifact consists of a few parts. We choose to license most of
5our code under the 3-clause BSD license (SPDX: BSD-3-Clause), with an
6exception of the Nix test suite that we have adopted, which remains
7licensed under LGPL 2.1 (SPDX: LGPL-2.1-or-later).
8
9Specifically:
10- The following files in lib/nix/ are derived from nixformat [1] by
11 Denis Korzunov:
12 lexer.ml, nix.ml, parser.mly, printer.ml and types.ml
13 nixformat is licensed under ISC (SPDX: ISC). For consistency, we
14 choose to relicense these files under the 3-clause BSD license (as
15 it subsumes the ISC license). We also include a copy of the ISC
16 license as required.
17- The files in test/testdata/ come from Nix [2] and remain licensed
18 under version 2.1 of the LGPL license. We also include a copy of
19 this license below. The only exception here is the file
20 test/testdata/importdef.sexp
21 which was created by us (and is therefore licensed under the 3-clause BSD
22 license).
23- Any files not described by the preceding items is licensed under the
24 3-clause BSD license.
25
26[1]: https://github.com/d2km/nixformat
27[2]: https://github.com/NixOs/nix
28
29
30The 3-clause BSD license (BSD-3-Clause)
31---------------------------------------
32
33Redistribution and use in source and binary forms, with or without
34modification, are permitted provided that the following conditions are
35met:
36
37 1. Redistributions of source code must retain the above copyright
38 notice, this list of conditions and the following disclaimer.
39 2. Redistributions in binary form must reproduce the above
40 copyright notice, this list of conditions and the following
41 disclaimer in the documentation and/or other materials provided
42 with the distribution.
43 3. Neither the name of the copyright holder nor the names of its
44 contributors may be used to endorse or promote products derived
45 from this software without specific prior written permission.
46
47THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
48"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
49LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
50A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
51HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
52SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
53LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
54DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
55THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
56(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
57OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
58
59
60The ISC license (ISC)
61---------------------
62
63Permission to use, copy, modify, and /or distribute this software for
64any purpose with or without fee is hereby granted, provided that the
65above copyright notice and this permission notice appear in all
66copies.
67
68THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
69WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
70WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
71AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
72DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
73PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
74TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
75PERFORMANCE OF THIS SOFTWARE.
76
77
78Version 2.1 of the LGPL license (LGPL-2.1-or-later)
79---------------------------------------------------
80
81Copyright (C) 1991, 1999 Free Software Foundation, Inc.
8251 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
83
84Everyone is permitted to copy and distribute verbatim copies of this
85license document, but changing it is not allowed.
86
87[This is the first released version of the Lesser GPL. It also counts
88as the successor of the GNU Library Public License, version 2, hence
89the version number 2.1.]
90
91Preamble
92
93The licenses for most software are designed to take away your freedom
94to share and change it. By contrast, the GNU General Public Licenses
95are intended to guarantee your freedom to share and change free
96software--to make sure the software is free for all its users.
97
98This license, the Lesser General Public License, applies to some
99specially designated software packages--typically libraries--of the
100Free Software Foundation and other authors who decide to use it. You
101can use it too, but we suggest you first think carefully about whether
102this license or the ordinary General Public License is the better
103strategy to use in any particular case, based on the explanations
104below.
105
106When we speak of free software, we are referring to freedom of use,
107not price. Our General Public Licenses are designed to make sure that
108you have the freedom to distribute copies of free software (and charge
109for this service if you wish); that you receive source code or can get
110it if you want it; that you can change the software and use pieces of
111it in new free programs; and that you are informed that you can do
112these things.
113
114To protect your rights, we need to make restrictions that forbid
115distributors to deny you these rights or to ask you to surrender these
116rights. These restrictions translate to certain responsibilities for
117you if you distribute copies of the library or if you modify it.
118
119For example, if you distribute copies of the library, whether gratis
120or for a fee, you must give the recipients all the rights that we gave
121you. You must make sure that they, too, receive or can get the source
122code. If you link other code with the library, you must provide
123complete object files to the recipients, so that they can relink them
124with the library after making changes to the library and recompiling
125it. And you must show them these terms so they know their rights.
126
127We protect your rights with a two-step method: (1) we copyright the
128library, and (2) we offer you this license, which gives you legal
129permission to copy, distribute and/or modify the library.
130
131To protect each distributor, we want to make it very clear that there
132is no warranty for the free library. Also, if the library is modified
133by someone else and passed on, the recipients should know that what
134they have is not the original version, so that the original author's
135reputation will not be affected by problems that might be introduced
136by others.
137
138Finally, software patents pose a constant threat to the existence of
139any free program. We wish to make sure that a company cannot
140effectively restrict the users of a free program by obtaining a
141restrictive license from a patent holder. Therefore, we insist that
142any patent license obtained for a version of the library must be
143consistent with the full freedom of use specified in this license.
144
145Most GNU software, including some libraries, is covered by the
146ordinary GNU General Public License. This license, the GNU Lesser
147General Public License, applies to certain designated libraries, and
148is quite different from the ordinary General Public License. We use
149this license for certain libraries in order to permit linking those
150libraries into non-free programs.
151
152When a program is linked with a library, whether statically or using a
153shared library, the combination of the two is legally speaking a
154combined work, a derivative of the original library. The ordinary
155General Public License therefore permits such linking only if the
156entire combination fits its criteria of freedom. The Lesser General
157Public License permits more lax criteria for linking other code with
158the library.
159
160We call this license the "Lesser" General Public License because it
161does Less to protect the user's freedom than the ordinary General
162Public License. It also provides other free software developers Less
163of an advantage over competing non-free programs. These disadvantages
164are the reason we use the ordinary General Public License for many
165libraries. However, the Lesser license provides advantages in certain
166special circumstances.
167
168For example, on rare occasions, there may be a special need to
169encourage the widest possible use of a certain library, so that it
170becomes a de-facto standard. To achieve this, non-free programs must
171be allowed to use the library. A more frequent case is that a free
172library does the same job as widely used non-free libraries. In this
173case, there is little to gain by limiting the free library to free
174software only, so we use the Lesser General Public License.
175
176In other cases, permission to use a particular library in non-free
177programs enables a greater number of people to use a large body of
178free software. For example, permission to use the GNU C Library in
179non-free programs enables many more people to use the whole GNU
180operating system, as well as its variant, the GNU/Linux operating
181system.
182
183Although the Lesser General Public License is Less protective of the
184users' freedom, it does ensure that the user of a program that is
185linked with the Library has the freedom and the wherewithal to run
186that program using a modified version of the Library.
187
188The precise terms and conditions for copying, distribution and
189modification follow. Pay close attention to the difference between a
190"work based on the library" and a "work that uses the library". The
191former contains code derived from the library, whereas the latter must
192be combined with the library in order to run.
193
194GNU LESSER GENERAL PUBLIC LICENSE
195
196TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
197
198 0. This License Agreement applies to any software library or
199 other program which contains a notice placed by the copyright
200 holder or other authorized party saying it may be distributed
201 under the terms of this Lesser General Public License (also
202 called "this License"). Each licensee is addressed as "you".
203
204 A "library" means a collection of software functions and/or
205 data prepared so as to be conveniently linked with application
206 programs (which use some of those functions and data) to form
207 executables.
208
209 The "Library", below, refers to any such software library or
210 work which has been distributed under these terms. A "work
211 based on the Library" means either the Library or any
212 derivative work under copyright law: that is to say, a work
213 containing the Library or a portion of it, either verbatim or
214 with modifications and/or translated straightforwardly into
215 another language. (Hereinafter, translation is included
216 without limitation in the term "modification".)
217
218 "Source code" for a work means the preferred form of the work
219 for making modifications to it. For a library, complete source
220 code means all the source code for all modules it contains,
221 plus any associated interface definition files, plus the
222 scripts used to control compilation and installation of the
223 library.
224
225 Activities other than copying, distribution and modification
226 are not covered by this License; they are outside its scope.
227 The act of running a program using the Library is not
228 restricted, and output from such a program is covered only if
229 its contents constitute a work based on the Library
230 (independent of the use of the Library in a tool for writing
231 it). Whether that is true depends on what the Library does and
232 what the program that uses the Library does. 1. You may copy
233 and distribute verbatim copies of the Library's complete
234 source code as you receive it, in any medium, provided that
235 you conspicuously and appropriately publish on each copy an
236 appropriate copyright notice and disclaimer of warranty; keep
237 intact all the notices that refer to this License and to the
238 absence of any warranty; and distribute a copy of this License
239 along with the Library.
240
241 You may charge a fee for the physical act of transferring a
242 copy, and you may at your option offer warranty protection in
243 exchange for a fee.
244
245 2. You may modify your copy or copies of the Library or any
246 portion of it, thus forming a work based on the Library, and
247 copy and distribute such modifications or work under the terms
248 of Section 1 above, provided that you also meet all of these
249 conditions:
250
251 a) The modified work must itself be a software library.
252 b) You must cause the files modified to carry prominent
253 notices stating that you changed the files and the date of
254 any change.
255 c) You must cause the whole of the work to be licensed at no
256 charge to all third parties under the terms of this
257 License.
258 d) If a facility in the modified Library refers to a function
259 or a table of data to be supplied by an application
260 program that uses the facility, other than as an argument
261 passed when the facility is invoked, then you must make a
262 good faith effort to ensure that, in the event an
263 application does not supply such function or table, the
264 facility still operates, and performs whatever part of its
265 purpose remains meaningful.
266
267 (For example, a function in a library to compute square roots
268 has a purpose that is entirely well-defined independent of the
269 application. Therefore, Subsection 2d requires that any
270 application-supplied function or table used by this function
271 must be optional: if the application does not supply it, the
272 square root function must still compute square roots.)
273
274 These requirements apply to the modified work as a whole. If
275 identifiable sections of that work are not derived from the
276 Library, and can be reasonably considered independent and
277 separate works in themselves, then this License, and its
278 terms, do not apply to those sections when you distribute them
279 as separate works. But when you distribute the same sections
280 as part of a whole which is a work based on the Library, the
281 distribution of the whole must be on the terms of this
282 License, whose permissions for other licensees extend to the
283 entire whole, and thus to each and every part regardless of
284 who wrote it.
285
286 Thus, it is not the intent of this section to claim rights or
287 contest your rights to work written entirely by you; rather,
288 the intent is to exercise the right to control the
289 distribution of derivative or collective works based on the
290 Library.
291
292 In addition, mere aggregation of another work not based on the
293 Library with the Library (or with a work based on the Library)
294 on a volume of a storage or distribution medium does not bring
295 the other work under the scope of this License.
296
297 3. You may opt to apply the terms of the ordinary GNU General
298 Public License instead of this License to a given copy of the
299 Library. To do this, you must alter all the notices that refer
300 to this License, so that they refer to the ordinary GNU
301 General Public License, version 2, instead of to this License.
302 (If a newer version than version 2 of the ordinary GNU General
303 Public License has appeared, then you can specify that version
304 instead if you wish.) Do not make any other change in these
305 notices.
306
307 Once this change is made in a given copy, it is irreversible
308 for that copy, so the ordinary GNU General Public License
309 applies to all subsequent copies and derivative works made
310 from that copy.
311
312 This option is useful when you wish to copy part of the code
313 of the Library into a program that is not a library.
314
315 4. You may copy and distribute the Library (or a portion or
316 derivative of it, under Section 2) in object code or
317 executable form under the terms of Sections 1 and 2 above
318 provided that you accompany it with the complete corresponding
319 machine-readable source code, which must be distributed under
320 the terms of Sections 1 and 2 above on a medium customarily
321 used for software interchange.
322
323 If distribution of object code is made by offering access to
324 copy from a designated place, then offering equivalent access
325 to copy the source code from the same place satisfies the
326 requirement to distribute the source code, even though third
327 parties are not compelled to copy the source along with the
328 object code.
329
330 5. A program that contains no derivative of any portion of the
331 Library, but is designed to work with the Library by being
332 compiled or linked with it, is called a "work that uses the
333 Library". Such a work, in isolation, is not a derivative work
334 of the Library, and therefore falls outside the scope of this
335 License.
336
337 However, linking a "work that uses the Library" with the
338 Library creates an executable that is a derivative of the
339 Library (because it contains portions of the Library), rather
340 than a "work that uses the library". The executable is
341 therefore covered by this License. Section 6 states terms for
342 distribution of such executables.
343
344 When a "work that uses the Library" uses material from a
345 header file that is part of the Library, the object code for
346 the work may be a derivative work of the Library even though
347 the source code is not. Whether this is true is especially
348 significant if the work can be linked without the Library, or
349 if the work is itself a library. The threshold for this to be
350 true is not precisely defined by law.
351
352 If such an object file uses only numerical parameters, data
353 structure layouts and accessors, and small macros and small
354 inline functions (ten lines or less in length), then the use
355 of the object file is unrestricted, regardless of whether it
356 is legally a derivative work. (Executables containing this
357 object code plus portions of the Library will still fall under
358 Section 6.)
359
360 Otherwise, if the work is a derivative of the Library, you may
361 distribute the object code for the work under the terms of
362 Section 6. Any executables containing that work also fall
363 under Section 6, whether or not they are linked directly with
364 the Library itself.
365
366 6. As an exception to the Sections above, you may also combine or
367 link a "work that uses the Library" with the Library to
368 produce a work containing portions of the Library, and
369 distribute that work under terms of your choice, provided that
370 the terms permit modification of the work for the customer's
371 own use and reverse engineering for debugging such
372 modifications.
373
374 You must give prominent notice with each copy of the work that
375 the Library is used in it and that the Library and its use are
376 covered by this License. You must supply a copy of this
377 License. If the work during execution displays copyright
378 notices, you must include the copyright notice for the Library
379 among them, as well as a reference directing the user to the
380 copy of this License. Also, you must do one of these things:
381
382 a) Accompany the work with the complete corresponding
383 machine-readable source code for the Library including
384 whatever changes were used in the work (which must be
385 distributed under Sections 1 and 2 above); and, if the
386 work is an executable linked with the Library, with the
387 complete machine-readable "work that uses the Library", as
388 object code and/or source code, so that the user can
389 modify the Library and then relink to produce a modified
390 executable containing the modified Library. (It is
391 understood that the user who changes the contents of
392 definitions files in the Library will not necessarily be
393 able to recompile the application to use the modified
394 definitions.)
395 b) Use a suitable shared library mechanism for linking with
396 the Library. A suitable mechanism is one that (1) uses at
397 run time a copy of the library already present on the
398 user's computer system, rather than copying library
399 functions into the executable, and (2) will operate
400 properly with a modified version of the library, if the
401 user installs one, as long as the modified version is
402 interface-compatible with the version that the work was
403 made with.
404 c) Accompany the work with a written offer, valid for at
405 least three years, to give the same user the materials
406 specified in Subsection 6a, above, for a charge no more
407 than the cost of performing this distribution.
408 d) If distribution of the work is made by offering access to
409 copy from a designated place, offer equivalent access to
410 copy the above specified materials from the same place.
411 e) Verify that the user has already received a copy of these
412 materials or that you have already sent this user a copy.
413
414 For an executable, the required form of the "work that uses
415 the Library" must include any data and utility programs needed
416 for reproducing the executable from it. However, as a special
417 exception, the materials to be distributed need not include
418 anything that is normally distributed (in either source or
419 binary form) with the major components (compiler, kernel, and
420 so on) of the operating system on which the executable runs,
421 unless that component itself accompanies the executable.
422
423 It may happen that this requirement contradicts the license
424 restrictions of other proprietary libraries that do not
425 normally accompany the operating system. Such a contradiction
426 means you cannot use both them and the Library together in an
427 executable that you distribute.
428
429 7. You may place library facilities that are a work based on the
430 Library side-by-side in a single library together with other
431 library facilities not covered by this License, and distribute
432 such a combined library, provided that the separate
433 distribution of the work based on the Library and of the other
434 library facilities is otherwise permitted, and provided that
435 you do these two things:
436
437 a) Accompany the combined library with a copy of the same
438 work based on the Library, uncombined with any other
439 library facilities. This must be distributed under the
440 terms of the Sections above.
441 b) Give prominent notice with the combined library of the
442 fact that part of it is a work based on the Library, and
443 explaining where to find the accompanying uncombined form
444 of the same work.
445
446 8. You may not copy, modify, sublicense, link with, or distribute
447 the Library except as expressly provided under this License.
448 Any attempt otherwise to copy, modify, sublicense, link with,
449 or distribute the Library is void, and will automatically
450 terminate your rights under this License. However, parties who
451 have received copies, or rights, from you under this License
452 will not have their licenses terminated so long as such
453 parties remain in full compliance.
454
455 9. You are not required to accept this License, since you have
456 not signed it. However, nothing else grants you permission to
457 modify or distribute the Library or its derivative works.
458 These actions are prohibited by law if you do not accept this
459 License. Therefore, by modifying or distributing the Library
460 (or any work based on the Library), you indicate your
461 acceptance of this License to do so, and all its terms and
462 conditions for copying, distributing or modifying the Library
463 or works based on it.
464
465 10. Each time you redistribute the Library (or any work based on
466 the Library), the recipient automatically receives a license
467 from the original licensor to copy, distribute, link with or
468 modify the Library subject to these terms and conditions. You
469 may not impose any further restrictions on the recipients'
470 exercise of the rights granted herein. You are not responsible
471 for enforcing compliance by third parties with this License.
472
473 11. If, as a consequence of a court judgment or allegation of
474 patent infringement or for any other reason (not limited to
475 patent issues), conditions are imposed on you (whether by
476 court order, agreement or otherwise) that contradict the
477 conditions of this License, they do not excuse you from the
478 conditions of this License. If you cannot distribute so as to
479 satisfy simultaneously your obligations under this License and
480 any other pertinent obligations, then as a consequence you may
481 not distribute the Library at all. For example, if a patent
482 license would not permit royalty-free redistribution of the
483 Library by all those who receive copies directly or indirectly
484 through you, then the only way you could satisfy both it and
485 this License would be to refrain entirely from distribution of
486 the Library.
487
488 If any portion of this section is held invalid or
489 unenforceable under any particular circumstance, the balance
490 of the section is intended to apply, and the section as a
491 whole is intended to apply in other circumstances.
492
493 It is not the purpose of this section to induce you to
494 infringe any patents or other property right claims or to
495 contest validity of any such claims; this section has the sole
496 purpose of protecting the integrity of the free software
497 distribution system which is implemented by public license
498 practices. Many people have made generous contributions to the
499 wide range of software distributed through that system in
500 reliance on consistent application of that system; it is up to
501 the author/donor to decide if he or she is willing to
502 distribute software through any other system and a licensee
503 cannot impose that choice.
504
505 This section is intended to make thoroughly clear what is
506 believed to be a consequence of the rest of this License.
507
508 12. If the distribution and/or use of the Library is restricted in
509 certain countries either by patents or by copyrighted
510 interfaces, the original copyright holder who places the
511 Library under this License may add an explicit geographical
512 distribution limitation excluding those countries, so that
513 distribution is permitted only in or among countries not thus
514 excluded. In such case, this License incorporates the
515 limitation as if written in the body of this License.
516
517 13. The Free Software Foundation may publish revised and/or new
518 versions of the Lesser General Public License from time to
519 time. Such new versions will be similar in spirit to the
520 present version, but may differ in detail to address new
521 problems or concerns.
522
523 Each version is given a distinguishing version number. If the
524 Library specifies a version number of this License which
525 applies to it and "any later version", you have the option of
526 following the terms and conditions either of that version or
527 of any later version published by the Free Software
528 Foundation. If the Library does not specify a license version
529 number, you may choose any version ever published by the Free
530 Software Foundation.
531
532 14. If you wish to incorporate parts of the Library into other
533 free programs whose distribution conditions are incompatible
534 with these, write to the author to ask for permission. For
535 software which is copyrighted by the Free Software Foundation,
536 write to the Free Software Foundation; we sometimes make
537 exceptions for this. Our decision will be guided by the two
538 goals of preserving the free status of all derivatives of our
539 free software and of promoting the sharing and reuse of
540 software generally.
541
542 NO WARRANTY
543 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
544 WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY
545 APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE
546 COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS
547 IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
548 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
549 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
550 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY
551 IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
552 THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
553
554 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
555 WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY
556 MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE
557 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL,
558 INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR
559 INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO
560 LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES
561 SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY
562 TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR
563 OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
564 DAMAGES.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..ac8dba0
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,55 @@
1# Default target
2all: Makefile.coq
3 +@$(MAKE) -f Makefile.coq all
4.PHONY: all
5
6# Permit local customization
7-include Makefile.local
8
9# Forward most targets to Coq makefile (with some trick to make this phony)
10%: Makefile.coq phony
11 @#echo "Forwarding $@"
12 +@$(MAKE) -f Makefile.coq $@
13phony: ;
14.PHONY: phony
15
16clean: Makefile.coq
17 +@$(MAKE) -f Makefile.coq clean
18 @# Make sure not to enter the `_opam` folder.
19 find [a-z]*/ \( -name "*.d" -o -name "*.vo" -o -name "*.vo[sk]" -o -name "*.aux" -o -name "*.cache" -o -name "*.glob" -o -name "*.vio" \) -print -delete || true
20 rm -f Makefile.coq .lia.cache builddep/*
21.PHONY: clean
22
23# Create Coq Makefile.
24Makefile.coq: _CoqProject Makefile
25 "$(COQBIN)coq_makefile" -f _CoqProject -o Makefile.coq $(EXTRA_COQFILES)
26
27# Install build-dependencies
28OPAMFILES=$(wildcard *.opam)
29BUILDDEPFILES=$(addsuffix -builddep.opam, $(addprefix builddep/,$(basename $(OPAMFILES))))
30
31builddep/%-builddep.opam: %.opam Makefile
32 @echo "# Creating builddep package for $<."
33 @mkdir -p builddep
34 @sed <$< -E 's/^(build|install|remove):.*/\1: []/; s/"(.*)"(.*= *version.*)$$/"\1-builddep"\2/;' >$@
35
36builddep-opamfiles: $(BUILDDEPFILES)
37.PHONY: builddep-opamfiles
38
39builddep: builddep-opamfiles
40 @# We want opam to not just install the build-deps now, but to also keep satisfying these
41 @# constraints. Otherwise, `opam upgrade` may well update some packages to versions
42 @# that are incompatible with our build requirements.
43 @# To achieve this, we create a fake opam package that has our build-dependencies as
44 @# dependencies, but does not actually install anything itself.
45 @echo "# Installing builddep packages."
46 @opam install $(OPAMFLAGS) $(BUILDDEPFILES)
47.PHONY: builddep
48
49# Backwards compatibility target
50build-dep: builddep
51.PHONY: build-dep
52
53# Some files that do *not* need to be forwarded to Makefile.coq.
54# ("::" lets Makefile.local overwrite this.)
55Makefile Makefile.local _CoqProject $(OPAMFILES):: ;
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..ad7b1b7
--- /dev/null
+++ b/README.md
@@ -0,0 +1,383 @@
1Artifact for "Verified Interpreters for Dynamic Languages with Applications to the Nix Expression Language"
2===========================================================================================================
3
4This is the accompanying artifact for the following paper:
5> Rutger Broekhoff and Robbert Krebbers. 2025. Verified Interpreters for Dynamic Languages with Applications to the Nix Expression Language. _Proc. ACM Program. Lang._ 9, ICFP, Article 268 (August 2025), 29 pages. https://doi.org/10.1145/3747537
6
7This artifact primarily consists of two components:
81. A Rocq formalization of the languages presented in the paper (LambdaLang; § 2, DynLang; § 3, EvalLang; § 3.4, NixLang; § 4).
9 This includes operational semantics and properties, an interpreter and correctness proof, plus some tests and examples.
102. An OCaml front-end for NixLang (§ 5), which elaborates Nix source files into NixLang.
11 These are then evaluated using the NixLang interpreter, which is derived from the Rocq sources using Rocq's program extraction functionality.
12
13> N.B.: If you are using the VM image that we provide for evaluating the artifact, then all necessary dependencies will already be installed using `opam`.
14> You can directly proceed with using the [Dune project and Makefile](#dune-project-and-makefile) or [using the CLI](#usage-of-the-cli).
15
16For the purposes of evaluating the artifact, we suggest the following steps:
171. [Building](#building) (this must certainly be done first).
182. Comparing that the mechanized semantics and interpreters of the defined languages match those presented in the paper.
19 The mechanization of all languages follows a [common structure](#structure-of-the-mechanization), but we also have a [table](#index-of-definitions-and-theories) that points you directly to the relevant definitions.
203. Comparing that the mechanized theorems correspond to those presented in the paper.
21 We have a [table](#index-of-definitions-and-theories) that lists all theorems in the paper and their corresponding version in the formalization.
22 The paper mentions some properties/proofs in passing, we list the corresponding mechanized versions for these as well (but it may be less relevant to verify these, as they are primarily used as stepping stones for the major theorems presented in the paper).
234. Exercising the Nix test suite on our interpreter and verifying that this gives the same results as presented in the paper (§ 5).
245. Trying out some Nix programs in our REPL.
25 The paper (§ 1, § 4.1, § 5) contains some examples that might be interesting to try out.
26
27You may also be interested in the [axioms used](#use-of-axioms) by the mechanization, or in reproducing the interpreter coverage number (91.77%, § 5, p. 22) and Table 1 (§ 5 p. 22).
28How to do this depends on the build method that you are using, see the followings section.
29
30> N.B.: We have only verified this artifact to function on Linux (Arch Linux, Debian) and macOS. It does not work on Windows.
31
32## Building
33
34As mentioned at the start, this project consists of two parts: the Rocq mechanization and the front-end of the Nix interpreter.
35The front-end of the Nix interpreter, which uses the makes use of the NixLang interpreter (written in Rocq, extracted to OCaml), is built using [Dune](https://dune.build/).
36The Dune project also takes care of checking all of the parts of the Rocq mechanization, and extracting the NixLang interpreter to OCaml.
37However, for convenience, we have a separate (classic) `Makefile` which checks only the Rocq sources (this may be more familiar to some, and will explicitly print the files being checked).
38(Do note that Dune will refuse to build if the `.vo` files resulting from the checking process are not cleaned up; this can be done using `make clean`.)
39
40*Both parts require dependencies.*
41We have two main ways of managing the dependencies of the project: either using Nix or `opam`.
42
43If you are familiar with Nix and have it available to you, it will likely be most easy to use.
44If you are just interested in using Nix to build the project (so not directly interacting with the Dune project / Makefile), look [here](#building-with-nix).
45If you are instead interested in interacting with `dune`, Makefile and/or other scripts in this repository, you should probably use the Nix devshell instead.
46For that, look [here](#managing-dependencies-nix-devshell).
47With the devshell set up, you can then proceed with using the [Dune project and Makefile](#dune-project-and-makefile).
48
49If you cannot or do not want to use Nix, there is always still `opam`.
50Look [here](#managing-dependencies-opam) to see how to install project dependencies with `opam`.
51With the dependencies installed using `opam`, you can then proceed with using the [Dune project and Makefile](#dune-project-and-makefile).
52
53### Building with Nix
54
55> N.B.: Only do this if you are solely interested in building/testing and/or using the artifact. If you are interested in being able to manually use the `Makefile` and Dune project, you should use a Nix devshell instead; look [here](#nix-devshell) for instructions.
56
57Run `nix-build` (or equivalently `nix-build ./default.nix`) to build and test the artifact. This will take a few minutes.
58The resulting CLI should then be available as `./result/bin/mininix`.
59See how to use the CLI [below](#usage-of-the-cli).
60For some more details on the test suite, look [here](#use-of-the-nix-language-tests).
61
62Run `nix-build ./axioms.nix` to generate the list of axioms used by the formalization.
63This is equivalent to running `make validate`.
64The output of `coqchk` should be printed directly, but will also be stored at `./result/coqchk-output`.
65See [below](#use-of-axioms) for more information on the axioms used.
66
67In the paper, we report a 91.77% coverage for the interpreter code extracted from Rocq.
68To generate the coverage report, run `nix-build ./coverage.nix`.
69The coverage report should then be available as `./result/coverage/report-plain` (a text file, look for `lib/extraction/interp.ml` for the interpreter coverage).
70A HTML version is also generated, the report for the interpreter should then be available under `./result/coverage/html/lib/extraction/interp.ml.html`.
71
72To generate the line counts for the Rocq development (for comparison with Table 1 in the article), run `nix-build ./cloc.nix`.
73The resulting report should be available as a text file `./result/formalization-loc-report`.
74
75### Managing dependencies: Nix devshell
76
77The Nix devshell gives you a shell where all required dependencies are installed for you, so you do not have to fiddle with `opam`, but can still use the Dune project and Makefile that we provide.
78There are a few ways that you can use the devshell.
79
80Enter the devshell by running `nix-shell`.
81You can then proceed with using the [Dune project and Makefile](#dune-project-and-makefile) *inside of the Nix devshell*.
82
83### Managing dependencies: opam
84
85First, ensure that your `opam` repositories are up-to-date:
86```sh
87opam update
88```
89
90For maximum flexibility and reproducibility, we recommend running the following
91command to create a new opam switch in which the pinned dependencies are
92installed (this includes the required Rocq, Flocq, Rocq-std++ versions etc.):
93
94```sh
95# Leave out the --locked flag if not on Linux!
96opam switch create ./ --repos default,rocq-released=https://rocq-prover.org/opam/released --deps-only --locked
97```
98
99It may be necessary to activate the newly set up opam switch as follows (if
100you are not sure and opam instructs you to run this after creating the switch:
101_do_ run it):
102
103```sh
104eval $(opam env)
105```
106
107The [Dune project `Makefile`](#dune-project-and-makefile) can then be used as usual.
108
109### Dune project and `Makefile`
110
111#### The Makefile (just the formalization)
112
113If you are solely interested in the Rocq sources, you may make use of the `Makefile` to check and build Rocq sources and dependencies, provided that you have the appropriate [Rocq](https://rocq-prover.org/), [Flocq](https://flocq.gitlabpages.inria.fr/) and [Rocq-std++](https://gitlab.mpi-sws.org/iris/stdpp) versions available (8.20.1, 4.2.0/4.2.1 and 1.11.0 resp.).
114When using a Nix devshell or an `opam` switch with the required dependencies installed (instructions above), this should work automatically.
115
116Run `make` to check all files in the formalization.
117Run `make validate` to print the axioms used.
118See [below](#use-of-axioms) for more information on the axioms used.
119
120#### The Dune project (formalization + front-end)
121
122> N.B.: Dune will produce errors if `.vo` files generated by the `Makefile` are present.
123> Remove these by running `make clean`.
124> The Dune project will then build.
125
126This step assumes that you have dependencies installed and available, either using `opam` or a Nix devshell.
127See the relevant sections above.
128
129To check all proofs and build the CLI, use `dune build -p mininix`.
130To then run the CLI, use `./_build/default/bin/main.exe` (see how to use it [below](#usage-of-the-cli)).
131To execute the test suite, use `dune test` (this may take a few minutes).
132For some more details on the test suite, look [here](#use-of-the-nix-language-tests).
133
134To generate the coverage report, run `./coverage.sh` (this will take a few minutes).
135The report will then be printed directly (look for `lib/extraction/interp.ml`).
136A detailed HTML report should also be available under `_coverage/html/lib/extraction/interp.ml.html`.
137
138To generate the line counts for the Rocq development (for comparison with Table 1 in the article), make sure that `cloc` and `jq` are installed (if not using the provided Nix shell).
139Then run `./cloc-rocq.sh` to print the report.
140
141## Usage of the CLI
142
143Depending on how you built the CLI, it will be available to you as `./_build/default/bin/main.exe` (Dune) or `./result/bin/mininix` (Nix).
144In these examples, replace `<cli>` with the actual path of the CLI binary.
145
146- As a Nix REPL: `<cli> repl`.
147 Various meta-commands are available: `:quit`, `:run`, `:set` and `:settings`.
148 Autocomplete for these meta-commands is available; it is possible to cycle through suggestions using <kbd>TAB</kbd>.
149 Input can be canceled using <kbd>Ctrl+C</kbd> and the REPL can be quit using `:quit` or <kbd>Ctrl+D</kbd>.
150 The REPL evaluates in deep mode by default.
151 This can be changed by using `:set eval_strategy shallow`.
152 The REPL does not handle newlines in user input (a newline is processed as a request to process input).
153
154 The expected format of user input is the Nix language (although, as mentioned in the paper, e.g. derivations are not supported).
155 The paper (§ 1, § 4.1, § 5) contains some examples that might be interesting to try out.
156- For evaluating single files: `<cli> eval FILENAME`.
157 This command evaluates in shallow mode by default.
158 You can change to deep mode by using the flag `-strict`.
159 An import tree definition file can be passed using the `-importsdef` flag.
160 See [below](#import-tree-definitions).
161
162## The Rocq mechanization
163
164See how to check/build the mechanization [here](#build).
165This section describes the different parts of the mechanization, and how it relates to the different parts of the article.
166
167### Use of axioms
168
169See how to list the axioms used [above](#build) (look for the dependency management / build method that you are using).
170(In case that you are using the Makefile (so dependencies are managed using `opam` / the Nix devshell): run `make validate`. If you are using Nix but not the devshell: use `nix-build ./axioms.nix` (the axioms used will also be written to `result/coqchk-output`).)
171
172Use of four axioms will be reported, namely:
173```
174Coq.Logic.FunctionalExtensionality.functional_extensionality_dep
175Coq.Reals.ClassicalDedekindReals.sig_not_dec
176Coq.Reals.ClassicalDedekindReals.sig_forall_dec
177Coq.Logic.Classical_Prop.classic
178```
179*These are not axioms that we directly make use of.*
180Instead, they are marked as used because we import [Flocq](https://flocq.gitlabpages.inria.fr/) (so NixLang can support IEEE 754 floating point numbers, see `theories/nix/floats.v`), which imports the classical `Reals` module from the standard library.
181Running `coqchk` on the `Reals` module from the standard library gives the same list of axioms as shown above.
182
183### Structure of the mechanization
184
185There are two files that are shared by all four languages:
186- `theories/res.v`: contains the `res` monad. See also Fig 2. on p. 6.
187- `theories/utils.v`: contains some generic lemmas that are useful for all languages.
188 A decent amount of these are about finite maps, which we use heavily.
189
190There is a general structure for all four languages that we formalize:
191- `operational.v`: the definition of the operational semantics.
192 + Contains an inductive type `expr` for expressions.
193 + Contains a `step` relation that describes the small-step op. sem.
194 + Contains a `subst` function that gives parallel substitution (as used by `step`).
195- `operational_props.v`: properties of the operational semantics.
196 + Contains a lemma `step_det`, proving that the small-step op. sem. is deterministic.
197- `interp.v`: the definition of the interpreter.
198 + Contains the definition of values `val`, thunks `thunk` and environments `env`.
199 + Contains an `interp` function that takes some expression, environment and amount of fuel, and returns a result (timeout, fail or some value).
200 (In NixLang, we end up not using `interp` directly, but instead use `interp'` which wraps `interp` and allows specifying whether to evaluate in shallow/deep mode, cf. `⟦e⟧^{δ,E}_μ` (§ 4.4, p. 19).)
201- `interp_proofs.v`: soundness and completeness of interpreter w.r.t. operational semantics, in three main theorems:
202 + `interp_sound_complete_ret_string` (or `interp_sound_complete_ret_lit` for NixLang) proving the soundness and completeness for programs that reduce to strings (or literals in general in NixLang).
203 + `interp_sound_complete_fail` proving the soundness and completeness for programs that fault.
204 + `interp_sound_complete_no_fuel` proving the soundness and completeness for programs that loop.
205 For LambdaLang, an extra condition here is that the programs that we are considering must be closed.
206
207 There is also always a generalized version of `interp_sound_complete_ret_string/lit`, namely `interp_sound_complete_ret`, which states that the interpreter is sound and complete w.r.t. the operational semantics for (in case of LambdaLang closed) programs that reduce to a value.
208
209Specific to the different languages are the following files:
210- In `theories/dynlang` (for DynLang, § 3):
211 + `equiv.v`, the equivalence of LambdaLang and DynLang for closed LambdaLang terms.
212- In `theories/evallang` (for EvalLang, § 3.4):
213 + `tests.v`, some tests of the EvalLang expression parser and interpreter.
214- In `theories/nix` (for NixLang, § 4):
215 + `floats.v`: our Flocq instantiation with some helper functions.
216 + `notations.v`: some notations to make writing NixLang programs in Rocq easier.
217 + `tests.v`: some example NixLang programs to test the functionality of the interpreter with.
218 + `wp.v`: the definition of our proof-of-concept weakest precondition-based program logic, derived rules (see § 5).
219 + `wp_examples.v`: examples of use of our WP-based program logic (see § 5).
220
221### Index of definitions and theories
222
223**Relevant definitions.**
224
225| In paper | File and line number | Name |
226|----------------------------------------------------|---------------------------------------|--------------------------------|
227| Shared result monad (p. 6) | `theories/res.v:4` | `res` |
228| LambdaLang syntax (p. 6) | `theories/lambda/operational.v:6` | `expr` |
229| LambdaLang operational semantics (p. 6) | `theories/lambda/operational.v:21` | `step` |
230| LambdaLang final expressions (p. 6) | `theories/lambda/operational.v:28` | `final` |
231| LambdaLang parallel substitution (p. 6) | `theories/lambda/operational.v:12` | `subst` |
232| LambdaLang interpreter (p. 6) | `theories/lambda/interp.v:34` | `interp` |
233| LambdaLang interpreter data structures (p. 6) | `theories/lambda/interp.v:7-14` | `thunk`, `env`, `val` |
234| DynLang syntax (p. 9) | `theories/dynlang/operational.v:6` | `expr` |
235| DynLang operational semantics (p. 9) | `theories/dynlang/operational.v:21` | `step` |
236| DynLang final expressions (p. 9) | `theories/dynlang/operational.v:31` | `final` |
237| DynLang parallel substitution (p. 9) | `theories/dynlang/operational.v:12` | `subst` |
238| DynLang interpreter (p. 9) | `theories/dynlang/interp.v:39` | `interp` |
239| DynLang interpreter data structures (p. 9) | `theories/dynlang/interp.v:7-13` | `thunk`, `env`, `val` |
240| EvalLang syntax (p. 11) | `theories/evallang/operational.v:7` | `expr` |
241| EvalLang expression parser (p. 11) | `theories/evallang/operational.v:103` | `parse` |
242| EvalLang operational semantics (p. 11) | `theories/evallang/operational.v:119` | `step` |
243| EvalLang final expressions (p. 11) | `theories/evallang/operational.v:130` | `final` |
244| EvalLang interpreter (p. 11) | `theories/evallang/interp.v:42` | `interp` |
245| EvalLang interpreter data structures (p. 11) | `theories/evallang/interp.v:7-13` | `thunk`, `env`, `val` |
246| NixLang syntax (p. 14) | `theories/nix/operational.v:67` | `expr` |
247| NixLang operational semantics (p. 14) | `theories/nix/operational.v:444` | `step` |
248| NixLang evaluation contexts (p. 14) | `theories/nix/operational.v:418` | `ctx1` |
249| NixLang final expressions (p. 14) | `theories/nix/operational.v:139` | `final` |
250| NixLang binary operator semantics (p. 15) | `theories/nix/operational.v:297` | `sem_bin_op` |
251| NixLang argument matching (p. 15) | `theories/nix/operational.v:398` | `matches` |
252| NixLang substitution (p. 15) | `theories/nix/operational.v:112` | `subst` |
253| NixLang interpreter (p. 18) | `theories/nix/interp.v:329` | `interp` |
254| NixLang interpreter data structures (p. 18) | `theories/nix/interp.v:5-21` | `val`, `thunk`, `tattr`, `env` |
255| NixLang interpreter variant with mode arg. (p. 19) | `theories/nix/interp.v:348` | `interp'` |
256
257**Corresponding theorems.**
258
259| Theorem in paper | File and line number | Name |
260|---------------------------------|---------------------------------------|------------------------------------|
261| Theorem 2.1, Item 1 (p. 7) | `theories/lambda/interp_proofs.v:575` | `interp_sound_complete_ret_string` |
262| Theorem 2.1, Item 2 (p. 7) | `theories/lambda/interp_proofs.v:585` | `interp_sound_complete_fail` |
263| Theorem 2.1, Item 3 (p. 7) | `theories/lambda/interp_proofs.v:594` | `interp_sound_complete_no_fuel` |
264| Lemma 2.2 (p. 8) | `theories/lambda/interp_proofs.v:516` | `interp_sound_open` |
265| Lemma 2.3 (p. 8) | `theories/lambda/interp_proofs.v:402` | `interp_step` |
266| Lemma 2.4 (p. 8) | `theories/lambda/interp_proofs.v:297` | `interp_proper` |
267| Theorem 3.1, Item 1 (p. 11) | `theories/dynlang/equiv.v:120` | `interp_equiv_ret_string` |
268| Theorem 3.1, Item 2 (p. 11) | `theories/dynlang/equiv.v:131` | `interp_equiv_fail` |
269| Theorem 3.1, Item 3 (p. 11) | `theories/dynlang/equiv.v:142` | `interp_equiv_no_fuel` |
270| Theorem 4.1, Item 1 (p. 20) (*) | `theories/nix/interp_proofs.v:2655` | `interp_sound_complete_ret_lit` |
271| Theorem 4.1, Item 2 (p. 20) | `theories/nix/interp_proofs.v:2665` | `interp_sound_complete_fail` |
272| Theorem 4.1, Item 3 (p. 20) | `theories/nix/interp_proofs.v:2673` | `interp_sound_complete_no_fuel` |
273| Lemma 4.2 (p. 20) | `theories/nix/interp_proofs.v:2619` | `interp_sound_open'` |
274| Lemma 4.3 (p. 20) | `theories/nix/interp_proofs.v:2029` | `interp_step'` |
275
276(*): The theorem in the formalization is stronger than the theorem presented in the paper. The latter is a trivial specialization of the former.
277
278**Other claims in the paper.**
279
280- § 2, LambdaLang:
281 + p. 7: Theorem 2.1, Item 1 generalizes to any final value.
282 See `theories/lambda/interp_proofs.v:563`, `interp_sound_complete_ret`.
283 This also holds for DynLang, EvalLang and NixLang.
284 These languages have a theory `interp_sound_complete_ret` in their respective `interp_proofs.v` files as well.
285 + p. 7: LambdaLang has a deterministic operational semantics. See `theories/lambda/operational_props.v:19`, `step_det`.
286 This also holds for DynLang, EvalLang and NixLang.
287 These languages have a theory `step_det` in their respective `operational_props.v` files as well.
288- § 3, DynLang:
289 + p. 10: A variant of the main theorem of DynLang (Theorem 2.1) also holds for DynLang.
290 The primary difference here is that the closedness conditions are not needed for DynLang.
291 For a variant of Theorem 2.1, Item 1, see `theories/dynlang/interp_proofs.v:391`, `interp_sound_complete_ret_string`.
292 For a variant of Theorem 2.1, Item 2, see `theories/dynlang/interp_proofs.v:400`, `interp_sound_complete_fail`.
293 For a variant of Theorem 2.1, Item 3, see `theories/dynlang/interp_proofs.v:408`, `interp_sound_complete_no_fuel`.
294 A variant of the generalized version of Theorem 2.1, Item 1 also holds for DynLang.
295 See `theories/dynlang/interp_proofs.v:381`, `interp_sound_complete_ret`.
296- § 4, NixLang:
297 + p. 19/20: Theorem 4.1, Item 1 generalizes to any final value.
298 + p. 20: Lemma 4.2 follows from mutual induction on four properties.
299 For these four properties and their corresponding proof, see `theories/nix/interp_proofs.v:2267-2282` (`interp_sound_open`, `interp_thunk_sound`, `interp_app_sound`, `force_deep_sound`).
300 + p. 20: Lemma 4.3 follows from mutual induction on two properties.
301 For these two properties and their corresponding proof, see `theories/nix/interp_proofs.v:1519`, `interp_step`.
302- § 5, Evaluation (Program logic, p. 22):
303 + We can derive structural rules for WP (the application rule is presented).
304 See `theories/nix/wp.v:55`, `App_wp` for the presented application rule.
305 In general, `theories/nix/wp.v` contains all derived rules for WP.
306 + We prove the total correctness of three variants of the recursive program from § 4.1:
307 * See `theories/nix/wp_examples.v:84`, `even_rec_attr_wp'` for
308 ```nix
309 rec { f = x: if x = 0 then true else !(f (x - 1)); }.f n
310 ```
311 * See `theories/nix/wp_examples.v:132`, `even_rec_functor_wp'` for
312 ```nix
313 { "__functor " = r: x: if x == 0 then true else !(r (x - 1)); } n
314 ```
315 * See `theories/nix/wp_examples.v:157`, `even_rec_default_wp'` for
316 ```nix
317 ({ f ? (x: if x == 0 then true else !(f (x - 1))) }: f) {} n
318 ```
319 + We prove the total correctness of the following program for any non-recursive attribute set `e`:
320 ```nix
321 let x = 1; in with e; with { y = 2; }; x == y
322 ```
323 See `theories/nix/wp_examples.v:11`, `test_wp`.
324
325## Import tree definitions
326
327We do not claim to have (proper) support the `import` feature of Nix, but we do support it in a bare-bones fashion in order to be able to run the test suite.
328In the test suite, there is a file `lib.nix`, which a few test cases load by using `with import ./lib.nix; ...` (or something similar).
329To support this, we use a so-called import tree definition file, which pre-declares all files that may be imported.
330In the test suite, for example, we have created a `test/testdata/importdef.sexp` file, which looks like this:
331```
332(deps ./lib.nix)
333```
334This means that the file `lib.nix` should be available to be imported for all files in the `test/testdata` folder.
335Such `importdef.sexp` files are discovered automatically by walking up the directory tree from the path of the file to be evaluated (or in case of the REPL, from the current working directory).
336The general syntax (`<forest>`) is as follows: `(deps <tree>)`, where `<tree>` is either `<filename>` or `(<filename> <forest>)`
337
338In general, the primitive imports mechanism works as follows:
339
340- All path expressions (_e.g.,_ `./lib.nix`) in the Nix source file are converted to strings representing their absolute path.
341- We load all dependencies and evaluate them to NixLang values.
342- We put all of these values in a NixLang attribute set (`VAttr`, see `theories/nix/interp.v:14`), where we associate the NixLang value of each imported file with the original filename (as an absolute path).
343- We then create a NixLang function `import <filename>` (using `VClo`, see `theories/nix/interp.v:9`) that takes a string and returns the value for that file (if indeed forward-declared in the import tree definition).
344- This function is then inserted into the global environment of the file that we want to evaluate.
345
346This process is performed recursively, hence recursive imports are also supported.
347
348## Use of the Nix language tests
349
350When exercising the official Nix language tests on our extracted interpreter, we do not exactly consider all tests in the Nix test suite.
351Since we are only interested in tests for the interpreter, and not so much in tests for the parser, we only consider the `eval-*` test files in the `test/testdata` folder.
352There are two types of tests that we have here: tests where evaluation should succeed, and tests where evaluation should fail.
353This is simply marked in the filename; Nix files that should fail to evaluate are named `eval-fail-*.nix` and files that should evaluate successfully are named `eval-okay-*.nix`.
354For the former, there are expected error outputs that the interpreter should produce, but we are not interested in reproducing these (nor would this be realistic with our setup).
355
356For the latter, there are also expected output expressions, which can be found in matching `eval-okay-*.exp`.
357However, there are two `eval-okay-*.nix` files for which no such matching `eval-okay-*.exp` file exists:
358- `eval-okay-tail-call-1.nix`: a file `eval-okay-tail-call-1.exp-disabled` exists; we hence do not consider this test.
359- `eval-okay-xml.nix`: a file `eval-okay-xml.exp.xml` exists, but we are not interested in converting the resulting term to XML to validate the result of this test.
360
361The total amount of `eval-fail-*.nix` files and pairs of `eval-okay-*.nix` and `eval-okay-*.exp` files informs our total count of interpreter tests that we consider to begin with, namely 182 (§ 5, p. 21).
362For these tests again, we explicitly list 74 tests that should be ignored in `./test/test_mininix.ml`, since they cover functionality of Nix that is out of scope for our paper.
363We end up with 108 tests that we exercise our interpreter on.
364Our interpreter passes 103 of these tests, and times out for five tests due to its call-by-name nature.
365Some more details can be found in the paper, in § 5.
366
367## General project structure
368
369- The `theories` folder contains the Rocq formalization. See the [structure of the mechanization](#structure-of-the-mechanization).
370- The `bin` folder contains the entrypoint for the command-line interface.
371- The `lib` folder contains the Nix parser, elaborator and interpreter extraction
372 + The `nix` subfolder contains an adapted version of the parser and pretty-printer from nixformat (licensed under ISC) by Denis Korzunov.
373 See https://github.com/d2km/nixformat.
374 Some improvements were made to the parser and pretty-printer.
375 The file `elaborator.ml`, not part of nixformat, in this folder is concerned with desugaring attribute paths among other things; you may consider this a 'normalizing' stage, which allows the elaborator to our core language to be more concise.
376 + The `mininix` subfolder is the most important here. It contains, among
377 other files:
378 - `nix2mininix.ml`, elaboration of Nix into our core language
379 - `builtins.nix`, our implementation of builtins in Nix, in our core Nix language, where we liberally use 'core' builtins (available as binary operations) that are specific to the core language
380 - `conv.ml`, conversion between numeric types in OCaml and Rocq/Flocq
381 - `import.ml`, very bare-bones support for imports, used in the test suite
382 + The `extraction` folder contains a file that extracts the core language interpreter and some auxiliary functions to OCaml
383- The `explorer` folder contains some utilities for converting the Rocq Mechanization to a static site.
diff --git a/_CoqProject b/_CoqProject
new file mode 100644
index 0000000..49e7e24
--- /dev/null
+++ b/_CoqProject
@@ -0,0 +1,31 @@
1-Q theories mininix
2
3theories/utils.v
4theories/res.v
5
6theories/lambda/operational.v
7theories/lambda/operational_props.v
8theories/lambda/interp.v
9theories/lambda/interp_proofs.v
10
11theories/dynlang/operational.v
12theories/dynlang/operational_props.v
13theories/dynlang/interp.v
14theories/dynlang/interp_proofs.v
15theories/dynlang/equiv.v
16
17theories/evallang/operational.v
18theories/evallang/operational_props.v
19theories/evallang/interp.v
20theories/evallang/interp_proofs.v
21theories/evallang/tests.v
22
23theories/nix/floats.v
24theories/nix/operational.v
25theories/nix/operational_props.v
26theories/nix/interp.v
27theories/nix/notations.v
28theories/nix/tests.v
29theories/nix/interp_proofs.v
30theories/nix/wp.v
31theories/nix/wp_examples.v
diff --git a/axioms.nix b/axioms.nix
new file mode 100644
index 0000000..1bdbefb
--- /dev/null
+++ b/axioms.nix
@@ -0,0 +1,22 @@
1{ pkgs ? import ./nixpkgs-pinned.nix {} }: with pkgs;
2
3stdenv.mkDerivation {
4 name = "mininix-axioms";
5
6 src = ./.;
7
8 nativeBuildInputs = [ coq_8_20 ];
9 buildInputs = (with coqPackages_8_20; [
10 flocq
11 stdpp
12 ]);
13
14 buildPhase = ''
15 make validate 2>&1 | tee coqchk-output
16 '';
17
18 installPhase = ''
19 mkdir -p $out
20 mv coqchk-output $out
21 '';
22}
diff --git a/bin/dune b/bin/dune
new file mode 100644
index 0000000..2a56b29
--- /dev/null
+++ b/bin/dune
@@ -0,0 +1,14 @@
1(executable
2 (public_name mininix)
3 (name main)
4 (preprocess
5 (pps ppx_let))
6 (libraries
7 nix
8 core
9 core_unix.command_unix
10 linenoise
11 mininix
12 sexp_pretty
13 stdio
14 ppx_let))
diff --git a/bin/main.ml b/bin/main.ml
new file mode 100644
index 0000000..e4ca4b9
--- /dev/null
+++ b/bin/main.ml
@@ -0,0 +1,26 @@
1open Core
2
3let repl =
4 Command.basic ~summary:"run the Mininix REPL" (Command.Param.return Repl.run)
5
6let eval =
7 Command.basic ~summary:"run a Nix file"
8 (let%map_open.Command filename = anon ("FILENAME" %: string)
9 and strict = flag "strict" no_arg ~doc:"use deep evaluation strategy"
10 and importsdef =
11 flag "importsdef" (optional string) ~doc:"import tree definition file"
12 in
13 fun () ->
14 Settings.opts.eval_strategy := if strict then `Deep else `Shallow;
15 Settings.opts.imports_def_file := importsdef;
16 let ok =
17 if String.(filename = "-") then Run.eval_stdin ()
18 else Run.eval_file filename
19 in
20 if ok then exit 0 else exit 1)
21
22let main =
23 Command.group ~summary:"the Mininix interpreter"
24 [ ("repl", repl); ("eval", eval) ]
25
26let () = Command_unix.run main
diff --git a/bin/repl.ml b/bin/repl.ml
new file mode 100644
index 0000000..092c503
--- /dev/null
+++ b/bin/repl.ml
@@ -0,0 +1,52 @@
1open Core
2open Option.Let_syntax
3
4let ok = ref true
5let opts = Settings.opts
6
7let rec user_input cb =
8 let prompt = (if !ok then "[okay]" else "[fail]") ^ " (mini)nix> " in
9 try
10 match LNoise.linenoise prompt with
11 | None -> ()
12 | Some v ->
13 cb v;
14 user_input cb
15 with Sys_unix.Break ->
16 printf "\n%!";
17 user_input cb
18
19let split_cmd_prefix cmd =
20 let%bind cmd = String.chop_prefix ~prefix:":" cmd in
21 let cmd' = Repl_cmd.lstrip_space cmd in
22 let space = String.chop_suffix_exn cmd ~suffix:cmd' in
23 return (":" ^ space, cmd')
24
25let handle_cmd cmd =
26 let cmd = Repl_cmd.strip_space cmd in
27 (match split_cmd_prefix cmd with
28 | Some (_, cmd) -> ok := Repl_cmd.invoke cmd
29 | None ->
30 if String.(strip cmd <> "") then
31 ok := Run.eval_expr cmd ~origin:Interactive);
32 printf "\n%!"
33
34let run () =
35 LNoise.set_multiline true;
36 LNoise.history_load ~filename:"mininix_history" |> ignore;
37 LNoise.history_set ~max_length:500 |> ignore;
38 LNoise.set_hints_callback (fun line ->
39 let%bind _, cmd = split_cmd_prefix line in
40 let%bind hint = Repl_cmd.hint cmd in
41 return (hint, LNoise.Yellow, true));
42 LNoise.set_completion_callback (fun line_so_far completions ->
43 match split_cmd_prefix line_so_far with
44 | Some (prefix, cmd_so_far) ->
45 Repl_cmd.complete cmd_so_far
46 |> List.map ~f:(String.append prefix)
47 |> List.iter ~f:(LNoise.add_completion completions)
48 | None -> ());
49 user_input (fun from_user ->
50 LNoise.history_add from_user |> ignore;
51 LNoise.history_save ~filename:"mininix_history" |> ignore;
52 handle_cmd from_user)
diff --git a/bin/repl_cmd.ml b/bin/repl_cmd.ml
new file mode 100644
index 0000000..9ebeae7
--- /dev/null
+++ b/bin/repl_cmd.ml
@@ -0,0 +1,178 @@
1open Core
2open Option.Let_syntax
3
4let join_str_list ~sep = function
5 | [] -> ""
6 | s :: ss -> List.fold ss ~init:s ~f:(fun acc s -> acc ^ sep ^ s)
7
8type cmd = {
9 args : string;
10 opts : unit -> string list;
11 next : (string -> (string, cmd) Either.t) option;
12 call : string list -> bool;
13}
14
15let set_opt_cmd opt setting =
16 {
17 args = "<option value>";
18 opts = (fun () -> Settings.allowed_values setting);
19 next = None;
20 call =
21 (fun args ->
22 match Settings.set_to setting args with
23 | None -> true
24 | Some msg ->
25 printf "Failed to set option %s: %s\n%!" opt msg;
26 false);
27 }
28
29let set_cmd =
30 {
31 args = "<option name> <option value>";
32 opts = (fun () -> Map.keys Settings.settings);
33 next =
34 Some
35 (fun opt ->
36 match Map.find Settings.settings opt with
37 | Some setting -> Second (set_opt_cmd opt setting)
38 | None -> First (sprintf "Unknown option '%s'" opt));
39 call =
40 (fun _ ->
41 printf "Missing option argument value\n%!";
42 false);
43 }
44
45let settings_cmd =
46 {
47 args = "";
48 opts = (fun () -> []);
49 next = None;
50 call =
51 (function
52 | [] ->
53 Settings.print ();
54 true
55 | _ ->
56 printf "Expected no arguments\n%!";
57 false);
58 }
59
60let run_cmd =
61 {
62 args = "<filename>";
63 opts = (fun () -> []);
64 next = None;
65 call =
66 (function
67 | [ filename ] -> Run.eval_file filename
68 | _ ->
69 printf "Expected one argument (the filename)\n%!";
70 false);
71 }
72
73let quit_cmd =
74 { args = ""; opts = (fun () -> []); next = None; call = (fun _ -> exit 0) }
75
76let commands =
77 Map.of_alist_exn
78 (module String)
79 [
80 ("quit", quit_cmd);
81 ("set", set_cmd);
82 ("settings", settings_cmd);
83 ("run", run_cmd);
84 ]
85
86let root_cmd =
87 {
88 args = "<command>";
89 opts = (fun () -> Map.keys commands);
90 next =
91 Some
92 (fun cmd_name ->
93 match Map.find commands cmd_name with
94 | Some cmd -> Second cmd
95 | None ->
96 First
97 (sprintf "Unknown command '%s' (expected one of {%s})" cmd_name
98 (Map.keys commands |> join_str_list ~sep:", ")));
99 call =
100 (fun _ ->
101 printf "Missing command!\n%!";
102 false);
103 }
104
105let is_space = Char.( = ) ' '
106let strip_space = String.strip ~drop:is_space
107let lstrip_space = String.lstrip ~drop:is_space
108
109let clean_str_list ss =
110 ss |> List.map ~f:strip_space
111 |> List.filter ~f:(fun s -> not (String.is_empty s))
112
113let words s = s |> String.split ~on:' ' |> clean_str_list
114let unwords ss = clean_str_list ss |> join_str_list ~sep:" "
115
116let rec call cmd args =
117 match args with
118 | [] -> cmd.call []
119 | arg0 :: argn -> (
120 match cmd.next with
121 | None -> cmd.call args
122 | Some next -> (
123 match next arg0 with
124 | First msg ->
125 printf "%s\n%!" msg;
126 false
127 | Second cmd' -> call cmd' argn))
128
129let try_lsplit2_space s =
130 match String.lsplit2 s ~on:' ' with Some (l, r) -> (l, r) | None -> (s, "")
131
132let lsplit2_space' s =
133 let%bind l, r = String.lsplit2 s ~on:' ' in
134 (* s = l ^ " " ^ r *)
135 let r' = lstrip_space r in
136 let space = " " ^ String.chop_suffix_exn r ~suffix:r' in
137 (* s = l ^ space ^ r' *)
138 return (l, space, r')
139
140let rec completions cmd args =
141 (* cmd|<TAB> -> options
142 cmd|abc<TAB> -> options with prefix 'abc'
143 cmd|abc .*<TAB> -> subcommand 'abc' options, pass .* *)
144 if String.(args = "") then cmd.opts ()
145 else
146 match lsplit2_space' args with
147 | None -> cmd.opts () |> List.filter ~f:(String.is_prefix ~prefix:args)
148 | Some (arg0, space, argn) -> (
149 match cmd.next with
150 | None -> []
151 | Some next -> (
152 match next arg0 with
153 | First _ -> []
154 | Second cmd' ->
155 completions cmd' argn
156 |> List.map ~f:(String.append (arg0 ^ space))))
157
158let rec hints cmd args =
159 (* cmd: "" -> " <args>"
160 cmd: "<space>+" -> "<args>"
161 cmd: "<space>+<subcmd>" -> "<hints for subcmd>"
162 cmd: "<space>+<subcmd> .*" -> "<hints for subcmd with .*>" *)
163 if String.(args = "") then Some (" " ^ cmd.args)
164 else if String.(strip_space args = "") then Some cmd.args
165 else
166 let args = lstrip_space args in
167 let%bind next = cmd.next in
168 match lsplit2_space' args with
169 | None ->
170 let%bind cmd' = next args |> Either.Second.to_option in
171 hints cmd' ""
172 | Some (arg0, space, argn) ->
173 let%bind cmd' = next arg0 |> Either.Second.to_option in
174 hints cmd' (space ^ argn)
175
176let invoke cmd = call root_cmd (words cmd)
177let complete cmd = completions root_cmd cmd
178let hint cmd = hints root_cmd cmd
diff --git a/bin/run.ml b/bin/run.ml
new file mode 100644
index 0000000..f39997c
--- /dev/null
+++ b/bin/run.ml
@@ -0,0 +1,163 @@
1open Core
2
3let opts = Settings.opts
4
5module Origin = struct
6 type t = Filename of string | Stdin | Interactive
7
8 let to_string = function
9 | Filename name -> name
10 | Stdin -> "<stdin>"
11 | Interactive -> "<interactive>"
12end
13
14(* [dir] must be an absolute path *)
15let rec find_imports_file dir : (string, string) result =
16 let def_filename = Filename.concat dir "importdef.sexp" in
17 match Core_unix.access def_filename [ `Read ] with
18 | Ok () -> Ok def_filename
19 | Error (Core_unix.Unix_error (ENOENT, _, _))
20 | Error (Core_unix.Unix_error (EACCES, _, _)) ->
21 let parent = Filename.dirname dir in
22 if String.(parent = dir) then Error "Could not find importdef.sexp file"
23 else find_imports_file (Filename.dirname dir)
24 | Error _ -> Error "Could not find importdef.sexp file"
25
26let load_imports ~for_ =
27 let cwd = Core_unix.getcwd () in
28 let filename =
29 match !(opts.imports_def_file) with
30 | None -> (
31 let dir =
32 match for_ with
33 | Origin.Filename filename ->
34 Filename.to_absolute_exn
35 (Filename.dirname filename)
36 ~relative_to:cwd
37 | Origin.Stdin | Origin.Interactive -> cwd
38 in
39 match find_imports_file dir with
40 | Error _ ->
41 printf
42 "Note: no importdef.sexp was found / could be accessed; imports \
43 will not work\n\
44 %!";
45 None
46 | Ok filename ->
47 let relative =
48 if Filename.is_absolute filename then
49 Filename.of_absolute_exn filename ~relative_to:cwd
50 else filename
51 in
52 printf "Imports definition found at %s\n%!" relative;
53 Some filename)
54 | Some filename -> Some filename
55 in
56 match filename with
57 | None -> Ok []
58 | Some filename -> (
59 (* User-provided filenames may not be absolute *)
60 let filename_abs = Filename.to_absolute_exn filename ~relative_to:cwd in
61 try
62 Ok
63 (In_channel.read_all filename
64 |> Sexp.of_string |> Mininix.Sexp.import_forest_of_sexp
65 |> Mininix.Import.materialize
66 ~relative_to:(Filename.dirname filename_abs))
67 with Sys_error err -> Error ("Failed to read imports definition: " ^ err))
68
69let eval_expr_with_imports ~origin ~imports data =
70 let cwd = Core_unix.getcwd () in
71 let config = Sexp_pretty.Config.default
72 and formatter = Stdlib.Format.formatter_of_out_channel stdout in
73 try
74 if !(opts.print_input) then printf "==> Input Nix:\n%s\n\n%!" data;
75 let nexp = Nix.parse ~filename:(Origin.to_string origin) data in
76 if !(opts.print_parsed) then (
77 print_string "==> Parsed Nix:\n";
78 Nix.Printer.print stdout nexp;
79 printf "\n\n%!");
80 let nnexp =
81 Nix.elaborate
82 ~dir:
83 (Some
84 (match origin with
85 | Filename name ->
86 Filename.to_absolute_exn ~relative_to:cwd
87 (Filename.dirname name)
88 | Stdin | Interactive -> cwd))
89 nexp
90 in
91 if !(opts.print_elaborated) then (
92 print_string "==> Parsed, elaborated Nix:\n";
93 Nix.Printer.print stdout nnexp;
94 printf "\n\n%!");
95 if !(opts.print_nix_sexp) then (
96 let nsexp = Nix.Ast.sexp_of_expr nnexp in
97 print_string "==> Nix S-expr:\n";
98 Sexp_pretty.pp_formatter config formatter nsexp;
99 printf "\n%!");
100 let mnexp = Mininix.Nix2mininix.from_nix nnexp in
101 if !(opts.print_mininix_sexp) then (
102 let mnsexp = Mininix.Sexp.expr_to_sexp mnexp in
103 print_string "==> Mininix S-expr:\n";
104 Sexp_pretty.pp_formatter config formatter mnsexp;
105 printf "\n%!");
106 let mnwpexp = Mininix.apply_prelude mnexp in
107 if !(opts.print_mininix_sexp_w_prelude) then (
108 let mnwpsexp = Mininix.Sexp.expr_to_sexp mnwpexp in
109 print_string "==> Mininix S-expr (+ prelude):\n";
110 Sexp_pretty.pp_formatter config formatter mnwpsexp;
111 printf "\n%!");
112 let res =
113 Mininix.interp_tl ~fuel:!(opts.fuel_amount) ~mode:!(opts.eval_strategy)
114 ~imports mnwpexp
115 in
116 if !(opts.print_result_mininix_sexp) then (
117 let ressexp = Mininix.Sexp.val_res_to_sexp res in
118 print_string "==> Evaluation result (Mininix S-exp):\n";
119 Sexp_pretty.pp_formatter config formatter ressexp;
120 printf "\n%!");
121 match res with
122 | Res (Some v) ->
123 let nixv = Mininix.Mininix2nix.from_val v in
124 if !(opts.print_result_nix_sexp) then (
125 let nixvsexp = Nix.Ast.sexp_of_expr nixv in
126 print_string "==> Evaluation result (Nix S-exp):\n";
127 Sexp_pretty.pp_formatter config formatter nixvsexp;
128 printf "\n%!");
129 print_string "==> Evaluation result (Nix):\n";
130 Nix.Printer.print stdout nixv;
131 printf "\n%!";
132 true
133 | Res None ->
134 printf "Failed to evaluate\n%!";
135 false
136 | _ ->
137 printf "Ran out of fuel\n%!";
138 false
139 with
140 | Nix.ParseError msg ->
141 printf "Failed to parse: %s\n%!" msg;
142 false
143 | Nix.ElaborateError msg ->
144 printf "Elaboration failed: %s\n%!" msg;
145 false
146 | Mininix.Nix2mininix.FromNixError msg ->
147 printf "Failed to convert Nix to Mininix: %s\n%!" msg;
148 false
149
150let eval_expr ~origin data =
151 match load_imports ~for_:origin with
152 | Ok imports -> eval_expr_with_imports ~origin ~imports data
153 | Error msg ->
154 print_endline msg;
155 false
156
157let eval_ch ~origin ch = In_channel.input_all ch |> eval_expr ~origin
158
159let eval_file filename =
160 In_channel.with_file filename ~binary:true
161 ~f:(eval_ch ~origin:(Filename filename))
162
163let eval_stdin () = eval_ch In_channel.stdin ~origin:Stdin
diff --git a/bin/settings.ml b/bin/settings.ml
new file mode 100644
index 0000000..55699ee
--- /dev/null
+++ b/bin/settings.ml
@@ -0,0 +1,120 @@
1open Core
2
3type fuel_amount = [ `Limited | `Unlimited ]
4type eval_strategy = [ `Shallow | `Deep ]
5
6type options = {
7 eval_strategy : eval_strategy ref;
8 fuel_amount : fuel_amount ref;
9 imports_def_file : string option ref;
10 print_input : bool ref;
11 print_parsed : bool ref;
12 print_elaborated : bool ref;
13 print_nix_sexp : bool ref;
14 print_mininix_sexp : bool ref;
15 print_mininix_sexp_w_prelude : bool ref;
16 print_result_mininix_sexp : bool ref;
17 print_result_nix_sexp : bool ref;
18}
19
20let opts =
21 {
22 eval_strategy = ref `Deep;
23 fuel_amount = ref `Unlimited;
24 imports_def_file = ref None;
25 print_input = ref false;
26 print_parsed = ref false;
27 print_elaborated = ref false;
28 print_nix_sexp = ref false;
29 print_mininix_sexp = ref false;
30 print_mininix_sexp_w_prelude = ref false;
31 print_result_mininix_sexp = ref false;
32 print_result_nix_sexp = ref false;
33 }
34
35type 'a setter = 'a -> unit
36
37type setting =
38 | BoolSetting of bool ref
39 | EvalStrategySetting of eval_strategy ref
40 | FilenameOptionSetting of string option ref
41 | FuelAmountSetting of fuel_amount ref
42
43let allowed_values s =
44 match s with
45 | BoolSetting _ -> [ "true"; "false" ]
46 | EvalStrategySetting _ -> [ "shallow"; "deep" ]
47 | FilenameOptionSetting _ -> [ "none"; "some " ]
48 | FuelAmountSetting _ -> [ "limited"; "unlimited" ]
49
50let set_to s v =
51 match s with
52 | BoolSetting vref -> (
53 match v with
54 | [ "true" ] ->
55 vref := true;
56 None
57 | [ "false" ] ->
58 vref := false;
59 None
60 | _ -> Some "expected one argument: 'true' or 'false'")
61 | EvalStrategySetting vref -> (
62 match v with
63 | [ "shallow" ] ->
64 vref := `Shallow;
65 None
66 | [ "deep" ] ->
67 vref := `Deep;
68 None
69 | _ -> Some "expected one argument: 'shallow' or 'deep'")
70 | FilenameOptionSetting vref -> (
71 match v with
72 | [ "none" ] ->
73 vref := None;
74 None
75 | [ "some"; filename ] ->
76 vref := Some (String.strip filename);
77 None
78 | _ -> Some "expected 'none' or 'some <filename>'")
79 | FuelAmountSetting vref -> (
80 match v with
81 | [ "limited" ] ->
82 vref := `Limited;
83 None
84 | [ "unlimited" ] ->
85 vref := `Unlimited;
86 None
87 | _ -> Some "expected 'limited' or 'unlimited'")
88
89let to_string s =
90 match s with
91 | BoolSetting vref -> Bool.to_string !vref
92 | EvalStrategySetting vref -> (
93 match !vref with `Shallow -> "shallow" | `Deep -> "deep")
94 | FilenameOptionSetting vref -> (
95 match !vref with None -> "none" | Some v -> "some " ^ v)
96 | FuelAmountSetting vref -> (
97 match !vref with `Limited -> "limited" | `Unlimited -> "unlimited")
98
99let settings =
100 Map.of_alist_exn
101 (module String)
102 [
103 ("print_input", BoolSetting opts.print_input);
104 ("print_parsed", BoolSetting opts.print_parsed);
105 ("print_elaborated", BoolSetting opts.print_elaborated);
106 ("print_nix_sexp", BoolSetting opts.print_nix_sexp);
107 ("print_mininix_sexp", BoolSetting opts.print_mininix_sexp);
108 ( "print_mininix_sexp_w_prelude",
109 BoolSetting opts.print_mininix_sexp_w_prelude );
110 ("print_result_mininix_sexp", BoolSetting opts.print_result_mininix_sexp);
111 ("print_result_nix_sexp", BoolSetting opts.print_result_nix_sexp);
112 ("eval_strategy", EvalStrategySetting opts.eval_strategy);
113 ("fuel_amount", FuelAmountSetting opts.fuel_amount);
114 ("imports_def_file", FilenameOptionSetting opts.imports_def_file);
115 ]
116
117let print () =
118 printf "==> Settings:\n";
119 Map.iteri settings ~f:(fun ~key:name ~data:setting ->
120 printf " %s: %s\n" name (to_string setting))
diff --git a/cloc-rocq.sh b/cloc-rocq.sh
new file mode 100755
index 0000000..1019af3
--- /dev/null
+++ b/cloc-rocq.sh
@@ -0,0 +1,150 @@
1#!/bin/bash
2
3cloc --by-file ./theories --include-ext=v --json | jq -r '
4 def categories: {
5 "./theories/lambda/operational.v": {
6 component: "(2) LambdaLang",
7 category1: "(1) Operational semantics",
8 category2: "General",
9 },
10 "./theories/lambda/operational_props.v": {
11 component: "(2) LambdaLang",
12 category1: "(1) Operational semantics",
13 category2: "Properties",
14 },
15 "./theories/lambda/interp.v": {
16 component: "(2) LambdaLang",
17 category1: "(2) Interpreter",
18 category2: "General",
19 },
20 "./theories/lambda/interp_proofs.v": {
21 component: "(2) LambdaLang",
22 category1: "(2) Interpreter",
23 category2: "Theorem + proofs",
24 },
25 "./theories/dynlang/operational.v": {
26 component: "(3) DynLang",
27 category1: "(1) Operational semantics",
28 category2: "General",
29 },
30 "./theories/dynlang/operational_props.v": {
31 component: "(3) DynLang",
32 category1: "(1) Operational semantics",
33 category2: "Properties",
34 },
35 "./theories/dynlang/interp.v": {
36 component: "(3) DynLang",
37 category1: "(2) Interpreter",
38 category2: "General",
39 },
40 "./theories/dynlang/interp_proofs.v": {
41 component: "(3) DynLang",
42 category1: "(2) Interpreter",
43 category2: "Theorem + proofs",
44 },
45 "./theories/dynlang/equiv.v": {
46 component: "(3) DynLang",
47 category1: "(4) Extra",
48 category2: "Equivalence with LambdaLang",
49 },
50 "./theories/evallang/operational.v": {
51 component: "(4) EvalLang",
52 category1: "(1) Operational semantics",
53 category2: "General",
54 },
55 "./theories/evallang/operational_props.v": {
56 component: "(4) EvalLang",
57 category1: "(1) Operational semantics",
58 category2: "Properties",
59 },
60 "./theories/evallang/interp.v": {
61 component: "(4) EvalLang",
62 category1: "(2) Interpreter",
63 category2: "General",
64 },
65 "./theories/evallang/interp_proofs.v": {
66 component: "(4) EvalLang",
67 category1: "(2) Interpreter",
68 category2: "Theorem + proofs",
69 },
70 "./theories/evallang/tests.v": {
71 component: "(4) EvalLang",
72 category1: "(3) Tests",
73 category2: "General",
74 },
75 "./theories/nix/floats.v": {
76 component: "(5) NixLang",
77 category1: "(4) Extra",
78 category2: "General",
79 },
80 "./theories/nix/operational.v": {
81 component: "(5) NixLang",
82 category1: "(1) Operational semantics",
83 category2: "General",
84 },
85 "./theories/nix/operational_props.v": {
86 component: "(5) NixLang",
87 category1: "(1) Operational semantics",
88 category2: "Properties",
89 },
90 "./theories/nix/notations.v": {
91 component: "(5) NixLang",
92 category1: "(4) Extra",
93 category2: "General",
94 },
95 "./theories/nix/interp.v": {
96 component: "(5) NixLang",
97 category1: "(2) Interpreter",
98 category2: "General",
99 },
100 "./theories/nix/interp_proofs.v": {
101 component: "(5) NixLang",
102 category1: "(2) Interpreter",
103 category2: "Theorem + proofs",
104 },
105 "./theories/nix/tests.v": {
106 component: "(5) NixLang",
107 category1: "(3) Tests",
108 category2: "General",
109 },
110 "./theories/nix/wp.v": {
111 component: "(5) NixLang",
112 category1: "(4) Extra",
113 category2: "General",
114 },
115 "./theories/nix/wp_examples.v": {
116 component: "(5) NixLang",
117 category1: "(4) Extra",
118 category2: "General",
119 },
120 "./theories/utils.v": {
121 component: "(1) Shared",
122 category1: "General",
123 category2: "General",
124 },
125 "./theories/res.v": {
126 component: "(1) Shared",
127 category1: "General",
128 category2: "General",
129 },
130 };
131 def add_cat_data:
132 { key, value: ({loc: .value.code} + categories[.key]) };
133 def categorize_by(key):
134 group_by(.value[key]) | map({ key: .[0].value[key], value: . }) | from_entries;
135 def spaces: if . == 0 then "" else " " + (. - 1 | spaces) end;
136 def pretty(ind):
137 if (. | type) == "number" then
138 . | tostring
139 else
140 to_entries | reduce .[] as $item (""; . + "\n" + (ind | spaces) + $item.key + ": " + ($item.value | pretty(ind + 2)))
141 end;
142 .SUM.code as $sum | del(.header, .SUM) | with_entries(add_cat_data) | to_entries
143 | categorize_by("component") | map_values(categorize_by("category1"))
144 | map_values(map_values(categorize_by("category2") | map_values(map(.value.loc) | add)))
145 | map_values(map_values(. + { TOTAL: to_entries | map(.value) | add }))
146 | map_values(. + { TOTAL: to_entries | map(.value.TOTAL) | add })
147 | . + { TOTAL: to_entries | map(.value.TOTAL) | add }
148 | if .TOTAL == $sum then . else error("internal error: calculated total \(.TOTAL) does not match provided sum \($sum)") end
149 | "Lines of code for the different parts of the Rocq development:" + pretty(0)
150'
diff --git a/cloc.nix b/cloc.nix
new file mode 100644
index 0000000..07a3692
--- /dev/null
+++ b/cloc.nix
@@ -0,0 +1,16 @@
1{ pkgs ? import ./nixpkgs-pinned.nix {} }:
2pkgs.stdenv.mkDerivation {
3 name = "mininix-cloc";
4 src = ./.;
5
6 nativeBuildInputs = with pkgs; [ cloc jq ];
7
8 buildPhase = ''
9 bash cloc-rocq.sh > formalization-loc-report
10 '';
11
12 installPhase = ''
13 mkdir -p $out
14 cp formalization-loc-report $out/
15 '';
16}
diff --git a/coverage.nix b/coverage.nix
new file mode 100644
index 0000000..ed03ce8
--- /dev/null
+++ b/coverage.nix
@@ -0,0 +1,19 @@
1{ pkgs ? import ./nixpkgs-pinned.nix {} }:
2(import ./default.nix { inherit pkgs; }).overrideAttrs (final: prev: {
3 name = "mininix-coverage";
4
5 nativeBuildInputs = prev.nativeBuildInputs ++ [
6 pkgs.ocaml-ng.ocamlPackages_4_14.bisect_ppx
7 ];
8
9 checkPhase = ''
10 dune test --instrument-with bisect_ppx --force
11 '';
12
13 installPhase = ''
14 mkdir -p $out/coverage
15 bisect-ppx-report summary --per-file > $out/coverage/report-plain
16 bisect-ppx-report html
17 cp -R _coverage $out/coverage/html/
18 '';
19})
diff --git a/coverage.sh b/coverage.sh
new file mode 100755
index 0000000..10fdf37
--- /dev/null
+++ b/coverage.sh
@@ -0,0 +1,9 @@
1#!/bin/bash
2
3rm -rf _coverage
4echo "Running tests"
5dune test --instrument-with bisect_ppx --force
6echo "Generating report"
7bisect-ppx-report html
8bisect-ppx-report summary --per-file
9echo "See lib/extraction/interp.ml above or see the detailed report (in HTML form) at _coverage/html/lib/extraction/interp.ml.html"
diff --git a/default.nix b/default.nix
new file mode 100644
index 0000000..8f68fe8
--- /dev/null
+++ b/default.nix
@@ -0,0 +1,27 @@
1{ pkgs ? import ./nixpkgs-pinned.nix {} }: with pkgs;
2let ocamlPackages = ocaml-ng.ocamlPackages_4_14; in
3
4ocamlPackages.buildDunePackage {
5 pname = "mininix";
6 version = "1.0.0";
7
8 src = ./.;
9 doCheck = true;
10
11 nativeBuildInputs = [ coq_8_20 git ocamlPackages.menhir ];
12 buildInputs = (with coqPackages_8_20; [
13 flocq
14 stdpp
15 ]) ++ (with ocamlPackages; [
16 bisect_ppx
17 core
18 core_unix
19 linenoise
20 pprint
21 ppx_blob
22 ppx_let
23 ppx_sexp_conv
24 sexp_pretty
25 stdio
26 ]);
27}
diff --git a/dune-project b/dune-project
new file mode 100644
index 0000000..32c81cd
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,22 @@
1(lang dune 3.15)
2
3(name mininix)
4
5(generate_opam_files true)
6
7(using menhir 3.0)
8(using coq 0.8)
9
10(authors "Rutger Broekhoff" "Robbert Krebbers")
11
12(license LICENSE)
13
14(package
15 (name mininix)
16 (depends (ocaml (< 5))
17 (coq (and (>= 8.20) (< 8.21)))
18 (coq-stdpp (and (>= 1.11) (< 1.12)))
19 coq-flocq
20 core core_unix linenoise menhir pprint sexp_pretty stdio
21 ppx_sexp_conv ppx_blob ppx_let bisect_ppx
22 (merlin :dev) (ocamlformat :dev)))
diff --git a/explorer/.gitignore b/explorer/.gitignore
new file mode 100644
index 0000000..94529d8
--- /dev/null
+++ b/explorer/.gitignore
@@ -0,0 +1,2 @@
1dest/
2dest-*/
diff --git a/explorer/generate.sh b/explorer/generate.sh
new file mode 100755
index 0000000..cf2b77a
--- /dev/null
+++ b/explorer/generate.sh
@@ -0,0 +1,140 @@
1#!/bin/bash
2
3shopt -s globstar
4set -eu
5set -o pipefail
6
7rm -rf dest
8mkdir -p dest
9TREE="$(pwd)/tree.sh"
10destdir="$(pwd)/dest"
11commit="$(git rev-parse --short HEAD)"
12
13cd ../theories
14for file in **/*.v; do
15 destfile="$destdir/$file.html"
16 mkdir -p "$(dirname "$destfile")"
17 echo "<!DOCTYPE html>
18 <html lang=\"en\">
19 <head>
20 <meta charset=\"UTF-8\">
21 <title>$file</title>
22 <style>" >> "$destfile"
23 python -m pygments -S default -f html >> "$destfile"
24 echo "
25 html { height: 100%; }
26 body {
27 font-family: sans-serif;
28 margin: 0px;
29 min-height: 100%;
30 display: flex;
31 flex-direction: column;
32 }
33 header {
34 display: flex;
35 padding: 0em 1em;
36 border-bottom: 1px solid black;
37 }
38 nav {
39 width: 200px;
40 border-right: 1px solid black;
41 min-height: 100%;
42 }
43 nav ul {
44 list-style-type: none;
45 padding-left: 1em;
46 }
47 nav ul:not(#top-dir) {
48 border-left: 1px solid black;
49 }
50 nav li {
51 font-family: monospace;
52 }
53 a { text-decoration: none; }
54 a.current { font-weight: bold; }
55 .row { display: flex; }
56 .grow { flex-grow: 1; }
57 .h1-like {
58 display: block;
59 margin-block: 0.67em;
60 font-size: 2.00em;
61 font-weight: bold;
62 }
63 #subtitle {
64 display: block;
65 margin-block: 0.83em;
66 font-size: 1.50em;
67 }
68 </style>
69 </head>
70 <body>
71 <header class=\"row\">
72 <div class=\"grow\">
73 <h1>Verified Interpreters for Dynamic Languages</h1>
74 <span id=\"subtitle\">with Applications to the Nix Expression Language</span>
75 </div>
76 <div>
77 <span class=\"h1-like\">Rocq Mechanization</span>
78 <span>Commit $commit</span>
79 </div>
80 </header>
81 <div class=\"row grow\">
82 <nav>
83 <ul id=\"top-dir\">
84" >> "$destfile"
85 $TREE "$file" >> "$destfile"
86 echo '
87 </ul>
88 </nav>
89 <main class="grow">' >> "$destfile"
90 python -m pygments -fhtml -lcoq -Oanchorlinenos,linenos,linespans=line "$file" >> "$destfile"
91 echo '
92 </main>
93 </div>
94 <script>
95 function highlightOne(lineno) {
96 let el = document.getElementById("line-" + lineno);
97 el.classList.add("hll");
98 }
99
100 function scrollTo(lineno) {
101 let el = document.getElementById("line-" + lineno);
102 el.scrollIntoView();
103 }
104
105 function highlight() {
106 let frag = window.location.hash.substring(1);
107 if (/^line-[0-9]+$/.test(frag)) {
108 highlightOne(frag.substring(5));
109 scrollTo(frag.substring(5));
110 } else if (/^L[0-9]+$/.test(frag)) {
111 highlightOne(frag.substring(1));
112 scrollTo(frag.substring(1));
113 } else if (/^L[0-9]+-L[0-9]+$/.test(frag)) {
114 let matches = frag.match(/[0-9]+/g);
115 let startLineno = Number(matches[0]);
116 let endLineno = Number(matches[1]);
117 for (let lineno = startLineno; lineno <= endLineno; lineno++) {
118 highlightOne(lineno);
119 }
120 scrollTo(startLineno);
121 }
122 }
123
124 function unhighlight() {
125 for (const el of Array.from(document.getElementsByClassName("hll"))) {
126 el.classList.remove("hll");
127 }
128 }
129
130 function rehighlight() {
131 unhighlight();
132 highlight();
133 }
134
135 window.addEventListener("hashchange", rehighlight);
136 window.addEventListener("load", highlight);
137 </script>
138 </body>
139</html>' >> "$destfile"
140done
diff --git a/explorer/tree.sh b/explorer/tree.sh
new file mode 100755
index 0000000..1620d2d
--- /dev/null
+++ b/explorer/tree.sh
@@ -0,0 +1,17 @@
1#!/bin/bash
2
3tree -J ../theories -P "*.v" | jq --arg "current" "$1" -r '
4 ("../" * ($current | [ scan("/+") ] | length)) as $prefix |
5 def make_item_link(prefix):
6 (if $current == prefix + .name then " class=\"current\"" else "" end) as $extra |
7 "<a href=\"\($prefix)\(prefix)\(.name | @uri).html\"\($extra)>\(.name | @html)</a>";
8 def handle_item(prefix):
9 if .type == "directory" then
10 "<li>\(.name | @html)<ul>" +
11 (.name as $dir | .contents | map(handle_item("\(prefix)\($dir)/")) | add) +
12 "</ul></li>"
13 else
14 "<li>\(make_item_link(prefix))</li>"
15 end;
16 .[0].contents | map(handle_item("")) | add
17'
diff --git a/explorer/upload-new.sh b/explorer/upload-new.sh
new file mode 100755
index 0000000..7873aa2
--- /dev/null
+++ b/explorer/upload-new.sh
@@ -0,0 +1,16 @@
1#!/bin/bash
2
3set -eu
4set -o pipefail
5
6commit="$(git rev-parse --short HEAD)"
7
8[ -e "dest-$commit" ] && {
9 echo "Revision $commit may have already been uploaded. Delete the directory dest-$commit to force re-upload.";
10 exit 1
11}
12
13./generate.sh
14mv dest "dest-$commit"
15mcli cp --recursive --checksum sha256 dest-$commit/* s3-default-par/verified-dyn-lang-interp/$commit/theories/
16echo "Base URL (for \\rocqbaseurl): https://s3.fr-par.scw.cloud/verified-dyn-lang-interp/$commit/"
diff --git a/importdef.sexp b/importdef.sexp
new file mode 100644
index 0000000..2d11aed
--- /dev/null
+++ b/importdef.sexp
@@ -0,0 +1 @@
(deps test/testdata/lib.nix)
diff --git a/lib/extraction/dune b/lib/extraction/dune
new file mode 100644
index 0000000..b56caf9
--- /dev/null
+++ b/lib/extraction/dune
@@ -0,0 +1,56 @@
1(coq.extraction
2 (prelude prelude)
3 (extracted_modules
4 Ascii
5 BinInt
6 Bits
7 Decimal
8 prelude
9 gmap
10 Nat
11 PeanoNat
12 SpecFloat
13 ZArith_dec
14 base
15 BinNat
16 Bool
17 DecimalString
18 interp
19 numbers
20 pretty
21 Specif
22 Zbool
23 Basics
24 BinNums
25 countable
26 list0
27 operational
28 res
29 String
30 Zpower
31 Binary
32 BinPosDef
33 Datatypes
34 fin_maps
35 List
36 option
37 Round
38 strings
39 BinarySingleNaN
40 BinPos
41 decidable
42 floats
43 mapset
44 orders
45 sorting
46 utils)
47 (flags
48 (-output-directory "."))
49 (theories Flocq stdpp mininix))
50
51(library
52 (name extraction)
53 (flags
54 (:standard -w -33))
55 (instrumentation
56 (backend bisect_ppx)))
diff --git a/lib/extraction/extraction.ml b/lib/extraction/extraction.ml
new file mode 100644
index 0000000..a737700
--- /dev/null
+++ b/lib/extraction/extraction.ml
@@ -0,0 +1,18 @@
1include Prelude
2include Interp
3include Operational
4include Res
5
6(* Stuff that's not part of the paper. Still exposed because we sometimes want
7 to be able to create a natural number, float, process a list etc. *)
8module Internal = struct
9 module BinNums = BinNums
10 module Datatypes = Datatypes
11 module List = List
12
13 module Floats = struct
14 include Floats
15 include Binary
16 include SpecFloat
17 end
18end
diff --git a/lib/extraction/prelude.v b/lib/extraction/prelude.v
new file mode 100644
index 0000000..ef35bcb
--- /dev/null
+++ b/lib/extraction/prelude.v
@@ -0,0 +1,52 @@
1Require Import Coq.Numbers.DecimalString ExtrOcamlBasic ExtrOcamlString.
2From stdpp Require Import strings stringmap gmap.
3From mininix Require Import nix.interp.
4
5Definition attr_set_insert (x : string) (α : attr) (αs : gmap string attr) : gmap string attr :=
6 <[x:=α]> αs.
7
8Definition attr_set_contains (x : string) (αs : gmap string attr) : bool :=
9 bool_decide (x ∈ dom αs).
10
11Definition attr_set_fold {A} (f : string → attr → A → A) (init : A) (αs : gmap string attr) : A :=
12 map_fold f init αs.
13
14Definition attr_set_empty : gmap string attr := ∅.
15
16Definition env_fold {A} (f : string → (kind * thunk) → A → A) (init : A) (E : env) : A :=
17 map_fold f init E.
18
19Definition env_insert_abs (x : string) (t : thunk) (E : env) : env :=
20 <[x:=(ABS,t)]> E.
21
22Definition thunk_map_fold {A} (f : string → thunk → A → A) (init : A) (bs : gmap string thunk) : A :=
23 map_fold f init bs.
24
25Definition thunk_map_insert (x : string) (t : thunk) (bs : gmap string thunk) : gmap string thunk :=
26 <[x:=t]> bs.
27
28Definition thunk_map_empty : gmap string thunk := ∅.
29
30Definition matcher := gmap string (option expr).
31
32Definition matcher_empty : matcher := ∅.
33
34Definition matcher_insert (x : string) (me : option expr) (ms : matcher) : matcher :=
35 <[x:=me]> ms.
36
37Definition matcher_fold {A} (f : string → option expr → A → A) (init : A) (ms : matcher) : A :=
38 map_fold f init ms.
39
40Definition env_empty : env := ∅.
41
42Definition string_of_Z (x : Z) : string :=
43 NilZero.string_of_int (Z.to_int x).
44
45Definition string_to_Z (s : string) : option Z :=
46 Z.of_int <$> NilZero.int_of_string s.
47
48Separate Extraction
49 attr_set_insert env_insert_abs matcher_insert thunk_map_insert
50 attr_set_contains attr_set_fold env_fold matcher_fold thunk_map_fold
51 env_empty attr_set_empty matcher_empty thunk_map_empty string_of_Z
52 string_to_Z interp' forallb.
diff --git a/lib/mininix/builtins.ml b/lib/mininix/builtins.ml
new file mode 100644
index 0000000..0809668
--- /dev/null
+++ b/lib/mininix/builtins.ml
@@ -0,0 +1,77 @@
1open Core
2open Nix2mininix
3
4let minimal_prelude =
5 mn_attr
6 [
7 ("true", `Nonrec, Extraction.ELit (Extraction.LitBool true));
8 ("false", `Nonrec, Extraction.ELit (Extraction.LitBool false));
9 ("null", `Nonrec, Extraction.ELit Extraction.LitNull);
10 ("seq", `Nonrec, mn_abs [ "e1"; "e2" ] (mn_seq (mn_id "e1") (mn_id "e2")));
11 ( "deepSeq",
12 `Nonrec,
13 mn_abs [ "e1"; "e2" ] (mn_deep_seq (mn_id "e1") (mn_id "e2")) );
14 ("typeOf", `Nonrec, mn_abs [ "e" ] (mn_type_of (mn_id "e")));
15 ("functionArgs", `Nonrec, mn_abs [ "f" ] (mn_function_args (mn_id "f")));
16 ( "bitAnd",
17 `Nonrec,
18 mn_abs [ "x"; "y" ] (mn_bit_and (mn_id "x") (mn_id "y")) );
19 ("bitOr", `Nonrec, mn_abs [ "x"; "y" ] (mn_bit_or (mn_id "x") (mn_id "y")));
20 ( "bitXor",
21 `Nonrec,
22 mn_abs [ "x"; "y" ] (mn_bit_xor (mn_id "x") (mn_id "y")) );
23 ("ceil", `Nonrec, mn_abs [ "x" ] (mn_ceil (mn_id "x")));
24 ("floor", `Nonrec, mn_abs [ "x" ] (mn_floor (mn_id "x")));
25 ("__mn_nearestEven", `Nonrec, mn_abs [ "x" ] (mn_nearest_even (mn_id "x")));
26 ( "__mn_singleton",
27 `Nonrec,
28 mn_abs [ "x"; "e" ] (mn_singleton_attr (mn_id "x") (mn_id "e")) );
29 ( "__mn_attr_delete",
30 `Nonrec,
31 mn_abs [ "as"; "x" ] (mn_delete_attr (mn_id "as") (mn_id "x")) );
32 ( "__mn_attr_has_prim",
33 `Nonrec,
34 mn_abs [ "d"; "e" ] (mn_has_attr (mn_id "d") (mn_id "e")) );
35 ("__mn_attr_match", `Nonrec, mn_abs [ "as" ] (mn_attr_match (mn_id "as")));
36 ("__mn_list_match", `Nonrec, mn_abs [ "xs" ] (mn_list_match (mn_id "xs")));
37 ( "__mn_string_match",
38 `Nonrec,
39 mn_abs [ "s" ] (mn_string_match (mn_id "s")) );
40 ]
41
42(* Watch out to not introduce constructs here that refer to themselves using
43 the mnbi_* functions in Nix2mininix - this can cause undesired loops. *)
44let builtins_nix =
45 Nix.elaborate (Nix.parse ~filename:"<builtins>" [%blob "builtins.nix"])
46
47let builtins =
48 Extraction.ELetAttr
49 (Extraction.ABS, minimal_prelude, Nix2mininix.from_nix builtins_nix)
50
51let exported_builtins =
52 [
53 "__mn_assert";
54 "__mn_attr_has";
55 "__mn_attr_insertNew";
56 "__mn_attr_select";
57 "__mn_attr_selectOr";
58 "abort";
59 "false";
60 "head";
61 "map";
62 "null";
63 "removeAttrs";
64 "tail";
65 "throw";
66 "toString";
67 "true";
68 ]
69
70let apply_prelude e =
71 let bindings =
72 mn_attr
73 (("builtins", `Nonrec, builtins)
74 :: List.map exported_builtins ~f:(fun x ->
75 (x, `Rec, mn_select_attr (mn_id "builtins") (mn_str x))))
76 in
77 Extraction.ELetAttr (Extraction.ABS, bindings, e)
diff --git a/lib/mininix/builtins.nix b/lib/mininix/builtins.nix
new file mode 100644
index 0000000..9c7ed32
--- /dev/null
+++ b/lib/mininix/builtins.nix
@@ -0,0 +1,302 @@
1rec {
2 inherit true false null functionArgs typeOf seq deepSeq bitAnd bitOr bitXor floor ceil; # from the minimal prelude
3
4 abort = _: null null; # we ignore the provided message
5 throw = abort; # same here
6
7 head = xs: (__mn_list_match xs).head;
8 tail = xs: (__mn_list_match xs).tail;
9
10 __mn_matchAttr = f: as: f (__mn_attr_match as);
11 __mn_matchList = f: xs: f (__mn_list_match xs);
12 __mn_matchString = f: s: f (__mn_string_match s);
13
14 __mn_foldr = op: nul:
15 __mn_matchList ({ head, tail, empty }:
16 if empty then nul else op head (__mn_foldr op nul tail));
17
18 # foldl' should really be strict. But if we do that (using seq), the
19 # complexity of this function suddenly morphs from linear to
20 # exponential, which is way worse than not actually being strict.
21 foldl' = op: nul:
22 __mn_matchList
23 ({ head, tail, empty }:
24 if empty then nul else
25 let v = op nul head; in
26 seq v (foldl' op v tail));
27 map = f:
28 __mn_matchList ({ head, tail, empty }:
29 if empty then [ ] else [ (f head) ] ++ map f tail);
30 elem = x: any (y: x == y);
31 elemAt = xs: n: assert n >= 0;
32 let go = xs: n: if n == 0 then head xs else go (tail xs) (n - 1);
33 in go xs n;
34 length = __mn_matchList ({ head, tail, empty }:
35 if empty then 0 else 1 + length tail);
36 sort = __mn_mergesort;
37 any = f: __mn_matchList ({ head, tail, empty }: !empty && (f head || any f tail));
38 all = f: __mn_matchList ({ head, tail, empty }: !empty -> (f head && all f tail));
39 concatLists =
40 __mn_matchList ({ head, tail, empty }:
41 if empty then [ ] else head ++ concatLists tail);
42 concatMap = f: xss: concatLists (map f xss);
43 concatStringsSep = sep:
44 __mn_matchList ({ head, tail, empty }:
45 if empty then "" else if tail == [ ] then head
46 else head + sep + concatStringsSep sep tail);
47 filter = f:
48 __mn_matchList ({ head, tail, empty }:
49 if empty then [ ] else (if f head then [ head ] else [ ]) ++ filter f tail);
50 groupBy = f: xs:
51 let update = x: acc: acc // { ${f x} = [ x ] ++ (acc.${f x} or [ ]); };
52 in __mn_foldr update { } xs;
53 partition = f: groupBy (x: if f x then "right" else "wrong");
54
55 hasAttr = x: as: as ? ${x};
56 getAttr = x: as: as.${x};
57 attrNames = __mn_matchAttr ({ key, tail, empty, ... }:
58 if empty then [ ] else [ key ] ++ attrNames tail);
59 attrValues = __mn_matchAttr ({ head, tail, empty, ... }:
60 if empty then [ ] else [ head ] ++ attrValues tail);
61 mapAttrs = f: __mn_matchAttr ({ key, head, tail, empty }:
62 if empty then { } else
63 mapAttrs f tail // { ${key} = f key head; });
64 removeAttrs = __mn_foldr (x: as': __mn_attr_delete as' x);
65 zipAttrsWith = f: ass: mapAttrs f (__mn_zipAttrs ass);
66 catAttrs = x:
67 __mn_matchList ({ head, tail, empty }:
68 if empty then [ ]
69 else (if head ? ${x} then [ head.${x} ] else [ ]) ++ catAttrs x tail);
70 listToAttrs =
71 __mn_foldr (attr: as': as' // { ${attr.name} = attr.value; }) { };
72 intersectAttrs = e1: e2:
73 __mn_matchAttr
74 ({ key, head, tail, empty }:
75 if empty then { } else
76 (if e2 ? ${key} then { ${key} = e2.${key}; } else { }) //
77 intersectAttrs tail (__mn_attr_delete e2 key))
78 e1;
79
80 lessThan = x: y: x < y; # documentation is misleading, not only for numbers
81 add = x: y: x + y;
82 mul = x: y: x * y;
83 div = x: y: x / y;
84 sub = x: y: x - y;
85 genList = gen: n:
86 let
87 aux = off: if off >= n then [ ] else
88 [ (gen off) ] ++ aux (off + 1);
89 in
90 aux 0;
91
92 __mn_genericClosure = { operator, seen, startSet }:
93 __mn_matchList
94 ({ head, tail, empty }:
95 if empty then [ ] else
96 if seen head.key
97 then __mn_genericClosure { inherit operator seen; startSet = tail; }
98 else [ head ] ++ __mn_genericClosure {
99 inherit operator;
100 seen = k: k == head.key || seen k;
101 startSet = tail ++ operator head;
102 })
103 startSet;
104 genericClosure = { operator, startSet }:
105 __mn_genericClosure { inherit operator startSet; seen = _: false; };
106
107 isAttrs = e: typeOf e == "set";
108 isBool = e: typeOf e == "bool";
109 isFloat = e: typeOf e == "float";
110 isFunction = e: typeOf e == "lambda";
111 isInt = e: typeOf e == "int";
112 isList = e: typeOf e == "list";
113 isNull = e: typeOf e == "null";
114 isString = e: typeOf e == "string";
115
116 toString = e:
117 if isAttrs e then
118 if e ? __toString then e.__toString e else e.outPath
119 else if isBool e then
120 if e then "1" else ""
121 else if isFloat e then
122 __mn_float_toString e
123 else if isInt e then
124 __mn_int_toString e
125 else if isList e then
126 concatStringsSep " " (map toString e)
127 else if isNull e then
128 ""
129 else if isString e then
130 e
131 else abort null;
132
133 stringLength =
134 __mn_matchString ({ head, tail, empty }:
135 if empty then 0 else 1 + stringLength tail);
136
137 substring = start: assert start >= 0; len:
138 __mn_matchString ({ head, tail, empty }:
139 if empty || len == 0 then "" else
140 if start > 0
141 then substring (start - 1) len tail
142 else head + substring 0 (len - 1) tail);
143
144 replaceStrings = from: to: s:
145 __mn_matchList
146 ({ head, tail, empty }:
147 let from = if empty then [ ] else [ head ] ++ tail; in
148 __mn_matchList
149 ({ head, tail, empty }:
150 let to = if empty then [ ] else [ head ] ++ tail; in
151 assert length from == length to;
152 __mn_strings_replace from to s)
153 to)
154 from;
155
156 __mn_strings_replace = subsFrom: subsTo: s:
157 let go = __mn_strings_replace subsFrom subsTo; in
158 __mn_strings_replace_aux go subsFrom subsTo s;
159
160 __mn_strings_replace_aux = go: subsFrom: subsTo: s:
161 __mn_matchList
162 ({ head, tail, empty }:
163 if empty
164 then
165 __mn_matchString
166 ({ head, tail, empty }: if empty then "" else head + go tail)
167 s
168 else
169 let subFrom = head; subsFrom' = tail; in
170 __mn_matchList
171 ({ head, tail, ... }:
172 let subTo = head; subsTo' = tail; in
173 if subFrom == ""
174 then
175 # We can only ask ourselves why, but it is so -- in Nix:
176 # replaceStrings ["" "a"] ["X" "_"] "asdf" ~> "XaXsXdXfX"
177 # and so we emulate this 'behavior'
178 subTo + __mn_matchString
179 ({ head, tail, empty }:
180 if empty then "" else head + go tail)
181 s
182 else
183 ({ ok, rest }:
184 if ok
185 then subTo + go rest
186 else __mn_strings_replace_aux go subsFrom' subsTo' s)
187 (__mn_string_chopPrefix subFrom s))
188 subsTo)
189 subsFrom;
190
191 __mn_string_chopPrefix = prefix: s:
192 __mn_matchString
193 ({ head, tail, empty }:
194 if empty then { ok = true; rest = s; } else
195 let prefix = head; prefix' = tail; in __mn_matchString
196 ({ head, tail, empty }:
197 if empty || prefix != head then { ok = false; rest = null; } else
198 __mn_string_chopPrefix prefix' tail)
199 s)
200 prefix;
201
202 __mn_string_drop = n: s:
203 if n <= 0 then s else
204 __mn_matchString
205 ({ tail, empty, ... }:
206 if empty then "" else
207 __mn_string_drop (n - 1) tail)
208 s;
209
210 __mn_float_toString = x:
211 let
212 sign = x < 0;
213 abs = __mn_abs x;
214 int = floor abs;
215 dec = __mn_nearestEven ((abs - int) * 1000000);
216 in
217 (if sign then "-" else "") +
218 __mn_int_toString int + "." + __mn_int_toString dec;
219 __mn_int_toString = x: (if x < 0 then "-" else "") +
220 (
221 let d10 = __mn_quotRem (__mn_abs x) 10; in
222 (if d10.quot != 0 then toString d10.quot else "") +
223 (if d10.rem == 0 then "0" else
224 if d10.rem == 1 then "1" else
225 if d10.rem == 2 then "2" else
226 if d10.rem == 3 then "3" else
227 if d10.rem == 4 then "4" else
228 if d10.rem == 5 then "5" else
229 if d10.rem == 6 then "6" else
230 if d10.rem == 7 then "7" else
231 if d10.rem == 8 then "8" else
232 if d10.rem == 9 then "9" else
233 abort null)
234 );
235
236 __mn_quotRem = x: y:
237 let quot = x / y; in
238 { inherit quot; rem = x - quot * y; };
239 __mn_abs = x: if x < 0 then -x else x;
240
241 __mn_attr_insertNew = as: x: e:
242 if x == null then { } else
243 assert !(as ? ${x}); as // __mn_singleton x e;
244 __mn_attr_has_aux = d: e:
245 if typeOf d != "set" then false else __mn_attr_has_prim d e;
246 __mn_attr_has = e:
247 __mn_matchList ({ head, tail, empty }:
248 if empty then true else
249 if __mn_attr_has_aux e head then __mn_attr_has e.${head} tail
250 else false);
251 __mn_attr_select = e:
252 __mn_matchList ({ head, tail, empty }:
253 if empty then e
254 else __mn_attr_select e.${head} tail);
255 __mn_attr_selectOr = e: as: d:
256 if __mn_attr_has e as
257 then __mn_attr_select e as
258 else d;
259 __mn_assert = e1: e2:
260 if e1 then e2 else abort null;
261
262 __mn_consAttrs = as: acc:
263 __mn_foldr
264 (x: acc: acc // {
265 ${x} = [ as.${x} ] ++ (acc.${x} or [ ]);
266 })
267 acc
268 (attrNames as);
269 __mn_zipAttrs = __mn_foldr __mn_consAttrs { };
270
271 # Old merge sort algorithm, taken from GHC.Internal.Data.OldList.
272 __mn_mergesort = cmp: xs: __mn_mergesort' cmp (__mn_singletons xs);
273 __mn_singletons = map (x: [ x ]);
274 __mn_mergesort' = cmp: xs:
275 __mn_matchList
276 ({ head, tail, empty }:
277 if empty then [ ] else if tail == [ ] then head else
278 __mn_mergesort' cmp (__mn_mergePairs cmp xs))
279 xs;
280 __mn_mergePairs = cmp:
281 __mn_matchList ({ head, tail, empty }: if empty then [ ] else
282 let xs' = head; in __mn_matchList
283 ({ head, tail, empty }:
284 if empty then [ xs' ] else
285 let ys' = head; xss' = tail; in
286 [ (__mn_merge cmp xs' ys') ] ++ __mn_mergePairs cmp xss')
287 tail);
288 __mn_merge = cmp: xs: ys:
289 __mn_matchList
290 ({ head, tail, empty }:
291 if empty then ys else
292 let x = head; xs' = tail; in
293 __mn_matchList
294 ({ head, tail, empty }:
295 if empty then xs else
296 let y = head; ys' = tail; in
297 if cmp y x
298 then [ y ] ++ __mn_merge cmp xs ys' # y < x, i.e., x > y
299 else [ x ] ++ __mn_merge cmp xs' ys)
300 ys)
301 xs;
302}
diff --git a/lib/mininix/conv.ml b/lib/mininix/conv.ml
new file mode 100644
index 0000000..8062099
--- /dev/null
+++ b/lib/mininix/conv.ml
@@ -0,0 +1,96 @@
1open Core
2
3let _ = assert (Sys.word_size_in_bits = 64)
4let chlist s = String.to_list s
5let ( <> ) l1 l2 = not (List.equal Char.( = ) l1 l2)
6let str = String.of_char_list
7let prec = 53
8let emax = 1024
9let exp_bits = 11
10let saturated_exp = Int.shift_left 1 exp_bits - 1
11
12let rec int_bits (x : int) : bool list =
13 if Int.(x < 0) then raise (Invalid_argument "Number must be nonnegative")
14 else if Int.(x = 0) then []
15 else
16 let q = x /% 2 and r = x % 2 in
17 int_bits q @ [ r = 1 ]
18
19let int_to_positive (x : int) : Extraction.Internal.BinNums.positive =
20 if x <= 0 then raise (Invalid_argument "Number must be positive")
21 else
22 let bits = List.tl_exn (int_bits x) in
23 List.fold_left
24 ~f:(fun acc digit ->
25 if digit then Extraction.Internal.BinNums.Coq_xI acc
26 else Extraction.Internal.BinNums.Coq_xO acc)
27 ~init:Extraction.Internal.BinNums.Coq_xH bits
28
29let int_to_z (x : int) : Extraction.Internal.BinNums.coq_Z =
30 if x = 0 then Z0
31 else if x < 0 then Zneg (int_to_positive (-x))
32 else Zpos (int_to_positive x)
33
34let rec int63_of_positive (x : Extraction.Internal.BinNums.positive) : Int63.t =
35 let two = Int63.(succ one) in
36 match x with
37 | Coq_xH -> Int63.of_int_exn 1
38 | Coq_xO x -> Int63.(two * int63_of_positive x)
39 | Coq_xI x -> Int63.((two * int63_of_positive x) + one)
40
41let int63_of_z (x : Extraction.Internal.BinNums.coq_Z) : Int63.t =
42 match x with
43 | Z0 -> Int63.zero
44 | Zpos x -> int63_of_positive x
45 | Zneg x -> Int63.neg (int63_of_positive x)
46
47let int63_to_positive x = Int63.to_int_exn x |> int_to_positive
48
49(* Conversions are the same as those in Coq's FloatOps.
50 See https://github.com/coq/coq/blob/master/theories/Floats/FloatOps.v *)
51
52let normfr_mantissa f =
53 let f = Float.abs f in
54 if Float.(f >= 0.5) && Float.(f < 1.) then Float.to_int (Float.ldexp f prec)
55 else 0
56
57let float_to_flocq (x : float) : Extraction.Internal.Floats.float =
58 match Float.classify x with
59 | Zero -> Extraction.Internal.Floats.B754_zero (Float.ieee_negative x)
60 | Nan ->
61 Extraction.Internal.Floats.B754_nan
62 (Float.ieee_negative x, Float.ieee_mantissa x |> int63_to_positive)
63 | Infinite -> Extraction.Internal.Floats.B754_infinity (Float.ieee_negative x)
64 | Normal | Subnormal -> (
65 let prec_z = int_to_z prec and emax_z = int_to_z emax in
66 let r, exp = Float.frexp x in
67 let e = int_to_z (exp - prec) and r' = int_to_z (normfr_mantissa r) in
68 let shr, e' =
69 Extraction.Internal.Floats.(shr_fexp prec_z emax_z r' e Coq_loc_Exact)
70 in
71 match shr.shr_m with
72 | Zpos p -> B754_finite (Float.is_negative x, p, e')
73 | Zneg _ | Z0 -> assert false)
74
75let float_from_flocq x : float =
76 match x with
77 | Extraction.Internal.Floats.B754_zero s ->
78 Float.create_ieee_exn ~negative:s ~mantissa:Int63.zero ~exponent:0
79 | Extraction.Internal.Floats.B754_infinity s ->
80 if s then Float.neg_infinity else Float.infinity
81 | Extraction.Internal.Floats.B754_nan (s, m) ->
82 let m_int = int63_of_positive m in
83 Float.create_ieee_exn ~negative:s ~mantissa:m_int ~exponent:saturated_exp
84 | Extraction.Internal.Floats.B754_finite (s, m, e) ->
85 let pm = Float.of_int63 (int63_of_positive m) in
86 let f = Float.ldexp pm (Int63.to_int_exn (int63_of_z e)) in
87 if s then Float.neg f else f
88
89open struct
90 open Base_quickcheck
91
92 let%expect_test "float conversion" =
93 Test.run_exn
94 (module Float)
95 ~f:(fun x -> [%test_eq: float] (float_from_flocq (float_to_flocq x)) x)
96end
diff --git a/lib/mininix/dune b/lib/mininix/dune
new file mode 100644
index 0000000..aabbf45
--- /dev/null
+++ b/lib/mininix/dune
@@ -0,0 +1,15 @@
1(library
2 (name mininix)
3 (inline_tests)
4 (preprocessor_deps
5 (file builtins.nix))
6 (preprocess
7 (pps
8 ppx_blob
9 ppx_sexp_conv
10 ppx_expect
11 ppx_assert
12 base_quickcheck.ppx_quickcheck))
13 (instrumentation
14 (backend bisect_ppx))
15 (libraries core extraction nix ppx_blob ppx_sexp_conv))
diff --git a/lib/mininix/import.ml b/lib/mininix/import.ml
new file mode 100644
index 0000000..ca1bfb5
--- /dev/null
+++ b/lib/mininix/import.ml
@@ -0,0 +1,54 @@
1open Core
2
3exception ImportError of string
4
5type tree = { filename : string; deps : forest }
6and forest = tree list
7
8let provide (imports : (string * Extraction.coq_val) list) =
9 let imports_set =
10 Extraction.(
11 VAttr
12 (List.fold imports ~init:thunk_map_empty ~f:(fun attrs (filename, v) ->
13 thunk_map_insert (Conv.chlist filename) (Forced v) attrs)))
14 in
15 let make_env =
16 Extraction.(
17 env_insert_abs (Conv.chlist "imports") (Forced imports_set) env_empty)
18 in
19 Extraction.(
20 VClo
21 ( Conv.chlist "path",
22 make_env,
23 EBinOp
24 ( SelectAttrOp,
25 EId (Conv.chlist "imports", None),
26 EId (Conv.chlist "path", None) ) ))
27
28let make_env (imports : (string * Extraction.coq_val) list) =
29 Extraction.(
30 env_insert_abs (Conv.chlist "import") (Forced (provide imports)) env_empty)
31
32let rec import trees : (string * Extraction.coq_val) list =
33 List.map trees ~f:(fun { filename; deps } ->
34 let data = In_channel.read_all filename in
35 Nix.parse ~filename data |> Nix.elaborate |> Nix2mininix.from_nix
36 |> Builtins.apply_prelude
37 |> Run.interp ~fuel:`Unlimited ~mode:`Shallow
38 ~env:(make_env (import deps))
39 |> function
40 | Res (Some v) -> (filename, v)
41 | Res None ->
42 raise
43 (ImportError
44 (sprintf "Could not import %s: Failed to evaluate" filename))
45 | NoFuel -> assert false)
46
47let rec tree_map ~(f : string -> string) { filename; deps } =
48 { filename = f filename; deps = forest_map ~f deps }
49
50and forest_map ~(f : string -> string) trees = List.map ~f:(tree_map ~f) trees
51
52(* [relative_to] must be an absolute path *)
53let materialize forest ~relative_to : (string * Extraction.coq_val) list =
54 forest_map forest ~f:(Filename.to_absolute_exn ~relative_to) |> import
diff --git a/lib/mininix/mininix.ml b/lib/mininix/mininix.ml
new file mode 100644
index 0000000..b121619
--- /dev/null
+++ b/lib/mininix/mininix.ml
@@ -0,0 +1,13 @@
1module Nix2mininix = Nix2mininix
2module Mininix2nix = Mininix2nix
3module Sexp = Sexp
4module Import = Import
5
6let interp_tl ~fuel ~mode ?(imports = []) e =
7 Run.interp ~fuel ~mode ~env:(Import.make_env imports) e
8
9let apply_prelude = Builtins.apply_prelude
10
11let preprocess input ~filename =
12 input |> Nix.parse ~filename |> Nix.elaborate |> Nix2mininix.from_nix
13 |> Builtins.apply_prelude
diff --git a/lib/mininix/mininix2nix.ml b/lib/mininix/mininix2nix.ml
new file mode 100644
index 0000000..efbc42a
--- /dev/null
+++ b/lib/mininix/mininix2nix.ml
@@ -0,0 +1,54 @@
1open Conv
2open Core
3
4(* [or] is not a 'strong' keyword. That means that 'it depends' whether it is
5 identified as such. In the context of the left-hand side of an attribute, it
6 is not recognized as such. *)
7let strong_keywords =
8 [ "with"; "rec"; "let"; "in"; "inherit"; "if"; "then"; "else"; "assert" ]
9
10let id_re = Str.regexp {|^[A-Za-z_]+[A-Za-z0-9'_-]*$|}
11
12let is_simple_id s =
13 Str.string_match id_re s 0
14 && not (List.exists strong_keywords ~f:(String.( = ) s))
15
16let thunk_map_to_map tm =
17 Extraction.thunk_map_fold
18 (fun k t -> Map.add_exn ~key:(String.of_char_list k) ~data:t)
19 (Map.empty (module String))
20 tm
21
22let from_lit l =
23 match l with
24 | Extraction.LitString s -> Nix.Ast.Val (Nix.Ast.Str (str s, []))
25 | Extraction.LitNull -> Nix.Ast.Id "null"
26 | Extraction.LitBool b -> Nix.Ast.Id (if b then "true" else "false")
27 | Extraction.LitNum x ->
28 Nix.Ast.Val
29 (match x with
30 | Extraction.NInt x -> Nix.Ast.Int (x |> Extraction.string_of_Z |> str)
31 | Extraction.NFloat x ->
32 Nix.Ast.Float (Printf.sprintf "%g" (float_from_flocq x)))
33
34let rec from_val = function
35 | Extraction.VClo _ | Extraction.VCloMatch _ -> Nix.Ast.Id "<CODE>"
36 | Extraction.VLit l -> from_lit l
37 | Extraction.VAttr bs ->
38 let bs =
39 thunk_map_to_map bs
40 |> Map.to_alist ~key_order:`Increasing
41 |> List.map ~f:(fun (x, t) ->
42 let lhs =
43 if is_simple_id x then Nix.Ast.Id x
44 else Nix.Ast.Val (Nix.Ast.Str (x, []))
45 in
46 Nix.Ast.AttrPath ([ lhs ], from_thunk t))
47 in
48 Nix.Ast.Val (Nix.Ast.AttSet (Nix.Ast.Nonrec, bs))
49 | Extraction.VList ts -> Nix.Ast.Val (Nix.Ast.List List.(ts >>| from_thunk))
50
51and from_thunk = function
52 | Extraction.Thunk (_, ELit l) -> from_lit l
53 | Extraction.Thunk _ | Extraction.Indirect _ -> Nix.Ast.Id "<CODE>"
54 | Extraction.Forced v -> from_val v
diff --git a/lib/mininix/nix2mininix.ml b/lib/mininix/nix2mininix.ml
new file mode 100644
index 0000000..cfd4fa3
--- /dev/null
+++ b/lib/mininix/nix2mininix.ml
@@ -0,0 +1,254 @@
1open Conv
2open Core
3
4exception FromNixError of string
5
6let try_insert_attr x e bs =
7 let x = chlist x in
8 if Extraction.attr_set_contains x bs then
9 raise (FromNixError "Attribute already exists")
10 else Extraction.attr_set_insert x e bs
11
12(* Shorthands, minor conversions *)
13
14let mn_singleton_set x e =
15 Extraction.(
16 EAttr (attr_set_insert (chlist x) (Attr (NONREC, e)) attr_set_empty))
17
18let mn_abs args e =
19 List.fold_right args ~init:e ~f:(fun arg e' ->
20 Extraction.EAbs (chlist arg, e'))
21
22let mn_lit l = Extraction.ELit l
23let mn_int x = mn_lit (Extraction.LitNum (Extraction.NInt x))
24let mn_float x = mn_lit (Extraction.LitNum (Extraction.NFloat x))
25let mn_bool b = mn_lit (Extraction.LitBool b)
26let mn_true = mn_bool true
27let mn_false = mn_bool false
28let mn_str s = mn_lit (Extraction.LitString (chlist s))
29let mn_null = mn_lit Extraction.LitNull
30let mn_id x = Extraction.EId (chlist x, None)
31let mn_app e1 e2 = Extraction.EApp (e1, e2)
32let mn_seq e1 e2 = Extraction.ESeq (Extraction.SHALLOW, e1, e2)
33let mn_deep_seq e1 e2 = Extraction.ESeq (Extraction.DEEP, e1, e2)
34let mn_list es = Extraction.EList es
35
36let mn_attr (bs : (string * [ `Rec | `Nonrec ] * Extraction.expr) list) =
37 Extraction.EAttr
38 (List.fold_left bs ~init:Extraction.attr_set_empty ~f:(fun bs' (x, r, e) ->
39 let r' =
40 match r with `Rec -> Extraction.REC | `Nonrec -> Extraction.NONREC
41 in
42 Extraction.attr_set_insert (chlist x) (Extraction.Attr (r', e)) bs'))
43
44let mn_with e1 e2 = Extraction.ELetAttr (Extraction.WITH, e1, e2)
45let mn_binop op e1 e2 = Extraction.EBinOp (op, e1, e2)
46let mn_add e1 e2 = mn_binop Extraction.AddOp e1 e2
47let mn_sub e1 e2 = mn_binop Extraction.SubOp e1 e2
48let mn_mul e1 e2 = mn_binop Extraction.MulOp e1 e2
49let mn_div e1 e2 = mn_binop Extraction.DivOp e1 e2
50let mn_bit_and e1 e2 = mn_binop Extraction.AndOp e1 e2
51let mn_bit_or e1 e2 = mn_binop Extraction.OrOp e1 e2
52let mn_bit_xor e1 e2 = mn_binop Extraction.XOrOp e1 e2
53let mn_lt e1 e2 = mn_binop Extraction.LtOp e1 e2
54let mn_eq e1 e2 = mn_binop Extraction.EqOp e1 e2
55let mn_if e1 e2 e3 = Extraction.EIf (e1, e2, e3)
56let mn_delete_attr e1 e2 = mn_binop Extraction.DeleteAttrOp e1 e2
57let mn_has_attr e1 e2 = mn_binop Extraction.HasAttrOp e1 e2
58let mn_select_attr e1 e2 = mn_binop Extraction.SelectAttrOp e1 e2
59
60let mn_singleton_attr e1 e2 =
61 mn_app (mn_binop Extraction.SingletonAttrOp e1 mn_null) e2
62
63let mn_update_attr e1 e2 = mn_binop Extraction.UpdateAttrOp e1 e2
64let mn_type_of e = mn_binop Extraction.TypeOfOp e mn_null
65let mn_function_args e = mn_binop Extraction.FunctionArgsOp e mn_null
66let mn_list_append e1 e2 = mn_binop Extraction.AppendListOp e1 e2
67let mn_list_match e = mn_binop Extraction.MatchListOp e mn_null
68let mn_string_match e = mn_binop Extraction.MatchStringOp e mn_null
69let mn_attr_match e = mn_binop Extraction.MatchAttrOp e mn_null
70let mn_ceil e = mn_binop (Extraction.RoundOp Ceil) e mn_null
71let mn_nearest_even e = mn_binop (Extraction.RoundOp NearestEven) e mn_null
72let mn_floor e = mn_binop (Extraction.RoundOp Floor) e mn_null
73
74(* Macros *)
75
76let mn_cast_bool e = mn_if e mn_true mn_false
77let mn_or e1 e2 = mn_if e1 mn_true (mn_cast_bool e2)
78let mn_and e1 e2 = mn_if e1 (mn_cast_bool e2) mn_false
79let mn_impl e1 e2 = mn_if e1 (mn_cast_bool e2) mn_true
80let mn_not e = mn_if e mn_false mn_true
81let mn_negate e = mn_sub (mn_int Extraction.Internal.BinNums.Z0) e
82let mn_neq e1 e2 = mn_not (mn_eq e2 e1)
83let mn_gt e1 e2 = mn_lt e2 e1
84let mn_lte e1 e2 = mn_not (mn_gt e1 e2)
85let mn_gte e1 e2 = mn_not (mn_lt e1 e2)
86
87(* Macros based on exported functions from the prelude *)
88
89let mnbi_assert e1 e2 = mn_app (mn_app (mn_id "__mn_assert") e1) e2
90let mnbi_has_attr e ds = mn_app (mn_app (mn_id "__mn_attr_has") e) (mn_list ds)
91let mnbi_select e ds = mn_app (mn_app (mn_id "__mn_attr_select") e) (mn_list ds)
92
93let mnbi_select_or e1 ds e2 =
94 mn_app (mn_app (mn_app (mn_id "__mn_attr_selectOr") e1) (mn_list ds)) e2
95
96let mnbi_insert_new e1 e2 e3 =
97 mn_app (mn_app (mn_app (mn_id "__mn_attr_insertNew") e1) e2) e3
98
99let is_dynamic_binding (b : Nix.Ast.binding) =
100 match b with
101 | Nix.Ast.AttrPath ([ Nix.Ast.Val (Nix.Ast.Str (_, [])) ], _)
102 | Nix.Ast.Inherit _ ->
103 false
104 | Nix.Ast.AttrPath ([ _ ], _) -> true
105 | _ -> assert false
106
107let has_dynamic_bindings (bs : Nix.Ast.binding list) =
108 List.exists bs ~f:is_dynamic_binding
109
110(* Static bindings left, dynamic bindings right *)
111let partition_dynamic (bs : Nix.Ast.binding list) :
112 Nix.Ast.binding list * Nix.Ast.binding list =
113 List.fold_left bs ~init:([], []) ~f:(fun (static, dynamic) b ->
114 if is_dynamic_binding b then (static, b :: dynamic)
115 else (b :: static, dynamic))
116
117(* Precondition: e must be have been processed by the elaborator. *)
118let rec from_nix e =
119 match e with
120 | Nix.Ast.BinaryOp (op, e1, e2) -> (
121 let e1', e2' = (from_nix e1, from_nix e2) in
122 match op with
123 | Nix.Ast.Plus -> mn_add e1' e2'
124 | Nix.Ast.Minus -> mn_sub e1' e2'
125 | Nix.Ast.Mult -> mn_mul e1' e2'
126 | Nix.Ast.Div -> mn_div e1' e2'
127 | Nix.Ast.Gt -> mn_gt e1' e2'
128 | Nix.Ast.Lt -> mn_lt e1' e2'
129 | Nix.Ast.Lte -> mn_lte e1' e2'
130 | Nix.Ast.Gte -> mn_gte e1' e2'
131 | Nix.Ast.Eq -> mn_eq e1' e2'
132 | Nix.Ast.Neq -> mn_neq e1' e2'
133 | Nix.Ast.Or -> mn_or e1' e2'
134 | Nix.Ast.And -> mn_and e1' e2'
135 | Nix.Ast.Impl -> mn_impl e1' e2'
136 | Nix.Ast.Merge -> mn_update_attr e1' e2'
137 | Nix.Ast.Concat -> mn_list_append e1' e2')
138 | Nix.Ast.UnaryOp (op, e) -> (
139 let e = from_nix e in
140 match op with Nix.Ast.Negate -> mn_negate e | Nix.Ast.Not -> mn_not e)
141 | Nix.Ast.Cond (e1, e2, e3) -> mn_if (from_nix e1) (from_nix e2) (from_nix e3)
142 | Nix.Ast.With (e1, e2) -> mn_with (from_nix e1) (from_nix e2)
143 | Nix.Ast.Assert (e1, e2) -> mnbi_assert (from_nix e1) (from_nix e2)
144 | Nix.Ast.Test (e, ds) -> mnbi_has_attr (from_nix e) List.(ds >>| from_nix)
145 | Nix.Ast.SetLet bs ->
146 from_nix
147 (Nix.Ast.Select
148 ( Nix.Ast.Val (Nix.Ast.AttSet (Nix.Ast.Rec, bs)),
149 [ Nix.Ast.Val (Nix.Ast.Str ("body", [])) ],
150 None ))
151 | Nix.Ast.Let (bs, e2) ->
152 if has_dynamic_bindings bs then
153 raise (FromNixError "Let bindings may not be dynamic");
154 let e1 = from_nix (Nix.Ast.Val (Nix.Ast.AttSet (Nix.Ast.Rec, bs))) in
155 Extraction.ELetAttr (Extraction.ABS, e1, from_nix e2)
156 | Nix.Ast.Val v -> from_nix_val v
157 | Nix.Ast.Id x -> mn_id x
158 | Nix.Ast.Select (e, parts, md) -> (
159 match md with
160 | Some d ->
161 mnbi_select_or (from_nix e) List.(parts >>| from_nix) (from_nix d)
162 | None -> (
163 match parts with
164 | [ part ] -> mn_select_attr (from_nix e) (from_nix part)
165 | _ -> mnbi_select (from_nix e) List.(parts >>| from_nix)))
166 | Nix.Ast.Apply (e1, e2) -> mn_app (from_nix e1) (from_nix e2)
167 | Nix.Ast.Aquote _ ->
168 assert false (* should be gone after processing by elaborator *)
169
170and from_nix_val v =
171 match v with
172 | Str (s, parts) ->
173 let parts = List.(parts >>= fun (e, s) -> [ from_nix e; mn_str s ]) in
174 List.fold_left parts ~init:(mn_str s) ~f:mn_add
175 | IStr _ -> raise (FromNixError "Indented strings are not supported")
176 | Int n -> (
177 match Extraction.string_to_Z (chlist n) with
178 | Some n -> mn_int n
179 | None -> raise (FromNixError "Bad integer literal"))
180 | Float n ->
181 let n =
182 try Float.of_string n
183 with Invalid_argument _ -> raise (FromNixError "Bad float literal")
184 in
185 if Float.(is_nan n || is_inf n) then
186 raise (FromNixError "Bad float literal")
187 else mn_float (float_to_flocq n)
188 | Path _ | SPath _ | HPath _ -> raise (FromNixError "Paths are not supported")
189 | Uri s -> mn_str s
190 | Lambda (Alias x, e) -> mn_abs [ x ] (from_nix e)
191 | Lambda (ParamSet (Some x, fs), e) ->
192 from_nix_val
193 (Lambda (Alias x, Apply (Val (Lambda (ParamSet (None, fs), e)), Id x)))
194 | Lambda (ParamSet (None, (fs, strictness)), e) ->
195 let ms =
196 List.fold_left fs ~init:Extraction.matcher_empty ~f:(fun ms (x, me) ->
197 Extraction.matcher_insert (chlist x) (Option.map ~f:from_nix me) ms)
198 in
199 Extraction.EAbsMatch
200 ( ms,
201 (match strictness with Loose -> false | Exact -> true),
202 from_nix e )
203 | List es -> mn_list (List.map es ~f:from_nix)
204 | AttSet (recursivity, bs) ->
205 let static, dynamic = partition_dynamic bs
206 and recursivity' =
207 match recursivity with
208 | Nix.Ast.Rec -> Extraction.REC
209 | Nix.Ast.Nonrec -> Extraction.NONREC
210 in
211
212 let set_no_dyn =
213 Extraction.EAttr
214 (List.fold_left static ~init:Extraction.attr_set_empty
215 ~f:(fun static' bnd ->
216 match bnd with
217 | Nix.Ast.AttrPath ([ Nix.Ast.Val (Nix.Ast.Str (x, [])) ], e) ->
218 try_insert_attr x
219 (Extraction.Attr (recursivity', from_nix e))
220 static'
221 | Nix.Ast.Inherit (None, xs) ->
222 List.fold_left xs ~init:static' ~f:(fun static' x ->
223 match x with
224 | Id x ->
225 try_insert_attr x
226 (Extraction.Attr (Extraction.NONREC, mn_id x))
227 static'
228 | _ -> assert false)
229 | Nix.Ast.Inherit (Some e, xs) ->
230 let e = from_nix e in
231 List.fold_left xs ~init:static' ~f:(fun static' x ->
232 match x with
233 | Id x ->
234 try_insert_attr x
235 (Extraction.Attr
236 (recursivity', mn_select_attr e (mn_str x)))
237 static'
238 | _ -> assert false)
239 | _ -> assert false))
240 in
241
242 List.fold_right dynamic ~init:set_no_dyn ~f:(fun bnd set ->
243 match bnd with
244 | Nix.Ast.AttrPath ([ d ], e) ->
245 mnbi_insert_new set
246 (match recursivity with
247 | Nix.Ast.Rec ->
248 Extraction.ELetAttr (Extraction.ABS, set_no_dyn, from_nix d)
249 | Nix.Ast.Nonrec -> from_nix d)
250 (match recursivity with
251 | Nix.Ast.Rec ->
252 Extraction.ELetAttr (Extraction.ABS, set_no_dyn, from_nix e)
253 | Nix.Ast.Nonrec -> from_nix e)
254 | _ -> assert false)
diff --git a/lib/mininix/run.ml b/lib/mininix/run.ml
new file mode 100644
index 0000000..f33bace
--- /dev/null
+++ b/lib/mininix/run.ml
@@ -0,0 +1,17 @@
1open Core
2
3(* The [n]th Church numeral *)
4let rec church n f x = if n <= 0 then x else church (n - 1) f (f x)
5
6let limited =
7 church 2048
8 (fun x -> Extraction.Internal.Datatypes.S x)
9 Extraction.Internal.Datatypes.O
10
11let rec infinity = Extraction.Internal.Datatypes.S infinity
12
13let interp ~fuel ~mode ~env e =
14 let mode : Extraction.mode =
15 match mode with `Shallow -> SHALLOW | `Deep -> DEEP
16 and fuel = match fuel with `Unlimited -> infinity | `Limited -> limited in
17 Extraction.interp' fuel mode env e
diff --git a/lib/mininix/sexp.ml b/lib/mininix/sexp.ml
new file mode 100644
index 0000000..95da655
--- /dev/null
+++ b/lib/mininix/sexp.ml
@@ -0,0 +1,160 @@
1open Conv
2open Core
3open Extraction
4
5exception ToSexpError of string
6
7let tag t l = Sexp.List (Sexp.Atom t :: l)
8
9let lit_to_sexp = function
10 | LitString s -> tag "LitString" [ Sexp.Atom (str s) ]
11 | LitNum (NInt n) ->
12 tag "LitNum" [ Sexp.Atom "INT"; Sexp.Atom (str (string_of_Z n)) ]
13 | LitNum (NFloat n) ->
14 tag "LitNum"
15 [
16 Sexp.Atom "FLOAT";
17 Sexp.Atom (Printf.sprintf "%g" (float_from_flocq n));
18 ]
19 | LitBool b -> tag "LitBool" [ Sexp.Atom (Bool.to_string b) ]
20 | LitNull -> tag "LitNull" []
21
22let option_to_sexp mv ~f =
23 match mv with Some v -> tag "Some" [ f v ] | None -> Sexp.Atom "None"
24
25let mode_to_sexp mode =
26 Sexp.Atom (match mode with SHALLOW -> "SHALLOW" | DEEP -> "DEEP")
27
28let rec_to_sexp r = Sexp.Atom (match r with REC -> "REC" | NONREC -> "NONREC")
29
30let binop_to_sexp op =
31 Sexp.Atom
32 (match op with
33 | UpdateAttrOp -> "UpdateAttrOp"
34 | AddOp -> "AddOp"
35 | SubOp -> "SubOp"
36 | MulOp -> "MulOp"
37 | DivOp -> "DivOp"
38 | AndOp -> "AndOp"
39 | OrOp -> "OrOp"
40 | XOrOp -> "XOrOp"
41 | RoundOp Ceil -> "Ceil"
42 | RoundOp NearestEven -> "NearestEven"
43 | RoundOp Floor -> "Floor"
44 | LtOp -> "LtOp"
45 | EqOp -> "EqOp"
46 | HasAttrOp -> "HasAttrOp"
47 | SelectAttrOp -> "SelectAttrOp"
48 | DeleteAttrOp -> "DeleteAttrOp"
49 | SingletonAttrOp -> "SingletonAttrOp"
50 | TypeOfOp -> "TypeOfOp"
51 | AppendListOp -> "AppendListOp"
52 | MatchAttrOp -> "MatchAttrOp"
53 | MatchListOp -> "MatchListOp"
54 | MatchStringOp -> "MatchStringOp"
55 | FunctionArgsOp -> "FunctionArgsOp")
56
57let kind_to_sexp k = Sexp.Atom (match k with ABS -> "ABS" | WITH -> "WITH")
58
59let rec expr_to_sexp = function
60 | ELit l -> tag "ELit" [ lit_to_sexp l ]
61 | EId (x, None) -> tag "EId" [ Sexp.Atom (str x) ]
62 | EId (x, Some (k, e)) ->
63 tag "EId"
64 [ Sexp.Atom (str x); tag "alt" [ kind_to_sexp k; expr_to_sexp e ] ]
65 | EAbs (x, e) -> tag "EAbs" [ Sexp.Atom (str x); expr_to_sexp e ]
66 | EAbsMatch (ms, strict, e) ->
67 tag "EAbsMatch"
68 [
69 Sexp.Atom (if strict then "EXACT" else "LOOSE");
70 tag "formals"
71 (matcher_fold
72 (fun x me se ->
73 Sexp.List
74 [ Sexp.Atom (str x); option_to_sexp me ~f:expr_to_sexp ]
75 :: se)
76 [] ms);
77 expr_to_sexp e;
78 ]
79 | EApp (e1, e2) -> tag "EApp" [ expr_to_sexp e1; expr_to_sexp e2 ]
80 | ELetAttr (k, e1, e2) ->
81 tag "ELetAttr" [ kind_to_sexp k; expr_to_sexp e1; expr_to_sexp e2 ]
82 | ESeq (mode, e1, e2) ->
83 tag "ESeq" [ mode_to_sexp mode; expr_to_sexp e1; expr_to_sexp e2 ]
84 | EAttr bs ->
85 tag "EAttr"
86 (attr_set_fold
87 (fun x (Attr (r, e)) se ->
88 Sexp.List [ Sexp.Atom (str x); rec_to_sexp r; expr_to_sexp e ]
89 :: se)
90 [] bs)
91 | EList es ->
92 tag "EList"
93 (Internal.List.fold_right (fun e se -> expr_to_sexp e :: se) [] es)
94 | EBinOp (op, e1, e2) ->
95 tag "EBinOp" [ binop_to_sexp op; expr_to_sexp e1; expr_to_sexp e2 ]
96 | EIf (e1, e2, e3) ->
97 tag "EIf" [ expr_to_sexp e1; expr_to_sexp e2; expr_to_sexp e3 ]
98
99let rec val_to_sexp = function
100 | VLit l -> tag "VLit" [ lit_to_sexp l ]
101 | VClo _ -> tag "VClo" []
102 | VCloMatch _ -> tag "VCloMatch" []
103 | VAttr bs ->
104 tag "VAttr"
105 (Extraction.thunk_map_fold
106 (fun x t bs' ->
107 Sexp.List [ Sexp.Atom (str x); thunk_to_sexp t ] :: bs')
108 [] bs)
109 | VList ts ->
110 tag "VList"
111 (Internal.List.fold_right (fun t st -> thunk_to_sexp t :: st) [] ts)
112
113and env_to_sexp env =
114 tag "Env"
115 (Extraction.env_fold
116 (fun x (k, t) envs ->
117 Sexp.List
118 [
119 Sexp.Atom (str x);
120 Sexp.Atom
121 (match k with
122 | Extraction.ABS -> "ABS"
123 | Extraction.WITH -> "WITH");
124 thunk_to_sexp t;
125 ]
126 :: envs)
127 [] env)
128
129and thunk_to_sexp = function
130 | Thunk _ -> tag "Thunk" [ Sexp.Atom "DELAYED" ]
131 | Indirect _ -> tag "Thunk" [ Sexp.Atom "INDIRECT" ]
132 | Forced v -> tag "Thunk" [ Sexp.Atom "FORCED"; val_to_sexp v ]
133
134let expr_res_to_sexp = function
135 | NoFuel -> Sexp.Atom "NoFuel"
136 | Res e -> tag "Res" [ option_to_sexp e ~f:expr_to_sexp ]
137
138let val_res_to_sexp = function
139 | NoFuel -> Sexp.Atom "NoFuel"
140 | Res e -> tag "Res" [ option_to_sexp e ~f:val_to_sexp ]
141
142let rec (sexp_of_import_tree : Import.tree -> Sexp.t) = function
143 | { filename; deps = [] } -> Sexp.Atom filename
144 | { filename; deps } ->
145 Sexp.List [ Sexp.Atom filename; sexp_of_import_forest deps ]
146
147and sexp_of_import_forest forest =
148 Sexp.List (Sexp.Atom "deps" :: List.map forest ~f:sexp_of_import_tree)
149
150exception OfSexpError of string
151
152let rec import_tree_of_sexp : Sexp.t -> Import.tree = function
153 | Sexp.Atom filename -> { filename; deps = [] }
154 | Sexp.List [ Sexp.Atom filename; deps ] ->
155 { filename; deps = import_forest_of_sexp deps }
156 | _ -> raise (OfSexpError "Could not parse import tree")
157
158and import_forest_of_sexp = function
159 | Sexp.List (Sexp.Atom "deps" :: deps) -> List.map ~f:import_tree_of_sexp deps
160 | _ -> raise (OfSexpError "Could not parse import forest")
diff --git a/lib/nix/dune b/lib/nix/dune
new file mode 100644
index 0000000..3954c8a
--- /dev/null
+++ b/lib/nix/dune
@@ -0,0 +1,15 @@
1(menhir
2 (modules parser)
3 (flags "--dump" "--strict" "--external-tokens" "Tokens")
4 (infer true))
5
6(ocamllex
7 (modules lexer))
8
9(library
10 (name nix)
11 (preprocess
12 (pps ppx_sexp_conv))
13 (instrumentation
14 (backend bisect_ppx))
15 (libraries core core_unix core_unix.filename_unix pprint ppx_sexp_conv str))
diff --git a/lib/nix/elaborator.ml b/lib/nix/elaborator.ml
new file mode 100644
index 0000000..36ee0d4
--- /dev/null
+++ b/lib/nix/elaborator.ml
@@ -0,0 +1,208 @@
1open Core
2open Types
3
4(* The Nix elaborator does a few things:
5 - Attribute paths are transformed into a simple list of expressions:
6 + Simple identifiers are rewritten to string values
7 + Antiquotations are rewritten to their component expressions
8 + Anything else, that is not a string value, is rejected
9 and raises an exception
10 - In 'inherit (...) x1 ... xn', x1 ... xn are checked for 'reasonably' being
11 identifiers, i.e., being one of x, "x" and ${"x"}.
12 - Nested attribute paths are unfolded and attribute sets are merged where
13 possible. (Where we mean 'what Nix does' with 'where possible'; see the
14 comment at the respective function.)
15 - Paths are turned into strings and made absolute w.r.t. the current
16 working directory.
17 - Indented strings are converted to their 'normal' counterpart. *)
18
19exception ElaborateError of string
20
21type attr_set = recursivity * binding list
22
23let set_expr (r, bs) = Val (AttSet (r, bs))
24let get_id = function Id x -> x | _ -> assert false
25
26let rec update_bnd (bs : binding list) (x : string) ~(f : expr option -> expr) =
27 match bs with
28 | [] -> [ AttrPath ([ Val (Str (x, [])) ], f None) ]
29 | AttrPath ([ Val (Str (y, [])) ], e) :: s' when String.(x = y) ->
30 AttrPath ([ Val (Str (y, [])) ], f (Some e)) :: s'
31 | Inherit (_, ids) :: _
32 when List.exists ids ~f:(fun e -> String.(get_id e = x)) ->
33 raise (ElaborateError "Cannot update inherit")
34 | bnd :: s' -> bnd :: update_bnd s' x ~f
35
36let set_update_bnd (r, bs) x ~f = (r, update_bnd bs x ~f)
37
38let rec has_bnd (bs : binding list) (x : string) : bool =
39 match bs with
40 | [] -> false
41 | AttrPath ([ Val (Str (y, [])) ], _) :: _ when String.(x = y) -> true
42 | Inherit (_, ids) :: _
43 when List.exists ids ~f:(fun e -> String.(get_id e = x)) ->
44 true
45 | _ :: bs' -> has_bnd bs' x
46
47let merge_bnds bs1 bs2 : binding list =
48 List.fold_left bs2 ~init:bs1 ~f:(fun bs1' b2 ->
49 match b2 with
50 | AttrPath ([ Val (Str (x, [])) ], e) ->
51 update_bnd bs1' x ~f:(function
52 | Some _ -> raise (ElaborateError "Duplicated attribute")
53 | None -> e)
54 | AttrPath ([ d ], e) -> AttrPath ([ d ], e) :: bs1'
55 | Inherit (md, xs) ->
56 if List.for_all xs ~f:(fun e -> not (has_bnd bs1' (get_id e))) then
57 Inherit (md, xs) :: bs1'
58 else raise (ElaborateError "Duplicated attribute")
59 | _ -> assert false)
60
61(* This function intentionally clobbers recursivity, because that is the way
62 that Nix likes to handle attribute insertion. See
63 (1) https://github.com/NixOS/nix/issues/9020
64 (2) https://github.com/NixOS/nix/issues/11268
65 (3) https://github.com/NixOS/nix/pull/11294 *)
66let rec insert (bs : binding list) (path : expr list) (e : expr) =
67 match path with
68 | [] -> raise (ElaborateError "Cannot insert attribute with empty path")
69 | [ Val (Str (x, [])) ] ->
70 update_bnd bs x ~f:(function
71 | None -> e
72 | Some (Val (AttSet (r1, bs1))) -> (
73 match e with
74 | Val (AttSet (_, bs2)) -> set_expr (r1, merge_bnds bs1 bs2)
75 | _ -> raise (ElaborateError "Duplicated attribute"))
76 | _ -> raise (ElaborateError "Duplicated attribute"))
77 | Val (Str (x, [])) :: rest ->
78 update_bnd bs x ~f:(function
79 | Some (Val (AttSet (r, bs))) -> Val (AttSet (r, insert bs rest e))
80 | Some _ -> raise (ElaborateError "Duplicated attribute")
81 | None -> Val (AttSet (Nonrec, insert [] rest e)))
82 | [ part ] -> AttrPath ([ part ], e) :: bs
83 | part :: rest ->
84 AttrPath ([ part ], Val (AttSet (Nonrec, insert [] rest e))) :: bs
85
86let insert_inherit (bs : binding list) (from : expr option) (es : expr list) =
87 if List.for_all es ~f:(fun e -> not (has_bnd bs (get_id e))) then
88 Inherit (from, es) :: bs
89 else raise (ElaborateError "Duplicated attribute")
90
91let simplify_path_component = function
92 | Id x -> Val (Str (x, []))
93 | Val (Str (s, ess)) -> Val (Str (s, ess))
94 | Aquote e -> e
95 | _ -> raise (ElaborateError "Unexpected path component")
96
97let simplify_path = List.map ~f:simplify_path_component
98
99let simplify_bnd_paths =
100 List.map ~f:(fun bnd ->
101 match bnd with
102 | AttrPath (path, e) -> AttrPath (simplify_path path, e)
103 | Inherit (me, xs) -> Inherit (me, xs))
104
105(* Law: concat_lines ∘ split_lines = id *)
106
107let rec split_lines s =
108 match String.lsplit2 s ~on:'\n' with
109 | Some (s1, s2) -> s1 :: split_lines s2
110 | None -> [ s ]
111
112let rec concat_lines = function
113 | [] -> ""
114 | [ x ] -> x
115 | x :: xs -> x ^ "\n" ^ concat_lines xs
116
117let map_tail ~f = function [] -> [] | x :: xs -> x :: List.map ~f xs
118
119let unindent n s ~skip_first_line =
120 let map_op ~f = if skip_first_line then map_tail ~f else List.map ~f in
121 split_lines s
122 |> map_op ~f:(fun line ->
123 let expected_prefix = String.make n ' ' in
124 String.chop_prefix_if_exists ~prefix:expected_prefix line)
125 |> concat_lines
126
127let is_spaces l = String.(strip l ~drop:(Char.( = ) ' ') |> is_empty)
128
129let drop_first_empty_line s =
130 match String.lsplit2 s ~on:'\n' with
131 | Some (l, s') when is_spaces l -> s'
132 | _ -> s
133
134let rec process ?(dir = None) = function
135 | BinaryOp (op, e1, e2) -> BinaryOp (op, process ~dir e1, process ~dir e2)
136 | UnaryOp (op, e) -> UnaryOp (op, process ~dir e)
137 | Cond (e1, e2, e3) -> Cond (process ~dir e1, process ~dir e2, process ~dir e3)
138 | With (e1, e2) -> With (process ~dir e1, process ~dir e2)
139 | Assert (e1, e2) -> Assert (process ~dir e1, process ~dir e2)
140 | Test (e1, es) ->
141 Test (process ~dir e1, List.(simplify_path es >>| process ~dir))
142 | SetLet bs -> SetLet (process_bnds ~dir bs)
143 | Let (bs, e) -> Let (process_bnds ~dir bs, process ~dir e)
144 | Val v -> Val (process_val ~dir v)
145 | Id x -> Id x
146 | Select (e, es, me) ->
147 Select
148 ( process ~dir e,
149 List.(simplify_path es >>| process ~dir),
150 Option.(me >>| process ~dir) )
151 | Apply (e1, e2) -> Apply (process ~dir e1, process ~dir e2)
152 | Aquote e -> Aquote (process ~dir e)
153
154and process_val ~dir = function
155 | Str (s, ess) -> Str (s, List.(ess >>| fun (e, s) -> (process ~dir e, s)))
156 | IStr (n, s, ess) ->
157 let s' = drop_first_empty_line (unindent n s ~skip_first_line:false)
158 and ess' =
159 List.map ess ~f:(fun (e, s) ->
160 (process ~dir e, unindent n s ~skip_first_line:true))
161 in
162 Str (s', ess')
163 | Lambda (p, e) -> Lambda (process_pattern ~dir p, process ~dir e)
164 | List es -> List List.(es >>| process ~dir)
165 | AttSet (r, bs) -> AttSet (r, process_bnds ~dir bs)
166 | Path p -> (
167 if Filename.is_absolute p then Str (p, [])
168 else
169 match dir with
170 | Some dir when Filename.is_absolute dir ->
171 Str (Filename.concat dir p, [])
172 | Some _ ->
173 raise
174 (ElaborateError "Provided directory should be an absolute path")
175 | None -> raise (ElaborateError "Do not know how to resolve path"))
176 | v -> v
177
178and process_bnds ~dir bs =
179 bs
180 |> List.map ~f:(function
181 | AttrPath (es, e) ->
182 AttrPath (List.(es >>| process ~dir), process ~dir e)
183 | Inherit (me, xs) ->
184 Inherit (Option.(me >>| process ~dir), process_inherit_ids xs))
185 |> simplify_bnd_paths
186 |> List.fold ~init:[] ~f:(fun bs' bnd ->
187 match bnd with
188 | AttrPath (path, e) -> insert bs' path e
189 | Inherit (from, es) -> insert_inherit bs' from es)
190
191and process_inherit_ids =
192 List.map ~f:(function
193 | Id x | Val (Str (x, [])) | Aquote (Val (Str (x, []))) -> Id x
194 | _ -> raise (ElaborateError "Unexpected expression in inherit"))
195
196and process_pattern ~dir = function
197 | Alias x -> Alias x
198 | ParamSet (mx, (ps, k)) -> ParamSet (mx, (process_param_set ~dir mx ps, k))
199
200and process_param_set ~dir ?(seen = String.Set.empty) mx ps =
201 match ps with
202 | [] -> []
203 | (y, me) :: ps' ->
204 if Set.mem seen y || Option.mem mx y ~equal:String.( = ) then
205 raise (ElaborateError "Duplicated function argument")
206 else
207 (y, Option.(me >>| process ~dir))
208 :: process_param_set ~dir mx ps' ~seen:(Set.add seen y)
diff --git a/lib/nix/lexer.mll b/lib/nix/lexer.mll
new file mode 100644
index 0000000..023d888
--- /dev/null
+++ b/lib/nix/lexer.mll
@@ -0,0 +1,315 @@
1{
2open Core
3open Tokens
4
5exception Error of string
6
7(* Types of curly braces.
8 AQUOTE corresponds to the braces for antiquotation, i.e. '${...}'
9 and SET to an attribute set '{...}'.
10 *)
11type braces =
12 | AQUOTE
13 | SET
14
15let print_stack s =
16 let b = Buffer.create 100 in
17 Buffer.add_string b "[ ";
18 List.iter s ~f:(function
19 | AQUOTE -> Buffer.add_string b "AQUOTE; "
20 | SET -> Buffer.add_string b "SET; "
21 );
22 Buffer.add_string b "]";
23 Buffer.contents b
24
25let token_of_str state buf =
26 match state with
27 | `Start -> STR_START (Buffer.contents buf)
28 | `Mid -> STR_MID (Buffer.contents buf)
29
30let token_of_istr state buf =
31 match state with
32 | `Start -> ISTR_START (Buffer.contents buf)
33 | `Mid -> ISTR_MID (Buffer.contents buf)
34
35(* lookup table for one-character tokens *)
36let char_table = Array.create ~len:94 EOF
37let _ =
38 List.iter ~f:(fun (k, v) -> Array.set char_table ((int_of_char k) - 1) v)
39 [
40 '.', SELECT;
41 '?', QMARK;
42 '!', NOT;
43 '=', ASSIGN;
44 '<', LT;
45 '>', GT;
46 '[', LBRACK;
47 ']', RBRACK;
48 '+', PLUS;
49 '-', MINUS;
50 '*', TIMES;
51 '/', SLASH;
52 '(', LPAREN;
53 ')', RPAREN;
54 ':', COLON;
55 ';', SEMICOLON;
56 ',', COMMA;
57 '@', AS
58 ]
59
60(* lookup table for two- and three-character tokens *)
61let str_table = Hashtbl.create (module String) ~size:10
62let _ =
63 List.iter ~f:(fun (kwd, tok) -> Hashtbl.set str_table ~key:kwd ~data:tok)
64 [
65 "//", MERGE;
66 "++", CONCAT;
67 "<=", LTE;
68 ">=", GTE;
69 "==", EQ;
70 "!=", NEQ;
71 "&&", AND;
72 "||", OR;
73 "->", IMPL;
74 "...", ELLIPSIS
75 ]
76
77(* lookup table for keywords *)
78let keyword_table = Hashtbl.create (module String) ~size:10
79let _ =
80 List.iter ~f:(fun (kwd, tok) -> Hashtbl.set keyword_table ~key:kwd ~data:tok)
81 [ "with", WITH;
82 "rec", REC;
83 "let", LET;
84 "in", IN;
85 "inherit", INHERIT;
86 "if" , IF;
87 "then", THEN;
88 "else", ELSE;
89 "assert", ASSERT;
90 "or", ORDEF ]
91
92(* replace an escape sequence by the corresponding character(s) *)
93let unescape = function
94 | "\\n" -> "\n"
95 | "\\r" -> "\r"
96 | "\\t" -> "\t"
97 | "\\\\" -> "\\"
98 | "\\${" -> "${"
99 | "''$" -> "$"
100 | "$$" -> "$"
101 | "'''" -> "''"
102 | "''\\t" -> "\t"
103 | "''\\r" -> "\r"
104 | "''\\n" -> "\n"
105 | x ->
106 failwith (Printf.sprintf "unescape unexpected arg %s" x)
107
108let collect_tokens lexer q lexbuf =
109 let stack = ref [] in
110 let queue = Stdlib.Queue.create () in
111 let rec go () =
112 match (try Some (Stdlib.Queue.take queue) with Stdlib.Queue.Empty -> None) with
113 | Some token ->
114 (
115 match token, !stack with
116 | AQUOTE_CLOSE, [] ->
117 Stdlib.Queue.add AQUOTE_CLOSE q
118 | EOF, _ ->
119 Stdlib.Queue.add EOF q;
120 | _, _ ->
121 Stdlib.Queue.add token q;
122 go ()
123 )
124 | None ->
125 lexer queue stack lexbuf;
126 go ()
127 in
128 Stdlib.Queue.add AQUOTE_OPEN q;
129 stack := [AQUOTE];
130 lexer queue stack lexbuf;
131 go ()
132
133(* utility functions *)
134let print_position lexbuf =
135 let pos = Lexing.lexeme_start_p lexbuf in
136 Printf.sprintf "%s:%d:%d" pos.pos_fname
137 pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
138
139
140let set_filename fname (lexbuf: Lexing.lexbuf) =
141 let pos = lexbuf.lex_curr_p in
142 lexbuf.lex_curr_p <- { pos with pos_fname = fname }; lexbuf
143
144}
145
146let nzdigit = ['1'-'9']
147let digit = nzdigit | '0'
148let float = (nzdigit digit* '.' digit* | '0'? '.' digit+) (['E' 'e'] ['+' '-']? digit+)?
149let alpha = ['a'-'z' 'A'-'Z']
150let alpha_digit = alpha | digit
151let path_chr = alpha_digit | ['.' '_' '-' '+']
152let path = path_chr* ('/' path_chr+)+
153let spath = alpha_digit path_chr* ('/' path_chr+)*
154let uri_chr = ['%' '/' '?' ':' '@' '&' '=' '+' '$' ',' '-' '_' '.' '!' '~' '*' '\'']
155let scheme = alpha (alpha | ['+' '-' '.'])*
156let uri = scheme ':' (alpha_digit | uri_chr)+
157let char_tokens = ['.' '?' '!' '=' '<' '>' '[' ']' '+' '-' '*' '/' '^' '(' ')' ':' ';' ',' '@']
158
159rule get_tokens q s = parse
160(* skip whitespeces *)
161| [' ' '\t' '\r']
162 { get_tokens q s lexbuf }
163(* increase line count for new lines *)
164| '\n'
165 { Lexing.new_line lexbuf; get_tokens q s lexbuf }
166| char_tokens as c
167 { Stdlib.Queue.add (Array.get char_table ((int_of_char c) - 1)) q }
168| ("//" | "++" | "<=" | ">=" | "==" | "!=" | "&&" | "||" | "->" | "...") as s
169 { Stdlib.Queue.add (Hashtbl.find_exn str_table s) q}
170| digit+ as i
171 { Stdlib.Queue.add (INT i) q }
172| float
173 { Stdlib.Queue.add (FLOAT (Lexing.lexeme lexbuf)) q }
174| path
175 { Stdlib.Queue.add (PATH (Lexing.lexeme lexbuf)) q }
176| '<' (spath as p) '>'
177 { Stdlib.Queue.add (SPATH p) q }
178| '~' path as p
179 { Stdlib.Queue.add (HPATH p) q }
180| uri
181 { Stdlib.Queue.add(URI (Lexing.lexeme lexbuf)) q }
182(* keywords or identifiers *)
183| ((alpha | '_')+ (alpha_digit | ['_' '\'' '-'])*) as id
184 { Stdlib.Queue.add (Hashtbl.find keyword_table id |> Option.value ~default:(ID id)) q}
185(* comments *)
186| '#' ([^ '\n']* as c)
187 { ignore c; get_tokens q s lexbuf}
188| "/*"
189 { comment (Buffer.create 64) lexbuf;
190 get_tokens q s lexbuf
191 }
192(* the following three tokens change the braces stack *)
193| "${"
194 { Stdlib.Queue.add AQUOTE_OPEN q; s := AQUOTE :: !s }
195| '{'
196 { Stdlib.Queue.add LBRACE q; s := SET :: !s }
197| '}'
198 {
199 match !s with
200 | AQUOTE :: rest ->
201 Stdlib.Queue.add AQUOTE_CLOSE q; s := rest
202 | SET :: rest ->
203 Stdlib.Queue.add RBRACE q; s := rest
204 | _ ->
205 let pos = print_position lexbuf in
206 let err = Printf.sprintf "Unbalanced '}' at %s\n" pos in
207 raise (Error err)
208 }
209(* a double-quoted string *)
210| '"'
211 { string `Start (Buffer.create 64) q lexbuf }
212(* an indented string *)
213| "''" (' '+ as ws)
214 { istring `Start (Some (String.length ws)) (Buffer.create 64) q lexbuf }
215| "''"
216 { istring `Start None (Buffer.create 64) q lexbuf }
217(* End of input *)
218| eof
219 { Stdlib.Queue.add EOF q }
220(* any other character raises an exception *)
221| _
222 {
223 let pos = print_position lexbuf in
224 let tok = Lexing.lexeme lexbuf in
225 let err = Printf.sprintf "Unexpected character '%s' at %s\n" tok pos in
226 raise (Error err)
227 }
228
229(* Nix does not allow nested comments, but it is still handy to lex it
230 separately because we can properly increase line count. *)
231and comment buf = parse
232 | '\n'
233 {Lexing.new_line lexbuf; Buffer.add_char buf '\n'; comment buf lexbuf}
234 | "*/"
235 { () }
236 | _ as c
237 { Buffer.add_char buf c; comment buf lexbuf }
238
239and string state buf q = parse
240 | '"' (* terminate when we hit '"' *)
241 { Stdlib.Queue.add (token_of_str state buf) q; Stdlib.Queue.add STR_END q }
242 | '\n'
243 { Lexing.new_line lexbuf; Buffer.add_char buf '\n'; string state buf q lexbuf }
244 | ("\\n" | "\\r" | "\\t" | "\\\\" | "\\${") as s
245 { Buffer.add_string buf (unescape s); string state buf q lexbuf }
246 | "\\" (_ as c) (* add the character verbatim *)
247 { Buffer.add_char buf c; string state buf q lexbuf }
248 | "${" (* collect all the tokens till we hit the matching '}' *)
249 {
250 Stdlib.Queue.add (token_of_str state buf) q;
251 collect_tokens get_tokens q lexbuf;
252 string `Mid (Buffer.create 64) q lexbuf
253 }
254 | _ as c (* otherwise just add the character to the buffer *)
255 { Buffer.add_char buf c; string state buf q lexbuf }
256
257and istring state imin buf q = parse
258 | ('\n' ' '* "''")
259 {
260 Lexing.new_line lexbuf;
261 Buffer.add_string buf "\n";
262 let indent = match imin with | None -> 0 | Some i -> i in
263 Stdlib.Queue.add (token_of_istr state buf) q;
264 Stdlib.Queue.add (ISTR_END indent) q
265 }
266 | "''"
267 {
268 let indent = match imin with | None -> 0 | Some i -> i in
269 Stdlib.Queue.add (token_of_istr state buf) q;
270 Stdlib.Queue.add (ISTR_END indent) q
271 }
272 | ('\n' ' '* '\n') as s
273 {
274 Lexing.new_line lexbuf;
275 Lexing.new_line lexbuf;
276 Buffer.add_string buf s;
277 istring state imin buf q lexbuf
278 }
279 | ('\n' (' '* as ws)) as s
280 {
281 Lexing.new_line lexbuf;
282 Buffer.add_string buf s;
283 let ws_count = String.length ws in
284 match imin with
285 | None ->
286 istring state (Some ws_count) buf q lexbuf
287 | Some i ->
288 istring state (Some (min i ws_count)) buf q lexbuf
289 }
290 | ("''$" | "'''" | "''\\t" | "''\\r" | "''\\n") as s
291 { Buffer.add_string buf (unescape s); istring state imin buf q lexbuf }
292 | "''\\" (_ as c)
293 { Buffer.add_char buf c; istring state imin buf q lexbuf }
294 | "${"
295 {
296 Stdlib.Queue.add (token_of_istr state buf) q;
297 collect_tokens get_tokens q lexbuf;
298 istring `Mid imin (Buffer.create 64) q lexbuf
299 }
300 | _ as c
301 { Buffer.add_char buf c; istring state imin buf q lexbuf }
302{
303
304let rec next_token
305 (q: token Stdlib.Queue.t)
306 (s: braces list ref)
307 (lexbuf: Lexing.lexbuf)
308 : token =
309 match (try Some (Stdlib.Queue.take q) with | Stdlib.Queue.Empty -> None) with
310 | Some token ->
311 token
312 | None ->
313 get_tokens q s lexbuf;
314 next_token q s lexbuf
315}
diff --git a/lib/nix/nix.ml b/lib/nix/nix.ml
new file mode 100644
index 0000000..39dc94c
--- /dev/null
+++ b/lib/nix/nix.ml
@@ -0,0 +1,20 @@
1open Core
2module Ast = Types
3module Printer = Printer
4
5exception ParseError of string
6
7let parse ~filename (data : string) =
8 let lexbuf = Lexer.set_filename filename (Lexing.from_string data)
9 and q, s = (Stdlib.Queue.create (), ref []) in
10 try Parser.main (Lexer.next_token q s) lexbuf with
11 | Lexer.Error msg ->
12 let msg' = String.rstrip msg in
13 raise (ParseError (sprintf "Lexing error: %s" msg'))
14 | Parser.Error ->
15 let msg = sprintf "Parse error at %s" (Lexer.print_position lexbuf) in
16 raise (ParseError msg)
17
18let elaborate = Elaborator.process
19
20exception ElaborateError = Elaborator.ElaborateError
diff --git a/lib/nix/parser.mly b/lib/nix/parser.mly
new file mode 100644
index 0000000..dc1638d
--- /dev/null
+++ b/lib/nix/parser.mly
@@ -0,0 +1,310 @@
1/* Tokens with data */
2%token <string> INT
3%token <string> FLOAT
4/* A path */
5%token <string> PATH
6/* Search path, enclosed in <> */
7%token <string> SPATH
8/* Home path, starts with ~ */
9%token <string> HPATH
10%token <string> URI
11%token <string> STR_START
12%token <string> STR_MID
13%token STR_END
14%token <string> ISTR_START
15%token <string> ISTR_MID
16%token <int> ISTR_END
17%token <string> ID
18/* Tokens that stand for themselves */
19%token SELECT "."
20%token QMARK "?"
21%token CONCAT "++"
22%token NOT "!"
23%token MERGE "//"
24%token ASSIGN "="
25%token LT "<"
26%token LTE "<="
27%token GT ">"
28%token GTE ">="
29%token EQ "=="
30%token NEQ "!="
31%token AND "&&"
32%token OR "||"
33%token IMPL "->"
34%token AQUOTE_OPEN "${"
35%token AQUOTE_CLOSE "}$"
36%token LBRACE "{"
37%token RBRACE "}"
38%token LBRACK "["
39%token RBRACK "]"
40%token PLUS "+"
41%token MINUS "-"
42%token TIMES "*"
43%token SLASH "/"
44%token LPAREN "("
45%token RPAREN ")"
46%token COLON ":"
47%token SEMICOLON ";"
48%token COMMA ","
49%token ELLIPSIS "..."
50%token AS "@"
51/* Keywords */
52%token WITH "with"
53%token REC "rec"
54%token LET "let"
55%token IN "in"
56%token INHERIT "inherit"
57%token IF "if"
58%token THEN "then"
59%token ELSE "else"
60%token ASSERT "assert"
61%token ORDEF "or"
62
63/* End of input */
64%token EOF
65
66%{
67 open Types
68%}
69
70%start <Types.expr> main
71
72%%
73
74main:
75| e = expr0 EOF
76 { e }
77
78expr0:
79| "if"; e1 = expr0; "then"; e2 = expr0; "else"; e3 = expr0
80 { Cond (e1, e2, e3) }
81| "with"; e1 = expr0; ";"; e2 = expr0
82 { With (e1, e2) }
83| "assert"; e1 = expr0; ";"; e2 = expr0
84 { Assert (e1, e2) }
85| "let"; xs = delimited("{", list(binding), "}")
86 { SetLet xs }
87| "let"; xs = list(binding); "in"; e = expr0
88 { Let (xs, e) }
89| l = lambda
90 { Val l }
91| e = expr1
92 { e }
93
94/* Rules expr1-expr14 are almost direct translation of the operator
95 precedence table:
96 https://nixos.org/nix/manual/#sec-language-operators */
97
98%inline binary_expr(Lhs, Op, Rhs):
99| lhs = Lhs; op = Op; rhs = Rhs
100 { BinaryOp (op, lhs, rhs) }
101
102expr1:
103| e = binary_expr(expr2, "->" {Impl}, expr1)
104| e = expr2
105 { e }
106
107expr2:
108| e = binary_expr(expr2, "||" {Or}, expr3)
109| e = expr3
110 { e }
111
112expr3:
113| e = binary_expr(expr3, "&&" {And}, expr4)
114| e = expr4
115 { e }
116
117%inline expr4_ops:
118| "==" { Eq }
119| "!=" { Neq }
120
121expr4:
122| e = binary_expr(expr5, expr4_ops, expr5)
123| e = expr5
124 { e }
125
126%inline expr5_ops:
127| "<" { Lt }
128| ">" { Gt }
129| "<=" { Lte }
130| ">=" { Gte }
131
132expr5:
133| e = binary_expr(expr6, expr5_ops, expr6)
134| e = expr6
135 { e }
136
137expr6:
138| e = binary_expr(expr7, "//" {Merge}, expr6)
139| e = expr7
140 { e }
141
142expr7:
143| e = preceded("!", expr7)
144 { UnaryOp (Not, e) }
145| e = expr8
146 { e }
147
148%inline expr8_ops:
149| "+" { Plus }
150| "-" { Minus }
151
152expr8:
153| e = binary_expr(expr8, expr8_ops, expr9)
154| e = expr9
155 { e }
156
157%inline expr9_ops:
158| "*" { Mult }
159| "/" { Div }
160
161expr9:
162| e = binary_expr(expr9, expr9_ops, expr10)
163| e = expr10
164 { e }
165
166expr10:
167| e = binary_expr(expr11, "++" {Concat}, expr10)
168| e = expr11
169 { e }
170
171expr11:
172| e = expr12 "?" p = attr_path
173 { Test (e, p) }
174| e = expr12
175 { e }
176
177expr12:
178| e = preceded("-", expr13)
179 { UnaryOp (Negate, e) }
180| e = expr13
181 { e }
182
183expr13:
184| f = expr13; arg = expr14
185 { Apply (f, arg) }
186| e = expr14
187 { e }
188
189%inline selectable:
190| s = set
191 { Val s }
192| id = ID
193 { Id id }
194| e = delimited("(", expr0, ")")
195 { e }
196
197expr14:
198| e = selectable; "."; p = attr_path; o = option(preceded("or", expr14))
199 { Select (e, p, o) }
200| e = atomic_expr; "or"
201 { Apply (e, Id "or") }
202| e = atomic_expr
203 { e }
204
205atomic_expr:
206| id = ID
207 { Id id }
208| v = value
209 { Val v }
210| e = delimited("(", expr0, ")")
211 { e }
212
213attr_path:
214| p = separated_nonempty_list(".", attr_path_component)
215 { p }
216
217attr_path_component:
218| "or"
219 { Id "or" }
220| id = ID
221 { Id id }
222| e = delimited("${", expr0, "}$")
223 { Aquote e }
224| s = str
225 { Val s }
226
227value:
228| s = str
229 { s }
230| s = istr
231 { s }
232| i = INT
233 {Int i}
234| f = FLOAT
235 { Float f }
236| p = PATH
237 { Path p }
238| sp = SPATH
239 { SPath sp }
240| hp = HPATH
241 { HPath hp }
242| uri = URI
243 { Uri uri }
244| l = nixlist
245 { l }
246| s = set
247 { s }
248
249%inline str_mid(X):
250| xs = list(pair(delimited("${", expr0, "}$"), X)) { xs }
251
252/* Double-quoted string */
253str:
254| start = STR_START; mids = str_mid(STR_MID); STR_END
255 { Str (start, mids) }
256
257/* Indented string */
258istr:
259| start = ISTR_START; mids = str_mid(ISTR_MID); i = ISTR_END
260 { IStr (i, start, mids) }
261
262/* Lists and sets */
263nixlist:
264| xs = delimited("[", list(expr14), "]")
265 { List xs }
266
267empty_set:
268| "{"; "}" {}
269
270set:
271| empty_set
272 { AttSet (Nonrec, []) }
273| xs = delimited("{", nonempty_list(binding), "}")
274 { AttSet (Nonrec, xs) }
275| xs = preceded("rec", delimited("{", list(binding), "}"))
276 { AttSet (Rec, xs) }
277
278binding:
279| kv = terminated(separated_pair(attr_path, "=", expr0), ";")
280 { let (k, v) = kv in AttrPath (k, v) }
281| xs = delimited("inherit", pair(option(delimited("(", expr0, ")")), list(attr_path_component)), ";")
282 { let (prefix, ids) = xs in Inherit (prefix, ids) }
283
284lambda:
285| id = ID; "@"; p = param_set; ":"; e = expr0
286 { Lambda (ParamSet (Some id, p), e) }
287| p = param_set; "@"; id = ID; ":"; e = expr0
288 { Lambda (ParamSet (Some id, p), e) }
289| p = param_set; ":"; e = expr0
290 { Lambda (ParamSet (None, p), e) }
291| id = ID; ":"; e = expr0
292 { Lambda (Alias id, e) }
293
294%inline param_set:
295| empty_set
296 { ([], Exact) }
297| "{"; "..."; "}"
298 { ([], Loose) }
299| ps = delimited("{", pair(pair(params, ","?), boption("...")), "}")
300 { let ((ps, _), ellipsis) = ps in (ps, if ellipsis then Loose else Exact) }
301
302params:
303| p = param
304 { [p] }
305| ps = params; ","; p = param
306 { ps @ [p] }
307
308%inline param:
309p = pair(ID, option(preceded("?", expr0)))
310 { p }
diff --git a/lib/nix/printer.ml b/lib/nix/printer.ml
new file mode 100644
index 0000000..57e81f4
--- /dev/null
+++ b/lib/nix/printer.ml
@@ -0,0 +1,176 @@
1open Core
2open Types
3open PPrint
4
5let rec escape_chlist = function
6 | [] -> []
7 | '$' :: '{' :: l' -> '\\' :: '$' :: '{' :: escape_chlist l'
8 | '\n' :: l' -> '\\' :: 'n' :: escape_chlist l'
9 | '\r' :: l' -> '\\' :: 'r' :: escape_chlist l'
10 | '\t' :: l' -> '\\' :: 't' :: escape_chlist l'
11 | '\\' :: l' -> '\\' :: '\\' :: escape_chlist l'
12 | '"' :: l' -> '\\' :: '"' :: escape_chlist l'
13 | c :: l' -> c :: escape_chlist l'
14
15let escape_string s = s |> String.to_list |> escape_chlist |> String.of_list
16let out_width = ref 80
17let set_width i = out_width := i
18let indent = ref 2
19let set_indent i = indent := i
20
21let rec doc_of_expr = function
22 | BinaryOp (op, lhs, rhs) ->
23 let lhs_doc = maybe_parens_bop op `Left lhs
24 and rhs_doc = maybe_parens_bop op `Right rhs in
25 infix !indent 1 (doc_of_bop op) lhs_doc rhs_doc
26 | UnaryOp (op, e) -> precede (doc_of_uop op) (maybe_parens (prec_of_uop op) e)
27 | Cond (e1, e2, e3) ->
28 surround !indent 1
29 (soft_surround !indent 1 (string "if") (doc_of_expr e1) (string "then"))
30 (doc_of_expr e2)
31 (string "else" ^^ nest !indent (break 1 ^^ doc_of_expr e3))
32 | With (e1, e2) ->
33 flow (break 1) [ string "with"; doc_of_expr e1 ^^ semi; doc_of_expr e2 ]
34 | Assert (e1, e2) ->
35 flow (break 1) [ string "assert"; doc_of_expr e1 ^^ semi; doc_of_expr e2 ]
36 | Test (e, path) ->
37 maybe_parens 4 e ^^ space ^^ string "?"
38 ^^ group (break 1 ^^ separate_map dot doc_of_expr path)
39 | SetLet bs ->
40 surround !indent 1
41 (string "let " ^^ lbrace)
42 (group (separate_map (break 1) doc_of_binding bs))
43 rbrace
44 | Let (bs, e) ->
45 surround !indent 1 (string "let")
46 (separate_map (break 1) doc_of_binding bs)
47 (prefix !indent 1 (string "in") (doc_of_expr e))
48 | Val v -> doc_of_val v
49 | Id id -> string id
50 | Select (e, path, oe) ->
51 maybe_parens 1 e ^^ dot ^^ doc_of_attpath path
52 ^^ optional
53 (fun e ->
54 space ^^ string "or" ^^ nest !indent (break 1 ^^ maybe_parens 1 e))
55 oe
56 | Apply (e1, e2) -> prefix !indent 1 (maybe_parens 2 e1) (maybe_parens 2 e2)
57 | Aquote e -> surround !indent 0 (string "${") (doc_of_expr e) (string "}")
58
59and maybe_parens lvl e =
60 if prec_of_expr e >= lvl then surround !indent 0 lparen (doc_of_expr e) rparen
61 else doc_of_expr e
62
63and maybe_parens_bop op (loc : [ `Left | `Right ]) e =
64 match (loc, assoc_of_bop op) with
65 | (`Left, Some Left | `Right, Some Right)
66 when prec_of_expr e >= prec_of_bop op ->
67 doc_of_expr e
68 | _, _ -> maybe_parens (prec_of_bop op) e
69
70and doc_of_attpath path = separate_map dot doc_of_expr path
71
72and doc_of_paramset (params, kind) =
73 let ps =
74 List.map ~f:doc_of_param params
75 @ if Poly.(kind = Loose) then [ string "..." ] else []
76 in
77 surround !indent 0 lbrace (separate (comma ^^ break 1) ps) rbrace
78
79and doc_of_param (id, oe) =
80 string id ^^ optional (fun e -> qmark ^^ space ^^ doc_of_expr e) oe
81
82and doc_of_binding = function
83 | AttrPath (path, e) ->
84 doc_of_attpath path ^^ space ^^ equals ^^ space ^^ doc_of_expr e ^^ semi
85 | Inherit (oe, ids) ->
86 let id_docs =
87 List.map
88 ~f:(function
89 | Id x | Val (Str (x, [])) -> string x | _ -> assert false)
90 ids
91 in
92 let xs =
93 flow (break 1)
94 (match oe with
95 | Some e -> parens (doc_of_expr e) :: id_docs
96 | None -> id_docs)
97 in
98 soft_surround !indent 0 (string "inherit" ^^ space) xs semi
99
100and doc_of_bop = function
101 | Plus -> plus
102 | Minus -> minus
103 | Mult -> star
104 | Div -> slash
105 | Gt -> rangle
106 | Lt -> langle
107 | Lte -> string "<="
108 | Gte -> string ">="
109 | Eq -> string "=="
110 | Neq -> string "!="
111 | Or -> string "||"
112 | And -> string "&&"
113 | Impl -> string "->"
114 | Merge -> string "//"
115 | Concat -> string "++"
116
117and doc_of_uop = function Negate -> minus | Not -> bang
118
119and doc_of_val = function
120 | Str (start, xs) ->
121 dquotes
122 (string (escape_string start)
123 ^^ concat
124 (List.map
125 ~f:(fun (e, s) ->
126 surround !indent 0 (string "${") (doc_of_expr e)
127 (string "}" ^^ string (escape_string s)))
128 xs))
129 | IStr (i, start, xs) ->
130 let qq = string "''" in
131 let str s =
132 String.split ~on:'\n' s
133 |> List.map ~f:(fun s ->
134 let len = String.length s in
135 let s' =
136 if len >= i then String.sub s ~pos:i ~len:(len - i) else s
137 in
138 string s')
139 |> separate hardline
140 in
141 enclose qq qq
142 (str start
143 ^^ concat
144 (List.map
145 ~f:(fun (e, s) ->
146 enclose (string "${") rbrace (doc_of_expr e) ^^ str s)
147 xs))
148 | Int x | Float x | Path x | SPath x | HPath x | Uri x -> string x
149 | Lambda (pattern, body) ->
150 let pat =
151 match pattern with
152 | Alias id -> string id
153 | ParamSet (None, ps) -> doc_of_paramset ps
154 | ParamSet (Some id, ps) ->
155 doc_of_paramset ps ^^ group (break 1 ^^ at ^^ break 1 ^^ string id)
156 in
157 flow (break 1) [ pat ^^ colon; doc_of_expr body ]
158 | List [] -> lbracket ^^ space ^^ rbracket
159 | List es ->
160 surround !indent 1 lbracket
161 (separate_map (break 1) (maybe_parens 2) es)
162 rbracket
163 | AttSet (Nonrec, []) -> lbrace ^^ space ^^ rbrace
164 | AttSet (Nonrec, bs) ->
165 surround !indent 1 lbrace
166 (group (separate_map (break 1) doc_of_binding bs))
167 rbrace
168 | AttSet (Rec, bs) ->
169 string "rec" ^^ space ^^ doc_of_val (AttSet (Nonrec, bs))
170
171let print chan expr = ToChannel.pretty 0.7 !out_width chan (doc_of_expr expr)
172
173let to_string expr =
174 let buf = Stdlib.Buffer.create 0 in
175 ToBuffer.pretty 0.7 !out_width buf (doc_of_expr expr);
176 Stdlib.Buffer.contents buf
diff --git a/lib/nix/tokens.ml b/lib/nix/tokens.ml
new file mode 100644
index 0000000..4891d48
--- /dev/null
+++ b/lib/nix/tokens.ml
@@ -0,0 +1,64 @@
1type token =
2 (* Tokens with data *)
3 | INT of string
4 | FLOAT of string
5 (* A path (starting with / or ./) *)
6 | PATH of string
7 (* Search path, enclosed in < and > *)
8 | SPATH of string
9 (* Home path, starting with ~/ *)
10 | HPATH of string
11 | URI of string
12 | STR_START of string
13 | STR_MID of string
14 | STR_END
15 | ISTR_START of string
16 | ISTR_MID of string
17 | ISTR_END of int
18 | ID of string
19 (* Tokens that stand for themselves *)
20 | SELECT
21 | QMARK
22 | CONCAT
23 | NOT
24 | MERGE
25 | ASSIGN
26 | LT
27 | LTE
28 | GT
29 | GTE
30 | EQ
31 | NEQ
32 | AND
33 | OR
34 | IMPL
35 | AQUOTE_OPEN
36 | AQUOTE_CLOSE
37 | LBRACE
38 | RBRACE
39 | LBRACK
40 | RBRACK
41 | PLUS
42 | MINUS
43 | TIMES
44 | SLASH
45 | LPAREN
46 | RPAREN
47 | COLON
48 | SEMICOLON
49 | COMMA
50 | ELLIPSIS
51 | AS
52 (* Keywords *)
53 | WITH
54 | REC
55 | LET
56 | IN
57 | INHERIT
58 | IF
59 | THEN
60 | ELSE
61 | ASSERT
62 | ORDEF
63 (* End of input *)
64 | EOF
diff --git a/lib/nix/types.ml b/lib/nix/types.ml
new file mode 100644
index 0000000..8245406
--- /dev/null
+++ b/lib/nix/types.ml
@@ -0,0 +1,112 @@
1open Core
2
3(* Binary operators *)
4type binary_op =
5 | Plus
6 | Minus
7 | Mult
8 | Div
9 | Gt
10 | Lt
11 | Lte
12 | Gte
13 | Eq
14 | Neq
15 | Or
16 | And
17 | Impl
18 | Merge
19 | Concat
20[@@deriving sexp_of]
21
22(* Unary operators *)
23type unary_op = Negate | Not [@@deriving sexp_of]
24
25(* The top-level expression type *)
26type expr =
27 | BinaryOp of binary_op * expr * expr
28 | UnaryOp of unary_op * expr
29 | Cond of expr * expr * expr
30 | With of expr * expr
31 | Assert of expr * expr
32 | Test of expr * expr list
33 | SetLet of binding list
34 | Let of binding list * expr
35 | Val of value
36 | Id of id
37 | Select of expr * expr list * expr option
38 | Apply of expr * expr
39 | Aquote of expr
40[@@deriving sexp_of]
41
42(* Possible values *)
43and value =
44 (* Str is a string start, followed by arbitrary number of antiquotations and
45 strings that separate them *)
46 | Str of string * (expr * string) list
47 (* IStr is an indented string, so it has the extra integer component which
48 indicates the indentation *)
49 | IStr of int * string * (expr * string) list
50 | Int of string
51 | Float of string
52 | Path of string
53 | SPath of string
54 | HPath of string
55 | Uri of string
56 | Lambda of pattern * expr
57 | List of expr list
58 | AttSet of recursivity * binding list
59[@@deriving sexp_of]
60
61(* Patterns in lambda definitions *)
62and pattern = Alias of id | ParamSet of id option * param_set
63[@@deriving sexp_of]
64
65and param_set = param list * match_kind [@@deriving sexp_of]
66and param = id * expr option [@@deriving sexp_of]
67and recursivity = Rec | Nonrec
68and match_kind = Exact | Loose
69
70(* Bindings in attribute sets and let expressions *)
71and binding =
72 (* The first expr should be attrpath, which is the same as in Select *)
73 | AttrPath of expr list * expr
74 | Inherit of expr option * expr list
75[@@deriving sexp_of]
76
77(* Identifiers *)
78and id = string
79
80(* Precedence levels of binary operators *)
81let prec_of_bop = function
82 | Concat -> 5
83 | Mult | Div -> 6
84 | Plus | Minus -> 7
85 | Merge -> 9
86 | Gt | Lt | Lte | Gte -> 10
87 | Eq | Neq -> 11
88 | And -> 12
89 | Or -> 13
90 | Impl -> 14
91
92type assoc = Left | Right
93
94let assoc_of_bop = function
95 | Mult | Div | Plus | Minus -> Some Left
96 | Concat | Merge | And | Or -> Some Right
97 | Gt | Lt | Lte | Gte | Eq | Neq | Impl -> None
98
99(* Precedence levels of unary operators *)
100let prec_of_uop = function Negate -> 3 | Not -> 8
101
102(* Precedence level of expressions
103 (assuming that the constituents have higher levels) *)
104let prec_of_expr = function
105 | Val (Lambda _) -> 15
106 | Val _ | Id _ | Aquote _ -> 0
107 | BinaryOp (op, _, _) -> prec_of_bop op
108 | UnaryOp (op, _) -> prec_of_uop op
109 | Cond _ | With _ | Assert _ | Let _ | SetLet _ -> 15
110 | Test _ -> 4
111 | Select _ -> 1
112 | Apply _ -> 2
diff --git a/mininix.opam b/mininix.opam
new file mode 100644
index 0000000..f28f0cb
--- /dev/null
+++ b/mininix.opam
@@ -0,0 +1,39 @@
1# This file is generated by dune, edit dune-project instead
2opam-version: "2.0"
3authors: ["Anonymous Authors"]
4license: "LICENSE"
5depends: [
6 "dune" {>= "3.15"}
7 "ocaml" {< "5"}
8 "coq" {>= "8.20" & < "8.21"}
9 "coq-stdpp" {>= "1.11" & < "1.12"}
10 "coq-flocq"
11 "core"
12 "core_unix"
13 "linenoise"
14 "menhir"
15 "pprint"
16 "sexp_pretty"
17 "stdio"
18 "ppx_sexp_conv"
19 "ppx_blob"
20 "ppx_let"
21 "bisect_ppx"
22 "merlin" {dev}
23 "ocamlformat" {dev}
24 "odoc" {with-doc}
25]
26build: [
27 ["dune" "subst"] {dev}
28 [
29 "dune"
30 "build"
31 "-p"
32 name
33 "-j"
34 jobs
35 "@install"
36 "@runtest" {with-test}
37 "@doc" {with-doc}
38 ]
39]
diff --git a/mininix.opam.locked b/mininix.opam.locked
new file mode 100644
index 0000000..3cabd84
--- /dev/null
+++ b/mininix.opam.locked
@@ -0,0 +1,131 @@
1opam-version: "2.0"
2name: "mininix"
3version: "dev"
4authors: "Anonymous Authors"
5license: "LICENSE"
6depends: [
7 "astring" {= "0.8.5" & with-doc}
8 "base" {= "v0.16.3"}
9 "base-bigarray" {= "base"}
10 "base-threads" {= "base"}
11 "base-unix" {= "base"}
12 "base_bigstring" {= "v0.16.0"}
13 "base_quickcheck" {= "v0.16.0"}
14 "bin_prot" {= "v0.16.0"}
15 "bisect_ppx" {= "2.8.3"}
16 "camlp-streams" {= "5.0.1" & with-doc}
17 "cmdliner" {= "1.3.0"}
18 "conf-bash" {= "1"}
19 "conf-g++" {= "1.0"}
20 "conf-gmp" {= "4"}
21 "conf-linux-libc-dev" {= "0"}
22 "conf-pkg-config" {= "4"}
23 "coq" {= "8.20.1"}
24 "coq-core" {= "8.20.1"}
25 "coq-flocq" {= "4.2.0"}
26 "coq-stdlib" {= "8.20.1"}
27 "coq-stdpp" {= "1.11.0"}
28 "coqide-server" {= "8.20.1"}
29 "core" {= "v0.16.2"}
30 "core_kernel" {= "v0.16.0"}
31 "core_unix" {= "v0.16.0"}
32 "cppo" {= "1.8.0" & with-doc}
33 "crunch" {= "3.3.1" & with-doc}
34 "csexp" {= "1.5.2"}
35 "dune" {= "3.17.2"}
36 "dune-configurator" {= "3.17.2"}
37 "expect_test_helpers_core" {= "v0.16.0"}
38 "fieldslib" {= "v0.16.0"}
39 "fmt" {= "0.9.0" & with-doc}
40 "fpath" {= "0.7.3" & with-doc}
41 "int_repr" {= "v0.16.0"}
42 "jane-street-headers" {= "v0.16.0"}
43 "jst-config" {= "v0.16.0"}
44 "linenoise" {= "1.5.1"}
45 "menhir" {= "20240715"}
46 "menhirCST" {= "20240715"}
47 "menhirLib" {= "20240715"}
48 "menhirSdk" {= "20240715"}
49 "num" {= "1.5-1"}
50 "ocaml" {= "4.14.2"}
51 "ocaml-base-compiler" {= "4.14.2"}
52 "ocaml-compiler-libs" {= "v0.12.4"}
53 "ocaml-config" {= "2"}
54 "ocaml-options-vanilla" {= "1"}
55 "ocaml_intrinsics" {= "v0.16.1"}
56 "ocamlbuild" {= "0.15.0" & with-doc}
57 "ocamlfind" {= "1.9.6"}
58 "odoc" {= "2.4.4" & with-doc}
59 "odoc-parser" {= "2.4.4" & with-doc}
60 "parsexp" {= "v0.16.0"}
61 "pprint" {= "20230830"}
62 "ppx_assert" {= "v0.16.0"}
63 "ppx_base" {= "v0.16.0"}
64 "ppx_bench" {= "v0.16.0"}
65 "ppx_bin_prot" {= "v0.16.0"}
66 "ppx_blob" {= "0.9.0"}
67 "ppx_cold" {= "v0.16.0"}
68 "ppx_compare" {= "v0.16.0"}
69 "ppx_custom_printf" {= "v0.16.0"}
70 "ppx_derivers" {= "1.2.1"}
71 "ppx_disable_unused_warnings" {= "v0.16.0"}
72 "ppx_enumerate" {= "v0.16.0"}
73 "ppx_expect" {= "v0.16.1"}
74 "ppx_fields_conv" {= "v0.16.0"}
75 "ppx_fixed_literal" {= "v0.16.0"}
76 "ppx_globalize" {= "v0.16.0"}
77 "ppx_hash" {= "v0.16.0"}
78 "ppx_here" {= "v0.16.0"}
79 "ppx_ignore_instrumentation" {= "v0.16.0"}
80 "ppx_inline_test" {= "v0.16.1"}
81 "ppx_jane" {= "v0.16.0"}
82 "ppx_let" {= "v0.16.0"}
83 "ppx_log" {= "v0.16.0"}
84 "ppx_module_timer" {= "v0.16.0"}
85 "ppx_optcomp" {= "v0.16.0"}
86 "ppx_optional" {= "v0.16.0"}
87 "ppx_pipebang" {= "v0.16.0"}
88 "ppx_sexp_conv" {= "v0.16.0"}
89 "ppx_sexp_message" {= "v0.16.0"}
90 "ppx_sexp_value" {= "v0.16.0"}
91 "ppx_stable" {= "v0.16.0"}
92 "ppx_stable_witness" {= "v0.16.0"}
93 "ppx_string" {= "v0.16.0"}
94 "ppx_tydi" {= "v0.16.0"}
95 "ppx_typerep_conv" {= "v0.16.0"}
96 "ppx_variants_conv" {= "v0.16.0"}
97 "ppxlib" {= "0.34.0"}
98 "ptime" {= "1.2.0" & with-doc}
99 "re" {= "1.12.0"}
100 "result" {= "1.5" & with-doc}
101 "seq" {= "base"}
102 "sexp_pretty" {= "v0.16.0"}
103 "sexplib" {= "v0.16.0"}
104 "sexplib0" {= "v0.16.0"}
105 "spawn" {= "v0.17.0"}
106 "splittable_random" {= "v0.16.0"}
107 "stdio" {= "v0.16.0"}
108 "stdlib-shims" {= "0.3.0"}
109 "time_now" {= "v0.16.0"}
110 "timezone" {= "v0.16.0"}
111 "topkg" {= "1.0.7" & with-doc}
112 "typerep" {= "v0.16.0"}
113 "tyxml" {= "4.6.0" & with-doc}
114 "uutf" {= "1.0.3" & with-doc}
115 "variantslib" {= "v0.16.0"}
116 "zarith" {= "1.14"}
117]
118build: [
119 ["dune" "subst"] {dev}
120 [
121 "dune"
122 "build"
123 "-p"
124 name
125 "-j"
126 jobs
127 "@install"
128 "@runtest" {with-test}
129 "@doc" {with-doc}
130 ]
131] \ No newline at end of file
diff --git a/nixpkgs-pinned.nix b/nixpkgs-pinned.nix
new file mode 100644
index 0000000..00ca388
--- /dev/null
+++ b/nixpkgs-pinned.nix
@@ -0,0 +1,7 @@
1import (builtins.fetchTarball {
2 name = "nixos-25.05";
3 # Nixpkgs 25.05 at 2025-05-06 19:25 UTC
4 # Please keep in sync with the locked version for the flake
5 url = "https://github.com/NixOS/nixpkgs/archive/70c74b02eac46f4e4aa071e45a6189ce0f6d9265.tar.gz";
6 sha256 = "0b4jz58kkm7dbq6c6fmbgrh29smchhs6d96czhms7wddlni1m71p";
7})
diff --git a/shell.nix b/shell.nix
new file mode 100644
index 0000000..464969d
--- /dev/null
+++ b/shell.nix
@@ -0,0 +1,21 @@
1{ pkgs ? import ./nixpkgs-pinned.nix {} }:
2let ocamlPackages = pkgs.ocaml-ng.ocamlPackages_4_14; in
3pkgs.mkShell {
4 inputsFrom = [ (import ./coverage.nix { inherit pkgs; }) ];
5 buildInputs = with pkgs; [
6 bash
7 cloc
8 git
9 jq
10 tree
11 (python3.withPackages (pkgs: [ pkgs.pygments ]))
12 coqPackages_8_20.coq
13 coqPackages_8_20.coq-lsp
14 coqPackages_8_20.vscoq-language-server
15 ocamlPackages.ocaml-lsp
16 ocamlPackages.ocamlformat
17 ocamlPackages.odoc
18 ocamlPackages.utop
19 ocamlPackages.merlin
20 ];
21}
diff --git a/test/dune b/test/dune
new file mode 100644
index 0000000..8726c07
--- /dev/null
+++ b/test/dune
@@ -0,0 +1,7 @@
1(test
2 (name test_mininix)
3 (libraries core core_unix core_unix.filename_unix nix mininix)
4 (preprocess
5 (pps ppx_sexp_conv ppx_expect))
6 (deps
7 (glob_files_rec testdata/*.{nix,exp})))
diff --git a/test/test_mininix.ml b/test/test_mininix.ml
new file mode 100644
index 0000000..f628a8a
--- /dev/null
+++ b/test/test_mininix.ml
@@ -0,0 +1,319 @@
1open Core
2
3let with_dir path ~f =
4 let fd = Core_unix.opendir path in
5 f fd;
6 Core_unix.closedir fd
7
8let walk_dir path ~f =
9 with_dir path ~f:(fun fd ->
10 let rec go () =
11 match Core_unix.readdir_opt fd with
12 | Some entry ->
13 f (Filename.concat path entry);
14 go ()
15 | None -> ()
16 in
17 go ())
18
19type testcase = {
20 name : string;
21 dir : string;
22 input : string;
23 expected_output : [ `Okay of string | `Fail ];
24}
25
26let testdata_dir = "./testdata"
27and testcases = ref []
28and testcases_ignored = ref 0
29
30let add_testcase c = testcases := c :: !testcases
31
32let print_testcase_stats () =
33 let okay, fail =
34 List.fold !testcases ~init:(0, 0)
35 ~f:(fun (okay, fail) { expected_output; _ } ->
36 match expected_output with
37 | `Okay _ -> (okay + 1, fail)
38 | `Fail -> (okay, fail + 1))
39 in
40 printf
41 "Loaded %d test cases (ignored %d), expected results: okay %d, fail %d\n%!"
42 (okay + fail) !testcases_ignored okay fail
43
44let imports () =
45 Mininix.Import.materialize
46 [ { filename = "./testdata/lib.nix"; deps = [] } ]
47 ~relative_to:(Core_unix.getcwd ())
48
49type eval_err = [ `Timeout | `ParseError | `ProgramError | `ElaborateError ]
50[@@deriving sexp]
51
52type eval_result = (string, eval_err) Result.t [@@deriving sexp]
53
54let eval input ~name ~dir ~imports =
55 let dir = Filename.to_absolute_exn dir ~relative_to:(Core_unix.getcwd ()) in
56 try
57 input
58 |> Nix.parse ~filename:(name ^ ".nix")
59 |> Nix.elaborate ~dir:(Some dir)
60 |> Mininix.Nix2mininix.from_nix |> Mininix.apply_prelude
61 |> Mininix.interp_tl ~fuel:`Limited ~mode:`Deep ~imports
62 |> function
63 | Res (Some v) ->
64 Ok (v |> Mininix.Mininix2nix.from_val |> Nix.Printer.to_string)
65 | Res None -> Error `ProgramError
66 | NoFuel -> Error `Timeout
67 with
68 | Nix.ParseError _ -> Error `ParseError
69 | Nix.ElaborateError _ -> Error `ElaborateError
70 | Mininix.Nix2mininix.FromNixError _ -> Error `ElaborateError
71
72let eval_subproc input ~name ~dir ~imports =
73 let rxfd, txfd = Core_unix.pipe () in
74 match Core_unix.fork () with
75 | `In_the_child ->
76 let txc = Core_unix.out_channel_of_descr txfd in
77 eval input ~name ~dir ~imports
78 |> [%sexp_of: eval_result] |> Sexp.output txc;
79 exit 0
80 | `In_the_parent child_pid ->
81 let select_res =
82 Core_unix.select ~restart:true ~read:[ rxfd ] ~write:[] ~except:[]
83 ~timeout:(`After (Time_ns.Span.of_min 1.))
84 ()
85 in
86 if List.is_empty select_res.read then (
87 ignore (Signal_unix.send Signal.kill (`Pid child_pid));
88 ignore (Core_unix.waitpid child_pid);
89 Error `Timeout)
90 else
91 let rxc = Core_unix.in_channel_of_descr rxfd in
92 let res = Sexp.input_sexp rxc |> [%of_sexp: eval_result] in
93 ignore (Core_unix.waitpid child_pid);
94 Core_unix.close ~restart:true rxfd;
95 Core_unix.close ~restart:true txfd;
96 res
97
98type test_result =
99 [ `Timeout
100 | `ParseError
101 | `ProgramError
102 | `ElaborateError
103 | `WrongOutput
104 | `UnexpectedSuccess
105 | `Okay ]
106
107let run_testcase ~imports = function
108 | { name; dir; input; expected_output = `Okay expected_output } -> (
109 match eval_subproc input ~name ~dir ~imports with
110 | Ok got_output ->
111 if String.(strip got_output = strip expected_output) then `Okay
112 else `WrongOutput
113 | Error err -> (err :> test_result))
114 | { name; dir; input; expected_output = `Fail } -> (
115 match eval_subproc input ~name ~dir ~imports with
116 | Ok _ -> `UnexpectedSuccess
117 | Error _ -> `Okay)
118
119type test_stats = {
120 okay : int;
121 unexpected_success : int;
122 wrong_output : int;
123 parse_error : int;
124 elaborate_error : int;
125 program_error : int;
126 timeout : int;
127}
128
129let test_stats_empty =
130 {
131 okay = 0;
132 unexpected_success = 0;
133 wrong_output = 0;
134 parse_error = 0;
135 elaborate_error = 0;
136 program_error = 0;
137 timeout = 0;
138 }
139
140let run_testcases () =
141 Nix.Printer.set_width 1000000;
142 let mat_imports = imports () in
143 let stats =
144 List.foldi !testcases ~init:test_stats_empty ~f:(fun i stats c ->
145 printf "[%d/%d] %s %!" (i + 1) (List.length !testcases) c.name;
146 match run_testcase c ~imports:mat_imports with
147 | `Okay ->
148 printf "okay\n%!";
149 { stats with okay = stats.okay + 1 }
150 | `UnexpectedSuccess ->
151 printf "unexpectedly succeeded\n%!";
152 { stats with unexpected_success = stats.unexpected_success + 1 }
153 | `WrongOutput ->
154 printf "gave wrong output\n%!";
155 { stats with wrong_output = stats.wrong_output + 1 }
156 | `ParseError ->
157 printf "could not be parsed\n%!";
158 { stats with parse_error = stats.parse_error + 1 }
159 | `ElaborateError ->
160 printf "could not be elaborated\n%!";
161 { stats with elaborate_error = stats.elaborate_error + 1 }
162 | `ProgramError ->
163 printf "failed to execute\n%!";
164 { stats with program_error = stats.program_error + 1 }
165 | `Timeout ->
166 printf "timed out\n%!";
167 { stats with timeout = stats.timeout + 1 })
168 in
169 printf
170 "Results:\n\
171 \ %d gave the expected output\n\
172 \ %d unexpectedly succeeded\n\
173 \ %d gave wrong output\n\
174 \ %d could not be parsed\n\
175 \ %d could not be elaborated\n\
176 \ %d failed to execute\n\
177 \ %d timed out\n\
178 %!"
179 stats.okay stats.unexpected_success stats.wrong_output stats.parse_error
180 stats.elaborate_error stats.program_error stats.timeout
181
182let try_add_testcase without_ext =
183 try
184 let dir = Filename.dirname without_ext in
185 let input = In_channel.read_all (without_ext ^ ".nix") in
186 let name = Filename.basename without_ext in
187 if String.is_prefix ~prefix:"eval-fail" name then
188 add_testcase { name; dir; input; expected_output = `Fail }
189 else if String.is_prefix ~prefix:"eval-okay" name then
190 let expected_output = In_channel.read_all (without_ext ^ ".exp") in
191 add_testcase { name; dir; input; expected_output = `Okay expected_output }
192 with
193 (* There are certain test cases where the '.nix' file is available, but
194 there is no '.exp' file. (Instead, for example, there may be a
195 '.exp-disabled' file, which we don't check for.) So [add_testcase] fails
196 when trying to read the '.exp' file, which does not exist. We catch the
197 exception that is then raised in [add_testcase] here. *)
198 | Sys_error _ ->
199 ()
200
201let ignore_tests =
202 [
203 (* We do not implement '«repeated»' *)
204 "eval-okay-repeated-empty-attrs";
205 "eval-okay-repeated-empty-list";
206 (* # Very specific / hard-to-implement builtins: *)
207 (* We do not implement conversion from/to JSON/XML *)
208 "eval-okay-toxml";
209 "eval-okay-toxml2";
210 "eval-okay-tojson";
211 "eval-okay-fromTOML";
212 "eval-okay-fromTOML-timestamps";
213 "eval-okay-fromjson";
214 "eval-okay-fromjson-escapes";
215 "eval-fail-fromJSON-overflowing";
216 "eval-fail-fromTOML-timestamps";
217 "eval-fail-toJSON";
218 (* We do not implement hasing *)
219 "eval-okay-convertHash";
220 "eval-okay-hashstring";
221 "eval-okay-hashfile";
222 "eval-okay-groupBy";
223 "eval-okay-zipAttrsWith";
224 "eval-fail-hashfile-missing";
225 (* We do not support filesystem operations *)
226 "eval-okay-readDir";
227 "eval-okay-readfile";
228 "eval-okay-readFileType";
229 "eval-okay-symlink-resolution";
230 (* We do not support version operations *)
231 "eval-okay-splitversion";
232 "eval-okay-versions";
233 (* We do not support flake references *)
234 "eval-okay-parse-flake-ref";
235 "eval-okay-flake-ref-to-string";
236 "eval-fail-flake-ref-to-string-negative-integer";
237 (* We do not support regexes *)
238 "eval-okay-regex-match";
239 "eval-okay-regex-split";
240 (* # Features that the core interpreter lacks *)
241 (* We do not implement derivations and contexts *)
242 "eval-okay-derivation-legacy";
243 "eval-okay-eq-derivations";
244 "eval-fail-addDrvOutputDependencies-empty-context";
245 "eval-fail-addDrvOutputDependencies-multi-elem-context";
246 "eval-fail-addDrvOutputDependencies-wrong-element-kind";
247 "eval-fail-assert-equal-derivations";
248 "eval-fail-assert-equal-derivations-extra";
249 "eval-fail-derivation-name";
250 "eval-okay-context";
251 "eval-okay-context-introspection";
252 "eval-okay-substring-context";
253 "eval-fail-addErrorContext-example";
254 (* We do not support scopedImport *)
255 "eval-okay-import";
256 (* We do not support tryEval *)
257 "eval-okay-redefine-builtin";
258 "eval-okay-tryeval";
259 (* We do not support unsafeGetAttrPos nor __curPos *)
260 "eval-okay-curpos";
261 "eval-okay-getattrpos";
262 "eval-okay-getattrpos-functionargs";
263 "eval-okay-getattrpos-undefined";
264 "eval-okay-inherit-attr-pos";
265 (* We do not support environment variable lookup *)
266 "eval-okay-getenv";
267 (* We do not support '__override's. Rationale: this construct has expressly
268 been avoided in Nixpkgs since the 13.10 release, see
269 https://github.com/NixOS/nixpkgs/issues/2112 *)
270 "eval-okay-attrs6";
271 "eval-okay-overrides";
272 "eval-fail-set-override";
273 (* We do not implement the 'trace' builtin *)
274 "eval-okay-print";
275 "eval-okay-inherit-from";
276 (* ^ also uses __overrides, for which we lack support *)
277 (* We do not implement flags to set arguments / retrieve attributes
278 for the evaluator *)
279 (* We do not support setting variables outside of the program *)
280 "eval-okay-autoargs";
281 (* We do not support paths *)
282 "eval-okay-baseNameOf";
283 "eval-okay-path";
284 "eval-okay-path-string-interpolation";
285 "eval-okay-pathexists";
286 "eval-okay-search-path";
287 "eval-okay-string";
288 "eval-okay-types";
289 "eval-fail-assert-equal-paths";
290 "eval-fail-bad-string-interpolation-2";
291 "eval-fail-nonexist-path";
292 "eval-fail-path-slash";
293 "eval-fail-to-path";
294 (* We do not implement the 'currentSystem' and 'dirOf' builtins *)
295 "eval-okay-builtins";
296 (* We do not support fetch operations *)
297 "eval-fail-fetchTree-negative";
298 "eval-fail-fetchurl-baseName";
299 "eval-fail-fetchurl-baseName-attrs";
300 "eval-fail-fetchurl-baseName-attrs-name";
301 (* We do not support the pipe operator *)
302 "eval-fail-pipe-operators";
303 ]
304
305let () =
306 Printf.printf "Running in %s\n%!" (Core_unix.getcwd ());
307 walk_dir testdata_dir ~f:(fun entry ->
308 match Filename.split_extension entry with
309 | without_ext, Some "nix" ->
310 if
311 List.exists ignore_tests ~f:(fun name ->
312 String.(name = Filename.basename without_ext))
313 then testcases_ignored := !testcases_ignored + 1
314 else try_add_testcase without_ext
315 | _ -> ());
316 testcases :=
317 List.sort !testcases ~compare:(fun c1 c2 -> String.compare c1.name c2.name);
318 print_testcase_stats ();
319 run_testcases ()
diff --git a/test/testdata/binary-data b/test/testdata/binary-data
new file mode 100644
index 0000000..06d7405
--- /dev/null
+++ b/test/testdata/binary-data
Binary files differ
diff --git a/test/testdata/data b/test/testdata/data
new file mode 100644
index 0000000..257cc56
--- /dev/null
+++ b/test/testdata/data
@@ -0,0 +1 @@
foo
diff --git a/test/testdata/dir1/a.nix b/test/testdata/dir1/a.nix
new file mode 100644
index 0000000..231f150
--- /dev/null
+++ b/test/testdata/dir1/a.nix
@@ -0,0 +1 @@
"a"
diff --git a/test/testdata/dir2/a.nix b/test/testdata/dir2/a.nix
new file mode 100644
index 0000000..170df52
--- /dev/null
+++ b/test/testdata/dir2/a.nix
@@ -0,0 +1 @@
"X"
diff --git a/test/testdata/dir2/b.nix b/test/testdata/dir2/b.nix
new file mode 100644
index 0000000..19010cc
--- /dev/null
+++ b/test/testdata/dir2/b.nix
@@ -0,0 +1 @@
"b"
diff --git a/test/testdata/dir3/a.nix b/test/testdata/dir3/a.nix
new file mode 100644
index 0000000..170df52
--- /dev/null
+++ b/test/testdata/dir3/a.nix
@@ -0,0 +1 @@
"X"
diff --git a/test/testdata/dir3/b.nix b/test/testdata/dir3/b.nix
new file mode 100644
index 0000000..170df52
--- /dev/null
+++ b/test/testdata/dir3/b.nix
@@ -0,0 +1 @@
"X"
diff --git a/test/testdata/dir3/c.nix b/test/testdata/dir3/c.nix
new file mode 100644
index 0000000..cdf1585
--- /dev/null
+++ b/test/testdata/dir3/c.nix
@@ -0,0 +1 @@
"c"
diff --git a/test/testdata/dir4/a.nix b/test/testdata/dir4/a.nix
new file mode 100644
index 0000000..170df52
--- /dev/null
+++ b/test/testdata/dir4/a.nix
@@ -0,0 +1 @@
"X"
diff --git a/test/testdata/dir4/c.nix b/test/testdata/dir4/c.nix
new file mode 100644
index 0000000..170df52
--- /dev/null
+++ b/test/testdata/dir4/c.nix
@@ -0,0 +1 @@
"X"
diff --git a/test/testdata/eval-fail-abort.err.exp b/test/testdata/eval-fail-abort.err.exp
new file mode 100644
index 0000000..20e7b9e
--- /dev/null
+++ b/test/testdata/eval-fail-abort.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'abort' builtin
3 at /pwd/lang/eval-fail-abort.nix:1:14:
4 1| if true then abort "this should fail" else 1
5 | ^
6 2|
7
8 error: evaluation aborted with the following error message: 'this should fail'
diff --git a/test/testdata/eval-fail-abort.nix b/test/testdata/eval-fail-abort.nix
new file mode 100644
index 0000000..75c51bc
--- /dev/null
+++ b/test/testdata/eval-fail-abort.nix
@@ -0,0 +1 @@
if true then abort "this should fail" else 1
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.err.exp b/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.err.exp
new file mode 100644
index 0000000..37e0bd9
--- /dev/null
+++ b/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'addDrvOutputDependencies' builtin
3 at /pwd/lang/eval-fail-addDrvOutputDependencies-empty-context.nix:1:1:
4 1| builtins.addDrvOutputDependencies ""
5 | ^
6 2|
7
8 error: context of string '' must have exactly one element, but has 0
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.nix b/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.nix
new file mode 100644
index 0000000..dc9ee3b
--- /dev/null
+++ b/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.nix
@@ -0,0 +1 @@
builtins.addDrvOutputDependencies ""
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.err.exp b/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.err.exp
new file mode 100644
index 0000000..6828e03
--- /dev/null
+++ b/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.err.exp
@@ -0,0 +1,9 @@
1error:
2 … while calling the 'addDrvOutputDependencies' builtin
3 at /pwd/lang/eval-fail-addDrvOutputDependencies-multi-elem-context.nix:18:4:
4 17|
5 18| in builtins.addDrvOutputDependencies combo-path
6 | ^
7 19|
8
9 error: context of string '/nix/store/pg9yqs4yd85yhdm3f4i5dyaqp5jahrsz-fail.drv/nix/store/2dxd5frb715z451vbf7s8birlf3argbk-fail-2.drv' must have exactly one element, but has 2
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.nix b/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.nix
new file mode 100644
index 0000000..dbde264
--- /dev/null
+++ b/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.nix
@@ -0,0 +1,18 @@
1let
2 drv0 = derivation {
3 name = "fail";
4 builder = "/bin/false";
5 system = "x86_64-linux";
6 outputs = [ "out" "foo" ];
7 };
8
9 drv1 = derivation {
10 name = "fail-2";
11 builder = "/bin/false";
12 system = "x86_64-linux";
13 outputs = [ "out" "foo" ];
14 };
15
16 combo-path = "${drv0.drvPath}${drv1.drvPath}";
17
18in builtins.addDrvOutputDependencies combo-path
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.err.exp b/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.err.exp
new file mode 100644
index 0000000..72b5e63
--- /dev/null
+++ b/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.err.exp
@@ -0,0 +1,9 @@
1error:
2 … while calling the 'addDrvOutputDependencies' builtin
3 at /pwd/lang/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix:9:4:
4 8|
5 9| in builtins.addDrvOutputDependencies drv.outPath
6 | ^
7 10|
8
9 error: `addDrvOutputDependencies` can only act on derivations, not on a derivation output such as 'out'
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix b/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix
new file mode 100644
index 0000000..e379e1d
--- /dev/null
+++ b/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix
@@ -0,0 +1,9 @@
1let
2 drv = derivation {
3 name = "fail";
4 builder = "/bin/false";
5 system = "x86_64-linux";
6 outputs = [ "out" "foo" ];
7 };
8
9in builtins.addDrvOutputDependencies drv.outPath
diff --git a/test/testdata/eval-fail-addErrorContext-example.err.exp b/test/testdata/eval-fail-addErrorContext-example.err.exp
new file mode 100644
index 0000000..4fad8f5
--- /dev/null
+++ b/test/testdata/eval-fail-addErrorContext-example.err.exp
@@ -0,0 +1,24 @@
1error:
2 … while counting down; n = 10
3
4 … while counting down; n = 9
5
6 … while counting down; n = 8
7
8 … while counting down; n = 7
9
10 … while counting down; n = 6
11
12 … while counting down; n = 5
13
14 … while counting down; n = 4
15
16 … while counting down; n = 3
17
18 … while counting down; n = 2
19
20 … while counting down; n = 1
21
22 (stack trace truncated; use '--show-trace' to show the full, detailed trace)
23
24 error: kaboom
diff --git a/test/testdata/eval-fail-addErrorContext-example.flags b/test/testdata/eval-fail-addErrorContext-example.flags
new file mode 100644
index 0000000..9b1f645
--- /dev/null
+++ b/test/testdata/eval-fail-addErrorContext-example.flags
@@ -0,0 +1 @@
--eval --strict --no-show-trace
diff --git a/test/testdata/eval-fail-addErrorContext-example.nix b/test/testdata/eval-fail-addErrorContext-example.nix
new file mode 100644
index 0000000..996b246
--- /dev/null
+++ b/test/testdata/eval-fail-addErrorContext-example.nix
@@ -0,0 +1,9 @@
1let
2 countDown = n:
3 if n == 0
4 then throw "kaboom"
5 else
6 builtins.addErrorContext
7 "while counting down; n = ${toString n}"
8 ("x" + countDown (n - 1));
9in countDown 10
diff --git a/test/testdata/eval-fail-assert-equal-attrs-names-2.err.exp b/test/testdata/eval-fail-assert-equal-attrs-names-2.err.exp
new file mode 100644
index 0000000..4b68d97
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-attrs-names-2.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating the condition of the assertion '({ a = true; } == { a = true; b = true; })'
3 at /pwd/lang/eval-fail-assert-equal-attrs-names-2.nix:1:1:
4 1| assert { a = true; } == { a = true; b = true; };
5 | ^
6 2| throw "unreachable"
7
8 error: attribute names of attribute set '{ a = true; }' differs from attribute set '{ a = true; b = true; }'
diff --git a/test/testdata/eval-fail-assert-equal-attrs-names-2.nix b/test/testdata/eval-fail-assert-equal-attrs-names-2.nix
new file mode 100644
index 0000000..8e7ac9c
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-attrs-names-2.nix
@@ -0,0 +1,2 @@
1assert { a = true; } == { a = true; b = true; };
2throw "unreachable"
diff --git a/test/testdata/eval-fail-assert-equal-attrs-names.err.exp b/test/testdata/eval-fail-assert-equal-attrs-names.err.exp
new file mode 100644
index 0000000..bc61ca6
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-attrs-names.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating the condition of the assertion '({ a = true; b = true; } == { a = true; })'
3 at /pwd/lang/eval-fail-assert-equal-attrs-names.nix:1:1:
4 1| assert { a = true; b = true; } == { a = true; };
5 | ^
6 2| throw "unreachable"
7
8 error: attribute names of attribute set '{ a = true; b = true; }' differs from attribute set '{ a = true; }'
diff --git a/test/testdata/eval-fail-assert-equal-attrs-names.nix b/test/testdata/eval-fail-assert-equal-attrs-names.nix
new file mode 100644
index 0000000..e2f53a8
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-attrs-names.nix
@@ -0,0 +1,2 @@
1assert { a = true; b = true; } == { a = true; };
2throw "unreachable"
diff --git a/test/testdata/eval-fail-assert-equal-derivations-extra.err.exp b/test/testdata/eval-fail-assert-equal-derivations-extra.err.exp
new file mode 100644
index 0000000..7f49240
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-derivations-extra.err.exp
@@ -0,0 +1,26 @@
1error:
2 … while evaluating the condition of the assertion '({ foo = { outPath = "/nix/store/0"; type = "derivation"; }; } == { foo = { devious = true; outPath = "/nix/store/1"; type = "derivation"; }; })'
3 at /pwd/lang/eval-fail-assert-equal-derivations-extra.nix:1:1:
4 1| assert
5 | ^
6 2| { foo = { type = "derivation"; outPath = "/nix/store/0"; }; }
7
8 … while comparing attribute 'foo'
9
10 … where left hand side is
11 at /pwd/lang/eval-fail-assert-equal-derivations-extra.nix:2:5:
12 1| assert
13 2| { foo = { type = "derivation"; outPath = "/nix/store/0"; }; }
14 | ^
15 3| ==
16
17 … where right hand side is
18 at /pwd/lang/eval-fail-assert-equal-derivations-extra.nix:4:5:
19 3| ==
20 4| { foo = { type = "derivation"; outPath = "/nix/store/1"; devious = true; }; };
21 | ^
22 5| throw "unreachable"
23
24 … while comparing a derivation by its 'outPath' attribute
25
26 error: string '"/nix/store/0"' is not equal to string '"/nix/store/1"'
diff --git a/test/testdata/eval-fail-assert-equal-derivations-extra.nix b/test/testdata/eval-fail-assert-equal-derivations-extra.nix
new file mode 100644
index 0000000..fd8bc3f
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-derivations-extra.nix
@@ -0,0 +1,5 @@
1assert
2 { foo = { type = "derivation"; outPath = "/nix/store/0"; }; }
3 ==
4 { foo = { type = "derivation"; outPath = "/nix/store/1"; devious = true; }; };
5throw "unreachable" \ No newline at end of file
diff --git a/test/testdata/eval-fail-assert-equal-derivations.err.exp b/test/testdata/eval-fail-assert-equal-derivations.err.exp
new file mode 100644
index 0000000..d7f0fac
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-derivations.err.exp
@@ -0,0 +1,26 @@
1error:
2 … while evaluating the condition of the assertion '({ foo = { ignored = (abort "not ignored"); outPath = "/nix/store/0"; type = "derivation"; }; } == { foo = { ignored = (abort "not ignored"); outPath = "/nix/store/1"; type = "derivation"; }; })'
3 at /pwd/lang/eval-fail-assert-equal-derivations.nix:1:1:
4 1| assert
5 | ^
6 2| { foo = { type = "derivation"; outPath = "/nix/store/0"; ignored = abort "not ignored"; }; }
7
8 … while comparing attribute 'foo'
9
10 … where left hand side is
11 at /pwd/lang/eval-fail-assert-equal-derivations.nix:2:5:
12 1| assert
13 2| { foo = { type = "derivation"; outPath = "/nix/store/0"; ignored = abort "not ignored"; }; }
14 | ^
15 3| ==
16
17 … where right hand side is
18 at /pwd/lang/eval-fail-assert-equal-derivations.nix:4:5:
19 3| ==
20 4| { foo = { type = "derivation"; outPath = "/nix/store/1"; ignored = abort "not ignored"; }; };
21 | ^
22 5| throw "unreachable"
23
24 … while comparing a derivation by its 'outPath' attribute
25
26 error: string '"/nix/store/0"' is not equal to string '"/nix/store/1"'
diff --git a/test/testdata/eval-fail-assert-equal-derivations.nix b/test/testdata/eval-fail-assert-equal-derivations.nix
new file mode 100644
index 0000000..c648eae
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-derivations.nix
@@ -0,0 +1,5 @@
1assert
2 { foo = { type = "derivation"; outPath = "/nix/store/0"; ignored = abort "not ignored"; }; }
3 ==
4 { foo = { type = "derivation"; outPath = "/nix/store/1"; ignored = abort "not ignored"; }; };
5throw "unreachable" \ No newline at end of file
diff --git a/test/testdata/eval-fail-assert-equal-floats.err.exp b/test/testdata/eval-fail-assert-equal-floats.err.exp
new file mode 100644
index 0000000..d8545e2
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-floats.err.exp
@@ -0,0 +1,22 @@
1error:
2 … while evaluating the condition of the assertion '({ b = 1; } == { b = 1.01; })'
3 at /pwd/lang/eval-fail-assert-equal-floats.nix:1:1:
4 1| assert { b = 1.0; } == { b = 1.01; };
5 | ^
6 2| abort "unreachable"
7
8 … while comparing attribute 'b'
9
10 … where left hand side is
11 at /pwd/lang/eval-fail-assert-equal-floats.nix:1:10:
12 1| assert { b = 1.0; } == { b = 1.01; };
13 | ^
14 2| abort "unreachable"
15
16 … where right hand side is
17 at /pwd/lang/eval-fail-assert-equal-floats.nix:1:26:
18 1| assert { b = 1.0; } == { b = 1.01; };
19 | ^
20 2| abort "unreachable"
21
22 error: a float with value '1' is not equal to a float with value '1.01'
diff --git a/test/testdata/eval-fail-assert-equal-floats.nix b/test/testdata/eval-fail-assert-equal-floats.nix
new file mode 100644
index 0000000..438e85a
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-floats.nix
@@ -0,0 +1,2 @@
1assert { b = 1.0; } == { b = 1.01; };
2abort "unreachable"
diff --git a/test/testdata/eval-fail-assert-equal-function-direct.err.exp b/test/testdata/eval-fail-assert-equal-function-direct.err.exp
new file mode 100644
index 0000000..f06d796
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-function-direct.err.exp
@@ -0,0 +1,9 @@
1error:
2 … while evaluating the condition of the assertion '((x: x) == (x: x))'
3 at /pwd/lang/eval-fail-assert-equal-function-direct.nix:3:1:
4 2| # This only compares a direct comparison and makes no claims about functions in nested structures.
5 3| assert
6 | ^
7 4| (x: x)
8
9 error: distinct functions and immediate comparisons of identical functions compare as unequal
diff --git a/test/testdata/eval-fail-assert-equal-function-direct.nix b/test/testdata/eval-fail-assert-equal-function-direct.nix
new file mode 100644
index 0000000..68e5e39
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-function-direct.nix
@@ -0,0 +1,7 @@
1# Note: functions in nested structures, e.g. attributes, may be optimized away by pointer identity optimization.
2# This only compares a direct comparison and makes no claims about functions in nested structures.
3assert
4 (x: x)
5 ==
6 (x: x);
7abort "unreachable" \ No newline at end of file
diff --git a/test/testdata/eval-fail-assert-equal-int-float.err.exp b/test/testdata/eval-fail-assert-equal-int-float.err.exp
new file mode 100644
index 0000000..c927e38
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-int-float.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating the condition of the assertion '(1 == 1.1)'
3 at /pwd/lang/eval-fail-assert-equal-int-float.nix:1:1:
4 1| assert 1 == 1.1;
5 | ^
6 2| throw "unreachable"
7
8 error: an integer with value '1' is not equal to a float with value '1.1'
diff --git a/test/testdata/eval-fail-assert-equal-int-float.nix b/test/testdata/eval-fail-assert-equal-int-float.nix
new file mode 100644
index 0000000..1dfdf2b
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-int-float.nix
@@ -0,0 +1,2 @@
1assert 1 == 1.1;
2throw "unreachable"
diff --git a/test/testdata/eval-fail-assert-equal-ints.err.exp b/test/testdata/eval-fail-assert-equal-ints.err.exp
new file mode 100644
index 0000000..d6219e2
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-ints.err.exp
@@ -0,0 +1,22 @@
1error:
2 … while evaluating the condition of the assertion '({ b = 1; } == { b = 2; })'
3 at /pwd/lang/eval-fail-assert-equal-ints.nix:1:1:
4 1| assert { b = 1; } == { b = 2; };
5 | ^
6 2| abort "unreachable"
7
8 … while comparing attribute 'b'
9
10 … where left hand side is
11 at /pwd/lang/eval-fail-assert-equal-ints.nix:1:10:
12 1| assert { b = 1; } == { b = 2; };
13 | ^
14 2| abort "unreachable"
15
16 … where right hand side is
17 at /pwd/lang/eval-fail-assert-equal-ints.nix:1:24:
18 1| assert { b = 1; } == { b = 2; };
19 | ^
20 2| abort "unreachable"
21
22 error: an integer with value '1' is not equal to an integer with value '2'
diff --git a/test/testdata/eval-fail-assert-equal-ints.nix b/test/testdata/eval-fail-assert-equal-ints.nix
new file mode 100644
index 0000000..645258e
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-ints.nix
@@ -0,0 +1,2 @@
1assert { b = 1; } == { b = 2; };
2abort "unreachable"
diff --git a/test/testdata/eval-fail-assert-equal-list-length.err.exp b/test/testdata/eval-fail-assert-equal-list-length.err.exp
new file mode 100644
index 0000000..9010855
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-list-length.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating the condition of the assertion '([ (1) (0) ] == [ (10) ])'
3 at /pwd/lang/eval-fail-assert-equal-list-length.nix:1:1:
4 1| assert [ 1 0 ] == [ 10 ];
5 | ^
6 2| throw "unreachable"
7
8 error: list of size '2' is not equal to list of size '1', left hand side is '[ 1 0 ]', right hand side is '[ 10 ]'
diff --git a/test/testdata/eval-fail-assert-equal-list-length.nix b/test/testdata/eval-fail-assert-equal-list-length.nix
new file mode 100644
index 0000000..6d40f4d
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-list-length.nix
@@ -0,0 +1,2 @@
1assert [ 1 0 ] == [ 10 ];
2throw "unreachable" \ No newline at end of file
diff --git a/test/testdata/eval-fail-assert-equal-paths.err.exp b/test/testdata/eval-fail-assert-equal-paths.err.exp
new file mode 100644
index 0000000..66c34e9
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-paths.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating the condition of the assertion '(/pwd/lang/foo == /pwd/lang/bar)'
3 at /pwd/lang/eval-fail-assert-equal-paths.nix:1:1:
4 1| assert ./foo == ./bar;
5 | ^
6 2| throw "unreachable"
7
8 error: path '/pwd/lang/foo' is not equal to path '/pwd/lang/bar'
diff --git a/test/testdata/eval-fail-assert-equal-paths.nix b/test/testdata/eval-fail-assert-equal-paths.nix
new file mode 100644
index 0000000..ef0b670
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-paths.nix
@@ -0,0 +1,2 @@
1assert ./foo == ./bar;
2throw "unreachable" \ No newline at end of file
diff --git a/test/testdata/eval-fail-assert-equal-type-nested.err.exp b/test/testdata/eval-fail-assert-equal-type-nested.err.exp
new file mode 100644
index 0000000..f78badd
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-type-nested.err.exp
@@ -0,0 +1,22 @@
1error:
2 … while evaluating the condition of the assertion '({ ding = false; } == { ding = null; })'
3 at /pwd/lang/eval-fail-assert-equal-type-nested.nix:1:1:
4 1| assert { ding = false; } == { ding = null; };
5 | ^
6 2| abort "unreachable"
7
8 … while comparing attribute 'ding'
9
10 … where left hand side is
11 at /pwd/lang/eval-fail-assert-equal-type-nested.nix:1:10:
12 1| assert { ding = false; } == { ding = null; };
13 | ^
14 2| abort "unreachable"
15
16 … where right hand side is
17 at /pwd/lang/eval-fail-assert-equal-type-nested.nix:1:31:
18 1| assert { ding = false; } == { ding = null; };
19 | ^
20 2| abort "unreachable"
21
22 error: a Boolean of value 'false' is not equal to null of value 'null'
diff --git a/test/testdata/eval-fail-assert-equal-type-nested.nix b/test/testdata/eval-fail-assert-equal-type-nested.nix
new file mode 100644
index 0000000..3fbd14c
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-type-nested.nix
@@ -0,0 +1,2 @@
1assert { ding = false; } == { ding = null; };
2abort "unreachable"
diff --git a/test/testdata/eval-fail-assert-equal-type.err.exp b/test/testdata/eval-fail-assert-equal-type.err.exp
new file mode 100644
index 0000000..4dc3f2e
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-type.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating the condition of the assertion '(false == null)'
3 at /pwd/lang/eval-fail-assert-equal-type.nix:1:1:
4 1| assert false == null;
5 | ^
6 2| abort "unreachable"
7
8 error: a Boolean of value 'false' is not equal to null of value 'null'
diff --git a/test/testdata/eval-fail-assert-equal-type.nix b/test/testdata/eval-fail-assert-equal-type.nix
new file mode 100644
index 0000000..7023ea0
--- /dev/null
+++ b/test/testdata/eval-fail-assert-equal-type.nix
@@ -0,0 +1,2 @@
1assert false == null;
2abort "unreachable"
diff --git a/test/testdata/eval-fail-assert-nested-bool.err.exp b/test/testdata/eval-fail-assert-nested-bool.err.exp
new file mode 100644
index 0000000..1debb66
--- /dev/null
+++ b/test/testdata/eval-fail-assert-nested-bool.err.exp
@@ -0,0 +1,74 @@
1error:
2 … while evaluating the condition of the assertion '({ a = { b = [ ({ c = { d = true; }; }) ]; }; } == { a = { b = [ ({ c = { d = false; }; }) ]; }; })'
3 at /pwd/lang/eval-fail-assert-nested-bool.nix:1:1:
4 1| assert
5 | ^
6 2| { a.b = [ { c.d = true; } ]; }
7
8 … while comparing attribute 'a'
9
10 … where left hand side is
11 at /pwd/lang/eval-fail-assert-nested-bool.nix:2:5:
12 1| assert
13 2| { a.b = [ { c.d = true; } ]; }
14 | ^
15 3| ==
16
17 … where right hand side is
18 at /pwd/lang/eval-fail-assert-nested-bool.nix:4:5:
19 3| ==
20 4| { a.b = [ { c.d = false; } ]; };
21 | ^
22 5|
23
24 … while comparing attribute 'b'
25
26 … where left hand side is
27 at /pwd/lang/eval-fail-assert-nested-bool.nix:2:5:
28 1| assert
29 2| { a.b = [ { c.d = true; } ]; }
30 | ^
31 3| ==
32
33 … where right hand side is
34 at /pwd/lang/eval-fail-assert-nested-bool.nix:4:5:
35 3| ==
36 4| { a.b = [ { c.d = false; } ]; };
37 | ^
38 5|
39
40 … while comparing list element 0
41
42 … while comparing attribute 'c'
43
44 … where left hand side is
45 at /pwd/lang/eval-fail-assert-nested-bool.nix:2:15:
46 1| assert
47 2| { a.b = [ { c.d = true; } ]; }
48 | ^
49 3| ==
50
51 … where right hand side is
52 at /pwd/lang/eval-fail-assert-nested-bool.nix:4:15:
53 3| ==
54 4| { a.b = [ { c.d = false; } ]; };
55 | ^
56 5|
57
58 … while comparing attribute 'd'
59
60 … where left hand side is
61 at /pwd/lang/eval-fail-assert-nested-bool.nix:2:15:
62 1| assert
63 2| { a.b = [ { c.d = true; } ]; }
64 | ^
65 3| ==
66
67 … where right hand side is
68 at /pwd/lang/eval-fail-assert-nested-bool.nix:4:15:
69 3| ==
70 4| { a.b = [ { c.d = false; } ]; };
71 | ^
72 5|
73
74 error: boolean 'true' is not equal to boolean 'false'
diff --git a/test/testdata/eval-fail-assert-nested-bool.nix b/test/testdata/eval-fail-assert-nested-bool.nix
new file mode 100644
index 0000000..2285769
--- /dev/null
+++ b/test/testdata/eval-fail-assert-nested-bool.nix
@@ -0,0 +1,6 @@
1assert
2 { a.b = [ { c.d = true; } ]; }
3 ==
4 { a.b = [ { c.d = false; } ]; };
5
6abort "unreachable" \ No newline at end of file
diff --git a/test/testdata/eval-fail-assert.err.exp b/test/testdata/eval-fail-assert.err.exp
new file mode 100644
index 0000000..7be9e23
--- /dev/null
+++ b/test/testdata/eval-fail-assert.err.exp
@@ -0,0 +1,30 @@
1error:
2 … while evaluating the attribute 'body'
3 at /pwd/lang/eval-fail-assert.nix:4:3:
4 3|
5 4| body = x "x";
6 | ^
7 5| }
8
9 … from call site
10 at /pwd/lang/eval-fail-assert.nix:4:10:
11 3|
12 4| body = x "x";
13 | ^
14 5| }
15
16 … while calling 'x'
17 at /pwd/lang/eval-fail-assert.nix:2:7:
18 1| let {
19 2| x = arg: assert arg == "y"; 123;
20 | ^
21 3|
22
23 … while evaluating the condition of the assertion '(arg == "y")'
24 at /pwd/lang/eval-fail-assert.nix:2:12:
25 1| let {
26 2| x = arg: assert arg == "y"; 123;
27 | ^
28 3|
29
30 error: string '"x"' is not equal to string '"y"'
diff --git a/test/testdata/eval-fail-assert.nix b/test/testdata/eval-fail-assert.nix
new file mode 100644
index 0000000..3b7a1e8
--- /dev/null
+++ b/test/testdata/eval-fail-assert.nix
@@ -0,0 +1,5 @@
1let {
2 x = arg: assert arg == "y"; 123;
3
4 body = x "x";
5} \ No newline at end of file
diff --git a/test/testdata/eval-fail-attr-name-type.err.exp b/test/testdata/eval-fail-attr-name-type.err.exp
new file mode 100644
index 0000000..6848a35
--- /dev/null
+++ b/test/testdata/eval-fail-attr-name-type.err.exp
@@ -0,0 +1,21 @@
1error:
2 … while evaluating the attribute 'puppy."${key}"'
3 at /pwd/lang/eval-fail-attr-name-type.nix:3:5:
4 2| attrs = {
5 3| puppy.doggy = {};
6 | ^
7 4| };
8
9 … while evaluating an attribute name
10 at /pwd/lang/eval-fail-attr-name-type.nix:7:17:
11 6| in
12 7| attrs.puppy.${key}
13 | ^
14 8|
15
16 error: expected a string but found an integer: 1
17 at /pwd/lang/eval-fail-attr-name-type.nix:7:17:
18 6| in
19 7| attrs.puppy.${key}
20 | ^
21 8|
diff --git a/test/testdata/eval-fail-attr-name-type.nix b/test/testdata/eval-fail-attr-name-type.nix
new file mode 100644
index 0000000..a0e7600
--- /dev/null
+++ b/test/testdata/eval-fail-attr-name-type.nix
@@ -0,0 +1,7 @@
1let
2 attrs = {
3 puppy.doggy = {};
4 };
5 key = 1;
6in
7 attrs.puppy.${key}
diff --git a/test/testdata/eval-fail-bad-string-interpolation-1.err.exp b/test/testdata/eval-fail-bad-string-interpolation-1.err.exp
new file mode 100644
index 0000000..5ae5303
--- /dev/null
+++ b/test/testdata/eval-fail-bad-string-interpolation-1.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating a path segment
3 at /pwd/lang/eval-fail-bad-string-interpolation-1.nix:1:2:
4 1| "${x: x}"
5 | ^
6 2|
7
8 error: cannot coerce a function to a string: «lambda @ /pwd/lang/eval-fail-bad-string-interpolation-1.nix:1:4»
diff --git a/test/testdata/eval-fail-bad-string-interpolation-1.nix b/test/testdata/eval-fail-bad-string-interpolation-1.nix
new file mode 100644
index 0000000..ffe9c98
--- /dev/null
+++ b/test/testdata/eval-fail-bad-string-interpolation-1.nix
@@ -0,0 +1 @@
"${x: x}"
diff --git a/test/testdata/eval-fail-bad-string-interpolation-2.err.exp b/test/testdata/eval-fail-bad-string-interpolation-2.err.exp
new file mode 100644
index 0000000..a287067
--- /dev/null
+++ b/test/testdata/eval-fail-bad-string-interpolation-2.err.exp
@@ -0,0 +1 @@
error: path '/pwd/lang/fnord' does not exist
diff --git a/test/testdata/eval-fail-bad-string-interpolation-2.nix b/test/testdata/eval-fail-bad-string-interpolation-2.nix
new file mode 100644
index 0000000..3745235
--- /dev/null
+++ b/test/testdata/eval-fail-bad-string-interpolation-2.nix
@@ -0,0 +1 @@
"${./fnord}"
diff --git a/test/testdata/eval-fail-bad-string-interpolation-3.err.exp b/test/testdata/eval-fail-bad-string-interpolation-3.err.exp
new file mode 100644
index 0000000..170a3d1
--- /dev/null
+++ b/test/testdata/eval-fail-bad-string-interpolation-3.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating a path segment
3 at /pwd/lang/eval-fail-bad-string-interpolation-3.nix:1:3:
4 1| ''${x: x}''
5 | ^
6 2|
7
8 error: cannot coerce a function to a string: «lambda @ /pwd/lang/eval-fail-bad-string-interpolation-3.nix:1:5»
diff --git a/test/testdata/eval-fail-bad-string-interpolation-3.nix b/test/testdata/eval-fail-bad-string-interpolation-3.nix
new file mode 100644
index 0000000..65b9d4f
--- /dev/null
+++ b/test/testdata/eval-fail-bad-string-interpolation-3.nix
@@ -0,0 +1 @@
''${x: x}''
diff --git a/test/testdata/eval-fail-bad-string-interpolation-4.err.exp b/test/testdata/eval-fail-bad-string-interpolation-4.err.exp
new file mode 100644
index 0000000..b262e81
--- /dev/null
+++ b/test/testdata/eval-fail-bad-string-interpolation-4.err.exp
@@ -0,0 +1,9 @@
1error:
2 … while evaluating a path segment
3 at /pwd/lang/eval-fail-bad-string-interpolation-4.nix:9:3:
4 8| # The error message should not be too long.
5 9| ''${pkgs}''
6 | ^
7 10|
8
9 error: cannot coerce a set to a string: { a = { a = { a = { a = "ha"; b = "ha"; c = "ha"; d = "ha"; e = "ha"; f = "ha"; g = "ha"; h = "ha"; j = "ha"; }; «8 attributes elided» }; «8 attributes elided» }; «8 attributes elided» }
diff --git a/test/testdata/eval-fail-bad-string-interpolation-4.nix b/test/testdata/eval-fail-bad-string-interpolation-4.nix
new file mode 100644
index 0000000..457b5f0
--- /dev/null
+++ b/test/testdata/eval-fail-bad-string-interpolation-4.nix
@@ -0,0 +1,9 @@
1let
2 # Basically a "billion laughs" attack, but toned down to simulated `pkgs`.
3 ha = x: y: { a = x y; b = x y; c = x y; d = x y; e = x y; f = x y; g = x y; h = x y; j = x y; };
4 has = ha (ha (ha (ha (x: x)))) "ha";
5 # A large structure that has already been evaluated.
6 pkgs = builtins.deepSeq has has;
7in
8# The error message should not be too long.
9''${pkgs}''
diff --git a/test/testdata/eval-fail-blackhole.err.exp b/test/testdata/eval-fail-blackhole.err.exp
new file mode 100644
index 0000000..95e33a5
--- /dev/null
+++ b/test/testdata/eval-fail-blackhole.err.exp
@@ -0,0 +1,14 @@
1error:
2 … while evaluating the attribute 'body'
3 at /pwd/lang/eval-fail-blackhole.nix:2:3:
4 1| let {
5 2| body = x;
6 | ^
7 3| x = y;
8
9 error: infinite recursion encountered
10 at /pwd/lang/eval-fail-blackhole.nix:3:7:
11 2| body = x;
12 3| x = y;
13 | ^
14 4| y = x;
diff --git a/test/testdata/eval-fail-blackhole.nix b/test/testdata/eval-fail-blackhole.nix
new file mode 100644
index 0000000..81133b5
--- /dev/null
+++ b/test/testdata/eval-fail-blackhole.nix
@@ -0,0 +1,5 @@
1let {
2 body = x;
3 x = y;
4 y = x;
5}
diff --git a/test/testdata/eval-fail-call-primop.err.exp b/test/testdata/eval-fail-call-primop.err.exp
new file mode 100644
index 0000000..0c6f614
--- /dev/null
+++ b/test/testdata/eval-fail-call-primop.err.exp
@@ -0,0 +1,10 @@
1error:
2 … while calling the 'length' builtin
3 at /pwd/lang/eval-fail-call-primop.nix:1:1:
4 1| builtins.length 1
5 | ^
6 2|
7
8 … while evaluating the first argument passed to builtins.length
9
10 error: expected a list but found an integer: 1
diff --git a/test/testdata/eval-fail-call-primop.nix b/test/testdata/eval-fail-call-primop.nix
new file mode 100644
index 0000000..972eb72
--- /dev/null
+++ b/test/testdata/eval-fail-call-primop.nix
@@ -0,0 +1 @@
builtins.length 1
diff --git a/test/testdata/eval-fail-deepseq.err.exp b/test/testdata/eval-fail-deepseq.err.exp
new file mode 100644
index 0000000..11b6234
--- /dev/null
+++ b/test/testdata/eval-fail-deepseq.err.exp
@@ -0,0 +1,20 @@
1error:
2 … while calling the 'deepSeq' builtin
3 at /pwd/lang/eval-fail-deepseq.nix:1:1:
4 1| builtins.deepSeq { x = abort "foo"; } 456
5 | ^
6 2|
7
8 … while evaluating the attribute 'x'
9 at /pwd/lang/eval-fail-deepseq.nix:1:20:
10 1| builtins.deepSeq { x = abort "foo"; } 456
11 | ^
12 2|
13
14 … while calling the 'abort' builtin
15 at /pwd/lang/eval-fail-deepseq.nix:1:24:
16 1| builtins.deepSeq { x = abort "foo"; } 456
17 | ^
18 2|
19
20 error: evaluation aborted with the following error message: 'foo'
diff --git a/test/testdata/eval-fail-deepseq.nix b/test/testdata/eval-fail-deepseq.nix
new file mode 100644
index 0000000..9baa49b
--- /dev/null
+++ b/test/testdata/eval-fail-deepseq.nix
@@ -0,0 +1 @@
builtins.deepSeq { x = abort "foo"; } 456
diff --git a/test/testdata/eval-fail-derivation-name.err.exp b/test/testdata/eval-fail-derivation-name.err.exp
new file mode 100644
index 0000000..0ef9867
--- /dev/null
+++ b/test/testdata/eval-fail-derivation-name.err.exp
@@ -0,0 +1,26 @@
1error:
2 … while evaluating the attribute 'outPath'
3 at <nix/derivation-internal.nix>:<number>:<number>:
4 <number>| value = commonAttrs // {
5 <number>| outPath = builtins.getAttr outputName strict;
6 | ^
7 <number>| drvPath = strict.drvPath;
8
9 … while calling the 'getAttr' builtin
10 at <nix/derivation-internal.nix>:<number>:<number>:
11 <number>| value = commonAttrs // {
12 <number>| outPath = builtins.getAttr outputName strict;
13 | ^
14 <number>| drvPath = strict.drvPath;
15
16 … while calling the 'derivationStrict' builtin
17 at <nix/derivation-internal.nix>:<number>:<number>:
18 <number>|
19 <number>| strict = derivationStrict drvAttrs;
20 | ^
21 <number>|
22
23 … while evaluating derivation '~jiggle~'
24 whose name attribute is located at /pwd/lang/eval-fail-derivation-name.nix:<number>:<number>
25
26 error: invalid derivation name: name '~jiggle~' contains illegal character '~'. Please pass a different 'name'.
diff --git a/test/testdata/eval-fail-derivation-name.nix b/test/testdata/eval-fail-derivation-name.nix
new file mode 100644
index 0000000..e779ad6
--- /dev/null
+++ b/test/testdata/eval-fail-derivation-name.nix
@@ -0,0 +1,5 @@
1derivation {
2 name = "~jiggle~";
3 system = "some-system";
4 builder = "/dontcare";
5}
diff --git a/test/testdata/eval-fail-derivation-name.postprocess b/test/testdata/eval-fail-derivation-name.postprocess
new file mode 100644
index 0000000..ffbc2b5
--- /dev/null
+++ b/test/testdata/eval-fail-derivation-name.postprocess
@@ -0,0 +1,9 @@
1# shellcheck shell=bash
2set -euo pipefail
3testcaseBasename=$1
4
5# Line numbers change when derivation.nix docs are updated.
6sed -i "$testcaseBasename.err" \
7 -e 's/[0-9 ][0-9 ][0-9 ][0-9 ][0-9 ][0-9 ][0-9 ][0-9]\([^0-9]\)/<number>\1/g' \
8 -e 's/[0-9][0-9]*/<number>/g' \
9 ;
diff --git a/test/testdata/eval-fail-dup-dynamic-attrs.err.exp b/test/testdata/eval-fail-dup-dynamic-attrs.err.exp
new file mode 100644
index 0000000..834f9c6
--- /dev/null
+++ b/test/testdata/eval-fail-dup-dynamic-attrs.err.exp
@@ -0,0 +1,14 @@
1error:
2 … while evaluating the attribute 'set'
3 at /pwd/lang/eval-fail-dup-dynamic-attrs.nix:2:3:
4 1| {
5 2| set = { "${"" + "b"}" = 1; };
6 | ^
7 3| set = { "${"b" + ""}" = 2; };
8
9 error: dynamic attribute 'b' already defined at /pwd/lang/eval-fail-dup-dynamic-attrs.nix:2:11
10 at /pwd/lang/eval-fail-dup-dynamic-attrs.nix:3:11:
11 2| set = { "${"" + "b"}" = 1; };
12 3| set = { "${"b" + ""}" = 2; };
13 | ^
14 4| }
diff --git a/test/testdata/eval-fail-dup-dynamic-attrs.nix b/test/testdata/eval-fail-dup-dynamic-attrs.nix
new file mode 100644
index 0000000..7ea17f6
--- /dev/null
+++ b/test/testdata/eval-fail-dup-dynamic-attrs.nix
@@ -0,0 +1,4 @@
1{
2 set = { "${"" + "b"}" = 1; };
3 set = { "${"b" + ""}" = 2; };
4}
diff --git a/test/testdata/eval-fail-duplicate-traces.err.exp b/test/testdata/eval-fail-duplicate-traces.err.exp
new file mode 100644
index 0000000..cedaebd
--- /dev/null
+++ b/test/testdata/eval-fail-duplicate-traces.err.exp
@@ -0,0 +1,51 @@
1error:
2 … from call site
3 at /pwd/lang/eval-fail-duplicate-traces.nix:9:3:
4 8| in
5 9| throwAfter 2
6 | ^
7 10|
8
9 … while calling 'throwAfter'
10 at /pwd/lang/eval-fail-duplicate-traces.nix:4:16:
11 3| let
12 4| throwAfter = n:
13 | ^
14 5| if n > 0
15
16 … from call site
17 at /pwd/lang/eval-fail-duplicate-traces.nix:6:10:
18 5| if n > 0
19 6| then throwAfter (n - 1)
20 | ^
21 7| else throw "Uh oh!";
22
23 … while calling 'throwAfter'
24 at /pwd/lang/eval-fail-duplicate-traces.nix:4:16:
25 3| let
26 4| throwAfter = n:
27 | ^
28 5| if n > 0
29
30 … from call site
31 at /pwd/lang/eval-fail-duplicate-traces.nix:6:10:
32 5| if n > 0
33 6| then throwAfter (n - 1)
34 | ^
35 7| else throw "Uh oh!";
36
37 … while calling 'throwAfter'
38 at /pwd/lang/eval-fail-duplicate-traces.nix:4:16:
39 3| let
40 4| throwAfter = n:
41 | ^
42 5| if n > 0
43
44 … while calling the 'throw' builtin
45 at /pwd/lang/eval-fail-duplicate-traces.nix:7:10:
46 6| then throwAfter (n - 1)
47 7| else throw "Uh oh!";
48 | ^
49 8| in
50
51 error: Uh oh!
diff --git a/test/testdata/eval-fail-duplicate-traces.nix b/test/testdata/eval-fail-duplicate-traces.nix
new file mode 100644
index 0000000..17ce374
--- /dev/null
+++ b/test/testdata/eval-fail-duplicate-traces.nix
@@ -0,0 +1,9 @@
1# Check that we only omit duplicate stack traces when there's a bunch of them.
2# Here, there's only a couple duplicate entries, so we output them all.
3let
4 throwAfter = n:
5 if n > 0
6 then throwAfter (n - 1)
7 else throw "Uh oh!";
8in
9 throwAfter 2
diff --git a/test/testdata/eval-fail-eol-1.err.exp b/test/testdata/eval-fail-eol-1.err.exp
new file mode 100644
index 0000000..3f5a5c2
--- /dev/null
+++ b/test/testdata/eval-fail-eol-1.err.exp
@@ -0,0 +1,6 @@
1error: undefined variable 'invalid'
2 at /pwd/lang/eval-fail-eol-1.nix:2:1:
3 1| # foo
4 2| invalid
5 | ^
6 3| # bar
diff --git a/test/testdata/eval-fail-eol-1.nix b/test/testdata/eval-fail-eol-1.nix
new file mode 100644
index 0000000..4762239
--- /dev/null
+++ b/test/testdata/eval-fail-eol-1.nix
@@ -0,0 +1,3 @@
1# foo
2invalid
3# bar
diff --git a/test/testdata/eval-fail-eol-2.err.exp b/test/testdata/eval-fail-eol-2.err.exp
new file mode 100644
index 0000000..ff13e2d
--- /dev/null
+++ b/test/testdata/eval-fail-eol-2.err.exp
@@ -0,0 +1,6 @@
1error: undefined variable 'invalid'
2 at /pwd/lang/eval-fail-eol-2.nix:2:1:
3 1| # foo
4 2| invalid
5 | ^
6 3| # bar
diff --git a/test/testdata/eval-fail-eol-2.nix b/test/testdata/eval-fail-eol-2.nix
new file mode 100644
index 0000000..0cf92a4
--- /dev/null
+++ b/test/testdata/eval-fail-eol-2.nix
@@ -0,0 +1,2 @@
1# foo invalid
2# bar
diff --git a/test/testdata/eval-fail-eol-3.err.exp b/test/testdata/eval-fail-eol-3.err.exp
new file mode 100644
index 0000000..ada3c5e
--- /dev/null
+++ b/test/testdata/eval-fail-eol-3.err.exp
@@ -0,0 +1,6 @@
1error: undefined variable 'invalid'
2 at /pwd/lang/eval-fail-eol-3.nix:2:1:
3 1| # foo
4 2| invalid
5 | ^
6 3| # bar
diff --git a/test/testdata/eval-fail-eol-3.nix b/test/testdata/eval-fail-eol-3.nix
new file mode 100644
index 0000000..4762239
--- /dev/null
+++ b/test/testdata/eval-fail-eol-3.nix
@@ -0,0 +1,3 @@
1# foo
2invalid
3# bar
diff --git a/test/testdata/eval-fail-fetchTree-negative.err.exp b/test/testdata/eval-fail-fetchTree-negative.err.exp
new file mode 100644
index 0000000..d9ba1f0
--- /dev/null
+++ b/test/testdata/eval-fail-fetchTree-negative.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'fetchTree' builtin
3 at /pwd/lang/eval-fail-fetchTree-negative.nix:1:1:
4 1| builtins.fetchTree {
5 | ^
6 2| type = "file";
7
8 error: negative value given for fetchTree attr owner: -1
diff --git a/test/testdata/eval-fail-fetchTree-negative.nix b/test/testdata/eval-fail-fetchTree-negative.nix
new file mode 100644
index 0000000..90bcab5
--- /dev/null
+++ b/test/testdata/eval-fail-fetchTree-negative.nix
@@ -0,0 +1,5 @@
1builtins.fetchTree {
2 type = "file";
3 url = "file://eval-fail-fetchTree-negative.nix";
4 owner = -1;
5}
diff --git a/test/testdata/eval-fail-fetchurl-baseName-attrs-name.err.exp b/test/testdata/eval-fail-fetchurl-baseName-attrs-name.err.exp
new file mode 100644
index 0000000..30f8b6a
--- /dev/null
+++ b/test/testdata/eval-fail-fetchurl-baseName-attrs-name.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'fetchurl' builtin
3 at /pwd/lang/eval-fail-fetchurl-baseName-attrs-name.nix:1:1:
4 1| builtins.fetchurl { url = "https://example.com/foo.tar.gz"; name = "~wobble~"; }
5 | ^
6 2|
7
8 error: invalid store path name when fetching URL 'https://example.com/foo.tar.gz': name '~wobble~' contains illegal character '~'. Please change the value for the 'name' attribute passed to 'fetchurl', so that it can create a valid store path.
diff --git a/test/testdata/eval-fail-fetchurl-baseName-attrs-name.nix b/test/testdata/eval-fail-fetchurl-baseName-attrs-name.nix
new file mode 100644
index 0000000..5838055
--- /dev/null
+++ b/test/testdata/eval-fail-fetchurl-baseName-attrs-name.nix
@@ -0,0 +1 @@
builtins.fetchurl { url = "https://example.com/foo.tar.gz"; name = "~wobble~"; }
diff --git a/test/testdata/eval-fail-fetchurl-baseName-attrs.err.exp b/test/testdata/eval-fail-fetchurl-baseName-attrs.err.exp
new file mode 100644
index 0000000..cef532e
--- /dev/null
+++ b/test/testdata/eval-fail-fetchurl-baseName-attrs.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'fetchurl' builtin
3 at /pwd/lang/eval-fail-fetchurl-baseName-attrs.nix:1:1:
4 1| builtins.fetchurl { url = "https://example.com/~wiggle~"; }
5 | ^
6 2|
7
8 error: invalid store path name when fetching URL 'https://example.com/~wiggle~': name '~wiggle~' contains illegal character '~'. Please add a valid 'name' attribute to the argument for 'fetchurl', so that it can create a valid store path.
diff --git a/test/testdata/eval-fail-fetchurl-baseName-attrs.nix b/test/testdata/eval-fail-fetchurl-baseName-attrs.nix
new file mode 100644
index 0000000..068120e
--- /dev/null
+++ b/test/testdata/eval-fail-fetchurl-baseName-attrs.nix
@@ -0,0 +1 @@
builtins.fetchurl { url = "https://example.com/~wiggle~"; }
diff --git a/test/testdata/eval-fail-fetchurl-baseName.err.exp b/test/testdata/eval-fail-fetchurl-baseName.err.exp
new file mode 100644
index 0000000..0950e8e
--- /dev/null
+++ b/test/testdata/eval-fail-fetchurl-baseName.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'fetchurl' builtin
3 at /pwd/lang/eval-fail-fetchurl-baseName.nix:1:1:
4 1| builtins.fetchurl "https://example.com/~wiggle~"
5 | ^
6 2|
7
8 error: invalid store path name when fetching URL 'https://example.com/~wiggle~': name '~wiggle~' contains illegal character '~'. Please pass an attribute set with 'url' and 'name' attributes to 'fetchurl', so that it can create a valid store path.
diff --git a/test/testdata/eval-fail-fetchurl-baseName.nix b/test/testdata/eval-fail-fetchurl-baseName.nix
new file mode 100644
index 0000000..9650938
--- /dev/null
+++ b/test/testdata/eval-fail-fetchurl-baseName.nix
@@ -0,0 +1 @@
builtins.fetchurl "https://example.com/~wiggle~"
diff --git a/test/testdata/eval-fail-flake-ref-to-string-negative-integer.err.exp b/test/testdata/eval-fail-flake-ref-to-string-negative-integer.err.exp
new file mode 100644
index 0000000..25c8d7e
--- /dev/null
+++ b/test/testdata/eval-fail-flake-ref-to-string-negative-integer.err.exp
@@ -0,0 +1,14 @@
1error:
2 … while calling the 'seq' builtin
3 at /pwd/lang/eval-fail-flake-ref-to-string-negative-integer.nix:1:16:
4 1| let n = -1; in builtins.seq n (builtins.flakeRefToString {
5 | ^
6 2| type = "github";
7
8 … while calling the 'flakeRefToString' builtin
9 at /pwd/lang/eval-fail-flake-ref-to-string-negative-integer.nix:1:32:
10 1| let n = -1; in builtins.seq n (builtins.flakeRefToString {
11 | ^
12 2| type = "github";
13
14 error: negative value given for flake ref attr repo: -1
diff --git a/test/testdata/eval-fail-flake-ref-to-string-negative-integer.nix b/test/testdata/eval-fail-flake-ref-to-string-negative-integer.nix
new file mode 100644
index 0000000..e0208eb
--- /dev/null
+++ b/test/testdata/eval-fail-flake-ref-to-string-negative-integer.nix
@@ -0,0 +1,7 @@
1let n = -1; in builtins.seq n (builtins.flakeRefToString {
2 type = "github";
3 owner = "NixOS";
4 repo = n;
5 ref = "23.05";
6 dir = "lib";
7})
diff --git a/test/testdata/eval-fail-foldlStrict-strict-op-application.err.exp b/test/testdata/eval-fail-foldlStrict-strict-op-application.err.exp
new file mode 100644
index 0000000..4903bc8
--- /dev/null
+++ b/test/testdata/eval-fail-foldlStrict-strict-op-application.err.exp
@@ -0,0 +1,37 @@
1error:
2 … while calling the 'foldl'' builtin
3 at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:2:1:
4 1| # Tests that the result of applying op is forced even if the value is never used
5 2| builtins.foldl'
6 | ^
7 3| (_: f: f null)
8
9 … while calling anonymous lambda
10 at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:3:7:
11 2| builtins.foldl'
12 3| (_: f: f null)
13 | ^
14 4| null
15
16 … from call site
17 at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:3:10:
18 2| builtins.foldl'
19 3| (_: f: f null)
20 | ^
21 4| null
22
23 … while calling anonymous lambda
24 at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:5:6:
25 4| null
26 5| [ (_: throw "Not the final value, but is still forced!") (_: 23) ]
27 | ^
28 6|
29
30 … while calling the 'throw' builtin
31 at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:5:9:
32 4| null
33 5| [ (_: throw "Not the final value, but is still forced!") (_: 23) ]
34 | ^
35 6|
36
37 error: Not the final value, but is still forced!
diff --git a/test/testdata/eval-fail-foldlStrict-strict-op-application.nix b/test/testdata/eval-fail-foldlStrict-strict-op-application.nix
new file mode 100644
index 0000000..1620cc7
--- /dev/null
+++ b/test/testdata/eval-fail-foldlStrict-strict-op-application.nix
@@ -0,0 +1,5 @@
1# Tests that the result of applying op is forced even if the value is never used
2builtins.foldl'
3 (_: f: f null)
4 null
5 [ (_: throw "Not the final value, but is still forced!") (_: 23) ]
diff --git a/test/testdata/eval-fail-fromJSON-overflowing.err.exp b/test/testdata/eval-fail-fromJSON-overflowing.err.exp
new file mode 100644
index 0000000..a39082b
--- /dev/null
+++ b/test/testdata/eval-fail-fromJSON-overflowing.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'fromJSON' builtin
3 at /pwd/lang/eval-fail-fromJSON-overflowing.nix:1:1:
4 1| builtins.fromJSON ''{"attr": 18446744073709551615}''
5 | ^
6 2|
7
8 error: unsigned json number 18446744073709551615 outside of Nix integer range
diff --git a/test/testdata/eval-fail-fromJSON-overflowing.nix b/test/testdata/eval-fail-fromJSON-overflowing.nix
new file mode 100644
index 0000000..6dfbce3
--- /dev/null
+++ b/test/testdata/eval-fail-fromJSON-overflowing.nix
@@ -0,0 +1 @@
builtins.fromJSON ''{"attr": 18446744073709551615}''
diff --git a/test/testdata/eval-fail-fromTOML-timestamps.err.exp b/test/testdata/eval-fail-fromTOML-timestamps.err.exp
new file mode 100644
index 0000000..9bbb251
--- /dev/null
+++ b/test/testdata/eval-fail-fromTOML-timestamps.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'fromTOML' builtin
3 at /pwd/lang/eval-fail-fromTOML-timestamps.nix:1:1:
4 1| builtins.fromTOML ''
5 | ^
6 2| key = "value"
7
8 error: while parsing TOML: Dates and times are not supported
diff --git a/test/testdata/eval-fail-fromTOML-timestamps.nix b/test/testdata/eval-fail-fromTOML-timestamps.nix
new file mode 100644
index 0000000..74cff94
--- /dev/null
+++ b/test/testdata/eval-fail-fromTOML-timestamps.nix
@@ -0,0 +1,130 @@
1builtins.fromTOML ''
2 key = "value"
3 bare_key = "value"
4 bare-key = "value"
5 1234 = "value"
6
7 "127.0.0.1" = "value"
8 "character encoding" = "value"
9 "ʎǝʞ" = "value"
10 'key2' = "value"
11 'quoted "value"' = "value"
12
13 name = "Orange"
14
15 physical.color = "orange"
16 physical.shape = "round"
17 site."google.com" = true
18
19 # This is legal according to the spec, but cpptoml doesn't handle it.
20 #a.b.c = 1
21 #a.d = 2
22
23 str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF."
24
25 int1 = +99
26 int2 = 42
27 int3 = 0
28 int4 = -17
29 int5 = 1_000
30 int6 = 5_349_221
31 int7 = 1_2_3_4_5
32
33 hex1 = 0xDEADBEEF
34 hex2 = 0xdeadbeef
35 hex3 = 0xdead_beef
36
37 oct1 = 0o01234567
38 oct2 = 0o755
39
40 bin1 = 0b11010110
41
42 flt1 = +1.0
43 flt2 = 3.1415
44 flt3 = -0.01
45 flt4 = 5e+22
46 flt5 = 1e6
47 flt6 = -2E-2
48 flt7 = 6.626e-34
49 flt8 = 9_224_617.445_991_228_313
50
51 bool1 = true
52 bool2 = false
53
54 odt1 = 1979-05-27T07:32:00Z
55 odt2 = 1979-05-27T00:32:00-07:00
56 odt3 = 1979-05-27T00:32:00.999999-07:00
57 odt4 = 1979-05-27 07:32:00Z
58 ldt1 = 1979-05-27T07:32:00
59 ldt2 = 1979-05-27T00:32:00.999999
60 ld1 = 1979-05-27
61 lt1 = 07:32:00
62 lt2 = 00:32:00.999999
63
64 arr1 = [ 1, 2, 3 ]
65 arr2 = [ "red", "yellow", "green" ]
66 arr3 = [ [ 1, 2 ], [3, 4, 5] ]
67 arr4 = [ "all", 'strings', """are the same""", ''''type'''']
68 arr5 = [ [ 1, 2 ], ["a", "b", "c"] ]
69
70 arr7 = [
71 1, 2, 3
72 ]
73
74 arr8 = [
75 1,
76 2, # this is ok
77 ]
78
79 [table-1]
80 key1 = "some string"
81 key2 = 123
82
83
84 [table-2]
85 key1 = "another string"
86 key2 = 456
87
88 [dog."tater.man"]
89 type.name = "pug"
90
91 [a.b.c]
92 [ d.e.f ]
93 [ g . h . i ]
94 [ j . "ʞ" . 'l' ]
95 [x.y.z.w]
96
97 name = { first = "Tom", last = "Preston-Werner" }
98 point = { x = 1, y = 2 }
99 animal = { type.name = "pug" }
100
101 [[products]]
102 name = "Hammer"
103 sku = 738594937
104
105 [[products]]
106
107 [[products]]
108 name = "Nail"
109 sku = 284758393
110 color = "gray"
111
112 [[fruit]]
113 name = "apple"
114
115 [fruit.physical]
116 color = "red"
117 shape = "round"
118
119 [[fruit.variety]]
120 name = "red delicious"
121
122 [[fruit.variety]]
123 name = "granny smith"
124
125 [[fruit]]
126 name = "banana"
127
128 [[fruit.variety]]
129 name = "plantain"
130''
diff --git a/test/testdata/eval-fail-hashfile-missing.err.exp b/test/testdata/eval-fail-hashfile-missing.err.exp
new file mode 100644
index 0000000..1e46539
--- /dev/null
+++ b/test/testdata/eval-fail-hashfile-missing.err.exp
@@ -0,0 +1,13 @@
1error:
2 … while calling the 'toString' builtin
3 at /pwd/lang/eval-fail-hashfile-missing.nix:4:3:
4 3| in
5 4| toString (builtins.concatLists (map (hash: map (builtins.hashFile hash) paths) ["md5" "sha1" "sha256" "sha512"]))
6 | ^
7 5|
8
9 … while evaluating the first argument passed to builtins.toString
10
11 … while calling the 'hashFile' builtin
12
13 error: opening file '/pwd/lang/this-file-is-definitely-not-there-7392097': No such file or directory
diff --git a/test/testdata/eval-fail-hashfile-missing.nix b/test/testdata/eval-fail-hashfile-missing.nix
new file mode 100644
index 0000000..ce098b8
--- /dev/null
+++ b/test/testdata/eval-fail-hashfile-missing.nix
@@ -0,0 +1,5 @@
1let
2 paths = [ ./this-file-is-definitely-not-there-7392097 "/and/neither/is/this/37293620" ];
3in
4 toString (builtins.concatLists (map (hash: map (builtins.hashFile hash) paths) ["md5" "sha1" "sha256" "sha512"]))
5
diff --git a/test/testdata/eval-fail-infinite-recursion-lambda.err.exp b/test/testdata/eval-fail-infinite-recursion-lambda.err.exp
new file mode 100644
index 0000000..712dd75
--- /dev/null
+++ b/test/testdata/eval-fail-infinite-recursion-lambda.err.exp
@@ -0,0 +1,38 @@
1error:
2 … from call site
3 at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:1:
4 1| (x: x x) (x: x x)
5 | ^
6 2|
7
8 … while calling anonymous lambda
9 at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:2:
10 1| (x: x x) (x: x x)
11 | ^
12 2|
13
14 … from call site
15 at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:5:
16 1| (x: x x) (x: x x)
17 | ^
18 2|
19
20 … while calling anonymous lambda
21 at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:11:
22 1| (x: x x) (x: x x)
23 | ^
24 2|
25
26 … from call site
27 at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:14:
28 1| (x: x x) (x: x x)
29 | ^
30 2|
31
32 (197 duplicate frames omitted)
33
34 error: stack overflow; max-call-depth exceeded
35 at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:14:
36 1| (x: x x) (x: x x)
37 | ^
38 2|
diff --git a/test/testdata/eval-fail-infinite-recursion-lambda.flags b/test/testdata/eval-fail-infinite-recursion-lambda.flags
new file mode 100644
index 0000000..59e20ec
--- /dev/null
+++ b/test/testdata/eval-fail-infinite-recursion-lambda.flags
@@ -0,0 +1 @@
--max-call-depth 100 \ No newline at end of file
diff --git a/test/testdata/eval-fail-infinite-recursion-lambda.nix b/test/testdata/eval-fail-infinite-recursion-lambda.nix
new file mode 100644
index 0000000..dd0a8bf
--- /dev/null
+++ b/test/testdata/eval-fail-infinite-recursion-lambda.nix
@@ -0,0 +1 @@
(x: x x) (x: x x)
diff --git a/test/testdata/eval-fail-list.err.exp b/test/testdata/eval-fail-list.err.exp
new file mode 100644
index 0000000..d492f8b
--- /dev/null
+++ b/test/testdata/eval-fail-list.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while evaluating one of the elements to concatenate
3 at /pwd/lang/eval-fail-list.nix:1:2:
4 1| 8++1
5 | ^
6 2|
7
8 error: expected a list but found an integer: 8
diff --git a/test/testdata/eval-fail-list.nix b/test/testdata/eval-fail-list.nix
new file mode 100644
index 0000000..fa749f2
--- /dev/null
+++ b/test/testdata/eval-fail-list.nix
@@ -0,0 +1 @@
8++1
diff --git a/test/testdata/eval-fail-missing-arg.err.exp b/test/testdata/eval-fail-missing-arg.err.exp
new file mode 100644
index 0000000..3b162fe
--- /dev/null
+++ b/test/testdata/eval-fail-missing-arg.err.exp
@@ -0,0 +1,12 @@
1error:
2 … from call site
3 at /pwd/lang/eval-fail-missing-arg.nix:1:1:
4 1| ({x, y, z}: x + y + z) {x = "foo"; z = "bar";}
5 | ^
6 2|
7
8 error: function 'anonymous lambda' called without required argument 'y'
9 at /pwd/lang/eval-fail-missing-arg.nix:1:2:
10 1| ({x, y, z}: x + y + z) {x = "foo"; z = "bar";}
11 | ^
12 2|
diff --git a/test/testdata/eval-fail-missing-arg.nix b/test/testdata/eval-fail-missing-arg.nix
new file mode 100644
index 0000000..c4be979
--- /dev/null
+++ b/test/testdata/eval-fail-missing-arg.nix
@@ -0,0 +1 @@
({x, y, z}: x + y + z) {x = "foo"; z = "bar";}
diff --git a/test/testdata/eval-fail-mutual-recursion.err.exp b/test/testdata/eval-fail-mutual-recursion.err.exp
new file mode 100644
index 0000000..c034afc
--- /dev/null
+++ b/test/testdata/eval-fail-mutual-recursion.err.exp
@@ -0,0 +1,64 @@
1error:
2 … from call site
3 at /pwd/lang/eval-fail-mutual-recursion.nix:36:3:
4 35| in
5 36| throwAfterA true 10
6 | ^
7 37|
8
9 … while calling 'throwAfterA'
10 at /pwd/lang/eval-fail-mutual-recursion.nix:29:26:
11 28|
12 29| throwAfterA = recurse: n:
13 | ^
14 30| if n > 0
15
16 … from call site
17 at /pwd/lang/eval-fail-mutual-recursion.nix:31:10:
18 30| if n > 0
19 31| then throwAfterA recurse (n - 1)
20 | ^
21 32| else if recurse
22
23 (19 duplicate frames omitted)
24
25 … from call site
26 at /pwd/lang/eval-fail-mutual-recursion.nix:33:10:
27 32| else if recurse
28 33| then throwAfterB true 10
29 | ^
30 34| else throw "Uh oh!";
31
32 … while calling 'throwAfterB'
33 at /pwd/lang/eval-fail-mutual-recursion.nix:22:26:
34 21| let
35 22| throwAfterB = recurse: n:
36 | ^
37 23| if n > 0
38
39 … from call site
40 at /pwd/lang/eval-fail-mutual-recursion.nix:24:10:
41 23| if n > 0
42 24| then throwAfterB recurse (n - 1)
43 | ^
44 25| else if recurse
45
46 (19 duplicate frames omitted)
47
48 … from call site
49 at /pwd/lang/eval-fail-mutual-recursion.nix:26:10:
50 25| else if recurse
51 26| then throwAfterA false 10
52 | ^
53 27| else throw "Uh oh!";
54
55 (21 duplicate frames omitted)
56
57 … while calling the 'throw' builtin
58 at /pwd/lang/eval-fail-mutual-recursion.nix:34:10:
59 33| then throwAfterB true 10
60 34| else throw "Uh oh!";
61 | ^
62 35| in
63
64 error: Uh oh!
diff --git a/test/testdata/eval-fail-mutual-recursion.nix b/test/testdata/eval-fail-mutual-recursion.nix
new file mode 100644
index 0000000..d090d31
--- /dev/null
+++ b/test/testdata/eval-fail-mutual-recursion.nix
@@ -0,0 +1,36 @@
1# Check that stack frame deduplication only affects consecutive intervals, and
2# that they are reported independently of any preceding sections, even if
3# they're indistinguishable.
4#
5# In terms of the current implementation, we check that we clear the set of
6# "seen frames" after eliding a group of frames.
7#
8# Suppose we have:
9# - 10 frames in a function A
10# - 10 frames in a function B
11# - 10 frames in a function A
12#
13# We want to output:
14# - a few frames of A (skip the rest)
15# - a few frames of B (skip the rest)
16# - a few frames of A (skip the rest)
17#
18# If we implemented this in the naive manner, we'd instead get:
19# - a few frames of A (skip the rest)
20# - a few frames of B (skip the rest, _and_ skip the remaining frames of A)
21let
22 throwAfterB = recurse: n:
23 if n > 0
24 then throwAfterB recurse (n - 1)
25 else if recurse
26 then throwAfterA false 10
27 else throw "Uh oh!";
28
29 throwAfterA = recurse: n:
30 if n > 0
31 then throwAfterA recurse (n - 1)
32 else if recurse
33 then throwAfterB true 10
34 else throw "Uh oh!";
35in
36 throwAfterA true 10
diff --git a/test/testdata/eval-fail-nested-list-items.err.exp b/test/testdata/eval-fail-nested-list-items.err.exp
new file mode 100644
index 0000000..90d4390
--- /dev/null
+++ b/test/testdata/eval-fail-nested-list-items.err.exp
@@ -0,0 +1,9 @@
1error:
2 … while evaluating a path segment
3 at /pwd/lang/eval-fail-nested-list-items.nix:11:6:
4 10|
5 11| "" + (let v = [ [ 1 2 3 4 5 6 7 8 ] [1 2 3 4]]; in builtins.deepSeq v v)
6 | ^
7 12|
8
9 error: cannot coerce a list to a string: [ [ 1 2 3 4 5 6 7 8 ] [ 1 «3 items elided» ] ]
diff --git a/test/testdata/eval-fail-nested-list-items.nix b/test/testdata/eval-fail-nested-list-items.nix
new file mode 100644
index 0000000..af45b1d
--- /dev/null
+++ b/test/testdata/eval-fail-nested-list-items.nix
@@ -0,0 +1,11 @@
1# This reproduces https://github.com/NixOS/nix/issues/10993, for lists
2# $ nix run nix/2.23.1 -- eval --expr '"" + (let v = [ [ 1 2 3 4 5 6 7 8 ] [1 2 3 4]]; in builtins.deepSeq v v)'
3# error:
4# … while evaluating a path segment
5# at «string»:1:6:
6# 1| "" + (let v = [ [ 1 2 3 4 5 6 7 8 ] [1 2 3 4]]; in builtins.deepSeq v v)
7# | ^
8#
9# error: cannot coerce a list to a string: [ [ 1 2 3 4 5 6 7 8 ] [ 1 «4294967290 items elided» ] ]
10
11"" + (let v = [ [ 1 2 3 4 5 6 7 8 ] [1 2 3 4]]; in builtins.deepSeq v v)
diff --git a/test/testdata/eval-fail-nonexist-path.err.exp b/test/testdata/eval-fail-nonexist-path.err.exp
new file mode 100644
index 0000000..a287067
--- /dev/null
+++ b/test/testdata/eval-fail-nonexist-path.err.exp
@@ -0,0 +1 @@
error: path '/pwd/lang/fnord' does not exist
diff --git a/test/testdata/eval-fail-nonexist-path.nix b/test/testdata/eval-fail-nonexist-path.nix
new file mode 100644
index 0000000..f2f0810
--- /dev/null
+++ b/test/testdata/eval-fail-nonexist-path.nix
@@ -0,0 +1,4 @@
1# This must fail to evaluate, since ./fnord doesn't exist. If it did
2# exist, it would produce "/nix/store/<hash>-fnord/xyzzy" (with an
3# appropriate context).
4"${./fnord}/xyzzy"
diff --git a/test/testdata/eval-fail-not-throws.err.exp b/test/testdata/eval-fail-not-throws.err.exp
new file mode 100644
index 0000000..fc81f72
--- /dev/null
+++ b/test/testdata/eval-fail-not-throws.err.exp
@@ -0,0 +1,14 @@
1error:
2 … in the argument of the not operator
3 at /pwd/lang/eval-fail-not-throws.nix:1:4:
4 1| ! (throw "uh oh!")
5 | ^
6 2|
7
8 … while calling the 'throw' builtin
9 at /pwd/lang/eval-fail-not-throws.nix:1:4:
10 1| ! (throw "uh oh!")
11 | ^
12 2|
13
14 error: uh oh!
diff --git a/test/testdata/eval-fail-not-throws.nix b/test/testdata/eval-fail-not-throws.nix
new file mode 100644
index 0000000..a74ce4e
--- /dev/null
+++ b/test/testdata/eval-fail-not-throws.nix
@@ -0,0 +1 @@
! (throw "uh oh!")
diff --git a/test/testdata/eval-fail-overflowing-add.err.exp b/test/testdata/eval-fail-overflowing-add.err.exp
new file mode 100644
index 0000000..6458cf1
--- /dev/null
+++ b/test/testdata/eval-fail-overflowing-add.err.exp
@@ -0,0 +1,6 @@
1error: integer overflow in adding 9223372036854775807 + 1
2 at /pwd/lang/eval-fail-overflowing-add.nix:4:8:
3 3| b = 1;
4 4| in a + b
5 | ^
6 5|
diff --git a/test/testdata/eval-fail-overflowing-add.nix b/test/testdata/eval-fail-overflowing-add.nix
new file mode 100644
index 0000000..24258fc
--- /dev/null
+++ b/test/testdata/eval-fail-overflowing-add.nix
@@ -0,0 +1,4 @@
1let
2 a = 9223372036854775807;
3 b = 1;
4in a + b
diff --git a/test/testdata/eval-fail-overflowing-div.err.exp b/test/testdata/eval-fail-overflowing-div.err.exp
new file mode 100644
index 0000000..8ce07d4
--- /dev/null
+++ b/test/testdata/eval-fail-overflowing-div.err.exp
@@ -0,0 +1,23 @@
1error:
2 … while calling the 'seq' builtin
3 at /pwd/lang/eval-fail-overflowing-div.nix:7:4:
4 6| b = -1;
5 7| in builtins.seq intMin (builtins.seq b (intMin / b))
6 | ^
7 8|
8
9 … while calling the 'seq' builtin
10 at /pwd/lang/eval-fail-overflowing-div.nix:7:25:
11 6| b = -1;
12 7| in builtins.seq intMin (builtins.seq b (intMin / b))
13 | ^
14 8|
15
16 … while calling the 'div' builtin
17 at /pwd/lang/eval-fail-overflowing-div.nix:7:48:
18 6| b = -1;
19 7| in builtins.seq intMin (builtins.seq b (intMin / b))
20 | ^
21 8|
22
23 error: integer overflow in dividing -9223372036854775808 / -1
diff --git a/test/testdata/eval-fail-overflowing-div.nix b/test/testdata/eval-fail-overflowing-div.nix
new file mode 100644
index 0000000..44fbe9d
--- /dev/null
+++ b/test/testdata/eval-fail-overflowing-div.nix
@@ -0,0 +1,7 @@
1let
2 # lol, this has to be written as an expression like this because negative
3 # numbers use unary negation rather than parsing directly, and 2**63 is out
4 # of range
5 intMin = -9223372036854775807 - 1;
6 b = -1;
7in builtins.seq intMin (builtins.seq b (intMin / b))
diff --git a/test/testdata/eval-fail-overflowing-mul.err.exp b/test/testdata/eval-fail-overflowing-mul.err.exp
new file mode 100644
index 0000000..f42b39d
--- /dev/null
+++ b/test/testdata/eval-fail-overflowing-mul.err.exp
@@ -0,0 +1,16 @@
1error:
2 … while calling the 'mul' builtin
3 at /pwd/lang/eval-fail-overflowing-mul.nix:3:10:
4 2| a = 4294967297;
5 3| in a * a * a
6 | ^
7 4|
8
9 … while calling the 'mul' builtin
10 at /pwd/lang/eval-fail-overflowing-mul.nix:3:6:
11 2| a = 4294967297;
12 3| in a * a * a
13 | ^
14 4|
15
16 error: integer overflow in multiplying 4294967297 * 4294967297
diff --git a/test/testdata/eval-fail-overflowing-mul.nix b/test/testdata/eval-fail-overflowing-mul.nix
new file mode 100644
index 0000000..6081d9c
--- /dev/null
+++ b/test/testdata/eval-fail-overflowing-mul.nix
@@ -0,0 +1,3 @@
1let
2 a = 4294967297;
3in a * a * a
diff --git a/test/testdata/eval-fail-overflowing-sub.err.exp b/test/testdata/eval-fail-overflowing-sub.err.exp
new file mode 100644
index 0000000..66a3a03
--- /dev/null
+++ b/test/testdata/eval-fail-overflowing-sub.err.exp
@@ -0,0 +1,9 @@
1error:
2 … while calling the 'sub' builtin
3 at /pwd/lang/eval-fail-overflowing-sub.nix:4:6:
4 3| b = 2;
5 4| in a - b
6 | ^
7 5|
8
9 error: integer overflow in subtracting -9223372036854775807 - 2
diff --git a/test/testdata/eval-fail-overflowing-sub.nix b/test/testdata/eval-fail-overflowing-sub.nix
new file mode 100644
index 0000000..229b8c6
--- /dev/null
+++ b/test/testdata/eval-fail-overflowing-sub.nix
@@ -0,0 +1,4 @@
1let
2 a = -9223372036854775807;
3 b = 2;
4in a - b
diff --git a/test/testdata/eval-fail-path-slash.err.exp b/test/testdata/eval-fail-path-slash.err.exp
new file mode 100644
index 0000000..e3531d3
--- /dev/null
+++ b/test/testdata/eval-fail-path-slash.err.exp
@@ -0,0 +1,6 @@
1error: path has a trailing slash
2 at /pwd/lang/eval-fail-path-slash.nix:6:12:
3 5| # and https://nixos.org/nix-dev/2016-June/020829.html
4 6| /nix/store/
5 | ^
6 7|
diff --git a/test/testdata/eval-fail-path-slash.nix b/test/testdata/eval-fail-path-slash.nix
new file mode 100644
index 0000000..8c2e104
--- /dev/null
+++ b/test/testdata/eval-fail-path-slash.nix
@@ -0,0 +1,6 @@
1# Trailing slashes in paths are not allowed.
2# This restriction could be lifted sometime,
3# for example if we make '/' a path concatenation operator.
4# See https://github.com/NixOS/nix/issues/1138
5# and https://nixos.org/nix-dev/2016-June/020829.html
6/nix/store/
diff --git a/test/testdata/eval-fail-pipe-operators.err.exp b/test/testdata/eval-fail-pipe-operators.err.exp
new file mode 100644
index 0000000..49f3fa8
--- /dev/null
+++ b/test/testdata/eval-fail-pipe-operators.err.exp
@@ -0,0 +1,5 @@
1error: experimental Nix feature 'pipe-operators' is disabled; add '--extra-experimental-features pipe-operators' to enable it
2 at /pwd/lang/eval-fail-pipe-operators.nix:1:3:
3 1| 1 |> 2
4 | ^
5 2|
diff --git a/test/testdata/eval-fail-pipe-operators.nix b/test/testdata/eval-fail-pipe-operators.nix
new file mode 100644
index 0000000..433e0fd
--- /dev/null
+++ b/test/testdata/eval-fail-pipe-operators.nix
@@ -0,0 +1 @@
1 |> 2
diff --git a/test/testdata/eval-fail-recursion.err.exp b/test/testdata/eval-fail-recursion.err.exp
new file mode 100644
index 0000000..19380dc
--- /dev/null
+++ b/test/testdata/eval-fail-recursion.err.exp
@@ -0,0 +1,12 @@
1error:
2 … in the right operand of the update (//) operator
3 at /pwd/lang/eval-fail-recursion.nix:1:12:
4 1| let a = {} // a; in a.foo
5 | ^
6 2|
7
8 error: infinite recursion encountered
9 at /pwd/lang/eval-fail-recursion.nix:1:15:
10 1| let a = {} // a; in a.foo
11 | ^
12 2|
diff --git a/test/testdata/eval-fail-recursion.nix b/test/testdata/eval-fail-recursion.nix
new file mode 100644
index 0000000..075b5ed
--- /dev/null
+++ b/test/testdata/eval-fail-recursion.nix
@@ -0,0 +1 @@
let a = {} // a; in a.foo
diff --git a/test/testdata/eval-fail-remove.err.exp b/test/testdata/eval-fail-remove.err.exp
new file mode 100644
index 0000000..292b3c3
--- /dev/null
+++ b/test/testdata/eval-fail-remove.err.exp
@@ -0,0 +1,15 @@
1error:
2 … while evaluating the attribute 'body'
3 at /pwd/lang/eval-fail-remove.nix:4:3:
4 3|
5 4| body = (removeAttrs attrs ["x"]).x;
6 | ^
7 5| }
8
9 error: attribute 'x' missing
10 at /pwd/lang/eval-fail-remove.nix:4:10:
11 3|
12 4| body = (removeAttrs attrs ["x"]).x;
13 | ^
14 5| }
15 Did you mean y?
diff --git a/test/testdata/eval-fail-remove.nix b/test/testdata/eval-fail-remove.nix
new file mode 100644
index 0000000..539e0eb
--- /dev/null
+++ b/test/testdata/eval-fail-remove.nix
@@ -0,0 +1,5 @@
1let {
2 attrs = {x = 123; y = 456;};
3
4 body = (removeAttrs attrs ["x"]).x;
5} \ No newline at end of file
diff --git a/test/testdata/eval-fail-scope-5.err.exp b/test/testdata/eval-fail-scope-5.err.exp
new file mode 100644
index 0000000..b0b05ca
--- /dev/null
+++ b/test/testdata/eval-fail-scope-5.err.exp
@@ -0,0 +1,28 @@
1error:
2 … while evaluating the attribute 'body'
3 at /pwd/lang/eval-fail-scope-5.nix:8:3:
4 7|
5 8| body = f {};
6 | ^
7 9|
8
9 … from call site
10 at /pwd/lang/eval-fail-scope-5.nix:8:10:
11 7|
12 8| body = f {};
13 | ^
14 9|
15
16 … while calling 'f'
17 at /pwd/lang/eval-fail-scope-5.nix:6:7:
18 5|
19 6| f = {x ? y, y ? x}: x + y;
20 | ^
21 7|
22
23 error: infinite recursion encountered
24 at /pwd/lang/eval-fail-scope-5.nix:6:12:
25 5|
26 6| f = {x ? y, y ? x}: x + y;
27 | ^
28 7|
diff --git a/test/testdata/eval-fail-scope-5.nix b/test/testdata/eval-fail-scope-5.nix
new file mode 100644
index 0000000..f89a65a
--- /dev/null
+++ b/test/testdata/eval-fail-scope-5.nix
@@ -0,0 +1,10 @@
1let {
2
3 x = "a";
4 y = "b";
5
6 f = {x ? y, y ? x}: x + y;
7
8 body = f {};
9
10}
diff --git a/test/testdata/eval-fail-seq.err.exp b/test/testdata/eval-fail-seq.err.exp
new file mode 100644
index 0000000..3e3d71b
--- /dev/null
+++ b/test/testdata/eval-fail-seq.err.exp
@@ -0,0 +1,14 @@
1error:
2 … while calling the 'seq' builtin
3 at /pwd/lang/eval-fail-seq.nix:1:1:
4 1| builtins.seq (abort "foo") 2
5 | ^
6 2|
7
8 … while calling the 'abort' builtin
9 at /pwd/lang/eval-fail-seq.nix:1:15:
10 1| builtins.seq (abort "foo") 2
11 | ^
12 2|
13
14 error: evaluation aborted with the following error message: 'foo'
diff --git a/test/testdata/eval-fail-seq.nix b/test/testdata/eval-fail-seq.nix
new file mode 100644
index 0000000..cddbbfd
--- /dev/null
+++ b/test/testdata/eval-fail-seq.nix
@@ -0,0 +1 @@
builtins.seq (abort "foo") 2
diff --git a/test/testdata/eval-fail-set-override.err.exp b/test/testdata/eval-fail-set-override.err.exp
new file mode 100644
index 0000000..9006ca4
--- /dev/null
+++ b/test/testdata/eval-fail-set-override.err.exp
@@ -0,0 +1,4 @@
1error:
2 … while evaluating the `__overrides` attribute
3
4 error: expected a set but found an integer: 1
diff --git a/test/testdata/eval-fail-set-override.nix b/test/testdata/eval-fail-set-override.nix
new file mode 100644
index 0000000..03551c1
--- /dev/null
+++ b/test/testdata/eval-fail-set-override.nix
@@ -0,0 +1 @@
rec { __overrides = 1; }
diff --git a/test/testdata/eval-fail-set.err.exp b/test/testdata/eval-fail-set.err.exp
new file mode 100644
index 0000000..6dd646e
--- /dev/null
+++ b/test/testdata/eval-fail-set.err.exp
@@ -0,0 +1,5 @@
1error: undefined variable 'x'
2 at /pwd/lang/eval-fail-set.nix:1:3:
3 1| 8.x
4 | ^
5 2|
diff --git a/test/testdata/eval-fail-set.nix b/test/testdata/eval-fail-set.nix
new file mode 100644
index 0000000..c6b7980
--- /dev/null
+++ b/test/testdata/eval-fail-set.nix
@@ -0,0 +1 @@
8.x
diff --git a/test/testdata/eval-fail-substring.err.exp b/test/testdata/eval-fail-substring.err.exp
new file mode 100644
index 0000000..0457a82
--- /dev/null
+++ b/test/testdata/eval-fail-substring.err.exp
@@ -0,0 +1,8 @@
1error:
2 … while calling the 'substring' builtin
3 at /pwd/lang/eval-fail-substring.nix:1:1:
4 1| builtins.substring (builtins.sub 0 1) 1 "x"
5 | ^
6 2|
7
8 error: negative start position in 'substring'
diff --git a/test/testdata/eval-fail-substring.nix b/test/testdata/eval-fail-substring.nix
new file mode 100644
index 0000000..f37c2bc
--- /dev/null
+++ b/test/testdata/eval-fail-substring.nix
@@ -0,0 +1 @@
builtins.substring (builtins.sub 0 1) 1 "x"
diff --git a/test/testdata/eval-fail-to-path.err.exp b/test/testdata/eval-fail-to-path.err.exp
new file mode 100644
index 0000000..d6b17be
--- /dev/null
+++ b/test/testdata/eval-fail-to-path.err.exp
@@ -0,0 +1,10 @@
1error:
2 … while calling the 'toPath' builtin
3 at /pwd/lang/eval-fail-to-path.nix:1:1:
4 1| builtins.toPath "foo/bar"
5 | ^
6 2|
7
8 … while evaluating the first argument passed to builtins.toPath
9
10 error: string 'foo/bar' doesn't represent an absolute path
diff --git a/test/testdata/eval-fail-to-path.nix b/test/testdata/eval-fail-to-path.nix
new file mode 100644
index 0000000..5e322bc
--- /dev/null
+++ b/test/testdata/eval-fail-to-path.nix
@@ -0,0 +1 @@
builtins.toPath "foo/bar"
diff --git a/test/testdata/eval-fail-toJSON.err.exp b/test/testdata/eval-fail-toJSON.err.exp
new file mode 100644
index 0000000..ad26771
--- /dev/null
+++ b/test/testdata/eval-fail-toJSON.err.exp
@@ -0,0 +1,50 @@
1error:
2 … while calling the 'toJSON' builtin
3 at /pwd/lang/eval-fail-toJSON.nix:1:1:
4 1| builtins.toJSON {
5 | ^
6 2| a.b = [
7
8 … while evaluating attribute 'a'
9 at /pwd/lang/eval-fail-toJSON.nix:2:3:
10 1| builtins.toJSON {
11 2| a.b = [
12 | ^
13 3| true
14
15 … while evaluating attribute 'b'
16 at /pwd/lang/eval-fail-toJSON.nix:2:3:
17 1| builtins.toJSON {
18 2| a.b = [
19 | ^
20 3| true
21
22 … while evaluating list element at index 3
23 at /pwd/lang/eval-fail-toJSON.nix:2:3:
24 1| builtins.toJSON {
25 2| a.b = [
26 | ^
27 3| true
28
29 … while evaluating attribute 'c'
30 at /pwd/lang/eval-fail-toJSON.nix:7:7:
31 6| {
32 7| c.d = throw "hah no";
33 | ^
34 8| }
35
36 … while evaluating attribute 'd'
37 at /pwd/lang/eval-fail-toJSON.nix:7:7:
38 6| {
39 7| c.d = throw "hah no";
40 | ^
41 8| }
42
43 … while calling the 'throw' builtin
44 at /pwd/lang/eval-fail-toJSON.nix:7:13:
45 6| {
46 7| c.d = throw "hah no";
47 | ^
48 8| }
49
50 error: hah no
diff --git a/test/testdata/eval-fail-toJSON.nix b/test/testdata/eval-fail-toJSON.nix
new file mode 100644
index 0000000..8112e1c
--- /dev/null
+++ b/test/testdata/eval-fail-toJSON.nix
@@ -0,0 +1,10 @@
1builtins.toJSON {
2 a.b = [
3 true
4 false
5 "it's a bird"
6 {
7 c.d = throw "hah no";
8 }
9 ];
10}
diff --git a/test/testdata/eval-fail-undeclared-arg.err.exp b/test/testdata/eval-fail-undeclared-arg.err.exp
new file mode 100644
index 0000000..6e13a13
--- /dev/null
+++ b/test/testdata/eval-fail-undeclared-arg.err.exp
@@ -0,0 +1,13 @@
1error:
2 … from call site
3 at /pwd/lang/eval-fail-undeclared-arg.nix:1:1:
4 1| ({x, z}: x + z) {x = "foo"; y = "bla"; z = "bar";}
5 | ^
6 2|
7
8 error: function 'anonymous lambda' called with unexpected argument 'y'
9 at /pwd/lang/eval-fail-undeclared-arg.nix:1:2:
10 1| ({x, z}: x + z) {x = "foo"; y = "bla"; z = "bar";}
11 | ^
12 2|
13 Did you mean one of x or z?
diff --git a/test/testdata/eval-fail-undeclared-arg.nix b/test/testdata/eval-fail-undeclared-arg.nix
new file mode 100644
index 0000000..cafdf16
--- /dev/null
+++ b/test/testdata/eval-fail-undeclared-arg.nix
@@ -0,0 +1 @@
({x, z}: x + z) {x = "foo"; y = "bla"; z = "bar";}
diff --git a/test/testdata/eval-fail-using-set-as-attr-name.err.exp b/test/testdata/eval-fail-using-set-as-attr-name.err.exp
new file mode 100644
index 0000000..4326c96
--- /dev/null
+++ b/test/testdata/eval-fail-using-set-as-attr-name.err.exp
@@ -0,0 +1,14 @@
1error:
2 … while evaluating an attribute name
3 at /pwd/lang/eval-fail-using-set-as-attr-name.nix:5:10:
4 4| in
5 5| attr.${key}
6 | ^
7 6|
8
9 error: expected a string but found a set: { }
10 at /pwd/lang/eval-fail-using-set-as-attr-name.nix:5:10:
11 4| in
12 5| attr.${key}
13 | ^
14 6|
diff --git a/test/testdata/eval-fail-using-set-as-attr-name.nix b/test/testdata/eval-fail-using-set-as-attr-name.nix
new file mode 100644
index 0000000..48e071a
--- /dev/null
+++ b/test/testdata/eval-fail-using-set-as-attr-name.nix
@@ -0,0 +1,5 @@
1let
2 attr = {foo = "bar";};
3 key = {};
4in
5 attr.${key}
diff --git a/test/testdata/eval-okay-any-all.exp b/test/testdata/eval-okay-any-all.exp
new file mode 100644
index 0000000..eb273f4
--- /dev/null
+++ b/test/testdata/eval-okay-any-all.exp
@@ -0,0 +1 @@
[ false false true true true true false true ]
diff --git a/test/testdata/eval-okay-any-all.nix b/test/testdata/eval-okay-any-all.nix
new file mode 100644
index 0000000..a3f26ea
--- /dev/null
+++ b/test/testdata/eval-okay-any-all.nix
@@ -0,0 +1,11 @@
1with builtins;
2
3[ (any (x: x == 1) [])
4 (any (x: x == 1) [2 3 4])
5 (any (x: x == 1) [1 2 3 4])
6 (any (x: x == 1) [4 3 2 1])
7 (all (x: x == 1) [])
8 (all (x: x == 1) [1])
9 (all (x: x == 1) [1 2 3])
10 (all (x: x == 1) [1 1 1])
11]
diff --git a/test/testdata/eval-okay-arithmetic.exp b/test/testdata/eval-okay-arithmetic.exp
new file mode 100644
index 0000000..5c54d10
--- /dev/null
+++ b/test/testdata/eval-okay-arithmetic.exp
@@ -0,0 +1 @@
2216
diff --git a/test/testdata/eval-okay-arithmetic.nix b/test/testdata/eval-okay-arithmetic.nix
new file mode 100644
index 0000000..7e9e6a0
--- /dev/null
+++ b/test/testdata/eval-okay-arithmetic.nix
@@ -0,0 +1,59 @@
1with import ./lib.nix;
2
3let {
4
5 /* Supposedly tail recursive version:
6
7 range_ = accum: first: last:
8 if first == last then ([first] ++ accum)
9 else range_ ([first] ++ accum) (builtins.add first 1) last;
10
11 range = range_ [];
12 */
13
14 x = 12;
15
16 err = abort "urgh";
17
18 body = sum
19 [ (sum (range 1 50))
20 (123 + 456)
21 (0 + -10 + -(-11) + -x)
22 (10 - 7 - -2)
23 (10 - (6 - -1))
24 (10 - 1 + 2)
25 (3 * 4 * 5)
26 (56088 / 123 / 2)
27 (3 + 4 * const 5 0 - 6 / id 2)
28
29 (builtins.bitAnd 12 10) # 0b1100 & 0b1010 = 8
30 (builtins.bitOr 12 10) # 0b1100 | 0b1010 = 14
31 (builtins.bitXor 12 10) # 0b1100 ^ 0b1010 = 6
32
33 (if 3 < 7 then 1 else err)
34 (if 7 < 3 then err else 1)
35 (if 3 < 3 then err else 1)
36
37 (if 3 <= 7 then 1 else err)
38 (if 7 <= 3 then err else 1)
39 (if 3 <= 3 then 1 else err)
40
41 (if 3 > 7 then err else 1)
42 (if 7 > 3 then 1 else err)
43 (if 3 > 3 then err else 1)
44
45 (if 3 >= 7 then err else 1)
46 (if 7 >= 3 then 1 else err)
47 (if 3 >= 3 then 1 else err)
48
49 (if 2 > 1 == 1 < 2 then 1 else err)
50 (if 1 + 2 * 3 >= 7 then 1 else err)
51 (if 1 + 2 * 3 < 7 then err else 1)
52
53 # Not integer, but so what.
54 (if "aa" < "ab" then 1 else err)
55 (if "aa" < "aa" then err else 1)
56 (if "foo" < "foobar" then 1 else err)
57 ];
58
59}
diff --git a/test/testdata/eval-okay-attrnames.exp b/test/testdata/eval-okay-attrnames.exp
new file mode 100644
index 0000000..b4aa387
--- /dev/null
+++ b/test/testdata/eval-okay-attrnames.exp
@@ -0,0 +1 @@
"newxfoonewxy"
diff --git a/test/testdata/eval-okay-attrnames.nix b/test/testdata/eval-okay-attrnames.nix
new file mode 100644
index 0000000..e5b26e9
--- /dev/null
+++ b/test/testdata/eval-okay-attrnames.nix
@@ -0,0 +1,11 @@
1with import ./lib.nix;
2
3let
4
5 attrs = {y = "y"; x = "x"; foo = "foo";} // rec {x = "newx"; bar = x;};
6
7 names = builtins.attrNames attrs;
8
9 values = map (name: builtins.getAttr name attrs) names;
10
11in assert values == builtins.attrValues attrs; concat values
diff --git a/test/testdata/eval-okay-attrs.exp b/test/testdata/eval-okay-attrs.exp
new file mode 100644
index 0000000..45b0f82
--- /dev/null
+++ b/test/testdata/eval-okay-attrs.exp
@@ -0,0 +1 @@
987
diff --git a/test/testdata/eval-okay-attrs.nix b/test/testdata/eval-okay-attrs.nix
new file mode 100644
index 0000000..810b31a
--- /dev/null
+++ b/test/testdata/eval-okay-attrs.nix
@@ -0,0 +1,5 @@
1let {
2 as = { x = 123; y = 456; } // { z = 789; } // { z = 987; };
3
4 body = if as ? a then as.a else assert as ? z; as.z;
5}
diff --git a/test/testdata/eval-okay-attrs2.exp b/test/testdata/eval-okay-attrs2.exp
new file mode 100644
index 0000000..45b0f82
--- /dev/null
+++ b/test/testdata/eval-okay-attrs2.exp
@@ -0,0 +1 @@
987
diff --git a/test/testdata/eval-okay-attrs2.nix b/test/testdata/eval-okay-attrs2.nix
new file mode 100644
index 0000000..9e06b83
--- /dev/null
+++ b/test/testdata/eval-okay-attrs2.nix
@@ -0,0 +1,10 @@
1let {
2 as = { x = 123; y = 456; } // { z = 789; } // { z = 987; };
3
4 A = "a";
5 Z = "z";
6
7 body = if builtins.hasAttr A as
8 then builtins.getAttr A as
9 else assert builtins.hasAttr Z as; builtins.getAttr Z as;
10}
diff --git a/test/testdata/eval-okay-attrs3.exp b/test/testdata/eval-okay-attrs3.exp
new file mode 100644
index 0000000..19de4fd
--- /dev/null
+++ b/test/testdata/eval-okay-attrs3.exp
@@ -0,0 +1 @@
"foo 22 80 itchyxac"
diff --git a/test/testdata/eval-okay-attrs3.nix b/test/testdata/eval-okay-attrs3.nix
new file mode 100644
index 0000000..f29de11
--- /dev/null
+++ b/test/testdata/eval-okay-attrs3.nix
@@ -0,0 +1,22 @@
1let
2
3 config =
4 {
5 services.sshd.enable = true;
6 services.sshd.port = 22;
7 services.httpd.port = 80;
8 hostName = "itchy";
9 a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z = "x";
10 foo = {
11 a = "a";
12 b.c = "c";
13 };
14 };
15
16in
17 if config.services.sshd.enable
18 then "foo ${toString config.services.sshd.port} ${toString config.services.httpd.port} ${config.hostName}"
19 + "${config.a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z}"
20 + "${config.foo.a}"
21 + "${config.foo.b.c}"
22 else "bar"
diff --git a/test/testdata/eval-okay-attrs4.exp b/test/testdata/eval-okay-attrs4.exp
new file mode 100644
index 0000000..1851731
--- /dev/null
+++ b/test/testdata/eval-okay-attrs4.exp
@@ -0,0 +1 @@
[ true false true false false true false false ]
diff --git a/test/testdata/eval-okay-attrs4.nix b/test/testdata/eval-okay-attrs4.nix
new file mode 100644
index 0000000..43ec812
--- /dev/null
+++ b/test/testdata/eval-okay-attrs4.nix
@@ -0,0 +1,7 @@
1let
2
3 as = { x.y.z = 123; a.b.c = 456; };
4
5 bs = null;
6
7in [ (as ? x) (as ? y) (as ? x.y.z) (as ? x.y.z.a) (as ? x.y.a) (as ? a.b.c) (bs ? x) (bs ? x.y.z) ]
diff --git a/test/testdata/eval-okay-attrs5.exp b/test/testdata/eval-okay-attrs5.exp
new file mode 100644
index 0000000..ce0430d
--- /dev/null
+++ b/test/testdata/eval-okay-attrs5.exp
@@ -0,0 +1 @@
[ 123 "foo" 456 456 "foo" "xyzzy" "xyzzy" true ]
diff --git a/test/testdata/eval-okay-attrs5.nix b/test/testdata/eval-okay-attrs5.nix
new file mode 100644
index 0000000..a4584cd
--- /dev/null
+++ b/test/testdata/eval-okay-attrs5.nix
@@ -0,0 +1,21 @@
1with import ./lib.nix;
2
3let
4
5 as = { x.y.z = 123; a.b.c = 456; };
6
7 bs = { f-o-o.bar = "foo"; };
8
9 or = x: y: x || y;
10
11in
12 [ as.x.y.z
13 as.foo or "foo"
14 as.x.y.bla or as.a.b.c
15 as.a.b.c or as.x.y.z
16 as.x.y.bla or bs.f-o-o.bar or "xyzzy"
17 as.x.y.bla or bs.bar.foo or "xyzzy"
18 (123).bla or null.foo or "xyzzy"
19 # Backwards compatibility test.
20 (fold or [] [true false false])
21 ]
diff --git a/test/testdata/eval-okay-attrs6.exp b/test/testdata/eval-okay-attrs6.exp
new file mode 100644
index 0000000..b469380
--- /dev/null
+++ b/test/testdata/eval-okay-attrs6.exp
@@ -0,0 +1 @@
{ __overrides = { bar = "qux"; }; bar = "qux"; foo = "bar"; }
diff --git a/test/testdata/eval-okay-attrs6.nix b/test/testdata/eval-okay-attrs6.nix
new file mode 100644
index 0000000..2e5c854
--- /dev/null
+++ b/test/testdata/eval-okay-attrs6.nix
@@ -0,0 +1,4 @@
1rec {
2 "${"foo"}" = "bar";
3 __overrides = { bar = "qux"; };
4}
diff --git a/test/testdata/eval-okay-autoargs.exp b/test/testdata/eval-okay-autoargs.exp
new file mode 100644
index 0000000..7a83917
--- /dev/null
+++ b/test/testdata/eval-okay-autoargs.exp
@@ -0,0 +1 @@
"xyzzy!xyzzy!foobar"
diff --git a/test/testdata/eval-okay-autoargs.flags b/test/testdata/eval-okay-autoargs.flags
new file mode 100644
index 0000000..ae37622
--- /dev/null
+++ b/test/testdata/eval-okay-autoargs.flags
@@ -0,0 +1 @@
--arg lib import(lang/lib.nix) --argstr xyzzy xyzzy! -A result
diff --git a/test/testdata/eval-okay-autoargs.nix b/test/testdata/eval-okay-autoargs.nix
new file mode 100644
index 0000000..815f51b
--- /dev/null
+++ b/test/testdata/eval-okay-autoargs.nix
@@ -0,0 +1,15 @@
1let
2
3 foobar = "foobar";
4
5in
6
7{ xyzzy2 ? xyzzy # mutually recursive args
8, xyzzy ? "blaat" # will be overridden by --argstr
9, fb ? foobar
10, lib # will be set by --arg
11}:
12
13{
14 result = lib.concat [xyzzy xyzzy2 fb];
15}
diff --git a/test/testdata/eval-okay-backslash-newline-1.exp b/test/testdata/eval-okay-backslash-newline-1.exp
new file mode 100644
index 0000000..3e75436
--- /dev/null
+++ b/test/testdata/eval-okay-backslash-newline-1.exp
@@ -0,0 +1 @@
"a\nb"
diff --git a/test/testdata/eval-okay-backslash-newline-1.nix b/test/testdata/eval-okay-backslash-newline-1.nix
new file mode 100644
index 0000000..7fef3dd
--- /dev/null
+++ b/test/testdata/eval-okay-backslash-newline-1.nix
@@ -0,0 +1,2 @@
1"a\
2b"
diff --git a/test/testdata/eval-okay-backslash-newline-2.exp b/test/testdata/eval-okay-backslash-newline-2.exp
new file mode 100644
index 0000000..3e75436
--- /dev/null
+++ b/test/testdata/eval-okay-backslash-newline-2.exp
@@ -0,0 +1 @@
"a\nb"
diff --git a/test/testdata/eval-okay-backslash-newline-2.nix b/test/testdata/eval-okay-backslash-newline-2.nix
new file mode 100644
index 0000000..35ddf49
--- /dev/null
+++ b/test/testdata/eval-okay-backslash-newline-2.nix
@@ -0,0 +1,2 @@
1''a''\
2b''
diff --git a/test/testdata/eval-okay-baseNameOf.exp b/test/testdata/eval-okay-baseNameOf.exp
new file mode 100644
index 0000000..52c33a5
--- /dev/null
+++ b/test/testdata/eval-okay-baseNameOf.exp
@@ -0,0 +1 @@
"ok"
diff --git a/test/testdata/eval-okay-baseNameOf.nix b/test/testdata/eval-okay-baseNameOf.nix
new file mode 100644
index 0000000..a7afdd8
--- /dev/null
+++ b/test/testdata/eval-okay-baseNameOf.nix
@@ -0,0 +1,32 @@
1assert baseNameOf "" == "";
2assert baseNameOf "." == ".";
3assert baseNameOf ".." == "..";
4assert baseNameOf "a" == "a";
5assert baseNameOf "a." == "a.";
6assert baseNameOf "a.." == "a..";
7assert baseNameOf "a.b" == "a.b";
8assert baseNameOf "a.b." == "a.b.";
9assert baseNameOf "a.b.." == "a.b..";
10assert baseNameOf "a/" == "a";
11assert baseNameOf "a/." == ".";
12assert baseNameOf "a/.." == "..";
13assert baseNameOf "a/b" == "b";
14assert baseNameOf "a/b." == "b.";
15assert baseNameOf "a/b.." == "b..";
16assert baseNameOf "a/b/c" == "c";
17assert baseNameOf "a/b/c." == "c.";
18assert baseNameOf "a/b/c.." == "c..";
19assert baseNameOf "a/b/c/d" == "d";
20assert baseNameOf "a/b/c/d." == "d.";
21assert baseNameOf "a\\b" == "a\\b";
22assert baseNameOf "C:a" == "C:a";
23assert baseNameOf "a//b" == "b";
24
25# It's been like this for close to a decade. We ought to commit to it.
26# https://github.com/NixOS/nix/pull/582#issuecomment-121014450
27assert baseNameOf "a//" == "";
28
29assert baseNameOf ./foo == "foo";
30assert baseNameOf ./foo/bar == "bar";
31
32"ok"
diff --git a/test/testdata/eval-okay-builtins-add.exp b/test/testdata/eval-okay-builtins-add.exp
new file mode 100644
index 0000000..0350b51
--- /dev/null
+++ b/test/testdata/eval-okay-builtins-add.exp
@@ -0,0 +1 @@
[ 5 4 "int" "tt" "float" 4 ]
diff --git a/test/testdata/eval-okay-builtins-add.nix b/test/testdata/eval-okay-builtins-add.nix
new file mode 100644
index 0000000..c841816
--- /dev/null
+++ b/test/testdata/eval-okay-builtins-add.nix
@@ -0,0 +1,8 @@
1[
2(builtins.add 2 3)
3(builtins.add 2 2)
4(builtins.typeOf (builtins.add 2 2))
5("t" + "t")
6(builtins.typeOf (builtins.add 2.0 2))
7(builtins.add 2.0 2)
8]
diff --git a/test/testdata/eval-okay-builtins.exp b/test/testdata/eval-okay-builtins.exp
new file mode 100644
index 0000000..0661686
--- /dev/null
+++ b/test/testdata/eval-okay-builtins.exp
@@ -0,0 +1 @@
/foo
diff --git a/test/testdata/eval-okay-builtins.nix b/test/testdata/eval-okay-builtins.nix
new file mode 100644
index 0000000..e9d65e8
--- /dev/null
+++ b/test/testdata/eval-okay-builtins.nix
@@ -0,0 +1,12 @@
1assert builtins ? currentSystem;
2assert !builtins ? __currentSystem;
3
4let {
5
6 x = if builtins ? dirOf then builtins.dirOf /foo/bar else "";
7
8 y = if builtins ? fnord then builtins.fnord "foo" else "";
9
10 body = x + y;
11
12}
diff --git a/test/testdata/eval-okay-callable-attrs.exp b/test/testdata/eval-okay-callable-attrs.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-callable-attrs.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-callable-attrs.nix b/test/testdata/eval-okay-callable-attrs.nix
new file mode 100644
index 0000000..310a030
--- /dev/null
+++ b/test/testdata/eval-okay-callable-attrs.nix
@@ -0,0 +1 @@
({ __functor = self: x: self.foo && x; foo = false; } // { foo = true; }) true
diff --git a/test/testdata/eval-okay-catattrs.exp b/test/testdata/eval-okay-catattrs.exp
new file mode 100644
index 0000000..b4a1e66
--- /dev/null
+++ b/test/testdata/eval-okay-catattrs.exp
@@ -0,0 +1 @@
[ 1 2 ]
diff --git a/test/testdata/eval-okay-catattrs.nix b/test/testdata/eval-okay-catattrs.nix
new file mode 100644
index 0000000..2c3dc10
--- /dev/null
+++ b/test/testdata/eval-okay-catattrs.nix
@@ -0,0 +1 @@
builtins.catAttrs "a" [ { a = 1; } { b = 0; } { a = 2; } ]
diff --git a/test/testdata/eval-okay-closure.exp b/test/testdata/eval-okay-closure.exp
new file mode 100644
index 0000000..e7dbf97
--- /dev/null
+++ b/test/testdata/eval-okay-closure.exp
@@ -0,0 +1 @@
[ { foo = true; key = -13; } { foo = true; key = -12; } { foo = true; key = -11; } { foo = true; key = -9; } { foo = true; key = -8; } { foo = true; key = -7; } { foo = true; key = -5; } { foo = true; key = -4; } { foo = true; key = -3; } { key = -1; } { foo = true; key = 0; } { foo = true; key = 1; } { foo = true; key = 2; } { foo = true; key = 4; } { foo = true; key = 5; } { foo = true; key = 6; } { key = 8; } { foo = true; key = 9; } { foo = true; key = 10; } { foo = true; key = 13; } { foo = true; key = 14; } { foo = true; key = 15; } { key = 17; } { foo = true; key = 18; } { foo = true; key = 19; } { foo = true; key = 22; } { foo = true; key = 23; } { key = 26; } { foo = true; key = 27; } { foo = true; key = 28; } { foo = true; key = 31; } { foo = true; key = 32; } { key = 35; } { foo = true; key = 36; } { foo = true; key = 40; } { foo = true; key = 41; } { key = 44; } { foo = true; key = 45; } { foo = true; key = 49; } { key = 53; } { foo = true; key = 54; } { foo = true; key = 58; } { key = 62; } { foo = true; key = 67; } { key = 71; } { key = 80; } ]
diff --git a/test/testdata/eval-okay-closure.exp.xml b/test/testdata/eval-okay-closure.exp.xml
new file mode 100644
index 0000000..dffc03a
--- /dev/null
+++ b/test/testdata/eval-okay-closure.exp.xml
@@ -0,0 +1,343 @@
1<?xml version='1.0' encoding='utf-8'?>
2<expr>
3 <list>
4 <attrs>
5 <attr name="foo">
6 <bool value="true" />
7 </attr>
8 <attr name="key">
9 <int value="-13" />
10 </attr>
11 </attrs>
12 <attrs>
13 <attr name="foo">
14 <bool value="true" />
15 </attr>
16 <attr name="key">
17 <int value="-12" />
18 </attr>
19 </attrs>
20 <attrs>
21 <attr name="foo">
22 <bool value="true" />
23 </attr>
24 <attr name="key">
25 <int value="-11" />
26 </attr>
27 </attrs>
28 <attrs>
29 <attr name="foo">
30 <bool value="true" />
31 </attr>
32 <attr name="key">
33 <int value="-9" />
34 </attr>
35 </attrs>
36 <attrs>
37 <attr name="foo">
38 <bool value="true" />
39 </attr>
40 <attr name="key">
41 <int value="-8" />
42 </attr>
43 </attrs>
44 <attrs>
45 <attr name="foo">
46 <bool value="true" />
47 </attr>
48 <attr name="key">
49 <int value="-7" />
50 </attr>
51 </attrs>
52 <attrs>
53 <attr name="foo">
54 <bool value="true" />
55 </attr>
56 <attr name="key">
57 <int value="-5" />
58 </attr>
59 </attrs>
60 <attrs>
61 <attr name="foo">
62 <bool value="true" />
63 </attr>
64 <attr name="key">
65 <int value="-4" />
66 </attr>
67 </attrs>
68 <attrs>
69 <attr name="foo">
70 <bool value="true" />
71 </attr>
72 <attr name="key">
73 <int value="-3" />
74 </attr>
75 </attrs>
76 <attrs>
77 <attr name="key">
78 <int value="-1" />
79 </attr>
80 </attrs>
81 <attrs>
82 <attr name="foo">
83 <bool value="true" />
84 </attr>
85 <attr name="key">
86 <int value="0" />
87 </attr>
88 </attrs>
89 <attrs>
90 <attr name="foo">
91 <bool value="true" />
92 </attr>
93 <attr name="key">
94 <int value="1" />
95 </attr>
96 </attrs>
97 <attrs>
98 <attr name="foo">
99 <bool value="true" />
100 </attr>
101 <attr name="key">
102 <int value="2" />
103 </attr>
104 </attrs>
105 <attrs>
106 <attr name="foo">
107 <bool value="true" />
108 </attr>
109 <attr name="key">
110 <int value="4" />
111 </attr>
112 </attrs>
113 <attrs>
114 <attr name="foo">
115 <bool value="true" />
116 </attr>
117 <attr name="key">
118 <int value="5" />
119 </attr>
120 </attrs>
121 <attrs>
122 <attr name="foo">
123 <bool value="true" />
124 </attr>
125 <attr name="key">
126 <int value="6" />
127 </attr>
128 </attrs>
129 <attrs>
130 <attr name="key">
131 <int value="8" />
132 </attr>
133 </attrs>
134 <attrs>
135 <attr name="foo">
136 <bool value="true" />
137 </attr>
138 <attr name="key">
139 <int value="9" />
140 </attr>
141 </attrs>
142 <attrs>
143 <attr name="foo">
144 <bool value="true" />
145 </attr>
146 <attr name="key">
147 <int value="10" />
148 </attr>
149 </attrs>
150 <attrs>
151 <attr name="foo">
152 <bool value="true" />
153 </attr>
154 <attr name="key">
155 <int value="13" />
156 </attr>
157 </attrs>
158 <attrs>
159 <attr name="foo">
160 <bool value="true" />
161 </attr>
162 <attr name="key">
163 <int value="14" />
164 </attr>
165 </attrs>
166 <attrs>
167 <attr name="foo">
168 <bool value="true" />
169 </attr>
170 <attr name="key">
171 <int value="15" />
172 </attr>
173 </attrs>
174 <attrs>
175 <attr name="key">
176 <int value="17" />
177 </attr>
178 </attrs>
179 <attrs>
180 <attr name="foo">
181 <bool value="true" />
182 </attr>
183 <attr name="key">
184 <int value="18" />
185 </attr>
186 </attrs>
187 <attrs>
188 <attr name="foo">
189 <bool value="true" />
190 </attr>
191 <attr name="key">
192 <int value="19" />
193 </attr>
194 </attrs>
195 <attrs>
196 <attr name="foo">
197 <bool value="true" />
198 </attr>
199 <attr name="key">
200 <int value="22" />
201 </attr>
202 </attrs>
203 <attrs>
204 <attr name="foo">
205 <bool value="true" />
206 </attr>
207 <attr name="key">
208 <int value="23" />
209 </attr>
210 </attrs>
211 <attrs>
212 <attr name="key">
213 <int value="26" />
214 </attr>
215 </attrs>
216 <attrs>
217 <attr name="foo">
218 <bool value="true" />
219 </attr>
220 <attr name="key">
221 <int value="27" />
222 </attr>
223 </attrs>
224 <attrs>
225 <attr name="foo">
226 <bool value="true" />
227 </attr>
228 <attr name="key">
229 <int value="28" />
230 </attr>
231 </attrs>
232 <attrs>
233 <attr name="foo">
234 <bool value="true" />
235 </attr>
236 <attr name="key">
237 <int value="31" />
238 </attr>
239 </attrs>
240 <attrs>
241 <attr name="foo">
242 <bool value="true" />
243 </attr>
244 <attr name="key">
245 <int value="32" />
246 </attr>
247 </attrs>
248 <attrs>
249 <attr name="key">
250 <int value="35" />
251 </attr>
252 </attrs>
253 <attrs>
254 <attr name="foo">
255 <bool value="true" />
256 </attr>
257 <attr name="key">
258 <int value="36" />
259 </attr>
260 </attrs>
261 <attrs>
262 <attr name="foo">
263 <bool value="true" />
264 </attr>
265 <attr name="key">
266 <int value="40" />
267 </attr>
268 </attrs>
269 <attrs>
270 <attr name="foo">
271 <bool value="true" />
272 </attr>
273 <attr name="key">
274 <int value="41" />
275 </attr>
276 </attrs>
277 <attrs>
278 <attr name="key">
279 <int value="44" />
280 </attr>
281 </attrs>
282 <attrs>
283 <attr name="foo">
284 <bool value="true" />
285 </attr>
286 <attr name="key">
287 <int value="45" />
288 </attr>
289 </attrs>
290 <attrs>
291 <attr name="foo">
292 <bool value="true" />
293 </attr>
294 <attr name="key">
295 <int value="49" />
296 </attr>
297 </attrs>
298 <attrs>
299 <attr name="key">
300 <int value="53" />
301 </attr>
302 </attrs>
303 <attrs>
304 <attr name="foo">
305 <bool value="true" />
306 </attr>
307 <attr name="key">
308 <int value="54" />
309 </attr>
310 </attrs>
311 <attrs>
312 <attr name="foo">
313 <bool value="true" />
314 </attr>
315 <attr name="key">
316 <int value="58" />
317 </attr>
318 </attrs>
319 <attrs>
320 <attr name="key">
321 <int value="62" />
322 </attr>
323 </attrs>
324 <attrs>
325 <attr name="foo">
326 <bool value="true" />
327 </attr>
328 <attr name="key">
329 <int value="67" />
330 </attr>
331 </attrs>
332 <attrs>
333 <attr name="key">
334 <int value="71" />
335 </attr>
336 </attrs>
337 <attrs>
338 <attr name="key">
339 <int value="80" />
340 </attr>
341 </attrs>
342 </list>
343</expr>
diff --git a/test/testdata/eval-okay-closure.nix b/test/testdata/eval-okay-closure.nix
new file mode 100644
index 0000000..cccd4dc
--- /dev/null
+++ b/test/testdata/eval-okay-closure.nix
@@ -0,0 +1,13 @@
1let
2
3 closure = builtins.genericClosure {
4 startSet = [{key = 80;}];
5 operator = {key, foo ? false}:
6 if builtins.lessThan key 0
7 then []
8 else [{key = builtins.sub key 9;} {key = builtins.sub key 13; foo = true;}];
9 };
10
11 sort = (import ./lib.nix).sortBy (a: b: builtins.lessThan a.key b.key);
12
13in sort closure
diff --git a/test/testdata/eval-okay-comments.exp b/test/testdata/eval-okay-comments.exp
new file mode 100644
index 0000000..7182dc2
--- /dev/null
+++ b/test/testdata/eval-okay-comments.exp
@@ -0,0 +1 @@
"abcdefghijklmnopqrstuvwxyz"
diff --git a/test/testdata/eval-okay-comments.nix b/test/testdata/eval-okay-comments.nix
new file mode 100644
index 0000000..cb2cce2
--- /dev/null
+++ b/test/testdata/eval-okay-comments.nix
@@ -0,0 +1,59 @@
1# A simple comment
2"a"+ # And another
3## A double comment
4"b"+ ## And another
5# Nested # comments #
6"c"+ # and # some # other #
7# An empty line, following here:
8
9"d"+ # and a comment not starting the line !
10
11"e"+
12/* multiline comments */
13"f" +
14/* multiline
15 comments,
16 on
17 multiple
18 lines
19*/
20"g" +
21# Small, tricky comments
22/**/ "h"+ /*/*/ "i"+ /***/ "j"+ /* /*/ "k"+ /*/* /*/ "l"+
23# Comments with an even number of ending '*' used to fail:
24"m"+
25/* */ /* **/ /* ***/ /* ****/ "n"+
26/* */ /** */ /*** */ /**** */ "o"+
27/** **/ /*** ***/ /**** ****/ "p"+
28/* * ** *** **** ***** */ "q"+
29# Random comments
30/* ***** ////// * / * / /* */ "r"+
31# Mixed comments
32/* # */
33"s"+
34# /* #
35"t"+
36# /* # */
37"u"+
38# /*********/
39"v"+
40## */*
41"w"+
42/*
43 * Multiline, decorated comments
44 * # This ain't a nest'd comm'nt
45 */
46"x"+
47''${/** with **/"y"
48 # real
49 /* comments
50 inside ! # */
51
52 # (and empty lines)
53
54}''+ /* And a multiline comment,
55 on the same line,
56 after some spaces
57*/ # followed by a one-line comment
58"z"
59/* EOF */
diff --git a/test/testdata/eval-okay-concat.exp b/test/testdata/eval-okay-concat.exp
new file mode 100644
index 0000000..bb4bbd5
--- /dev/null
+++ b/test/testdata/eval-okay-concat.exp
@@ -0,0 +1 @@
[ 1 2 3 4 5 6 7 8 9 ]
diff --git a/test/testdata/eval-okay-concat.nix b/test/testdata/eval-okay-concat.nix
new file mode 100644
index 0000000..d158a9b
--- /dev/null
+++ b/test/testdata/eval-okay-concat.nix
@@ -0,0 +1 @@
[1 2 3] ++ [4 5 6] ++ [7 8 9]
diff --git a/test/testdata/eval-okay-concatmap.exp b/test/testdata/eval-okay-concatmap.exp
new file mode 100644
index 0000000..3b8be77
--- /dev/null
+++ b/test/testdata/eval-okay-concatmap.exp
@@ -0,0 +1 @@
[ [ 1 3 5 7 9 ] [ "a" "z" "b" "z" ] ]
diff --git a/test/testdata/eval-okay-concatmap.nix b/test/testdata/eval-okay-concatmap.nix
new file mode 100644
index 0000000..97da5d3
--- /dev/null
+++ b/test/testdata/eval-okay-concatmap.nix
@@ -0,0 +1,5 @@
1with import ./lib.nix;
2
3[ (builtins.concatMap (x: if x / 2 * 2 == x then [] else [ x ]) (range 0 10))
4 (builtins.concatMap (x: [x] ++ ["z"]) ["a" "b"])
5]
diff --git a/test/testdata/eval-okay-concatstringssep.exp b/test/testdata/eval-okay-concatstringssep.exp
new file mode 100644
index 0000000..9398764
--- /dev/null
+++ b/test/testdata/eval-okay-concatstringssep.exp
@@ -0,0 +1 @@
[ "" "foobarxyzzy" "foo, bar, xyzzy" "foo" "" ]
diff --git a/test/testdata/eval-okay-concatstringssep.nix b/test/testdata/eval-okay-concatstringssep.nix
new file mode 100644
index 0000000..adc4c41
--- /dev/null
+++ b/test/testdata/eval-okay-concatstringssep.nix
@@ -0,0 +1,8 @@
1with builtins;
2
3[ (concatStringsSep "" [])
4 (concatStringsSep "" ["foo" "bar" "xyzzy"])
5 (concatStringsSep ", " ["foo" "bar" "xyzzy"])
6 (concatStringsSep ", " ["foo"])
7 (concatStringsSep ", " [])
8]
diff --git a/test/testdata/eval-okay-context-introspection.exp b/test/testdata/eval-okay-context-introspection.exp
new file mode 100644
index 0000000..a136b00
--- /dev/null
+++ b/test/testdata/eval-okay-context-introspection.exp
@@ -0,0 +1 @@
[ true true true true true true true true true true true true true ]
diff --git a/test/testdata/eval-okay-context-introspection.nix b/test/testdata/eval-okay-context-introspection.nix
new file mode 100644
index 0000000..8886cf3
--- /dev/null
+++ b/test/testdata/eval-okay-context-introspection.nix
@@ -0,0 +1,59 @@
1let
2 drv = derivation {
3 name = "fail";
4 builder = "/bin/false";
5 system = "x86_64-linux";
6 outputs = [ "out" "foo" ];
7 };
8
9 path = "${./eval-okay-context-introspection.nix}";
10
11 desired-context = {
12 "${builtins.unsafeDiscardStringContext path}" = {
13 path = true;
14 };
15 "${builtins.unsafeDiscardStringContext drv.drvPath}" = {
16 outputs = [ "foo" "out" ];
17 allOutputs = true;
18 };
19 };
20
21 combo-path = "${path}${drv.outPath}${drv.foo.outPath}${drv.drvPath}";
22 legit-context = builtins.getContext combo-path;
23
24 reconstructed-path = builtins.appendContext
25 (builtins.unsafeDiscardStringContext combo-path)
26 desired-context;
27
28 # Eta rule for strings with context.
29 etaRule = str:
30 str == builtins.appendContext
31 (builtins.unsafeDiscardStringContext str)
32 (builtins.getContext str);
33
34 # Only holds true if string context contains both a `DrvDeep` and
35 # `Opaque` element.
36 almostEtaRule = str:
37 str == builtins.addDrvOutputDependencies
38 (builtins.unsafeDiscardOutputDependency str);
39
40 addDrvOutputDependencies_idempotent = str:
41 builtins.addDrvOutputDependencies str ==
42 builtins.addDrvOutputDependencies (builtins.addDrvOutputDependencies str);
43
44 rules = str: [
45 (etaRule str)
46 (almostEtaRule str)
47 (addDrvOutputDependencies_idempotent str)
48 ];
49
50in [
51 (legit-context == desired-context)
52 (reconstructed-path == combo-path)
53 (etaRule "foo")
54 (etaRule drv.foo.outPath)
55] ++ builtins.concatMap rules [
56 drv.drvPath
57 (builtins.addDrvOutputDependencies drv.drvPath)
58 (builtins.unsafeDiscardOutputDependency drv.drvPath)
59]
diff --git a/test/testdata/eval-okay-context.exp b/test/testdata/eval-okay-context.exp
new file mode 100644
index 0000000..2f535bd
--- /dev/null
+++ b/test/testdata/eval-okay-context.exp
@@ -0,0 +1 @@
"foo eval-okay-context.nix bar"
diff --git a/test/testdata/eval-okay-context.nix b/test/testdata/eval-okay-context.nix
new file mode 100644
index 0000000..7b9531c
--- /dev/null
+++ b/test/testdata/eval-okay-context.nix
@@ -0,0 +1,6 @@
1let s = "foo ${builtins.substring 33 100 (baseNameOf "${./eval-okay-context.nix}")} bar";
2in
3 if s != "foo eval-okay-context.nix bar"
4 then abort "context not discarded"
5 else builtins.unsafeDiscardStringContext s
6
diff --git a/test/testdata/eval-okay-convertHash.err.exp b/test/testdata/eval-okay-convertHash.err.exp
new file mode 100644
index 0000000..41d7467
--- /dev/null
+++ b/test/testdata/eval-okay-convertHash.err.exp
@@ -0,0 +1,108 @@
1warning: "base32" is a deprecated alias for hash format "nix32".
2warning: "base32" is a deprecated alias for hash format "nix32".
3warning: "base32" is a deprecated alias for hash format "nix32".
4warning: "base32" is a deprecated alias for hash format "nix32".
5warning: "base32" is a deprecated alias for hash format "nix32".
6warning: "base32" is a deprecated alias for hash format "nix32".
7warning: "base32" is a deprecated alias for hash format "nix32".
8warning: "base32" is a deprecated alias for hash format "nix32".
9warning: "base32" is a deprecated alias for hash format "nix32".
10warning: "base32" is a deprecated alias for hash format "nix32".
11warning: "base32" is a deprecated alias for hash format "nix32".
12warning: "base32" is a deprecated alias for hash format "nix32".
13warning: "base32" is a deprecated alias for hash format "nix32".
14warning: "base32" is a deprecated alias for hash format "nix32".
15warning: "base32" is a deprecated alias for hash format "nix32".
16warning: "base32" is a deprecated alias for hash format "nix32".
17warning: "base32" is a deprecated alias for hash format "nix32".
18warning: "base32" is a deprecated alias for hash format "nix32".
19warning: "base32" is a deprecated alias for hash format "nix32".
20warning: "base32" is a deprecated alias for hash format "nix32".
21warning: "base32" is a deprecated alias for hash format "nix32".
22warning: "base32" is a deprecated alias for hash format "nix32".
23warning: "base32" is a deprecated alias for hash format "nix32".
24warning: "base32" is a deprecated alias for hash format "nix32".
25warning: "base32" is a deprecated alias for hash format "nix32".
26warning: "base32" is a deprecated alias for hash format "nix32".
27warning: "base32" is a deprecated alias for hash format "nix32".
28warning: "base32" is a deprecated alias for hash format "nix32".
29warning: "base32" is a deprecated alias for hash format "nix32".
30warning: "base32" is a deprecated alias for hash format "nix32".
31warning: "base32" is a deprecated alias for hash format "nix32".
32warning: "base32" is a deprecated alias for hash format "nix32".
33warning: "base32" is a deprecated alias for hash format "nix32".
34warning: "base32" is a deprecated alias for hash format "nix32".
35warning: "base32" is a deprecated alias for hash format "nix32".
36warning: "base32" is a deprecated alias for hash format "nix32".
37warning: "base32" is a deprecated alias for hash format "nix32".
38warning: "base32" is a deprecated alias for hash format "nix32".
39warning: "base32" is a deprecated alias for hash format "nix32".
40warning: "base32" is a deprecated alias for hash format "nix32".
41warning: "base32" is a deprecated alias for hash format "nix32".
42warning: "base32" is a deprecated alias for hash format "nix32".
43warning: "base32" is a deprecated alias for hash format "nix32".
44warning: "base32" is a deprecated alias for hash format "nix32".
45warning: "base32" is a deprecated alias for hash format "nix32".
46warning: "base32" is a deprecated alias for hash format "nix32".
47warning: "base32" is a deprecated alias for hash format "nix32".
48warning: "base32" is a deprecated alias for hash format "nix32".
49warning: "base32" is a deprecated alias for hash format "nix32".
50warning: "base32" is a deprecated alias for hash format "nix32".
51warning: "base32" is a deprecated alias for hash format "nix32".
52warning: "base32" is a deprecated alias for hash format "nix32".
53warning: "base32" is a deprecated alias for hash format "nix32".
54warning: "base32" is a deprecated alias for hash format "nix32".
55warning: "base32" is a deprecated alias for hash format "nix32".
56warning: "base32" is a deprecated alias for hash format "nix32".
57warning: "base32" is a deprecated alias for hash format "nix32".
58warning: "base32" is a deprecated alias for hash format "nix32".
59warning: "base32" is a deprecated alias for hash format "nix32".
60warning: "base32" is a deprecated alias for hash format "nix32".
61warning: "base32" is a deprecated alias for hash format "nix32".
62warning: "base32" is a deprecated alias for hash format "nix32".
63warning: "base32" is a deprecated alias for hash format "nix32".
64warning: "base32" is a deprecated alias for hash format "nix32".
65warning: "base32" is a deprecated alias for hash format "nix32".
66warning: "base32" is a deprecated alias for hash format "nix32".
67warning: "base32" is a deprecated alias for hash format "nix32".
68warning: "base32" is a deprecated alias for hash format "nix32".
69warning: "base32" is a deprecated alias for hash format "nix32".
70warning: "base32" is a deprecated alias for hash format "nix32".
71warning: "base32" is a deprecated alias for hash format "nix32".
72warning: "base32" is a deprecated alias for hash format "nix32".
73warning: "base32" is a deprecated alias for hash format "nix32".
74warning: "base32" is a deprecated alias for hash format "nix32".
75warning: "base32" is a deprecated alias for hash format "nix32".
76warning: "base32" is a deprecated alias for hash format "nix32".
77warning: "base32" is a deprecated alias for hash format "nix32".
78warning: "base32" is a deprecated alias for hash format "nix32".
79warning: "base32" is a deprecated alias for hash format "nix32".
80warning: "base32" is a deprecated alias for hash format "nix32".
81warning: "base32" is a deprecated alias for hash format "nix32".
82warning: "base32" is a deprecated alias for hash format "nix32".
83warning: "base32" is a deprecated alias for hash format "nix32".
84warning: "base32" is a deprecated alias for hash format "nix32".
85warning: "base32" is a deprecated alias for hash format "nix32".
86warning: "base32" is a deprecated alias for hash format "nix32".
87warning: "base32" is a deprecated alias for hash format "nix32".
88warning: "base32" is a deprecated alias for hash format "nix32".
89warning: "base32" is a deprecated alias for hash format "nix32".
90warning: "base32" is a deprecated alias for hash format "nix32".
91warning: "base32" is a deprecated alias for hash format "nix32".
92warning: "base32" is a deprecated alias for hash format "nix32".
93warning: "base32" is a deprecated alias for hash format "nix32".
94warning: "base32" is a deprecated alias for hash format "nix32".
95warning: "base32" is a deprecated alias for hash format "nix32".
96warning: "base32" is a deprecated alias for hash format "nix32".
97warning: "base32" is a deprecated alias for hash format "nix32".
98warning: "base32" is a deprecated alias for hash format "nix32".
99warning: "base32" is a deprecated alias for hash format "nix32".
100warning: "base32" is a deprecated alias for hash format "nix32".
101warning: "base32" is a deprecated alias for hash format "nix32".
102warning: "base32" is a deprecated alias for hash format "nix32".
103warning: "base32" is a deprecated alias for hash format "nix32".
104warning: "base32" is a deprecated alias for hash format "nix32".
105warning: "base32" is a deprecated alias for hash format "nix32".
106warning: "base32" is a deprecated alias for hash format "nix32".
107warning: "base32" is a deprecated alias for hash format "nix32".
108warning: "base32" is a deprecated alias for hash format "nix32".
diff --git a/test/testdata/eval-okay-convertHash.exp b/test/testdata/eval-okay-convertHash.exp
new file mode 100644
index 0000000..16b0240
--- /dev/null
+++ b/test/testdata/eval-okay-convertHash.exp
@@ -0,0 +1 @@
{ hashesBase16 = [ "d41d8cd98f00b204e9800998ecf8427e" "6c69ee7f211c640419d5366cc076ae46" "bb3438fbabd460ea6dbd27d153e2233b" "da39a3ee5e6b4b0d3255bfef95601890afd80709" "cd54e8568c1b37cf1e5badb0779bcbf382212189" "6d12e10b1d331dad210e47fd25d4f260802b7e77" "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" "900a4469df00ccbfd0c145c6d1e4b7953dd0afafadd7534e3a4019e8d38fc663" "ad0387b3bd8652f730ca46d25f9c170af0fd589f42e7f23f5a9e6412d97d7e56" "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" "9d0886f8c6b389398a16257bc79780fab9831c7fc11c8ab07fa732cb7b348feade382f92617c9c5305fefba0af02ab5fd39a587d330997ff5bd0db19f7666653" "21644b72aa259e5a588cd3afbafb1d4310f4889680f6c83b9d531596a5a284f34dbebff409d23bcc86aee6bad10c891606f075c6f4755cb536da27db5693f3a7" ]; hashesBase32 = [ "3y8bwfr609h3lh9ch0izcqq7fl" "26mrvc0v1nslch8r0w45zywsbc" "1v4gi57l97pmnylq6lmgxkhd5v" "143xibwh31h9bvxzalr0sjvbbvpa6ffs" "i4hj30pkrfdpgc5dbcgcydqviibfhm6d" "fxz2p030yba2bza71qhss79k3l5y24kd" "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73" "0qy6iz9yh6a079757mxdmypx0gcmnzjd3ij5q78bzk00vxll82lh" "0mkygpci4r4yb8zz5rs2kxcgvw0a2yf5zlj6r8qgfll6pnrqf0xd" "0zdl9zrg8r3i9c1g90lgg9ip5ijzv3yhz91i0zzn3r8ap9ws784gkp9dk9j3aglhgf1amqb0pj21mh7h1nxcl18akqvvf7ggqsy30yg" "19ncrpp37dx0nzzjw4k6zaqkb9mzaq2myhgpzh5aff7qqcj5wwdxslg6ixwncm7gyq8l761gwf87fgsh2bwfyr52s53k2dkqvw8c24x" "2kz74snvckxldmmbisz9ikmy031d28cs6xfdbl6rhxx42glpyz4vww4lajrc5akklxwixl0js4g84233pxvmbykiic5m7i5m9r4nr11" ]; hashesBase64 = [ "1B2M2Y8AsgTpgAmY7PhCfg==" "bGnufyEcZAQZ1TZswHauRg==" "uzQ4+6vUYOptvSfRU+IjOw==" "2jmj7l5rSw0yVb/vlWAYkK/YBwk=" "zVToVowbN88eW62wd5vL84IhIYk=" "bRLhCx0zHa0hDkf9JdTyYIArfnc=" "47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=" "kApEad8AzL/QwUXG0eS3lT3Qr6+t11NOOkAZ6NOPxmM=" "rQOHs72GUvcwykbSX5wXCvD9WJ9C5/I/Wp5kEtl9flY=" "z4PhNX7vuL3xVChQ1m2AB9Yg5AULVxXcg/SpIdNs6c5H0NE8XYXysP+DGNKHfuwvY7kxvUdBeoGlODJ6+SfaPg==" "nQiG+MaziTmKFiV7x5eA+rmDHH/BHIqwf6cyy3s0j+reOC+SYXycUwX++6CvAqtf05pYfTMJl/9b0NsZ92ZmUw==" "IWRLcqolnlpYjNOvuvsdQxD0iJaA9sg7nVMVlqWihPNNvr/0CdI7zIau5rrRDIkWBvB1xvR1XLU22ifbVpPzpw==" ]; hashesNix32 = [ "3y8bwfr609h3lh9ch0izcqq7fl" "26mrvc0v1nslch8r0w45zywsbc" "1v4gi57l97pmnylq6lmgxkhd5v" "143xibwh31h9bvxzalr0sjvbbvpa6ffs" "i4hj30pkrfdpgc5dbcgcydqviibfhm6d" "fxz2p030yba2bza71qhss79k3l5y24kd" "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73" "0qy6iz9yh6a079757mxdmypx0gcmnzjd3ij5q78bzk00vxll82lh" "0mkygpci4r4yb8zz5rs2kxcgvw0a2yf5zlj6r8qgfll6pnrqf0xd" "0zdl9zrg8r3i9c1g90lgg9ip5ijzv3yhz91i0zzn3r8ap9ws784gkp9dk9j3aglhgf1amqb0pj21mh7h1nxcl18akqvvf7ggqsy30yg" "19ncrpp37dx0nzzjw4k6zaqkb9mzaq2myhgpzh5aff7qqcj5wwdxslg6ixwncm7gyq8l761gwf87fgsh2bwfyr52s53k2dkqvw8c24x" "2kz74snvckxldmmbisz9ikmy031d28cs6xfdbl6rhxx42glpyz4vww4lajrc5akklxwixl0js4g84233pxvmbykiic5m7i5m9r4nr11" ]; hashesSRI = [ "md5-1B2M2Y8AsgTpgAmY7PhCfg==" "md5-bGnufyEcZAQZ1TZswHauRg==" "md5-uzQ4+6vUYOptvSfRU+IjOw==" "sha1-2jmj7l5rSw0yVb/vlWAYkK/YBwk=" "sha1-zVToVowbN88eW62wd5vL84IhIYk=" "sha1-bRLhCx0zHa0hDkf9JdTyYIArfnc=" "sha256-47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=" "sha256-kApEad8AzL/QwUXG0eS3lT3Qr6+t11NOOkAZ6NOPxmM=" "sha256-rQOHs72GUvcwykbSX5wXCvD9WJ9C5/I/Wp5kEtl9flY=" "sha512-z4PhNX7vuL3xVChQ1m2AB9Yg5AULVxXcg/SpIdNs6c5H0NE8XYXysP+DGNKHfuwvY7kxvUdBeoGlODJ6+SfaPg==" "sha512-nQiG+MaziTmKFiV7x5eA+rmDHH/BHIqwf6cyy3s0j+reOC+SYXycUwX++6CvAqtf05pYfTMJl/9b0NsZ92ZmUw==" "sha512-IWRLcqolnlpYjNOvuvsdQxD0iJaA9sg7nVMVlqWihPNNvr/0CdI7zIau5rrRDIkWBvB1xvR1XLU22ifbVpPzpw==" ]; }
diff --git a/test/testdata/eval-okay-convertHash.nix b/test/testdata/eval-okay-convertHash.nix
new file mode 100644
index 0000000..a0191ee
--- /dev/null
+++ b/test/testdata/eval-okay-convertHash.nix
@@ -0,0 +1,33 @@
1let
2 hashAlgos = [ "md5" "md5" "md5" "sha1" "sha1" "sha1" "sha256" "sha256" "sha256" "sha512" "sha512" "sha512" ];
3 hashesBase16 = import ./eval-okay-hashstring.exp;
4 map2 = f: { fsts, snds }: if fsts == [ ] then [ ] else [ (f (builtins.head fsts) (builtins.head snds)) ] ++ map2 f { fsts = builtins.tail fsts; snds = builtins.tail snds; };
5 map2' = f: fsts: snds: map2 f { inherit fsts snds; };
6 getOutputHashes = hashes: {
7 hashesBase16 = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "base16";}) hashAlgos hashes;
8 hashesNix32 = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "nix32";}) hashAlgos hashes;
9 hashesBase32 = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "base32";}) hashAlgos hashes;
10 hashesBase64 = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "base64";}) hashAlgos hashes;
11 hashesSRI = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "sri" ;}) hashAlgos hashes;
12 };
13 getOutputHashesColon = hashes: {
14 hashesBase16 = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "base16";}) hashAlgos hashes;
15 hashesNix32 = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "nix32";}) hashAlgos hashes;
16 hashesBase32 = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "base32";}) hashAlgos hashes;
17 hashesBase64 = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "base64";}) hashAlgos hashes;
18 hashesSRI = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "sri" ;}) hashAlgos hashes;
19 };
20 outputHashes = getOutputHashes hashesBase16;
21in
22# map2'`
23assert map2' (s1: s2: s1 + s2) [ "a" "b" ] [ "c" "d" ] == [ "ac" "bd" ];
24# hashesBase16
25assert outputHashes.hashesBase16 == hashesBase16;
26# standard SRI hashes
27assert outputHashes.hashesSRI == (map2' (hashAlgo: hashBody: hashAlgo + "-" + hashBody) hashAlgos outputHashes.hashesBase64);
28# without prefix
29assert builtins.all (x: getOutputHashes x == outputHashes) (builtins.attrValues outputHashes);
30# colon-separated.
31# Note that colon prefix must not be applied to the standard SRI. e.g. "sha256:sha256-..." is illegal.
32assert builtins.all (x: getOutputHashesColon x == outputHashes) (with outputHashes; [ hashesBase16 hashesBase32 hashesBase64 ]);
33outputHashes
diff --git a/test/testdata/eval-okay-curpos.exp b/test/testdata/eval-okay-curpos.exp
new file mode 100644
index 0000000..65fd65b
--- /dev/null
+++ b/test/testdata/eval-okay-curpos.exp
@@ -0,0 +1 @@
[ 3 7 4 9 ]
diff --git a/test/testdata/eval-okay-curpos.nix b/test/testdata/eval-okay-curpos.nix
new file mode 100644
index 0000000..b79553d
--- /dev/null
+++ b/test/testdata/eval-okay-curpos.nix
@@ -0,0 +1,5 @@
1# Bla
2let
3 x = __curPos;
4 y = __curPos;
5in [ x.line x.column y.line y.column ]
diff --git a/test/testdata/eval-okay-deepseq.exp b/test/testdata/eval-okay-deepseq.exp
new file mode 100644
index 0000000..8d38505
--- /dev/null
+++ b/test/testdata/eval-okay-deepseq.exp
@@ -0,0 +1 @@
456
diff --git a/test/testdata/eval-okay-deepseq.nix b/test/testdata/eval-okay-deepseq.nix
new file mode 100644
index 0000000..53aa4b1
--- /dev/null
+++ b/test/testdata/eval-okay-deepseq.nix
@@ -0,0 +1 @@
builtins.deepSeq (let as = { x = 123; y = as; }; in as) 456
diff --git a/test/testdata/eval-okay-delayed-with-inherit.exp b/test/testdata/eval-okay-delayed-with-inherit.exp
new file mode 100644
index 0000000..eaacb55
--- /dev/null
+++ b/test/testdata/eval-okay-delayed-with-inherit.exp
@@ -0,0 +1 @@
"b-overridden"
diff --git a/test/testdata/eval-okay-delayed-with-inherit.nix b/test/testdata/eval-okay-delayed-with-inherit.nix
new file mode 100644
index 0000000..84b388c
--- /dev/null
+++ b/test/testdata/eval-okay-delayed-with-inherit.nix
@@ -0,0 +1,24 @@
1let
2 pkgs_ = with pkgs; {
3 a = derivation {
4 name = "a";
5 system = builtins.currentSystem;
6 builder = "/bin/sh";
7 args = [ "-c" "touch $out" ];
8 inherit b;
9 };
10
11 inherit b;
12 };
13
14 packageOverrides = p: {
15 b = derivation {
16 name = "b-overridden";
17 system = builtins.currentSystem;
18 builder = "/bin/sh";
19 args = [ "-c" "touch $out" ];
20 };
21 };
22
23 pkgs = pkgs_ // (packageOverrides pkgs_);
24in pkgs.a.b.name
diff --git a/test/testdata/eval-okay-delayed-with.exp b/test/testdata/eval-okay-delayed-with.exp
new file mode 100644
index 0000000..8e7c61a
--- /dev/null
+++ b/test/testdata/eval-okay-delayed-with.exp
@@ -0,0 +1 @@
"b-overridden b-overridden a"
diff --git a/test/testdata/eval-okay-delayed-with.nix b/test/testdata/eval-okay-delayed-with.nix
new file mode 100644
index 0000000..3fb023e
--- /dev/null
+++ b/test/testdata/eval-okay-delayed-with.nix
@@ -0,0 +1,29 @@
1let
2
3 pkgs_ = with pkgs; {
4 a = derivation {
5 name = "a";
6 system = builtins.currentSystem;
7 builder = "/bin/sh";
8 args = [ "-c" "touch $out" ];
9 inherit b;
10 };
11
12 b = derivation {
13 name = "b";
14 system = builtins.currentSystem;
15 builder = "/bin/sh";
16 args = [ "-c" "touch $out" ];
17 inherit a;
18 };
19
20 c = b;
21 };
22
23 packageOverrides = pkgs: with pkgs; {
24 b = derivation (b.drvAttrs // { name = "${b.name}-overridden"; });
25 };
26
27 pkgs = pkgs_ // (packageOverrides pkgs_);
28
29in "${pkgs.a.b.name} ${pkgs.c.name} ${pkgs.b.a.name}"
diff --git a/test/testdata/eval-okay-derivation-legacy.err.exp b/test/testdata/eval-okay-derivation-legacy.err.exp
new file mode 100644
index 0000000..94f0854
--- /dev/null
+++ b/test/testdata/eval-okay-derivation-legacy.err.exp
@@ -0,0 +1,6 @@
1warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'allowedReferences'; use 'outputChecks.<output>.allowedReferences' instead
2warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'allowedRequisites'; use 'outputChecks.<output>.allowedRequisites' instead
3warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'disallowedReferences'; use 'outputChecks.<output>.disallowedReferences' instead
4warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'disallowedRequisites'; use 'outputChecks.<output>.disallowedRequisites' instead
5warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'maxClosureSize'; use 'outputChecks.<output>.maxClosureSize' instead
6warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'maxSize'; use 'outputChecks.<output>.maxSize' instead
diff --git a/test/testdata/eval-okay-derivation-legacy.exp b/test/testdata/eval-okay-derivation-legacy.exp
new file mode 100644
index 0000000..4f374a1
--- /dev/null
+++ b/test/testdata/eval-okay-derivation-legacy.exp
@@ -0,0 +1 @@
"/nix/store/mzgwvrjjir216ra58mwwizi8wj6y9ddr-eval-okay-derivation-legacy"
diff --git a/test/testdata/eval-okay-derivation-legacy.nix b/test/testdata/eval-okay-derivation-legacy.nix
new file mode 100644
index 0000000..b529cdf
--- /dev/null
+++ b/test/testdata/eval-okay-derivation-legacy.nix
@@ -0,0 +1,12 @@
1(builtins.derivationStrict {
2 name = "eval-okay-derivation-legacy";
3 system = "x86_64-linux";
4 builder = "/dontcare";
5 __structuredAttrs = true;
6 allowedReferences = [ ];
7 disallowedReferences = [ ];
8 allowedRequisites = [ ];
9 disallowedRequisites = [ ];
10 maxSize = 1234;
11 maxClosureSize = 12345;
12}).out
diff --git a/test/testdata/eval-okay-dynamic-attrs-2.exp b/test/testdata/eval-okay-dynamic-attrs-2.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-dynamic-attrs-2.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-dynamic-attrs-2.nix b/test/testdata/eval-okay-dynamic-attrs-2.nix
new file mode 100644
index 0000000..6d57bf8
--- /dev/null
+++ b/test/testdata/eval-okay-dynamic-attrs-2.nix
@@ -0,0 +1 @@
{ a."${"b"}" = true; a."${"c"}" = false; }.a.b
diff --git a/test/testdata/eval-okay-dynamic-attrs-bare.exp b/test/testdata/eval-okay-dynamic-attrs-bare.exp
new file mode 100644
index 0000000..df8750a
--- /dev/null
+++ b/test/testdata/eval-okay-dynamic-attrs-bare.exp
@@ -0,0 +1 @@
{ binds = true; hasAttrs = true; multiAttrs = true; recBinds = true; selectAttrs = true; selectOrAttrs = true; }
diff --git a/test/testdata/eval-okay-dynamic-attrs-bare.nix b/test/testdata/eval-okay-dynamic-attrs-bare.nix
new file mode 100644
index 0000000..0dbe15e
--- /dev/null
+++ b/test/testdata/eval-okay-dynamic-attrs-bare.nix
@@ -0,0 +1,17 @@
1let
2 aString = "a";
3
4 bString = "b";
5in {
6 hasAttrs = { a.b = null; } ? ${aString}.b;
7
8 selectAttrs = { a.b = true; }.a.${bString};
9
10 selectOrAttrs = { }.${aString} or true;
11
12 binds = { ${aString}."${bString}c" = true; }.a.bc;
13
14 recBinds = rec { ${bString} = a; a = true; }.b;
15
16 multiAttrs = { ${aString} = true; ${bString} = false; }.a;
17}
diff --git a/test/testdata/eval-okay-dynamic-attrs.exp b/test/testdata/eval-okay-dynamic-attrs.exp
new file mode 100644
index 0000000..df8750a
--- /dev/null
+++ b/test/testdata/eval-okay-dynamic-attrs.exp
@@ -0,0 +1 @@
{ binds = true; hasAttrs = true; multiAttrs = true; recBinds = true; selectAttrs = true; selectOrAttrs = true; }
diff --git a/test/testdata/eval-okay-dynamic-attrs.nix b/test/testdata/eval-okay-dynamic-attrs.nix
new file mode 100644
index 0000000..ee02ac7
--- /dev/null
+++ b/test/testdata/eval-okay-dynamic-attrs.nix
@@ -0,0 +1,17 @@
1let
2 aString = "a";
3
4 bString = "b";
5in {
6 hasAttrs = { a.b = null; } ? "${aString}".b;
7
8 selectAttrs = { a.b = true; }.a."${bString}";
9
10 selectOrAttrs = { }."${aString}" or true;
11
12 binds = { "${aString}"."${bString}c" = true; }.a.bc;
13
14 recBinds = rec { "${bString}" = a; a = true; }.b;
15
16 multiAttrs = { "${aString}" = true; "${bString}" = false; }.a;
17}
diff --git a/test/testdata/eval-okay-elem.exp b/test/testdata/eval-okay-elem.exp
new file mode 100644
index 0000000..3cf6c0e
--- /dev/null
+++ b/test/testdata/eval-okay-elem.exp
@@ -0,0 +1 @@
[ true false 30 ]
diff --git a/test/testdata/eval-okay-elem.nix b/test/testdata/eval-okay-elem.nix
new file mode 100644
index 0000000..71ea7a4
--- /dev/null
+++ b/test/testdata/eval-okay-elem.nix
@@ -0,0 +1,6 @@
1with import ./lib.nix;
2
3let xs = range 10 40; in
4
5[ (builtins.elem 23 xs) (builtins.elem 42 xs) (builtins.elemAt xs 20) ]
6
diff --git a/test/testdata/eval-okay-empty-args.exp b/test/testdata/eval-okay-empty-args.exp
new file mode 100644
index 0000000..cb5537d
--- /dev/null
+++ b/test/testdata/eval-okay-empty-args.exp
@@ -0,0 +1 @@
"ab"
diff --git a/test/testdata/eval-okay-empty-args.nix b/test/testdata/eval-okay-empty-args.nix
new file mode 100644
index 0000000..78c133a
--- /dev/null
+++ b/test/testdata/eval-okay-empty-args.nix
@@ -0,0 +1 @@
({}: {x,y,}: "${x}${y}") {} {x = "a"; y = "b";}
diff --git a/test/testdata/eval-okay-eq-derivations.exp b/test/testdata/eval-okay-eq-derivations.exp
new file mode 100644
index 0000000..ec04aab
--- /dev/null
+++ b/test/testdata/eval-okay-eq-derivations.exp
@@ -0,0 +1 @@
[ true true true false ]
diff --git a/test/testdata/eval-okay-eq-derivations.nix b/test/testdata/eval-okay-eq-derivations.nix
new file mode 100644
index 0000000..d526cb4
--- /dev/null
+++ b/test/testdata/eval-okay-eq-derivations.nix
@@ -0,0 +1,10 @@
1let
2
3 drvA1 = derivation { name = "a"; builder = "/foo"; system = "i686-linux"; };
4 drvA2 = derivation { name = "a"; builder = "/foo"; system = "i686-linux"; };
5 drvA3 = derivation { name = "a"; builder = "/foo"; system = "i686-linux"; } // { dummy = 1; };
6
7 drvC1 = derivation { name = "c"; builder = "/foo"; system = "i686-linux"; };
8 drvC2 = derivation { name = "c"; builder = "/bar"; system = "i686-linux"; };
9
10in [ (drvA1 == drvA1) (drvA1 == drvA2) (drvA1 == drvA3) (drvC1 == drvC2) ]
diff --git a/test/testdata/eval-okay-eq.exp b/test/testdata/eval-okay-eq.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-eq.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-eq.nix b/test/testdata/eval-okay-eq.nix
new file mode 100644
index 0000000..73d200b
--- /dev/null
+++ b/test/testdata/eval-okay-eq.nix
@@ -0,0 +1,3 @@
1["foobar" (rec {x = 1; y = x;})]
2==
3[("foo" + "bar") ({x = 1; y = 1;})]
diff --git a/test/testdata/eval-okay-filter.exp b/test/testdata/eval-okay-filter.exp
new file mode 100644
index 0000000..355d51c
--- /dev/null
+++ b/test/testdata/eval-okay-filter.exp
@@ -0,0 +1 @@
[ 0 2 4 6 8 10 100 102 104 106 108 110 ]
diff --git a/test/testdata/eval-okay-filter.nix b/test/testdata/eval-okay-filter.nix
new file mode 100644
index 0000000..85109b0
--- /dev/null
+++ b/test/testdata/eval-okay-filter.nix
@@ -0,0 +1,5 @@
1with import ./lib.nix;
2
3builtins.filter
4 (x: x / 2 * 2 == x)
5 (builtins.concatLists [ (range 0 10) (range 100 110) ])
diff --git a/test/testdata/eval-okay-flake-ref-to-string.exp b/test/testdata/eval-okay-flake-ref-to-string.exp
new file mode 100644
index 0000000..110f844
--- /dev/null
+++ b/test/testdata/eval-okay-flake-ref-to-string.exp
@@ -0,0 +1 @@
"github:NixOS/nixpkgs/23.05?dir=lib"
diff --git a/test/testdata/eval-okay-flake-ref-to-string.nix b/test/testdata/eval-okay-flake-ref-to-string.nix
new file mode 100644
index 0000000..dbb4e5b
--- /dev/null
+++ b/test/testdata/eval-okay-flake-ref-to-string.nix
@@ -0,0 +1,7 @@
1builtins.flakeRefToString {
2 type = "github";
3 owner = "NixOS";
4 repo = "nixpkgs";
5 ref = "23.05";
6 dir = "lib";
7}
diff --git a/test/testdata/eval-okay-flatten.exp b/test/testdata/eval-okay-flatten.exp
new file mode 100644
index 0000000..b979b2b
--- /dev/null
+++ b/test/testdata/eval-okay-flatten.exp
@@ -0,0 +1 @@
"1234567"
diff --git a/test/testdata/eval-okay-flatten.nix b/test/testdata/eval-okay-flatten.nix
new file mode 100644
index 0000000..fe911e9
--- /dev/null
+++ b/test/testdata/eval-okay-flatten.nix
@@ -0,0 +1,8 @@
1with import ./lib.nix;
2
3let {
4
5 l = ["1" "2" ["3" ["4"] ["5" "6"]] "7"];
6
7 body = concat (flatten l);
8}
diff --git a/test/testdata/eval-okay-float.exp b/test/testdata/eval-okay-float.exp
new file mode 100644
index 0000000..3c50a8a
--- /dev/null
+++ b/test/testdata/eval-okay-float.exp
@@ -0,0 +1 @@
[ 3.4 3.5 2.5 1.5 ]
diff --git a/test/testdata/eval-okay-float.nix b/test/testdata/eval-okay-float.nix
new file mode 100644
index 0000000..b2702c7
--- /dev/null
+++ b/test/testdata/eval-okay-float.nix
@@ -0,0 +1,6 @@
1[
2 (1.1 + 2.3)
3 (builtins.add (0.5 + 0.5) (2.0 + 0.5))
4 ((0.5 + 0.5) * (2.0 + 0.5))
5 ((1.5 + 1.5) / (0.5 * 4.0))
6]
diff --git a/test/testdata/eval-okay-floor-ceil.exp b/test/testdata/eval-okay-floor-ceil.exp
new file mode 100644
index 0000000..81f8042
--- /dev/null
+++ b/test/testdata/eval-okay-floor-ceil.exp
@@ -0,0 +1 @@
"23;24;23;23"
diff --git a/test/testdata/eval-okay-floor-ceil.nix b/test/testdata/eval-okay-floor-ceil.nix
new file mode 100644
index 0000000..d76a0d8
--- /dev/null
+++ b/test/testdata/eval-okay-floor-ceil.nix
@@ -0,0 +1,9 @@
1with import ./lib.nix;
2
3let
4 n1 = builtins.floor 23.5;
5 n2 = builtins.ceil 23.5;
6 n3 = builtins.floor 23;
7 n4 = builtins.ceil 23;
8in
9 builtins.concatStringsSep ";" (map toString [ n1 n2 n3 n4 ])
diff --git a/test/testdata/eval-okay-foldlStrict-lazy-elements.exp b/test/testdata/eval-okay-foldlStrict-lazy-elements.exp
new file mode 100644
index 0000000..d81cc07
--- /dev/null
+++ b/test/testdata/eval-okay-foldlStrict-lazy-elements.exp
@@ -0,0 +1 @@
42
diff --git a/test/testdata/eval-okay-foldlStrict-lazy-elements.nix b/test/testdata/eval-okay-foldlStrict-lazy-elements.nix
new file mode 100644
index 0000000..c666e07
--- /dev/null
+++ b/test/testdata/eval-okay-foldlStrict-lazy-elements.nix
@@ -0,0 +1,9 @@
1# Tests that the rhs argument of op is not forced unconditionally
2let
3 lst = builtins.foldl'
4 (acc: x: acc ++ [ x ])
5 [ ]
6 [ 42 (throw "this shouldn't be evaluated") ];
7in
8
9builtins.head lst
diff --git a/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.exp b/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.exp
new file mode 100644
index 0000000..d81cc07
--- /dev/null
+++ b/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.exp
@@ -0,0 +1 @@
42
diff --git a/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.nix b/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.nix
new file mode 100644
index 0000000..abcd536
--- /dev/null
+++ b/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.nix
@@ -0,0 +1,6 @@
1# Checks that the nul value for the accumulator is not forced unconditionally.
2# Some languages provide a foldl' that is strict in this argument, but Nix does not.
3builtins.foldl'
4 (_: x: x)
5 (throw "This is never forced")
6 [ "but the results of applying op are" 42 ]
diff --git a/test/testdata/eval-okay-foldlStrict.exp b/test/testdata/eval-okay-foldlStrict.exp
new file mode 100644
index 0000000..837e12b
--- /dev/null
+++ b/test/testdata/eval-okay-foldlStrict.exp
@@ -0,0 +1 @@
500500
diff --git a/test/testdata/eval-okay-foldlStrict.nix b/test/testdata/eval-okay-foldlStrict.nix
new file mode 100644
index 0000000..3b87188
--- /dev/null
+++ b/test/testdata/eval-okay-foldlStrict.nix
@@ -0,0 +1,3 @@
1with import ./lib.nix;
2
3builtins.foldl' (x: y: x + y) 0 (range 1 1000)
diff --git a/test/testdata/eval-okay-fromTOML-timestamps.exp b/test/testdata/eval-okay-fromTOML-timestamps.exp
new file mode 100644
index 0000000..08b3c69
--- /dev/null
+++ b/test/testdata/eval-okay-fromTOML-timestamps.exp
@@ -0,0 +1 @@
{ "1234" = "value"; "127.0.0.1" = "value"; a = { b = { c = { }; }; }; arr1 = [ 1 2 3 ]; arr2 = [ "red" "yellow" "green" ]; arr3 = [ [ 1 2 ] [ 3 4 5 ] ]; arr4 = [ "all" "strings" "are the same" "type" ]; arr5 = [ [ 1 2 ] [ "a" "b" "c" ] ]; arr7 = [ 1 2 3 ]; arr8 = [ 1 2 ]; bare-key = "value"; bare_key = "value"; bin1 = 214; bool1 = true; bool2 = false; "character encoding" = "value"; d = { e = { f = { }; }; }; dog = { "tater.man" = { type = { name = "pug"; }; }; }; flt1 = 1; flt2 = 3.1415; flt3 = -0.01; flt4 = 5e+22; flt5 = 1e+06; flt6 = -0.02; flt7 = 6.626e-34; flt8 = 9.22462e+06; fruit = [ { name = "apple"; physical = { color = "red"; shape = "round"; }; variety = [ { name = "red delicious"; } { name = "granny smith"; } ]; } { name = "banana"; variety = [ { name = "plantain"; } ]; } ]; g = { h = { i = { }; }; }; hex1 = 3735928559; hex2 = 3735928559; hex3 = 3735928559; int1 = 99; int2 = 42; int3 = 0; int4 = -17; int5 = 1000; int6 = 5349221; int7 = 12345; j = { "ʞ" = { l = { }; }; }; key = "value"; key2 = "value"; ld1 = { _type = "timestamp"; value = "1979-05-27"; }; ldt1 = { _type = "timestamp"; value = "1979-05-27T07:32:00"; }; ldt2 = { _type = "timestamp"; value = "1979-05-27T00:32:00.999999"; }; lt1 = { _type = "timestamp"; value = "07:32:00"; }; lt2 = { _type = "timestamp"; value = "00:32:00.999999"; }; name = "Orange"; oct1 = 342391; oct2 = 493; odt1 = { _type = "timestamp"; value = "1979-05-27T07:32:00Z"; }; odt2 = { _type = "timestamp"; value = "1979-05-27T00:32:00-07:00"; }; odt3 = { _type = "timestamp"; value = "1979-05-27T00:32:00.999999-07:00"; }; odt4 = { _type = "timestamp"; value = "1979-05-27T07:32:00Z"; }; physical = { color = "orange"; shape = "round"; }; products = [ { name = "Hammer"; sku = 738594937; } { } { color = "gray"; name = "Nail"; sku = 284758393; } ]; "quoted \"value\"" = "value"; site = { "google.com" = true; }; str = "I'm a string. \"You can quote me\". Name\tJosé\nLocation\tSF."; table-1 = { key1 = "some string"; key2 = 123; }; table-2 = { key1 = "another string"; key2 = 456; }; x = { y = { z = { w = { animal = { type = { name = "pug"; }; }; name = { first = "Tom"; last = "Preston-Werner"; }; point = { x = 1; y = 2; }; }; }; }; }; "ʎǝʞ" = "value"; }
diff --git a/test/testdata/eval-okay-fromTOML-timestamps.flags b/test/testdata/eval-okay-fromTOML-timestamps.flags
new file mode 100644
index 0000000..9ed39dc
--- /dev/null
+++ b/test/testdata/eval-okay-fromTOML-timestamps.flags
@@ -0,0 +1 @@
--extra-experimental-features parse-toml-timestamps
diff --git a/test/testdata/eval-okay-fromTOML-timestamps.nix b/test/testdata/eval-okay-fromTOML-timestamps.nix
new file mode 100644
index 0000000..74cff94
--- /dev/null
+++ b/test/testdata/eval-okay-fromTOML-timestamps.nix
@@ -0,0 +1,130 @@
1builtins.fromTOML ''
2 key = "value"
3 bare_key = "value"
4 bare-key = "value"
5 1234 = "value"
6
7 "127.0.0.1" = "value"
8 "character encoding" = "value"
9 "ʎǝʞ" = "value"
10 'key2' = "value"
11 'quoted "value"' = "value"
12
13 name = "Orange"
14
15 physical.color = "orange"
16 physical.shape = "round"
17 site."google.com" = true
18
19 # This is legal according to the spec, but cpptoml doesn't handle it.
20 #a.b.c = 1
21 #a.d = 2
22
23 str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF."
24
25 int1 = +99
26 int2 = 42
27 int3 = 0
28 int4 = -17
29 int5 = 1_000
30 int6 = 5_349_221
31 int7 = 1_2_3_4_5
32
33 hex1 = 0xDEADBEEF
34 hex2 = 0xdeadbeef
35 hex3 = 0xdead_beef
36
37 oct1 = 0o01234567
38 oct2 = 0o755
39
40 bin1 = 0b11010110
41
42 flt1 = +1.0
43 flt2 = 3.1415
44 flt3 = -0.01
45 flt4 = 5e+22
46 flt5 = 1e6
47 flt6 = -2E-2
48 flt7 = 6.626e-34
49 flt8 = 9_224_617.445_991_228_313
50
51 bool1 = true
52 bool2 = false
53
54 odt1 = 1979-05-27T07:32:00Z
55 odt2 = 1979-05-27T00:32:00-07:00
56 odt3 = 1979-05-27T00:32:00.999999-07:00
57 odt4 = 1979-05-27 07:32:00Z
58 ldt1 = 1979-05-27T07:32:00
59 ldt2 = 1979-05-27T00:32:00.999999
60 ld1 = 1979-05-27
61 lt1 = 07:32:00
62 lt2 = 00:32:00.999999
63
64 arr1 = [ 1, 2, 3 ]
65 arr2 = [ "red", "yellow", "green" ]
66 arr3 = [ [ 1, 2 ], [3, 4, 5] ]
67 arr4 = [ "all", 'strings', """are the same""", ''''type'''']
68 arr5 = [ [ 1, 2 ], ["a", "b", "c"] ]
69
70 arr7 = [
71 1, 2, 3
72 ]
73
74 arr8 = [
75 1,
76 2, # this is ok
77 ]
78
79 [table-1]
80 key1 = "some string"
81 key2 = 123
82
83
84 [table-2]
85 key1 = "another string"
86 key2 = 456
87
88 [dog."tater.man"]
89 type.name = "pug"
90
91 [a.b.c]
92 [ d.e.f ]
93 [ g . h . i ]
94 [ j . "ʞ" . 'l' ]
95 [x.y.z.w]
96
97 name = { first = "Tom", last = "Preston-Werner" }
98 point = { x = 1, y = 2 }
99 animal = { type.name = "pug" }
100
101 [[products]]
102 name = "Hammer"
103 sku = 738594937
104
105 [[products]]
106
107 [[products]]
108 name = "Nail"
109 sku = 284758393
110 color = "gray"
111
112 [[fruit]]
113 name = "apple"
114
115 [fruit.physical]
116 color = "red"
117 shape = "round"
118
119 [[fruit.variety]]
120 name = "red delicious"
121
122 [[fruit.variety]]
123 name = "granny smith"
124
125 [[fruit]]
126 name = "banana"
127
128 [[fruit.variety]]
129 name = "plantain"
130''
diff --git a/test/testdata/eval-okay-fromTOML.exp b/test/testdata/eval-okay-fromTOML.exp
new file mode 100644
index 0000000..d0dd3af
--- /dev/null
+++ b/test/testdata/eval-okay-fromTOML.exp
@@ -0,0 +1 @@
[ { clients = { data = [ [ "gamma" "delta" ] [ 1 2 ] ]; hosts = [ "alpha" "omega" ]; }; database = { connection_max = 5000; enabled = true; ports = [ 8001 8001 8002 ]; server = "192.168.1.1"; }; owner = { name = "Tom Preston-Werner"; }; servers = { alpha = { dc = "eqdc10"; ip = "10.0.0.1"; }; beta = { dc = "eqdc10"; ip = "10.0.0.2"; }; }; title = "TOML Example"; } { "1234" = "value"; "127.0.0.1" = "value"; a = { b = { c = { }; }; }; arr1 = [ 1 2 3 ]; arr2 = [ "red" "yellow" "green" ]; arr3 = [ [ 1 2 ] [ 3 4 5 ] ]; arr4 = [ "all" "strings" "are the same" "type" ]; arr5 = [ [ 1 2 ] [ "a" "b" "c" ] ]; arr7 = [ 1 2 3 ]; arr8 = [ 1 2 ]; bare-key = "value"; bare_key = "value"; bin1 = 214; bool1 = true; bool2 = false; "character encoding" = "value"; d = { e = { f = { }; }; }; dog = { "tater.man" = { type = { name = "pug"; }; }; }; flt1 = 1; flt2 = 3.1415; flt3 = -0.01; flt4 = 5e+22; flt5 = 1e+06; flt6 = -0.02; flt7 = 6.626e-34; flt8 = 9.22462e+06; fruit = [ { name = "apple"; physical = { color = "red"; shape = "round"; }; variety = [ { name = "red delicious"; } { name = "granny smith"; } ]; } { name = "banana"; variety = [ { name = "plantain"; } ]; } ]; g = { h = { i = { }; }; }; hex1 = 3735928559; hex2 = 3735928559; hex3 = 3735928559; int1 = 99; int2 = 42; int3 = 0; int4 = -17; int5 = 1000; int6 = 5349221; int7 = 12345; j = { "ʞ" = { l = { }; }; }; key = "value"; key2 = "value"; name = "Orange"; oct1 = 342391; oct2 = 493; physical = { color = "orange"; shape = "round"; }; products = [ { name = "Hammer"; sku = 738594937; } { } { color = "gray"; name = "Nail"; sku = 284758393; } ]; "quoted \"value\"" = "value"; site = { "google.com" = true; }; str = "I'm a string. \"You can quote me\". Name\tJosé\nLocation\tSF."; table-1 = { key1 = "some string"; key2 = 123; }; table-2 = { key1 = "another string"; key2 = 456; }; x = { y = { z = { w = { animal = { type = { name = "pug"; }; }; name = { first = "Tom"; last = "Preston-Werner"; }; point = { x = 1; y = 2; }; }; }; }; }; "ʎǝʞ" = "value"; } { metadata = { "checksum aho-corasick 0.6.4 (registry+https://github.com/rust-lang/crates.io-index)" = "d6531d44de723825aa81398a6415283229725a00fa30713812ab9323faa82fc4"; "checksum ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ee49baf6cb617b853aa8d93bf420db2383fab46d314482ca2803b40d5fde979b"; "checksum ansi_term 0.9.0 (registry+https://github.com/rust-lang/crates.io-index)" = "23ac7c30002a5accbf7e8987d0632fa6de155b7c3d39d0067317a391e00a2ef6"; "checksum arrayvec 0.4.7 (registry+https://github.com/rust-lang/crates.io-index)" = "a1e964f9e24d588183fcb43503abda40d288c8657dfc27311516ce2f05675aef"; }; package = [ { dependencies = [ "memchr 2.0.1 (registry+https://github.com/rust-lang/crates.io-index)" ]; name = "aho-corasick"; source = "registry+https://github.com/rust-lang/crates.io-index"; version = "0.6.4"; } { name = "ansi_term"; source = "registry+https://github.com/rust-lang/crates.io-index"; version = "0.9.0"; } { dependencies = [ "libc 0.2.42 (registry+https://github.com/rust-lang/crates.io-index)" "termion 1.5.1 (registry+https://github.com/rust-lang/crates.io-index)" "winapi 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)" ]; name = "atty"; source = "registry+https://github.com/rust-lang/crates.io-index"; version = "0.2.10"; } ]; } { a = [ [ { b = true; } ] ]; c = [ [ { d = true; } ] ]; e = [ [ 123 ] ]; } ]
diff --git a/test/testdata/eval-okay-fromTOML.nix b/test/testdata/eval-okay-fromTOML.nix
new file mode 100644
index 0000000..9639326
--- /dev/null
+++ b/test/testdata/eval-okay-fromTOML.nix
@@ -0,0 +1,208 @@
1[
2
3 (builtins.fromTOML ''
4 # This is a TOML document.
5
6 title = "TOML Example"
7
8 [owner]
9 name = "Tom Preston-Werner"
10 #dob = 1979-05-27T07:32:00-08:00 # First class dates
11
12 [database]
13 server = "192.168.1.1"
14 ports = [ 8001, 8001, 8002 ]
15 connection_max = 5000
16 enabled = true
17
18 [servers]
19
20 # Indentation (tabs and/or spaces) is allowed but not required
21 [servers.alpha]
22 ip = "10.0.0.1"
23 dc = "eqdc10"
24
25 [servers.beta]
26 ip = "10.0.0.2"
27 dc = "eqdc10"
28
29 [clients]
30 data = [ ["gamma", "delta"], [1, 2] ]
31
32 # Line breaks are OK when inside arrays
33 hosts = [
34 "alpha",
35 "omega"
36 ]
37 '')
38
39 (builtins.fromTOML ''
40 key = "value"
41 bare_key = "value"
42 bare-key = "value"
43 1234 = "value"
44
45 "127.0.0.1" = "value"
46 "character encoding" = "value"
47 "ʎǝʞ" = "value"
48 'key2' = "value"
49 'quoted "value"' = "value"
50
51 name = "Orange"
52
53 physical.color = "orange"
54 physical.shape = "round"
55 site."google.com" = true
56
57 # This is legal according to the spec, but cpptoml doesn't handle it.
58 #a.b.c = 1
59 #a.d = 2
60
61 str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF."
62
63 int1 = +99
64 int2 = 42
65 int3 = 0
66 int4 = -17
67 int5 = 1_000
68 int6 = 5_349_221
69 int7 = 1_2_3_4_5
70
71 hex1 = 0xDEADBEEF
72 hex2 = 0xdeadbeef
73 hex3 = 0xdead_beef
74
75 oct1 = 0o01234567
76 oct2 = 0o755
77
78 bin1 = 0b11010110
79
80 flt1 = +1.0
81 flt2 = 3.1415
82 flt3 = -0.01
83 flt4 = 5e+22
84 flt5 = 1e6
85 flt6 = -2E-2
86 flt7 = 6.626e-34
87 flt8 = 9_224_617.445_991_228_313
88
89 bool1 = true
90 bool2 = false
91
92 # FIXME: not supported because Nix doesn't have a date/time type.
93 #odt1 = 1979-05-27T07:32:00Z
94 #odt2 = 1979-05-27T00:32:00-07:00
95 #odt3 = 1979-05-27T00:32:00.999999-07:00
96 #odt4 = 1979-05-27 07:32:00Z
97 #ldt1 = 1979-05-27T07:32:00
98 #ldt2 = 1979-05-27T00:32:00.999999
99 #ld1 = 1979-05-27
100 #lt1 = 07:32:00
101 #lt2 = 00:32:00.999999
102
103 arr1 = [ 1, 2, 3 ]
104 arr2 = [ "red", "yellow", "green" ]
105 arr3 = [ [ 1, 2 ], [3, 4, 5] ]
106 arr4 = [ "all", 'strings', """are the same""", ''''type'''']
107 arr5 = [ [ 1, 2 ], ["a", "b", "c"] ]
108
109 arr7 = [
110 1, 2, 3
111 ]
112
113 arr8 = [
114 1,
115 2, # this is ok
116 ]
117
118 [table-1]
119 key1 = "some string"
120 key2 = 123
121
122
123 [table-2]
124 key1 = "another string"
125 key2 = 456
126
127 [dog."tater.man"]
128 type.name = "pug"
129
130 [a.b.c]
131 [ d.e.f ]
132 [ g . h . i ]
133 [ j . "ʞ" . 'l' ]
134 [x.y.z.w]
135
136 name = { first = "Tom", last = "Preston-Werner" }
137 point = { x = 1, y = 2 }
138 animal = { type.name = "pug" }
139
140 [[products]]
141 name = "Hammer"
142 sku = 738594937
143
144 [[products]]
145
146 [[products]]
147 name = "Nail"
148 sku = 284758393
149 color = "gray"
150
151 [[fruit]]
152 name = "apple"
153
154 [fruit.physical]
155 color = "red"
156 shape = "round"
157
158 [[fruit.variety]]
159 name = "red delicious"
160
161 [[fruit.variety]]
162 name = "granny smith"
163
164 [[fruit]]
165 name = "banana"
166
167 [[fruit.variety]]
168 name = "plantain"
169 '')
170
171 (builtins.fromTOML ''
172 [[package]]
173 name = "aho-corasick"
174 version = "0.6.4"
175 source = "registry+https://github.com/rust-lang/crates.io-index"
176 dependencies = [
177 "memchr 2.0.1 (registry+https://github.com/rust-lang/crates.io-index)",
178 ]
179
180 [[package]]
181 name = "ansi_term"
182 version = "0.9.0"
183 source = "registry+https://github.com/rust-lang/crates.io-index"
184
185 [[package]]
186 name = "atty"
187 version = "0.2.10"
188 source = "registry+https://github.com/rust-lang/crates.io-index"
189 dependencies = [
190 "libc 0.2.42 (registry+https://github.com/rust-lang/crates.io-index)",
191 "termion 1.5.1 (registry+https://github.com/rust-lang/crates.io-index)",
192 "winapi 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)",
193 ]
194
195 [metadata]
196 "checksum aho-corasick 0.6.4 (registry+https://github.com/rust-lang/crates.io-index)" = "d6531d44de723825aa81398a6415283229725a00fa30713812ab9323faa82fc4"
197 "checksum ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ee49baf6cb617b853aa8d93bf420db2383fab46d314482ca2803b40d5fde979b"
198 "checksum ansi_term 0.9.0 (registry+https://github.com/rust-lang/crates.io-index)" = "23ac7c30002a5accbf7e8987d0632fa6de155b7c3d39d0067317a391e00a2ef6"
199 "checksum arrayvec 0.4.7 (registry+https://github.com/rust-lang/crates.io-index)" = "a1e964f9e24d588183fcb43503abda40d288c8657dfc27311516ce2f05675aef"
200 '')
201
202 (builtins.fromTOML ''
203 a = [[{ b = true }]]
204 c = [ [ { d = true } ] ]
205 e = [[123]]
206 '')
207
208]
diff --git a/test/testdata/eval-okay-fromjson-escapes.exp b/test/testdata/eval-okay-fromjson-escapes.exp
new file mode 100644
index 0000000..add5505
--- /dev/null
+++ b/test/testdata/eval-okay-fromjson-escapes.exp
@@ -0,0 +1 @@
"quote \" reverse solidus \\ solidus / backspace  formfeed newline \n carriage return \r horizontal tab \t 1 char unicode encoded backspace  1 char unicode encoded e with accent é 2 char unicode encoded s with caron š 3 char unicode encoded rightwards arrow →"
diff --git a/test/testdata/eval-okay-fromjson-escapes.nix b/test/testdata/eval-okay-fromjson-escapes.nix
new file mode 100644
index 0000000..f007135
--- /dev/null
+++ b/test/testdata/eval-okay-fromjson-escapes.nix
@@ -0,0 +1,3 @@
1# This string contains all supported escapes in a JSON string, per json.org
2# \b and \f are not supported by Nix
3builtins.fromJSON ''"quote \" reverse solidus \\ solidus \/ backspace \b formfeed \f newline \n carriage return \r horizontal tab \t 1 char unicode encoded backspace \u0008 1 char unicode encoded e with accent \u00e9 2 char unicode encoded s with caron \u0161 3 char unicode encoded rightwards arrow \u2192"''
diff --git a/test/testdata/eval-okay-fromjson.exp b/test/testdata/eval-okay-fromjson.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-fromjson.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-fromjson.nix b/test/testdata/eval-okay-fromjson.nix
new file mode 100644
index 0000000..4c526b9
--- /dev/null
+++ b/test/testdata/eval-okay-fromjson.nix
@@ -0,0 +1,41 @@
1builtins.fromJSON
2 ''
3 {
4 "Video": {
5 "Title": "The Penguin Chronicles",
6 "Width": 1920,
7 "Height": 1080,
8 "EmbeddedData": [3.14159, 23493,null, true ,false, -10],
9 "Thumb": {
10 "Url": "http://www.example.com/video/5678931",
11 "Width": 200,
12 "Height": 250
13 },
14 "Animated" : false,
15 "IDs": [116, 943, 234, 38793, true ,false,null, -100],
16 "Escapes": "\"\\\/\t\n\r\t",
17 "Subtitle" : false,
18 "Latitude": 37.7668,
19 "Longitude": -122.3959
20 }
21 }
22 ''
23==
24 { Video =
25 { Title = "The Penguin Chronicles";
26 Width = 1920;
27 Height = 1080;
28 EmbeddedData = [ 3.14159 23493 null true false (0-10) ];
29 Thumb =
30 { Url = "http://www.example.com/video/5678931";
31 Width = 200;
32 Height = 250;
33 };
34 Animated = false;
35 IDs = [ 116 943 234 38793 true false null (0-100) ];
36 Escapes = "\"\\\/\t\n\r\t"; # supported in JSON but not Nix: \b\f
37 Subtitle = false;
38 Latitude = 37.7668;
39 Longitude = -122.3959;
40 };
41 }
diff --git a/test/testdata/eval-okay-functionargs.exp b/test/testdata/eval-okay-functionargs.exp
new file mode 100644
index 0000000..c1c9f8f
--- /dev/null
+++ b/test/testdata/eval-okay-functionargs.exp
@@ -0,0 +1 @@
[ "stdenv" "fetchurl" "aterm-stdenv" "aterm-stdenv2" "libX11" "libXv" "mplayer-stdenv2.libXv-libX11" "mplayer-stdenv2.libXv-libX11_2" "nix-stdenv-aterm-stdenv" "nix-stdenv2-aterm2-stdenv2" ]
diff --git a/test/testdata/eval-okay-functionargs.exp.xml b/test/testdata/eval-okay-functionargs.exp.xml
new file mode 100644
index 0000000..651f54c
--- /dev/null
+++ b/test/testdata/eval-okay-functionargs.exp.xml
@@ -0,0 +1,15 @@
1<?xml version='1.0' encoding='utf-8'?>
2<expr>
3 <list>
4 <string value="stdenv" />
5 <string value="fetchurl" />
6 <string value="aterm-stdenv" />
7 <string value="aterm-stdenv2" />
8 <string value="libX11" />
9 <string value="libXv" />
10 <string value="mplayer-stdenv2.libXv-libX11" />
11 <string value="mplayer-stdenv2.libXv-libX11_2" />
12 <string value="nix-stdenv-aterm-stdenv" />
13 <string value="nix-stdenv2-aterm2-stdenv2" />
14 </list>
15</expr>
diff --git a/test/testdata/eval-okay-functionargs.nix b/test/testdata/eval-okay-functionargs.nix
new file mode 100644
index 0000000..68dca62
--- /dev/null
+++ b/test/testdata/eval-okay-functionargs.nix
@@ -0,0 +1,80 @@
1let
2
3 stdenvFun = { }: { name = "stdenv"; };
4 stdenv2Fun = { }: { name = "stdenv2"; };
5 fetchurlFun = { stdenv }: assert stdenv.name == "stdenv"; { name = "fetchurl"; };
6 atermFun = { stdenv, fetchurl }: { name = "aterm-${stdenv.name}"; };
7 aterm2Fun = { stdenv, fetchurl }: { name = "aterm2-${stdenv.name}"; };
8 nixFun = { stdenv, fetchurl, aterm }: { name = "nix-${stdenv.name}-${aterm.name}"; };
9
10 mplayerFun =
11 { stdenv, fetchurl, enableX11 ? false, xorg ? null, enableFoo ? true, foo ? null }:
12 assert stdenv.name == "stdenv2";
13 assert enableX11 -> xorg.libXv.name == "libXv";
14 assert enableFoo -> foo != null;
15 { name = "mplayer-${stdenv.name}.${xorg.libXv.name}-${xorg.libX11.name}"; };
16
17 makeOverridable = f: origArgs: f origArgs //
18 { override = newArgs:
19 makeOverridable f (origArgs // (if builtins.isFunction newArgs then newArgs origArgs else newArgs));
20 };
21
22 callPackage_ = pkgs: f: args:
23 makeOverridable f ((builtins.intersectAttrs (builtins.functionArgs f) pkgs) // args);
24
25 allPackages =
26 { overrides ? (pkgs: pkgsPrev: { }) }:
27 let
28 callPackage = callPackage_ pkgs;
29 pkgs = pkgsStd // (overrides pkgs pkgsStd);
30 pkgsStd = {
31 inherit pkgs;
32 stdenv = callPackage stdenvFun { };
33 stdenv2 = callPackage stdenv2Fun { };
34 fetchurl = callPackage fetchurlFun { };
35 aterm = callPackage atermFun { };
36 xorg = callPackage xorgFun { };
37 mplayer = callPackage mplayerFun { stdenv = pkgs.stdenv2; enableFoo = false; };
38 nix = callPackage nixFun { };
39 };
40 in pkgs;
41
42 libX11Fun = { stdenv, fetchurl }: { name = "libX11"; };
43 libX11_2Fun = { stdenv, fetchurl }: { name = "libX11_2"; };
44 libXvFun = { stdenv, fetchurl, libX11 }: { name = "libXv"; };
45
46 xorgFun =
47 { pkgs }:
48 let callPackage = callPackage_ (pkgs // pkgs.xorg); in
49 {
50 libX11 = callPackage libX11Fun { };
51 libXv = callPackage libXvFun { };
52 };
53
54in
55
56let
57
58 pkgs = allPackages { };
59
60 pkgs2 = allPackages {
61 overrides = pkgs: pkgsPrev: {
62 stdenv = pkgs.stdenv2;
63 nix = pkgsPrev.nix.override { aterm = aterm2Fun { inherit (pkgs) stdenv fetchurl; }; };
64 xorg = pkgsPrev.xorg // { libX11 = libX11_2Fun { inherit (pkgs) stdenv fetchurl; }; };
65 };
66 };
67
68in
69
70 [ pkgs.stdenv.name
71 pkgs.fetchurl.name
72 pkgs.aterm.name
73 pkgs2.aterm.name
74 pkgs.xorg.libX11.name
75 pkgs.xorg.libXv.name
76 pkgs.mplayer.name
77 pkgs2.mplayer.name
78 pkgs.nix.name
79 pkgs2.nix.name
80 ]
diff --git a/test/testdata/eval-okay-getattrpos-functionargs.exp b/test/testdata/eval-okay-getattrpos-functionargs.exp
new file mode 100644
index 0000000..7f9ac40
--- /dev/null
+++ b/test/testdata/eval-okay-getattrpos-functionargs.exp
@@ -0,0 +1 @@
{ column = 11; file = "eval-okay-getattrpos-functionargs.nix"; line = 2; }
diff --git a/test/testdata/eval-okay-getattrpos-functionargs.nix b/test/testdata/eval-okay-getattrpos-functionargs.nix
new file mode 100644
index 0000000..11d6bb0
--- /dev/null
+++ b/test/testdata/eval-okay-getattrpos-functionargs.nix
@@ -0,0 +1,4 @@
1let
2 fun = { foo }: {};
3 pos = builtins.unsafeGetAttrPos "foo" (builtins.functionArgs fun);
4in { inherit (pos) column line; file = baseNameOf pos.file; }
diff --git a/test/testdata/eval-okay-getattrpos-undefined.exp b/test/testdata/eval-okay-getattrpos-undefined.exp
new file mode 100644
index 0000000..19765bd
--- /dev/null
+++ b/test/testdata/eval-okay-getattrpos-undefined.exp
@@ -0,0 +1 @@
null
diff --git a/test/testdata/eval-okay-getattrpos-undefined.nix b/test/testdata/eval-okay-getattrpos-undefined.nix
new file mode 100644
index 0000000..14dd38f
--- /dev/null
+++ b/test/testdata/eval-okay-getattrpos-undefined.nix
@@ -0,0 +1 @@
builtins.unsafeGetAttrPos "abort" builtins
diff --git a/test/testdata/eval-okay-getattrpos.exp b/test/testdata/eval-okay-getattrpos.exp
new file mode 100644
index 0000000..469249b
--- /dev/null
+++ b/test/testdata/eval-okay-getattrpos.exp
@@ -0,0 +1 @@
{ column = 5; file = "eval-okay-getattrpos.nix"; line = 3; }
diff --git a/test/testdata/eval-okay-getattrpos.nix b/test/testdata/eval-okay-getattrpos.nix
new file mode 100644
index 0000000..ca6b079
--- /dev/null
+++ b/test/testdata/eval-okay-getattrpos.nix
@@ -0,0 +1,6 @@
1let
2 as = {
3 foo = "bar";
4 };
5 pos = builtins.unsafeGetAttrPos "foo" as;
6in { inherit (pos) column line; file = baseNameOf pos.file; }
diff --git a/test/testdata/eval-okay-getenv.exp b/test/testdata/eval-okay-getenv.exp
new file mode 100644
index 0000000..14e24d4
--- /dev/null
+++ b/test/testdata/eval-okay-getenv.exp
@@ -0,0 +1 @@
"foobar"
diff --git a/test/testdata/eval-okay-getenv.nix b/test/testdata/eval-okay-getenv.nix
new file mode 100644
index 0000000..4cfec5f
--- /dev/null
+++ b/test/testdata/eval-okay-getenv.nix
@@ -0,0 +1 @@
builtins.getEnv "TEST_VAR" + (if builtins.getEnv "NO_SUCH_VAR" == "" then "bar" else "bla")
diff --git a/test/testdata/eval-okay-groupBy.exp b/test/testdata/eval-okay-groupBy.exp
new file mode 100644
index 0000000..bfca565
--- /dev/null
+++ b/test/testdata/eval-okay-groupBy.exp
@@ -0,0 +1 @@
{ "1" = [ 9 ]; "2" = [ 8 ]; "3" = [ 13 29 ]; "4" = [ 3 4 10 11 17 18 ]; "5" = [ 0 23 26 28 ]; "6" = [ 1 12 21 27 30 ]; "7" = [ 7 22 ]; "8" = [ 14 ]; "9" = [ 19 ]; b = [ 16 25 ]; c = [ 24 ]; d = [ 2 ]; e = [ 5 6 15 31 ]; f = [ 20 ]; }
diff --git a/test/testdata/eval-okay-groupBy.nix b/test/testdata/eval-okay-groupBy.nix
new file mode 100644
index 0000000..862d89d
--- /dev/null
+++ b/test/testdata/eval-okay-groupBy.nix
@@ -0,0 +1,5 @@
1with import ./lib.nix;
2
3builtins.groupBy (n:
4 builtins.substring 0 1 (builtins.hashString "sha256" (toString n))
5) (range 0 31)
diff --git a/test/testdata/eval-okay-hash.exp b/test/testdata/eval-okay-hash.exp
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/test/testdata/eval-okay-hash.exp
diff --git a/test/testdata/eval-okay-hashfile.exp b/test/testdata/eval-okay-hashfile.exp
new file mode 100644
index 0000000..ff1e829
--- /dev/null
+++ b/test/testdata/eval-okay-hashfile.exp
@@ -0,0 +1 @@
[ "d3b07384d113edec49eaa6238ad5ff00" "0f343b0931126a20f133d67c2b018a3b" "f1d2d2f924e986ac86fdf7b36c94bcdf32beec15" "60cacbf3d72e1e7834203da608037b1bf83b40e8" "b5bb9d8014a0f9b1d61e21e796d78dccdf1352f23cd32812f4850b878ae4944c" "5f70bf18a086007016e948b04aed3b82103a36bea41755b6cddfaf10ace3c6ef" "0cf9180a764aba863a67b6d72f0918bc131c6772642cb2dce5a34f0a702f9470ddc2bf125c12198b1995c233c34b4afd346c54a2334c350a948a51b6e8b4e6b6" "8efb4f73c5655351c444eb109230c556d39e2c7624e9c11abc9e3fb4b9b9254218cc5085b454a9698d085cfa92198491f07a723be4574adc70617b73eb0b6461" ]
diff --git a/test/testdata/eval-okay-hashfile.nix b/test/testdata/eval-okay-hashfile.nix
new file mode 100644
index 0000000..aff5a18
--- /dev/null
+++ b/test/testdata/eval-okay-hashfile.nix
@@ -0,0 +1,4 @@
1let
2 paths = [ ./data ./binary-data ];
3in
4 builtins.concatLists (map (hash: map (builtins.hashFile hash) paths) ["md5" "sha1" "sha256" "sha512"])
diff --git a/test/testdata/eval-okay-hashstring.exp b/test/testdata/eval-okay-hashstring.exp
new file mode 100644
index 0000000..d720a08
--- /dev/null
+++ b/test/testdata/eval-okay-hashstring.exp
@@ -0,0 +1 @@
[ "d41d8cd98f00b204e9800998ecf8427e" "6c69ee7f211c640419d5366cc076ae46" "bb3438fbabd460ea6dbd27d153e2233b" "da39a3ee5e6b4b0d3255bfef95601890afd80709" "cd54e8568c1b37cf1e5badb0779bcbf382212189" "6d12e10b1d331dad210e47fd25d4f260802b7e77" "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" "900a4469df00ccbfd0c145c6d1e4b7953dd0afafadd7534e3a4019e8d38fc663" "ad0387b3bd8652f730ca46d25f9c170af0fd589f42e7f23f5a9e6412d97d7e56" "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" "9d0886f8c6b389398a16257bc79780fab9831c7fc11c8ab07fa732cb7b348feade382f92617c9c5305fefba0af02ab5fd39a587d330997ff5bd0db19f7666653" "21644b72aa259e5a588cd3afbafb1d4310f4889680f6c83b9d531596a5a284f34dbebff409d23bcc86aee6bad10c891606f075c6f4755cb536da27db5693f3a7" ]
diff --git a/test/testdata/eval-okay-hashstring.nix b/test/testdata/eval-okay-hashstring.nix
new file mode 100644
index 0000000..b0f62b2
--- /dev/null
+++ b/test/testdata/eval-okay-hashstring.nix
@@ -0,0 +1,4 @@
1let
2 strings = [ "" "text 1" "text 2" ];
3in
4 builtins.concatLists (map (hash: map (builtins.hashString hash) strings) ["md5" "sha1" "sha256" "sha512"])
diff --git a/test/testdata/eval-okay-if.exp b/test/testdata/eval-okay-if.exp
new file mode 100644
index 0000000..00750ed
--- /dev/null
+++ b/test/testdata/eval-okay-if.exp
@@ -0,0 +1 @@
3
diff --git a/test/testdata/eval-okay-if.nix b/test/testdata/eval-okay-if.nix
new file mode 100644
index 0000000..23e4c74
--- /dev/null
+++ b/test/testdata/eval-okay-if.nix
@@ -0,0 +1 @@
if "foo" != "f" + "oo" then 1 else if false then 2 else 3
diff --git a/test/testdata/eval-okay-import.exp b/test/testdata/eval-okay-import.exp
new file mode 100644
index 0000000..c508125
--- /dev/null
+++ b/test/testdata/eval-okay-import.exp
@@ -0,0 +1 @@
[ 1 2 3 4 5 6 7 8 9 10 ]
diff --git a/test/testdata/eval-okay-import.nix b/test/testdata/eval-okay-import.nix
new file mode 100644
index 0000000..0b18d94
--- /dev/null
+++ b/test/testdata/eval-okay-import.nix
@@ -0,0 +1,11 @@
1let
2
3 overrides = {
4 import = fn: scopedImport overrides fn;
5
6 scopedImport = attrs: fn: scopedImport (overrides // attrs) fn;
7
8 builtins = builtins // overrides;
9 } // import ./lib.nix;
10
11in scopedImport overrides ./imported.nix
diff --git a/test/testdata/eval-okay-ind-string.exp b/test/testdata/eval-okay-ind-string.exp
new file mode 100644
index 0000000..7862331
--- /dev/null
+++ b/test/testdata/eval-okay-ind-string.exp
@@ -0,0 +1 @@
"This is an indented multi-line string\nliteral. An amount of whitespace at\nthe start of each line matching the minimum\nindentation of all lines in the string\nliteral together will be removed. Thus,\nin this case four spaces will be\nstripped from each line, even though\n THIS LINE is indented six spaces.\n\nAlso, empty lines don't count in the\ndetermination of the indentation level (the\nprevious empty line has indentation 0, but\nit doesn't matter).\nIf the string starts with whitespace\n followed by a newline, it's stripped, but\n that's not the case here. Two spaces are\n stripped because of the \" \" at the start. \nThis line is indented\na bit further.\nAnti-quotations, like so, are\nalso allowed.\n The \\ is not special here.\n' can be followed by any character except another ', e.g. 'x'.\nLikewise for $, e.g. $$ or $varName.\nBut ' followed by ' is special, as is $ followed by {.\nIf you want them, use anti-quotations: '', \${.\n Tabs are not interpreted as whitespace (since we can't guess\n what tab settings are intended), so don't use them.\n\tThis line starts with a space and a tab, so only one\n space will be stripped from each line.\nAlso note that if the last line (just before the closing ' ')\nconsists only of whitespace, it's ignored. But here there is\nsome non-whitespace stuff, so the line isn't removed. \nThis shows a hacky way to preserve an empty line after the start.\nBut there's no reason to do so: you could just repeat the empty\nline.\n Similarly you can force an indentation level,\n in this case to 2 spaces. This works because the anti-quote\n is significant (not whitespace).\nstart on network-interfaces\n\nstart script\n\n rm -f /var/run/opengl-driver\n ln -sf 123 /var/run/opengl-driver\n\n rm -f /var/log/slim.log\n \nend script\n\nenv SLIM_CFGFILE=abc\nenv SLIM_THEMESDIR=def\nenv FONTCONFIG_FILE=/etc/fonts/fonts.conf \t\t\t\t# !!! cleanup\nenv XKB_BINDIR=foo/bin \t\t\t\t# Needed for the Xkb extension.\nenv LD_LIBRARY_PATH=libX11/lib:libXext/lib:/usr/lib/ # related to xorg-sys-opengl - needed to load libglx for (AI)GLX support (for compiz)\n\nenv XORG_DRI_DRIVER_PATH=nvidiaDrivers/X11R6/lib/modules/drivers/ \n\nexec slim/bin/slim\nEscaping of ' followed by ': ''\nEscaping of $ followed by {: \${\nAnd finally to interpret \\n etc. as in a string: \n, \r, \t.\nfoo\n'bla'\nbar\ncut -d $'\\t' -f 1\nending dollar $$\n"
diff --git a/test/testdata/eval-okay-ind-string.nix b/test/testdata/eval-okay-ind-string.nix
new file mode 100644
index 0000000..95d59b5
--- /dev/null
+++ b/test/testdata/eval-okay-ind-string.nix
@@ -0,0 +1,128 @@
1let
2
3 s1 = ''
4 This is an indented multi-line string
5 literal. An amount of whitespace at
6 the start of each line matching the minimum
7 indentation of all lines in the string
8 literal together will be removed. Thus,
9 in this case four spaces will be
10 stripped from each line, even though
11 THIS LINE is indented six spaces.
12
13 Also, empty lines don't count in the
14 determination of the indentation level (the
15 previous empty line has indentation 0, but
16 it doesn't matter).
17 '';
18
19 s2 = '' If the string starts with whitespace
20 followed by a newline, it's stripped, but
21 that's not the case here. Two spaces are
22 stripped because of the " " at the start.
23 '';
24
25 s3 = ''
26 This line is indented
27 a bit further.
28 ''; # indentation of last line doesn't count if it's empty
29
30 s4 = ''
31 Anti-quotations, like ${if true then "so" else "not so"}, are
32 also allowed.
33 '';
34
35 s5 = ''
36 The \ is not special here.
37 ' can be followed by any character except another ', e.g. 'x'.
38 Likewise for $, e.g. $$ or $varName.
39 But ' followed by ' is special, as is $ followed by {.
40 If you want them, use anti-quotations: ${"''"}, ${"\${"}.
41 '';
42
43 s6 = ''
44 Tabs are not interpreted as whitespace (since we can't guess
45 what tab settings are intended), so don't use them.
46 This line starts with a space and a tab, so only one
47 space will be stripped from each line.
48 '';
49
50 s7 = ''
51 Also note that if the last line (just before the closing ' ')
52 consists only of whitespace, it's ignored. But here there is
53 some non-whitespace stuff, so the line isn't removed. '';
54
55 s8 = '' ${""}
56 This shows a hacky way to preserve an empty line after the start.
57 But there's no reason to do so: you could just repeat the empty
58 line.
59 '';
60
61 s9 = ''
62 ${""} Similarly you can force an indentation level,
63 in this case to 2 spaces. This works because the anti-quote
64 is significant (not whitespace).
65 '';
66
67 s10 = ''
68 '';
69
70 s11 = '''';
71
72 s12 = '' '';
73
74 s13 = ''
75 start on network-interfaces
76
77 start script
78
79 rm -f /var/run/opengl-driver
80 ${if true
81 then "ln -sf 123 /var/run/opengl-driver"
82 else if true
83 then "ln -sf 456 /var/run/opengl-driver"
84 else ""
85 }
86
87 rm -f /var/log/slim.log
88
89 end script
90
91 env SLIM_CFGFILE=${"abc"}
92 env SLIM_THEMESDIR=${"def"}
93 env FONTCONFIG_FILE=/etc/fonts/fonts.conf # !!! cleanup
94 env XKB_BINDIR=${"foo"}/bin # Needed for the Xkb extension.
95 env LD_LIBRARY_PATH=${"libX11"}/lib:${"libXext"}/lib:/usr/lib/ # related to xorg-sys-opengl - needed to load libglx for (AI)GLX support (for compiz)
96
97 ${if true
98 then "env XORG_DRI_DRIVER_PATH=${"nvidiaDrivers"}/X11R6/lib/modules/drivers/"
99 else if true
100 then "env XORG_DRI_DRIVER_PATH=${"mesa"}/lib/modules/dri"
101 else ""
102 }
103
104 exec ${"slim"}/bin/slim
105 '';
106
107 s14 = ''
108 Escaping of ' followed by ': '''
109 Escaping of $ followed by {: ''${
110 And finally to interpret \n etc. as in a string: ''\n, ''\r, ''\t.
111 '';
112
113 # Regression test: string interpolation in '${x}' should work, but didn't.
114 s15 = let x = "bla"; in ''
115 foo
116 '${x}'
117 bar
118 '';
119
120 # Regression test: accept $'.
121 s16 = ''
122 cut -d $'\t' -f 1
123 '';
124
125 # Accept dollars at end of strings
126 s17 = ''ending dollar $'' + ''$'' + "\n";
127
128in s1 + s2 + s3 + s4 + s5 + s6 + s7 + s8 + s9 + s10 + s11 + s12 + s13 + s14 + s15 + s16 + s17
diff --git a/test/testdata/eval-okay-inherit-attr-pos.exp b/test/testdata/eval-okay-inherit-attr-pos.exp
new file mode 100644
index 0000000..e87d037
--- /dev/null
+++ b/test/testdata/eval-okay-inherit-attr-pos.exp
@@ -0,0 +1 @@
[ { column = 17; file = "/pwd/lang/eval-okay-inherit-attr-pos.nix"; line = 4; } { column = 19; file = "/pwd/lang/eval-okay-inherit-attr-pos.nix"; line = 4; } { column = 21; file = "/pwd/lang/eval-okay-inherit-attr-pos.nix"; line = 5; } { column = 23; file = "/pwd/lang/eval-okay-inherit-attr-pos.nix"; line = 5; } ]
diff --git a/test/testdata/eval-okay-inherit-attr-pos.nix b/test/testdata/eval-okay-inherit-attr-pos.nix
new file mode 100644
index 0000000..017ab1d
--- /dev/null
+++ b/test/testdata/eval-okay-inherit-attr-pos.nix
@@ -0,0 +1,12 @@
1let
2 d = 0;
3 x = 1;
4 y = { inherit d x; };
5 z = { inherit (y) d x; };
6in
7 [
8 (builtins.unsafeGetAttrPos "d" y)
9 (builtins.unsafeGetAttrPos "x" y)
10 (builtins.unsafeGetAttrPos "d" z)
11 (builtins.unsafeGetAttrPos "x" z)
12 ]
diff --git a/test/testdata/eval-okay-inherit-from.err.exp b/test/testdata/eval-okay-inherit-from.err.exp
new file mode 100644
index 0000000..3227501
--- /dev/null
+++ b/test/testdata/eval-okay-inherit-from.err.exp
@@ -0,0 +1 @@
trace: used
diff --git a/test/testdata/eval-okay-inherit-from.exp b/test/testdata/eval-okay-inherit-from.exp
new file mode 100644
index 0000000..024daff
--- /dev/null
+++ b/test/testdata/eval-okay-inherit-from.exp
@@ -0,0 +1 @@
[ 1 2 { __overrides = { y = { d = [ ]; }; }; c = [ ]; d = 4; x = { c = [ ]; }; y = «repeated»; } { inner = { c = 3; d = 4; }; } ]
diff --git a/test/testdata/eval-okay-inherit-from.nix b/test/testdata/eval-okay-inherit-from.nix
new file mode 100644
index 0000000..b72a1c6
--- /dev/null
+++ b/test/testdata/eval-okay-inherit-from.nix
@@ -0,0 +1,16 @@
1let
2 inherit (builtins.trace "used" { a = 1; b = 2; }) a b;
3 x.c = 3;
4 y.d = 4;
5
6 merged = {
7 inner = {
8 inherit (y) d;
9 };
10
11 inner = {
12 inherit (x) c;
13 };
14 };
15in
16 [ a b rec { x.c = []; inherit (x) c; inherit (y) d; __overrides.y.d = []; } merged ]
diff --git a/test/testdata/eval-okay-intersectAttrs.exp b/test/testdata/eval-okay-intersectAttrs.exp
new file mode 100644
index 0000000..50445bc
--- /dev/null
+++ b/test/testdata/eval-okay-intersectAttrs.exp
@@ -0,0 +1 @@
[ { } { a = 1; } { a = 1; } { a = "a"; } { m = 1; } { m = "m"; } { n = 1; } { n = "n"; } { n = 1; p = 2; } { n = "n"; p = "p"; } { n = 1; p = 2; } { n = "n"; p = "p"; } { a = "a"; b = "b"; c = "c"; d = "d"; e = "e"; f = "f"; g = "g"; h = "h"; i = "i"; j = "j"; k = "k"; l = "l"; m = "m"; n = "n"; o = "o"; p = "p"; q = "q"; r = "r"; s = "s"; t = "t"; u = "u"; v = "v"; w = "w"; x = "x"; y = "y"; z = "z"; } true ]
diff --git a/test/testdata/eval-okay-intersectAttrs.nix b/test/testdata/eval-okay-intersectAttrs.nix
new file mode 100644
index 0000000..39d4993
--- /dev/null
+++ b/test/testdata/eval-okay-intersectAttrs.nix
@@ -0,0 +1,50 @@
1let
2 alphabet =
3 { a = "a";
4 b = "b";
5 c = "c";
6 d = "d";
7 e = "e";
8 f = "f";
9 g = "g";
10 h = "h";
11 i = "i";
12 j = "j";
13 k = "k";
14 l = "l";
15 m = "m";
16 n = "n";
17 o = "o";
18 p = "p";
19 q = "q";
20 r = "r";
21 s = "s";
22 t = "t";
23 u = "u";
24 v = "v";
25 w = "w";
26 x = "x";
27 y = "y";
28 z = "z";
29 };
30 foo = {
31 inherit (alphabet) f o b a r z q u x;
32 aa = throw "aa";
33 };
34 alphabetFail = builtins.mapAttrs throw alphabet;
35in
36[ (builtins.intersectAttrs { a = abort "l1"; } { b = abort "r1"; })
37 (builtins.intersectAttrs { a = abort "l2"; } { a = 1; })
38 (builtins.intersectAttrs alphabetFail { a = 1; })
39 (builtins.intersectAttrs { a = abort "laa"; } alphabet)
40 (builtins.intersectAttrs alphabetFail { m = 1; })
41 (builtins.intersectAttrs { m = abort "lam"; } alphabet)
42 (builtins.intersectAttrs alphabetFail { n = 1; })
43 (builtins.intersectAttrs { n = abort "lan"; } alphabet)
44 (builtins.intersectAttrs alphabetFail { n = 1; p = 2; })
45 (builtins.intersectAttrs { n = abort "lan2"; p = abort "lap"; } alphabet)
46 (builtins.intersectAttrs alphabetFail { n = 1; p = 2; })
47 (builtins.intersectAttrs { n = abort "lan2"; p = abort "lap"; } alphabet)
48 (builtins.intersectAttrs alphabetFail alphabet)
49 (builtins.intersectAttrs alphabet foo == builtins.intersectAttrs foo alphabet)
50]
diff --git a/test/testdata/eval-okay-let.exp b/test/testdata/eval-okay-let.exp
new file mode 100644
index 0000000..14e24d4
--- /dev/null
+++ b/test/testdata/eval-okay-let.exp
@@ -0,0 +1 @@
"foobar"
diff --git a/test/testdata/eval-okay-let.nix b/test/testdata/eval-okay-let.nix
new file mode 100644
index 0000000..fe118c5
--- /dev/null
+++ b/test/testdata/eval-okay-let.nix
@@ -0,0 +1,5 @@
1let {
2 x = "foo";
3 y = "bar";
4 body = x + y;
5}
diff --git a/test/testdata/eval-okay-list.exp b/test/testdata/eval-okay-list.exp
new file mode 100644
index 0000000..f784f26
--- /dev/null
+++ b/test/testdata/eval-okay-list.exp
@@ -0,0 +1 @@
"foobarblatest"
diff --git a/test/testdata/eval-okay-list.nix b/test/testdata/eval-okay-list.nix
new file mode 100644
index 0000000..d433bcf
--- /dev/null
+++ b/test/testdata/eval-okay-list.nix
@@ -0,0 +1,7 @@
1with import ./lib.nix;
2
3let {
4
5 body = concat ["foo" "bar" "bla" "test"];
6
7} \ No newline at end of file
diff --git a/test/testdata/eval-okay-listtoattrs.exp b/test/testdata/eval-okay-listtoattrs.exp
new file mode 100644
index 0000000..74abef7
--- /dev/null
+++ b/test/testdata/eval-okay-listtoattrs.exp
@@ -0,0 +1 @@
"AAbar"
diff --git a/test/testdata/eval-okay-listtoattrs.nix b/test/testdata/eval-okay-listtoattrs.nix
new file mode 100644
index 0000000..4186e02
--- /dev/null
+++ b/test/testdata/eval-okay-listtoattrs.nix
@@ -0,0 +1,11 @@
1# this test shows how to use listToAttrs and that evaluation is still lazy (throw isn't called)
2with import ./lib.nix;
3
4let
5 asi = name: value : { inherit name value; };
6 list = [ ( asi "a" "A" ) ( asi "b" "B" ) ];
7 a = builtins.listToAttrs list;
8 b = builtins.listToAttrs ( list ++ list );
9 r = builtins.listToAttrs [ (asi "result" [ a b ]) ( asi "throw" (throw "this should not be thrown")) ];
10 x = builtins.listToAttrs [ (asi "foo" "bar") (asi "foo" "bla") ];
11in concat (map (x: x.a) r.result) + x.foo
diff --git a/test/testdata/eval-okay-logic.exp b/test/testdata/eval-okay-logic.exp
new file mode 100644
index 0000000..d00491f
--- /dev/null
+++ b/test/testdata/eval-okay-logic.exp
@@ -0,0 +1 @@
1
diff --git a/test/testdata/eval-okay-logic.nix b/test/testdata/eval-okay-logic.nix
new file mode 100644
index 0000000..fbb1279
--- /dev/null
+++ b/test/testdata/eval-okay-logic.nix
@@ -0,0 +1 @@
assert !false && (true || false) -> true; 1
diff --git a/test/testdata/eval-okay-map.exp b/test/testdata/eval-okay-map.exp
new file mode 100644
index 0000000..dbb64f7
--- /dev/null
+++ b/test/testdata/eval-okay-map.exp
@@ -0,0 +1 @@
"foobarblabarxyzzybar"
diff --git a/test/testdata/eval-okay-map.nix b/test/testdata/eval-okay-map.nix
new file mode 100644
index 0000000..a76c1d8
--- /dev/null
+++ b/test/testdata/eval-okay-map.nix
@@ -0,0 +1,3 @@
1with import ./lib.nix;
2
3concat (map (x: x + "bar") [ "foo" "bla" "xyzzy" ]) \ No newline at end of file
diff --git a/test/testdata/eval-okay-mapattrs.exp b/test/testdata/eval-okay-mapattrs.exp
new file mode 100644
index 0000000..3f113f1
--- /dev/null
+++ b/test/testdata/eval-okay-mapattrs.exp
@@ -0,0 +1 @@
{ x = "x-foo"; y = "y-bar"; }
diff --git a/test/testdata/eval-okay-mapattrs.nix b/test/testdata/eval-okay-mapattrs.nix
new file mode 100644
index 0000000..f075b62
--- /dev/null
+++ b/test/testdata/eval-okay-mapattrs.nix
@@ -0,0 +1,3 @@
1with import ./lib.nix;
2
3builtins.mapAttrs (name: value: name + "-" + value) { x = "foo"; y = "bar"; }
diff --git a/test/testdata/eval-okay-merge-dynamic-attrs.exp b/test/testdata/eval-okay-merge-dynamic-attrs.exp
new file mode 100644
index 0000000..157d677
--- /dev/null
+++ b/test/testdata/eval-okay-merge-dynamic-attrs.exp
@@ -0,0 +1 @@
{ set1 = { a = 1; b = 2; }; set2 = { a = 1; b = 2; }; set3 = { a = 1; b = 2; }; set4 = { a = 1; b = 2; }; }
diff --git a/test/testdata/eval-okay-merge-dynamic-attrs.nix b/test/testdata/eval-okay-merge-dynamic-attrs.nix
new file mode 100644
index 0000000..f459a55
--- /dev/null
+++ b/test/testdata/eval-okay-merge-dynamic-attrs.nix
@@ -0,0 +1,13 @@
1{
2 set1 = { a = 1; };
3 set1 = { "${"b" + ""}" = 2; };
4
5 set2 = { "${"b" + ""}" = 2; };
6 set2 = { a = 1; };
7
8 set3.a = 1;
9 set3."${"b" + ""}" = 2;
10
11 set4."${"b" + ""}" = 2;
12 set4.a = 1;
13}
diff --git a/test/testdata/eval-okay-nested-with.exp b/test/testdata/eval-okay-nested-with.exp
new file mode 100644
index 0000000..0cfbf08
--- /dev/null
+++ b/test/testdata/eval-okay-nested-with.exp
@@ -0,0 +1 @@
2
diff --git a/test/testdata/eval-okay-nested-with.nix b/test/testdata/eval-okay-nested-with.nix
new file mode 100644
index 0000000..ba9d79a
--- /dev/null
+++ b/test/testdata/eval-okay-nested-with.nix
@@ -0,0 +1,3 @@
1with { x = 1; };
2with { x = 2; };
3x
diff --git a/test/testdata/eval-okay-new-let.exp b/test/testdata/eval-okay-new-let.exp
new file mode 100644
index 0000000..f98b388
--- /dev/null
+++ b/test/testdata/eval-okay-new-let.exp
@@ -0,0 +1 @@
"xyzzyfoobar"
diff --git a/test/testdata/eval-okay-new-let.nix b/test/testdata/eval-okay-new-let.nix
new file mode 100644
index 0000000..7381231
--- /dev/null
+++ b/test/testdata/eval-okay-new-let.nix
@@ -0,0 +1,14 @@
1let
2
3 f = z:
4
5 let
6 x = "foo";
7 y = "bar";
8 body = 1; # compat test
9 in
10 z + x + y;
11
12 arg = "xyzzy";
13
14in f arg
diff --git a/test/testdata/eval-okay-null-dynamic-attrs.exp b/test/testdata/eval-okay-null-dynamic-attrs.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-null-dynamic-attrs.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-null-dynamic-attrs.nix b/test/testdata/eval-okay-null-dynamic-attrs.nix
new file mode 100644
index 0000000..b060c0b
--- /dev/null
+++ b/test/testdata/eval-okay-null-dynamic-attrs.nix
@@ -0,0 +1 @@
{ ${null} = true; } == {}
diff --git a/test/testdata/eval-okay-overrides.exp b/test/testdata/eval-okay-overrides.exp
new file mode 100644
index 0000000..0cfbf08
--- /dev/null
+++ b/test/testdata/eval-okay-overrides.exp
@@ -0,0 +1 @@
2
diff --git a/test/testdata/eval-okay-overrides.nix b/test/testdata/eval-okay-overrides.nix
new file mode 100644
index 0000000..719bdc9
--- /dev/null
+++ b/test/testdata/eval-okay-overrides.nix
@@ -0,0 +1,9 @@
1let
2
3 overrides = { a = 2; b = 3; };
4
5in (rec {
6 __overrides = overrides;
7 x = a;
8 a = 1;
9}).x
diff --git a/test/testdata/eval-okay-parse-flake-ref.exp b/test/testdata/eval-okay-parse-flake-ref.exp
new file mode 100644
index 0000000..fc17ba0
--- /dev/null
+++ b/test/testdata/eval-okay-parse-flake-ref.exp
@@ -0,0 +1 @@
{ dir = "lib"; owner = "NixOS"; ref = "23.05"; repo = "nixpkgs"; type = "github"; }
diff --git a/test/testdata/eval-okay-parse-flake-ref.nix b/test/testdata/eval-okay-parse-flake-ref.nix
new file mode 100644
index 0000000..db4ed27
--- /dev/null
+++ b/test/testdata/eval-okay-parse-flake-ref.nix
@@ -0,0 +1 @@
builtins.parseFlakeRef "github:NixOS/nixpkgs/23.05?dir=lib"
diff --git a/test/testdata/eval-okay-partition.exp b/test/testdata/eval-okay-partition.exp
new file mode 100644
index 0000000..cd8b8b0
--- /dev/null
+++ b/test/testdata/eval-okay-partition.exp
@@ -0,0 +1 @@
{ right = [ 0 2 4 6 8 10 100 102 104 106 108 110 ]; wrong = [ 1 3 5 7 9 101 103 105 107 109 ]; }
diff --git a/test/testdata/eval-okay-partition.nix b/test/testdata/eval-okay-partition.nix
new file mode 100644
index 0000000..846d2ce
--- /dev/null
+++ b/test/testdata/eval-okay-partition.nix
@@ -0,0 +1,5 @@
1with import ./lib.nix;
2
3builtins.partition
4 (x: x / 2 * 2 == x)
5 (builtins.concatLists [ (range 0 10) (range 100 110) ])
diff --git a/test/testdata/eval-okay-path-string-interpolation.exp b/test/testdata/eval-okay-path-string-interpolation.exp
new file mode 100644
index 0000000..5b8ea02
--- /dev/null
+++ b/test/testdata/eval-okay-path-string-interpolation.exp
@@ -0,0 +1 @@
{ absolute = /foo; expr = /pwd/lang/foo/bar; home = /fake-home/foo; notfirst = /pwd/lang/bar/foo; simple = /pwd/lang/foo; slashes = /foo/bar; surrounded = /pwd/lang/a-foo-b; }
diff --git a/test/testdata/eval-okay-path-string-interpolation.nix b/test/testdata/eval-okay-path-string-interpolation.nix
new file mode 100644
index 0000000..497d7c1
--- /dev/null
+++ b/test/testdata/eval-okay-path-string-interpolation.nix
@@ -0,0 +1,12 @@
1let
2 foo = "foo";
3in
4{
5 simple = ./${foo};
6 surrounded = ./a-${foo}-b;
7 absolute = /${foo};
8 expr = ./${foo + "/bar"};
9 home = ~/${foo};
10 notfirst = ./bar/${foo};
11 slashes = /${foo}/${"bar"};
12}
diff --git a/test/testdata/eval-okay-path.exp b/test/testdata/eval-okay-path.exp
new file mode 100644
index 0000000..635e224
--- /dev/null
+++ b/test/testdata/eval-okay-path.exp
@@ -0,0 +1 @@
[ "/nix/store/ya937r4ydw0l6kayq8jkyqaips9c75jm-output" "/nix/store/m7y372g6jb0g4hh1dzmj847rd356fhnz-output" ]
diff --git a/test/testdata/eval-okay-path.nix b/test/testdata/eval-okay-path.nix
new file mode 100644
index 0000000..599b335
--- /dev/null
+++ b/test/testdata/eval-okay-path.nix
@@ -0,0 +1,15 @@
1[
2 (builtins.path
3 { path = ./.;
4 filter = path: _: baseNameOf path == "data";
5 recursive = true;
6 sha256 = "1yhm3gwvg5a41yylymgblsclk95fs6jy72w0wv925mmidlhcq4sw";
7 name = "output";
8 })
9 (builtins.path
10 { path = ./data;
11 recursive = false;
12 sha256 = "0k4lwj58f2w5yh92ilrwy9917pycipbrdrr13vbb3yd02j09vfxm";
13 name = "output";
14 })
15]
diff --git a/test/testdata/eval-okay-pathexists.exp b/test/testdata/eval-okay-pathexists.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-pathexists.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-pathexists.nix b/test/testdata/eval-okay-pathexists.nix
new file mode 100644
index 0000000..022b22f
--- /dev/null
+++ b/test/testdata/eval-okay-pathexists.nix
@@ -0,0 +1,34 @@
1builtins.pathExists (./lib.nix)
2&& builtins.pathExists (builtins.toPath ./lib.nix)
3&& builtins.pathExists (builtins.toString ./lib.nix)
4&& !builtins.pathExists (builtins.toString ./lib.nix + "/")
5&& !builtins.pathExists (builtins.toString ./lib.nix + "/.")
6# FIXME
7# && !builtins.pathExists (builtins.toString ./lib.nix + "/..")
8# && !builtins.pathExists (builtins.toString ./lib.nix + "/a/..")
9# && !builtins.pathExists (builtins.toString ./lib.nix + "/../lib.nix")
10&& !builtins.pathExists (builtins.toString ./lib.nix + "/./")
11&& !builtins.pathExists (builtins.toString ./lib.nix + "/./.")
12&& builtins.pathExists (builtins.toString ./.. + "/lang/lib.nix")
13&& !builtins.pathExists (builtins.toString ./.. + "lang/lib.nix")
14&& builtins.pathExists (builtins.toString ./. + "/../lang/lib.nix")
15&& builtins.pathExists (builtins.toString ./. + "/../lang/./lib.nix")
16&& builtins.pathExists (builtins.toString ./.)
17&& builtins.pathExists (builtins.toString ./. + "/")
18&& builtins.pathExists (builtins.toString ./. + "/../lang")
19&& builtins.pathExists (builtins.toString ./. + "/../lang/")
20&& builtins.pathExists (builtins.toString ./. + "/../lang/.")
21&& builtins.pathExists (builtins.toString ./. + "/../lang/./")
22&& builtins.pathExists (builtins.toString ./. + "/../lang//./")
23&& builtins.pathExists (builtins.toString ./. + "/../lang/..")
24&& builtins.pathExists (builtins.toString ./. + "/../lang/../")
25&& builtins.pathExists (builtins.toString ./. + "/../lang/..//")
26&& builtins.pathExists (builtins.toPath (builtins.toString ./lib.nix))
27&& !builtins.pathExists (builtins.toPath (builtins.toString ./bla.nix))
28&& builtins.pathExists (builtins.toPath { __toString = x: builtins.toString ./lib.nix; })
29&& builtins.pathExists (builtins.toPath { outPath = builtins.toString ./lib.nix; })
30&& builtins.pathExists ./lib.nix
31&& !builtins.pathExists ./bla.nix
32&& builtins.pathExists ./symlink-resolution/foo/overlays/overlay.nix
33&& builtins.pathExists ./symlink-resolution/broken
34&& builtins.pathExists (builtins.toString ./symlink-resolution/foo/overlays + "/.")
diff --git a/test/testdata/eval-okay-patterns.exp b/test/testdata/eval-okay-patterns.exp
new file mode 100644
index 0000000..a430401
--- /dev/null
+++ b/test/testdata/eval-okay-patterns.exp
@@ -0,0 +1 @@
"abcxyzDDDDEFijk"
diff --git a/test/testdata/eval-okay-patterns.nix b/test/testdata/eval-okay-patterns.nix
new file mode 100644
index 0000000..96fd25a
--- /dev/null
+++ b/test/testdata/eval-okay-patterns.nix
@@ -0,0 +1,16 @@
1let
2
3 f = args@{x, y, z}: x + args.y + z;
4
5 g = {x, y, z}@args: f args;
6
7 h = {x ? "d", y ? x, z ? args.x}@args: x + y + z;
8
9 j = {x, y, z, ...}: x + y + z;
10
11in
12 f {x = "a"; y = "b"; z = "c";} +
13 g {x = "x"; y = "y"; z = "z";} +
14 h {x = "D";} +
15 h {x = "D"; y = "E"; z = "F";} +
16 j {x = "i"; y = "j"; z = "k"; bla = "bla"; foo = "bar";}
diff --git a/test/testdata/eval-okay-print.err.exp b/test/testdata/eval-okay-print.err.exp
new file mode 100644
index 0000000..80aa17c
--- /dev/null
+++ b/test/testdata/eval-okay-print.err.exp
@@ -0,0 +1 @@
trace: [ «thunk» ]
diff --git a/test/testdata/eval-okay-print.exp b/test/testdata/eval-okay-print.exp
new file mode 100644
index 0000000..0d960fb
--- /dev/null
+++ b/test/testdata/eval-okay-print.exp
@@ -0,0 +1 @@
[ null <PRIMOP> <PRIMOP-APP> <LAMBDA> [ [ «repeated» ] ] ]
diff --git a/test/testdata/eval-okay-print.nix b/test/testdata/eval-okay-print.nix
new file mode 100644
index 0000000..d36ba4d
--- /dev/null
+++ b/test/testdata/eval-okay-print.nix
@@ -0,0 +1 @@
with builtins; trace [(1+1)] [ null toString (deepSeq "x") (a: a) (let x=[x]; in x) ]
diff --git a/test/testdata/eval-okay-readDir.exp b/test/testdata/eval-okay-readDir.exp
new file mode 100644
index 0000000..6413f6d
--- /dev/null
+++ b/test/testdata/eval-okay-readDir.exp
@@ -0,0 +1 @@
{ bar = "regular"; foo = "directory"; ldir = "symlink"; linked = "symlink"; }
diff --git a/test/testdata/eval-okay-readDir.nix b/test/testdata/eval-okay-readDir.nix
new file mode 100644
index 0000000..a7ec929
--- /dev/null
+++ b/test/testdata/eval-okay-readDir.nix
@@ -0,0 +1 @@
builtins.readDir ./readDir
diff --git a/test/testdata/eval-okay-readFileType.exp b/test/testdata/eval-okay-readFileType.exp
new file mode 100644
index 0000000..6413f6d
--- /dev/null
+++ b/test/testdata/eval-okay-readFileType.exp
@@ -0,0 +1 @@
{ bar = "regular"; foo = "directory"; ldir = "symlink"; linked = "symlink"; }
diff --git a/test/testdata/eval-okay-readFileType.nix b/test/testdata/eval-okay-readFileType.nix
new file mode 100644
index 0000000..174fb6c
--- /dev/null
+++ b/test/testdata/eval-okay-readFileType.nix
@@ -0,0 +1,6 @@
1{
2 bar = builtins.readFileType ./readDir/bar;
3 foo = builtins.readFileType ./readDir/foo;
4 linked = builtins.readFileType ./readDir/linked;
5 ldir = builtins.readFileType ./readDir/ldir;
6}
diff --git a/test/testdata/eval-okay-readfile.exp b/test/testdata/eval-okay-readfile.exp
new file mode 100644
index 0000000..a2c87d0
--- /dev/null
+++ b/test/testdata/eval-okay-readfile.exp
@@ -0,0 +1 @@
"builtins.readFile ./eval-okay-readfile.nix\n"
diff --git a/test/testdata/eval-okay-readfile.nix b/test/testdata/eval-okay-readfile.nix
new file mode 100644
index 0000000..82f7cb1
--- /dev/null
+++ b/test/testdata/eval-okay-readfile.nix
@@ -0,0 +1 @@
builtins.readFile ./eval-okay-readfile.nix
diff --git a/test/testdata/eval-okay-redefine-builtin.exp b/test/testdata/eval-okay-redefine-builtin.exp
new file mode 100644
index 0000000..c508d53
--- /dev/null
+++ b/test/testdata/eval-okay-redefine-builtin.exp
@@ -0,0 +1 @@
false
diff --git a/test/testdata/eval-okay-redefine-builtin.nix b/test/testdata/eval-okay-redefine-builtin.nix
new file mode 100644
index 0000000..df9fc3f
--- /dev/null
+++ b/test/testdata/eval-okay-redefine-builtin.nix
@@ -0,0 +1,3 @@
1let
2 throw = abort "Error!";
3in (builtins.tryEval <foobaz>).success
diff --git a/test/testdata/eval-okay-regex-match.exp b/test/testdata/eval-okay-regex-match.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-regex-match.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-regex-match.nix b/test/testdata/eval-okay-regex-match.nix
new file mode 100644
index 0000000..273e259
--- /dev/null
+++ b/test/testdata/eval-okay-regex-match.nix
@@ -0,0 +1,29 @@
1with builtins;
2
3let
4
5 matches = pat: s: match pat s != null;
6
7 splitFN = match "((.*)/)?([^/]*)\\.(nix|cc)";
8
9in
10
11assert matches "foobar" "foobar";
12assert matches "fo*" "f";
13assert !matches "fo+" "f";
14assert matches "fo*" "fo";
15assert matches "fo*" "foo";
16assert matches "fo+" "foo";
17assert matches "fo{1,2}" "foo";
18assert !matches "fo{1,2}" "fooo";
19assert !matches "fo*" "foobar";
20assert matches "[[:space:]]+([^[:space:]]+)[[:space:]]+" " foo ";
21assert !matches "[[:space:]]+([[:upper:]]+)[[:space:]]+" " foo ";
22
23assert match "(.*)\\.nix" "foobar.nix" == [ "foobar" ];
24assert match "[[:space:]]+([[:upper:]]+)[[:space:]]+" " FOO " == [ "FOO" ];
25
26assert splitFN "/path/to/foobar.nix" == [ "/path/to/" "/path/to" "foobar" "nix" ];
27assert splitFN "foobar.cc" == [ null null "foobar" "cc" ];
28
29true
diff --git a/test/testdata/eval-okay-regex-split.exp b/test/testdata/eval-okay-regex-split.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-regex-split.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-regex-split.nix b/test/testdata/eval-okay-regex-split.nix
new file mode 100644
index 0000000..0073e05
--- /dev/null
+++ b/test/testdata/eval-okay-regex-split.nix
@@ -0,0 +1,48 @@
1with builtins;
2
3# Non capturing regex returns empty lists
4assert split "foobar" "foobar" == ["" [] ""];
5assert split "fo*" "f" == ["" [] ""];
6assert split "fo+" "f" == ["f"];
7assert split "fo*" "fo" == ["" [] ""];
8assert split "fo*" "foo" == ["" [] ""];
9assert split "fo+" "foo" == ["" [] ""];
10assert split "fo{1,2}" "foo" == ["" [] ""];
11assert split "fo{1,2}" "fooo" == ["" [] "o"];
12assert split "fo*" "foobar" == ["" [] "bar"];
13
14# Capturing regex returns a list of sub-matches
15assert split "(fo*)" "f" == ["" ["f"] ""];
16assert split "(fo+)" "f" == ["f"];
17assert split "(fo*)" "fo" == ["" ["fo"] ""];
18assert split "(f)(o*)" "f" == ["" ["f" ""] ""];
19assert split "(f)(o*)" "foo" == ["" ["f" "oo"] ""];
20assert split "(fo+)" "foo" == ["" ["foo"] ""];
21assert split "(fo{1,2})" "foo" == ["" ["foo"] ""];
22assert split "(fo{1,2})" "fooo" == ["" ["foo"] "o"];
23assert split "(fo*)" "foobar" == ["" ["foo"] "bar"];
24
25# Matches are greedy.
26assert split "(o+)" "oooofoooo" == ["" ["oooo"] "f" ["oooo"] ""];
27
28# Matches multiple times.
29assert split "(b)" "foobarbaz" == ["foo" ["b"] "ar" ["b"] "az"];
30
31# Split large strings containing newlines. null are inserted when a
32# pattern within the current did not match anything.
33assert split "[[:space:]]+|([',.!?])" ''
34 Nix Rocks!
35 That's why I use it.
36'' == [
37 "Nix" [ null ] "Rocks" ["!"] "" [ null ]
38 "That" ["'"] "s" [ null ] "why" [ null ] "I" [ null ] "use" [ null ] "it" ["."] "" [ null ]
39 ""
40];
41
42# Documentation examples
43assert split "(a)b" "abc" == [ "" [ "a" ] "c" ];
44assert split "([ac])" "abc" == [ "" [ "a" ] "b" [ "c" ] "" ];
45assert split "(a)|(c)" "abc" == [ "" [ "a" null ] "b" [ null "c" ] "" ];
46assert split "([[:upper:]]+)" " FOO " == [ " " [ "FOO" ] " " ];
47
48true
diff --git a/test/testdata/eval-okay-regression-20220122.exp b/test/testdata/eval-okay-regression-20220122.exp
new file mode 100644
index 0000000..00750ed
--- /dev/null
+++ b/test/testdata/eval-okay-regression-20220122.exp
@@ -0,0 +1 @@
3
diff --git a/test/testdata/eval-okay-regression-20220122.nix b/test/testdata/eval-okay-regression-20220122.nix
new file mode 100644
index 0000000..694e9a1
--- /dev/null
+++ b/test/testdata/eval-okay-regression-20220122.nix
@@ -0,0 +1 @@
((_: _) 1) + ((__: __) 2)
diff --git a/test/testdata/eval-okay-regression-20220125.exp b/test/testdata/eval-okay-regression-20220125.exp
new file mode 100644
index 0000000..00750ed
--- /dev/null
+++ b/test/testdata/eval-okay-regression-20220125.exp
@@ -0,0 +1 @@
3
diff --git a/test/testdata/eval-okay-regression-20220125.nix b/test/testdata/eval-okay-regression-20220125.nix
new file mode 100644
index 0000000..4855023
--- /dev/null
+++ b/test/testdata/eval-okay-regression-20220125.nix
@@ -0,0 +1,2 @@
1((__curPosFoo: __curPosFoo) 1) + ((__curPosBar: __curPosBar) 2)
2
diff --git a/test/testdata/eval-okay-remove.exp b/test/testdata/eval-okay-remove.exp
new file mode 100644
index 0000000..8d38505
--- /dev/null
+++ b/test/testdata/eval-okay-remove.exp
@@ -0,0 +1 @@
456
diff --git a/test/testdata/eval-okay-remove.nix b/test/testdata/eval-okay-remove.nix
new file mode 100644
index 0000000..4ad5ba8
--- /dev/null
+++ b/test/testdata/eval-okay-remove.nix
@@ -0,0 +1,5 @@
1let {
2 attrs = {x = 123; y = 456;};
3
4 body = (removeAttrs attrs ["x"]).y;
5} \ No newline at end of file
diff --git a/test/testdata/eval-okay-repeated-empty-attrs.exp b/test/testdata/eval-okay-repeated-empty-attrs.exp
new file mode 100644
index 0000000..d21e6db
--- /dev/null
+++ b/test/testdata/eval-okay-repeated-empty-attrs.exp
@@ -0,0 +1 @@
[ { } { } ]
diff --git a/test/testdata/eval-okay-repeated-empty-attrs.nix b/test/testdata/eval-okay-repeated-empty-attrs.nix
new file mode 100644
index 0000000..030a3b8
--- /dev/null
+++ b/test/testdata/eval-okay-repeated-empty-attrs.nix
@@ -0,0 +1,2 @@
1# Tests that empty attribute sets are not printed as `«repeated»`.
2[ {} {} ]
diff --git a/test/testdata/eval-okay-repeated-empty-list.exp b/test/testdata/eval-okay-repeated-empty-list.exp
new file mode 100644
index 0000000..701fc7e
--- /dev/null
+++ b/test/testdata/eval-okay-repeated-empty-list.exp
@@ -0,0 +1 @@
[ [ ] [ ] ]
diff --git a/test/testdata/eval-okay-repeated-empty-list.nix b/test/testdata/eval-okay-repeated-empty-list.nix
new file mode 100644
index 0000000..376c51b
--- /dev/null
+++ b/test/testdata/eval-okay-repeated-empty-list.nix
@@ -0,0 +1 @@
[ [] [] ]
diff --git a/test/testdata/eval-okay-replacestrings.exp b/test/testdata/eval-okay-replacestrings.exp
new file mode 100644
index 0000000..eac67c5
--- /dev/null
+++ b/test/testdata/eval-okay-replacestrings.exp
@@ -0,0 +1 @@
[ "faabar" "fbar" "fubar" "faboor" "fubar" "XaXbXcX" "X" "a_b" "fubar" ]
diff --git a/test/testdata/eval-okay-replacestrings.nix b/test/testdata/eval-okay-replacestrings.nix
new file mode 100644
index 0000000..a803e65
--- /dev/null
+++ b/test/testdata/eval-okay-replacestrings.nix
@@ -0,0 +1,12 @@
1with builtins;
2
3[ (replaceStrings ["o"] ["a"] "foobar")
4 (replaceStrings ["o"] [""] "foobar")
5 (replaceStrings ["oo"] ["u"] "foobar")
6 (replaceStrings ["oo" "a"] ["a" "oo"] "foobar")
7 (replaceStrings ["oo" "oo"] ["u" "i"] "foobar")
8 (replaceStrings [""] ["X"] "abc")
9 (replaceStrings [""] ["X"] "")
10 (replaceStrings ["-"] ["_"] "a-b")
11 (replaceStrings ["oo" "XX"] ["u" (throw "unreachable")] "foobar")
12]
diff --git a/test/testdata/eval-okay-scope-1.exp b/test/testdata/eval-okay-scope-1.exp
new file mode 100644
index 0000000..00750ed
--- /dev/null
+++ b/test/testdata/eval-okay-scope-1.exp
@@ -0,0 +1 @@
3
diff --git a/test/testdata/eval-okay-scope-1.nix b/test/testdata/eval-okay-scope-1.nix
new file mode 100644
index 0000000..fa38a71
--- /dev/null
+++ b/test/testdata/eval-okay-scope-1.nix
@@ -0,0 +1,6 @@
1(({x}: x:
2
3 { x = 1;
4 y = x;
5 }
6) {x = 2;} 3).y
diff --git a/test/testdata/eval-okay-scope-2.exp b/test/testdata/eval-okay-scope-2.exp
new file mode 100644
index 0000000..d00491f
--- /dev/null
+++ b/test/testdata/eval-okay-scope-2.exp
@@ -0,0 +1 @@
1
diff --git a/test/testdata/eval-okay-scope-2.nix b/test/testdata/eval-okay-scope-2.nix
new file mode 100644
index 0000000..eb8b02b
--- /dev/null
+++ b/test/testdata/eval-okay-scope-2.nix
@@ -0,0 +1,6 @@
1((x: {x}:
2 rec {
3 x = 1;
4 y = x;
5 }
6) 2 {x = 3;}).y
diff --git a/test/testdata/eval-okay-scope-3.exp b/test/testdata/eval-okay-scope-3.exp
new file mode 100644
index 0000000..b8626c4
--- /dev/null
+++ b/test/testdata/eval-okay-scope-3.exp
@@ -0,0 +1 @@
4
diff --git a/test/testdata/eval-okay-scope-3.nix b/test/testdata/eval-okay-scope-3.nix
new file mode 100644
index 0000000..10d6bc0
--- /dev/null
+++ b/test/testdata/eval-okay-scope-3.nix
@@ -0,0 +1,6 @@
1((x: as: {x}:
2 rec {
3 inherit (as) x;
4 y = x;
5 }
6) 2 {x = 4;} {x = 3;}).y
diff --git a/test/testdata/eval-okay-scope-4.exp b/test/testdata/eval-okay-scope-4.exp
new file mode 100644
index 0000000..00ff03a
--- /dev/null
+++ b/test/testdata/eval-okay-scope-4.exp
@@ -0,0 +1 @@
"ccdd"
diff --git a/test/testdata/eval-okay-scope-4.nix b/test/testdata/eval-okay-scope-4.nix
new file mode 100644
index 0000000..dc8243b
--- /dev/null
+++ b/test/testdata/eval-okay-scope-4.nix
@@ -0,0 +1,10 @@
1let {
2
3 x = "a";
4 y = "b";
5
6 f = {x ? y, y ? x}: x + y;
7
8 body = f {x = "c";} + f {y = "d";};
9
10}
diff --git a/test/testdata/eval-okay-scope-6.exp b/test/testdata/eval-okay-scope-6.exp
new file mode 100644
index 0000000..00ff03a
--- /dev/null
+++ b/test/testdata/eval-okay-scope-6.exp
@@ -0,0 +1 @@
"ccdd"
diff --git a/test/testdata/eval-okay-scope-6.nix b/test/testdata/eval-okay-scope-6.nix
new file mode 100644
index 0000000..0995d4e
--- /dev/null
+++ b/test/testdata/eval-okay-scope-6.nix
@@ -0,0 +1,7 @@
1let {
2
3 f = {x ? y, y ? x}: x + y;
4
5 body = f {x = "c";} + f {y = "d";};
6
7}
diff --git a/test/testdata/eval-okay-scope-7.exp b/test/testdata/eval-okay-scope-7.exp
new file mode 100644
index 0000000..d00491f
--- /dev/null
+++ b/test/testdata/eval-okay-scope-7.exp
@@ -0,0 +1 @@
1
diff --git a/test/testdata/eval-okay-scope-7.nix b/test/testdata/eval-okay-scope-7.nix
new file mode 100644
index 0000000..4da0296
--- /dev/null
+++ b/test/testdata/eval-okay-scope-7.nix
@@ -0,0 +1,6 @@
1rec {
2 inherit (x) y;
3 x = {
4 y = 1;
5 };
6}.y
diff --git a/test/testdata/eval-okay-search-path.exp b/test/testdata/eval-okay-search-path.exp
new file mode 100644
index 0000000..4519bc4
--- /dev/null
+++ b/test/testdata/eval-okay-search-path.exp
@@ -0,0 +1 @@
"abccX"
diff --git a/test/testdata/eval-okay-search-path.flags b/test/testdata/eval-okay-search-path.flags
new file mode 100644
index 0000000..dfad1c6
--- /dev/null
+++ b/test/testdata/eval-okay-search-path.flags
@@ -0,0 +1 @@
-I lang/dir1 -I lang/dir2 -I dir5=lang/dir3
diff --git a/test/testdata/eval-okay-search-path.nix b/test/testdata/eval-okay-search-path.nix
new file mode 100644
index 0000000..6fe33de
--- /dev/null
+++ b/test/testdata/eval-okay-search-path.nix
@@ -0,0 +1,10 @@
1with import ./lib.nix;
2with builtins;
3
4assert isFunction (import <nix/fetchurl.nix>);
5
6assert length __nixPath == 5;
7assert length (filter (x: baseNameOf x.path == "dir4") __nixPath) == 1;
8
9import <a.nix> + import <b.nix> + import <c.nix> + import <dir5/c.nix>
10 + (let __nixPath = [ { path = ./dir2; } { path = ./dir1; } ]; in import <a.nix>)
diff --git a/test/testdata/eval-okay-seq.exp b/test/testdata/eval-okay-seq.exp
new file mode 100644
index 0000000..0cfbf08
--- /dev/null
+++ b/test/testdata/eval-okay-seq.exp
@@ -0,0 +1 @@
2
diff --git a/test/testdata/eval-okay-seq.nix b/test/testdata/eval-okay-seq.nix
new file mode 100644
index 0000000..0a9a21c
--- /dev/null
+++ b/test/testdata/eval-okay-seq.nix
@@ -0,0 +1 @@
builtins.seq 1 2
diff --git a/test/testdata/eval-okay-sort.exp b/test/testdata/eval-okay-sort.exp
new file mode 100644
index 0000000..899119e
--- /dev/null
+++ b/test/testdata/eval-okay-sort.exp
@@ -0,0 +1 @@
[ [ 42 77 147 249 483 526 ] [ 526 483 249 147 77 42 ] [ "bar" "fnord" "foo" "xyzzy" ] [ { key = 1; value = "foo"; } { key = 1; value = "fnord"; } { key = 2; value = "bar"; } ] [ [ ] [ ] [ 1 ] [ 1 4 ] [ 1 5 ] [ 1 6 ] [ 2 ] [ 2 3 ] [ 3 ] [ 3 ] ] ]
diff --git a/test/testdata/eval-okay-sort.nix b/test/testdata/eval-okay-sort.nix
new file mode 100644
index 0000000..50aa78e
--- /dev/null
+++ b/test/testdata/eval-okay-sort.nix
@@ -0,0 +1,20 @@
1with builtins;
2
3[ (sort lessThan [ 483 249 526 147 42 77 ])
4 (sort (x: y: y < x) [ 483 249 526 147 42 77 ])
5 (sort lessThan [ "foo" "bar" "xyzzy" "fnord" ])
6 (sort (x: y: x.key < y.key)
7 [ { key = 1; value = "foo"; } { key = 2; value = "bar"; } { key = 1; value = "fnord"; } ])
8 (sort lessThan [
9 [ 1 6 ]
10 [ ]
11 [ 2 3 ]
12 [ 3 ]
13 [ 1 5 ]
14 [ 2 ]
15 [ 1 ]
16 [ ]
17 [ 1 4 ]
18 [ 3 ]
19 ])
20]
diff --git a/test/testdata/eval-okay-splitversion.exp b/test/testdata/eval-okay-splitversion.exp
new file mode 100644
index 0000000..153ceb8
--- /dev/null
+++ b/test/testdata/eval-okay-splitversion.exp
@@ -0,0 +1 @@
[ "1" "2" "3" ]
diff --git a/test/testdata/eval-okay-splitversion.nix b/test/testdata/eval-okay-splitversion.nix
new file mode 100644
index 0000000..9e5c99d
--- /dev/null
+++ b/test/testdata/eval-okay-splitversion.nix
@@ -0,0 +1 @@
builtins.splitVersion "1.2.3"
diff --git a/test/testdata/eval-okay-string.exp b/test/testdata/eval-okay-string.exp
new file mode 100644
index 0000000..63f650f
--- /dev/null
+++ b/test/testdata/eval-okay-string.exp
@@ -0,0 +1 @@
"foobar/a/b/c/d/foo/xyzzy/foo.txt/../foo/x/yescape: \"quote\" \n \\end\nof\nlinefoobarblaatfoo$bar$\"$\"$"
diff --git a/test/testdata/eval-okay-string.nix b/test/testdata/eval-okay-string.nix
new file mode 100644
index 0000000..47cc989
--- /dev/null
+++ b/test/testdata/eval-okay-string.nix
@@ -0,0 +1,12 @@
1"foo" + "bar"
2 + toString (/a/b + /c/d)
3 + toString (/foo/bar + "/../xyzzy/." + "/foo.txt")
4 + ("/../foo" + toString /x/y)
5 + "escape: \"quote\" \n \\"
6 + "end
7of
8line"
9 + "foo${if true then "b${"a" + "r"}" else "xyzzy"}blaat"
10 + "foo$bar"
11 + "$\"$\""
12 + "$"
diff --git a/test/testdata/eval-okay-strings-as-attrs-names.exp b/test/testdata/eval-okay-strings-as-attrs-names.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-strings-as-attrs-names.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-strings-as-attrs-names.nix b/test/testdata/eval-okay-strings-as-attrs-names.nix
new file mode 100644
index 0000000..5e40928
--- /dev/null
+++ b/test/testdata/eval-okay-strings-as-attrs-names.nix
@@ -0,0 +1,20 @@
1let
2
3 attr = {
4 "key 1" = "test";
5 "key 2" = "caseok";
6 };
7
8 t1 = builtins.getAttr "key 1" attr;
9 t2 = attr."key 2";
10 t3 = attr ? "key 1";
11 t4 = builtins.attrNames { inherit (attr) "key 1"; };
12
13 # This is permitted, but there is currently no way to reference this
14 # variable.
15 "foo bar" = 1;
16
17in t1 == "test"
18 && t2 == "caseok"
19 && t3 == true
20 && t4 == ["key 1"]
diff --git a/test/testdata/eval-okay-substring-context.exp b/test/testdata/eval-okay-substring-context.exp
new file mode 100644
index 0000000..2fe7f71
--- /dev/null
+++ b/test/testdata/eval-okay-substring-context.exp
@@ -0,0 +1 @@
"okay"
diff --git a/test/testdata/eval-okay-substring-context.nix b/test/testdata/eval-okay-substring-context.nix
new file mode 100644
index 0000000..d0ef70d
--- /dev/null
+++ b/test/testdata/eval-okay-substring-context.nix
@@ -0,0 +1,11 @@
1with builtins;
2
3let
4
5 s = "${builtins.derivation { name = "test"; builder = "/bin/sh"; system = "x86_64-linux"; }}";
6
7in
8
9if getContext s == getContext "${substring 0 0 s + unsafeDiscardStringContext s}"
10then "okay"
11else throw "empty substring should preserve context"
diff --git a/test/testdata/eval-okay-substring.exp b/test/testdata/eval-okay-substring.exp
new file mode 100644
index 0000000..f48b462
--- /dev/null
+++ b/test/testdata/eval-okay-substring.exp
@@ -0,0 +1 @@
"ooxfoobarybarzobaabbc_bad"
diff --git a/test/testdata/eval-okay-substring.nix b/test/testdata/eval-okay-substring.nix
new file mode 100644
index 0000000..54c97e1
--- /dev/null
+++ b/test/testdata/eval-okay-substring.nix
@@ -0,0 +1,23 @@
1with builtins;
2
3let
4
5 s = "foobar";
6
7in
8
9substring 1 2 s
10+ "x"
11+ substring 0 (stringLength s) s
12+ "y"
13+ substring 3 100 s
14+ "z"
15+ substring 2 (sub (stringLength s) 3) s
16+ "a"
17+ substring 3 0 s
18+ "b"
19+ substring 3 1 s
20+ "c"
21+ substring 5 10 "perl"
22+ "_"
23+ substring 3 (-1) "tebbad"
diff --git a/test/testdata/eval-okay-symlink-resolution.exp b/test/testdata/eval-okay-symlink-resolution.exp
new file mode 100644
index 0000000..8b8441b
--- /dev/null
+++ b/test/testdata/eval-okay-symlink-resolution.exp
@@ -0,0 +1 @@
"test"
diff --git a/test/testdata/eval-okay-symlink-resolution.nix b/test/testdata/eval-okay-symlink-resolution.nix
new file mode 100644
index 0000000..ffb1818
--- /dev/null
+++ b/test/testdata/eval-okay-symlink-resolution.nix
@@ -0,0 +1 @@
import symlink-resolution/foo/overlays/overlay.nix
diff --git a/test/testdata/eval-okay-tail-call-1.exp-disabled b/test/testdata/eval-okay-tail-call-1.exp-disabled
new file mode 100644
index 0000000..f7393e8
--- /dev/null
+++ b/test/testdata/eval-okay-tail-call-1.exp-disabled
@@ -0,0 +1 @@
100000
diff --git a/test/testdata/eval-okay-tail-call-1.nix b/test/testdata/eval-okay-tail-call-1.nix
new file mode 100644
index 0000000..a3962ce
--- /dev/null
+++ b/test/testdata/eval-okay-tail-call-1.nix
@@ -0,0 +1,3 @@
1let
2 f = n: if n == 100000 then n else f (n + 1);
3in f 0
diff --git a/test/testdata/eval-okay-tojson.exp b/test/testdata/eval-okay-tojson.exp
new file mode 100644
index 0000000..e92aae3
--- /dev/null
+++ b/test/testdata/eval-okay-tojson.exp
@@ -0,0 +1 @@
"{\"a\":123,\"b\":-456,\"c\":\"foo\",\"d\":\"foo\\n\\\"bar\\\"\",\"e\":true,\"f\":false,\"g\":[1,2,3],\"h\":[\"a\",[\"b\",{\"foo\\nbar\":{}}]],\"i\":3,\"j\":1.44,\"k\":\"foo\"}"
diff --git a/test/testdata/eval-okay-tojson.nix b/test/testdata/eval-okay-tojson.nix
new file mode 100644
index 0000000..ce67943
--- /dev/null
+++ b/test/testdata/eval-okay-tojson.nix
@@ -0,0 +1,13 @@
1builtins.toJSON
2 { a = 123;
3 b = -456;
4 c = "foo";
5 d = "foo\n\"bar\"";
6 e = true;
7 f = false;
8 g = [ 1 2 3 ];
9 h = [ "a" [ "b" { "foo\nbar" = {}; } ] ];
10 i = 1 + 2;
11 j = 1.44;
12 k = { __toString = self: self.a; a = "foo"; };
13 }
diff --git a/test/testdata/eval-okay-toxml.exp b/test/testdata/eval-okay-toxml.exp
new file mode 100644
index 0000000..8282208
--- /dev/null
+++ b/test/testdata/eval-okay-toxml.exp
@@ -0,0 +1 @@
"<?xml version='1.0' encoding='utf-8'?>\n<expr>\n <attrs>\n <attr name=\"a\">\n <string value=\"s\" />\n </attr>\n </attrs>\n</expr>\n"
diff --git a/test/testdata/eval-okay-toxml.nix b/test/testdata/eval-okay-toxml.nix
new file mode 100644
index 0000000..068c97a
--- /dev/null
+++ b/test/testdata/eval-okay-toxml.nix
@@ -0,0 +1,3 @@
1# Make sure the expected XML output is produced; in particular, make sure it
2# doesn't contain source location information.
3builtins.toXML { a = "s"; }
diff --git a/test/testdata/eval-okay-toxml2.exp b/test/testdata/eval-okay-toxml2.exp
new file mode 100644
index 0000000..634a841
--- /dev/null
+++ b/test/testdata/eval-okay-toxml2.exp
@@ -0,0 +1 @@
"<?xml version='1.0' encoding='utf-8'?>\n<expr>\n <list>\n <string value=\"ab\" />\n <int value=\"10\" />\n <attrs>\n <attr name=\"x\">\n <string value=\"x\" />\n </attr>\n <attr name=\"y\">\n <string value=\"x\" />\n </attr>\n </attrs>\n </list>\n</expr>\n"
diff --git a/test/testdata/eval-okay-toxml2.nix b/test/testdata/eval-okay-toxml2.nix
new file mode 100644
index 0000000..ff1791b
--- /dev/null
+++ b/test/testdata/eval-okay-toxml2.nix
@@ -0,0 +1 @@
builtins.toXML [("a" + "b") 10 (rec {x = "x"; y = x;})]
diff --git a/test/testdata/eval-okay-tryeval.exp b/test/testdata/eval-okay-tryeval.exp
new file mode 100644
index 0000000..2b2e6fa
--- /dev/null
+++ b/test/testdata/eval-okay-tryeval.exp
@@ -0,0 +1 @@
{ x = { success = true; value = "x"; }; y = { success = false; value = false; }; z = { success = false; value = false; }; }
diff --git a/test/testdata/eval-okay-tryeval.nix b/test/testdata/eval-okay-tryeval.nix
new file mode 100644
index 0000000..629bc44
--- /dev/null
+++ b/test/testdata/eval-okay-tryeval.nix
@@ -0,0 +1,5 @@
1{
2 x = builtins.tryEval "x";
3 y = builtins.tryEval (assert false; "y");
4 z = builtins.tryEval (throw "bla");
5}
diff --git a/test/testdata/eval-okay-types.exp b/test/testdata/eval-okay-types.exp
new file mode 100644
index 0000000..92a1532
--- /dev/null
+++ b/test/testdata/eval-okay-types.exp
@@ -0,0 +1 @@
[ true false true false true false true false true true true true true true true true true true true false true true true false "int" "bool" "string" "null" "set" "list" "lambda" "lambda" "lambda" "lambda" ]
diff --git a/test/testdata/eval-okay-types.nix b/test/testdata/eval-okay-types.nix
new file mode 100644
index 0000000..9b58be5
--- /dev/null
+++ b/test/testdata/eval-okay-types.nix
@@ -0,0 +1,37 @@
1with builtins;
2
3[ (isNull null)
4 (isNull (x: x))
5 (isFunction (x: x))
6 (isFunction "fnord")
7 (isString ("foo" + "bar"))
8 (isString [ "x" ])
9 (isInt (1 + 2))
10 (isInt { x = 123; })
11 (isInt (1 / 2))
12 (isInt (1 + 1))
13 (isInt (1 / 2))
14 (isInt (1 * 2))
15 (isInt (1 - 2))
16 (isFloat (1.2))
17 (isFloat (1 + 1.0))
18 (isFloat (1 / 2.0))
19 (isFloat (1 * 2.0))
20 (isFloat (1 - 2.0))
21 (isBool (true && false))
22 (isBool null)
23 (isPath /nix/store)
24 (isPath ./.)
25 (isAttrs { x = 123; })
26 (isAttrs null)
27 (typeOf (3 * 4))
28 (typeOf true)
29 (typeOf "xyzzy")
30 (typeOf null)
31 (typeOf { x = 456; })
32 (typeOf [ 1 2 3 ])
33 (typeOf (x: x))
34 (typeOf ((x: y: x) 1))
35 (typeOf map)
36 (typeOf (map (x: x)))
37]
diff --git a/test/testdata/eval-okay-versions.exp b/test/testdata/eval-okay-versions.exp
new file mode 100644
index 0000000..27ba77d
--- /dev/null
+++ b/test/testdata/eval-okay-versions.exp
@@ -0,0 +1 @@
true
diff --git a/test/testdata/eval-okay-versions.nix b/test/testdata/eval-okay-versions.nix
new file mode 100644
index 0000000..e9111f5
--- /dev/null
+++ b/test/testdata/eval-okay-versions.nix
@@ -0,0 +1,43 @@
1let
2
3 name1 = "hello-1.0.2";
4 name2 = "hello";
5 name3 = "915resolution-0.5.2";
6 name4 = "xf86-video-i810-1.7.4";
7 name5 = "name-that-ends-with-dash--1.0";
8
9 eq = 0;
10 lt = builtins.sub 0 1;
11 gt = 1;
12
13 versionTest = v1: v2: expected:
14 let d1 = builtins.compareVersions v1 v2;
15 d2 = builtins.compareVersions v2 v1;
16 in d1 == builtins.sub 0 d2 && d1 == expected;
17
18 tests = [
19 ((builtins.parseDrvName name1).name == "hello")
20 ((builtins.parseDrvName name1).version == "1.0.2")
21 ((builtins.parseDrvName name2).name == "hello")
22 ((builtins.parseDrvName name2).version == "")
23 ((builtins.parseDrvName name3).name == "915resolution")
24 ((builtins.parseDrvName name3).version == "0.5.2")
25 ((builtins.parseDrvName name4).name == "xf86-video-i810")
26 ((builtins.parseDrvName name4).version == "1.7.4")
27 ((builtins.parseDrvName name5).name == "name-that-ends-with-dash")
28 ((builtins.parseDrvName name5).version == "-1.0")
29 (versionTest "1.0" "2.3" lt)
30 (versionTest "2.1" "2.3" lt)
31 (versionTest "2.3" "2.3" eq)
32 (versionTest "2.5" "2.3" gt)
33 (versionTest "3.1" "2.3" gt)
34 (versionTest "2.3.1" "2.3" gt)
35 (versionTest "2.3.1" "2.3a" gt)
36 (versionTest "2.3pre1" "2.3" lt)
37 (versionTest "2.3pre3" "2.3pre12" lt)
38 (versionTest "2.3a" "2.3c" lt)
39 (versionTest "2.3pre1" "2.3c" lt)
40 (versionTest "2.3pre1" "2.3q" lt)
41 ];
42
43in (import ./lib.nix).and tests
diff --git a/test/testdata/eval-okay-with.exp b/test/testdata/eval-okay-with.exp
new file mode 100644
index 0000000..378c8dc
--- /dev/null
+++ b/test/testdata/eval-okay-with.exp
@@ -0,0 +1 @@
"xyzzybarxyzzybar"
diff --git a/test/testdata/eval-okay-with.nix b/test/testdata/eval-okay-with.nix
new file mode 100644
index 0000000..033e8d3
--- /dev/null
+++ b/test/testdata/eval-okay-with.nix
@@ -0,0 +1,19 @@
1let {
2
3 a = "xyzzy";
4
5 as = {
6 a = "foo";
7 b = "bar";
8 };
9
10 bs = {
11 a = "bar";
12 };
13
14 x = with as; a + b;
15
16 y = with as; with bs; a + b;
17
18 body = x + y;
19}
diff --git a/test/testdata/eval-okay-xml.exp.xml b/test/testdata/eval-okay-xml.exp.xml
new file mode 100644
index 0000000..2009932
--- /dev/null
+++ b/test/testdata/eval-okay-xml.exp.xml
@@ -0,0 +1,52 @@
1<?xml version='1.0' encoding='utf-8'?>
2<expr>
3 <attrs>
4 <attr name="a">
5 <string value="foo" />
6 </attr>
7 <attr name="at">
8 <function>
9 <attrspat name="args">
10 <attr name="x" />
11 <attr name="y" />
12 <attr name="z" />
13 </attrspat>
14 </function>
15 </attr>
16 <attr name="b">
17 <string value="bar" />
18 </attr>
19 <attr name="c">
20 <string value="foobar" />
21 </attr>
22 <attr name="ellipsis">
23 <function>
24 <attrspat ellipsis="1">
25 <attr name="x" />
26 <attr name="y" />
27 <attr name="z" />
28 </attrspat>
29 </function>
30 </attr>
31 <attr name="f">
32 <function>
33 <attrspat>
34 <attr name="x" />
35 <attr name="y" />
36 <attr name="z" />
37 </attrspat>
38 </function>
39 </attr>
40 <attr name="id">
41 <function>
42 <varpat name="x" />
43 </function>
44 </attr>
45 <attr name="x">
46 <int value="123" />
47 </attr>
48 <attr name="y">
49 <float value="567.89" />
50 </attr>
51 </attrs>
52</expr>
diff --git a/test/testdata/eval-okay-xml.nix b/test/testdata/eval-okay-xml.nix
new file mode 100644
index 0000000..9ee9f8a
--- /dev/null
+++ b/test/testdata/eval-okay-xml.nix
@@ -0,0 +1,21 @@
1rec {
2
3 x = 123;
4
5 y = 567.890;
6
7 a = "foo";
8
9 b = "bar";
10
11 c = "foo" + "bar";
12
13 f = {z, x, y}: if y then x else z;
14
15 id = x: x;
16
17 at = args@{x, y, z}: x;
18
19 ellipsis = {x, y, z, ...}: x;
20
21}
diff --git a/test/testdata/eval-okay-zipAttrsWith.exp b/test/testdata/eval-okay-zipAttrsWith.exp
new file mode 100644
index 0000000..9c0b15d
--- /dev/null
+++ b/test/testdata/eval-okay-zipAttrsWith.exp
@@ -0,0 +1 @@
{ "0" = { n = "0"; v = [ 5 23 29 ]; }; "1" = { n = "1"; v = [ 7 30 ]; }; "2" = { n = "2"; v = [ 18 ]; }; "4" = { n = "4"; v = [ 10 ]; }; "5" = { n = "5"; v = [ 15 25 26 31 ]; }; "6" = { n = "6"; v = [ 3 14 ]; }; "7" = { n = "7"; v = [ 12 ]; }; "8" = { n = "8"; v = [ 2 6 8 9 ]; }; "9" = { n = "9"; v = [ 0 16 ]; }; a = { n = "a"; v = [ 17 21 22 27 ]; }; c = { n = "c"; v = [ 11 24 ]; }; d = { n = "d"; v = [ 4 13 28 ]; }; e = { n = "e"; v = [ 20 ]; }; f = { n = "f"; v = [ 1 19 ]; }; }
diff --git a/test/testdata/eval-okay-zipAttrsWith.nix b/test/testdata/eval-okay-zipAttrsWith.nix
new file mode 100644
index 0000000..877d4e5
--- /dev/null
+++ b/test/testdata/eval-okay-zipAttrsWith.nix
@@ -0,0 +1,9 @@
1with import ./lib.nix;
2
3let
4 str = builtins.hashString "sha256" "test";
5in
6builtins.zipAttrsWith
7 (n: v: { inherit n v; })
8 (map (n: { ${builtins.substring n 1 str} = n; })
9 (range 0 31))
diff --git a/test/testdata/importdef.sexp b/test/testdata/importdef.sexp
new file mode 100644
index 0000000..bf8debb
--- /dev/null
+++ b/test/testdata/importdef.sexp
@@ -0,0 +1 @@
(deps ./lib.nix)
diff --git a/test/testdata/imported.nix b/test/testdata/imported.nix
new file mode 100644
index 0000000..fb39ee4
--- /dev/null
+++ b/test/testdata/imported.nix
@@ -0,0 +1,3 @@
1# The function ‘range’ comes from lib.nix and was added to the lexical
2# scope by scopedImport.
3range 1 5 ++ import ./imported2.nix
diff --git a/test/testdata/imported2.nix b/test/testdata/imported2.nix
new file mode 100644
index 0000000..6d0a299
--- /dev/null
+++ b/test/testdata/imported2.nix
@@ -0,0 +1 @@
range 6 10
diff --git a/test/testdata/lib.nix b/test/testdata/lib.nix
new file mode 100644
index 0000000..028a538
--- /dev/null
+++ b/test/testdata/lib.nix
@@ -0,0 +1,61 @@
1with builtins;
2
3rec {
4
5 fold = op: nul: list:
6 if list == []
7 then nul
8 else op (head list) (fold op nul (tail list));
9
10 concat =
11 fold (x: y: x + y) "";
12
13 and = fold (x: y: x && y) true;
14
15 flatten = x:
16 if isList x
17 then fold (x: y: (flatten x) ++ y) [] x
18 else [x];
19
20 sum = foldl' (x: y: add x y) 0;
21
22 hasSuffix = ext: fileName:
23 let lenFileName = stringLength fileName;
24 lenExt = stringLength ext;
25 in !(lessThan lenFileName lenExt) &&
26 substring (sub lenFileName lenExt) lenFileName fileName == ext;
27
28 # Split a list at the given position.
29 splitAt = pos: list:
30 if pos == 0 then {first = []; second = list;} else
31 if list == [] then {first = []; second = [];} else
32 let res = splitAt (sub pos 1) (tail list);
33 in {first = [(head list)] ++ res.first; second = res.second;};
34
35 # Stable merge sort.
36 sortBy = comp: list:
37 if lessThan 1 (length list)
38 then
39 let
40 split = splitAt (div (length list) 2) list;
41 first = sortBy comp split.first;
42 second = sortBy comp split.second;
43 in mergeLists comp first second
44 else list;
45
46 mergeLists = comp: list1: list2:
47 if list1 == [] then list2 else
48 if list2 == [] then list1 else
49 if comp (head list2) (head list1) then [(head list2)] ++ mergeLists comp list1 (tail list2) else
50 [(head list1)] ++ mergeLists comp (tail list1) list2;
51
52 id = x: x;
53
54 const = x: y: x;
55
56 range = first: last:
57 if first > last
58 then []
59 else genList (n: first + n) (last - first + 1);
60
61}
diff --git a/test/testdata/non-eval-fail-bad-drvPath.nix b/test/testdata/non-eval-fail-bad-drvPath.nix
new file mode 100644
index 0000000..23639bc
--- /dev/null
+++ b/test/testdata/non-eval-fail-bad-drvPath.nix
@@ -0,0 +1,14 @@
1let
2 package = {
3 type = "derivation";
4 name = "cachix-1.7.3";
5 system = builtins.currentSystem;
6 outputs = [ "out" ];
7 # Illegal, because does not end in `.drv`
8 drvPath = "${builtins.storeDir}/8qlfcic10lw5304gqm8q45nr7g7jl62b-cachix-1.7.3-bin";
9 outputName = "out";
10 outPath = "${builtins.storeDir}/8qlfcic10lw5304gqm8q45nr7g7jl62b-cachix-1.7.3-bin";
11 out = package;
12 };
13in
14package
diff --git a/test/testdata/parse-fail-dup-attrs-1.err.exp b/test/testdata/parse-fail-dup-attrs-1.err.exp
new file mode 100644
index 0000000..ffb5198
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-1.err.exp
@@ -0,0 +1,6 @@
1error: attribute 'x' already defined at «stdin»:1:3
2 at «stdin»:3:3:
3 2| y = 456;
4 3| x = 789;
5 | ^
6 4| }
diff --git a/test/testdata/parse-fail-dup-attrs-1.nix b/test/testdata/parse-fail-dup-attrs-1.nix
new file mode 100644
index 0000000..2c02317
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-1.nix
@@ -0,0 +1,4 @@
1{ x = 123;
2 y = 456;
3 x = 789;
4}
diff --git a/test/testdata/parse-fail-dup-attrs-2.err.exp b/test/testdata/parse-fail-dup-attrs-2.err.exp
new file mode 100644
index 0000000..3105e60
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-2.err.exp
@@ -0,0 +1,6 @@
1error: attribute 'x' already defined at «stdin»:9:5
2 at «stdin»:10:18:
3 9| x = 789;
4 10| inherit (as) x;
5 | ^
6 11| };
diff --git a/test/testdata/parse-fail-dup-attrs-2.nix b/test/testdata/parse-fail-dup-attrs-2.nix
new file mode 100644
index 0000000..864d986
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-2.nix
@@ -0,0 +1,13 @@
1let {
2
3 as = {
4 x = 123;
5 y = 456;
6 };
7
8 bs = {
9 x = 789;
10 inherit (as) x;
11 };
12
13}
diff --git a/test/testdata/parse-fail-dup-attrs-3.err.exp b/test/testdata/parse-fail-dup-attrs-3.err.exp
new file mode 100644
index 0000000..3105e60
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-3.err.exp
@@ -0,0 +1,6 @@
1error: attribute 'x' already defined at «stdin»:9:5
2 at «stdin»:10:18:
3 9| x = 789;
4 10| inherit (as) x;
5 | ^
6 11| };
diff --git a/test/testdata/parse-fail-dup-attrs-3.nix b/test/testdata/parse-fail-dup-attrs-3.nix
new file mode 100644
index 0000000..114d197
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-3.nix
@@ -0,0 +1,13 @@
1let {
2
3 as = {
4 x = 123;
5 y = 456;
6 };
7
8 bs = rec {
9 x = 789;
10 inherit (as) x;
11 };
12
13}
diff --git a/test/testdata/parse-fail-dup-attrs-4.err.exp b/test/testdata/parse-fail-dup-attrs-4.err.exp
new file mode 100644
index 0000000..c98a8f8
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-4.err.exp
@@ -0,0 +1,6 @@
1error: attribute 'services.ssh.port' already defined at «stdin»:2:3
2 at «stdin»:3:3:
3 2| services.ssh.port = 22;
4 3| services.ssh.port = 23;
5 | ^
6 4| }
diff --git a/test/testdata/parse-fail-dup-attrs-4.nix b/test/testdata/parse-fail-dup-attrs-4.nix
new file mode 100644
index 0000000..7741743
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-4.nix
@@ -0,0 +1,4 @@
1{
2 services.ssh.port = 22;
3 services.ssh.port = 23;
4}
diff --git a/test/testdata/parse-fail-dup-attrs-7.err.exp b/test/testdata/parse-fail-dup-attrs-7.err.exp
new file mode 100644
index 0000000..4e0a48e
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-7.err.exp
@@ -0,0 +1,6 @@
1error: attribute 'x' already defined at «stdin»:6:13
2 at «stdin»:7:13:
3 6| inherit x;
4 7| inherit x;
5 | ^
6 8| };
diff --git a/test/testdata/parse-fail-dup-attrs-7.nix b/test/testdata/parse-fail-dup-attrs-7.nix
new file mode 100644
index 0000000..bbc3eb0
--- /dev/null
+++ b/test/testdata/parse-fail-dup-attrs-7.nix
@@ -0,0 +1,9 @@
1rec {
2
3 x = 1;
4
5 as = {
6 inherit x;
7 inherit x;
8 };
9} \ No newline at end of file
diff --git a/test/testdata/parse-fail-dup-formals.err.exp b/test/testdata/parse-fail-dup-formals.err.exp
new file mode 100644
index 0000000..d7c7e02
--- /dev/null
+++ b/test/testdata/parse-fail-dup-formals.err.exp
@@ -0,0 +1,4 @@
1error: duplicate formal function argument 'x'
2 at «stdin»:1:8:
3 1| {x, y, x}: x
4 | ^
diff --git a/test/testdata/parse-fail-dup-formals.nix b/test/testdata/parse-fail-dup-formals.nix
new file mode 100644
index 0000000..a0edd91
--- /dev/null
+++ b/test/testdata/parse-fail-dup-formals.nix
@@ -0,0 +1 @@
{x, y, x}: x \ No newline at end of file
diff --git a/test/testdata/parse-fail-eof-in-string.err.exp b/test/testdata/parse-fail-eof-in-string.err.exp
new file mode 100644
index 0000000..17f34b6
--- /dev/null
+++ b/test/testdata/parse-fail-eof-in-string.err.exp
@@ -0,0 +1,5 @@
1error: syntax error, unexpected end of file, expecting '"'
2 at «stdin»:3:6:
3 2| # Note that this file must not end with a newline.
4 3| a 1"$
5 | ^
diff --git a/test/testdata/parse-fail-eof-in-string.nix b/test/testdata/parse-fail-eof-in-string.nix
new file mode 100644
index 0000000..19775d2
--- /dev/null
+++ b/test/testdata/parse-fail-eof-in-string.nix
@@ -0,0 +1,3 @@
1# https://github.com/NixOS/nix/issues/6562
2# Note that this file must not end with a newline.
3a 1"$ \ No newline at end of file
diff --git a/test/testdata/parse-fail-eof-pos.err.exp b/test/testdata/parse-fail-eof-pos.err.exp
new file mode 100644
index 0000000..ef9ca38
--- /dev/null
+++ b/test/testdata/parse-fail-eof-pos.err.exp
@@ -0,0 +1,5 @@
1error: syntax error, unexpected end of file
2 at «stdin»:3:1:
3 2| # no content
4 3|
5 | ^
diff --git a/test/testdata/parse-fail-eof-pos.nix b/test/testdata/parse-fail-eof-pos.nix
new file mode 100644
index 0000000..bd66a2c
--- /dev/null
+++ b/test/testdata/parse-fail-eof-pos.nix
@@ -0,0 +1,2 @@
1(
2# no content
diff --git a/test/testdata/parse-fail-mixed-nested-attrs1.err.exp b/test/testdata/parse-fail-mixed-nested-attrs1.err.exp
new file mode 100644
index 0000000..a447215
--- /dev/null
+++ b/test/testdata/parse-fail-mixed-nested-attrs1.err.exp
@@ -0,0 +1,6 @@
1error: attribute 'z' already defined at «stdin»:3:16
2 at «stdin»:2:3:
3 1| {
4 2| x.z = 3;
5 | ^
6 3| x = { y = 3; z = 3; };
diff --git a/test/testdata/parse-fail-mixed-nested-attrs1.nix b/test/testdata/parse-fail-mixed-nested-attrs1.nix
new file mode 100644
index 0000000..11e40e6
--- /dev/null
+++ b/test/testdata/parse-fail-mixed-nested-attrs1.nix
@@ -0,0 +1,4 @@
1{
2 x.z = 3;
3 x = { y = 3; z = 3; };
4}
diff --git a/test/testdata/parse-fail-mixed-nested-attrs2.err.exp b/test/testdata/parse-fail-mixed-nested-attrs2.err.exp
new file mode 100644
index 0000000..ead1f0d
--- /dev/null
+++ b/test/testdata/parse-fail-mixed-nested-attrs2.err.exp
@@ -0,0 +1,6 @@
1error: attribute 'y' already defined at «stdin»:3:9
2 at «stdin»:2:3:
3 1| {
4 2| x.y.y = 3;
5 | ^
6 3| x = { y.y= 3; z = 3; };
diff --git a/test/testdata/parse-fail-mixed-nested-attrs2.nix b/test/testdata/parse-fail-mixed-nested-attrs2.nix
new file mode 100644
index 0000000..17da82e
--- /dev/null
+++ b/test/testdata/parse-fail-mixed-nested-attrs2.nix
@@ -0,0 +1,4 @@
1{
2 x.y.y = 3;
3 x = { y.y= 3; z = 3; };
4}
diff --git a/test/testdata/parse-fail-patterns-1.err.exp b/test/testdata/parse-fail-patterns-1.err.exp
new file mode 100644
index 0000000..6ba39d8
--- /dev/null
+++ b/test/testdata/parse-fail-patterns-1.err.exp
@@ -0,0 +1,5 @@
1error: duplicate formal function argument 'args'
2 at «stdin»:1:1:
3 1| args@{args, x, y, z}: x
4 | ^
5 2|
diff --git a/test/testdata/parse-fail-patterns-1.nix b/test/testdata/parse-fail-patterns-1.nix
new file mode 100644
index 0000000..7b40616
--- /dev/null
+++ b/test/testdata/parse-fail-patterns-1.nix
@@ -0,0 +1 @@
args@{args, x, y, z}: x
diff --git a/test/testdata/parse-fail-regression-20060610.err.exp b/test/testdata/parse-fail-regression-20060610.err.exp
new file mode 100644
index 0000000..6ae7c01
--- /dev/null
+++ b/test/testdata/parse-fail-regression-20060610.err.exp
@@ -0,0 +1,6 @@
1error: undefined variable 'gcc'
2 at «stdin»:9:13:
3 8| body = ({
4 9| inherit gcc;
5 | ^
6 10| }).gcc;
diff --git a/test/testdata/parse-fail-regression-20060610.nix b/test/testdata/parse-fail-regression-20060610.nix
new file mode 100644
index 0000000..b1934f7
--- /dev/null
+++ b/test/testdata/parse-fail-regression-20060610.nix
@@ -0,0 +1,11 @@
1let {
2 x =
3 {gcc}:
4 {
5 inherit gcc;
6 };
7
8 body = ({
9 inherit gcc;
10 }).gcc;
11}
diff --git a/test/testdata/parse-fail-undef-var-2.err.exp b/test/testdata/parse-fail-undef-var-2.err.exp
new file mode 100644
index 0000000..96e87b2
--- /dev/null
+++ b/test/testdata/parse-fail-undef-var-2.err.exp
@@ -0,0 +1,6 @@
1error: syntax error, unexpected ':', expecting '}' or ','
2 at «stdin»:3:13:
3 2|
4 3| f = {x, y : ["baz" "bar" z "bat"]}: x + y;
5 | ^
6 4|
diff --git a/test/testdata/parse-fail-undef-var-2.nix b/test/testdata/parse-fail-undef-var-2.nix
new file mode 100644
index 0000000..c10a52b
--- /dev/null
+++ b/test/testdata/parse-fail-undef-var-2.nix
@@ -0,0 +1,7 @@
1let {
2
3 f = {x, y : ["baz" "bar" z "bat"]}: x + y;
4
5 body = f {x = "foo"; y = "bar";};
6
7}
diff --git a/test/testdata/parse-fail-undef-var.err.exp b/test/testdata/parse-fail-undef-var.err.exp
new file mode 100644
index 0000000..3d143d9
--- /dev/null
+++ b/test/testdata/parse-fail-undef-var.err.exp
@@ -0,0 +1,5 @@
1error: undefined variable 'y'
2 at «stdin»:1:4:
3 1| x: y
4 | ^
5 2|
diff --git a/test/testdata/parse-fail-undef-var.nix b/test/testdata/parse-fail-undef-var.nix
new file mode 100644
index 0000000..7b63008
--- /dev/null
+++ b/test/testdata/parse-fail-undef-var.nix
@@ -0,0 +1 @@
x: y
diff --git a/test/testdata/parse-fail-utf8.err.exp b/test/testdata/parse-fail-utf8.err.exp
new file mode 100644
index 0000000..1c83f6e
--- /dev/null
+++ b/test/testdata/parse-fail-utf8.err.exp
@@ -0,0 +1,5 @@
1error: syntax error, unexpected invalid token, expecting end of file
2 at «stdin»:1:5:
3 1| 123 é 4
4 | ^
5 2|
diff --git a/test/testdata/parse-fail-utf8.nix b/test/testdata/parse-fail-utf8.nix
new file mode 100644
index 0000000..34948d4
--- /dev/null
+++ b/test/testdata/parse-fail-utf8.nix
@@ -0,0 +1 @@
123 é 4
diff --git a/test/testdata/parse-okay-1.exp b/test/testdata/parse-okay-1.exp
new file mode 100644
index 0000000..d5ab5f1
--- /dev/null
+++ b/test/testdata/parse-okay-1.exp
@@ -0,0 +1 @@
({ x, y, z }: ((x + y) + z))
diff --git a/test/testdata/parse-okay-1.nix b/test/testdata/parse-okay-1.nix
new file mode 100644
index 0000000..23a58ed
--- /dev/null
+++ b/test/testdata/parse-okay-1.nix
@@ -0,0 +1 @@
{x, y, z}: x + y + z
diff --git a/test/testdata/parse-okay-crlf.exp b/test/testdata/parse-okay-crlf.exp
new file mode 100644
index 0000000..4213609
--- /dev/null
+++ b/test/testdata/parse-okay-crlf.exp
@@ -0,0 +1 @@
rec { foo = "multi\nline\n string\n test\r"; x = y; y = 123; z = 456; }
diff --git a/test/testdata/parse-okay-crlf.nix b/test/testdata/parse-okay-crlf.nix
new file mode 100644
index 0000000..21518d4
--- /dev/null
+++ b/test/testdata/parse-okay-crlf.nix
@@ -0,0 +1,17 @@
1rec {
2
3 /* Dit is
4 een test. */
5
6 x =
7 # Dit is een test. y;
8
9 y = 123;
10
11 # CR or CR/LF (but not explicit \r's) in strings should be
12 # translated to LF.
13 foo = "multi line
14 string
15 test\r";
16
17 z = 456; }
diff --git a/test/testdata/parse-okay-dup-attrs-5.exp b/test/testdata/parse-okay-dup-attrs-5.exp
new file mode 100644
index 0000000..88b0b03
--- /dev/null
+++ b/test/testdata/parse-okay-dup-attrs-5.exp
@@ -0,0 +1 @@
{ services = { ssh = { enable = true; port = 23; }; }; }
diff --git a/test/testdata/parse-okay-dup-attrs-5.nix b/test/testdata/parse-okay-dup-attrs-5.nix
new file mode 100644
index 0000000..f4b9efd
--- /dev/null
+++ b/test/testdata/parse-okay-dup-attrs-5.nix
@@ -0,0 +1,4 @@
1{
2 services.ssh = { enable = true; };
3 services.ssh.port = 23;
4}
diff --git a/test/testdata/parse-okay-dup-attrs-6.exp b/test/testdata/parse-okay-dup-attrs-6.exp
new file mode 100644
index 0000000..88b0b03
--- /dev/null
+++ b/test/testdata/parse-okay-dup-attrs-6.exp
@@ -0,0 +1 @@
{ services = { ssh = { enable = true; port = 23; }; }; }
diff --git a/test/testdata/parse-okay-dup-attrs-6.nix b/test/testdata/parse-okay-dup-attrs-6.nix
new file mode 100644
index 0000000..ae6d7a7
--- /dev/null
+++ b/test/testdata/parse-okay-dup-attrs-6.nix
@@ -0,0 +1,4 @@
1{
2 services.ssh.port = 23;
3 services.ssh = { enable = true; };
4}
diff --git a/test/testdata/parse-okay-ind-string.exp b/test/testdata/parse-okay-ind-string.exp
new file mode 100644
index 0000000..82e9940
--- /dev/null
+++ b/test/testdata/parse-okay-ind-string.exp
@@ -0,0 +1 @@
(let string = "str"; in [ (/some/path) ((/some/path)) ((/some/path)) ((/some/path + "\n end")) (string) ((string)) ((string)) ((string + "\n end")) ("") ("") ("end") ])
diff --git a/test/testdata/parse-okay-ind-string.nix b/test/testdata/parse-okay-ind-string.nix
new file mode 100644
index 0000000..97c9de3
--- /dev/null
+++ b/test/testdata/parse-okay-ind-string.nix
@@ -0,0 +1,31 @@
1let
2 string = "str";
3in [
4 /some/path
5
6 ''${/some/path}''
7
8 ''
9 ${/some/path}''
10
11 ''${/some/path}
12 end''
13
14 string
15
16 ''${string}''
17
18 ''
19 ${string}''
20
21 ''${string}
22 end''
23
24 ''''
25
26 ''
27 ''
28
29 ''
30 end''
31]
diff --git a/test/testdata/parse-okay-inherits.exp b/test/testdata/parse-okay-inherits.exp
new file mode 100644
index 0000000..1355527
--- /dev/null
+++ b/test/testdata/parse-okay-inherits.exp
@@ -0,0 +1 @@
(let b = 2; c = { }; in { inherit b; inherit (c) d e; a = 1; f = 3; })
diff --git a/test/testdata/parse-okay-inherits.nix b/test/testdata/parse-okay-inherits.nix
new file mode 100644
index 0000000..10596c8
--- /dev/null
+++ b/test/testdata/parse-okay-inherits.nix
@@ -0,0 +1,9 @@
1let
2 c = {};
3 b = 2;
4in {
5 a = 1;
6 inherit b;
7 inherit (c) d e;
8 f = 3;
9}
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-1.exp b/test/testdata/parse-okay-mixed-nested-attrs-1.exp
new file mode 100644
index 0000000..89c66f7
--- /dev/null
+++ b/test/testdata/parse-okay-mixed-nested-attrs-1.exp
@@ -0,0 +1 @@
{ x = { q = 3; y = 3; z = 3; }; }
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-1.nix b/test/testdata/parse-okay-mixed-nested-attrs-1.nix
new file mode 100644
index 0000000..fd1001c
--- /dev/null
+++ b/test/testdata/parse-okay-mixed-nested-attrs-1.nix
@@ -0,0 +1,4 @@
1{
2 x = { y = 3; z = 3; };
3 x.q = 3;
4}
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-2.exp b/test/testdata/parse-okay-mixed-nested-attrs-2.exp
new file mode 100644
index 0000000..89c66f7
--- /dev/null
+++ b/test/testdata/parse-okay-mixed-nested-attrs-2.exp
@@ -0,0 +1 @@
{ x = { q = 3; y = 3; z = 3; }; }
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-2.nix b/test/testdata/parse-okay-mixed-nested-attrs-2.nix
new file mode 100644
index 0000000..ad066b6
--- /dev/null
+++ b/test/testdata/parse-okay-mixed-nested-attrs-2.nix
@@ -0,0 +1,4 @@
1{
2 x.q = 3;
3 x = { y = 3; z = 3; };
4}
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-3.exp b/test/testdata/parse-okay-mixed-nested-attrs-3.exp
new file mode 100644
index 0000000..b89a597
--- /dev/null
+++ b/test/testdata/parse-okay-mixed-nested-attrs-3.exp
@@ -0,0 +1 @@
{ services = { httpd = { enable = true; }; ssh = { enable = true; port = 123; }; }; }
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-3.nix b/test/testdata/parse-okay-mixed-nested-attrs-3.nix
new file mode 100644
index 0000000..45a33e4
--- /dev/null
+++ b/test/testdata/parse-okay-mixed-nested-attrs-3.nix
@@ -0,0 +1,7 @@
1{
2 services.ssh.enable = true;
3 services.ssh = { port = 123; };
4 services = {
5 httpd.enable = true;
6 };
7}
diff --git a/test/testdata/parse-okay-regression-20041027.exp b/test/testdata/parse-okay-regression-20041027.exp
new file mode 100644
index 0000000..9df7219
--- /dev/null
+++ b/test/testdata/parse-okay-regression-20041027.exp
@@ -0,0 +1 @@
({ fetchurl, stdenv }: ((stdenv).mkDerivation { name = "libXi-6.0.1"; src = (fetchurl { md5 = "7e935a42428d63a387b3c048be0f2756"; url = "http://freedesktop.org/~xlibs/release/libXi-6.0.1.tar.bz2"; }); }))
diff --git a/test/testdata/parse-okay-regression-20041027.nix b/test/testdata/parse-okay-regression-20041027.nix
new file mode 100644
index 0000000..ae2e256
--- /dev/null
+++ b/test/testdata/parse-okay-regression-20041027.nix
@@ -0,0 +1,11 @@
1{stdenv, fetchurl /* pkgconfig, libX11 */ }:
2
3stdenv.mkDerivation {
4 name = "libXi-6.0.1";
5 src = fetchurl {
6 url = http://freedesktop.org/~xlibs/release/libXi-6.0.1.tar.bz2;
7 md5 = "7e935a42428d63a387b3c048be0f2756";
8 };
9/* buildInputs = [pkgconfig];
10 propagatedBuildInputs = [libX11]; */
11}
diff --git a/test/testdata/parse-okay-regression-751.exp b/test/testdata/parse-okay-regression-751.exp
new file mode 100644
index 0000000..e2ed886
--- /dev/null
+++ b/test/testdata/parse-okay-regression-751.exp
@@ -0,0 +1 @@
(let const = (a: "const"); in ((const { x = "q"; })))
diff --git a/test/testdata/parse-okay-regression-751.nix b/test/testdata/parse-okay-regression-751.nix
new file mode 100644
index 0000000..05c78b3
--- /dev/null
+++ b/test/testdata/parse-okay-regression-751.nix
@@ -0,0 +1,2 @@
1let const = a: "const"; in
2''${ const { x = "q"; }}''
diff --git a/test/testdata/parse-okay-subversion.exp b/test/testdata/parse-okay-subversion.exp
new file mode 100644
index 0000000..32fbba3
--- /dev/null
+++ b/test/testdata/parse-okay-subversion.exp
@@ -0,0 +1 @@
({ db4 ? null, expat, fetchurl, httpServer ? false, httpd ? null, j2sdk ? null, javaSwigBindings ? false, javahlBindings ? false, localServer ? false, openssl ? null, pythonBindings ? false, sslSupport ? false, stdenv, swig ? null }: assert (expat != null); assert (localServer -> (db4 != null)); assert (httpServer -> ((httpd != null) && ((httpd).expat == expat))); assert (sslSupport -> ((openssl != null) && (httpServer -> ((httpd).openssl == openssl)))); assert (pythonBindings -> ((swig != null) && (swig).pythonSupport)); assert (javaSwigBindings -> ((swig != null) && (swig).javaSupport)); assert (javahlBindings -> (j2sdk != null)); ((stdenv).mkDerivation { inherit expat httpServer javaSwigBindings javahlBindings localServer pythonBindings sslSupport; builder = /foo/bar; db4 = (if localServer then db4 else null); httpd = (if httpServer then httpd else null); j2sdk = (if javaSwigBindings then (swig).j2sdk else (if javahlBindings then j2sdk else null)); name = "subversion-1.1.1"; openssl = (if sslSupport then openssl else null); patches = (if javahlBindings then [ (/javahl.patch) ] else [ ]); python = (if pythonBindings then (swig).python else null); src = (fetchurl { md5 = "a180c3fe91680389c210c99def54d9e0"; url = "http://subversion.tigris.org/tarballs/subversion-1.1.1.tar.bz2"; }); swig = (if (pythonBindings || javaSwigBindings) then swig else null); }))
diff --git a/test/testdata/parse-okay-subversion.nix b/test/testdata/parse-okay-subversion.nix
new file mode 100644
index 0000000..3562728
--- /dev/null
+++ b/test/testdata/parse-okay-subversion.nix
@@ -0,0 +1,43 @@
1{ localServer ? false
2, httpServer ? false
3, sslSupport ? false
4, pythonBindings ? false
5, javaSwigBindings ? false
6, javahlBindings ? false
7, stdenv, fetchurl
8, openssl ? null, httpd ? null, db4 ? null, expat, swig ? null, j2sdk ? null
9}:
10
11assert expat != null;
12assert localServer -> db4 != null;
13assert httpServer -> httpd != null && httpd.expat == expat;
14assert sslSupport -> openssl != null && (httpServer -> httpd.openssl == openssl);
15assert pythonBindings -> swig != null && swig.pythonSupport;
16assert javaSwigBindings -> swig != null && swig.javaSupport;
17assert javahlBindings -> j2sdk != null;
18
19stdenv.mkDerivation {
20 name = "subversion-1.1.1";
21
22 builder = /foo/bar;
23 src = fetchurl {
24 url = http://subversion.tigris.org/tarballs/subversion-1.1.1.tar.bz2;
25 md5 = "a180c3fe91680389c210c99def54d9e0";
26 };
27
28 # This is a hopefully temporary fix for the problem that
29 # libsvnjavahl.so isn't linked against libstdc++, which causes
30 # loading the library into the JVM to fail.
31 patches = if javahlBindings then [/javahl.patch] else [];
32
33 openssl = if sslSupport then openssl else null;
34 httpd = if httpServer then httpd else null;
35 db4 = if localServer then db4 else null;
36 swig = if pythonBindings || javaSwigBindings then swig else null;
37 python = if pythonBindings then swig.python else null;
38 j2sdk = if javaSwigBindings then swig.j2sdk else
39 if javahlBindings then j2sdk else null;
40
41 inherit expat localServer httpServer sslSupport
42 pythonBindings javaSwigBindings javahlBindings;
43}
diff --git a/test/testdata/parse-okay-url.exp b/test/testdata/parse-okay-url.exp
new file mode 100644
index 0000000..e5f0829
--- /dev/null
+++ b/test/testdata/parse-okay-url.exp
@@ -0,0 +1 @@
[ ("x:x") ("https://svn.cs.uu.nl:12443/repos/trace/trunk") ("http://www2.mplayerhq.hu/MPlayer/releases/fonts/font-arial-iso-8859-1.tar.bz2") ("http://losser.st-lab.cs.uu.nl/~armijn/.nix/gcc-3.3.4-static-nix.tar.gz") ("http://fpdownload.macromedia.com/get/shockwave/flash/english/linux/7.0r25/install_flash_player_7_linux.tar.gz") ("https://ftp5.gwdg.de/pub/linux/archlinux/extra/os/x86_64/unzip-6.0-14-x86_64.pkg.tar.zst") ("ftp://ftp.gtk.org/pub/gtk/v1.2/gtk+-1.2.10.tar.gz") ]
diff --git a/test/testdata/parse-okay-url.nix b/test/testdata/parse-okay-url.nix
new file mode 100644
index 0000000..08de27d
--- /dev/null
+++ b/test/testdata/parse-okay-url.nix
@@ -0,0 +1,8 @@
1[ x:x
2 https://svn.cs.uu.nl:12443/repos/trace/trunk
3 http://www2.mplayerhq.hu/MPlayer/releases/fonts/font-arial-iso-8859-1.tar.bz2
4 http://losser.st-lab.cs.uu.nl/~armijn/.nix/gcc-3.3.4-static-nix.tar.gz
5 http://fpdownload.macromedia.com/get/shockwave/flash/english/linux/7.0r25/install_flash_player_7_linux.tar.gz
6 https://ftp5.gwdg.de/pub/linux/archlinux/extra/os/x86_64/unzip-6.0-14-x86_64.pkg.tar.zst
7 ftp://ftp.gtk.org/pub/gtk/v1.2/gtk+-1.2.10.tar.gz
8]
diff --git a/test/testdata/readDir/bar b/test/testdata/readDir/bar
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/test/testdata/readDir/bar
diff --git a/test/testdata/readDir/foo/git-hates-directories b/test/testdata/readDir/foo/git-hates-directories
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/test/testdata/readDir/foo/git-hates-directories
diff --git a/test/testdata/readDir/ldir b/test/testdata/readDir/ldir
new file mode 120000
index 0000000..1910281
--- /dev/null
+++ b/test/testdata/readDir/ldir
@@ -0,0 +1 @@
foo \ No newline at end of file
diff --git a/test/testdata/readDir/linked b/test/testdata/readDir/linked
new file mode 120000
index 0000000..c503f86
--- /dev/null
+++ b/test/testdata/readDir/linked
@@ -0,0 +1 @@
foo/git-hates-directories \ No newline at end of file
diff --git a/test/testdata/symlink-resolution/broken b/test/testdata/symlink-resolution/broken
new file mode 120000
index 0000000..e07da69
--- /dev/null
+++ b/test/testdata/symlink-resolution/broken
@@ -0,0 +1 @@
nonexistent \ No newline at end of file
diff --git a/test/testdata/symlink-resolution/foo/lib/default.nix b/test/testdata/symlink-resolution/foo/lib/default.nix
new file mode 100644
index 0000000..8b8441b
--- /dev/null
+++ b/test/testdata/symlink-resolution/foo/lib/default.nix
@@ -0,0 +1 @@
"test"
diff --git a/test/testdata/symlink-resolution/foo/overlays b/test/testdata/symlink-resolution/foo/overlays
new file mode 120000
index 0000000..0d44a21
--- /dev/null
+++ b/test/testdata/symlink-resolution/foo/overlays
@@ -0,0 +1 @@
../overlays \ No newline at end of file
diff --git a/test/testdata/symlink-resolution/overlays/overlay.nix b/test/testdata/symlink-resolution/overlays/overlay.nix
new file mode 100644
index 0000000..b036830
--- /dev/null
+++ b/test/testdata/symlink-resolution/overlays/overlay.nix
@@ -0,0 +1 @@
import ../lib
diff --git a/theories/dune b/theories/dune
new file mode 100644
index 0000000..0034b5d
--- /dev/null
+++ b/theories/dune
@@ -0,0 +1,8 @@
1(include_subdirs qualified)
2
3(coq.theory
4 (name mininix)
5 ; This ensures that all files are checked when using the install alias.
6 ; (This does not happen otherwise when just compiling the front-end.)
7 (package mininix)
8 (theories Flocq stdpp))
diff --git a/theories/dynlang/equiv.v b/theories/dynlang/equiv.v
new file mode 100644
index 0000000..aa0b7f3
--- /dev/null
+++ b/theories/dynlang/equiv.v
@@ -0,0 +1,154 @@
1From mininix Require Export lambda.interp_proofs dynlang.interp_proofs.
2From stdpp Require Import options.
3
4Class Lift A B := lift : A → B.
5Global Hint Mode Lift ! - : typeclass_instances.
6Arguments lift {_ _ _} !_ /.
7Notation "⌜ x ⌝" := (lift x) (at level 0).
8Notation "⌜* x ⌝" := (fmap lift x) (at level 0).
9
10Module lambda.
11 Global Instance lambda_expr_lift : Lift lambda.expr dynlang.expr :=
12 fix go e := let _ : Lift _ _ := go in
13 match e with
14 | lambda.EString s => dynlang.EString s
15 | lambda.EId x => dynlang.EId ∅ (dynlang.EString x)
16 | lambda.EAbs x e => dynlang.EAbs (dynlang.EString x) ⌜e⌝
17 | lambda.EApp e1 e2 => dynlang.EApp ⌜e1⌝ ⌜e2⌝
18 end.
19
20 Global Instance lambda_thunk_lift : Lift lambda.thunk dynlang.thunk :=
21 fix go t := let _ : Lift _ _ := go in
22 dynlang.Thunk ⌜*lambda.thunk_env t⌝ ⌜lambda.thunk_expr t⌝.
23
24 Global Instance lambda_val_lift : Lift lambda.val dynlang.val := λ v,
25 match v with
26 | lambda.VString s => dynlang.VString s
27 | lambda.VClo x E e => dynlang.VClo x ⌜*E⌝ ⌜e⌝
28 end.
29End lambda.
30
31Lemma interp_open_lambda_dynlang E e mv n :
32 lambda.closed_env E → lambda.closed (dom E) e →
33 lambda.interp n E e = Res mv →
34 ∃ m, dynlang.interp m ⌜*E⌝ ⌜e⌝ = Res ⌜*mv⌝.
35Proof.
36 revert E e mv. induction n as [|n IH]; [done|]; intros E e mv HE He Hinterp.
37 rewrite lambda.interp_S in Hinterp. destruct e as [s|z|ex e|e1 e2]; simplify_res.
38 - (* EString *) by exists 1.
39 - (* EId *)
40 apply elem_of_dom in He as [[Et et] Hz]. rewrite Hz /= in Hinterp.
41 apply lambda.closed_env_lookup in Hz as He; last done.
42 rewrite lambda.closed_thunk_eq/= in He. destruct He as [HEtclosed Hetclosed].
43 apply IH in Hinterp as [m Hinterp]; [|done..].
44 exists (S (S m)). rewrite !dynlang.interp_S /= -dynlang.interp_S.
45 rewrite lookup_empty /= right_id_L lookup_fmap Hz /=.
46 eauto using dynlang.interp_le with lia.
47 - (* EAbs *) by exists 2.
48 - (* EApp *)
49 destruct He as [He1 He2].
50 destruct (lambda.interp _ _ e1) as [mw|] eqn:Hinterp1; simplify_res.
51 pose proof Hinterp1 as Hinterp1'.
52 apply lambda.interp_closed in Hinterp1' as Hmw; [|done..].
53 eapply IH in Hinterp1 as [m1 Hinterp1]; [|done..].
54 destruct mw as [w|]; simplify_res; last first.
55 { exists (S m1). by rewrite dynlang.interp_S /= Hinterp1. }
56 destruct (maybe3 lambda.VClo w) eqn:?; simplify_res; last first.
57 { exists (S m1). rewrite dynlang.interp_S /= Hinterp1 /=. by destruct w. }
58 destruct w; simplify_res.
59 apply IH in Hinterp as [m2 Hinterp2].
60 + exists (S (m1 + m2)). rewrite dynlang.interp_S /=.
61 rewrite (dynlang.interp_le Hinterp1) /=; last lia.
62 rewrite fmap_insert /= in Hinterp2.
63 rewrite (dynlang.interp_le Hinterp2) /=; last lia. done.
64 + apply lambda.closed_env_insert; [by split|naive_solver].
65 + rewrite dom_insert_L. set_solver.
66Qed.
67Lemma interp_lambda_dynlang e mv n :
68 lambda.closed ∅ e →
69 lambda.interp n ∅ e = Res mv →
70 ∃ m, dynlang.interp m ∅ ⌜e⌝ = Res ⌜*mv⌝.
71Proof. intro. by apply interp_open_lambda_dynlang. Qed.
72
73Lemma interp_open_dynlang_lambda E e mv n :
74 lambda.closed_env E → lambda.closed (dom E) e →
75 dynlang.interp n ⌜*E⌝ ⌜e⌝ = Res mv →
76 ∃ mw, lambda.interp n E e = Res mw ∧ mv = ⌜*mw⌝.
77Proof.
78 revert E e mv. induction n as [|n IH]; [done|]; intros E e mv HE He Hinterp.
79 rewrite dynlang.interp_S in Hinterp. destruct e as [s|z|ex e|e1 e2]; simplify_res.
80 - (* EString *) rewrite lambda.interp_S /=. by eexists.
81 - (* EId *)
82 destruct n as [|n]; [done|].
83 rewrite dynlang.interp_S /= -dynlang.interp_S in Hinterp.
84 apply elem_of_dom in He as [[Et et] Hz].
85 pose proof (f_equal (fmap lift) Hz) as Hz'.
86 rewrite -lookup_fmap /= in Hz'. rewrite Hz' lookup_empty /= {Hz'} in Hinterp.
87 pose proof Hz as Hz'.
88 apply lambda.closed_env_lookup in Hz' as [HEt Het]; simpl in *; last done.
89 apply IH in Hinterp as (mw & Hinterp & ->); [|done..].
90 exists mw. rewrite lambda.interp_S /= Hz /=. done.
91 - (* EAbs *)
92 destruct n as [|n]; [done|].
93 rewrite dynlang.interp_S /= in Hinterp; simplify_res.
94 rewrite lambda.interp_S /=. by eexists.
95 - (* EApp *)
96 destruct He as [He1 He2].
97 destruct (dynlang.interp _ _ _) as [mw1|] eqn:Hinterp1; simplify_res.
98 eapply IH in Hinterp1 as (mv1 & Hinterp1 & ->); [|done..].
99 destruct mv1 as [v1|]; simplify_res; last first.
100 { exists None. by rewrite lambda.interp_S /= Hinterp1. }
101 destruct (maybe3 dynlang.VClo _) eqn:?; simplify_res; last first.
102 { exists None. rewrite lambda.interp_S /= Hinterp1 /=. by destruct v1. }
103 destruct v1; simplify_res.
104 change (dynlang.Thunk ⌜*E⌝ ⌜e2⌝) with ⌜lambda.Thunk E e2⌝ in Hinterp.
105 rewrite -fmap_insert in Hinterp.
106 apply lambda.interp_closed in Hinterp1 as Hmw; [|done..].
107 apply IH in Hinterp as (mv2 & Hinterp2 & ->).
108 + exists mv2. rewrite lambda.interp_S /= Hinterp1 /=. done.
109 + apply lambda.closed_env_insert; [by split|]. naive_solver.
110 + rewrite dom_insert_L. set_solver.
111Qed.
112Lemma interp_dynlang_lambda e mv n :
113 lambda.closed ∅ e →
114 dynlang.interp n ∅ ⌜e⌝ = Res mv →
115 ∃ mw, lambda.interp n ∅ e = Res mw ∧ mv = ⌜*mw⌝.
116Proof. intros. by apply interp_open_dynlang_lambda. Qed.
117
118(* The following equivalences about the semantics trivially follow: *)
119
120Theorem interp_equiv_ret_string e s :
121 lambda.closed ∅ e →
122 rtc lambda.step e (lambda.EString s)
123 ↔ rtc dynlang.step ⌜e⌝ (dynlang.EString s).
124Proof.
125 intros. rewrite -lambda.interp_sound_complete_ret_string //.
126 rewrite -dynlang.interp_sound_complete_ret_string. split; intros [n Hinterp].
127 + by apply interp_lambda_dynlang in Hinterp.
128 + apply interp_dynlang_lambda in Hinterp as ([[]|] & ?); naive_solver.
129Qed.
130
131Theorem interp_equiv_fail e :
132 lambda.closed ∅ e →
133 (∃ e', rtc lambda.step e e' ∧ lambda.stuck e')
134 ↔ (∃ e', rtc dynlang.step ⌜e⌝ e' ∧ dynlang.stuck e').
135Proof.
136 intros. rewrite -lambda.interp_sound_complete_fail //.
137 rewrite -dynlang.interp_sound_complete_fail. split; intros [n Hinterp].
138 + by apply interp_lambda_dynlang in Hinterp.
139 + apply interp_dynlang_lambda in Hinterp as ([] & ?); naive_solver.
140Qed.
141
142Theorem interp_equiv_no_fuel e :
143 lambda.closed ∅ e →
144 all_loop lambda.step e ↔ all_loop dynlang.step ⌜e⌝.
145Proof.
146 intros He. rewrite -lambda.interp_sound_complete_no_fuel; last done.
147 rewrite -dynlang.interp_sound_complete_no_fuel. split; intros Hnofuel n.
148 - destruct (dynlang.interp n ∅ _) as [mv|] eqn:Hinterp; [|done].
149 apply interp_dynlang_lambda in Hinterp as (? & Hinterp & _); [|done].
150 by rewrite Hnofuel in Hinterp.
151 - destruct (lambda.interp n ∅ _) as [mv|] eqn:Hinterp; [|done].
152 apply interp_lambda_dynlang in Hinterp as [m Hinterp]; [|done..].
153 by rewrite Hnofuel in Hinterp.
154Qed.
diff --git a/theories/dynlang/interp.v b/theories/dynlang/interp.v
new file mode 100644
index 0000000..dcf6b95
--- /dev/null
+++ b/theories/dynlang/interp.v
@@ -0,0 +1,49 @@
1From mininix Require Export res dynlang.operational_props.
2From stdpp Require Import options.
3
4Module Import dynlang.
5Export dynlang.
6
7Inductive thunk := Thunk { thunk_env : gmap string thunk; thunk_expr : expr }.
8Add Printing Constructor thunk.
9Notation env := (gmap string thunk).
10
11Inductive val :=
12 | VString (s : string)
13 | VClo (x : string) (E : env) (e : expr).
14
15Global Instance maybe_VString : Maybe VString := λ v,
16 if v is VString s then Some s else None.
17Global Instance maybe_VClo : Maybe3 VClo := λ v,
18 if v is VClo x E e then Some (x, E, e) else None.
19
20Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val :=
21 match e with
22 | EString s =>
23 mret (VString s)
24 | EId ds e =>
25 v ← interp E e;
26 x ← Res $ maybe VString v;
27 t ← Res $ (E !! x) ∪ (Thunk ∅ <$> ds !! x);
28 interp (thunk_env t) (thunk_expr t)
29 | EAbs ex e =>
30 v ← interp E ex;
31 x ← Res $ maybe VString v;
32 mret (VClo x E e)
33 | EApp e1 e2 =>
34 v1 ← interp E e1;
35 '(x, E', e') ← Res (maybe3 VClo v1);
36 interp (<[x:=Thunk E e2]> E') e'
37 end.
38
39Fixpoint interp (n : nat) (E : env) (e : expr) : res val :=
40 match n with
41 | O => NoFuel
42 | S n => interp1 (interp n) E e
43 end.
44
45Global Opaque interp.
46
47End dynlang.
48
49Add Printing Constructor dynlang.thunk.
diff --git a/theories/dynlang/interp_proofs.v b/theories/dynlang/interp_proofs.v
new file mode 100644
index 0000000..f18a91c
--- /dev/null
+++ b/theories/dynlang/interp_proofs.v
@@ -0,0 +1,426 @@
1From mininix Require Export dynlang.interp.
2From stdpp Require Import options.
3
4Module Import dynlang.
5Export dynlang.
6
7Lemma interp_S n : interp (S n) = interp1 (interp n).
8Proof. done. Qed.
9
10Fixpoint thunk_size (t : thunk) : nat :=
11 S (map_sum_with thunk_size (thunk_env t)).
12Definition env_size (E : env) : nat :=
13 map_sum_with thunk_size E.
14
15Lemma env_ind (P : env → Prop) :
16 (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) →
17 ∀ E : env, P E.
18Proof.
19 intros Pbs E.
20 induction (Nat.lt_wf_0_projected env_size E) as [E _ IH].
21 apply Pbs, map_Forall_lookup=> y [E' e'] Hy.
22 apply (map_sum_with_lookup_le thunk_size) in Hy.
23 apply IH. by rewrite -Nat.le_succ_l.
24Qed.
25
26(** Correspondence to operational semantics *)
27Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr :=
28 subst (thunk_to_expr <$> E).
29Fixpoint thunk_to_expr (t : thunk) : expr :=
30 subst_env' thunk_to_expr (thunk_env t) (thunk_expr t).
31Notation subst_env := (subst_env' thunk_to_expr).
32
33Lemma subst_env_eq e E :
34 subst_env E e =
35 match e with
36 | EString s => EString s
37 | EId ds e => EId ((thunk_to_expr <$> E) ∪ ds) (subst_env E e)
38 | EAbs ex e => EAbs (subst_env E ex) (subst_env E e)
39 | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2)
40 end.
41Proof. by destruct e. Qed.
42
43Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e.
44Proof. done. Qed.
45
46(* Use the unfolding lemmas, don't rely on conversion *)
47Opaque subst_env'.
48
49Definition val_to_expr (v : val) : expr :=
50 match v with
51 | VString s => EString s
52 | VClo x E e => EAbs (EString x) (subst_env E e)
53 end.
54
55Lemma val_final v : final (val_to_expr v).
56Proof. by destruct v. Qed.
57
58Lemma subst_empty e : subst ∅ e = e.
59Proof. induction e; f_equal/=; auto. by rewrite left_id_L. Qed.
60
61Lemma subst_env_empty e : subst_env ∅ e = e.
62Proof. rewrite subst_env_alt. apply subst_empty. Qed.
63
64Lemma interp_le {n1 n2 E e mv} :
65 interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv.
66Proof.
67 revert n2 E e mv.
68 induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|].
69 rewrite interp_S in He; rewrite interp_S; destruct e;
70 repeat match goal with
71 | _ => case_match
72 | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res
73 | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
74 | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
75 | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia)
76 | _ => progress simplify_res
77 | _ => progress simplify_option_eq
78 end; eauto with lia.
79Qed.
80
81Lemma interp_agree {n1 n2 E e mv1 mv2} :
82 interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2.
83Proof.
84 intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
85 - rewrite -He2. symmetry. eauto using interp_le.
86 - rewrite -He1. eauto using interp_le.
87Qed.
88
89Lemma subst_env_union E1 E2 e :
90 subst_env (E1 ∪ E2) e = subst_env E1 (subst_env E2 e).
91Proof.
92 revert E1 E2. induction e; intros E1 E2; rewrite subst_env_eq /=.
93 - done.
94 - rewrite !(subst_env_eq (EId _ _)) IHe. f_equal.
95 by rewrite assoc_L map_fmap_union.
96 - rewrite !(subst_env_eq (EAbs _ _)) /=. f_equal; auto.
97 - rewrite !(subst_env_eq (EApp _ _)) /=. f_equal; auto.
98Qed.
99
100Lemma subst_env_insert E x e t :
101 subst_env (<[x:=t]> E) e = subst {[x:=thunk_to_expr t]} (subst_env E e).
102Proof.
103 rewrite insert_union_singleton_l subst_env_union subst_env_alt.
104 by rewrite map_fmap_singleton.
105Qed.
106
107Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' :
108 subst_env E1 e1 = subst_env E2 e2 →
109 subst_env E1' e1' = subst_env E2' e2' →
110 subst_env (<[x:=Thunk E1' e1']> E1) e1 = subst_env (<[x:=Thunk E2' e2']> E2) e2.
111Proof. intros He He'. by rewrite !subst_env_insert //= He' He. Qed.
112
113Lemma interp_proper n E1 E2 e1 e2 mv :
114 subst_env E1 e1 = subst_env E2 e2 →
115 interp n E1 e1 = Res mv →
116 ∃ mw m, interp m E2 e2 = Res mw ∧
117 val_to_expr <$> mv = val_to_expr <$> mw.
118Proof.
119 revert n E1 E2 e1 e2 mv. induction n as [|n IHn]; [done|].
120 intros E1 E2 e1 e2 mv Hsubst Hinterp.
121 rewrite 2!subst_env_eq in Hsubst.
122 rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done.
123 - eexists (Some (VString _)), 1. by rewrite interp_S.
124 - destruct (interp n _ e1) as [mv1|] eqn:Hinterp'; simplify_eq/=.
125 eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
126 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
127 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
128 destruct (maybe VString v1) as [x|] eqn:Hv1;
129 simplify_res; last first.
130 { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=.
131 destruct v1, w1; repeat destruct select base_lit; by simplify_eq/=. }
132 destruct v1, w1; repeat destruct select base_lit; simplify_eq/=.
133 assert (∀ (ds : stringmap expr) (E : env) x,
134 thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds !! x)
135 = ((thunk_to_expr <$> E) ∪ ds) !! x) as HE.
136 { intros ds' E x. rewrite lookup_union lookup_fmap.
137 repeat destruct (_ !! _); f_equal/=; by rewrite subst_env_empty. }
138 pose proof (f_equal (.!! s0) Hsubst) as Hs. rewrite -!HE {HE} in Hs.
139 destruct (E1 !! s0 ∪ _) as [[E1' e1']|],
140 (E2 !! s0 ∪ _) as [[E2' e2']|] eqn:HE2; simplify_res; last first.
141 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. by rewrite HE2. }
142 eapply IHn in Hinterp as (mw & m2 & Hinterp2 & ?); [|by eauto..].
143 exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=.
144 rewrite (interp_le Hinterp1) /=; last lia. rewrite HE2 /=.
145 eauto using interp_le with lia.
146 - destruct (interp n _ _) as [mv1|] eqn:Hinterp'; simplify_eq/=.
147 eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
148 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
149 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
150 destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
151 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
152 by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). }
153 destruct v1, w1; simplify_eq/=.
154 eexists (Some (VClo _ _ _)), (S m1).
155 rewrite interp_S /= Hinterp1 /=. split; [done|]. by do 2 f_equal/=.
156 - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
157 eapply IHn in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done.
158 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
159 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
160 destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
161 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
162 by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
163 destruct v', w'; simplify_eq/=.
164 eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp
165 as (w & m2 & Hinterp2 & ?); last by apply subst_env_insert_eq.
166 exists w, (S (m1 `max` m2)). rewrite interp_S /=.
167 rewrite (interp_le Hinterp1) /=; last lia.
168 rewrite (interp_le Hinterp2) /=; last lia. done.
169Qed.
170
171Lemma subst_as_subst_env x e1 e2 :
172 subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1.
173Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed.
174
175Lemma interp_subst n x e1 e2 mv :
176 interp n ∅ (subst {[x:=e2]} e1) = Res mv →
177 ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧
178 val_to_expr <$> mv = val_to_expr <$> mw.
179Proof.
180 apply interp_proper.
181 by rewrite subst_env_empty subst_as_subst_env.
182Qed.
183
184Lemma interp_step e1 e2 n mv :
185 e1 --> e2 →
186 interp n ∅ e2 = Res mv →
187 ∃ mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw.
188Proof.
189 intros Hstep. revert mv n.
190 induction Hstep; intros mv n Hinterp.
191 - apply interp_subst in Hinterp as (w & [|m] & Hinterp & Hv);
192 simplify_eq/=; [|done..].
193 exists w, (S (S (S m))). rewrite !interp_S /= -!interp_S.
194 eauto using interp_le with lia.
195 - exists mv, (S (S n)). rewrite !interp_S /= -interp_S.
196 rewrite lookup_empty left_id_L H /=. eauto using interp_le with lia.
197 - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
198 destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
199 apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res.
200 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
201 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
202 destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
203 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
204 by assert (maybe VString w' = None) as -> by (by destruct v', w'). }
205 destruct v', w'; simplify_eq/=.
206 eexists (Some (VClo _ _ _)), (S m1). rewrite !interp_S /=.
207 rewrite (interp_le Hinterp1) /=; last lia. done.
208 - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
209 destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
210 apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res.
211 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
212 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
213 destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
214 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
215 by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
216 destruct v', w'; simplify_eq/=.
217 eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & Hv);
218 last apply subst_env_insert_eq; try done.
219 exists mw, (S (m1 `max` m2)). rewrite !interp_S /=.
220 rewrite (interp_le Hinterp1) /=; last lia.
221 by rewrite (interp_le Hinterp2) /=; last lia.
222 - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
223 destruct (interp n _ e1') as [mv1|] eqn:Hinterp1; simplify_eq/=.
224 apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1).
225 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
226 { exists None, (S m). by rewrite interp_S /= Hinterp1. }
227 exists mv, (S (n `max` m)). split; [|done].
228 rewrite interp_S /= (interp_le Hinterp1) /=; last lia.
229 assert (maybe VString w1 = maybe VString v1) as ->.
230 { destruct v1, w1; naive_solver. }
231 destruct (maybe VString v1); simplify_res; [|done].
232 destruct (_ ∪ _); simplify_res; eauto using interp_le with lia.
233Qed.
234
235Lemma final_interp e :
236 final e →
237 ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w.
238Proof.
239 induction e as [| |[]|]; inv 1.
240 - eexists (VString _), 1. by rewrite interp_S /=.
241 - eexists (VClo _ _ _), 2. rewrite interp_S /=. split; [done|].
242 by rewrite subst_env_empty.
243Qed.
244
245Lemma red_final_interp e :
246 red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail.
247Proof.
248 induction e.
249 - (* ENat *) right; left. constructor.
250 - (* EId *) destruct IHe as [[??]|[Hfinal|[m Hinterp]]].
251 + left. by repeat econstructor.
252 + apply final_interp in Hfinal as (w & m & Hinterp & ->).
253 destruct (maybe VString w) as [x|] eqn:Hw; last first.
254 { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=.
255 by rewrite Hw. }
256 destruct w; simplify_eq/=.
257 destruct (ds !! x) as [e|] eqn:Hx; last first.
258 { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=.
259 by rewrite Hx. }
260 left. by repeat econstructor.
261 + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done.
262 - (* EAbs *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
263 + left. by repeat econstructor.
264 + apply final_interp in Hfinal as (w & m & Hinterp & ->).
265 destruct (maybe VString w) as [x|] eqn:Hw; last first.
266 { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=.
267 by rewrite Hw. }
268 destruct w; naive_solver.
269 + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done.
270 - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
271 + left. by repeat econstructor.
272 + apply final_interp in Hfinal as (w & m & Hinterp & ->).
273 destruct (maybe3 VClo w) eqn:Hw.
274 { destruct w; simplify_eq/=. left. by repeat econstructor. }
275 do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw.
276 + do 2 right. exists (S m). by rewrite interp_S /= Hinterp.
277Qed.
278
279Lemma interp_complete e1 e2 :
280 e1 -->* e2 →
281 nf step e2 →
282 ∃ mw m, interp m ∅ e1 = Res mw ∧
283 if mw is Some w then e2 = val_to_expr w else ¬final e2.
284Proof.
285 intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH].
286 { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..].
287 - apply final_interp in Hfinal as (w & m & ? & ?).
288 by exists (Some w), m.
289 - exists None, m. split; [done|]. intros Hfinal.
290 apply final_interp in Hfinal as (w & m' & ? & _).
291 by assert (mfail = mret w) by eauto using interp_agree. }
292 destruct IH as (mw & m & Hinterp & ?); try done.
293 eapply interp_step in Hinterp as (mw' & m' & ? & ?); last done.
294 destruct mw, mw'; naive_solver.
295Qed.
296
297Lemma interp_complete_ret e1 e2 :
298 e1 -->* e2 → final e2 →
299 ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w.
300Proof.
301 intros Hsteps Hfinal. apply interp_complete in Hsteps
302 as ([w|] & m & ? & ?); naive_solver eauto using final_nf.
303Qed.
304Lemma interp_complete_fail e1 e2 :
305 e1 -->* e2 → nf step e2 → ¬final e2 →
306 ∃ m, interp m ∅ e1 = mfail.
307Proof.
308 intros Hsteps Hnf Hforce.
309 apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto.
310 destruct Hforce. apply val_final.
311Qed.
312
313Lemma interp_sound_open E e n mv :
314 interp n E e = Res mv →
315 ∃ e', subst_env E e -->* e' ∧
316 if mv is Some v then e' = val_to_expr v else stuck e'.
317Proof.
318 revert E e mv.
319 induction n as [|n IH]; intros E e mv Hinterp; first done.
320 rewrite subst_env_eq. rewrite interp_S in Hinterp.
321 destruct e; simplify_res.
322 - (* EString *) by eexists.
323 - (* EId *)
324 destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
325 apply IH in Hinterp1 as (e1' & Hsteps1 & He1').
326 destruct mv1 as [v1|]; simplify_res; last first.
327 { eexists; split; [by eapply SId_rtc|]. split; [|inv 1].
328 intros [??]. destruct He1' as [Hnf []].
329 inv_step; simpl; eauto. destruct Hnf; eauto. }
330 destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first.
331 { eexists; split; [by eapply SId_rtc|]. split; [|inv 1].
332 intros [??]. destruct v1; inv_step. }
333 destruct v1; simplify_eq/=.
334 assert (thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds !! x)
335 = ((thunk_to_expr <$> E) ∪ ds) !! x).
336 { rewrite lookup_union lookup_fmap.
337 repeat destruct (_ !! _); f_equal/=; by rewrite subst_env_empty. }
338 destruct (_ ∪ _) as [[E' e']|] eqn:Hx; simplify_res.
339 * apply IH in Hinterp as (e'' & Hsteps & He'').
340 exists e''; split; [|done]. etrans; [by eapply SId_rtc|].
341 eapply rtc_l; [|done]. by econstructor.
342 * eexists; split; [by eapply SId_rtc|]. split; [|inv 1].
343 intros [? Hstep]. inv_step; simplify_eq/=; congruence.
344 - (* EAbs *)
345 destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
346 apply IH in Hinterp1 as (e1' & Hsteps1 & He1').
347 destruct mv1 as [v1|]; simplify_res; last first.
348 { eexists; split; [by eapply SAbsL_rtc|]. split.
349 + intros [??]. destruct He1' as [Hnf []].
350 inv_step; simpl; eauto. destruct Hnf; eauto.
351 + intros ?. destruct He1' as [_ []]. by destruct e1'. }
352 eexists; split; [by eapply SAbsL_rtc|].
353 destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first.
354 { split; [|destruct v1; inv 1]. intros [??]. destruct v1; inv_step. }
355 by destruct v1; simplify_eq/=.
356 - (* EApp *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res.
357 apply IH in Hinterp' as (e' & Hsteps & He'); try done.
358 destruct mv' as [v'|]; simplify_res; last first.
359 { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
360 intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
361 inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. }
362 destruct (maybe3 VClo v') eqn:?; simplify_res; last first.
363 { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
364 intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. }
365 destruct v'; simplify_res.
366 apply IH in Hinterp as (e'' & Hsteps' & He'').
367 eexists; split; [|done]. etrans; [by apply SAppL_rtc|].
368 eapply rtc_l; first by constructor.
369 rewrite subst_env_insert // in Hsteps'.
370Qed.
371
372Lemma interp_sound n e mv :
373 interp n ∅ e = Res mv →
374 ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'.
375Proof.
376 intros Hsteps%interp_sound_open; try done.
377 by rewrite subst_env_empty in Hsteps.
378Qed.
379
380(** Final theorems *)
381Theorem interp_sound_complete_ret e v :
382 (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w)
383 ↔ e -->* val_to_expr v.
384Proof.
385 split.
386 - by intros (n & w & (e' & ? & ->)%interp_sound & ->).
387 - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?);
388 eauto using val_final.
389Qed.
390
391Theorem interp_sound_complete_ret_string e s :
392 (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s.
393Proof.
394 split.
395 - by intros [n (e' & ? & ->)%interp_sound].
396 - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?);
397 simplify_eq/=; eauto.
398Qed.
399
400Theorem interp_sound_complete_fail e :
401 (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'.
402Proof.
403 split.
404 - by intros [n ?%interp_sound].
405 - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail.
406Qed.
407
408Theorem interp_sound_complete_no_fuel e :
409 (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e.
410Proof.
411 rewrite all_loop_alt. split.
412 - intros Hnofuel e' Hsteps.
413 destruct (red_final_interp e') as [|[|He']]; [done|..].
414 + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done.
415 by rewrite Hnofuel in Hinterp.
416 + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]).
417 destruct (interp_complete e e'') as (mv & n & Hinterp & _); [by etrans|done|].
418 by rewrite Hnofuel in Hinterp.
419 - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done].
420 apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck).
421 destruct mv as [v|]; simplify_eq/=.
422 + apply final_nf in Hsteps as []. apply val_final.
423 + by destruct Hstuck as [[] ?].
424Qed.
425
426End dynlang.
diff --git a/theories/dynlang/operational.v b/theories/dynlang/operational.v
new file mode 100644
index 0000000..34cca7b
--- /dev/null
+++ b/theories/dynlang/operational.v
@@ -0,0 +1,41 @@
1From mininix Require Export utils.
2From stdpp Require Import options.
3
4Module Import dynlang.
5
6Inductive expr :=
7 | EString (s : string)
8 | EId (ds : gmap string expr) (ex : expr)
9 | EAbs (ex e : expr)
10 | EApp (e1 e2 : expr).
11
12Fixpoint subst (ds : gmap string expr) (e : expr) : expr :=
13 match e with
14 | EString s => EString s
15 | EId ds' e => EId (ds ∪ ds') (subst ds e)
16 | EAbs ex e => EAbs (subst ds ex) (subst ds e)
17 | EApp e1 e2 => EApp (subst ds e1) (subst ds e2)
18 end.
19
20Reserved Infix "-->" (right associativity, at level 55).
21Inductive step : expr → expr → Prop :=
22 | Sβ x e1 e2 : EApp (EAbs (EString x) e1) e2 --> subst {[x:=e2]} e1
23 | SIdString ds x e : ds !! x = Some e → EId ds (EString x) --> e
24 | SAbsL ex1 ex1' e : ex1 --> ex1' → EAbs ex1 e --> EAbs ex1' e
25 | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2
26 | SId ds e1 e1' : e1 --> e1' → EId ds e1 --> EId ds e1'
27where "e1 --> e2" := (step e1 e2).
28
29Infix "-->*" := (rtc step) (right associativity, at level 55).
30
31Definition final (e : expr) : Prop :=
32 match e with
33 | EString _ => True
34 | EAbs (EString _) _ => True
35 | _ => False
36 end.
37
38Definition stuck (e : expr) : Prop :=
39 nf step e ∧ ¬final e.
40
41End dynlang.
diff --git a/theories/dynlang/operational_props.v b/theories/dynlang/operational_props.v
new file mode 100644
index 0000000..9e8028c
--- /dev/null
+++ b/theories/dynlang/operational_props.v
@@ -0,0 +1,33 @@
1From mininix Require Export dynlang.operational.
2From stdpp Require Import options.
3
4Module Import dynlang.
5Export dynlang.
6
7(** Properties of operational semantics *)
8Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1.
9Proof. induction 1; simpl; repeat case_match; naive_solver. Qed.
10Lemma final_nf e : final e → nf step e.
11Proof. by intros ? [??%step_not_final]. Qed.
12
13Lemma SAbsL_rtc ex1 ex1' e : ex1 -->* ex1' → EAbs ex1 e -->* EAbs ex1' e.
14Proof. induction 1; econstructor; eauto using step. Qed.
15Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2.
16Proof. induction 1; econstructor; eauto using step. Qed.
17Lemma SId_rtc ds e1 e1' : e1 -->* e1' → EId ds e1 -->* EId ds e1'.
18Proof. induction 1; econstructor; eauto using step. Qed.
19
20Ltac inv_step := repeat
21 match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end.
22
23Lemma step_det e d1 d2 :
24 e --> d1 →
25 e --> d2 →
26 d1 = d2.
27Proof.
28 intros Hred1. revert d2.
29 induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step;
30 f_equal; by apply IHHred1.
31Qed.
32
33End dynlang.
diff --git a/theories/evallang/interp.v b/theories/evallang/interp.v
new file mode 100644
index 0000000..d98b87f
--- /dev/null
+++ b/theories/evallang/interp.v
@@ -0,0 +1,52 @@
1From mininix Require Export res evallang.operational_props.
2From stdpp Require Import options.
3
4Module Import evallang.
5Export evallang.
6
7Inductive thunk := Thunk { thunk_env : gmap string thunk; thunk_expr : expr }.
8Add Printing Constructor thunk.
9Notation env := (gmap string thunk).
10
11Inductive val :=
12 | VString (s : string)
13 | VClo (x : string) (E : env) (e : expr).
14
15Global Instance maybe_VString : Maybe VString := λ v,
16 if v is VString s then Some s else None.
17Global Instance maybe_VClo : Maybe3 VClo := λ v,
18 if v is VClo x E e then Some (x, E, e) else None.
19
20Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val :=
21 match e with
22 | EString s =>
23 mret (VString s)
24 | EId ds x =>
25 t ← Res $ (E !! x) ∪ (Thunk ∅ <$> ds);
26 interp (thunk_env t) (thunk_expr t)
27 | EEval ds e =>
28 v ← interp E e;
29 s ← Res $ maybe VString v;
30 e ← Res $ parse s;
31 interp (E ∪ (Thunk ∅ <$> ds)) e
32 | EAbs ex e =>
33 v ← interp E ex;
34 x ← Res $ maybe VString v;
35 mret (VClo x E e)
36 | EApp e1 e2 =>
37 v1 ← interp E e1;
38 '(x, E', e') ← Res (maybe3 VClo v1);
39 interp (<[x:=Thunk E e2]> E') e'
40 end.
41
42Fixpoint interp (n : nat) (E : env) (e : expr) : res val :=
43 match n with
44 | O => NoFuel
45 | S n => interp1 (interp n) E e
46 end.
47
48Global Opaque interp.
49
50End evallang.
51
52Add Printing Constructor evallang.thunk.
diff --git a/theories/evallang/interp_proofs.v b/theories/evallang/interp_proofs.v
new file mode 100644
index 0000000..0a26dd1
--- /dev/null
+++ b/theories/evallang/interp_proofs.v
@@ -0,0 +1,478 @@
1From mininix Require Export evallang.interp.
2From stdpp Require Import options.
3
4Module Import evallang.
5Export evallang.
6
7Lemma interp_S n : interp (S n) = interp1 (interp n).
8Proof. done. Qed.
9
10Fixpoint thunk_size (t : thunk) : nat :=
11 S (map_sum_with thunk_size (thunk_env t)).
12Definition env_size (E : env) : nat :=
13 map_sum_with thunk_size E.
14
15Lemma env_ind (P : env → Prop) :
16 (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) →
17 ∀ E : env, P E.
18Proof.
19 intros Pbs E.
20 induction (Nat.lt_wf_0_projected env_size E) as [E _ IH].
21 apply Pbs, map_Forall_lookup=> y [E' e'] Hy.
22 apply (map_sum_with_lookup_le thunk_size) in Hy.
23 apply IH. by rewrite -Nat.le_succ_l.
24Qed.
25
26(** Correspondence to operational semantics *)
27Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr :=
28 subst (thunk_to_expr <$> E).
29Fixpoint thunk_to_expr (t : thunk) : expr :=
30 subst_env' thunk_to_expr (thunk_env t) (thunk_expr t).
31Notation subst_env := (subst_env' thunk_to_expr).
32
33Lemma subst_env_eq e E :
34 subst_env E e =
35 match e with
36 | EString s => EString s
37 | EId ds x => EId ((thunk_to_expr <$> E !! x) ∪ ds) x
38 | EEval ds e => EEval ((thunk_to_expr <$> E) ∪ ds) (subst_env E e)
39 | EAbs ex e => EAbs (subst_env E ex) (subst_env E e)
40 | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2)
41 end.
42Proof. destruct e; rewrite /subst_env' /= ?lookup_fmap //. Qed.
43
44Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e.
45Proof. done. Qed.
46
47(* Use the unfolding lemmas, don't rely on conversion *)
48Opaque subst_env'.
49
50Definition val_to_expr (v : val) : expr :=
51 match v with
52 | VString s => EString s
53 | VClo x E e => EAbs (EString x) (subst_env E e)
54 end.
55
56Lemma final_val_to_expr v : final (val_to_expr v).
57Proof. by destruct v. Qed.
58Lemma step_not_val_to_expr v e : val_to_expr v --> e → False.
59Proof. intros []%step_not_final. apply final_val_to_expr. Qed.
60
61Lemma subst_empty e : subst ∅ e = e.
62Proof. induction e; f_equal/=; rewrite ?lookup_empty ?left_id_L //. Qed.
63
64Lemma subst_env_empty e : subst_env ∅ e = e.
65Proof. rewrite subst_env_alt. apply subst_empty. Qed.
66
67Lemma interp_le {n1 n2 E e mv} :
68 interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv.
69Proof.
70 revert n2 E e mv.
71 induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|].
72 rewrite interp_S in He; rewrite interp_S; destruct e;
73 repeat match goal with
74 | _ => case_match
75 | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res
76 | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
77 | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
78 | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia)
79 | _ => progress simplify_res
80 | _ => progress simplify_option_eq
81 end; eauto with lia.
82Qed.
83
84Lemma interp_agree {n1 n2 E e mv1 mv2} :
85 interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2.
86Proof.
87 intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
88 - rewrite -He2. symmetry. eauto using interp_le.
89 - rewrite -He1. eauto using interp_le.
90Qed.
91
92Lemma subst_env_union E1 E2 e :
93 subst_env (E1 ∪ E2) e = subst_env E1 (subst_env E2 e).
94Proof.
95 revert E1 E2. induction e; intros E1 E2; rewrite subst_env_eq /=.
96 - done.
97 - rewrite !subst_env_eq lookup_union. by destruct (E1 !! _), (E2 !! _), ds.
98 - rewrite !(subst_env_eq (EEval _ _)) IHe. f_equal.
99 by rewrite assoc_L map_fmap_union.
100 - rewrite !(subst_env_eq (EAbs _ _)) /=. f_equal; auto.
101 - rewrite !(subst_env_eq (EApp _ _)) /=. f_equal; auto.
102Qed.
103
104Lemma subst_env_insert E x e t :
105 subst_env (<[x:=t]> E) e = subst {[x:=thunk_to_expr t]} (subst_env E e).
106Proof.
107 rewrite insert_union_singleton_l subst_env_union subst_env_alt.
108 by rewrite map_fmap_singleton.
109Qed.
110
111Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' :
112 subst_env E1 e1 = subst_env E2 e2 →
113 subst_env E1' e1' = subst_env E2' e2' →
114 subst_env (<[x:=Thunk E1' e1']> E1) e1 = subst_env (<[x:=Thunk E2' e2']> E2) e2.
115Proof. intros He He'. by rewrite !subst_env_insert //= He' He. Qed.
116
117Lemma option_fmap_thunk_to_expr_Thunk (me : option expr) :
118 thunk_to_expr <$> (Thunk ∅ <$> me) = me.
119Proof. destruct me; f_equal/=. by rewrite subst_env_empty. Qed.
120
121Lemma map_fmap_thunk_to_expr_Thunk (es : gmap string expr) :
122 thunk_to_expr <$> (Thunk ∅ <$> es) = es.
123Proof.
124 apply map_eq=> x. by rewrite !lookup_fmap option_fmap_thunk_to_expr_Thunk.
125Qed.
126
127Lemma subst_env_eval_eq E1 E2 ds1 ds2 e :
128 (thunk_to_expr <$> E1) ∪ ds1 = (thunk_to_expr <$> E2) ∪ ds2 →
129 subst_env (E1 ∪ (Thunk ∅ <$> ds1)) e = subst_env (E2 ∪ (Thunk ∅ <$> ds2)) e.
130Proof.
131 intros HE.
132 by rewrite !subst_env_alt !map_fmap_union !map_fmap_thunk_to_expr_Thunk HE.
133Qed.
134
135Lemma interp_proper n E1 E2 e1 e2 mv :
136 subst_env E1 e1 = subst_env E2 e2 →
137 interp n E1 e1 = Res mv →
138 ∃ mw m, interp m E2 e2 = Res mw ∧
139 val_to_expr <$> mv = val_to_expr <$> mw.
140Proof.
141 revert n E1 E2 e1 e2 mv. induction n as [|n IHn]; [done|].
142 intros E1 E2 e1 e2 mv Hsubst Hinterp.
143 rewrite 2!subst_env_eq in Hsubst.
144 rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done.
145 - eexists (Some (VString _)), 1. by rewrite interp_S.
146 - assert (thunk_to_expr <$> E1 !! x0 ∪ (Thunk ∅ <$> ds) =
147 thunk_to_expr <$> E2 !! x0 ∪ (Thunk ∅ <$> ds0)).
148 { destruct (E1 !! _), (E2 !! _), ds, ds0; simplify_eq/=;
149 f_equal/=; by rewrite ?subst_env_empty. }
150 destruct (E1 !! x0 ∪ (Thunk ∅ <$> ds)) as [[E1' e1']|],
151 (E2 !! x0 ∪ (Thunk ∅ <$> ds0)) as [[E2' e2']|] eqn:HE2;
152 simplify_res; last first.
153 { exists None, 1. by rewrite interp_S /= HE2. }
154 eapply IHn in Hinterp as (mw & m & Hinterp2 & ?); [|by eauto..].
155 exists mw, (S m). split; [|done]. rewrite interp_S /= HE2 /=. done.
156 - destruct (interp n _ e1) as [mv1|] eqn:Hinterp'; simplify_eq/=.
157 eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
158 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
159 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
160 destruct (maybe VString v1) as [x|] eqn:Hv1;
161 simplify_res; last first.
162 { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=.
163 destruct v1, w1; repeat destruct select base_lit; by simplify_eq/=. }
164 destruct v1, w1; repeat destruct select base_lit; simplify_eq/=.
165 destruct (parse _) as [e|] eqn:Hparse; simplify_res; last first.
166 { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=.
167 by rewrite Hparse. }
168 eapply IHn in Hinterp
169 as (mw & m2 & Hinterp2 & ?); last by apply subst_env_eval_eq.
170 exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=.
171 rewrite (interp_le Hinterp1) /=; last lia. rewrite Hparse /=.
172 eauto using interp_le with lia.
173 - destruct (interp n _ _) as [mv1|] eqn:Hinterp'; simplify_eq/=.
174 eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
175 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
176 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
177 destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
178 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
179 by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). }
180 destruct v1, w1; simplify_eq/=.
181 eexists (Some (VClo _ _ _)), (S m1).
182 rewrite interp_S /= Hinterp1 /=. split; [done|]. by do 2 f_equal/=.
183 - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
184 eapply IHn in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done.
185 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
186 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
187 destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
188 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
189 by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
190 destruct v', w'; simplify_eq/=.
191 eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp
192 as (w & m2 & Hinterp2 & ?); last by apply subst_env_insert_eq.
193 exists w, (S (m1 `max` m2)). rewrite interp_S /=.
194 rewrite (interp_le Hinterp1) /=; last lia.
195 rewrite (interp_le Hinterp2) /=; last lia. done.
196Qed.
197
198Lemma subst_as_subst_env x e1 e2 :
199 subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1.
200Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed.
201
202Lemma interp_subst_abs n x e1 e2 mv :
203 interp n ∅ (subst {[x:=e2]} e1) = Res mv →
204 ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧
205 val_to_expr <$> mv = val_to_expr <$> mw.
206Proof.
207 apply interp_proper. by rewrite subst_env_empty subst_as_subst_env.
208Qed.
209
210Lemma interp_subst_eval n e ds mv :
211 interp n ∅ (subst ds e) = Res mv →
212 ∃ mw m, interp m (Thunk ∅ <$> ds) e = Res mw ∧
213 val_to_expr <$> mv = val_to_expr <$> mw.
214Proof.
215 apply interp_proper.
216 by rewrite subst_env_empty subst_env_alt map_fmap_thunk_to_expr_Thunk.
217Qed.
218
219Lemma interp_step e1 e2 n mv :
220 e1 --> e2 →
221 interp n ∅ e2 = Res mv →
222 ∃ mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw.
223Proof.
224 intros Hstep. revert mv n.
225 induction Hstep; intros mv n Hinterp.
226 - apply interp_subst_abs in Hinterp as (mw & [|m] & Hinterp & Hv);
227 simplify_eq/=; [|done..].
228 exists mw, (S (S (S m))). rewrite !interp_S /= -!interp_S.
229 eauto using interp_le with lia.
230 - exists mv, (S n). rewrite !interp_S /=.
231 rewrite lookup_empty left_id_L /=. done.
232 - apply interp_subst_eval in Hinterp as (mw & [|m] & Hinterp & Hv);
233 simplify_eq/=; [|done..].
234 exists mw, (S (S m)). rewrite !interp_S /= -interp_S.
235 rewrite left_id_L H /=. done.
236 - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
237 destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
238 apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res.
239 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
240 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
241 destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
242 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
243 by assert (maybe VString w' = None) as -> by (by destruct v', w'). }
244 destruct v', w'; simplify_eq/=.
245 eexists (Some (VClo _ _ _)), (S m1). rewrite !interp_S /=.
246 rewrite (interp_le Hinterp1) /=; last lia. done.
247 - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
248 destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
249 apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res.
250 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
251 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
252 destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
253 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
254 by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
255 destruct v', w'; simplify_eq/=.
256 eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & Hv);
257 last apply subst_env_insert_eq; try done.
258 exists mw, (S (m1 `max` m2)). rewrite !interp_S /=.
259 rewrite (interp_le Hinterp1) /=; last lia.
260 by rewrite (interp_le Hinterp2) /=; last lia.
261 - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
262 destruct (interp n _ e1') as [mv1|] eqn:Hinterp1; simplify_eq/=.
263 apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1).
264 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
265 { exists None, (S m). by rewrite interp_S /= Hinterp1. }
266 destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
267 { exists None, (S m). rewrite interp_S /= Hinterp1 /=.
268 by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). }
269 destruct v1, w1; simplify_eq/=.
270 exists mv, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
271 rewrite (interp_le Hinterp1) /=; last lia.
272 destruct (parse _); simplify_res; eauto using interp_le with lia.
273Qed.
274
275Lemma final_interp e :
276 final e →
277 ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w.
278Proof.
279 induction e as [| | |[]|]; inv 1.
280 - eexists (VString _), 1. by rewrite interp_S /=.
281 - eexists (VClo _ _ _), 2. rewrite interp_S /=. split; [done|].
282 by rewrite subst_env_empty.
283Qed.
284
285Lemma red_final_interp e :
286 red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail.
287Proof.
288 induction e.
289 - (* ENat *) right; left. constructor.
290 - (* EId *) destruct ds as [e|].
291 + left. by repeat econstructor.
292 + do 2 right. by exists 1.
293 - (* EEval *) destruct IHe as [[??]|[Hfinal|[m Hinterp]]].
294 + left. by repeat econstructor.
295 + apply final_interp in Hfinal as (w & m & Hinterp & ->).
296 destruct (maybe VString w) as [x|] eqn:Hw; last first.
297 { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=.
298 by rewrite Hw. }
299 destruct w; simplify_eq/=.
300 destruct (parse x) as [e|] eqn:Hparse; last first.
301 { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=.
302 by rewrite Hparse. }
303 left. by repeat econstructor.
304 + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done.
305 - (* EAbs *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
306 + left. by repeat econstructor.
307 + apply final_interp in Hfinal as (w & m & Hinterp & ->).
308 destruct (maybe VString w) as [x|] eqn:Hw; last first.
309 { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=.
310 by rewrite Hw. }
311 destruct w; naive_solver.
312 + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done.
313 - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
314 + left. by repeat econstructor.
315 + apply final_interp in Hfinal as (w & m & Hinterp & ->).
316 destruct (maybe3 VClo w) eqn:Hw.
317 { destruct w; simplify_eq/=. left. by repeat econstructor. }
318 do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw.
319 + do 2 right. exists (S m). by rewrite interp_S /= Hinterp.
320Qed.
321
322Lemma interp_complete e1 e2 :
323 e1 -->* e2 →
324 nf step e2 →
325 ∃ mw m, interp m ∅ e1 = Res mw ∧
326 if mw is Some w then e2 = val_to_expr w else ¬final e2.
327Proof.
328 intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH].
329 { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..].
330 - apply final_interp in Hfinal as (w & m & ? & ?).
331 by exists (Some w), m.
332 - exists None, m. split; [done|]. intros Hfinal.
333 apply final_interp in Hfinal as (w & m' & ? & _).
334 by assert (mfail = mret w) by eauto using interp_agree. }
335 destruct IH as (mw & m & Hinterp & ?); try done.
336 eapply interp_step in Hinterp as (mw' & m' & ? & ?); last done.
337 destruct mw, mw'; naive_solver.
338Qed.
339
340Lemma interp_complete_ret e1 e2 :
341 e1 -->* e2 → final e2 →
342 ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w.
343Proof.
344 intros Hsteps Hfinal. apply interp_complete in Hsteps
345 as ([w|] & m & ? & ?); naive_solver eauto using final_nf.
346Qed.
347Lemma interp_complete_fail e1 e2 :
348 e1 -->* e2 → nf step e2 → ¬final e2 →
349 ∃ m, interp m ∅ e1 = mfail.
350Proof.
351 intros Hsteps Hnf Hforce.
352 apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto.
353 destruct Hforce. apply final_val_to_expr.
354Qed.
355
356Lemma interp_sound_open E e n mv :
357 interp n E e = Res mv →
358 ∃ e', subst_env E e -->* e' ∧
359 if mv is Some v then e' = val_to_expr v else stuck e'.
360Proof.
361 revert E e mv.
362 induction n as [|n IH]; intros E e mv Hinterp; first done.
363 rewrite subst_env_eq. rewrite interp_S in Hinterp.
364 destruct e; simplify_res.
365 - (* EString *) by eexists.
366 - (* EId *)
367 assert (thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds)
368 = (thunk_to_expr <$> E !! x) ∪ ds).
369 { destruct (_ !! _), ds; f_equal/=. by rewrite subst_env_empty. }
370 destruct (_ ∪ (_ <$> _)) as [[E1 e1]|], (_ ∪ _) as [e2|]; simplify_res.
371 * apply IH in Hinterp as (e'' & Hsteps & He'').
372 exists e''; split; [|done].
373 eapply rtc_l; [|done]. by econstructor.
374 * eexists; split; [done|]. split; [|inv 1].
375 intros [? Hstep]. inv_step; simplify_eq/=; congruence.
376 - (* EEval *)
377 destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
378 apply IH in Hinterp1 as (e1' & Hsteps1 & He1').
379 destruct mv1 as [v1|]; simplify_res; last first.
380 { eexists; split; [by eapply SEval_rtc|]. split; [|inv 1].
381 intros [??]. destruct He1' as [Hnf []].
382 inv_step; simpl; eauto. destruct Hnf; eauto. }
383 destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first.
384 { eexists; split; [by eapply SEval_rtc|]. split; [|inv 1].
385 intros [??]. destruct v1; inv_step. }
386 destruct v1; simplify_eq/=.
387 destruct (parse x) as [ex|] eqn:Hparse; simplify_res; last first.
388 { eexists; split; [by eapply SEval_rtc|].
389 split; [|inv 1]. intros [??]. inv_step. }
390 apply IH in Hinterp as (e'' & Hsteps & He'').
391 exists e''; split; [|done]. etrans; [by eapply SEval_rtc|].
392 eapply rtc_l; [by econstructor|].
393 by rewrite subst_env_alt map_fmap_union
394 map_fmap_thunk_to_expr_Thunk in Hsteps.
395 - (* EAbs *)
396 destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
397 apply IH in Hinterp1 as (e1' & Hsteps1 & He1').
398 destruct mv1 as [v1|]; simplify_res; last first.
399 { eexists; split; [by eapply SAbsL_rtc|]. split.
400 + intros [??]. destruct He1' as [Hnf []].
401 inv_step; simpl; eauto. destruct Hnf; eauto.
402 + intros ?. destruct He1' as [_ []]. by destruct e1'. }
403 eexists; split; [by eapply SAbsL_rtc|].
404 destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first.
405 { split; [|destruct v1; inv 1]. intros [??]. destruct v1; inv_step. }
406 by destruct v1; simplify_eq/=.
407 - (* EApp *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res.
408 apply IH in Hinterp' as (e' & Hsteps & He'); try done.
409 destruct mv' as [v'|]; simplify_res; last first.
410 { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
411 intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
412 inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. }
413 destruct (maybe3 VClo v') eqn:?; simplify_res; last first.
414 { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
415 intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. }
416 destruct v'; simplify_res.
417 apply IH in Hinterp as (e'' & Hsteps' & He'').
418 eexists; split; [|done]. etrans; [by apply SAppL_rtc|].
419 eapply rtc_l; first by constructor.
420 rewrite subst_env_insert // in Hsteps'.
421Qed.
422
423Lemma interp_sound n e mv :
424 interp n ∅ e = Res mv →
425 ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'.
426Proof.
427 intros Hsteps%interp_sound_open; try done.
428 by rewrite subst_env_empty in Hsteps.
429Qed.
430
431(** Final theorems *)
432Theorem interp_sound_complete_ret e v :
433 (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w)
434 ↔ e -->* val_to_expr v.
435Proof.
436 split.
437 - by intros (n & w & (e' & ? & ->)%interp_sound & ->).
438 - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?);
439 unfold nf, red;
440 naive_solver eauto using final_val_to_expr, step_not_val_to_expr.
441Qed.
442
443Theorem interp_sound_complete_ret_string e s :
444 (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s.
445Proof.
446 split.
447 - by intros [n (e' & ? & ->)%interp_sound].
448 - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?);
449 simplify_eq/=; eauto.
450Qed.
451
452Theorem interp_sound_complete_fail e :
453 (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'.
454Proof.
455 split.
456 - by intros [n ?%interp_sound].
457 - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail.
458Qed.
459
460Theorem interp_sound_complete_no_fuel e :
461 (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e.
462Proof.
463 rewrite all_loop_alt. split.
464 - intros Hnofuel e' Hsteps.
465 destruct (red_final_interp e') as [|[|He']]; [done|..].
466 + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done.
467 by rewrite Hnofuel in Hinterp.
468 + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]).
469 destruct (interp_complete e e'') as (mv & n & Hinterp & _); [by etrans|done|].
470 by rewrite Hnofuel in Hinterp.
471 - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done].
472 apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck).
473 destruct mv as [v|]; simplify_eq/=.
474 + apply final_nf in Hsteps as []. apply final_val_to_expr.
475 + by destruct Hstuck as [[] ?].
476Qed.
477
478End evallang.
diff --git a/theories/evallang/operational.v b/theories/evallang/operational.v
new file mode 100644
index 0000000..79174dd
--- /dev/null
+++ b/theories/evallang/operational.v
@@ -0,0 +1,140 @@
1From Coq Require Import Ascii.
2From mininix Require Export utils.
3From stdpp Require Import options.
4
5Module Import evallang.
6
7Inductive expr :=
8 | EString (s : string)
9 | EId (ds : option expr) (x : string)
10 | EEval (ds : gmap string expr) (ee : expr)
11 | EAbs (ex e : expr)
12 | EApp (e1 e2 : expr).
13
14Module parser.
15 Inductive token :=
16 | TId (s : string)
17 | TString (s : string)
18 | TColon
19 | TExclamation
20 | TParenL
21 | TParenR.
22
23 Inductive token_state :=
24 TSString (s : string) | TSId (s : string) | TSOther.
25
26 Definition token_state_push (st : token_state) (k : list token) : list token :=
27 match st with
28 | TSId s => TId (String.rev s) :: k
29 | _ => k
30 end.
31
32 Fixpoint tokenize_go (sin : string) (st : token_state)
33 (k : list token) : option (list token) :=
34 match sin, st with
35 | "", TSString _ => None (* no closing "" *)
36 | "", _ => Some (reverse (token_state_push st k))
37 | String "\" (String """" sin), TSString s =>
38 tokenize_go sin (TSString (String """" s)) k
39 | String """" sin, TSString s =>
40 tokenize_go sin TSOther (TString (String.rev s) :: k)
41 | String a sin, TSString s => tokenize_go sin (TSString (String a s)) k
42 | String ":" sin, _ => tokenize_go sin TSOther (TColon :: token_state_push st k)
43 | String "!" sin, _ => tokenize_go sin TSOther (TExclamation :: token_state_push st k)
44 | String "(" sin, _ => tokenize_go sin TSOther (TParenL :: token_state_push st k)
45 | String ")" sin, _ => tokenize_go sin TSOther (TParenR :: token_state_push st k)
46 | String """" sin, _ => tokenize_go sin (TSString "") k
47 | String a sin, TSOther =>
48 if Ascii.is_space a then tokenize_go sin TSOther k
49 else tokenize_go sin (TSId (String a EmptyString)) k
50 | String a sin, TSId s =>
51 if Ascii.is_space a then tokenize_go sin TSOther (TId (String.rev s) :: k)
52 else tokenize_go sin (TSId (String a s)) k
53 end.
54 Definition tokenize (sin : string) : option (list token) :=
55 tokenize_go sin TSOther [].
56
57 Inductive stack_item :=
58 | SExpr (e : expr)
59 | SAbsR (e : expr)
60 | SEval
61 | SParenL.
62
63 Definition stack_push (e : expr) (k : list stack_item) : list stack_item :=
64 match k with
65 | SExpr e1 :: k => SExpr (EApp e1 e) :: k
66 | SEval :: k => SExpr (EEval ∅ e) :: k
67 | _ => SExpr e :: k
68 end.
69
70 Fixpoint stack_pop_go (e : expr)
71 (k : list stack_item) : option (expr * list stack_item) :=
72 match k with
73 | SAbsR e1 :: k => stack_pop_go (EAbs e1 e) k
74 | _ => Some (e, k)
75 end.
76
77 Definition stack_pop (k : list stack_item) : option (expr * list stack_item) :=
78 match k with
79 | SExpr e :: k => stack_pop_go e k
80 | _ => None
81 end.
82
83 Fixpoint parse_go (ts : list token) (k : list stack_item) : option expr :=
84 match ts with
85 | [] => '(e, k) ← stack_pop k; guard (k = []);; Some e
86 | TString x :: ts => parse_go ts (stack_push (EString x) k)
87 | TId "eval" :: TExclamation :: ts => parse_go ts (SEval :: k)
88 | TId x :: TColon :: ts => parse_go ts (SAbsR (EString x) :: k)
89 | TId x :: ts => parse_go ts (stack_push (EId None x) k)
90 | TColon :: ts =>
91 '(e, k) ← stack_pop k;
92 parse_go ts (SAbsR e :: k)
93 | TParenL :: ts => parse_go ts (SParenL :: k)
94 | TParenR :: ts =>
95 '(e, k) ← stack_pop k;
96 match k with
97 | SParenL :: k => parse_go ts (stack_push e k)
98 | _ => None
99 end
100 | _ => None
101 end.
102
103 Definition parse (sin : string) : option expr :=
104 ts ← tokenize sin; parse_go ts [].
105End parser.
106
107Definition parse := parser.parse.
108
109Fixpoint subst (ds : gmap string expr) (e : expr) : expr :=
110 match e with
111 | EString s => EString s
112 | EId ds' x => EId (ds !! x ∪ ds') x
113 | EEval ds' ee => EEval (ds ∪ ds') (subst ds ee)
114 | EAbs ex e => EAbs (subst ds ex) (subst ds e)
115 | EApp e1 e2 => EApp (subst ds e1) (subst ds e2)
116 end.
117
118Reserved Infix "-->" (right associativity, at level 55).
119Inductive step : expr → expr → Prop :=
120 | Sβ x e1 e2 : EApp (EAbs (EString x) e1) e2 --> subst {[x:=e2]} e1
121 | SId e x : EId (Some e) x --> e
122 | SEvalString ds s e : parse s = Some e → EEval ds (EString s) --> subst ds e
123 | SAbsL ex1 ex1' e : ex1 --> ex1' → EAbs ex1 e --> EAbs ex1' e
124 | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2
125 | SEval ds e1 e1' : e1 --> e1' → EEval ds e1 --> EEval ds e1'
126where "e1 --> e2" := (step e1 e2).
127
128Infix "-->*" := (rtc step) (right associativity, at level 55).
129
130Definition final (e : expr) : Prop :=
131 match e with
132 | EString _ => True
133 | EAbs (EString _) _ => True
134 | _ => False
135 end.
136
137Definition stuck (e : expr) : Prop :=
138 nf step e ∧ ¬final e.
139
140End evallang.
diff --git a/theories/evallang/operational_props.v b/theories/evallang/operational_props.v
new file mode 100644
index 0000000..31724c0
--- /dev/null
+++ b/theories/evallang/operational_props.v
@@ -0,0 +1,33 @@
1From mininix Require Export evallang.operational.
2From stdpp Require Import options.
3
4Module Import evallang.
5Export evallang.
6
7(** Properties of operational semantics *)
8Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1.
9Proof. induction 1; simpl; repeat case_match; naive_solver. Qed.
10Lemma final_nf e : final e → nf step e.
11Proof. by intros ? [??%step_not_final]. Qed.
12
13Lemma SAbsL_rtc ex1 ex1' e : ex1 -->* ex1' → EAbs ex1 e -->* EAbs ex1' e.
14Proof. induction 1; econstructor; eauto using step. Qed.
15Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2.
16Proof. induction 1; econstructor; eauto using step. Qed.
17Lemma SEval_rtc ds e1 e1' : e1 -->* e1' → EEval ds e1 -->* EEval ds e1'.
18Proof. induction 1; econstructor; eauto using step. Qed.
19
20Ltac inv_step := repeat
21 match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end.
22
23Lemma step_det e d1 d2 :
24 e --> d1 →
25 e --> d2 →
26 d1 = d2.
27Proof.
28 intros Hred1. revert d2.
29 induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step;
30 f_equal; by apply IHHred1.
31Qed.
32
33End evallang.
diff --git a/theories/evallang/tests.v b/theories/evallang/tests.v
new file mode 100644
index 0000000..eaba8a0
--- /dev/null
+++ b/theories/evallang/tests.v
@@ -0,0 +1,33 @@
1From mininix Require Export evallang.interp.
2From stdpp Require Import options.
3
4Import evallang.
5
6Definition interp' (n : nat) (s : string) : res val :=
7 interp n ∅ (EEval ∅ (EString s)).
8
9Lemma test_1_a : interp' 1000 ("(x: x) ""s""") = mret (VString "s").
10Proof. by vm_compute. Qed.
11Lemma test_1_b : interp' 1000 ("(""x"": x) ""s""") = mret (VString "s").
12Proof. by vm_compute. Qed.
13Lemma test_1_c : interp' 1000 ("((y:y) ""x"": x) ""s""") = mret (VString "s").
14Proof. by vm_compute. Qed.
15Lemma test_1_d : interp' 1000 ("(((y:y) ""x""): x) ""s""") = mret (VString "s").
16Proof. by vm_compute. Qed.
17
18Lemma test_2 : interp' 1000 ("(x: y: eval! y) ""s"" ""x""") = mret (VString "s").
19Proof. by vm_compute. Qed.
20
21Lemma test_3 : interp' 1000 ("eval! ""x: x"" ""s""") = mret (VString "s").
22Proof. by vm_compute. Qed.
23
24Lemma test_4_a :
25 interp' 1000 ("(x: y: eval! y) ""s"" ""x""") = mret (VString "s").
26Proof. by vm_compute. Qed.
27Lemma test_4_b :
28 interp' 1000 ("eval! ""(x: y: eval! y) \""s\"" \""x\""""") = mret (VString "s").
29Proof. by vm_compute. Qed.
30
31Lemma test_5 :
32 interp' 1000 ("(x: y: eval! ""x: x"" (eval! y)) ""s"" ""x""") = mret (VString "s").
33Proof. by vm_compute. Qed.
diff --git a/theories/lambda/interp.v b/theories/lambda/interp.v
new file mode 100644
index 0000000..5bc60d1
--- /dev/null
+++ b/theories/lambda/interp.v
@@ -0,0 +1,44 @@
1From mininix Require Export res lambda.operational_props.
2From stdpp Require Import options.
3
4Module Import lambda.
5Export lambda.
6
7Inductive thunk :=
8 Thunk { thunk_env : gmap string thunk; thunk_expr : expr }.
9Add Printing Constructor thunk.
10Notation env := (gmap string thunk).
11
12Inductive val :=
13 | VString (s : string)
14 | VClo (x : string) (E : env) (e : expr).
15
16Global Instance maybe_VClo : Maybe3 VClo := λ v,
17 if v is VClo x E e then Some (x, E, e) else None.
18
19Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val :=
20 match e with
21 | EString s =>
22 mret (VString s)
23 | EId x =>
24 t ← Res (E !! x);
25 interp (thunk_env t) (thunk_expr t)
26 | EAbs x e =>
27 mret (VClo x E e)
28 | EApp e1 e2 =>
29 v1 ← interp E e1;
30 '(x, E', e') ← Res (maybe3 VClo v1);
31 interp (<[x:=Thunk E e2]> E') e'
32 end.
33
34Fixpoint interp (n : nat) (E : env) (e : expr) : res val :=
35 match n with
36 | O => NoFuel
37 | S n => interp1 (interp n) E e
38 end.
39
40Global Opaque interp.
41
42End lambda.
43
44Add Printing Constructor lambda.thunk.
diff --git a/theories/lambda/interp_proofs.v b/theories/lambda/interp_proofs.v
new file mode 100644
index 0000000..efd0982
--- /dev/null
+++ b/theories/lambda/interp_proofs.v
@@ -0,0 +1,614 @@
1From mininix Require Export lambda.interp.
2From stdpp Require Import options.
3
4Module Import lambda.
5Export lambda.
6
7Lemma interp_S n : interp (S n) = interp1 (interp n).
8Proof. done. Qed.
9
10Fixpoint thunk_size (t : thunk) : nat :=
11 S (map_sum_with thunk_size (thunk_env t)).
12Definition env_size (E : env) : nat :=
13 map_sum_with thunk_size E.
14
15Lemma env_ind (P : env → Prop) :
16 (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) →
17 ∀ E : env, P E.
18Proof.
19 intros Pbs E.
20 induction (Nat.lt_wf_0_projected env_size E) as [E _ IH].
21 apply Pbs, map_Forall_lookup=> y [E' e'] Hy.
22 apply (map_sum_with_lookup_le thunk_size) in Hy.
23 apply IH. by rewrite -Nat.le_succ_l.
24Qed.
25
26(** Correspondence to operational semantics *)
27Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr :=
28 subst (thunk_to_expr <$> E).
29Fixpoint thunk_to_expr (t : thunk) : expr :=
30 subst_env' thunk_to_expr (thunk_env t) (thunk_expr t).
31Notation subst_env := (subst_env' thunk_to_expr).
32
33Lemma subst_env_eq e E :
34 subst_env E e =
35 match e with
36 | EString s => EString s
37 | EId x => if E !! x is Some t then thunk_to_expr t else EId x
38 | EAbs x e => EAbs x (subst_env (delete x E) e)
39 | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2)
40 end.
41Proof.
42 rewrite /subst_env. destruct e; simpl; try done.
43 - rewrite lookup_fmap. by destruct (E !! x) as [[]|].
44 - by rewrite fmap_delete.
45Qed.
46Lemma subst_env_id x E :
47 subst_env E (EId x) = if E !! x is Some t then thunk_to_expr t else EId x.
48Proof. by rewrite subst_env_eq. Qed.
49
50Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e.
51Proof. done. Qed.
52
53(* Use the unfolding lemmas, don't rely on conversion *)
54Opaque subst_env'.
55
56Definition val_to_expr (v : val) : expr :=
57 match v with
58 | VString s => EString s
59 | VClo x E e => EAbs x (subst_env (delete x E) e)
60 end.
61
62Lemma final_val_to_expr v : final (val_to_expr v).
63Proof. by destruct v. Qed.
64Lemma step_not_val_to_expr v e : val_to_expr v --> e → False.
65Proof. intros []%step_not_final. apply final_val_to_expr. Qed.
66
67Lemma subst_empty e : subst ∅ e = e.
68Proof. induction e; f_equal/=; auto. Qed.
69
70Lemma subst_env_empty e : subst_env ∅ e = e.
71Proof. rewrite subst_env_alt. apply subst_empty. Qed.
72
73Lemma interp_le {n1 n2 E e mv} :
74 interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv.
75Proof.
76 revert n2 E e mv.
77 induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|].
78 rewrite interp_S in He; rewrite interp_S; destruct e;
79 repeat match goal with
80 | _ => case_match
81 | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res
82 | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
83 | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
84 | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia)
85 | _ => progress simplify_res
86 | _ => progress simplify_option_eq
87 end; eauto with lia.
88Qed.
89
90Lemma interp_agree {n1 n2 E e mv1 mv2} :
91 interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2.
92Proof.
93 intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
94 - rewrite -He2. symmetry. eauto using interp_le.
95 - rewrite -He1. eauto using interp_le.
96Qed.
97
98Definition is_not_id (e : expr) : Prop :=
99 match e with EId _ => False | _ => True end.
100
101Lemma id_or_not e : (∃ x, e = EId x) ∨ is_not_id e.
102Proof. destruct e; naive_solver. Qed.
103
104Lemma interp_not_id n E e v :
105 interp n E e = mret v → is_not_id (subst_env E e).
106Proof.
107 revert E e v. induction n as [|n IH]; intros E e v; [done|].
108 rewrite interp_S. destruct e; simpl; try done.
109 rewrite subst_env_id. destruct (_ !! _) as [[[]]|]; naive_solver.
110Qed.
111
112Fixpoint closed (X : stringset) (e : expr) : Prop :=
113 match e with
114 | EString _ => True
115 | EId x => x ∈ X
116 | EAbs x e => closed ({[ x ]} ∪ X) e
117 | EApp e1 e2 => closed X e1 ∧ closed X e2
118 end.
119
120Inductive closed_thunk (t : thunk) : Prop := {
121 closed_thunk_env : map_Forall (λ _, closed_thunk) (thunk_env t);
122 closed_thunk_expr : closed (dom (thunk_env t)) (thunk_expr t);
123}.
124Notation closed_env := (map_Forall (M:=env) (λ _, closed_thunk)).
125
126Definition closed_val (v : val) : Prop :=
127 match v with
128 | VString _ => True
129 | VClo x E e => closed_env E ∧ closed ({[x]} ∪ dom E) e
130 end.
131
132Lemma closed_thunk_eq E e :
133 closed_thunk (Thunk E e) ↔ closed_env E ∧ closed (dom E) e.
134Proof. split; inv 1; constructor; done. Qed.
135
136Lemma closed_env_delete x E : closed_env E → closed_env (delete x E).
137Proof. apply map_Forall_delete. Qed.
138
139Lemma closed_env_insert x t E :
140 closed_thunk t → closed_env E → closed_env (<[x:=t]> E).
141Proof. apply: map_Forall_insert_2. Qed.
142
143Lemma closed_env_lookup E x t :
144 closed_env E → E !! x = Some t → closed_thunk t.
145Proof. apply map_Forall_lookup_1. Qed.
146
147Lemma closed_subst E ds e :
148 dom ds ## E → closed E e → subst ds e = e.
149Proof.
150 revert E ds.
151 induction e; intros E ds Hdisj Heclosed; simplify_eq/=; first done.
152 - assert (Hxds : x ∉ dom ds) by set_solver.
153 by rewrite (not_elem_of_dom_1 _ _ Hxds).
154 - f_equal. by apply IHe with (E := {[x]} ∪ E); first set_solver.
155 - f_equal; naive_solver.
156Qed.
157
158Lemma closed_weaken X Y e : closed X e → X ⊆ Y → closed Y e.
159Proof. revert X Y; induction e; naive_solver eauto with set_solver. Qed.
160
161Lemma subst_closed ds X e :
162 map_Forall (λ _, closed ∅) ds →
163 closed (dom ds ∪ X) e →
164 closed X (subst ds e).
165Proof.
166 revert X ds. induction e; intros X ds; repeat (case_decide || simplify_eq/=).
167 - done.
168 - intros. case_match.
169 + apply H in H1. by eapply closed_weaken.
170 + apply not_elem_of_dom in H1. set_solver.
171 - intros. apply IHe.
172 + by apply map_Forall_delete.
173 + by rewrite dom_delete_L assoc_L difference_union_L
174 [dom _ ∪ _]comm_L -assoc_L.
175 - naive_solver.
176Qed.
177
178Lemma subst_env_delete_closed E X e x :
179 closed_env E →
180 closed ({[x]} ∪ X) (subst_env E e) →
181 closed ({[x]} ∪ X) (subst_env (delete x E) e).
182Proof.
183 revert E X x.
184 induction e as [s | z | z e IHe | e1 IHe1 e2 IHe2]; intros E X x.
185 - rewrite !subst_env_eq //.
186 - rewrite !subst_env_eq /=. case_match.
187 + destruct (decide (x = z)) as [->|?].
188 * rewrite lookup_delete. set_solver.
189 * rewrite lookup_delete_ne // H //.
190 + destruct (decide (x = z)) as [->|?].
191 * rewrite delete_notin // H //.
192 * rewrite lookup_delete_ne // H //.
193 - intros HE.
194 rewrite [subst_env (delete _ _) _]subst_env_eq subst_env_eq /=
195 delete_commute comm_L -assoc_L.
196 by apply IHe, map_Forall_delete.
197 - rewrite [subst_env (delete _ _) _]subst_env_eq subst_env_eq /=.
198 naive_solver.
199Qed.
200
201Lemma subst_env_closed E X e :
202 closed_env E → closed (dom E ∪ X) e → closed X (subst_env E e).
203Proof.
204 revert e X. induction E using env_ind.
205 induction e; intros X Hcenv Hclosed; simplify_eq/=.
206 - done.
207 - rewrite subst_env_eq. case_match.
208 + destruct t as [Et et]; simpl.
209 apply closed_env_lookup in H0 as Htclosed; last done.
210 apply closed_thunk_eq in Htclosed as [HEtclosed Hetclosed].
211 apply (H _ _ H0); simpl.
212 * exact HEtclosed.
213 * eapply closed_weaken; set_solver.
214 + simpl in *. apply not_elem_of_dom in H0. set_solver.
215 - rewrite subst_env_eq. simpl in *.
216 rewrite comm_L -assoc_L in Hclosed.
217 apply IHe in Hclosed; last exact Hcenv.
218 apply subst_env_delete_closed; first done.
219 by rewrite comm_L.
220 - rewrite subst_env_eq. naive_solver.
221Qed.
222
223Lemma thunk_to_expr_closed t : closed_thunk t → closed ∅ (thunk_to_expr t).
224Proof.
225 destruct t as [E e]. intros [HEclosed Heclosed]%closed_thunk_eq.
226 by apply subst_env_closed; last rewrite union_empty_r_L.
227Qed.
228
229Lemma subst_env_insert E x e t :
230 closed_env E →
231 subst_env (<[x:=t]> E) e
232 = subst {[x:=thunk_to_expr t]} (subst_env (delete x E) e).
233Proof.
234 revert E. induction e; intros E HEclosed; simpl.
235 - done.
236 - destruct (decide (x = x0)) as [->|?].
237 + rewrite subst_env_eq lookup_insert subst_env_id
238 lookup_delete /= lookup_singleton. done.
239 + rewrite subst_env_eq lookup_insert_ne // subst_env_id.
240 destruct (E !! x0) eqn:Elookup.
241 * apply closed_env_lookup in Elookup as Hc0closed; last done.
242 apply thunk_to_expr_closed in Hc0closed.
243 rewrite lookup_delete_ne // Elookup.
244 by erewrite closed_subst with (E := ∅).
245 * by rewrite lookup_delete_ne // Elookup /= lookup_singleton_ne.
246 - rewrite (subst_env_eq (EAbs x0 e)) (subst_env_eq (EAbs _ _)) /=. f_equal.
247 destruct (decide (x0 = x)) as [->|?].
248 + by rewrite delete_insert_delete delete_idemp
249 delete_singleton subst_empty.
250 + rewrite delete_insert_ne // delete_singleton_ne // delete_commute.
251 apply IHe. by apply closed_env_delete.
252 - rewrite (subst_env_eq (EApp _ _)) [subst_env (delete x E) _]subst_env_eq /=.
253 f_equal; auto.
254Qed.
255
256Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' :
257 closed_env E1 → closed_env E2 →
258 subst_env (delete x E1) e1 = subst_env (delete x E2) e2 →
259 subst_env E1' e1' = subst_env E2' e2' →
260 subst_env (<[x:=Thunk E1' e1']> E1) e1
261 = subst_env (<[x:=Thunk E2' e2']> E2) e2.
262Proof.
263 intros HE1closed HE2closed He' He.
264 rewrite !subst_env_insert //=. by rewrite He' He.
265Qed.
266
267Lemma interp_closed n E e mv :
268 closed_env E → closed (dom E) e → interp n E e = Res mv →
269 if mv is Some v then closed_val v else True.
270Proof.
271 revert E e mv.
272 induction n; first done; intros E e mv HEclosed Heclosed Hinterp.
273 destruct e.
274 - rewrite interp_S /= in Hinterp. by destruct mv; simplify_res.
275 - rewrite interp_S /= in Hinterp. simplify_option_eq.
276 destruct (E !! x) eqn:Hlookup; simplify_res; try done.
277 apply closed_env_lookup in Hlookup; last assumption.
278 destruct t as [E' e']. apply closed_thunk_eq in Hlookup as [Henv Hexpr].
279 by apply IHn with (E := E') (e := e').
280 - rewrite interp_S /= in Hinterp. simplify_option_eq.
281 destruct mv as [v|]; simplify_res. split_and!.
282 + set_solver.
283 + done.
284 - rewrite interp_S /= in Hinterp. simplify_option_eq.
285 destruct Heclosed as [He1closed He2closed].
286 destruct (interp n E e1) as [[[]|]|] eqn:Einterp; simplify_res; try done.
287 apply IHn in Einterp; try done.
288 simpl in Einterp. destruct Einterp as [Hinterp1 Hinterp2].
289 apply IHn in Hinterp; first done.
290 + rewrite <-insert_delete_insert.
291 apply map_Forall_insert; first apply lookup_delete. split.
292 * by split.
293 * by apply closed_env_delete.
294 + by rewrite dom_insert_L.
295Qed.
296
297Lemma interp_proper n E1 E2 e1 e2 mv :
298 closed_env E1 → closed_env E2 →
299 closed (dom E1) e1 → closed (dom E2) e2 →
300 subst_env E1 e1 = subst_env E2 e2 →
301 interp n E1 e1 = Res mv →
302 ∃ mw m, interp m E2 e2 = Res mw ∧
303 val_to_expr <$> mv = val_to_expr <$> mw.
304Proof.
305 revert n E2 E1 e1 e2 mv. induction n as [|n IHn]; [done|].
306 intros E2. induction E2 as [E2 IH] using env_ind.
307 intros E1 e1 e2 mv HE1closed HE2closed He1closed He2closed Hsubst Hinterp.
308 destruct (id_or_not e1) as [[x ->]|?].
309 { rewrite interp_S /= in Hinterp.
310 destruct (E1 !! x) as [[E' e']|] eqn:Hx; simplify_eq/=;
311 last by apply not_elem_of_dom in Hx.
312 rewrite subst_env_id Hx in Hsubst.
313 apply closed_env_lookup in Hx; last done.
314 rewrite closed_thunk_eq in Hx.
315 destruct Hx as [HE'close He'closed].
316 eauto. }
317 destruct (id_or_not e2) as [[x ->]|?].
318 { rewrite subst_env_id in Hsubst.
319 destruct (E2 !! x) as [[E' e']|] eqn:Hx; simplify_eq/=.
320 - apply closed_env_lookup in Hx as Hclosed; last done.
321 rewrite closed_thunk_eq in Hclosed.
322 destruct Hclosed as [HE'closed He'closed].
323 rewrite map_Forall_lookup in IH.
324 odestruct (IH _ _ Hx) as (w & m & Hinterp' & Hw);
325 first apply HE1closed; try done.
326 exists w, (S m). by rewrite interp_S /= Hx /=.
327 - destruct mv as [v|].
328 + apply interp_not_id in Hinterp. by rewrite Hsubst in Hinterp.
329 + exists None, 1. by rewrite interp_S /= Hx. }
330 rewrite (subst_env_eq e1) (subst_env_eq e2) in Hsubst.
331 rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done.
332 - eexists (Some (VString _)), 1. by rewrite interp_S.
333 - eexists (Some (VClo _ _ _)), 1. split; first by rewrite interp_S.
334 by do 2 f_equal/=.
335 - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
336 destruct He1closed as [He1_1closed He1_2closed],
337 He2closed as [He2_1closed He2_2closed].
338 apply interp_closed in Hinterp' as Hclosed; [|done..].
339 eapply IHn with (e2 := e2_1) in Hinterp' as (mw' & m1 & Hinterp1 & ?);
340 try done.
341 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
342 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
343 destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
344 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
345 by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
346 destruct v', w'; simplify_eq/=.
347 eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp
348 as (w & m2 & Hinterp2 & ?).
349 + exists w, (S (m1 `max` m2)). rewrite interp_S /=.
350 rewrite (interp_le Hinterp1) /=; last lia.
351 rewrite (interp_le Hinterp2) /=; last lia. done.
352 + rewrite -insert_delete_insert.
353 apply map_Forall_insert; first apply lookup_delete.
354 split; first done. apply closed_env_delete. naive_solver.
355 + apply interp_closed in Hinterp1; [|done..].
356 rewrite /closed_val in Hinterp1. destruct Hinterp1 as [??].
357 by apply map_Forall_insert_2.
358 + rewrite dom_insert_L. naive_solver.
359 + rewrite dom_insert_L.
360 apply interp_closed in Hinterp1; [|done..].
361 rewrite /closed_val in Hinterp1. by destruct Hinterp1 as [_ ?].
362 + apply interp_closed in Hinterp1; [|done..].
363 rewrite /closed_val in Hinterp1. destruct Hinterp1 as [? _].
364 apply subst_env_insert_eq; try naive_solver.
365Qed.
366
367Lemma subst_as_subst_env x e1 e2 :
368 subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1.
369Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed.
370
371Lemma interp_subst n x e1 e2 mv :
372 closed {[x]} e1 → closed ∅ e2 →
373 interp n ∅ (subst {[x:=e2]} e1) = Res mv →
374 ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧
375 val_to_expr <$> mv = val_to_expr <$> mw.
376Proof.
377 intros He1 He2.
378 apply interp_proper.
379 - done.
380 - by apply closed_env_insert.
381 - apply subst_closed.
382 + by apply map_Forall_singleton.
383 + by rewrite dom_singleton_L dom_empty_L union_empty_r_L.
384 - by rewrite insert_empty dom_singleton_L.
385 - by rewrite subst_env_empty subst_as_subst_env.
386Qed.
387
388Lemma closed_step e1 e2 : closed ∅ e1 → e1 --> e2 → closed ∅ e2.
389Proof.
390 intros Hclosed Hstep. revert Hclosed.
391 induction Hstep; intros He1closed.
392 - simplify_eq/=. destruct He1closed.
393 apply subst_closed.
394 + by eapply map_Forall_singleton.
395 + by rewrite dom_singleton_L.
396 - simplify_eq/=. destruct He1closed. auto.
397Qed.
398
399Lemma closed_steps e1 e2 : closed ∅ e1 → e1 -->* e2 → closed ∅ e2.
400Proof. induction 2; eauto using closed_step. Qed.
401
402Lemma interp_step e1 e2 n v :
403 closed ∅ e1 →
404 e1 --> e2 →
405 interp n ∅ e2 = Res v →
406 ∃ w m, interp m ∅ e1 = Res w ∧ val_to_expr <$> v = val_to_expr <$> w.
407Proof.
408 intros He1closed Hstep. revert v n He1closed.
409 induction Hstep as [|???? IH]; intros v n He1closed Hinterp.
410 { rewrite /= union_empty_r_L in He1closed.
411 destruct He1closed as [He1closed He2closed].
412 apply interp_subst in Hinterp as (w & [|m] & Hinterp & Hv);
413 simplify_eq/=; [|done..].
414 exists w, (S (S m)). by rewrite !interp_S /= -interp_S. }
415 simpl in He1closed. destruct He1closed as [He1closed He2closed].
416 destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
417 destruct (interp n _ _) eqn:Hinterp'; simplify_res.
418 destruct x; simplify_res; last first.
419 { apply IH in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res; last done.
420 destruct mw'; try done. exists None, (S m1).
421 by rewrite interp_S /= Hinterp1. }
422 apply closed_step in Hstep as He1'closed; last done.
423 apply interp_closed in Hinterp' as Hcloclosed;
424 [|done|by rewrite dom_empty_L].
425 apply IH in Hinterp' as ([] & m1 & Hinterp1 & ?); simplify_eq/=; last done.
426 destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
427 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
428 by assert (maybe3 VClo v1 = None) as -> by (by destruct v1, v0). }
429 simplify_option_eq.
430 simpl in Hcloclosed. destruct Hcloclosed as [HEclosed Heclosed].
431 apply interp_closed in Hinterp1 as Hcloclosed;
432 [|done|by rewrite dom_empty_L]. simpl in Hcloclosed.
433 destruct v1; simplify_option_eq.
434 destruct Hcloclosed as [HE0closed He0closed].
435 eapply interp_proper with (E2 := <[x0:=Thunk ∅ e2]> E0) (e2 := e0)
436 in Hinterp as (w & m2 & Hinterp2 & Hv); last apply subst_env_insert_eq.
437 { exists w, (S (m1 `max` m2)). rewrite !interp_S /=.
438 rewrite (interp_le Hinterp1) /=; last lia.
439 by rewrite (interp_le Hinterp2) /=; last lia. }
440 - by apply closed_env_insert.
441 - by apply closed_env_insert.
442 - by rewrite dom_insert_L.
443 - by rewrite dom_insert_L.
444 - done.
445 - done.
446 - done.
447 - done.
448Qed.
449
450Lemma final_interp e :
451 final e →
452 ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w.
453Proof.
454 induction e; inv 1.
455 - eexists (VString _), 1. by rewrite interp_S /=.
456 - eexists (VClo _ _ _), 1. rewrite interp_S /=. split; [done|].
457 by rewrite delete_empty subst_env_empty.
458Qed.
459
460Lemma red_final_interp e :
461 red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail.
462Proof.
463 induction e.
464 - (* ENat *) right; left. constructor.
465 - (* EId *) do 2 right. by exists 1.
466 - (* EAbs *) right; left. constructor.
467 - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
468 + left. by repeat econstructor.
469 + apply final_interp in Hfinal as (w & m & Hinterp & ->).
470 destruct (maybe3 VClo w) eqn:Hw.
471 { destruct w; simplify_eq/=. left. by repeat econstructor. }
472 do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw.
473 + do 2 right. exists (S m). by rewrite interp_S /= Hinterp.
474Qed.
475
476Lemma interp_complete e1 e2 :
477 closed ∅ e1 →
478 e1 -->* e2 →
479 nf step e2 →
480 ∃ mw m, interp m ∅ e1 = Res mw ∧
481 if mw is Some w then e2 = val_to_expr w else ¬final e2.
482Proof.
483 intros He1 Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH].
484 { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..].
485 - apply final_interp in Hfinal as (w & m & ? & ?).
486 by exists (Some w), m.
487 - exists None, m. split; [done|]. intros Hfinal.
488 apply final_interp in Hfinal as (w & m' & ? & _).
489 by assert (mfail = mret w) by eauto using interp_agree. }
490 apply closed_step in Hstep as He2; last assumption.
491 destruct IH as (mw & m & Hinterp & ?); try done.
492 eapply interp_step in Hinterp as (mw' & m' & ? & ?).
493 - destruct mw, mw'; naive_solver.
494 - done.
495 - done.
496Qed.
497
498Lemma interp_complete_ret e1 e2 :
499 closed ∅ e1 →
500 e1 -->* e2 → final e2 →
501 ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w.
502Proof.
503 intros Hclosed Hsteps Hfinal. apply interp_complete in Hsteps
504 as ([w|] & m & ? & ?); naive_solver eauto using final_nf.
505Qed.
506Lemma interp_complete_fail e1 e2 :
507 closed ∅ e1 →
508 e1 -->* e2 → nf step e2 → ¬final e2 →
509 ∃ m, interp m ∅ e1 = mfail.
510Proof.
511 intros Hclosed Hsteps Hnf Hforce.
512 apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto.
513 destruct Hforce. apply final_val_to_expr.
514Qed.
515
516Lemma interp_sound_open E e n mv :
517 closed_env E → closed (dom E) e →
518 interp n E e = Res mv →
519 ∃ e', subst_env E e -->* e' ∧
520 if mv is Some v then e' = val_to_expr v else stuck e'.
521Proof.
522 revert E e mv.
523 induction n as [|n IH]; intros E e mv HEclosed Heclosed Hinterp; first done.
524 rewrite subst_env_eq. rewrite interp_S in Hinterp.
525 destruct e; simplify_res.
526 - (* ENat *) by eexists.
527 - (* EId *) destruct (_ !! _) as [[E' e]|] eqn:Hx; simplify_res.
528 + apply closed_env_lookup in Hx as Hxclosed; last done.
529 rewrite closed_thunk_eq in Hxclosed. destruct_and!.
530 apply IH in Hinterp as (e' & Hsteps & He'); naive_solver.
531 + eexists; repeat split; [done| |inv 1]. intros [? Hstep]. inv Hstep.
532 - (* EAbs *) by eexists.
533 - (* EApp *) destruct_and!.
534 destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res.
535 apply interp_closed in Hinterp' as Hvclosed; [|done..].
536 apply IH in Hinterp' as (e' & Hsteps & He'); [|done..].
537 destruct mv' as [v'|]; simplify_res; last first.
538 { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
539 intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
540 inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. }
541 destruct (maybe3 VClo v') eqn:?; simplify_res; last first.
542 { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
543 intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. }
544 destruct v'; simplify_res. destruct_and!.
545 apply IH in Hinterp as (e'' & Hsteps' & He'').
546 + eexists; split; [|done]. etrans; [by apply SAppL_rtc|].
547 eapply rtc_l; first by constructor.
548 rewrite subst_env_insert // in Hsteps'.
549 + by apply closed_env_insert.
550 + by rewrite dom_insert_L.
551Qed.
552
553Lemma interp_sound n e mv :
554 closed ∅ e →
555 interp n ∅ e = Res mv →
556 ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'.
557Proof.
558 intros He Hsteps%interp_sound_open; try done.
559 by rewrite subst_env_empty in Hsteps.
560Qed.
561
562(** Final theorems *)
563Theorem interp_sound_complete_ret e v :
564 closed ∅ e →
565 (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w)
566 ↔ e -->* val_to_expr v.
567Proof.
568 split.
569 - by intros (n & w & (e' & ? & ->)%interp_sound & ->).
570 - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?);
571 unfold nf, red;
572 naive_solver eauto using final_val_to_expr, step_not_val_to_expr.
573Qed.
574
575Theorem interp_sound_complete_ret_string e s :
576 closed ∅ e →
577 (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s.
578Proof.
579 split.
580 - by intros [n (e' & ? & ->)%interp_sound].
581 - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?);
582 simplify_eq/=; eauto.
583Qed.
584
585Theorem interp_sound_complete_fail e :
586 closed ∅ e →
587 (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'.
588Proof.
589 split.
590 - by intros [n ?%interp_sound].
591 - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail.
592Qed.
593
594Theorem interp_sound_complete_no_fuel e :
595 closed ∅ e →
596 (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e.
597Proof.
598 rewrite all_loop_alt. split.
599 - intros Hnofuel e' Hsteps.
600 destruct (red_final_interp e') as [|[|He']]; [done|..].
601 + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); [|done..].
602 by rewrite Hnofuel in Hinterp.
603 + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]);
604 last by eauto using closed_steps.
605 destruct (interp_complete e e'') as (mv & n & Hinterp & _); [done|by etrans|done|].
606 by rewrite Hnofuel in Hinterp.
607 - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done].
608 apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck); [|done].
609 destruct mv as [v|]; simplify_eq/=.
610 + apply final_nf in Hsteps as []. apply final_val_to_expr.
611 + by destruct Hstuck as [[] ?].
612Qed.
613
614End lambda.
diff --git a/theories/lambda/operational.v b/theories/lambda/operational.v
new file mode 100644
index 0000000..b0fa366
--- /dev/null
+++ b/theories/lambda/operational.v
@@ -0,0 +1,38 @@
1From mininix Require Export utils.
2From stdpp Require Import options.
3
4Module Import lambda.
5
6Inductive expr :=
7 | EString (s : string)
8 | EId (x : string)
9 | EAbs (x : string) (e : expr)
10 | EApp (e1 e2 : expr).
11
12Fixpoint subst (ds : gmap string expr) (e : expr) : expr :=
13 match e with
14 | EString s => EString s
15 | EId x => if ds !! x is Some d then d else EId x
16 | EAbs x e => EAbs x (subst (delete x ds) e)
17 | EApp e1 e2 => EApp (subst ds e1) (subst ds e2)
18 end.
19
20Reserved Infix "-->" (right associativity, at level 55).
21Inductive step : expr → expr → Prop :=
22 | Sβ x e1 e2 : EApp (EAbs x e1) e2 --> subst {[x:=e2]} e1
23 | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2
24where "e1 --> e2" := (step e1 e2).
25
26Infix "-->*" := (rtc step) (right associativity, at level 55).
27
28Definition final (e : expr) : Prop :=
29 match e with
30 | EString _ => True
31 | EAbs _ _ => True
32 | _ => False
33 end.
34
35Definition stuck (e : expr) : Prop :=
36 nf step e ∧ ¬final e.
37
38End lambda.
diff --git a/theories/lambda/operational_props.v b/theories/lambda/operational_props.v
new file mode 100644
index 0000000..c331924
--- /dev/null
+++ b/theories/lambda/operational_props.v
@@ -0,0 +1,29 @@
1From mininix Require Export lambda.operational.
2From stdpp Require Import options.
3
4Module Import lambda.
5Export lambda.
6
7(** Properties of operational semantics *)
8Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1.
9Proof. induction 1; inv 1; naive_solver. Qed.
10Lemma final_nf e : final e → nf step e.
11Proof. by intros ? [??%step_not_final]. Qed.
12
13Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2.
14Proof. induction 1; repeat (done || econstructor). Qed.
15
16Ltac inv_step := repeat
17 match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end.
18
19Lemma step_det e d1 d2 :
20 e --> d1 →
21 e --> d2 →
22 d1 = d2.
23Proof.
24 intros Hred1. revert d2.
25 induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step.
26 f_equal. by apply IHHred1.
27Qed.
28
29End lambda.
diff --git a/theories/nix/floats.v b/theories/nix/floats.v
new file mode 100644
index 0000000..246e0c3
--- /dev/null
+++ b/theories/nix/floats.v
@@ -0,0 +1,85 @@
1From stdpp Require Import prelude ssreflect.
2From Flocq.IEEE754 Require Import
3 Binary BinarySingleNaN (mode_NE, mode_DN, mode_UP) Bits.
4From stdpp Require Import options.
5
6Global Arguments B754_zero {_ _}.
7Global Arguments B754_infinity {_ _}.
8Global Arguments B754_nan {_ _}.
9Global Arguments B754_finite {_ _}.
10
11(** The bit representation of floats is not observable in Nix, and it appears
12that only negative NaNs are ever produced. So we setup the Flocq floats in
13the way that it always produces [-NaN], i.e., [indef_nan]. *)
14Definition float := binary64.
15
16Variant round_mode := Floor | Ceil | NearestEven.
17Global Instance round_mode_eq_dec : EqDecision round_mode.
18Proof. solve_decision. Defined.
19
20Module Float.
21 Definition prec : Z := 53.
22 Definition emax : Z := 1024.
23
24 Lemma Hprec : (0 < 53)%Z.
25 Proof. done. Qed.
26 Lemma Hprec_emax : (53 < 1024)%Z.
27 Proof. done. Qed.
28
29 Global Instance inhabited : Inhabited float := populate (B754_zero false).
30
31 Global Instance eq_dec : EqDecision float.
32 Proof.
33 refine (λ f1 f2,
34 match f1, f2 with
35 | B754_zero s1, B754_zero s2 => cast_if (decide (s1 = s2))
36 | B754_infinity s1, B754_infinity s2 => cast_if (decide (s1 = s2))
37 | B754_nan s1 pl1 _, B754_nan s2 pl2 _ =>
38 cast_if_and (decide (s1 = s2)) (decide (pl1 = pl2))
39 | B754_finite s1 m1 e1 _, B754_finite s2 m2 e2 _ =>
40 cast_if_and3 (decide (s1 = s2)) (decide (m1 = m2)) (decide (e1 = e2))
41 | _, _ => right _
42 end); abstract naive_solver (f_equal; apply (proof_irrel _)).
43 Defined.
44
45 Definition of_Z (x : Z) : float :=
46 binary_normalize prec emax (refl_equal _) (refl_equal _) mode_NE x 0 false.
47
48 Definition to_Z (f : float) : option Z :=
49 match f with
50 | B754_zero _ => Some 0
51 | B754_finite s m e _ => Some (Zaux.cond_Zopp s (Zpos m) ≪ e)
52 | _ => None
53 end%Z.
54
55 (** QNaN Floating-Point Indefinite; see Table 4-3. Floating-Point Number and
56 NaN Encodings. *)
57 Definition indef_nan : { f | is_nan prec emax f = true } :=
58 @B754_nan prec emax true (2^51) (refl_equal _) ↾ eq_refl _.
59
60 Definition to_flocq_round_mode (m : round_mode) : BinarySingleNaN.mode :=
61 match m with Floor => mode_DN | Ceil => mode_UP | NearestEven => mode_NE end.
62
63 Definition round (m : round_mode) : float → float :=
64 Bnearbyint prec emax (refl_equal _) (λ _, indef_nan) (to_flocq_round_mode m).
65
66 (* For add: not [mode_DN]; otherwise [+0.0 + -0.0] would yield [-0.0], but
67 [inf / (+0.0 + -0.0)] yields [inf] in C++, so this cannot be the case. *)
68 (* C++ compiles floating point addition to the x86 ADDSD instruction. Looking
69 at the Intel x86 Software Developer's Manual, it seems that the default
70 rounding mode on x86 is Round to Nearest (even); see table 4-8. (In §4.8.4.) *)
71 Definition add : float → float → float :=
72 Bplus _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE.
73 Definition sub : float → float → float :=
74 Bminus _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE.
75 Definition mul : float → float → float :=
76 Bmult _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE.
77 Definition div : float → float → float :=
78 Bdiv _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE.
79
80 Definition eqb (f1 f2 : float) : bool :=
81 bool_decide (b64_compare f1 f2 = Some Eq).
82
83 Definition ltb (f1 f2 : float) : bool :=
84 bool_decide (b64_compare f1 f2 = Some Lt).
85End Float.
diff --git a/theories/nix/interp.v b/theories/nix/interp.v
new file mode 100644
index 0000000..bb4e815
--- /dev/null
+++ b/theories/nix/interp.v
@@ -0,0 +1,351 @@
1From Coq Require Import Ascii.
2From mininix Require Export res nix.operational_props.
3From stdpp Require Import options.
4
5Section val.
6 Local Unset Elimination Schemes.
7 Inductive val :=
8 | VLit (bl : base_lit) (Hbl : base_lit_ok bl)
9 | VClo (x : string) (E : gmap string (kind * thunk)) (e : expr)
10 | VCloMatch (E : gmap string (kind * thunk))
11 (ms : gmap string (option expr))
12 (strict : bool) (e : expr)
13 | VList (ts : list thunk)
14 | VAttr (ts : gmap string thunk)
15 with thunk :=
16 | Forced (v : val) : thunk
17 | Thunk (E : gmap string (kind * thunk)) (e : expr) : thunk
18 | Indirect (x : string)
19 (E : gmap string (kind * thunk))
20 (tαs : gmap string (expr + thunk)).
21End val.
22
23Notation VLitI bl := (VLit bl I).
24
25Notation tattr := (expr + thunk)%type.
26Notation env := (gmap string (kind * thunk)).
27
28Definition maybe_VLit (v : val) : option base_lit :=
29 if v is VLit bl _ then Some bl else None.
30Global Instance maybe_VList : Maybe VList := λ v,
31 if v is VList ts then Some ts else None.
32Global Instance maybe_VAttr : Maybe VAttr := λ v,
33 if v is VAttr ts then Some ts else None.
34
35Fixpoint interp_eq_list_body (i : nat) (ts1 ts2 : list thunk) : expr :=
36 match ts1, ts2 with
37 | [], [] => ELit (LitBool true)
38 | _ :: ts1, _ :: ts2 =>
39 EIf (EBinOp EqOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i)))
40 (interp_eq_list_body (S i) ts1 ts2) (ELit (LitBool false))
41 | _, _ => ELit (LitBool false)
42 end.
43
44Definition interp_eq_list (ts1 ts2 : list thunk) : thunk :=
45 Thunk (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪
46 kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2)) $
47 interp_eq_list_body 0 ts1 ts2.
48
49Fixpoint interp_lt_list_body (i : nat) (ts1 ts2 : list thunk) : expr :=
50 match ts1, ts2 with
51 | [], _ => ELit (LitBool true)
52 | _ :: ts1, _ :: ts2 =>
53 EIf (EBinOp LtOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i)))
54 (ELit (LitBool true))
55 (EIf (EBinOp EqOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i)))
56 (interp_lt_list_body (S i) ts1 ts2) (ELit (LitBool false)))
57 | _ :: _, [] => ELit (LitBool false)
58 end.
59
60Definition interp_lt_list (ts1 ts2 : list thunk) : thunk :=
61 Thunk (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪
62 kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2)) $
63 interp_lt_list_body 0 ts1 ts2.
64
65Definition interp_eq_attr (ts1 ts2 : gmap string thunk) : thunk :=
66 Thunk (kmap (String "1") ((ABS,.) <$> ts1) ∪
67 kmap (String "2") ((ABS,.) <$> ts2)) $
68 sem_and_attr $ map_imap (λ x _,
69 Some (EBinOp EqOp (EId' ("1" +:+ x)) (EId' ("2" +:+ x)))) ts1.
70
71Definition interp_eq (v1 v2 : val) : option thunk :=
72 match v1, v2 with
73 | VLit bl1 _, VLit bl2 _ =>
74 Some $ Forced $ VLitI (LitBool $ sem_eq_base_lit bl1 bl2)
75 | VClo _ _ _, VClo _ _ _ => None
76 | VList ts1, VList ts2 => Some $
77 if decide (length ts1 = length ts2) then interp_eq_list ts1 ts2
78 else Forced $ VLitI (LitBool false)
79 | VAttr ts1, VAttr ts2 => Some $
80 if decide (dom ts1 = dom ts2) then interp_eq_attr ts1 ts2
81 else Forced $ VLitI (LitBool false)
82 | _, _ => Some $ Forced $ VLitI (LitBool false)
83 end.
84
85Definition type_of_val (v : val) : string :=
86 match v with
87 | VLit bl _ => type_of_base_lit bl
88 | VClo _ _ _ | VCloMatch _ _ _ _ => "lambda"
89 | VList _ => "list"
90 | VAttr _ => "set"
91 end.
92
93Global Instance val_inhabited : Inhabited val := populate (VLitI inhabitant).
94Global Instance thunk_inhabited : Inhabited thunk := populate (Forced inhabitant).
95
96Definition interp_bin_op (op : bin_op) (v1 : val) : option (val → option thunk) :=
97 if decide (op = EqOp) then
98 Some (interp_eq v1)
99 else if decide (op = TypeOfOp) then
100 Some $ λ v2,
101 guard (maybe_VLit v2 = Some LitNull);;
102 Some $ Forced $ VLitI (LitString $ type_of_val v1)
103 else
104 match v1 with
105 | VLit (LitNum n1) Hn1 =>
106 if maybe RoundOp op is Some m then
107 Some $ λ v2,
108 guard (maybe_VLit v2 = Some LitNull);;
109 Some $ Forced $ VLit
110 (LitNum $ NInt $ float_to_bounded_Z $ Float.round m $ num_to_float n1)
111 (float_to_bounded_Z_ok _)
112 else
113 '(f ↾ Hf) ← option_to_eq_Some (sem_bin_op_num op n1);
114 Some $ λ v2,
115 if v2 is VLit (LitNum n2) Hn2 then
116 '(bl ↾ Hbl) ← option_to_eq_Some (f n2);
117 Some $ Forced $ VLit bl (sem_bin_op_num_ok Hn1 Hn2 Hf Hbl)
118 else None
119 | VLit (LitString s1) _ =>
120 match op with
121 | SingletonAttrOp => Some $ λ v2,
122 guard (maybe_VLit v2 = Some LitNull);;
123 Some $ Forced $ VClo "t" ∅ (EAttr {[ s1 := AttrN (EId' "t") ]})
124 | MatchStringOp => Some $ λ v2,
125 guard (maybe_VLit v2 = Some LitNull);;
126 match s1 with
127 | EmptyString => Some $ Forced $ VAttr {[
128 "empty" := Forced (VLitI (LitBool true));
129 "head" := Forced (VLitI LitNull);
130 "tail" := Forced (VLitI LitNull) ]}
131 | String a s1 => Some $ Forced $ VAttr {[
132 "empty" := Forced (VLitI (LitBool false));
133 "head" := Forced (VLitI (LitString (String a EmptyString)));
134 "tail" := Forced (VLitI (LitString s1)) ]}
135 end
136 | _ =>
137 '(f ↾ Hf) ← option_to_eq_Some (sem_bin_op_string op);
138 Some $ λ v2,
139 bl2 ← maybe_VLit v2;
140 s2 ← maybe LitString bl2;
141 Some $ Forced $ VLit (f s1 s2) (sem_bin_op_string_ok Hf)
142 end
143 | VClo _ _ _ =>
144 match op with
145 | FunctionArgsOp => Some $ λ v2,
146 guard (maybe_VLit v2 = Some LitNull);;
147 Some (Forced (VAttr ∅))
148 | _ => None
149 end
150 | VCloMatch _ ms _ _ =>
151 match op with
152 | FunctionArgsOp => Some $ λ v2,
153 guard (maybe_VLit v2 = Some LitNull);;
154 Some $ Forced $ VAttr $
155 (λ m, Forced $ VLitI (LitBool (from_option (λ _, true) false m))) <$> ms
156 | _ => None
157 end
158 | VList ts1 =>
159 match op with
160 | LtOp => Some $ λ v2,
161 ts2 ← maybe VList v2;
162 Some (interp_lt_list ts1 ts2)
163 | MatchListOp => Some $ λ v2,
164 guard (maybe_VLit v2 = Some LitNull);;
165 match ts1 with
166 | [] => Some $ Forced $ VAttr {[
167 "empty" := Forced (VLitI (LitBool true));
168 "head" := Forced (VLitI LitNull);
169 "tail" := Forced (VLitI LitNull) ]}
170 | t :: ts1 => Some $ Forced $ VAttr {[
171 "empty" := Forced (VLitI (LitBool false));
172 "head" := t;
173 "tail" := Forced (VList ts1) ]}
174 end
175 | AppendListOp => Some $ λ v2,
176 ts2 ← maybe VList v2;
177 Some (Forced (VList (ts1 ++ ts2)))
178 | _ => None
179 end
180 | VAttr ts1 =>
181 match op with
182 | SelectAttrOp => Some $ λ v2,
183 bl ← maybe_VLit v2;
184 x ← maybe LitString bl;
185 ts1 !! x
186 | UpdateAttrOp => Some $ λ v2,
187 ts2 ← maybe VAttr v2;
188 Some $ Forced $ VAttr $ ts2 ∪ ts1
189 | HasAttrOp => Some $ λ v2,
190 bl ← maybe_VLit v2;
191 x ← maybe LitString bl;
192 Some $ Forced $ VLitI (LitBool $ bool_decide (is_Some (ts1 !! x)))
193 | DeleteAttrOp => Some $ λ v2,
194 bl ← maybe_VLit v2;
195 x ← maybe LitString bl;
196 Some $ Forced $ VAttr $ delete x ts1
197 | MatchAttrOp => Some $ λ v2,
198 guard (maybe_VLit v2 = Some LitNull);;
199 match map_minimal_key attr_le ts1 with
200 | None => Some $ Forced $ VAttr {[
201 "empty" := Forced (VLitI (LitBool true));
202 "key" := Forced (VLitI LitNull);
203 "head" := Forced (VLitI LitNull);
204 "tail" := Forced (VLitI LitNull) ]}
205 | Some x => Some $ Forced $ VAttr {[
206 "empty" := Forced (VLitI (LitBool false));
207 "key" := Forced (VLitI (LitString x));
208 "head" := ts1 !!! x;
209 "tail" := Forced (VAttr (delete x ts1)) ]}
210 end
211 | _ => None
212 end
213 | _ => None
214 end.
215
216Definition interp_match
217 (ts : gmap string thunk) (mds : gmap string (option expr))
218 (strict : bool) : option (gmap string tattr) :=
219 map_mapM id $ merge (λ mt mmd,
220 (* Some (Some _) means keep, Some None means fail, None means skip *)
221 match mt, mmd with
222 | Some t, Some _ => Some $ Some (inr t)
223 | None, Some (Some e) => Some $ Some (inl e)
224 | None, Some _ => Some None (* bad *)
225 | Some _, None => guard strict;; Some None
226 | _, _ => None (* skip *)
227 end) ts mds.
228
229Definition force_deep1
230 (force_deep : val → res val)
231 (interp_thunk : thunk → res val) (v : val) : res val :=
232 match v with
233 | VList ts => VList ∘ fmap Forced <$>
234 mapM (mbind force_deep ∘ interp_thunk) ts
235 | VAttr ts => VAttr ∘ fmap Forced <$>
236 map_mapM_sorted attr_le (mbind force_deep ∘ interp_thunk) ts
237 | _ => mret v
238 end.
239
240Definition indirects_env (E : env) (tαs : gmap string tattr) : env :=
241 map_imap (λ y _, Some (ABS, Indirect y E tαs)) tαs ∪ E.
242
243Definition attr_to_tattr (E : env) (α : attr) : tattr :=
244 from_attr inl (inr ∘ Thunk E) α.
245
246Definition interp1
247 (force_deep : val → res val)
248 (interp : env → expr → res val)
249 (interp_thunk : thunk → res val)
250 (interp_app : val → thunk → res val)
251 (E : env) (e : expr) : res val :=
252 match e with
253 | ELit bl =>
254 bl_ok ← guard (base_lit_ok bl);
255 mret (VLit bl bl_ok)
256 | EId x mke =>
257 '(_,t) ← Res $ union_kinded (E !! x) (prod_map id (Thunk ∅) <$> mke);
258 interp_thunk t
259 | EAbs x e => mret (VClo x E e)
260 | EAbsMatch ms strict e => mret (VCloMatch E ms strict e)
261 | EApp e1 e2 =>
262 v1 ← interp E e1;
263 interp_app v1 (Thunk E e2)
264 | ESeq μ' e1 e2 =>
265 v ← interp E e1;
266 (if μ' is DEEP then force_deep else mret) v;;
267 interp E e2
268 | EList es => mret (VList (Thunk E <$> es))
269 | EAttr αs =>
270 let E' := indirects_env E (attr_to_tattr E <$> αs) in
271 mret (VAttr (from_attr (Thunk E') (Thunk E) <$> αs))
272 | ELetAttr k e1 e2 =>
273 v1 ← interp E e1;
274 ts ← Res (maybe VAttr v1);
275 interp (union_kinded ((k,.) <$> ts) E) e2
276 | EBinOp op e1 e2 =>
277 v1 ← interp E e1;
278 f ← Res (interp_bin_op op v1);
279 v2 ← interp E e2;
280 t2 ← Res (f v2);
281 interp_thunk t2
282 | EIf e1 e2 e3 =>
283 v1 ← interp E e1;
284 '(b : bool) ← Res (maybe_VLit v1 ≫= maybe LitBool);
285 interp E (if b then e2 else e3)
286 end.
287
288Definition interp_thunk1
289 (interp : env → expr → res val)
290 (interp_thunk : thunk → res val)
291 (t : thunk) : res val :=
292 match t with
293 | Forced v => mret v
294 | Thunk E e => interp E e
295 | Indirect x E tαs =>
296 tα ← Res $ tαs !! x;
297 match tα with
298 | inl e => interp (indirects_env E tαs) e
299 | inr t => interp_thunk t
300 end
301 end.
302
303Definition interp_app1
304 (interp : env → expr → res val)
305 (interp_thunk : thunk → res val)
306 (interp_app : val → thunk → res val)
307 (v1 : val) (t2 : thunk) : res val :=
308 match v1 with
309 | VClo x E e =>
310 interp (<[x:=(ABS, t2)]> E) e
311 | VCloMatch E ms strict e =>
312 vt ← interp_thunk t2;
313 ts ← Res (maybe VAttr vt);
314 tαs ← Res $ interp_match ts ms strict;
315 interp (indirects_env E tαs) e
316 | VAttr ts =>
317 t ← Res (ts !! "__functor");
318 vt ← interp_thunk t;
319 v ← interp_app vt (Forced v1);
320 interp_app v t2
321 | _ => mfail
322 end.
323
324Fixpoint force_deep (n : nat) (v : val) : res val :=
325 match n with
326 | O => NoFuel
327 | S n => force_deep1 (force_deep n) (interp_thunk n) v
328 end
329with interp (n : nat) (E : env) (e : expr) : res val :=
330 match n with
331 | O => NoFuel
332 | S n => interp1 (force_deep n) (interp n) (interp_thunk n) (interp_app n) E e
333 end
334with interp_thunk (n : nat) (t : thunk) : res val :=
335 match n with
336 | O => NoFuel
337 | S n => interp_thunk1 (interp n) (interp_thunk n) t
338 end
339with interp_app (n : nat) (v1 : val) (t2 : thunk) : res val :=
340 match n with
341 | O => NoFuel
342 | S n => interp_app1 (interp n) (interp_thunk n) (interp_app n) v1 t2
343 end.
344
345Definition force_deep' (n : nat) (μ : mode) : val → res val :=
346 match μ with SHALLOW => mret | DEEP => force_deep n end.
347
348Definition interp' (n : nat) (μ : mode) (E : env) (e : expr) : res val :=
349 interp n E e ≫= force_deep' n μ.
350
351Global Opaque force_deep interp interp_thunk interp_app.
diff --git a/theories/nix/interp_proofs.v b/theories/nix/interp_proofs.v
new file mode 100644
index 0000000..5780e48
--- /dev/null
+++ b/theories/nix/interp_proofs.v
@@ -0,0 +1,2690 @@
1From Coq Require Import Ascii.
2From mininix Require Export nix.interp.
3From stdpp Require Import options.
4
5Lemma force_deep_S n :
6 force_deep (S n) = force_deep1 (force_deep n) (interp_thunk n).
7Proof. done. Qed.
8Lemma interp_S n :
9 interp (S n) = interp1 (force_deep n) (interp n) (interp_thunk n) (interp_app n).
10Proof. done. Qed.
11Lemma interp_thunk_S n :
12 interp_thunk (S n) = interp_thunk1 (interp n) (interp_thunk n).
13Proof. done. Qed.
14Lemma interp_app_S n :
15 interp_app (S n) = interp_app1 (interp n) (interp_thunk n) (interp_app n).
16Proof. done. Qed.
17
18Lemma interp_shallow' m E e : interp' m SHALLOW E e = interp m E e.
19Proof. rewrite /interp'. by destruct (interp _ _ _) as [[]|]. Qed.
20
21Lemma interp_lit n E bl (Hbl : base_lit_ok bl) :
22 interp (S n) E (ELit bl) = mret (VLit bl Hbl).
23Proof.
24 rewrite interp_S /=. case_guard; simpl; [|done].
25 do 2 f_equal. apply (proof_irrel _).
26Qed.
27
28(** Induction *)
29Fixpoint val_size (v : val) : nat :=
30 match v with
31 | VLit _ _ => 1
32 | VClo _ E _ | VCloMatch E _ _ _ => S (map_sum_with (thunk_size ∘ snd) E)
33 | VList ts => S (sum_list_with thunk_size ts)
34 | VAttr ts => S (map_sum_with thunk_size ts)
35 end
36with thunk_size (t : thunk) : nat :=
37 match t with
38 | Forced v => S (val_size v)
39 | Thunk E _ => S (map_sum_with (thunk_size ∘ snd) E)
40 | Indirect _ E tαs => S (map_sum_with (thunk_size ∘ snd) E +
41 map_sum_with (from_sum (λ _, 1) thunk_size) tαs)
42 end.
43Notation env_size := (map_sum_with (thunk_size ∘ snd)).
44
45Definition from_thunk {A} (f : val → A) (g : env → expr → A)
46 (h : string → env → gmap string tattr → A) (t : thunk) : A :=
47 match t with
48 | Forced v => f v
49 | Thunk E e => g E e
50 | Indirect x E tαs => h x E tαs
51 end.
52
53Lemma env_val_ind (P : env → Prop) (Q : val → Prop) :
54 (∀ E,
55 map_Forall (λ _, from_thunk Q (λ E _, P E) (λ _ E _, P E) ∘ snd) E → P E) →
56 (∀ b Hbl, Q (VLit b Hbl)) →
57 (∀ x E e, P E → Q (VClo x E e)) →
58 (∀ E ms strict e, P E → Q (VCloMatch E ms strict e)) →
59 (∀ ts, Forall (from_thunk Q (λ E _, P E) (λ _ E _, P E)) ts → Q (VList ts)) →
60 (∀ ts, map_Forall (λ _, from_thunk Q (λ E _, P E) (λ _ E _, P E)) ts → Q (VAttr ts)) →
61 (∀ E, P E) ∧ (∀ v, Q v).
62Proof.
63 intros Penv Qlit Qclo Qmatch Qlist Qattr.
64 cut (∀ n, (∀ E, env_size E < n → P E) ∧ (∀ v, val_size v < n → Q v)).
65 { intros Hhelp; split.
66 - intros E. apply (Hhelp (S (env_size E))); lia.
67 - intros v. apply (Hhelp (S (val_size v))); lia. }
68 intros n. induction n as [|n IH]; [by auto with lia|]. split.
69 - intros E ?. apply Penv, map_Forall_lookup=> y [k ei] Hy.
70 apply (map_sum_with_lookup_le (thunk_size ∘ snd)) in Hy; simpl in *.
71 destruct ei as [v|E' e'|x E' tαs]; simplify_eq/=; try apply IH; eauto with lia.
72 - intros [] ?; simpl in *.
73 + apply Qlit.
74 + apply Qclo, IH. lia.
75 + apply Qmatch, IH. lia.
76 + apply Qlist, Forall_forall=> t Hy.
77 apply (sum_list_with_in _ thunk_size) in Hy.
78 destruct t; simpl in *; try apply IH; lia.
79 + apply Qattr, map_Forall_lookup=> y t Hy.
80 apply (map_sum_with_lookup_le thunk_size) in Hy.
81 destruct t; simpl in *; try apply IH; lia.
82Qed.
83
84Lemma env_ind (P : env → Prop) :
85 (∀ E,
86 map_Forall (λ i, from_thunk (λ _, True) (λ E _, P E) (λ _ E _, P E) ∘ snd) E →
87 P E) →
88 ∀ E : env, P E.
89Proof. intros. apply (env_val_ind P (λ _, True)); auto. Qed.
90
91Lemma val_ind (Q : val → Prop) :
92 (∀ bl Hbl, Q (VLit bl Hbl)) →
93 (∀ x E e, Q (VClo x E e)) →
94 (∀ ms strict E e, Q (VCloMatch ms strict E e)) →
95 (∀ ts, Forall (from_thunk Q (λ _ _, True) (λ _ _ _, True)) ts → Q (VList ts)) →
96 (∀ ts,
97 map_Forall (λ _, from_thunk Q (λ _ _, True) (λ _ _ _, True)) ts → Q (VAttr ts)) →
98 (∀ v, Q v).
99Proof. intros. apply (env_val_ind (λ _, True) Q); auto. Qed.
100(** Correspondence to operational semantics *)
101Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr :=
102 subst (prod_map id thunk_to_expr <$> E).
103
104Definition tattr_to_attr'
105 (thunk_to_expr : thunk → expr) (subst_env : env → expr → expr)
106 (E : env) (α : tattr) : attr :=
107 from_sum (AttrR ∘ subst_env E) (AttrN ∘ thunk_to_expr) α.
108
109Fixpoint thunk_to_expr (t : thunk) : expr :=
110 match t with
111 | Forced v => val_to_expr v
112 | Thunk E e => subst_env' thunk_to_expr E e
113 | Indirect x E tαs => ESelect
114 (EAttr (tattr_to_attr' thunk_to_expr (subst_env' thunk_to_expr) E <$> tαs)) x
115 end
116with val_to_expr (v : val) : expr :=
117 match v with
118 | VLit bl _ => ELit bl
119 | VClo x E e => EAbs x (subst_env' thunk_to_expr E e)
120 | VCloMatch E ms strict e => EAbsMatch
121 (fmap (M:=option) (subst_env' thunk_to_expr E) <$> ms)
122 strict
123 (subst_env' thunk_to_expr E e)
124 | VList ts => EList (thunk_to_expr <$> ts)
125 | VAttr ts => EAttr (AttrN ∘ thunk_to_expr <$> ts)
126 end.
127
128Notation subst_env := (subst_env' thunk_to_expr).
129Notation tattr_to_attr := (tattr_to_attr' thunk_to_expr subst_env).
130Notation attr_subst_env E := (attr_map (subst_env E)).
131
132Lemma subst_env_eq e E :
133 subst_env E e =
134 match e with
135 | ELit n => ELit n
136 | EId x mkd => EId x $
137 union_kinded (prod_map id thunk_to_expr <$> E !! x) mkd
138 | EAbs x e => EAbs x (subst_env E e)
139 | EAbsMatch ms strict e =>
140 EAbsMatch (fmap (M:=option) (subst_env E) <$> ms) strict (subst_env E e)
141 | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2)
142 | ESeq μ e1 e2 => ESeq μ (subst_env E e1) (subst_env E e2)
143 | EList es => EList (subst_env E <$> es)
144 | EAttr αs => EAttr (attr_subst_env E <$> αs)
145 | ELetAttr k e1 e2 => ELetAttr k (subst_env E e1) (subst_env E e2)
146 | EBinOp op e1 e2 => EBinOp op (subst_env E e1) (subst_env E e2)
147 | EIf e1 e2 e3 => EIf (subst_env E e1) (subst_env E e2) (subst_env E e3)
148 end.
149Proof. rewrite /subst_env. destruct e; by rewrite /= ?lookup_fmap. Qed.
150
151Lemma subst_env_alt E e : subst_env E e = subst (prod_map id thunk_to_expr <$> E) e.
152Proof. done. Qed.
153
154(* Use the unfolding lemmas, don't rely on conversion *)
155Opaque subst_env'.
156
157Lemma subst_env_empty e : subst_env ∅ e = e.
158Proof. rewrite subst_env_alt. apply subst_empty. Qed.
159
160Lemma final_val_to_expr v : final SHALLOW (val_to_expr v).
161Proof. induction v; simpl; constructor; auto. Qed.
162Local Hint Resolve final_val_to_expr | 0 : core.
163Lemma step_not_val_to_expr v e : val_to_expr v -{SHALLOW}-> e → False.
164Proof. intros []%step_not_final. done. Qed.
165
166Lemma final_force_deep n t v :
167 force_deep n t = mret v → final DEEP (val_to_expr v).
168Proof.
169 revert t v. induction n as [|n IH]; intros v w; [done|].
170 rewrite force_deep_S /=.
171 intros; destruct v; simplify_res; eauto using final.
172 + destruct (mapM _ _) as [[vs|]|] eqn:Hmap; simplify_res; eauto.
173 constructor. revert vs Hmap.
174 induction ts as [|t ts IHts]; intros; simplify_res; [by constructor|..].
175 destruct (interp_thunk _ _) as [[w|]|]; simplify_res.
176 destruct (force_deep _ _) as [[w'|]|] eqn:?; simplify_res.
177 destruct (mapM _ _) as [[ws|]|]; simplify_res; eauto.
178 + destruct (map_mapM_sorted _ _ _) as [[vs|]|] eqn:Hmap; simplify_res.
179 constructor; [done|].
180 revert vs Hmap. induction ts as [|x t ts ?? IHts]
181 using (map_sorted_ind attr_le); intros ts' Hts.
182 { rewrite map_mapM_sorted_empty in Hts; simplify_res. done. }
183 rewrite map_mapM_sorted_insert //= in Hts.
184 destruct (interp_thunk _ _) as [[w|]|] eqn:?; simplify_res.
185 destruct (force_deep _ _) as [[w'|]|] eqn:?; simplify_res.
186 destruct (map_mapM_sorted _ _ _) as [[ws|]|] eqn:Hmap; simplify_res.
187 rewrite !fmap_insert /=. apply map_Forall_insert_2, IHts; eauto.
188Qed.
189
190Lemma interp_bin_op_Some_1 op v1 f :
191 interp_bin_op op v1 = Some f →
192 ∃ Φ, sem_bin_op op (val_to_expr v1) Φ.
193Proof.
194 intros Hinterp. unfold interp_bin_op, interp_eq in *.
195 repeat (case_match || simplify_option_eq);
196 eexists; by repeat econstructor; eauto using final.
197Qed.
198
199Lemma interp_bin_op_Some_2 op v1 Φ :
200 sem_bin_op op (val_to_expr v1) Φ →
201 is_Some (interp_bin_op op v1).
202Proof.
203 unfold interp_bin_op; destruct v1; inv 1;
204 repeat (case_match || simplify_option_eq); eauto.
205 destruct (option_to_eq_Some _) as [[??]|] eqn:Ho; simplify_eq/=; eauto.
206 by rewrite H2 in Ho.
207Qed.
208
209Lemma interp_eq_list_correct ts1 ts2 :
210 thunk_to_expr (interp_eq_list ts1 ts2) =D=>
211 sem_eq_list (thunk_to_expr <$> ts1) (thunk_to_expr <$> ts2).
212Proof.
213 simpl.
214 remember (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪
215 kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2))
216 as E eqn:HE.
217 assert (∀ (i : nat) t, ts1 !! i = Some t →
218 E !! String "1" (pretty (i + 0)) = Some (ABS, t)) as Hts1.
219 { intros x t Hxt. rewrite Nat.add_0_r.
220 rewrite HE lookup_union (lookup_kmap _) lookup_fmap.
221 rewrite lookup_map_seq_0 Hxt /= union_Some_l. done. }
222 assert (∀ (i : nat) t, ts2 !! i = Some t →
223 E !! String "2" (pretty (i + 0)) = Some (ABS, t)) as Hts2.
224 { intros x t Hxt. rewrite Nat.add_0_r.
225 rewrite HE lookup_union_r; last by apply (lookup_kmap_None _).
226 rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0 Hxt /=. done. }
227 clear HE. revert ts2 Hts1 Hts2. generalize 0.
228 induction ts1 as [|t1 ts1 IH]; intros n [|t2 ts2] Hts1 Hts2; csimpl; [done..|].
229 rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=. rewrite /String.app.
230 rewrite (Hts1 0 t1) // (Hts2 0 t2) //=.
231 constructor; [repeat constructor| |done].
232 apply IH; intros i t; rewrite Nat.add_succ_r;
233 [apply (Hts1 (S i))|apply (Hts2 (S i))].
234Qed.
235
236Lemma interp_lt_list_correct ts1 ts2 :
237 thunk_to_expr (interp_lt_list ts1 ts2) =D=>
238 sem_lt_list (thunk_to_expr <$> ts1) (thunk_to_expr <$> ts2).
239Proof.
240 simpl.
241 remember (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪
242 kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2))
243 as E eqn:HE.
244 assert (∀ (i : nat) t, ts1 !! i = Some t →
245 E !! String "1" (pretty (i + 0)) = Some (ABS, t)) as Hts1.
246 { intros x t Hxt. rewrite Nat.add_0_r.
247 rewrite HE lookup_union (lookup_kmap _) lookup_fmap.
248 rewrite lookup_map_seq_0 Hxt /= union_Some_l. done. }
249 assert (∀ (i : nat) t, ts2 !! i = Some t →
250 E !! String "2" (pretty (i + 0)) = Some (ABS, t)) as Hts2.
251 { intros x t Hxt. rewrite Nat.add_0_r.
252 rewrite HE lookup_union_r; last by apply (lookup_kmap_None _).
253 rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0 Hxt /=. done. }
254 clear HE. revert ts2 Hts1 Hts2. generalize 0.
255 induction ts1 as [|t1 ts1 IH]; intros n [|t2 ts2] Hts1 Hts2; csimpl; [done..|].
256 rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=. rewrite /String.app.
257 rewrite (Hts1 0 t1) // (Hts2 0 t2) //=.
258 constructor; [repeat constructor..|].
259 rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=.
260 rewrite (Hts1 0 t1) // (Hts2 0 t2) //=.
261 constructor; [repeat constructor| |done].
262 apply IH; intros i t; rewrite Nat.add_succ_r;
263 [apply (Hts1 (S i))|apply (Hts2 (S i))].
264Qed.
265
266Lemma interp_eq_attr_correct ts1 ts2 :
267 dom ts1 = dom ts2 →
268 thunk_to_expr (interp_eq_attr ts1 ts2) =D=>
269 sem_eq_attr (AttrN ∘ thunk_to_expr <$> ts1) (AttrN ∘ thunk_to_expr <$> ts2).
270Proof.
271 intros Hdom. simpl.
272 remember (kmap (String "1") ((ABS,.) <$> ts1) ∪
273 kmap (String "2") ((ABS,.) <$> ts2)) as E eqn:HE.
274 assert (map_Forall (λ x t, E !! String "1" x = Some (ABS, t)) ts1) as Hts1.
275 { intros x t Hxt.
276 rewrite HE lookup_union (lookup_kmap (String "1")) lookup_fmap.
277 by rewrite Hxt /= union_Some_l. }
278 assert (map_Forall (λ x t, E !! String "2" x = Some (ABS, t)) ts2) as Hts2.
279 { intros x t Hxt.
280 rewrite HE lookup_union_r; last by apply (lookup_kmap_None _).
281 by rewrite (lookup_kmap (String "2")) lookup_fmap Hxt. }
282 clear HE. revert ts2 Hdom Hts1 Hts2.
283 induction ts1 as [|x t1 ts1 Hts1x IH] using (map_sorted_ind attr_le);
284 intros ts2 Hdom Hts1 Hts2.
285 { apply symmetry, dom_empty_inv_L in Hdom as ->. done. }
286 rewrite dom_insert_L in Hdom.
287 assert (is_Some (ts2 !! x)) as [t2 Hxt2] by (apply elem_of_dom; set_solver).
288 assert (dom ts1 = dom (delete x ts2)).
289 { rewrite dom_delete_L -Hdom. apply not_elem_of_dom in Hts1x. set_solver. }
290 rewrite -(insert_delete ts2 x t2) //. rewrite -(insert_delete ts2 x t2) // in Hts2.
291 apply map_Forall_insert in Hts1 as [Hx1 Hts1]; last done.
292 apply map_Forall_insert in Hts2 as [Hx2 Hts2]; last by rewrite lookup_delete.
293 rewrite /sem_eq_attr !fmap_insert /=. erewrite <-insert_merge by done.
294 rewrite sem_and_attr_insert; first last.
295 { intros y. rewrite lookup_merge !lookup_fmap /is_Some.
296 destruct (ts1 !! y) eqn:? , (delete x ts2 !! y); naive_solver. }
297 { rewrite lookup_merge !lookup_fmap lookup_delete /=. by destruct (ts1 !! x). }
298 rewrite map_imap_insert sem_and_attr_insert; first last.
299 { intros y. rewrite map_lookup_imap /is_Some.
300 destruct (ts1 !! y) eqn:?; naive_solver. }
301 { by rewrite map_lookup_imap Hts1x. }
302 rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /= Hx1 Hx2 /=.
303 constructor; [|apply IHts1; by auto|done]. by do 2 constructor.
304Qed.
305
306Lemma interp_bin_op_Some_Some_1 op v1 f Φ v2 t3 :
307 interp_bin_op op v1 = Some f →
308 sem_bin_op op (val_to_expr v1) Φ →
309 f v2 = Some t3 →
310 ∃ e3, Φ (val_to_expr v2) e3 ∧ thunk_to_expr t3 =D=> e3.
311Proof.
312 unfold interp_bin_op, interp_eq, type_of_val, type_of_expr;
313 destruct v1, v2; inv 2; intros;
314 repeat match goal with
315 | _ => progress simplify_option_eq
316 | H : _ <$> _ = ∅ |- _ => apply fmap_empty_inv in H
317 | H : context [dom (_ <$> _)] |- _ => rewrite !dom_fmap_L in H
318 | H : context [length (_ <$> _)] |- _ => rewrite !length_fmap in H
319 | _ => case_match
320 | _ => eexists; split; [done|]
321 | _ => by apply interp_eq_list_correct
322 | _ => eexists; split; [|by apply: interp_lt_list_correct]
323 | _ => by apply: interp_eq_attr_correct
324 | _ => eexists; split; [|done]
325 | _ => split; [|done]
326 | _ => rewrite map_fmap_singleton
327 | _ => rewrite fmap_delete
328 | _ => rewrite subst_env_empty
329 | _ => rewrite fmap_app
330 | _ => rewrite lookup_fmap
331 | _ => by constructor
332 end; eauto using final.
333 - apply reflexive_eq. f_equal. apply map_eq=> x.
334 rewrite !lookup_fmap. by destruct (_ !! _) as [[]|].
335 - by destruct (ts !! _).
336 - apply (map_minimal_key_Some _) in H as [[t Hx] ?].
337 split; [done|]. right. eexists s, _; split_and!.
338 + by rewrite lookup_fmap Hx.
339 + intros y. rewrite lookup_fmap fmap_is_Some. auto.
340 + rewrite 3!fmap_insert map_fmap_singleton /=.
341 by rewrite lookup_total_alt Hx fmap_delete.
342 - apply map_minimal_key_None in H as ->. auto.
343 - split; [done|]. by rewrite map_fmap_union.
344Qed.
345
346Lemma interp_bin_op_Some_Some_2 op v1 f Φ v2 e3 :
347 interp_bin_op op v1 = Some f →
348 sem_bin_op op (val_to_expr v1) Φ →
349 Φ (val_to_expr v2) e3 →
350 ∃ t3, f v2 = Some t3 ∧ thunk_to_expr t3 =D=> e3.
351Proof.
352 unfold interp_bin_op, interp_eq; destruct v1; inv 2; intros;
353 repeat match goal with
354 | H : ∃ _, _ |- _ => destruct H
355 | H : _ ∧ _ |- _ => destruct H
356 | H : _ <$> _ = ∅ |- _ => apply fmap_empty_inv in H
357 | H : context [(_ <$> _) !! _ = _] |- _ => rewrite lookup_fmap in H
358 | H : context [dom (_ <$> _)] |- _ => rewrite !dom_fmap_L in H
359 | H : context [length (_ <$> _)] |- _ => rewrite !length_fmap in H
360 | _ => progress simplify_option_eq
361 | H : val_to_expr ?v2 = _ |- _ => destruct v2
362 | _ => case_match
363 | _ => eexists; split; [|by apply interp_eq_attr_correct]
364 | _ => eexists; split; [|by apply interp_eq_list_correct]
365 | _ => eexists; split; [|by apply interp_lt_list_correct]
366 | _ => eexists; split; [done|]
367 | _ => rewrite map_fmap_singleton
368 | _ => rewrite fmap_delete
369 | _ => rewrite subst_env_empty
370 | _ => rewrite fmap_app
371 | _ => rewrite map_fmap_union
372 end; eauto.
373 - rewrite (option_to_eq_Some_Some _ _ H1) /=. by eexists.
374 - apply reflexive_eq. f_equal. apply map_eq=> x.
375 rewrite !lookup_fmap. by destruct (_ !! _) as [[]|].
376 - rewrite lookup_fmap. by destruct (_ !! _).
377 - destruct H1 as [[Hemp _]|(x & e' & Hx & Hleast & ->)].
378 { by apply fmap_empty_inv in Hemp as ->. }
379 rewrite lookup_fmap fmap_Some in Hx. destruct Hx as (t & Hx & [= ->]).
380 setoid_rewrite lookup_fmap in Hleast. setoid_rewrite fmap_is_Some in Hleast.
381 apply (map_minimal_key_Some _) in H as [??].
382 assert (s = x) as -> by (apply (anti_symm attr_le); naive_solver).
383 rewrite 3!fmap_insert map_fmap_singleton /= fmap_delete.
384 rewrite lookup_total_alt Hx. done.
385 - apply map_minimal_key_None in H as ->. naive_solver.
386Qed.
387
388Lemma interp_match_subst E ts ms strict :
389 interp_match ts (fmap (M:=option) (subst_env E) <$> ms) strict =
390 fmap (M:=gmap string) (sum_map (subst_env E) id) <$> interp_match ts ms strict.
391Proof.
392 unfold interp_match. set (f mt mme := match mt with _ => _ end).
393 revert ts. induction ms as [|x mt ms Hmsx IH] using map_ind; intros ts.
394 { rewrite fmap_empty merge_empty_r.
395 induction ts as [|x t ts Hmsx IH] using map_ind; [done|].
396 rewrite omap_insert /=. destruct strict; simplify_eq/=.
397 { rewrite map_mapM_insert_option //= lookup_omap Hmsx. done. }
398 rewrite -omap_delete delete_notin //. }
399 destruct (ts !! x) as [t|] eqn:Htsx.
400 { rewrite -(insert_delete ts x t) // fmap_insert.
401 rewrite -!(insert_merge _ _ _ _ (Some (inr t))) //.
402 rewrite !map_mapM_insert_option /=;
403 [|by rewrite lookup_merge lookup_delete ?lookup_fmap Hmsx..].
404 rewrite IH. destruct (map_mapM id _); rewrite /= ?fmap_insert //. }
405 rewrite -(insert_merge_r _ _ _ _ (inl <$> mt)) /=; last first.
406 { rewrite Htsx /=. by destruct mt. }
407 rewrite fmap_insert.
408 rewrite -(insert_merge_r _ _ _ _ (inl <$> (subst_env E <$> mt))) /=; last first.
409 { rewrite Htsx /=. by destruct mt. }
410 rewrite !map_mapM_insert_option /=;
411 [|by rewrite lookup_merge ?lookup_fmap Htsx Hmsx..].
412 rewrite IH. destruct mt, (map_mapM id _); rewrite /= ?fmap_insert //.
413Qed.
414
415Lemma interp_match_Some_1 ts ms strict tαs :
416 interp_match ts ms strict = Some tαs →
417 matches (thunk_to_expr <$> ts) ms strict (tattr_to_attr ∅ <$> tαs).
418Proof.
419 unfold interp_match. set (f mt mme := match mt with _ => _ end).
420 revert ts tαs.
421 induction ms as [|x mt ms Hmsx IH] using map_ind; intros ts αs Hmatch.
422 { rewrite merge_empty_r in Hmatch. revert αs Hmatch.
423 induction ts as [|x t ts Hmsx IH] using map_ind; intros ts' Hmatch.
424 { rewrite omap_empty map_mapM_empty in Hmatch. injection Hmatch as <-.
425 rewrite !fmap_empty. constructor. }
426 rewrite omap_insert /= in Hmatch. destruct strict; simplify_eq/=.
427 { rewrite map_mapM_insert_option //= in Hmatch. by rewrite lookup_omap Hmsx. }
428 rewrite fmap_insert.
429 rewrite -omap_delete delete_notin // in Hmatch. apply IH in Hmatch.
430 apply matches_strict; rewrite ?lookup_fmap ?Hmsx; eauto. }
431 destruct (ts !! x) as [t|] eqn:Htsx.
432 { rewrite -(insert_delete ts x t) //.
433 rewrite -(insert_delete ts x t) // in Hmatch.
434 rewrite -(insert_merge _ _ _ _ (Some (inr t))) // in Hmatch.
435 rewrite map_mapM_insert_option /= in Hmatch;
436 last (by rewrite lookup_merge lookup_delete Hmsx).
437 destruct (map_mapM id _) as [E''|] eqn:?; simplify_eq/=.
438 injection Hmatch as <-.
439 rewrite !fmap_insert /=. constructor.
440 - by rewrite lookup_fmap lookup_delete.
441 - done.
442 - by apply IH. }
443 rewrite -(insert_merge_r _ _ _ _ (inl <$> mt)) /= in Hmatch; last first.
444 { rewrite Htsx /=. by destruct mt. }
445 rewrite map_mapM_insert_option /= in Hmatch;
446 last (by rewrite lookup_merge Htsx Hmsx).
447 destruct mt as [t|]; simplify_eq/=.
448 destruct (map_mapM id _) as [E''|] eqn:?; simplify_eq/=.
449 injection Hmatch as <-. rewrite !fmap_insert /= subst_env_empty. constructor.
450 - by rewrite lookup_fmap Htsx.
451 - done.
452 - by apply IH.
453Qed.
454
455Lemma interp_match_Some_2 es ms strict αs :
456 matches es ms strict αs →
457 interp_match (Thunk ∅ <$> es) ms strict = Some (attr_to_tattr ∅ <$> αs).
458Proof.
459 unfold interp_match. set (f mt mme := match mt with _ => _ end).
460 induction 1; [done|..].
461 - rewrite fmap_empty merge_empty_r.
462 induction es as [|x e es ? IH] using map_ind; [done|].
463 rewrite fmap_insert omap_insert /= -omap_delete -fmap_delete delete_notin //.
464 - rewrite !fmap_insert /=.
465 rewrite -(insert_merge _ _ _ _ (Some (inr (Thunk ∅ e)))) //.
466 rewrite map_mapM_insert_option /=; last first.
467 { by rewrite lookup_merge !lookup_fmap H H0. }
468 by rewrite IHmatches.
469 - rewrite !fmap_insert /=.
470 rewrite -(insert_merge_r _ _ _ _ (Some (inl d))) /=; last first.
471 { by rewrite lookup_fmap H. }
472 rewrite map_mapM_insert_option /=; last first.
473 { by rewrite lookup_merge !lookup_fmap H H0. }
474 by rewrite IHmatches /=.
475Qed.
476
477Lemma force_deep_le {n1 n2 v mv} :
478 force_deep n1 v = Res mv → n1 ≤ n2 → force_deep n2 v = Res mv
479with interp_le {n1 n2 E e mv} :
480 interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv
481with interp_thunk_le {n1 n2 t mvs} :
482 interp_thunk n1 t = Res mvs → n1 ≤ n2 → interp_thunk n2 t = Res mvs
483with interp_app_le {n1 n2 v t mv} :
484 interp_app n1 v t = Res mv → n1 ≤ n2 → interp_app n2 v t = Res mv.
485Proof.
486 - destruct n1 as [|n1], n2 as [|n2]; intros Ht ?; [done || lia..|].
487 rewrite force_deep_S in Ht; rewrite force_deep_S; simpl in *.
488 destruct v as []; simplify_res; try done.
489 + destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res.
490 erewrite mapM_Res_impl; [done..|]. intros t mw Hinterp; simpl in *.
491 destruct (interp_thunk n1 _) as [mw'|] eqn:Hinterp'; simplify_res.
492 rewrite (interp_thunk_le _ _ _ _ Hinterp') /=; last lia.
493 destruct mw'; simplify_res; eauto with lia.
494 + destruct (map_mapM_sorted _ _ _) eqn:?; simplify_res.
495 erewrite (map_mapM_sorted_Res_impl attr_le); [done..|].
496 clear dependent ts. intros t mw Hinterp; simpl in *.
497 destruct (interp_thunk n1 _) as [mw'|] eqn:Hinterp'; simplify_res.
498 rewrite (interp_thunk_le _ _ _ _ Hinterp') /=; last lia.
499 destruct mw'; simplify_res; eauto with lia.
500 - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [done || lia..|].
501 rewrite interp_S in He; rewrite interp_S; destruct e;
502 repeat match goal with
503 | _ => case_match
504 | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res
505 | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
506 | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
507 | H : interp ?n' _ _ = Res ?mv |- interp ?n ?E ?e ≫= _ = _ =>
508 rewrite (interp_le n' n E e mv); [|done || lia..]
509 | H : interp_app ?n' _ _ = Res ?mv |- interp_app ?n ?E ?e ≫= _ = _ =>
510 rewrite (interp_app_le n' n E e mv); [|done || lia..]
511 | H : force_deep ?n' _ = Res ?mv |- force_deep ?n ?t ≫= _ = _ =>
512 rewrite (force_deep_le n' n t mv); [|done || lia..]
513 | _ => progress simplify_res
514 | _ => progress simplify_option_eq
515 end; eauto with lia.
516 - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [by (done || lia)..|].
517 rewrite interp_thunk_S in He. rewrite interp_thunk_S.
518 destruct t; repeat (case_match || destruct (_ !! _)
519 || simplify_res); eauto with lia.
520 - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [by (done || lia)..|].
521 rewrite interp_app_S /= in He; rewrite interp_app_S /=.
522 destruct v; simplify_res; eauto with lia.
523 + destruct (interp_thunk n1 t) as [mw|] eqn:?; simplify_res.
524 erewrite interp_thunk_le by eauto with lia. simpl.
525 destruct mw as [w|]; simplify_res; [|done].
526 destruct (maybe VAttr w) as [ts|]; simplify_res; [|done].
527 destruct (interp_match _ _ _); simplify_res; eauto with lia.
528 + destruct (_ !! "__functor") as [tf|]; simplify_res; [|done].
529 destruct (interp_thunk n1 tf) as [mw|] eqn:?; simplify_res.
530 erewrite interp_thunk_le by eauto with lia. simpl.
531 destruct mw as [w|]; simplify_res; [|done].
532 destruct (interp_app n1 _ _) as [mw|] eqn:?; simplify_res.
533 erewrite interp_app_le by eauto with lia; simpl.
534 destruct mw; simplify_res; eauto with lia.
535Qed.
536
537Lemma mapM_interp_le {n1 n2 ts mvs} :
538 mapM (mbind (force_deep n1) ∘ interp_thunk n1) ts = Res mvs →
539 n1 ≤ n2 →
540 mapM (mbind (force_deep n2) ∘ interp_thunk n2) ts = Res mvs.
541Proof.
542 intros. eapply mapM_Res_impl; [done|]; simpl; intros t mv ?.
543 destruct (interp_thunk _ _) as [mw|] eqn:Hthunk; simplify_res.
544 rewrite (interp_thunk_le Hthunk) //=.
545 destruct mw; simplify_res; eauto using force_deep_le.
546Qed.
547Lemma map_mapM_interp_le {n1 n2 ts mvs} :
548 map_mapM_sorted attr_le (mbind (force_deep n1) ∘ interp_thunk n1) ts = Res mvs →
549 n1 ≤ n2 →
550 map_mapM_sorted attr_le (mbind (force_deep n2) ∘ interp_thunk n2) ts = Res mvs.
551Proof.
552 intros. eapply (map_mapM_sorted_Res_impl attr_le); [done|]; simpl.
553 intros t mv ?. destruct (interp_thunk _ _) as [mw|] eqn:Hthunk; simplify_res.
554 rewrite (interp_thunk_le Hthunk) //=.
555 destruct mw; simplify_res; eauto using force_deep_le.
556Qed.
557
558Lemma interp_agree {n1 n2 E e mv1 mv2} :
559 interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2.
560Proof.
561 intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
562 - rewrite -He2. symmetry. eauto using interp_le.
563 - rewrite -He1. eauto using interp_le.
564Qed.
565
566Lemma subst_env_union E1 E2 e :
567 subst_env (union_kinded E1 E2) e = subst_env E1 (subst_env E2 e).
568Proof.
569 rewrite !subst_env_alt -subst_union. f_equal. apply map_eq=> x.
570 rewrite lookup_union_with !lookup_fmap lookup_union_with.
571 by repeat destruct (_ !! _) as [[[]]|].
572Qed.
573
574Lemma union_kinded_union {A} (E1 E2 : gmap string (kind * A)) :
575 map_Forall (λ _ ka, ka.1 = ABS) E1 → union_kinded E1 E2 = E1 ∪ E2.
576Proof.
577 rewrite map_Forall_lookup; intros.
578 apply map_eq=> x. rewrite lookup_union_with lookup_union.
579 destruct (E1 !! x) as [[[] a]|] eqn:?; naive_solver.
580Qed.
581
582Lemma subst_abs_env_insert E x e t :
583 subst_env (<[x:=(ABS, t)]> E) e
584 = subst {[x:=(ABS, thunk_to_expr t)]} (subst_env E e).
585Proof.
586 assert (<[x:=(ABS, t)]> E =
587 union_kinded {[x:=(ABS, t)]} E) as ->.
588 { apply map_eq=> y. rewrite lookup_union_with.
589 destruct (decide (x = y)) as [->|].
590 - rewrite lookup_insert lookup_singleton /=. by destruct (_ !! _).
591 - rewrite lookup_insert_ne // lookup_singleton_ne //. by destruct (_ !! _). }
592 rewrite subst_env_union subst_env_alt. by rewrite map_fmap_singleton.
593Qed.
594
595Lemma subst_abs_as_subst_env x e1 e2 :
596 subst {[x:=(ABS, e2)]} e1 = subst_env (<[x:=(ABS, Thunk ∅ e2)]> ∅) e1.
597Proof. rewrite subst_abs_env_insert //= !subst_env_empty //. Qed.
598
599Lemma subst_env_insert_proper e1 e2 E1 E2 x t1 t2 :
600 subst_env E1 e1 = subst_env E2 e2 →
601 thunk_to_expr t1 = thunk_to_expr t2 →
602 subst_env (<[x:=(ABS, t1)]> E1) e1 = subst_env (<[x:=(ABS, t2)]> E2) e2.
603Proof. rewrite !subst_abs_env_insert //. auto with f_equal. Qed.
604
605Lemma subst_env_insert_proper' e1 e2 E1 E2 x E1' E2' e1' e2' :
606 subst_env E1 e1 = subst_env E2 e2 →
607 subst_env E1' e1' = subst_env E2' e2' →
608 subst_env (<[x:=(ABS, Thunk E1' e1')]> E1) e1
609 = subst_env (<[x:=(ABS, Thunk E2' e2')]> E2) e2.
610Proof. intros. by apply subst_env_insert_proper. Qed.
611
612Lemma subst_env_union_fmap_proper k e1 e2 E1 E2 ts1 ts2 :
613 subst_env E1 e1 = subst_env E2 e2 →
614 AttrN ∘ thunk_to_expr <$> ts1 = AttrN ∘ thunk_to_expr <$> ts2 →
615 subst_env (union_kinded ((k,.) <$> ts1) E1) e1
616 = subst_env (union_kinded ((k,.) <$> ts2) E2) e2.
617Proof.
618 intros He Hes. rewrite !subst_env_union; [|by apply env_unionable_with..].
619 rewrite He !subst_env_alt /=. f_equal.
620 apply map_eq=> x. rewrite !lookup_fmap.
621 apply (f_equal (.!! x)) in Hes. rewrite !lookup_fmap in Hes.
622 destruct (ts1 !! x), (ts2 !! x); simplify_eq/=; auto with f_equal.
623Qed.
624
625Lemma subst_env_fmap_proper k e ts1 ts2 :
626 AttrN ∘ thunk_to_expr <$> ts1 = AttrN ∘ thunk_to_expr <$> ts2 →
627 subst_env ((k,.) <$> ts1) e = subst_env ((k,.) <$> ts2) e.
628Proof.
629 intros. rewrite -(right_id_L ∅ (union_kinded) (_ <$> ts1))
630 -(right_id_L ∅ (union_kinded) (_ <$> ts2)).
631 by apply subst_env_union_fmap_proper.
632Qed.
633
634Lemma tattr_to_attr_from_attr E (αs : gmap string attr) :
635 tattr_to_attr E <$> (attr_to_tattr E <$> αs) = attr_subst_env E <$> αs.
636Proof.
637 apply map_eq=> x. rewrite /tattr_to_attr !lookup_fmap.
638 destruct (αs !! x) as [[[] ]|] eqn:?; auto.
639Qed.
640
641Lemma tattr_to_attr_from_attr_empty (αs : gmap string attr) :
642 tattr_to_attr ∅ <$> (attr_to_tattr ∅ <$> αs) = αs.
643Proof.
644 rewrite tattr_to_attr_from_attr. apply map_eq=> x. rewrite !lookup_fmap.
645 destruct (αs !! x) as [[[] ]|] eqn:?; f_equal/=; by rewrite subst_env_empty.
646Qed.
647
648Lemma indirects_env_proper E1 E2 tαs1 tαs2 e1 e2 :
649 tattr_to_attr E1 <$> tαs1 = tattr_to_attr E2 <$> tαs2 →
650 subst_env E1 e1 = subst_env E2 e2 →
651 subst_env (indirects_env E1 tαs1) e1 = subst_env (indirects_env E2 tαs2) e2.
652Proof.
653 intros Htαs HE. rewrite /indirects_env -!union_kinded_union;
654 [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..].
655 rewrite !subst_env_union HE !subst_env_alt. f_equal.
656 apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap.
657 pose proof (f_equal (.!! x) Htαs) as Hx. rewrite !lookup_fmap in Hx.
658 repeat destruct (_ !! x) as [[]|]; simplify_eq/=; auto with f_equal.
659Qed.
660
661Lemma subst_env_indirects_env E tαs e :
662 subst_env (indirects_env E tαs) e
663 = subst_env (indirects_env ∅ (attr_to_tattr ∅ <$> (tattr_to_attr E <$> tαs)))
664 (subst_env E e).
665Proof.
666 rewrite /indirects_env -!union_kinded_union;
667 [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..].
668 rewrite !subst_env_union subst_env_empty !subst_env_alt.
669 f_equal. apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap !lookup_fmap.
670 destruct (_ !! _) as [[]|];
671 do 4 f_equal/=; auto using tattr_to_attr_from_attr_empty.
672Qed.
673
674Lemma subst_env_indirects_env_attr_to_tattr E αs e :
675 subst_env (indirects_env E (attr_to_tattr E <$> αs)) e
676 = subst (indirects (attr_subst_env E <$> αs)) (subst_env E e).
677Proof.
678 rewrite /indirects_env -!union_kinded_union;
679 [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..].
680 rewrite subst_env_union !subst_env_alt. f_equal.
681 apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap !lookup_fmap.
682 repeat destruct (_ !! x) as [[]|]; simplify_eq/=; do 4 f_equal/=.
683 by rewrite tattr_to_attr_from_attr.
684Qed.
685
686Lemma subst_env_indirects_env_attr_to_tattr_empty αs e :
687 subst_env (indirects_env ∅ (attr_to_tattr ∅ <$> αs)) e =
688 subst (indirects αs) e.
689Proof.
690 rewrite subst_env_indirects_env_attr_to_tattr subst_env_empty. do 3 f_equal.
691 apply map_eq=> x. rewrite !lookup_fmap.
692 destruct (_ !! x) as [[]|]; do 2 f_equal/=; auto using subst_env_empty.
693Qed.
694
695Lemma interp_val_to_expr E e v :
696 subst_env E e = val_to_expr v →
697 ∃ w m, interp m E e = mret w ∧ val_to_expr v = val_to_expr w.
698Proof.
699 revert v. induction e; intros [];
700 rewrite subst_env_eq; intros; simplify_eq/=.
701 - eexists (VLit _ ltac:(done)), 1. split; [|done]. by rewrite interp_lit.
702 - eexists (VClo _ _ _), 1. rewrite interp_S /=. auto with f_equal.
703 - eexists (VCloMatch _ _ _ _), 1. rewrite interp_S /=. auto with f_equal.
704 - eexists (VList _), 1. rewrite interp_S /=. split; [done|].
705 f_equal. rewrite -H0. clear.
706 induction es; f_equal/=; auto.
707 - eexists (VAttr _), 1. rewrite interp_S /=. split; [done|].
708 assert (no_recs αs) as Hrecs.
709 { intros y α Hy.
710 apply (f_equal (.!! y)) in H0. rewrite !lookup_fmap Hy /= in H0.
711 destruct (ts !! y), α; by simplify_eq/=. }
712 rewrite from_attr_no_recs // -H0.
713 f_equal. apply map_eq=> y.
714 rewrite !lookup_fmap. destruct (αs !! y) as [[]|] eqn:?; do 2 f_equal/=.
715 eauto using no_recs_lookup.
716Qed.
717
718Lemma interp_val_to_expr_Res m E e v mw :
719 subst_env E e = val_to_expr v →
720 interp m E e = Res mw →
721 Some (val_to_expr v) = val_to_expr <$> mw.
722Proof.
723 intros (mw' & m' & Hinterp' & ->)%interp_val_to_expr Hinterp.
724 by assert (mw = Some mw') as -> by eauto using interp_agree.
725Qed.
726
727Lemma interp_empty_val_to_expr v :
728 ∃ w m, interp m ∅ (val_to_expr v) = mret w ∧ val_to_expr v = val_to_expr w.
729Proof. apply interp_val_to_expr. by rewrite subst_env_empty. Qed.
730
731Lemma interp_empty_val_to_expr_Res m v mw :
732 interp m ∅ (val_to_expr v) = Res mw →
733 Some (val_to_expr v) = val_to_expr <$> mw.
734Proof. apply interp_val_to_expr_Res. by rewrite subst_env_empty. Qed.
735
736Lemma interp_eq_list_proper ts1 ts2 ts1' ts2' :
737 thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' →
738 thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' →
739 thunk_to_expr (interp_eq_list ts1 ts2)
740 = thunk_to_expr (interp_eq_list ts1' ts2').
741Proof.
742 intros Hts1 Hts2. rewrite /= !subst_env_alt.
743 f_equal; last first.
744 { revert ts1' ts2 ts2' Hts1 Hts2. generalize 0.
745 induction ts1; intros ? [] [] [] ??; simplify_eq/=; auto with f_equal. }
746 rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap.
747 - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
748 + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
749 rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0.
750 rewrite lookup_fmap lookup_map_seq_0 in Hy.
751 apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1.
752 repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
753 + rewrite lookup_kmap_None in Hy.
754 apply symmetry, fmap_None, (lookup_kmap_None _).
755 intros y' ->. generalize (Hy _ eq_refl).
756 rewrite !lookup_fmap !lookup_map_seq_0.
757 apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1.
758 intros. repeat destruct (_ !! _); by simplify_eq/=.
759 - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
760 + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
761 rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0.
762 rewrite lookup_fmap lookup_map_seq_0 in Hy.
763 apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2.
764 repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
765 + rewrite lookup_kmap_None in Hy.
766 apply symmetry, fmap_None, (lookup_kmap_None _).
767 intros y' ->. generalize (Hy _ eq_refl).
768 rewrite !lookup_fmap !lookup_map_seq_0.
769 apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2.
770 intros. repeat destruct (_ !! _); by simplify_eq/=.
771Qed.
772
773Lemma interp_lt_list_proper ts1 ts2 ts1' ts2' :
774 thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' →
775 thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' →
776 thunk_to_expr (interp_lt_list ts1 ts2)
777 = thunk_to_expr (interp_lt_list ts1' ts2').
778Proof.
779 intros Hts1 Hts2. rewrite /= !subst_env_alt.
780 f_equal; last first.
781 { revert ts1' ts2 ts2' Hts1 Hts2. generalize 0.
782 induction ts1; intros ? [] [] [] ??; simplify_eq/=; auto with f_equal. }
783 rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap.
784 - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
785 + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
786 rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0.
787 rewrite lookup_fmap lookup_map_seq_0 in Hy.
788 apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1.
789 repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
790 + rewrite lookup_kmap_None in Hy.
791 apply symmetry, fmap_None, (lookup_kmap_None _).
792 intros y' ->. generalize (Hy _ eq_refl).
793 rewrite !lookup_fmap !lookup_map_seq_0.
794 apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1.
795 intros. repeat destruct (_ !! _); by simplify_eq/=.
796 - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
797 + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
798 rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0.
799 rewrite lookup_fmap lookup_map_seq_0 in Hy.
800 apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2.
801 repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
802 + rewrite lookup_kmap_None in Hy.
803 apply symmetry, fmap_None, (lookup_kmap_None _).
804 intros y' ->. generalize (Hy _ eq_refl).
805 rewrite !lookup_fmap !lookup_map_seq_0.
806 apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2.
807 intros. repeat destruct (_ !! _); by simplify_eq/=.
808Qed.
809
810Lemma interp_eq_attr_proper ts1 ts2 ts1' ts2' :
811 thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' →
812 thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' →
813 thunk_to_expr (interp_eq_attr ts1 ts2)
814 = thunk_to_expr (interp_eq_attr ts1' ts2').
815Proof.
816 intros Hts1 Hts2. rewrite /= !subst_env_alt.
817 f_equal; last first.
818 { clear Hts2. f_equal. apply map_eq=> y.
819 rewrite !map_lookup_imap. apply (f_equal (.!! y)) in Hts1.
820 rewrite !lookup_fmap in Hts1. by repeat destruct (_ !! _). }
821 rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap.
822 - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
823 + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
824 rewrite (lookup_kmap (String "1")) lookup_fmap.
825 rewrite lookup_fmap in Hy.
826 apply (f_equal (.!! y')) in Hts1. rewrite !lookup_fmap in Hts1.
827 repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
828 + rewrite lookup_kmap_None in Hy.
829 apply symmetry, fmap_None, (lookup_kmap_None _).
830 intros y' ->. generalize (Hy _ eq_refl). rewrite !lookup_fmap.
831 apply (f_equal (.!! y')) in Hts1. rewrite !lookup_fmap in Hts1.
832 intros. repeat destruct (_ !! _); by simplify_eq/=.
833 - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
834 + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
835 rewrite (lookup_kmap (String "2")) lookup_fmap.
836 rewrite lookup_fmap in Hy.
837 apply (f_equal (.!! y')) in Hts2. rewrite !lookup_fmap in Hts2.
838 repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
839 + rewrite lookup_kmap_None in Hy.
840 apply symmetry, fmap_None, (lookup_kmap_None _).
841 intros y' ->. generalize (Hy _ eq_refl). rewrite !lookup_fmap.
842 apply (f_equal (.!! y')) in Hts2. rewrite !lookup_fmap in Hts2.
843 intros. repeat destruct (_ !! _); by simplify_eq/=.
844Qed.
845
846Opaque interp_eq_list interp_lt_list interp_eq_attr.
847
848Lemma interp_bin_op_proper op v1 v2 :
849 val_to_expr v1 = val_to_expr v2 →
850 match interp_bin_op op v1, interp_bin_op op v2 with
851 | None, None => True
852 | Some f1, Some f2 => ∀ v1' v2',
853 val_to_expr v1' = val_to_expr v2' →
854 thunk_to_expr <$> f1 v1' = thunk_to_expr <$> f2 v2'
855 | _, _ => False
856 end.
857Proof.
858 intros. unfold interp_bin_op, interp_eq;
859 repeat (done || case_match || simplify_eq/= ||
860 destruct (option_to_eq_Some _) as [[]|]);
861 intros [] [] ?; simplify_eq/=;
862 repeat match goal with
863 | _ => done
864 | _ => progress simplify_option_eq
865 | _ => rewrite map_fmap_singleton
866 | _ => rewrite map_fmap_union
867 | _ => case_match
868 | |- context[ maybe _ ?x ] => is_var x; destruct x
869 end; auto with congruence.
870 - f_equal. by apply interp_eq_list_proper.
871 - apply (f_equal length) in H, H0. rewrite !length_fmap in H H0. congruence.
872 - apply (f_equal length) in H, H0. rewrite !length_fmap in H H0. congruence.
873 - f_equal. apply interp_eq_attr_proper.
874 + rewrite 2!map_fmap_compose in H. by simplify_eq.
875 + rewrite 2!map_fmap_compose in H0. by simplify_eq.
876 - apply (f_equal dom) in H, H0. rewrite !dom_fmap_L in H H0. congruence.
877 - apply (f_equal dom) in H, H0. rewrite !dom_fmap_L in H H0. congruence.
878 - destruct v1, v2; by simplify_eq/=.
879 - repeat destruct (option_to_eq_Some _) as [[]|]; simplify_eq/=; auto.
880 - do 3 f_equal. apply map_eq=> y. rewrite !lookup_fmap.
881 apply (f_equal (.!! y)) in H. rewrite !lookup_fmap in H.
882 repeat destruct (_ !! _) as [[]|]; naive_solver.
883 - f_equal. by apply interp_lt_list_proper.
884 - rewrite !fmap_insert /=. auto 10 with f_equal.
885 - by rewrite !fmap_app H0 H.
886 - apply (f_equal (.!! s)) in H. rewrite !lookup_fmap in H.
887 repeat destruct (_ !! _); simplify_eq/=; by f_equal.
888 - apply (f_equal (.!! s)) in H. rewrite !lookup_fmap in H.
889 repeat destruct (_ !! _); simplify_eq/=; by f_equal.
890 - rewrite !fmap_delete. congruence.
891 - assert (∀ y, is_Some (ts !! y) ↔ is_Some (ts0 !! y)) as Hx.
892 { intros y. rewrite -!(fmap_is_Some (AttrN ∘ thunk_to_expr)) -!lookup_fmap.
893 by rewrite H. }
894 apply (map_minimal_key_Some _) in H5 as [[t1 Hx1] ?], H8 as [[t2 Hx2] ?].
895 assert (s0 = s) as -> by (apply (anti_symm attr_le); naive_solver).
896 pose proof (f_equal (.!! s) H) as Hs. rewrite !lookup_fmap in Hs.
897 rewrite !fmap_insert !fmap_empty /= !lookup_total_alt Hx1 Hx2 /=.
898 rewrite Hx1 Hx2 /= in Hs. simplify_eq/=. rewrite Hs !fmap_delete H. done.
899 - apply map_minimal_key_None in H8 as ->.
900 rewrite fmap_empty in H. by apply fmap_empty_inv in H as ->.
901 - apply map_minimal_key_None in H5 as ->.
902 rewrite fmap_empty in H. by apply symmetry, fmap_empty_inv in H as ->.
903Qed.
904
905Lemma interp_match_proper E1 E2 ts1 ts2 ms1 ms2 strict :
906 thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 →
907 fmap (M:=option) (subst_env E1) <$> ms1 = fmap (subst_env E2) <$> ms2 →
908 fmap (M:=gmap string) (tattr_to_attr E1) <$> interp_match ts1 ms1 strict
909 = fmap (tattr_to_attr E2) <$> interp_match ts2 ms2 strict.
910Proof.
911 revert ms2 ts1 ts2.
912 induction ms1 as [|x m1 ms1 Hmsx IH] using map_ind; intros ms2 ts1 ts2 Hts Hms.
913 { rewrite fmap_empty in Hms. apply symmetry, fmap_empty_inv in Hms as ->.
914 rewrite /interp_match !merge_empty_r. revert ts2 Hts.
915 induction ts1 as [|x t1 ts1 Htsx IH] using map_ind; intros ts2 Hts.
916 { rewrite fmap_empty in Hts. by apply symmetry, fmap_empty_inv in Hts as ->. }
917 rewrite fmap_insert in Hts.
918 apply symmetry, fmap_insert_inv in Hts as (t2&ts2'&?&Htsx2&->&Hts);
919 last by rewrite lookup_fmap Htsx.
920 rewrite !omap_insert /=. destruct strict; simpl;
921 rewrite ?map_mapM_insert_option ?delete_notin //= ?lookup_omap ?Htsx ?Htsx2;
922 auto. }
923 rewrite fmap_insert in Hms.
924 apply symmetry, fmap_insert_inv in Hms as (m2&ms2'&?&Hmsx2&->&Hms);
925 last by rewrite lookup_fmap Hmsx.
926 pose proof (f_equal (.!! x) Hts) as Hx. rewrite !lookup_fmap in Hx.
927 destruct (ts1 !! x) as [t1|] eqn:Hts1x, (ts2 !! x) as [t2|] eqn:Hts2x; simplify_eq/=.
928 - rewrite -(insert_delete ts1 x t1) // -(insert_delete ts2 x t2) //.
929 rewrite /interp_match. erewrite <-!insert_merge by done.
930 rewrite !map_mapM_insert_option ?lookup_merge ?lookup_delete ?Hmsx ?Hmsx2 //=.
931 apply (f_equal (delete x)) in Hts. rewrite -!fmap_delete in Hts.
932 eapply IH in Hms; [|done]. rewrite /interp_match in Hms.
933 repeat destruct (map_mapM id _); simplify_eq/=; [|done..].
934 rewrite !fmap_insert /=. auto with f_equal.
935 - rewrite /interp_match.
936 rewrite -!(insert_merge_r _ ts1 _ _ (inl <$> m1));
937 last (rewrite Hts1x; by destruct m1).
938 rewrite -!(insert_merge_r _ ts2 _ _ (inl <$> m2));
939 last (rewrite Hts2x; by destruct m2).
940 rewrite !map_mapM_insert_option ?lookup_merge ?Hts1x ?Hts2x ?Hmsx ?Hmsx2 //.
941 eapply IH in Hms; [|done]. rewrite /interp_match in Hms.
942 destruct m1, m2; simplify_eq/=; auto.
943 repeat destruct (map_mapM id _); simplify_eq/=; [|done..].
944 rewrite !fmap_insert /=. auto with f_equal.
945Qed.
946
947Lemma mapM_interp_proper' n ts1 ts2 mvs :
948 (∀ v1 v2 mv,
949 val_to_expr v1 = val_to_expr v2 →
950 force_deep n v1 = Res mv →
951 ∃ mw m, force_deep m v2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) →
952 (∀ t1 t2 mv,
953 thunk_to_expr t1 = thunk_to_expr t2 →
954 interp_thunk n t1 = Res mv →
955 ∃ mw m, interp_thunk m t2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) →
956 thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 →
957 mapM (mbind (force_deep n) ∘ interp_thunk n) ts1 = Res mvs →
958 ∃ mws m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧
959 fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws.
960Proof.
961 intros force_deep_proper interp_thunk_proper Hts.
962 revert mvs. rewrite list_eq_Forall2 Forall2_fmap in Hts.
963 induction Hts as [|t1 t2 ts1 ts2 ?? IH]; intros mvs ?; simplify_res.
964 { by exists (Some []), 0. }
965 destruct (interp_thunk _ _) as [mv|] eqn:Hinterp'; simplify_res.
966 eapply interp_thunk_proper in Hinterp'
967 as (mw & m1 & Hinterp1 & Hw); [|by eauto..].
968 destruct mv as [v|], mw as [w|]; simplify_res; last first.
969 { exists None, m1. by rewrite /= Hinterp1. }
970 destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res.
971 eapply force_deep_proper in Hforce as (mw' & m2 & Hforce2 & Hw'); last done.
972 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
973 { exists None, (m1 `max` m2).
974 rewrite (interp_thunk_le Hinterp1) /=; last lia.
975 rewrite (force_deep_le Hforce2) /=; last lia. done. }
976 destruct (mapM _ _) as [mvs'|] eqn:?; simplify_res.
977 destruct (IH _ eq_refl) as (mws & m3 & Hmap3 & ?).
978 exists ((w' ::.) <$> mws), (S (m1 `max` m2 `max` m3)).
979 rewrite (interp_thunk_le Hinterp1) /=; last lia.
980 rewrite (force_deep_le Hforce2) /=; last lia.
981 rewrite (mapM_interp_le Hmap3) /=; last lia. split; [by destruct mws|].
982 destruct mvs', mws; simplify_res; auto 10 with f_equal.
983Qed.
984
985Lemma force_deep_proper n v1 v2 mv :
986 val_to_expr v1 = val_to_expr v2 →
987 force_deep n v1 = Res mv →
988 ∃ mw m, force_deep m v2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw
989with interp_proper n E1 E2 e1 e2 mv :
990 subst_env E1 e1 = subst_env E2 e2 →
991 interp n E1 e1 = Res mv →
992 ∃ mw m, interp m E2 e2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw
993with interp_thunk_proper n t1 t2 mv :
994 thunk_to_expr t1 = thunk_to_expr t2 →
995 interp_thunk n t1 = Res mv →
996 ∃ mw m, interp_thunk m t2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw
997with interp_app_proper n v1 v2 t1' t2' mv :
998 val_to_expr v1 = val_to_expr v2 →
999 thunk_to_expr t1' = thunk_to_expr t2' →
1000 interp_app n v1 t1' = Res mv →
1001 ∃ mw m, interp_app m v2 t2' = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw.
1002Proof.
1003 (* force_deep_proper *)
1004 - destruct n as [|n]; [done|].
1005 intros Hv Hinterp. rewrite force_deep_S /force_deep1 in Hinterp.
1006 destruct v1 as [| | |ts1|ts1], v2 as [| | |ts2|ts2]; simplify_res.
1007 { eexists _, 1; split; [by rewrite force_deep_S|]. done. }
1008 { eexists _, 1; split; [by rewrite force_deep_S|]. simpl. auto with f_equal. }
1009 { eexists _, 1; split; [by rewrite force_deep_S|]. simpl. auto with f_equal. }
1010 { destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res.
1011 eapply mapM_interp_proper' in Hmap as (mws & m & Hmap & Hmvs); [|by eauto..].
1012 exists (VList ∘ fmap Forced <$> mws), (S m).
1013 rewrite force_deep_S /= Hmap. split; [done|].
1014 destruct mvs, mws; simplify_eq/=; do 2 f_equal.
1015 rewrite list_eq_Forall2 Forall2_fmap in Hmvs.
1016 by rewrite list_eq_Forall2 !Forall2_fmap. }
1017 destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap; simplify_res.
1018 assert (∃ mws m,
1019 map_mapM_sorted attr_le
1020 (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧
1021 fmap (M:=gmap _) val_to_expr <$> mvs = fmap (M:=gmap _) val_to_expr <$> mws)
1022 as (mws & m & Hmap' & Hmvs); last first.
1023 { exists (VAttr ∘ fmap Forced <$> mws), (S m).
1024 rewrite force_deep_S /= Hmap'. split; [done|].
1025 destruct mvs, mws; simplify_eq/=; do 2 f_equal.
1026 apply map_eq=> x. rewrite !lookup_fmap.
1027 apply (f_equal (.!! x)) in Hmvs. rewrite !lookup_fmap in Hmvs.
1028 repeat destruct (_ !! x); simplify_res; auto with f_equal. }
1029 revert ts2 mvs Hmap Hv. induction ts1 as [|x t1 ts1 Hx1 ? IH]
1030 using (map_sorted_ind attr_le); intros ts2' mvs Hmap Hts.
1031 { exists (Some ∅), 0. rewrite fmap_empty in Hts.
1032 apply symmetry, fmap_empty_inv in Hts as ->.
1033 rewrite map_mapM_sorted_empty in Hmap; simplify_res.
1034 by rewrite map_mapM_sorted_empty. }
1035 rewrite map_mapM_sorted_insert //= in Hmap. rewrite fmap_insert in Hts.
1036 apply symmetry, fmap_insert_inv in Hts as (t2 & ts2 & Ht & ? & -> & Hts);
1037 simplify_eq/=; last by rewrite lookup_fmap Hx1.
1038 assert (∀ j, is_Some (ts2 !! j) → attr_le x j).
1039 { intros j. rewrite -(fmap_is_Some (AttrN ∘ thunk_to_expr)).
1040 rewrite -lookup_fmap -Hts lookup_fmap fmap_is_Some. auto. }
1041 destruct (interp_thunk _ _) as [mv|] eqn:Hinterp'; simplify_res.
1042 eapply interp_thunk_proper in Hinterp'
1043 as (mw & m1 & Hinterp1 & Hw); [|by eauto..].
1044 destruct mv as [v|], mw as [w|]; simplify_res; last first.
1045 { exists None, m1. by rewrite map_mapM_sorted_insert //= Hinterp1. }
1046 destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res.
1047 eapply force_deep_proper in Hforce as (mw' & m2 & Hforce2 & Hw'); last done.
1048 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1049 { exists None, (m1 `max` m2). rewrite map_mapM_sorted_insert //=.
1050 rewrite (interp_thunk_le Hinterp1) /=; last lia.
1051 rewrite (force_deep_le Hforce2) /=; last lia. done. }
1052 destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:?; simplify_res.
1053 eapply IH in Hts as (mws & m3 & Hmap3 & ?); last done.
1054 exists (<[x:=w']> <$> mws), (S (m1 `max` m2 `max` m3)).
1055 rewrite map_mapM_sorted_insert //=.
1056 rewrite (interp_thunk_le Hinterp1) /=; last lia.
1057 rewrite (force_deep_le Hforce2) /=; last lia.
1058 rewrite (map_mapM_interp_le Hmap3) /=; last lia.
1059 destruct mvs' as [vs'|], mws as [ws'|]; simplify_res; last done.
1060 split; [done|]. rewrite !fmap_insert. auto 10 with f_equal.
1061 (* interp_proper *)
1062 - destruct n as [|n]; [done|]. intros Hsubst Hinterp.
1063 rewrite 2!subst_env_eq in Hsubst.
1064 rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done.
1065 + (* ELit *)
1066 case_guard; simplify_res.
1067 * eexists (Some (VLit _ ltac:(done))), 1. by rewrite interp_lit.
1068 * exists None, 1. split; [|done]. rewrite interp_S /=. by case_guard.
1069 + (* EId *)
1070 assert (∀ (mke : option (kind * expr)) (E : env) x,
1071 prod_map id thunk_to_expr <$>
1072 union_kinded (E !! x) (prod_map id (Thunk ∅) <$> mke)
1073 = union_kinded (prod_map id thunk_to_expr <$> E !! x) mke) as HE.
1074 { intros mke' E x. destruct (E !! _) as [[[] ?]|], mke' as [[[] ?]|];
1075 simplify_eq/=; rewrite ?subst_env_empty //. }
1076 rewrite -!HE {HE} in H.
1077 destruct (union_kinded (E1 !! _) _) as [[k1 t1]|],
1078 (union_kinded (E2 !! _) _) as [[k2 t2]|] eqn:HE2; simplify_res; last first.
1079 { exists None, (S n). rewrite interp_S /=. by rewrite HE2. }
1080 eapply interp_thunk_proper
1081 in Hinterp as (mw & m & Hinterp & ?); [|by eauto..].
1082 exists mw, (S (n `max` m)). split; [|done]. rewrite interp_S /= HE2 /=.
1083 eauto using interp_thunk_le with lia.
1084 + (* EAbs *) eexists (Some (VClo _ _ _)), 1; split; [by rewrite interp_S|].
1085 simpl. auto with f_equal.
1086 + (* EAbsMatch *)
1087 eexists (Some (VCloMatch _ _ _ _)), 1; split; [by rewrite interp_S|].
1088 simpl. auto with f_equal.
1089 + (* EApp *)
1090 destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp'; simplify_eq/=.
1091 eapply interp_proper in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
1092 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
1093 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
1094 destruct (interp_app n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
1095 eapply (interp_app_proper _ _ _ _ (Thunk _ _)) in Hinterp'
1096 as (mw & m2 & Hinterp2 & ?); [|done..].
1097 exists mw, (S (m1 `max` m2)). rewrite interp_S /=.
1098 rewrite (interp_le Hinterp1) /=; last lia.
1099 rewrite (interp_app_le Hinterp2) /=; last lia. done.
1100 + (* ESeq *)
1101 destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp'; simplify_eq/=.
1102 eapply interp_proper in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
1103 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
1104 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
1105 destruct μ0; simplify_res.
1106 { eapply interp_proper in Hinterp as (w2 & m2 & Hinterp2 & ?); last done.
1107 exists w2, (S (m1 `max` m2)). rewrite interp_S /=.
1108 rewrite (interp_le Hinterp1) /=; last lia.
1109 rewrite (interp_le Hinterp2) /=; last lia. done. }
1110 destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res.
1111 eapply force_deep_proper in Hforce as (mw' & m2 & Hforce & ?); last done.
1112 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1113 { exists None, (S (m1 `max` m2)). rewrite interp_S /=.
1114 rewrite (interp_le Hinterp1) /=; last lia.
1115 rewrite (force_deep_le Hforce) /=; last lia. done. }
1116 eapply interp_proper in Hinterp as (w2 & m3 & Hinterp3 & ?); last done.
1117 exists w2, (S (m1 `max` m2 `max` m3)). rewrite interp_S /=.
1118 rewrite (interp_le Hinterp1) /=; last lia.
1119 rewrite (force_deep_le Hforce) /=; last lia.
1120 rewrite (interp_le Hinterp3) /=; last lia. done.
1121 + (* EList *)
1122 eexists (Some (VList _)), 1; rewrite interp_S /=; split; [done|].
1123 do 2 f_equal. revert es0 Hsubst.
1124 induction es; intros [] ?; simplify_eq/=; f_equal/=; auto.
1125 + (* EAttr *)
1126 eexists (Some (VAttr _)), 1; rewrite interp_S /=; split; [done|].
1127 do 2 f_equal. apply map_eq=> x. rewrite !lookup_fmap.
1128 pose proof (f_equal (.!! x) Hsubst) as Hx. rewrite !lookup_fmap in Hx.
1129 destruct (αs !! x) as [[[]]|], (αs0 !! x) as [[[]]|];
1130 simplify_eq/=; do 2 f_equal; auto.
1131 apply indirects_env_proper, Hx. by rewrite !tattr_to_attr_from_attr.
1132 + (* ELetAttr *)
1133 destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_eq/=.
1134 eapply interp_proper in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done.
1135 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1136 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
1137 destruct (maybe VAttr _) eqn:Hattr; simplify_res; last first.
1138 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
1139 by assert (maybe VAttr w' = None) as -> by (by destruct v', w'). }
1140 destruct v', w'; simplify_res.
1141 eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & ?);
1142 [|by apply subst_env_union_fmap_proper].
1143 exists mw, (S (m1 `max` m2)). rewrite interp_S /=.
1144 rewrite (interp_le Hinterp1) /=; last lia.
1145 rewrite (interp_le Hinterp2) /=; last lia. done.
1146 + (* EBinOp *)
1147 destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp1; simplify_res.
1148 eapply interp_proper in Hinterp1 as (mw1 & m1 & Hinterp1 & Hw1); last done.
1149 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
1150 { exists None. exists (S m1). by rewrite interp_S /= Hinterp1. }
1151 apply (interp_bin_op_proper op0) in Hw1.
1152 destruct (interp_bin_op _ v1) as [f|] eqn:Hop1,
1153 (interp_bin_op _ w1) as [g|] eqn:Hop2; simplify_res; try done; last first.
1154 { exists None. exists (S m1). by rewrite interp_S /= Hinterp1 /= Hop2. }
1155 destruct (interp n _ e1_2) as [mv2|] eqn:Hinterp2; simplify_res.
1156 eapply interp_proper in Hinterp2 as (mw2 & m2 & Hinterp2 & Hw2); last done.
1157 destruct mv2 as [v2|], mw2 as [w2|]; simplify_res; last first.
1158 { exists None. exists (S (m1 `max` m2)). rewrite interp_S /=.
1159 rewrite (interp_le Hinterp1) /=; last lia.
1160 rewrite Hop2 /= (interp_le Hinterp2) /=; last lia. done. }
1161 apply Hw1 in Hw2.
1162 destruct (f v2) as [t|] eqn:Hf,
1163 (g w2) as [t'|] eqn:Hg; simplify_res; last first.
1164 { exists None. exists (S (m1 `max` m2)). rewrite interp_S /=.
1165 rewrite (interp_le Hinterp1) /=; last lia.
1166 rewrite Hop2 /= (interp_le Hinterp2) /=; last lia. by rewrite Hg. }
1167 eapply interp_thunk_proper in Hinterp
1168 as (mw & m3 & Hforce3 & Hw); [|by eauto..].
1169 exists mw, (S (m1 `max` m2 `max` m3)). rewrite interp_S /=. split; [|done].
1170 rewrite (interp_le Hinterp1) /=; last lia.
1171 rewrite Hop2 /= (interp_le Hinterp2) /=; last lia.
1172 rewrite Hg /=. eauto using interp_thunk_le with lia.
1173 + (* EIf *)
1174 destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp1; simplify_res.
1175 eapply interp_proper in Hinterp1 as (mw1 & m1 & Hinterp1 & Hw1); last done.
1176 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
1177 { exists None. exists (S m1). by rewrite interp_S /= Hinterp1. }
1178 destruct (maybe_VLit _ ≫= maybe LitBool) as [b|] eqn:Hbool;
1179 simplify_res; last first.
1180 { exists None. exists (S m1). rewrite interp_S /= Hinterp1 /=.
1181 destruct v1, w1; repeat destruct select base_lit; naive_solver. }
1182 eapply (interp_proper _ _ _ _ (if b then _ else _)) in Hinterp
1183 as (mw & m2 & Hinterp & Hw); last by destruct b.
1184 exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=.
1185 rewrite (interp_le Hinterp1) /=; last lia.
1186 assert (maybe_VLit w1 ≫= maybe LitBool = Some b) as ->.
1187 { destruct v1, w1; repeat destruct select base_lit; naive_solver. }
1188 rewrite /=. eauto using interp_le with lia.
1189 (* interp_thunk_proper *)
1190 - destruct n as [|n]; [done|].
1191 intros Ht Hinterp. rewrite interp_thunk_S in Hinterp.
1192 destruct t1 as [v1|E1 e1|x1 E1 tαs1], t2 as [v2|E2 e2|x2 E2 tαs2]; simplify_res.
1193 + exists (Some v2), 1. rewrite interp_thunk_S /=. auto with f_equal.
1194 + destruct (interp_val_to_expr E2 e2 v1) as (w & m & ? & ?); first done.
1195 exists (Some w), (S m); simpl; auto with f_equal.
1196 + by destruct v1.
1197 + exists (Some v2), 1; split; [done|]; simpl.
1198 symmetry. eauto using interp_val_to_expr_Res.
1199 + eapply interp_proper in Hinterp as (mw & m & ? & ?); eauto.
1200 exists mw, (S m). eauto.
1201 + assert (∃ αs1, e1 = ESelect (EAttr αs1) x2 ∧
1202 attr_subst_env E1 <$> αs1 = tattr_to_attr E2 <$> tαs2) as (αs1 & -> & Hαs).
1203 { repeat match goal with
1204 | H : subst_env _ ?e = _ |- _ =>
1205 rewrite subst_env_eq in H; destruct e; simplify_eq; []
1206 end; eauto. }
1207 clear Ht. destruct n as [|n]; [done|].
1208 rewrite !interp_S /= in Hinterp.
1209 (* without [in Hinterp at 2 3] the termination checker loops *)
1210 destruct n as [|n'] in Hinterp at 2 3; [done|].
1211 rewrite !interp_S /= lookup_fmap in Hinterp.
1212 pose proof (f_equal (.!! x2) Hαs) as Hx. rewrite !lookup_fmap in Hx.
1213 destruct (αs1 !! x2) as [[[] e1]|],
1214 (tαs2 !! x2) as [[e2|t2]|] eqn:Hx2; simplify_res.
1215 * rewrite -tattr_to_attr_from_attr in Hαs.
1216 destruct n as [|n]; [done|]. rewrite interp_thunk_S in Hinterp.
1217 eapply interp_proper in Hinterp as (mw & m & Hinterp & ?);
1218 last by apply indirects_env_proper.
1219 exists mw, (S m). by rewrite interp_thunk_S /= Hx2.
1220 * eapply interp_thunk_proper in Hinterp
1221 as (mw & m & Hinterp & ?); last done.
1222 exists mw, (S m). rewrite interp_thunk_S /= Hx2. done.
1223 * exists None, (S n). by rewrite interp_thunk_S /= Hx2.
1224 + by destruct v2.
1225 + assert (∃ αs2, e2 = ESelect (EAttr αs2) x1 ∧
1226 attr_subst_env E2 <$> αs2 = tattr_to_attr E1 <$> tαs1) as (αs2 & -> & Hαs).
1227 { repeat match goal with
1228 | H : _ = subst_env _ ?e |- _ =>
1229 rewrite subst_env_eq in H; destruct e; simplify_eq; []
1230 end; eauto. }
1231 clear Ht.
1232 pose proof (f_equal (.!! x1) Hαs) as Hx. rewrite !lookup_fmap in Hx.
1233 destruct (tαs1 !! x1) as [[e1|t1]|],
1234 (αs2 !! x1) as [[[] e2]|] eqn:Hx2; simplify_res.
1235 * rewrite -tattr_to_attr_from_attr in Hαs.
1236 eapply interp_proper in Hinterp as (mw & m & Hinterp & ?);
1237 last by apply indirects_env_proper.
1238 exists mw, (S (S (S m))). rewrite interp_thunk_S /= !interp_S /=.
1239 rewrite lookup_fmap Hx2 /= interp_thunk_S /=. done.
1240 * apply (interp_thunk_proper _ _ (Thunk E2 e2))
1241 in Hinterp as (mw & m & Hinterp & ?); last done.
1242 destruct m as [|m]; [done|].
1243 exists mw, (S (S (S m))). rewrite interp_thunk_S /= !interp_S /=.
1244 rewrite lookup_fmap Hx2 /= interp_thunk_S /=. done.
1245 * exists None, (S (S (S n))). rewrite interp_thunk_S /= !interp_S /=.
1246 rewrite lookup_fmap Hx2 /=. done.
1247 + pose proof (f_equal (.!! x2) Ht) as Hx. rewrite !lookup_fmap in Hx.
1248 destruct (tαs1 !! x2) as [[e1|t1]|] eqn:Hx1,
1249 (tαs2 !! _) as [[e2|t2]|] eqn:Hx2; simplify_res.
1250 * eapply interp_proper in Hinterp
1251 as (mw & m & Hinterp & ?); [|by apply indirects_env_proper].
1252 exists mw, (S m). rewrite interp_thunk_S /= Hx2. done.
1253 * eapply interp_thunk_proper in Hinterp as (mw & m & Hinterp & ?); [|done].
1254 exists mw, (S m). rewrite interp_thunk_S /= Hx2. done.
1255 * exists None, 1. by rewrite interp_thunk_S /= Hx2.
1256 (* interp_app_proper *)
1257 - destruct n as [|n]; [done|].
1258 intros Hv Ht Hinterp. rewrite interp_app_S /= in Hinterp.
1259 destruct v1, v2; simplify_res.
1260 + (* VLit *) by eexists None, 1.
1261 + (* VClo *)
1262 eapply interp_proper in Hinterp as (mw & m & Hinterp' & ?);
1263 last by eapply subst_env_insert_proper.
1264 eexists _, (S m). rewrite interp_app_S /= Hinterp'. done.
1265 + (* VCloMatch *)
1266 destruct (interp_thunk n t1') as [mv1|] eqn:Hthunk; simplify_res.
1267 eapply interp_thunk_proper in Hthunk as (mw1 & m1 & Hthunk & Hw); [|by eauto..].
1268 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
1269 { exists None, (S m1). split; [|done].
1270 rewrite interp_app_S /= Hthunk /=. done. }
1271 destruct (maybe VAttr v1) as [ts1|] eqn:?; simplify_res; last first.
1272 { exists None, (S m1). split; [|done].
1273 rewrite interp_app_S /= Hthunk /=. destruct v1, w1; naive_solver. }
1274 destruct v1, w1; simplify_eq/=.
1275 rewrite 2!map_fmap_compose in Hw. apply (inj _) in Hw.
1276 eapply (interp_match_proper _ _ _ _ _ _ strict0) in Hw; last done.
1277 destruct (interp_match ts1 _ _) as [tαs1|] eqn:Hmatch1,
1278 (interp_match ts0 _ _) as [tαs2|] eqn:Hmatch2;
1279 simplify_res; try done; last first.
1280 { exists None, (S m1). split; [|done].
1281 rewrite interp_app_S /= Hthunk /= Hmatch2. done. }
1282 eapply interp_proper in Hinterp as (mw & m2 & Hinterp & ?); last first.
1283 { by apply indirects_env_proper. }
1284 exists mw, (S (m1 `max` m2)). split; [|done].
1285 rewrite interp_app_S /=.
1286 rewrite (interp_thunk_le Hthunk) /=; last lia.
1287 rewrite Hmatch2 /=. eauto using interp_le with lia.
1288 + (* VList *) by eexists None, 1.
1289 + (* VAttr *)
1290 pose proof (f_equal (.!! "__functor") Hv) as Htf.
1291 rewrite !lookup_fmap /= in Htf.
1292 destruct (ts !! _) as [e|] eqn:Hfunc, (ts0 !! _) as [e'|] eqn:Hfunc';
1293 simplify_res; last first.
1294 { exists None, 1. by rewrite interp_app_S /= Hfunc'. }
1295 destruct (interp_thunk _ _) as [mv'|] eqn:Hinterp'; simplify_res.
1296 eapply interp_thunk_proper in Hinterp'
1297 as (mw' & m1 & Hinterp1 & Hw'); [|by eauto..].
1298 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1299 { exists None, (S m1). by rewrite interp_app_S /= Hfunc' /= Hinterp1. }
1300 destruct (interp_app _ _ _) as [mv'|] eqn:Happ; simplify_res.
1301 eapply (interp_app_proper _ _ _ _ (Forced (VAttr _))) in Happ
1302 as (mw' & m2 & Happ2 & ?); [|done|by rewrite /= Hv].
1303 destruct mv', mw'; simplify_res; last first.
1304 { exists None, (S (m1 `max` m2)). rewrite interp_app_S /= Hfunc' /=.
1305 rewrite (interp_thunk_le Hinterp1) /=; last lia.
1306 rewrite (interp_app_le Happ2) /=; last lia. done. }
1307 eapply interp_app_proper in Hinterp as (mw' & m3 & Happ3 & ?); [|done..].
1308 exists mw', (S (m1 `max` m2 `max` m3)). rewrite interp_app_S /= Hfunc' /=.
1309 rewrite (interp_thunk_le Hinterp1) /=; last lia.
1310 rewrite (interp_app_le Happ2) /=; last lia.
1311 rewrite (interp_app_le Happ3) /=; last lia. done.
1312Qed.
1313
1314Lemma mapM_interp_proper n ts1 ts2 mvs :
1315 thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 →
1316 mapM (mbind (force_deep n) ∘ interp_thunk n) ts1 = Res mvs →
1317 ∃ mws m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧
1318 fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws.
1319Proof. eauto using mapM_interp_proper', force_deep_proper, interp_thunk_proper. Qed.
1320
1321Lemma interp_thunk_as_interp n t mv :
1322 interp_thunk n t = Res mv →
1323 ∃ mw m, interp m ∅ (thunk_to_expr t) = Res mw ∧
1324 val_to_expr <$> mv = val_to_expr <$> mw.
1325Proof.
1326 revert t mv. induction n as [|n IH]; intros t mv Hinterp; [done|].
1327 rewrite interp_thunk_S in Hinterp. destruct t as [v|E e|x E tαs]; simplify_res.
1328 { destruct (interp_empty_val_to_expr v) as (w & m & Hinterp & ?).
1329 exists (Some w), m; simpl; auto using f_equal. }
1330 { eapply interp_proper, Hinterp. by rewrite subst_env_empty. }
1331 destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res.
1332 - eapply interp_proper in Hinterp as (mw & m & Hinterp & ?);
1333 last apply subst_env_indirects_env.
1334 exists mw, (S (S m)). rewrite !interp_S /=.
1335 rewrite !lookup_fmap Hx /= interp_thunk_S /=. done.
1336 - apply IH in Hinterp as (mw & m & Hinterp & ?).
1337 exists mw, (S (S m)). rewrite !interp_S /=.
1338 rewrite !lookup_fmap Hx /= interp_thunk_S //=.
1339 - exists None, (S (S n)). rewrite !interp_S /=.
1340 by rewrite !lookup_fmap Hx /=.
1341Qed.
1342
1343Lemma interp_as_interp_thunk n t mv :
1344 interp n ∅ (thunk_to_expr t) = Res mv →
1345 ∃ mw m, interp_thunk m t = Res mw ∧
1346 val_to_expr <$> mv = val_to_expr <$> mw.
1347Proof.
1348 revert t mv. induction (lt_wf n) as [[|n] _ IH]; intros t mv Hinterp; [done|].
1349 destruct t as [v|E e|x E tαs]; simplify_res.
1350 { apply interp_empty_val_to_expr_Res in Hinterp. by exists (Some v), 1. }
1351 { eapply (interp_proper _ _ E) in Hinterp as (mw & m & Hinterp & ?);
1352 [|by rewrite subst_env_empty].
1353 exists mw, (S m). by rewrite interp_thunk_S /=. }
1354 destruct n as [|n]; [done|]. rewrite !interp_S /= in Hinterp.
1355 rewrite !lookup_fmap in Hinterp.
1356 destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res.
1357 - rewrite interp_thunk_S /= in Hinterp.
1358 eapply interp_proper in Hinterp as (mw & m & Hinterp & ?);
1359 last apply symmetry, subst_env_indirects_env.
1360 exists mw, (S m). rewrite interp_thunk_S /= Hx. done.
1361 - rewrite interp_thunk_S /= in Hinterp.
1362 eapply IH in Hinterp as (mw & m & Hinterp & ?); last lia.
1363 exists mw, (S m). rewrite !interp_thunk_S /= Hx. done.
1364 - exists None, (S n). rewrite !interp_thunk_S /= Hx. done.
1365Qed.
1366
1367Lemma delayed_interp n e e' mv :
1368 interp n ∅ e' = Res mv →
1369 e =D=> e' →
1370 ∃ m, interp m ∅ e = Res mv.
1371Proof.
1372 intros Hinterp Hdel. revert n mv Hinterp. induction Hdel; intros n mv Hinterp.
1373 - by eauto.
1374 - apply IHHdel in Hinterp as [m Hinterp].
1375 exists (S (S m)). rewrite interp_S /= lookup_empty left_id_L /=.
1376 by rewrite interp_thunk_S /=.
1377 - destruct n as [|n]; [done|]. rewrite interp_S /= in Hinterp.
1378 destruct (interp _ _ e1') as [mv1|] eqn:Hinterp1; simplify_res.
1379 apply IHHdel1 in Hinterp1 as [m1 Hinterp1].
1380 destruct mv1 as [v1|]; simplify_res; last first.
1381 { exists (S m1). by rewrite interp_S /= Hinterp1. }
1382 destruct (interp_bin_op op v1) as [f|] eqn:Hf; simplify_res; last first.
1383 { exists (S m1). by rewrite interp_S /= Hinterp1 /= Hf. }
1384 destruct (interp _ _ e2') as [mv2|] eqn:Hinterp2; simplify_res.
1385 apply IHHdel2 in Hinterp2 as [m2 Hinterp2]. exists (S (n `max` m1 `max` m2)).
1386 rewrite interp_S /= (interp_le Hinterp1); last lia.
1387 rewrite /= Hf /= (interp_le Hinterp2); last lia.
1388 destruct mv2; simplify_res; [|done].
1389 destruct (f _); simplify_res; [|done].
1390 eauto using interp_thunk_le with lia.
1391 - destruct n as [|n]; [done|]. rewrite interp_S /= in Hinterp.
1392 destruct (interp _ _ e1') as [mv1|] eqn:Hinterp1; simplify_res.
1393 apply IHHdel1 in Hinterp1 as [m1 Hinterp1].
1394 destruct mv1 as [v1|]; simplify_res; last first.
1395 { exists (S m1). by rewrite interp_S /= Hinterp1. }
1396 destruct (maybe_VLit v1 ≫= maybe LitBool) as [[]|] eqn: Hbool; simplify_res.
1397 + apply IHHdel2 in Hinterp as [m2 Hinterp2]. exists (S (m1 `max` m2)).
1398 rewrite interp_S /= (interp_le Hinterp1); last lia.
1399 rewrite /= Hbool /=. eauto using interp_le with lia.
1400 + apply IHHdel3 in Hinterp as [m3 Hinterp3]. exists (S (m1 `max` m3)).
1401 rewrite interp_S /= (interp_le Hinterp1); last lia.
1402 rewrite /= Hbool /=. eauto using interp_le with lia.
1403 + exists (S m1). rewrite interp_S /= Hinterp1 /= Hbool. done.
1404Qed.
1405
1406Lemma interp_subst_abs n x e1 e2 mv :
1407 interp n ∅ (subst {[x:=(ABS, e2)]} e1) = Res mv →
1408 ∃ mw m, interp m (<[x:=(ABS, Thunk ∅ e2)]> ∅) e1 = Res mw ∧
1409 val_to_expr <$> mv = val_to_expr <$> mw.
1410Proof.
1411 apply interp_proper. by rewrite subst_env_empty subst_abs_as_subst_env.
1412Qed.
1413
1414Lemma interp_subst_indirects n e αs mv :
1415 interp n ∅ (subst (indirects αs) e) = Res mv →
1416 ∃ mw m,
1417 interp m (indirects_env ∅ (attr_to_tattr ∅ <$> αs)) e = Res mw ∧
1418 val_to_expr <$> mv = val_to_expr <$> mw.
1419Proof.
1420 apply interp_proper. rewrite subst_env_empty. rewrite subst_env_alt.
1421 f_equal. apply map_eq=> x. rewrite !lookup_fmap.
1422 destruct (αs !! x) eqn:?; do 2 f_equal/=;
1423 rewrite /indirects /indirects_env right_id_L !map_lookup_imap
1424 !lookup_fmap !Heqo //=.
1425 rewrite tattr_to_attr_from_attr_empty //.
1426Qed.
1427
1428Lemma interp_subst_fmap k n e es mv :
1429 interp n ∅ (subst ((k,.) <$> es) e) = Res mv →
1430 ∃ mw m, interp m ((k,.) ∘ Thunk ∅ <$> es) e = Res mw ∧
1431 val_to_expr <$> mv = val_to_expr <$> mw.
1432Proof.
1433 apply interp_proper. rewrite subst_env_empty. rewrite subst_env_alt.
1434 f_equal. apply map_eq=> x. rewrite !lookup_fmap.
1435 destruct (es !! x) as [d|]; do 2 f_equal/=. by rewrite subst_env_empty.
1436Qed.
1437
1438Lemma final_interp μ e :
1439 final μ e →
1440 ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w.
1441Proof.
1442 revert μ. induction e; intros μ'; intros Hfinal; try by inv Hfinal.
1443 - inv Hfinal. eexists (VLit _ _), 1. by rewrite interp_lit /=.
1444 - eexists (VClo _ _ _), 1. rewrite interp_S /=. split; [done|].
1445 by rewrite /= subst_env_empty.
1446 - eexists (VCloMatch _ _ _ _), 1. rewrite interp_S /=. split; [done|].
1447 rewrite /= subst_env_empty. f_equal.
1448 apply map_eq=> x. rewrite lookup_fmap.
1449 destruct (ms !! x) as [[]|]; do 2 f_equal/=. by rewrite subst_env_empty.
1450 - eexists (VList _), 1. rewrite interp_S /=. split; [done|]. f_equal. clear.
1451 induction es; f_equal/=; [|done].
1452 by rewrite /= subst_env_empty.
1453 - eexists (VAttr _), 1. rewrite interp_S /=. split; [done|].
1454 f_equal. apply map_eq=> x.
1455 assert (no_recs αs) by (by inv Hfinal).
1456 rewrite from_attr_no_recs // !lookup_fmap.
1457 destruct (_ !! _) as [[]|] eqn:?; f_equal/=.
1458 f_equal; eauto using no_recs_lookup, subst_env_empty.
1459Qed.
1460
1461Lemma final_force_deep' v :
1462 final DEEP (val_to_expr v) →
1463 ∃ w m, force_deep m v = mret w ∧ val_to_expr v = val_to_expr w.
1464Proof.
1465 intros Hfinal. remember (val_to_expr v) as e eqn:He.
1466 revert v He. induction e; intros [] ?; simplify_eq/=; inv Hfinal.
1467 - (* VLit *) eexists (VLit _ _), 1. by rewrite force_deep_S.
1468 - (* VClo *)
1469 eexists (VClo _ _ _), 1. by rewrite force_deep_S.
1470 - (* VCloMatch *)
1471 eexists (VCloMatch _ _ _ _), 1. by rewrite force_deep_S.
1472 - (* VList *)
1473 assert (∃ vs m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts = mret vs ∧
1474 val_to_expr <$> vs = thunk_to_expr <$> ts)
1475 as (vs & m & Hmap & Hvs); last first.
1476 { exists (VList (Forced <$> vs)), (S m). rewrite force_deep_S /= Hmap /=.
1477 split; [done|]. f_equal. rewrite -Hvs.
1478 clear. by induction vs; by f_equal/=. }
1479 rewrite Forall_fmap in H1. induction H1 as [|t ts Ht ? IH]; simplify_eq/=.
1480 { by exists [], 0. }
1481 apply Forall_cons in H as [IHt IHts].
1482 destruct IH as (ws & m1 & Hinterp1 & ?); simplify_eq/=; [done|]. clear IHts.
1483 destruct (final_interp DEEP (thunk_to_expr t))
1484 as (v' & m & Hinterp & ?); [done|].
1485 apply interp_as_interp_thunk in Hinterp
1486 as ([v''|] & m' & Hinterp & ?); simplify_res.
1487 destruct (IHt Ht v'') as (w & m'' & Hforce & ?); [congruence|].
1488 exists (w :: ws), (m1 `max` m' `max` m''); csimpl.
1489 rewrite (interp_thunk_le Hinterp) /=; last lia.
1490 rewrite (force_deep_le Hforce) /=; last lia.
1491 rewrite (mapM_interp_le Hinterp1) /=; last lia. auto with f_equal.
1492 - (* VAttr *) clear H1. assert (∃ vs m,
1493 map_mapM_sorted attr_le
1494 (mbind (force_deep m) ∘ interp_thunk m) ts = mret vs ∧
1495 val_to_expr <$> vs = thunk_to_expr <$> ts)
1496 as (vs & m & Hmap & Hvs); last first.
1497 { exists (VAttr (Forced <$> vs)), (S m). rewrite force_deep_S /= Hmap /=.
1498 split; [done|]. rewrite 2!map_fmap_compose -Hvs. f_equal.
1499 apply map_eq=> x. rewrite !lookup_fmap. by destruct (vs !! x). }
1500 induction ts as [|x t ts Hx ? IH] using (map_sorted_ind attr_le).
1501 { exists ∅, 0. by rewrite map_mapM_sorted_empty. }
1502 rewrite fmap_insert /= in H, H2.
1503 apply map_Forall_insert in H as [IHt IHts]; last by rewrite lookup_fmap Hx.
1504 apply map_Forall_insert in H2 as [Ht Hts]; last by rewrite lookup_fmap Hx.
1505 apply IH in IHts as (ws & m1 & Hinterp1 & ?); clear IH; simplify_eq/=; last done.
1506 destruct (final_interp DEEP (thunk_to_expr t))
1507 as (v' & m & Hinterp & ?); [done|].
1508 apply interp_as_interp_thunk in Hinterp
1509 as ([v''|] & m' & Hinterp & ?); simplify_res.
1510 destruct (IHt Ht v'') as (w & m'' & Hforce & ?); [congruence|].
1511 exists (<[x:=w]> ws), (m1 `max` m' `max` m'').
1512 rewrite fmap_insert map_mapM_sorted_insert //=.
1513 rewrite (interp_thunk_le Hinterp) /=; last lia.
1514 rewrite (force_deep_le Hforce) /=; last lia.
1515 rewrite (map_mapM_interp_le Hinterp1) /=; last lia.
1516 rewrite fmap_insert. auto with f_equal.
1517Qed.
1518
1519Lemma interp_step μ e1 e2 :
1520 e1 -{μ}-> e2 →
1521 (∀ n mv,
1522 ¬final SHALLOW e1 →
1523 interp n ∅ e2 = Res mv →
1524 exists mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) ∧
1525 (∀ n v1 v2 mv,
1526 μ = DEEP →
1527 e1 = val_to_expr v1 →
1528 e2 = val_to_expr v2 →
1529 force_deep n v2 = Res mv →
1530 exists mw m, force_deep m v1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw).
1531Proof.
1532 intros Hstep. induction Hstep; inv_step.
1533 - split; [|by intros ? []]. intros n mv _ Hinterp.
1534 apply interp_subst_abs in Hinterp as (mw & [|m] & Hinterp & Hv); simplify_eq/=.
1535 exists mw, (S (S (S m))). split; [|done].
1536 rewrite interp_S /= interp_app_S /= /= !interp_S /=.
1537 rewrite -!interp_S /=. rewrite (interp_le Hinterp); last lia. done.
1538 - split; [|by intros ? []]. intros n mv _ Hinterp.
1539 destruct n as [|n]; simplify_eq/=. apply interp_match_Some_2 in H0.
1540 apply interp_subst_indirects in Hinterp as (mw & m & Hinterp & ?).
1541 exists mw, (S (S (S (S m)))); split; [|done].
1542 rewrite !interp_S /= interp_app_S /= interp_thunk_S /= (interp_S m) /=.
1543 rewrite from_attr_no_recs // map_fmap_compose H0 /=.
1544 eauto using interp_le with lia.
1545 - split; [|by intros ? []]. intros n mv _ Hinterp.
1546 destruct n as [|[|[|n]]]; simplify_eq/=.
1547 rewrite !interp_S /= -!interp_S in Hinterp.
1548 destruct (interp _ _ e1) as [mw|] eqn:Hinterp'; simplify_res.
1549 destruct mw as [w|]; simplify_res; last first.
1550 { exists None, (S (S (S (S n)))). split; [|done].
1551 rewrite 2!interp_S /= interp_app_S /=.
1552 rewrite from_attr_no_recs // lookup_fmap H0 /=.
1553 rewrite interp_thunk_S /= Hinterp'. done. }
1554 destruct (interp_app _ _ _) as [mv'|] eqn:Happ; simplify_res.
1555 eapply (interp_app_proper _ _ _ _
1556 (Forced (VAttr (Thunk ∅ ∘ attr_expr <$> αs))))
1557 in Happ as (mw' & m1 & Happ1 & Hw); [|done|]; last first.
1558 { rewrite /= subst_env_eq /=. f_equal.
1559 apply map_eq=> y. rewrite !lookup_fmap.
1560 destruct (αs !! y) as [[]|] eqn:?; do 2 f_equal/=; eauto using no_recs_lookup. }
1561 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1562 { exists None, (S (S (S (S (n `max` m1))))). split; [|done].
1563 rewrite 2!interp_S /= interp_app_S /=.
1564 rewrite from_attr_no_recs // lookup_fmap H0 /=.
1565 rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia.
1566 rewrite (interp_app_le Happ1); last lia. done. }
1567 eapply interp_app_proper in Hinterp as (mw & m2 & ? & Hinterp); [|done..].
1568 exists mw, (S (S (S (S (n `max` m1 `max` m2))))). split; [|done].
1569 rewrite !interp_S /= interp_app_S /=.
1570 rewrite from_attr_no_recs // lookup_fmap H0 /=.
1571 rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia.
1572 rewrite (interp_app_le Happ1) /=; last lia.
1573 eauto using interp_app_le with lia.
1574 - split; [|by intros ? []]. intros n mv _ Hinterp.
1575 destruct (final_interp μ' e1) as (v & m & Hinterp' & ->); first done.
1576 destruct μ'.
1577 { exists mv, (S (n `max` m)). rewrite interp_S /=.
1578 rewrite (interp_le Hinterp) /=; last lia.
1579 by rewrite (interp_le Hinterp') /=; last lia. }
1580 destruct (final_force_deep' v) as (w & m' & Hforce & ?); first done.
1581 exists mv, (S (n `max` m `max` m')). rewrite interp_S /=.
1582 rewrite (interp_le Hinterp) /=; last lia.
1583 rewrite (interp_le Hinterp') /=; last lia.
1584 by rewrite (force_deep_le Hforce) /=; last lia.
1585 - split; [|by intros ? []]. intros n mv _ Hinterp.
1586 rewrite map_fmap_compose in Hinterp.
1587 apply interp_subst_fmap in Hinterp as (mw & [|m] & Hinterp & Hv); simplify_eq/=.
1588 rewrite map_fmap_compose in Hinterp.
1589 exists mw, (S (S m)). rewrite !interp_S /= -interp_S.
1590 rewrite from_attr_no_recs // right_id_L map_fmap_compose. done.
1591 - split; last first.
1592 { intros n [] v2 mv _ Hαs; simplify_eq/=. by destruct H. }
1593 intros n mv _ Hinterp. destruct n as [|n]; [done|].
1594 rewrite interp_S /= in Hinterp; simplify_res.
1595 eexists _, 1; split; [by rewrite interp_S|].
1596 do 2 f_equal/=. apply map_eq=> x /=. rewrite !lookup_fmap.
1597 destruct (αs !! x) as [[[] ?]|]; do 2 f_equal/=.
1598 by rewrite subst_env_indirects_env_attr_to_tattr_empty subst_env_empty.
1599 - split; [|by intros ? []]. intros n mv _ Hinterp.
1600 apply final_interp in H as (v1 & m1 & Hinterp1 & ->).
1601 pose proof H1 as Hsem. apply interp_bin_op_Some_2 in H1 as [f Hf].
1602 eapply final_interp in H0 as (v2 & m2 & Hinterp2 & ->).
1603 eapply interp_bin_op_Some_Some_2 in H2 as (t3 & Hfv & Hdel); [|done..].
1604 eapply delayed_interp in Hinterp as (m3 & Hinterp); [|done].
1605 apply interp_as_interp_thunk in Hinterp as (mw & m & Hinterp3 & ?).
1606 exists mw, (S (m `max` m1 `max` m2)). split; [|done]. rewrite interp_S /=.
1607 rewrite (interp_le Hinterp1) /=; last lia.
1608 rewrite Hf /= (interp_le Hinterp2) /=; last lia.
1609 rewrite Hfv /= (interp_thunk_le Hinterp3); last lia. done.
1610 - split; [|by intros ? []]. intros n mv _ Hinterp.
1611 exists mv, (S (S n)). rewrite !interp_S /= -interp_S.
1612 eauto using interp_le with lia.
1613 - split; [|by intros ? []]. intros n mv _ Hinterp.
1614 exists mv, (S (S n)). rewrite !interp_S /= lookup_empty /=. done.
1615 - split; [intros ?? []; constructor; by eauto|].
1616 intros n [] [] mv _ Hts Hts' Hforce; simplify_eq.
1617 destruct n as [|n]; [done|rewrite force_deep_S /= in Hforce].
1618 destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_eq/=.
1619 destruct IHHstep as [IH1 IH2].
1620 apply symmetry, fmap_app_inv in Hts
1621 as (ts1 & [|t1 ts1'] & ? & ? & ?); simplify_eq/=.
1622 apply symmetry, fmap_app_inv in Hts'
1623 as (ts2 & [|t2 ts2'] & Hts & ? & ?); simplify_eq/=.
1624 assert (∃ mws m,
1625 mapM (mbind (force_deep m) ∘ interp_thunk m) (ts1 ++ t1 :: ts1') = Res mws ∧
1626 fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws)
1627 as (mws & m & Hmap' & Hmvs); last first.
1628 { exists (VList ∘ fmap Forced <$> mws), (S m). rewrite force_deep_S /= Hmap'.
1629 split; [done|].
1630 destruct mvs as [vs|], mws as [ws|]; simplify_eq/=; do 2 f_equal.
1631 rewrite list_eq_Forall2 Forall2_fmap in Hmvs.
1632 by rewrite list_eq_Forall2 !Forall2_fmap. }
1633 rewrite mapM_res_app in Hmap.
1634 destruct (mapM _ ts2) as [mvs1|] eqn:Hmap1; simplify_res.
1635 eapply mapM_interp_proper in Hmap1 as (mws1 & m1 & Hmap1 & ?); [|done].
1636 destruct mvs1 as [vs1|], mws1 as [ws1|]; simplify_res; last first.
1637 { exists None, m1. by rewrite mapM_res_app Hmap1. }
1638 destruct (interp_thunk n t2) as [mw|] eqn:Hinterp; simplify_res.
1639 apply interp_thunk_as_interp in Hinterp as (mw' & m & Hinterp & Hmw').
1640 destruct (default mfail (force_deep n <$> mw))
1641 as [mu|] eqn:Hforce; simplify_res.
1642 destruct (step_any_shallow _ _ _ Hstep) as [|Hfinal1].
1643 + (* SHALLOW *)
1644 apply IH1 in Hinterp as (mw'' & m' & Hinterp & Hmw'');
1645 [|by eauto using step_not_final].
1646 apply interp_as_interp_thunk in Hinterp as (mw''' & m2 & Hinterp & ?).
1647 destruct mw as [w|], mw', mw'', mw''' as [w'''|]; simplify_res; last first.
1648 { exists None, (m1 `max` m2). rewrite mapM_res_app.
1649 rewrite (mapM_interp_le Hmap1) /=; last lia.
1650 rewrite (interp_thunk_le Hinterp) /=; last lia. done. }
1651 eapply (force_deep_proper _ _ w''')
1652 in Hforce as (mu' & m3 & Hforce & ?); last congruence.
1653 destruct mu as [u|], mu' as [u'|]; simplify_res; last first.
1654 { exists None, (m1 `max` m2 `max` m3). rewrite mapM_res_app.
1655 rewrite (mapM_interp_le Hmap1) /=; last lia.
1656 rewrite (interp_thunk_le Hinterp) /=; last lia.
1657 rewrite (force_deep_le Hforce) /=; last lia. done. }
1658 destruct (mapM _ ts2') as [mvs2|] eqn:Hmap2; simplify_res.
1659 eapply mapM_interp_proper in Hmap2 as (mws2 & m4 & Hmap2 & ?); [|done].
1660 exists ((ws1 ++.) ∘ (u' ::.) <$> mws2), (m1 `max` m2 `max` m3 `max` m4).
1661 rewrite mapM_res_app.
1662 rewrite (mapM_interp_le Hmap1) /=; last lia.
1663 rewrite (interp_thunk_le Hinterp) /=; last lia.
1664 rewrite (force_deep_le Hforce) /=; last lia.
1665 rewrite (mapM_interp_le Hmap2) /=; last lia. split; [by destruct mws2|].
1666 destruct mvs2, mws2; simplify_res; f_equal. rewrite !fmap_app !fmap_cons.
1667 congruence.
1668 + (* DEEP *)
1669 apply step_final_shallow in Hstep as Hfinal2; last done.
1670 apply final_interp in Hfinal1 as (w1 & m2 & Hinterpt1 & ?).
1671 apply interp_as_interp_thunk in Hinterpt1 as (mw'' & m3 & Hinterpt1 & ?).
1672 apply final_interp in Hfinal2 as (w2' & m4 & Hinterpt2 & ?).
1673 eapply interp_agree in Hinterp; last apply Hinterpt2.
1674 destruct mw as [w2|], mw'' as [w2''|]; simplify_res.
1675 eapply IH2 in Hforce as (mu' & m5 & Hforce & ?); [|by auto with congruence..].
1676 eapply (force_deep_proper _ _ w2'')
1677 in Hforce as (mu'' & m6 & Hforce & ?); last congruence.
1678 destruct mu as [u|], mu' as [u'|], mu'' as [u''|]; simplify_res; last first.
1679 { exists None, (m1 `max` m3 `max` m6). rewrite mapM_res_app.
1680 rewrite (mapM_interp_le Hmap1) /=; last lia.
1681 rewrite (interp_thunk_le Hinterpt1) /=; last lia.
1682 rewrite (force_deep_le Hforce) /=; last lia. done. }
1683 destruct (mapM _ ts2') as [mvs2|] eqn:Hmap2; simplify_res.
1684 eapply mapM_interp_proper in Hmap2 as (mws2 & m7 & Hmap2 & ?); [|done].
1685 exists ((ws1 ++.) ∘ (u'' ::.) <$> mws2), (m1 `max` m3 `max` m6 `max` m7).
1686 rewrite mapM_res_app.
1687 rewrite (mapM_interp_le Hmap1) /=; last lia.
1688 rewrite (interp_thunk_le Hinterpt1) /=; last lia.
1689 rewrite (force_deep_le Hforce) /=; last lia.
1690 rewrite (mapM_interp_le Hmap2) /=; last lia. split; [by destruct mws2|].
1691 destruct mvs2, mws2; simplify_res; f_equal. rewrite !fmap_app !fmap_cons.
1692 congruence.
1693 - split; [intros ?? []; constructor; by eauto using no_recs_insert|].
1694 intros n [] [] mv _ Hts Hts' Hforce; simplify_eq.
1695 destruct n as [|n]; [done|rewrite force_deep_S /= in Hforce].
1696 destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap; simplify_eq/=.
1697 destruct IHHstep as [IH1 IH2].
1698 apply symmetry, fmap_insert_inv in Hts
1699 as (t1 & ts1 & ? & Hx1 & ? & ?); simplify_eq/=; last done.
1700 apply symmetry, fmap_insert_inv in Hts' as (t2 & ts2 & ? & Hx2 & ? & Hts);
1701 simplify_eq/=; last by rewrite lookup_fmap Hx1.
1702 assert (∃ mws m,
1703 map_mapM_sorted attr_le (mbind (force_deep m) ∘ interp_thunk m)
1704 (<[x:=t1]> ts1) = Res mws ∧
1705 fmap (M:=gmap _) val_to_expr <$> mvs = fmap (M:=gmap _) val_to_expr <$> mws)
1706 as (mws & m & Hmap' & Hmvs); last first.
1707 { exists (VAttr ∘ fmap Forced <$> mws), (S m). rewrite force_deep_S /= Hmap'.
1708 split; [done|].
1709 destruct mvs as [vs|], mws as [ws|]; simplify_eq/=; do 2 f_equal.
1710 apply map_eq=> y. rewrite !lookup_fmap.
1711 apply (f_equal (.!! y)) in Hmvs. rewrite !lookup_fmap in Hmvs.
1712 destruct (vs !! _), (ws !! _); simplify_eq/=; auto with f_equal. }
1713 destruct (step_any_shallow _ _ _ Hstep) as [|Hfinal].
1714 + (* SHALLOW *) assert (map_Forall2 (λ _ t1 t2, ∀ n mv,
1715 interp n ∅ (thunk_to_expr t2) = Res mv →
1716 ∃ mw m, interp m ∅ (thunk_to_expr t1) = Res mw ∧
1717 val_to_expr <$> mv = val_to_expr <$> mw)
1718 (<[x:=t1]> ts1) (<[x:=t2]> ts2)) as IHts.
1719 { apply map_Forall2_insert_2; first by eauto using step_not_final.
1720 intros y. apply (f_equal (.!! y)) in Hts. rewrite !lookup_fmap in Hts.
1721 destruct (ts1 !! y), (ts2 !! y); simplify_eq/=; constructor.
1722 rewrite -Hts; eauto. }
1723 revert IHts Hmap. generalize (<[x:=t1]> ts1) (<[x:=t2]> ts2). clear.
1724 intros ts1. revert n mvs.
1725 induction ts1 as [|x t1 ts1 ?? IH] using (map_sorted_ind attr_le);
1726 intros n mvs ts2' IHts Hmap.
1727 { apply map_Forall2_empty_inv_l in IHts as ->.
1728 rewrite map_mapM_sorted_empty in Hmap; simplify_res.
1729 by exists (Some ∅), 1. }
1730 apply map_Forall2_insert_inv_l in IHts
1731 as (t2 & ts2 & -> & ? & IHt & IHts); simplify_eq/=; last done.
1732 assert (∀ j, is_Some (ts2 !! j) → attr_le x j).
1733 { apply map_Forall2_dom_L in IHts. intros j.
1734 rewrite -elem_of_dom -IHts elem_of_dom. auto. }
1735 rewrite map_mapM_sorted_insert //= in Hmap.
1736 destruct (interp_thunk _ _) as [mv|] eqn:Hinterp; simplify_res.
1737 assert (∃ mw m, interp_thunk m t1 = Res mw ∧
1738 val_to_expr <$> mv = val_to_expr <$> mw) as (mw & m1 & Hinterp1 & ?).
1739 { apply interp_thunk_as_interp in Hinterp as (mw & m & Hinterp & ?).
1740 apply IHt in Hinterp as (mw' & m' & Hinterp & ?).
1741 eapply interp_as_interp_thunk in Hinterp as (mw'' & m'' & Hinterp & ?).
1742 exists mw'', m''. eauto with congruence. }
1743 destruct mv as [v|], mw as [w|]; simplify_res; last first.
1744 { exists None, m1. split; [|done]. rewrite map_mapM_sorted_insert //=.
1745 by rewrite Hinterp1. }
1746 destruct (force_deep _ _) as [mv|] eqn:Hforce; simplify_res.
1747 eapply force_deep_proper in Hforce as (mw & m2 & Hforce' & ?); last done.
1748 destruct mv as [v'|], mw as [w'|]; simplify_res; last first.
1749 { exists None, (m1 `max` m2). split; [|done].
1750 rewrite map_mapM_sorted_insert //=.
1751 rewrite (interp_thunk_le Hinterp1) /=; last lia.
1752 rewrite (force_deep_le Hforce') /=; last lia. done. }
1753 destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:Hmap'; simplify_res.
1754 apply IH in Hmap' as (mws & m3 & Hmap3 & ?); last done.
1755 exists (fmap <[x:=w']> mws), (m1 `max` m2 `max` m3).
1756 rewrite map_mapM_sorted_insert //=.
1757 rewrite (interp_thunk_le Hinterp1) /=; last lia.
1758 rewrite (force_deep_le Hforce') /=; last lia.
1759 rewrite (map_mapM_interp_le Hmap3) /=; last lia.
1760 destruct mvs', mws; simplify_res; last done.
1761 rewrite !fmap_insert. auto with f_equal.
1762 + (* DEEP *)
1763 assert (map_Forall2 (λ _ t1 t2,
1764 thunk_to_expr t1 = thunk_to_expr t2 ∨
1765 ∃ v1 v2,
1766 thunk_to_expr t1 = val_to_expr v1 ∧
1767 thunk_to_expr t2 = val_to_expr v2 ∧
1768 ∀ n mv,
1769 force_deep n v2 = Res mv →
1770 ∃ mw m, force_deep m v1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw)
1771 (<[x:=t1]> ts1) (<[x:=t2]> ts2)) as IHts.
1772 { apply map_Forall2_insert_2; last first.
1773 { intros y. apply (f_equal (.!! y)) in Hts. rewrite !lookup_fmap in Hts.
1774 destruct (ts1 !! y), (ts2 !! y); simplify_eq/=; constructor; eauto. }
1775 assert (final SHALLOW (thunk_to_expr t2))
1776 as (v2 & m2 & Hinterp2 & Ht2)%final_interp
1777 by eauto using step_final_shallow.
1778 apply final_interp in Hfinal as (v1 & m1 & Hinterp1 & Ht1); eauto 10. }
1779 revert IHts Hmap. generalize (<[x:=t1]> ts1) (<[x:=t2]> ts2). clear.
1780 intros ts1. revert n mvs.
1781 induction ts1 as [|x t1 ts1 ?? IH] using (map_sorted_ind attr_le);
1782 intros n mvs ts2' IHts Hmap.
1783 { apply map_Forall2_empty_inv_l in IHts as ->.
1784 rewrite map_mapM_sorted_empty in Hmap; simplify_res.
1785 by exists (Some ∅), 1. }
1786 apply map_Forall2_insert_inv_l in IHts
1787 as (t2 & ts2 & -> & ? & IHt & IHts); simplify_eq/=; last done.
1788 assert (∀ j, is_Some (ts2 !! j) → attr_le x j).
1789 { apply map_Forall2_dom_L in IHts. intros j.
1790 rewrite -elem_of_dom -IHts elem_of_dom. auto. }
1791 rewrite map_mapM_sorted_insert //= in Hmap.
1792 destruct (interp_thunk n t2 ≫= force_deep n)
1793 as [mv|] eqn:Hinterp; simplify_res.
1794 assert (∃ mw m, interp_thunk m t1 ≫= force_deep m = Res mw ∧
1795 val_to_expr <$> mv = val_to_expr <$> mw) as (mw & m1 & Hinterp1 & ?).
1796 { destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res.
1797 destruct IHt as [|(v1 & v2 & Ht1 & Ht2 & IHt)].
1798 * eapply interp_thunk_proper in Hthunk
1799 as (mw' & m1 & Hthunk1 & ?); last done.
1800 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1801 { exists None, m1. by rewrite Hthunk1. }
1802 eapply force_deep_proper in Hinterp
1803 as (mw & m2 & Hforce2 & ?); last done.
1804 exists mw, (m1 `max` m2). split; [|done].
1805 rewrite (interp_thunk_le Hthunk1) /=; last lia.
1806 eauto using force_deep_le with lia.
1807 * destruct (interp_empty_val_to_expr v1) as (v1' & m1 & Hinterp1 & ?).
1808 rewrite -Ht1 in Hinterp1.
1809 eapply interp_as_interp_thunk in Hinterp1
1810 as ([v1''|] & m1' & Hthunk1 & ?); simplify_res.
1811 eapply (interp_thunk_proper _ _ (Forced v2)) in Hthunk
1812 as (mw2 & m2 & Hthunk2 & ?); simplify_res; [|done].
1813 destruct m2 as [|m2]; [done|].
1814 rewrite interp_thunk_S in Hthunk2; simplify_res.
1815 destruct mv' as [v2'|]; simplify_res.
1816 eapply force_deep_proper in Hinterp
1817 as (mv' & m2' & Hforce2 & ?); last done.
1818 eapply IHt in Hforce2 as (mw' & m2'' & Hforce2 & ?).
1819 eapply (force_deep_proper _ _ v1'') in Hforce2
1820 as (mw'' & m2''' & Hforce2 & ?); last congruence.
1821 exists mw'', (m1' `max` m2''').
1822 rewrite (interp_thunk_le Hthunk1) /=; last lia.
1823 rewrite (force_deep_le Hforce2) /=; last lia. auto with congruence. }
1824 destruct mv as [v|], mw as [w|]; simplify_res; last first.
1825 { exists None, m1. split; [|done]. rewrite map_mapM_sorted_insert //=.
1826 by rewrite Hinterp1. }
1827 destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:Hmap'; simplify_res.
1828 apply IH in Hmap' as (mws & m2 & Hmap2 & ?); last done.
1829 exists (fmap <[x:=w]> mws), (m1 `max` m2).
1830 rewrite map_mapM_sorted_insert //=.
1831 destruct (interp_thunk m1 t1) as [[]|] eqn:Hinterp'; simplify_res.
1832 rewrite (interp_thunk_le Hinterp') /=; last lia.
1833 rewrite (force_deep_le Hinterp1) /=; last lia.
1834 rewrite (map_mapM_interp_le Hmap2) /=; last lia.
1835 destruct mvs', mws; simplify_res; last done.
1836 rewrite !fmap_insert. auto with f_equal.
1837 - split; [|by intros ? []]. intros n mv _ Hinterp.
1838 destruct n as [|n]; simplify_eq/=.
1839 rewrite interp_S /= in Hinterp.
1840 destruct (interp n ∅ e') as [mv'|] eqn:Hinterp'; simplify_res.
1841 apply IHHstep in Hinterp'
1842 as (mw' & m1 & Hinterp1 & ?); last by eauto using step_not_final.
1843 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1844 { exists None, (S m1). split; [|done]. by rewrite interp_S /= Hinterp1. }
1845 eapply interp_app_proper in Hinterp as (mw & m2 & Happ2 & ?); [|done..].
1846 exists mw, (S (m1 `max` m2)). rewrite interp_S /=.
1847 rewrite (interp_le Hinterp1) /=; last lia.
1848 rewrite (interp_app_le Happ2) /=; last lia. done.
1849 - split; [|by intros ? []]. intros n mv _ Hinterp.
1850 destruct n as [|[|[|n]]]; simplify_eq/=.
1851 rewrite !interp_S /= interp_app_S /= interp_thunk_S /= in Hinterp.
1852 destruct (interp n ∅ e') as [mv'|] eqn:Hinterp'; simplify_res.
1853 apply IHHstep in Hinterp'
1854 as (mw' & m1 & Hinterp1 & Hw'); last by eauto using step_not_final.
1855 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1856 { exists None, (S (S (S m1))). split; [|done].
1857 rewrite !interp_S /= interp_app_S /= interp_thunk_S /=.
1858 by rewrite Hinterp1. }
1859 destruct (maybe VAttr v') as [ts|] eqn:?; simplify_res; last first.
1860 { exists None, (S (S (S m1))). split; [|done].
1861 rewrite !interp_S /= interp_app_S /= interp_thunk_S /= Hinterp1 /=.
1862 assert (maybe VAttr w' = None) as ->; [|done].
1863 destruct v', w'; naive_solver. }
1864 destruct v', w'; simplify_eq/=.
1865 rewrite 2!map_fmap_compose in Hw'. apply (inj _) in Hw'.
1866 eapply (interp_match_proper ∅ ∅ _ _ ms ms strict) in Hw'; [|done].
1867 destruct (interp_match ts _ strict) as [tαs1|] eqn:Hmatch1,
1868 (interp_match ts1 _ strict) as [tαs2|] eqn:Hmatch2;
1869 simplify_res; try done; last first.
1870 { exists None, (S (S (S m1))). split; [|done].
1871 rewrite !interp_S /= interp_app_S /= interp_thunk_S /=.
1872 rewrite Hinterp1 /= Hmatch2. done. }
1873 eapply interp_proper in Hinterp
1874 as (mw & m2 & Hinterp & ?); last first.
1875 { by apply indirects_env_proper. }
1876 exists mw, (S (S (S (m1 `max` m2)))). split; [|done].
1877 rewrite !interp_S /= interp_app_S /= interp_thunk_S /=.
1878 rewrite (interp_le Hinterp1) /=; last lia.
1879 rewrite Hmatch2 /=. eauto using interp_le with lia.
1880 - split; [|by intros ? []]. intros n mv _ Hinterp.
1881 destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
1882 destruct (interp n _ e') as [mv'|] eqn:Hinterp'; simplify_eq/=.
1883 destruct (step_any_shallow μ e e') as [|Hfinal]; first done.
1884 + apply IHHstep in Hinterp'
1885 as (mw' & m & Hinterp' & Hw); last by eauto using step_not_final.
1886 destruct mv' as [v|], mw' as [w'|]; simplify_res; last first.
1887 { exists None, (S m). by rewrite interp_S /= Hinterp'. }
1888 destruct μ; simplify_res.
1889 { exists mv, (S (n `max` m)). rewrite interp_S /=.
1890 rewrite (interp_le Hinterp') /=; last lia.
1891 rewrite (interp_le Hinterp) /=; last lia. done. }
1892 destruct (force_deep n v) as [mv'|] eqn:Hforce; simplify_res.
1893 eapply force_deep_proper
1894 in Hforce as (mw' & m2 & Hforce2 & ?); last done.
1895 exists mv, (S (n `max` m `max` m2)). split; [|done]. rewrite interp_S /=.
1896 rewrite (interp_le Hinterp') /=; last lia.
1897 rewrite (force_deep_le Hforce2) /=; last lia.
1898 destruct mv', mw'; simplify_res; eauto using interp_le with lia.
1899 + destruct μ; [by odestruct step_not_final|].
1900 assert (final SHALLOW e') as (w & m & Hinterp'' & ->)%final_interp
1901 by eauto using step_final_shallow.
1902 apply interp_empty_val_to_expr_Res in Hinterp'.
1903 destruct mv' as [v|]; simplify_res.
1904 destruct (force_deep n v) as [mv'|] eqn:Hforce; simplify_res.
1905 apply final_interp in Hfinal as (w' & m' & Hinterp''' & ->).
1906 eapply IHHstep in Hforce as (mw' & m'' & Hforce' & ?); [|done..].
1907 exists mv, (S (n `max` m' `max` m'')). rewrite interp_S /=.
1908 rewrite (interp_le Hinterp''') /=; last lia.
1909 rewrite (force_deep_le Hforce') /=; last lia.
1910 destruct mv', mw'; simplify_res; eauto using interp_le with lia.
1911 - split; [|by intros ? []]. intros n mv _ Hinterp.
1912 destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
1913 destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_eq/=.
1914 apply IHHstep in Hinterp'
1915 as (mw' & m1 & Hinterp1 & Hw); last by eauto using step_not_final.
1916 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
1917 { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
1918 destruct (maybe VAttr _) eqn:Hattr; simplify_res; last first.
1919 { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
1920 by assert (maybe VAttr w' = None) as -> by (by destruct v', w'). }
1921 destruct v', w'; simplify_res.
1922 rewrite right_id_L in Hinterp.
1923 eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & ?);
1924 last by apply subst_env_fmap_proper.
1925 exists mw, (S (m1 `max` m2)). rewrite !interp_S /=.
1926 rewrite (interp_le Hinterp1) /=; last lia. rewrite right_id_L.
1927 by rewrite (interp_le Hinterp2) /=; last lia.
1928 - split; [|by intros ? []]. intros n mv _ Hinterp.
1929 destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
1930 destruct (interp n _ e') as [mv1|] eqn:Hinterp1; simplify_eq/=.
1931 apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1);
1932 last by eauto using step_not_final.
1933 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
1934 { exists None, (S m). by rewrite interp_S /= Hinterp1. }
1935 apply (interp_bin_op_proper op) in Hw1.
1936 destruct (interp_bin_op _ v1) as [f|] eqn:Hopf; simplify_res; last first.
1937 { exists None, (S m). rewrite interp_S /= Hinterp1 /=.
1938 by destruct (interp_bin_op _ w1). }
1939 destruct (interp_bin_op _ w1) as [g|] eqn:Hopg; simplify_res; [|done].
1940 destruct (interp n _ e2) as [mv2|] eqn:Hinterp2; simplify_res.
1941 destruct mv2 as [v2|]; simplify_res; last first.
1942 { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
1943 rewrite (interp_le Hinterp1) /=; last lia.
1944 rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hopg. }
1945 specialize (Hw1 v2 _ eq_refl).
1946 destruct (f v2) as [t2|], (g v2) as [t2'|] eqn:Hg; simplify_res; last first.
1947 { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
1948 rewrite (interp_le Hinterp1) /=; last lia.
1949 rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hopg /= Hg. }
1950 eapply interp_thunk_proper in Hinterp as (mw & m' & Hthunk & ?); last done.
1951 exists mw, (S (n `max` m `max` m')). split; [|done]. rewrite interp_S /=.
1952 rewrite (interp_le Hinterp1) /=; last lia.
1953 rewrite (interp_le Hinterp2) /=; last lia. rewrite Hopg /= Hg /=.
1954 rewrite (interp_thunk_le Hthunk) /=; last lia. done.
1955 - split; [|by intros ? []]. intros n mv _ Hinterp.
1956 destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
1957 destruct (interp n ∅ e1) as [mw1|] eqn:Hinterp1; simplify_res.
1958 apply final_interp in H0 as (v1 & m1 & Hinterp1' & ->).
1959 apply interp_bin_op_Some_2 in H1 as [f Hop].
1960 assert (mw1 = Some v1) as -> by eauto using interp_agree.
1961 rewrite /= Hop /= in Hinterp.
1962 destruct (interp _ _ e') as [mv2|] eqn:Hinterp2; simplify_res; last first.
1963 apply IHHstep in Hinterp2 as (mw2 & m & Hinterp2 & Hw);
1964 last by eauto using step_not_final.
1965 destruct mv2 as [v2|], mw2 as [w2|]; simplify_res; last first.
1966 { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
1967 rewrite (interp_le Hinterp1) /=; last lia.
1968 rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hop. }
1969 pose proof @eq_refl as Hf%(interp_bin_op_proper op v1). rewrite !Hop in Hf.
1970 apply Hf in Hw; clear Hf.
1971 destruct (f v2) as [t|] eqn:Hf,
1972 (f w2) as [t'|] eqn:Hf'; simplify_res; last first.
1973 { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
1974 rewrite (interp_le Hinterp1) /=; last lia.
1975 rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hop /= Hf'. }
1976 eapply interp_thunk_proper in Hinterp as (mw & m' & Hthunk & ?); last done.
1977 exists mw, (S (n `max` m `max` m')). split; [|done]. rewrite interp_S /=.
1978 rewrite (interp_le Hinterp1) /=; last lia.
1979 rewrite (interp_le Hinterp2) /=; last lia. rewrite Hop /= Hf' /=.
1980 eauto using interp_thunk_le with lia.
1981 - split; [|by intros ? []]. intros n mv _ Hinterp.
1982 destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
1983 destruct (interp n _ e') as [mv1|] eqn:Hinterp1; simplify_eq/=.
1984 apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1);
1985 last by eauto using step_not_final.
1986 destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
1987 { exists None, (S m). by rewrite interp_S /= Hinterp1. }
1988 exists mv, (S (n `max` m)). split; [|done].
1989 rewrite interp_S /= (interp_le Hinterp1) /=; last lia.
1990 assert (maybe_VLit w1 ≫= maybe LitBool = maybe_VLit v1 ≫= maybe LitBool) as ->.
1991 { destruct v1, w1; repeat destruct select base_lit; naive_solver. }
1992 destruct (maybe_VLit v1 ≫= maybe LitBool); simplify_res; [|done].
1993 eauto using interp_le with lia.
1994Qed.
1995
1996Lemma final_interp' μ e :
1997 final μ e →
1998 ∃ w m, interp' m μ ∅ e = mret w ∧ e = val_to_expr w.
1999Proof.
2000 intros Hfinal. destruct (final_interp _ _ Hfinal) as (w & m & Hinterp & ->).
2001 destruct μ.
2002 { exists w, m. by rewrite interp_shallow'. }
2003 apply final_force_deep' in Hfinal as (w' & m' & Hforce & ?).
2004 exists w', (m `max` m'); split; [|done]. rewrite /interp'.
2005 rewrite (interp_le Hinterp) /=; last lia. eauto using force_deep_le with lia.
2006Qed.
2007
2008Lemma force_deep_le' {n1 n2 μ v mv} :
2009 force_deep' n1 μ v = Res mv → n1 ≤ n2 → force_deep' n2 μ v = Res mv.
2010Proof. destruct μ; eauto using force_deep_le. Qed.
2011
2012Lemma interp_le' {n1 n2 μ E e mv} :
2013 interp' n1 μ E e = Res mv → n1 ≤ n2 → interp' n2 μ E e = Res mv.
2014Proof.
2015 rewrite /interp'. intros.
2016 destruct (interp n1 _ _) as [mw|] eqn:Hinterp; simplify_res.
2017 rewrite (interp_le Hinterp); last lia.
2018 destruct mw; simplify_res; eauto using force_deep_le'.
2019Qed.
2020
2021Lemma interp_agree' {n1 n2 μ E e mv1 mv2} :
2022 interp' n1 μ E e = Res mv1 → interp' n2 μ E e = Res mv2 → mv1 = mv2.
2023Proof.
2024 intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
2025 - rewrite -He2. symmetry. eauto using interp_le'.
2026 - rewrite -He1. eauto using interp_le'.
2027Qed.
2028
2029Lemma interp_step' n μ e1 e2 mv :
2030 e1 -{μ}-> e2 →
2031 interp' n μ ∅ e2 = Res mv →
2032 ∃ mw m, interp' m μ ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw.
2033Proof.
2034 intros Hstep. destruct μ.
2035 { setoid_rewrite interp_shallow'.
2036 eapply interp_step; eauto using step_not_final. }
2037 intros Hinterp. rewrite /interp' in Hinterp.
2038 destruct (interp n ∅ e2) as [mv'|] eqn:Hinterp'; simplify_res.
2039 destruct (step_any_shallow _ _ _ Hstep) as [|Hfinal].
2040 - eapply interp_step in Hinterp' as (mw' & m & Hinterp' & ?);
2041 [|by eauto using step_not_final..].
2042 destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
2043 { exists None, m. by rewrite /interp' Hinterp'. }
2044 eapply force_deep_proper in Hinterp as (mw' & m' & Hforce & ?); last done.
2045 exists mw', (m `max` m'). rewrite /interp'.
2046 rewrite (interp_le Hinterp') /=; last lia.
2047 eauto using force_deep_le with lia.
2048 - assert (final SHALLOW e2)
2049 as (w2 & m2 & Hinterpw2 & ->)%final_interp by eauto using step_final_shallow.
2050 apply final_interp in Hfinal as (w1 & m1 & Hinterpw1 & ->).
2051 apply interp_empty_val_to_expr_Res in Hinterp'; destruct mv'; simplify_res.
2052 eapply interp_step in Hstep as [_ Hstep].
2053 eapply Hstep in Hinterp as (mw & m & Hforce & ?); [|done..].
2054 exists mw, (m `max` m1). split; [|done]. rewrite /interp'.
2055 rewrite (interp_le Hinterpw1) /=; last lia.
2056 eauto using force_deep_le with lia.
2057Qed.
2058
2059Lemma final_val_to_expr' n μ E e v :
2060 interp' n μ E e = mret v → final μ (val_to_expr v).
2061Proof.
2062 rewrite /interp'. intros Hinterp.
2063 destruct (interp _ _ e) as [[w|]|] eqn:Hinterp'; simplify_res.
2064 destruct μ; simplify_res; eauto using final_force_deep.
2065Qed.
2066
2067Lemma red_final_interp μ e :
2068 red (step μ) e ∨ final μ e ∨ ∃ m, interp' m μ ∅ e = mfail.
2069Proof.
2070 revert μ. induction e; intros μ'.
2071 - (* ELit *)
2072 destruct (decide (base_lit_ok b)).
2073 + right; left. by constructor.
2074 + do 2 right. exists 1. rewrite /interp' interp_S /=. by case_guard.
2075 - (* EId *) destruct mkd as [[k d]|].
2076 + left. eexists; constructor.
2077 + do 2 right. by exists 1.
2078 - (* EAbs *) right; left. constructor.
2079 - (* EAbsMatch *) right; left. constructor.
2080 - (* EApp *) destruct (IHe1 SHALLOW) as [[??]|[Hfinal|[m Hinterp]]].
2081 + left. eexists. by eapply SAppL.
2082 + apply final_interp in Hfinal as ([] & m & _ & ->); simplify_res.
2083 { do 2 right. exists 3. rewrite /interp' interp_S /= interp_lit //. }
2084 { left. by repeat econstructor. }
2085 { destruct (IHe2 SHALLOW) as [[??]|[Hfinal|[m2 Hinterp2]]].
2086 * left. by repeat econstructor.
2087 * apply final_interp in Hfinal as (w2 & m2 & Hinterp2 & ->).
2088 destruct (maybe VAttr w2) as [ts|] eqn:Hw2; last first.
2089 { do 2 right. exists (S (S (S m2))).
2090 rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=.
2091 rewrite Hinterp2 /= Hw2. done. }
2092 destruct w2; simplify_eq/=.
2093 destruct (interp_match ts (fmap (M:=option) (subst_env E) <$> ms) strict)
2094 as [E'|] eqn:Hmatch; last first.
2095 { do 2 right. exists (S (S (S m2))).
2096 rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=.
2097 rewrite Hinterp2 /= Hmatch. done. }
2098 apply interp_match_Some_1 in Hmatch.
2099 left. repeat econstructor; [done|].
2100 by rewrite map_fmap_compose fmap_attr_expr_Attr.
2101 * rewrite interp_shallow' in Hinterp2.
2102 do 2 right. exists (S (S (S m2))).
2103 rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=.
2104 by rewrite Hinterp2. }
2105 { do 2 right. by exists 3. }
2106 destruct (ts !! "__functor") as [e|] eqn:Hfunc.
2107 { left. repeat econstructor; by simplify_map_eq. }
2108 do 2 right. exists (S (S m)). rewrite /interp' !interp_S /=.
2109 rewrite interp_app_S /= !lookup_fmap Hfunc. done.
2110 + rewrite interp_shallow' in Hinterp.
2111 do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp.
2112 - (* ESeq *) destruct (IHe1 μ) as [[??]|[Hfinal|[m Hinterp]]].
2113 + left. eexists. by eapply SSeq.
2114 + left. by repeat econstructor.
2115 + do 2 right. exists (S m). rewrite /interp' interp_S /=.
2116 rewrite /interp' in Hinterp.
2117 destruct (interp _ _ e1) as [[]|], μ; simplify_res; [|done..].
2118 by rewrite Hinterp.
2119 - (* EList *)
2120 destruct μ'.
2121 { right; left. by constructor. }
2122 assert (red (step DEEP) (EList es) ∨ Forall (final DEEP) es ∨
2123 ∃ m, mapM (mbind (force_deep m) ∘ interp_thunk m)
2124 (Thunk ∅ <$> es) = mfail) as Hhelp; last first.
2125 { destruct Hhelp as [?|[?|[m Hinterp]]]; [by auto using final..|].
2126 do 2 right. exists (S m). rewrite /interp' interp_S /=.
2127 rewrite force_deep_S /=. by rewrite Hinterp. }
2128 induction H as [|e es He Hes IH]; [by right; left|].
2129 destruct (He DEEP) as [[??]|[Hfinal|[m Hinterp]]]; simplify_eq/=.
2130 + left. eexists. by eapply (SList []).
2131 + destruct IH as [[??]|[?|[m2 Hinterp2]]]; [|by eauto|].
2132 * left. inv_step. eexists. eapply (SList (_ :: _)); by eauto.
2133 * apply final_interp' in Hfinal as (w & m1 & Hinterp1 & _).
2134 do 2 right. exists (S (m1 `max` m2)).
2135 rewrite /interp' /force_deep' in Hinterp1.
2136 destruct (interp m1 _ _) as [[]|] eqn:Hinterp1'; simplify_res.
2137 rewrite interp_thunk_S /= (interp_le Hinterp1') /=; last lia.
2138 rewrite (force_deep_le Hinterp1) /=; last lia.
2139 rewrite (mapM_interp_le Hinterp2) /=; last lia. done.
2140 + do 2 right. exists (S m).
2141 rewrite /interp' /force_deep' in Hinterp.
2142 destruct (interp m _ _) as [mw|] eqn:Hinterp1'; simplify_res.
2143 rewrite interp_thunk_S /= Hinterp1' /=.
2144 destruct mw as [w|]; simplify_res; [|done].
2145 rewrite (force_deep_le Hinterp) /=; last lia. done.
2146 - (* EAttr *) destruct (decide (no_recs αs)) as [Hrecs|]; last first.
2147 { left. by repeat econstructor. }
2148 destruct μ'.
2149 { right; left. by constructor. }
2150 assert (red (step DEEP) (EAttr αs) ∨
2151 map_Forall (λ _, final DEEP ∘ attr_expr) αs ∨
2152 ∃ m, map_mapM_sorted attr_le (mbind (force_deep m) ∘ interp_thunk m)
2153 (Thunk ∅ ∘ attr_expr <$> αs) = mfail) as Hhelp; last first.
2154 { destruct Hhelp as [?|[?|[m Hinterp]]]; [by auto using final..|].
2155 do 2 right. exists (S m). rewrite /interp' interp_S /=.
2156 rewrite from_attr_no_recs //. rewrite force_deep_S /=. by rewrite Hinterp. }
2157 induction αs as [|x [τ e] es Hx ? IH]
2158 using (map_sorted_ind attr_le); [by right; left|].
2159 rewrite !map_Forall_insert //.
2160 apply map_Forall_insert in H as [He Hes%IH]; clear IH;
2161 [|by eauto using no_recs_insert_inv..].
2162 assert (τ = NONREC) as -> by (by eapply no_recs_lookup, lookup_insert).
2163 assert (∀ y, is_Some ((Thunk ∅ ∘ attr_expr <$> es) !! y) → attr_le x y).
2164 { intros y. rewrite lookup_fmap fmap_is_Some. eauto. }
2165 destruct (He DEEP) as [[??]|[Hfinal|[m Hinterp]]]; simplify_eq/=.
2166 + left. eexists; eapply SAttr; naive_solver eauto using no_recs_insert_inv.
2167 + destruct Hes as [[??]|[?|[m2 Hinterp2]]]; [|by eauto|].
2168 * left. inv_step; first by naive_solver eauto using no_recs_insert_inv.
2169 apply lookup_insert_None in Hx as [??].
2170 rewrite insert_commute // in Hrecs. rewrite insert_commute //.
2171 eexists; eapply SAttr; [|by rewrite lookup_insert_ne| |done].
2172 { eapply no_recs_insert_inv; [|done]. by rewrite lookup_insert_ne. }
2173 intros ?? [[<- <-]|[??]]%lookup_insert_Some; eauto.
2174 * apply final_interp' in Hfinal as (w & m1 & Hinterp1 & _).
2175 do 2 right. exists (S (m1 `max` m2)). rewrite fmap_insert /=.
2176 rewrite map_mapM_sorted_insert //=; last by rewrite lookup_fmap Hx.
2177 rewrite /interp' /force_deep' in Hinterp1.
2178 destruct (interp m1 _ _) as [[]|] eqn:Hinterp1'; simplify_res.
2179 rewrite interp_thunk_S /= (interp_le Hinterp1') /=; last lia.
2180 rewrite (force_deep_le Hinterp1) /=; last lia.
2181 rewrite (map_mapM_interp_le Hinterp2) /=; last lia. done.
2182 + do 2 right. exists (S m). rewrite fmap_insert /=.
2183 rewrite map_mapM_sorted_insert //=; last by rewrite lookup_fmap Hx.
2184 rewrite /interp' /force_deep' in Hinterp.
2185 destruct (interp m _ _) as [mw|] eqn:Hinterp'; simplify_res.
2186 rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia.
2187 destruct mw as [w|]; simplify_res; [|done].
2188 rewrite (force_deep_le Hinterp) /=; last lia. done.
2189 - (* ELetAttr *) destruct (IHe1 SHALLOW) as [[??]|[Hfinal|[m Hinterp]]].
2190 + left. eexists. by eapply SLetAttr.
2191 + apply final_interp in Hfinal as (w & m & Hinterp & ->).
2192 destruct (maybe VAttr w) eqn:Hw.
2193 { destruct w; simplify_eq/=. left. by repeat econstructor. }
2194 do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp /= Hw.
2195 + do 2 right. exists (S m). rewrite interp_shallow' in Hinterp.
2196 by rewrite /interp' interp_S /= Hinterp /=.
2197 - (* EBinOp *)
2198 destruct (IHe1 SHALLOW) as [[??]|[Hfinal1|[m Hinterp]]].
2199 + left. eexists. by eapply SBinOpL.
2200 + apply final_interp in Hfinal1 as (w1 & m1 & Hinterp1 & ->).
2201 destruct (interp_bin_op op w1) as [f|] eqn:Hop; last first.
2202 { do 2 right. exists (S m1). rewrite /interp' interp_S /=.
2203 by rewrite Hinterp1 /= Hop. }
2204 pose proof Hop as [Φ ?]%interp_bin_op_Some_1.
2205 destruct (IHe2 SHALLOW) as [[??]|[Hfinal2|[m Hinterp2]]].
2206 * left. by repeat econstructor.
2207 * apply final_interp in Hfinal2 as (w2 & m2 & Hinterp2 & ->).
2208 destruct (f w2) as [w|] eqn:Hf; last first.
2209 ** do 2 right. exists (S (m1 `max` m2)). rewrite /interp' interp_S /=.
2210 rewrite (interp_le Hinterp1) /=; last lia.
2211 rewrite Hop /= (interp_le Hinterp2) /=; last lia. by rewrite Hf.
2212 ** eapply interp_bin_op_Some_Some_1 in Hf as (?&?&?); [|done..].
2213 left. by repeat econstructor.
2214 * rewrite interp_shallow' in Hinterp2.
2215 do 2 right. exists (S (m `max` m1)). rewrite /interp' interp_S /=.
2216 rewrite (interp_le Hinterp1) /=; last lia.
2217 rewrite Hop /= (interp_le Hinterp2) /=; last lia. done.
2218 + rewrite interp_shallow' in Hinterp.
2219 do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp.
2220 - (* EIf *)
2221 destruct (IHe1 SHALLOW) as [[??]|[Hfinal1|[m Hinterp]]].
2222 + left. eexists. by eapply SIf.
2223 + apply final_interp in Hfinal1 as (w1 & m1 & Hinterp1 & ->).
2224 destruct (maybe_VLit w1 ≫= maybe LitBool) as [b|] eqn:Hbool; last first.
2225 { do 2 right. exists (S m1).
2226 rewrite /interp' interp_S /= Hinterp1 /= Hbool. done. }
2227 left. destruct w1; repeat destruct select base_lit; simplify_eq/=.
2228 eexists; constructor.
2229 + rewrite interp_shallow' in Hinterp.
2230 do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp.
2231Qed.
2232
2233Lemma interp_complete μ e1 e2 :
2234 e1 -{μ}->* e2 → nf (step μ) e2 →
2235 ∃ mw m, interp' m μ ∅ e1 = Res mw ∧
2236 if mw is Some w then e2 = val_to_expr w else ¬final μ e2.
2237Proof.
2238 intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH].
2239 { destruct (red_final_interp μ e) as [?|[Hfinal|[m Hinterp]]]; [done|..].
2240 - apply final_interp' in Hfinal as (w & m & ? & ?).
2241 by exists (Some w), m.
2242 - exists None, m. split; [done|]. intros Hfinal.
2243 apply final_interp' in Hfinal as (w & m' & Hinterp' & _).
2244 rewrite /interp' in Hinterp, Hinterp'.
2245 by assert (mfail = mret w) by eauto using interp_agree'. }
2246 destruct IH as (mw & m & Hinterp & ?); first done.
2247 eapply interp_step' in Hstep as (mw' & m' & ? & ?); last done.
2248 destruct mw, mw'; naive_solver.
2249Qed.
2250
2251Lemma interp_complete_ret μ e1 e2 :
2252 e1 -{μ}->* e2 → final μ e2 →
2253 ∃ w m, interp' m μ ∅ e1 = mret w ∧ e2 = val_to_expr w.
2254Proof.
2255 intros Hsteps Hfinal. apply interp_complete in Hsteps
2256 as ([w|] & m & ? & ?); naive_solver eauto using final_nf.
2257Qed.
2258Lemma interp_complete_fail μ e1 e2 :
2259 e1 -{μ}->* e2 → nf (step μ) e2 → ¬final μ e2 →
2260 ∃ m, interp' m μ ∅ e1 = mfail.
2261Proof.
2262 intros Hsteps Hnf Hfinal.
2263 apply interp_complete in Hsteps as ([w|] & m & ? & ?);
2264 naive_solver eauto using final_val_to_expr'.
2265Qed.
2266
2267Lemma interp_sound_open n E e mv :
2268 interp n E e = Res mv →
2269 ∃ e', subst_env E e -{SHALLOW}->* e' ∧
2270 if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e'
2271with interp_thunk_sound n t mv :
2272 interp_thunk n t = Res mv →
2273 ∃ e', thunk_to_expr t -{SHALLOW}->* e' ∧
2274 if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e'
2275with interp_app_sound n v1 t2 mv :
2276 interp_app n v1 t2 = Res mv →
2277 ∃ e', EApp (val_to_expr v1) (thunk_to_expr t2) -{SHALLOW}->* e' ∧
2278 if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e'
2279with force_deep_sound n v mv :
2280 force_deep n v = Res mv →
2281 ∃ e', val_to_expr v -{DEEP}->* e' ∧
2282 if mv is Some v' then e' = val_to_expr v' else stuck DEEP e'.
2283Proof.
2284 - destruct n as [|n]; [done|].
2285 rewrite subst_env_eq interp_S. intros Hinterp.
2286 destruct e; simplify_res.
2287 + (* ELit *) case_guard; simplify_res.
2288 * by eexists.
2289 * eexists; split; [done|]. split; [|by inv 1]. intros [??]; inv_step.
2290 + (* EId *)
2291 assert (union_kinded (prod_map id thunk_to_expr <$> E !! x) mke
2292 = prod_map id thunk_to_expr <$> (union_kinded (E !! x)
2293 (prod_map id (Thunk ∅) <$> mke))) as ->.
2294 { destruct (_ !! _) as [[[]]|], mke as [[[]]|];
2295 by rewrite /= ?thunk_to_expr_eq /= ?subst_env_empty. }
2296 destruct (union_kinded _ _) as [[k t]|]; simplify_res.
2297 * apply interp_thunk_sound in Hinterp as (e' & Hsteps & He').
2298 exists e'; split; [|done]. eapply rtc_l; [constructor|done].
2299 * eexists; split; [done|]. split; [|inv 1]. intros [? Hstep]. inv_step.
2300 + (* EAbs *) by eexists.
2301 + (* EAbsMatch *) by eexists.
2302 + (* EApp *)
2303 destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
2304 apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1').
2305 destruct mv1 as [v1|]; simplify_res; last first.
2306 { eexists; split; [by eapply SAppL_rtc|]. split; [|inv 1].
2307 intros [??]. destruct He1' as [Hnf []].
2308 inv_step; eauto using final. destruct Hnf; eauto. }
2309 apply interp_app_sound in Hinterp as (e' & Hsteps2 & He').
2310 eexists e'; split; [|done]. etrans; [|done]. by eapply SAppL_rtc.
2311 + (* ESeq *) destruct (interp _ _ e1) as [mv'|] eqn:Hinterp'; simplify_res.
2312 apply interp_sound_open in Hinterp' as (e' & Hsteps & He').
2313 destruct mv' as [v'|]; simplify_res; last first.
2314 { eexists; repeat split; [by apply SSeq_rtc, steps_shallow_any| |inv 1].
2315 intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
2316 destruct Hfinal. inv_step; eauto using final_any_shallow.
2317 apply step_any_shallow in H2 as []; [|done]. destruct Hnf; eauto. }
2318 destruct μ; simplify_res.
2319 { apply interp_sound_open in Hinterp as (e'' & Hsteps' & He'').
2320 eexists; split; [|done]. etrans; first by apply SSeq_rtc.
2321 eapply rtc_l; first by apply SSeqFinal. done. }
2322 destruct (force_deep _ _) as [mw|] eqn:Hforce; simplify_res.
2323 pose proof Hforce as Hforce'.
2324 apply force_deep_sound in Hforce' as (e'' & Hsteps' & He'').
2325 destruct mw as [w|]; simplify_res; last first.
2326 { eexists. split.
2327 { etrans; [by eapply SSeq_rtc, steps_shallow_any|].
2328 etrans; [by eapply SSeq_rtc|]. done. }
2329 split; [|inv 1]. destruct He''. intros [e''' Hstep].
2330 inv_step; eauto using step_not_final. }
2331 apply interp_sound_open in Hinterp as (e''' & Hsteps'' & He''').
2332 exists e'''. split; [|done].
2333 etrans; [by eapply SSeq_rtc, steps_shallow_any|].
2334 etrans; [by eapply SSeq_rtc|].
2335 eapply rtc_l; first by eapply SSeqFinal, final_force_deep. done.
2336 + (* EList *)
2337 eexists; split; [done|]. f_equal.
2338 induction es; f_equal/=; auto.
2339 + (* EAttr *)
2340 eexists; split; [apply SAttr_rec_rtc|].
2341 f_equal. apply map_eq=> x. rewrite !lookup_fmap.
2342 destruct (αs !! x) as [[[] e]|] eqn:?; do 2 f_equal/=.
2343 by rewrite subst_env_indirects_env_attr_to_tattr.
2344 + (* ELetAttr *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res.
2345 apply interp_sound_open in Hinterp' as (e' & Hsteps & He').
2346 destruct mv' as [v'|]; simplify_res; last first.
2347 { eexists; repeat split; [by apply SLetAttr_rtc| |inv 1].
2348 intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
2349 inv_step; [by destruct Hfinal; constructor|]. destruct Hnf; eauto. }
2350 destruct (maybe VAttr v') eqn:?; simplify_res; last first.
2351 { eexists; repeat split; [by apply SLetAttr_rtc| |inv 1].
2352 intros [e'' Hstep]. destruct v'; inv_step; simplify_eq/=. }
2353 destruct v'; simplify_res.
2354 apply interp_sound_open in Hinterp as (e'' & Hsteps' & He'').
2355 eexists; split; [|done]. etrans; [by apply SLetAttr_rtc|].
2356 eapply rtc_l; [by econstructor|].
2357 rewrite subst_env_union in Hsteps'.
2358 rewrite subst_env_alt -!map_fmap_compose in Hsteps'.
2359 by rewrite -map_fmap_compose.
2360 + (* EBinOp *)
2361 destruct (interp _ _ e1) as [mv1|] eqn:Hinterp1; simplify_res.
2362 apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1').
2363 destruct mv1 as [v1|]; simplify_res; last first.
2364 { eexists; split; [by eapply SBinOpL_rtc|]. split; [|inv 1].
2365 intros [? Hstep]. destruct He1'. inv_step; naive_solver. }
2366 destruct (interp_bin_op _ v1) as [f|] eqn:Hop; simplify_res; last first.
2367 { assert (¬∃ Φ, sem_bin_op op (val_to_expr v1) Φ).
2368 { by intros [? ?%interp_bin_op_Some_2%not_eq_None_Some]. }
2369 eexists; split; [by eapply SBinOpL_rtc|]. split; [|inv 1].
2370 intros [? Hstep]. inv_step; eauto using step_not_val_to_expr. }
2371 pose proof Hop as [Φ ?]%interp_bin_op_Some_1.
2372 destruct (interp _ _ e2) as [mv2|] eqn:Hinterp2; simplify_res.
2373 apply interp_sound_open in Hinterp2 as (e2' & Hsteps2 & He2').
2374 destruct mv2 as [v2|]; simplify_res; last first.
2375 { eexists; split.
2376 { etrans; [by eapply SBinOpL_rtc|].
2377 eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1. }
2378 split; [|inv 1]. destruct He2'.
2379 intros [? Hstep]. inv_step; eauto using step_not_val_to_expr. }
2380 destruct (f v2) eqn:Hf; simplify_res; last first.
2381 { eexists; split.
2382 { etrans; [by eapply SBinOpL_rtc|].
2383 eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1. }
2384 split; [|inv 1]. pose proof @interp_bin_op_Some_Some_2.
2385 intros [? Hstep]. inv_step; naive_solver eauto using step_not_val_to_expr. }
2386 apply interp_thunk_sound in Hinterp as (e' & Hsteps3 & He').
2387 eapply interp_bin_op_Some_Some_1 in Hf as (e3 & ? & ?); [|done..].
2388 eapply delayed_steps_l in Hsteps3
2389 as (e'' & Hsteps3 & Hdel); last done.
2390 eexists e''; split.
2391 { etrans; [by eapply SBinOpL_rtc|].
2392 etrans; [eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1|].
2393 eapply rtc_l; [by econstructor|]. done. }
2394 destruct mv.
2395 { subst e'. eapply delayed_final_l in Hdel as <-; done. }
2396 destruct He' as [Hnf Hfinal]. split.
2397 { intros [e4 Hsteps4]. destruct Hnf.
2398 eapply delayed_step_r in Hsteps4 as (e4' & Hstep4' & ?); [|done].
2399 destruct Hstep4'; eauto. }
2400 intros Hfinal'. eapply Hnf.
2401 eapply delayed_final_r in Hfinal' as Hsteps; [|done].
2402 destruct Hsteps; by eauto.
2403 + (* EIf *)
2404 destruct (interp _ _ e1) as [mv1|] eqn:Hinterp1; simplify_res.
2405 apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1').
2406 destruct mv1 as [v1|]; simplify_res; last first.
2407 { eexists; repeat split; [by apply SIf_rtc| |inv 1].
2408 intros [e'' Hstep]. destruct He1' as [Hnf Hfinal].
2409 destruct Hfinal. inv_step; eauto using final. destruct Hnf; eauto. }
2410 destruct (maybe_VLit v1 ≫= maybe LitBool) as [b|] eqn:Hbool;
2411 simplify_res; last first.
2412 { eexists; repeat split; [by apply SIf_rtc| |inv 1].
2413 intros [e'' ?]. destruct v1; inv_step; eauto using final. }
2414 apply interp_sound_open in Hinterp as (e' & Hsteps & He').
2415 exists e'; split; [|done]. etrans; [by apply SIf_rtc|].
2416 assert (val_to_expr v1 = ELit (LitBool b)) as ->.
2417 { destruct v1; repeat destruct select base_lit; naive_solver. }
2418 eapply rtc_l; [constructor|]. by destruct b.
2419 - destruct n as [|n]; [done|]. rewrite interp_thunk_S /=.
2420 intros Hthunk. destruct t; simplify_res; [by eauto using rtc..|].
2421 destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res.
2422 + apply interp_sound_open in Hthunk as (e' & Hsteps & ?).
2423 exists e'; split; [|done]. etrans; [eapply SBinOpL_rtc, SAttr_rec_rtc|].
2424 eapply rtc_l; [eapply SBinOp; repeat constructor|]; try done; simpl.
2425 eexists; split; [done|]. rewrite !lookup_fmap Hx /=.
2426 rewrite -subst_env_indirects_env_attr_to_tattr_empty.
2427 by rewrite -subst_env_indirects_env.
2428 + apply interp_thunk_sound in Hthunk as (e' & Hsteps & ?).
2429 exists e'; split; [|done]. etrans; [eapply SBinOpL_rtc, SAttr_rec_rtc|].
2430 eapply rtc_l; [eapply SBinOp; repeat constructor|]; try done; simpl.
2431 eexists; split; [done|]. by rewrite !lookup_fmap Hx /=.
2432 + eexists. split; [eapply SBinOpL_rtc, SAttr_rec_rtc|]. split; [|inv 1].
2433 intros [??]. inv_step. inv H7. destruct H8 as (? & ? & Hx'); simplify_eq/=.
2434 by rewrite !lookup_fmap Hx in Hx'.
2435 - destruct n as [|n]; [done|]. rewrite interp_app_S /=. intros Happ.
2436 destruct v1; simplify_res.
2437 + eexists; split; [done|]. split; [|inv 1]. intros [??]; inv_step.
2438 + eapply interp_sound_open in Happ as (e' & Hsteps & He').
2439 eexists; split; [|done]. eapply rtc_l; [constructor|].
2440 rewrite subst_abs_env_insert // in Hsteps.
2441 + destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res.
2442 apply interp_thunk_sound in Hthunk as (et & Htsteps & Het).
2443 destruct mv' as [v'|]; simplify_res; last first.
2444 { eexists; split; [by eapply SAppR_rtc|].
2445 split; [|inv 1]. destruct Het.
2446 intros [??]; inv_step; eauto using final. }
2447 destruct (maybe VAttr v') as [ts|] eqn:?; simplify_res; last first.
2448 { eexists; repeat split; [by apply SAppR_rtc| |inv 1].
2449 intros [e'' Hstep]. destruct v'; inv_step; simplify_eq/=. }
2450 destruct v'; simplify_res.
2451 destruct (interp_match _ _ _) as [tαs|] eqn:Hmatch;
2452 simplify_res; last first.
2453 { eexists; repeat split; [by apply SAppR_rtc| |inv 1].
2454 intros [e'' Hstep]. inv_step.
2455 rewrite map_fmap_compose fmap_attr_expr_Attr in H6.
2456 apply interp_match_Some_2 in H6. rewrite interp_match_subst in H6.
2457 opose proof (interp_match_proper ∅ ∅
2458 (Thunk ∅ <$> (thunk_to_expr <$> ts)) ts ms ms strict _ _).
2459 { apply map_eq=> x. rewrite !lookup_fmap.
2460 destruct (ts !! x); f_equal/=. by rewrite subst_env_empty. }
2461 { done. }
2462 repeat destruct (interp_match _ _ _); simplify_eq/=. }
2463 pose proof (interp_match_subst E ts ms strict) as Hmatch'.
2464 rewrite Hmatch /= in Hmatch'.
2465 apply interp_match_Some_1 in Hmatch'.
2466 apply interp_sound_open in Happ as (e' & Hsteps & ?).
2467 exists e'; split; [|done].
2468 etrans; [by apply SAppR_rtc|].
2469 eapply rtc_l; [constructor; [done|]|].
2470 { rewrite map_fmap_compose fmap_attr_expr_Attr. done. }
2471 etrans; [|apply Hsteps]. apply reflexive_eq. f_equal.
2472 rewrite subst_env_indirects_env.
2473 rewrite subst_env_indirects_env_attr_to_tattr_empty.
2474 do 2 f_equal. apply map_eq=> y. rewrite !lookup_fmap.
2475 destruct (_ !! y) as [[]|]; f_equal/=. by rewrite subst_env_empty.
2476 + eexists; split; [done|]. split; [|inv 1]. intros [??]; inv_step.
2477 + destruct (ts !! _) eqn:Hfunc; simplify_res; last first.
2478 { eexists; split; [by eapply SAppL_rtc|]. split; [|inv 1].
2479 intros [??]; inv_step; simplify_map_eq. }
2480 destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res.
2481 apply interp_thunk_sound in Hthunk as (et & Htsteps & Het).
2482 assert (EApp (EAttr (AttrN ∘ thunk_to_expr <$> ts)) (thunk_to_expr t2)
2483 -{SHALLOW}->*
2484 EApp (EApp et (EAttr (AttrN ∘ thunk_to_expr <$> ts))) (thunk_to_expr t2))
2485 as Hsteps; [|clear Htsteps].
2486 { eapply rtc_l; [constructor; by simplify_map_eq|].
2487 eapply SAppL_rtc, SAppL_rtc, Htsteps. }
2488 destruct mv' as [v'|]; simplify_res; last first.
2489 { eexists; split; [exact Hsteps|].
2490 split; [|inv 1]. intros [??]. destruct Het as [Hnf []].
2491 inv_step; eauto using final. destruct Hnf; eauto. }
2492 destruct (interp_app _ _ _) as [mv'|] eqn:Happ'; simplify_res.
2493 apply interp_app_sound in Happ' as (e' & Hsteps' & He').
2494 destruct mv' as [v''|]; simplify_res; last first.
2495 { eexists; split; [etrans; [apply Hsteps|apply SAppL_rtc, Hsteps']|].
2496 split; [|inv 1]. intros [??]. destruct He' as [Hnf []].
2497 inv_step; eauto using final. destruct Hnf; eauto. }
2498 apply interp_app_sound in Happ as (e'' & Hsteps'' & He'').
2499 eexists e''; split; [|done].
2500 etrans; [apply Hsteps|]. etrans; [apply SAppL_rtc, Hsteps'|]. done.
2501 - destruct n as [|n]; [done|]. rewrite force_deep_S.
2502 intros Hforce. destruct v; simplify_res.
2503 + (* VLit *) by eexists.
2504 + (* VAbs *) by eexists.
2505 + (* VAbsMatch *) by eexists.
2506 + (* VList *)
2507 destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res.
2508 assert (∃ ts',
2509 EList (thunk_to_expr <$> ts) -{DEEP}->* EList (thunk_to_expr <$> ts') ∧
2510 if mvs is Some vs then thunk_to_expr <$> ts' = val_to_expr <$> vs
2511 else nf (step DEEP) (EList (thunk_to_expr <$> ts')) ∧
2512 ¬Forall (final DEEP ∘ thunk_to_expr) ts')
2513 as (ts' & Hsteps & Hts'); last first.
2514 { eexists; split; [done|]. destruct mvs as [vs|]; simplify_eq/=.
2515 * f_equal. rewrite -list_fmap_compose Hts'.
2516 clear. induction vs; f_equal/=; auto.
2517 * destruct Hts' as [Hnf Hfinal]; split; [done|].
2518 inv 1. by apply Hfinal, Forall_fmap. }
2519 revert mvs Hmap. induction ts as [|t ts IH]; intros mv' Hmap; simplify_res.
2520 { by exists []. }
2521 destruct (interp_thunk _ _) as [mv''|] eqn:Hthunk; simplify_res.
2522 apply interp_thunk_sound in Hthunk as (et & Htsteps & Het).
2523 destruct mv'' as [v''|]; simplify_res; last first.
2524 { exists (Thunk ∅ et :: ts); csimpl. rewrite subst_env_empty.
2525 apply (stuck_shallow_any DEEP) in Het as [??]. split_and!.
2526 * eapply (SList_rtc []); [done|].
2527 etrans; [by apply steps_shallow_any|done].
2528 * by apply List_nf_cons.
2529 * rewrite Forall_cons /= subst_env_empty.
2530 naive_solver eauto using final_any_shallow. }
2531 destruct (force_deep _ _) as [mvf|] eqn:Hforce; simplify_res.
2532 pose proof Hforce as Hforce'.
2533 apply force_deep_sound in Hforce' as (e' & Hsteps' & He').
2534 destruct mvf as [vf|]; simplify_res; last first.
2535 { exists (Thunk ∅ e' :: ts). csimpl. rewrite subst_env_empty.
2536 destruct He'. split_and!.
2537 * eapply (SList_rtc []); [done|].
2538 etrans; [by apply steps_shallow_any|done].
2539 * by apply List_nf_cons.
2540 * rewrite Forall_cons /= subst_env_empty. naive_solver. }
2541 destruct (mapM _ _) as [mvs|] eqn:Hmap'; simplify_res.
2542 destruct (IH _ eq_refl) as (ts' & Hsteps'' & Hts').
2543 exists (Forced vf :: ts'); csimpl. split.
2544 { etrans; [eapply (SList_rtc []); [done..|];
2545 etrans; [by apply steps_shallow_any|done]|]; simpl.
2546 eapply List_steps_cons; by eauto using final_force_deep. }
2547 destruct mvs as [vs|]; simplify_res.
2548 { by rewrite Hts'. }
2549 split; [|rewrite Forall_cons; naive_solver].
2550 apply List_nf_cons_final; naive_solver eauto using final_force_deep.
2551 + (* VAttr *)
2552 destruct (map_mapM_sorted _ _) as [mvs|] eqn:Hmap; simplify_res.
2553 assert (∃ ts',
2554 EAttr (AttrN ∘ thunk_to_expr <$> ts) -{DEEP}->*
2555 EAttr (AttrN ∘ thunk_to_expr <$> ts') ∧
2556 if mvs is Some vs then thunk_to_expr <$> ts' = val_to_expr <$> vs
2557 else nf (step DEEP) (EAttr (AttrN ∘ thunk_to_expr <$> ts')) ∧
2558 ¬map_Forall (λ _, final DEEP ∘ thunk_to_expr) ts')
2559 as (ts' & Hsteps & Hts'); last first.
2560 { eexists; split; [done|]. destruct mvs as [vs|]; simplify_eq/=.
2561 * f_equal. rewrite map_fmap_compose Hts'.
2562 apply map_eq=> x. rewrite !lookup_fmap. by destruct (vs !! x).
2563 * destruct Hts' as [Hnf Hfinal]; split; [done|].
2564 inv 1. apply Hfinal=> x t Hx /=.
2565 ospecialize (H2 x _ _); first by rewrite lookup_fmap Hx. done. }
2566 revert mvs Hmap. induction ts as [|x t ts Hx ? IH]
2567 using (map_sorted_ind attr_le); intros mv' Hmap.
2568 { rewrite map_mapM_sorted_empty in Hmap; simplify_res. by exists ∅. }
2569 rewrite map_mapM_sorted_insert //= in Hmap.
2570 assert ((AttrN ∘ thunk_to_expr <$> ts) !! x = None).
2571 { by rewrite lookup_fmap Hx. }
2572 assert (∀ y α, (AttrN ∘ thunk_to_expr <$> ts) !! y = Some α →
2573 final DEEP (attr_expr α) ∨ attr_le x y).
2574 { intros y α. rewrite lookup_fmap. destruct (ts !! y) eqn:?; naive_solver. }
2575 destruct (interp_thunk _ _) as [mv''|] eqn:Hthunk; simplify_res.
2576 apply interp_thunk_sound in Hthunk as (et & Htsteps & Het).
2577 destruct mv'' as [v''|]; simplify_res; last first.
2578 { exists (<[x:=Thunk ∅ et]> ts).
2579 rewrite !fmap_insert /= subst_env_empty.
2580 apply (stuck_shallow_any DEEP) in Het as [??]. split_and!.
2581 * eapply SAttr_lookup_rtc; [done..|].
2582 etrans; [by apply steps_shallow_any|done].
2583 * apply Attr_nf_insert; auto.
2584 intros y. rewrite lookup_fmap fmap_is_Some. eauto.
2585 * rewrite map_Forall_insert //= subst_env_empty.
2586 naive_solver eauto using final_any_shallow. }
2587 destruct (force_deep _ _) as [mvf|] eqn:Hforce; simplify_res.
2588 pose proof Hforce as Hforce'.
2589 apply force_deep_sound in Hforce' as (e' & Hsteps' & He').
2590 destruct mvf as [vf|]; simplify_res; last first.
2591 { exists (<[x:=Thunk ∅ e']> ts). rewrite !fmap_insert /= subst_env_empty.
2592 destruct He'. split_and!.
2593 * eapply SAttr_lookup_rtc; [done..|].
2594 etrans; [by apply steps_shallow_any|done].
2595 * apply Attr_nf_insert; auto.
2596 intros y. rewrite lookup_fmap fmap_is_Some. eauto.
2597 * rewrite map_Forall_insert //= subst_env_empty. naive_solver. }
2598 destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap'; simplify_res.
2599 destruct (IH _ eq_refl) as (ts' & Hsteps'' & Hts').
2600 exists (<[x:=Forced vf]> ts'). split.
2601 { rewrite !fmap_insert /=.
2602 etrans; [eapply SAttr_lookup_rtc; [done..|];
2603 etrans; [by apply steps_shallow_any|done]|].
2604 eapply Attr_steps_insert; by eauto using final_force_deep. }
2605 destruct mvs as [vs|]; simplify_res.
2606 { by rewrite !fmap_insert Hts'. }
2607 assert (∀ y, ts !! y = None ↔ ts' !! y = None) as Hdom.
2608 { intros y. rewrite -!(fmap_None (AttrN ∘ thunk_to_expr)).
2609 rewrite -!lookup_fmap. by eapply Attr_steps_dom. }
2610 split; [|rewrite map_Forall_insert; naive_solver].
2611 rewrite fmap_insert /=. apply Attr_nf_insert_final;
2612 eauto using final_force_deep.
2613 * rewrite lookup_fmap fmap_None. naive_solver.
2614 * intros y. rewrite lookup_fmap fmap_is_Some.
2615 rewrite -not_eq_None_Some -Hdom not_eq_None_Some. auto.
2616 * naive_solver.
2617Qed.
2618
2619Lemma interp_sound_open' n μ E e mv :
2620 interp' n μ E e = Res mv →
2621 ∃ e', subst_env E e -{μ}->* e' ∧
2622 if mv is Some v' then e' = val_to_expr v' else stuck μ e'.
2623Proof.
2624 intros Hinterp. destruct μ.
2625 { rewrite interp_shallow' in Hinterp. by eapply interp_sound_open. }
2626 rewrite /interp' /= in Hinterp.
2627 destruct (interp n E e) as [mv'|] eqn:Hinterp'; simplify_res.
2628 apply interp_sound_open in Hinterp' as (e' & Hsteps & He').
2629 destruct mv' as [v'|]; simplify_res; last first.
2630 { eauto using steps_shallow_any, stuck_shallow_any. }
2631 eapply force_deep_sound in Hinterp as (e'' & Hsteps' & He'').
2632 eexists; split; [|done]. etrans; [by eapply steps_shallow_any|done].
2633Qed.
2634
2635Lemma interp_sound n μ e mv :
2636 interp' n μ ∅ e = Res mv →
2637 ∃ e', e -{μ}->* e' ∧
2638 if mv is Some v then e' = val_to_expr v else stuck μ e'.
2639Proof.
2640 intros Hsteps%interp_sound_open'. by rewrite subst_env_empty in Hsteps.
2641Qed.
2642
2643(** Final theorems *)
2644Theorem interp_sound_complete_ret e v :
2645 (∃ w n, interp' n SHALLOW ∅ e = mret w ∧ val_to_expr v = val_to_expr w)
2646 ↔ e -{SHALLOW}->* val_to_expr v.
2647Proof.
2648 split.
2649 - by intros (n & w & (e' & ? & ->)%interp_sound & ->).
2650 - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?);
2651 unfold nf, red;
2652 naive_solver eauto using final_val_to_expr, step_not_val_to_expr.
2653Qed.
2654
2655Theorem interp_sound_complete_ret_lit μ e bl (Hbl : base_lit_ok bl) :
2656 (∃ n, interp' n μ ∅ e = mret (VLit bl Hbl)) ↔ e -{μ}->* ELit bl.
2657Proof.
2658 split.
2659 - intros [n (e' & ? & ->)%interp_sound]. done.
2660 - intros Hsteps. apply interp_complete_ret in Hsteps
2661 as ([] & n & ? & Hv); simplify_eq/=; last by constructor.
2662 exists n. by rewrite (proof_irrel Hbl Hbl0).
2663Qed.
2664
2665Theorem interp_sound_complete_fail μ e :
2666 (∃ n, interp' n μ ∅ e = mfail) ↔ ∃ e', e -{μ}->* e' ∧ stuck μ e'.
2667Proof.
2668 split.
2669 - by intros [n ?%interp_sound].
2670 - intros (e' & Hsteps & Hnf & Hfinal). by eapply interp_complete_fail.
2671Qed.
2672
2673Theorem interp_sound_complete_no_fuel μ e :
2674 (∀ n, interp' n μ ∅ e = NoFuel) ↔ all_loop (step μ) e.
2675Proof.
2676 rewrite all_loop_alt. split.
2677 - intros Hnofuel e' Hsteps.
2678 destruct (red_final_interp μ e') as [|[|He']]; [done|..].
2679 + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done.
2680 by rewrite Hnofuel in Hinterp.
2681 + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]).
2682 destruct (interp_complete μ e e'')
2683 as (mv & n & Hinterp & _); [by etrans|done|].
2684 by rewrite Hnofuel in Hinterp.
2685 - intros Hred n. destruct (interp' n μ ∅ e) as [mv|] eqn:Hinterp; [|done].
2686 destruct (interp_sound _ _ _ _ Hinterp) as (e' & Hsteps & Hstuck).
2687 destruct mv as [v|]; simplify_eq/=.
2688 + apply Hred in Hsteps as []%final_nf. by eapply final_val_to_expr'.
2689 + destruct Hstuck as [[] ?]; eauto.
2690Qed.
diff --git a/theories/nix/notations.v b/theories/nix/notations.v
new file mode 100644
index 0000000..e9995b5
--- /dev/null
+++ b/theories/nix/notations.v
@@ -0,0 +1,43 @@
1From mininix Require Export nix.operational.
2
3(* Influenced by
4https://gitlab.mpi-sws.org/iris/iris/-/blob/master/iris_heap_lang/notation.v
5But always uses ":" instead of a scope. *)
6
7Coercion EId' : string >-> expr.
8Coercion NInt : Z >-> num.
9Coercion NFloat : float >-> num.
10Coercion LitNum : num >-> base_lit.
11Coercion LitBool : bool >-> base_lit.
12Coercion ELit : base_lit >-> expr.
13Coercion EApp : expr >-> Funclass.
14
15Notation "λattr: a , e" := (EAbsMatch a true e)
16 (at level 200, e, a at level 200,
17 format "'[' 'λattr:' a , '/ ' e ']'").
18Notation "λattr: a .., e" := (EAbsMatch a false e)
19 (at level 200, e, a at level 200,
20 format "'[' 'λattr:' a .., '/ ' e ']'").
21
22Notation "λ: x .. y , e" := (EAbs x .. (EAbs y e) ..)
23 (at level 200, x, y at level 1, e at level 200,
24 format "'[' 'λ:' x .. y , '/ ' e ']'").
25Notation "'let:' x := e1 'in' e2" := (ELet x e1 e2)
26 (at level 200, x at level 1, e1, e2 at level 200,
27 format "'[' 'let:' x := '[' e1 ']' 'in' '/' e2 ']'").
28Notation "'with:' a 'in' e" := (EWith a e)
29 (at level 200, a, e at level 200,
30 format "'[' 'with:' a 'in' '/' e ']'").
31
32Notation "'if:' e1 'then' e2 'else' e3" := (EIf e1 e2 e3)
33 (at level 200, e1, e2, e3 at level 200).
34
35Notation "e1 .: e2" := (ESelect e1 e2) (at level 70, no associativity).
36
37Notation "e1 +: e2" := (EBinOp AddOp e1 e2) (at level 50, left associativity).
38Notation "e1 *: e2" := (EBinOp MulOp e1 e2).
39Notation "e1 -: e2" := (EBinOp SubOp e1 e2) (at level 50, left associativity).
40Notation "e1 /: e2" := (EBinOp DivOp e1 e2) (at level 40).
41Notation "e1 =: e2" := (EBinOp EqOp e1 e2) (at level 70, no associativity).
42Notation "e1 <: e2" := (EBinOp LtOp e1 e2) (at level 70, no associativity).
43Notation "'ceil:' e" := (EBinOp (RoundOp Ceil) e LitNull) (at level 10).
diff --git a/theories/nix/operational.v b/theories/nix/operational.v
new file mode 100644
index 0000000..d3f0777
--- /dev/null
+++ b/theories/nix/operational.v
@@ -0,0 +1,527 @@
1From mininix Require Export utils nix.floats.
2From stdpp Require Import options.
3
4(** Our development does not rely on a particular order on attribute set names.
5It can be any decidable total order. We pick something concrete (lexicographic
6order on strings) to avoid having to parametrize the whole development. *)
7Definition attr_le := String.le.
8Global Instance attr_le_dec : RelDecision attr_le := _.
9Global Instance attr_le_po : PartialOrder attr_le := _.
10Global Instance attr_le_total : Total attr_le := _.
11Global Typeclasses Opaque attr_le.
12
13Inductive mode := SHALLOW | DEEP.
14Inductive kind := ABS | WITH.
15Inductive rec := REC | NONREC.
16
17Global Instance rec_eq_dec : EqDecision rec.
18Proof. solve_decision. Defined.
19
20Inductive num :=
21 | NInt (n : Z)
22 | NFloat (f : float).
23
24Inductive base_lit :=
25 | LitNum (n : num)
26 | LitBool (b : bool)
27 | LitString (s : string)
28 | LitNull.
29
30Global Instance num_inhabited : Inhabited num := populate (NInt 0).
31Global Instance base_lit_inhabited : Inhabited base_lit := populate LitNull.
32
33Global Instance num_eq_dec : EqDecision num.
34Proof. solve_decision. Defined.
35Global Instance base_lit_eq_dec : EqDecision base_lit.
36Proof. solve_decision. Defined.
37
38Global Instance maybe_NInt : Maybe NInt := λ n,
39 if n is NInt i then Some i else None.
40Global Instance maybe_NFloat : Maybe NFloat := λ n,
41 if n is NFloat f then Some f else None.
42Global Instance maybe_LitNum : Maybe LitNum := λ bl,
43 if bl is LitNum n then Some n else None.
44Global Instance maybe_LitBool : Maybe LitBool := λ bl,
45 if bl is LitBool b then Some b else None.
46Global Instance maybe_LitString : Maybe LitString := λ bl,
47 if bl is LitString s then Some s else None.
48
49Inductive bin_op : Set :=
50 | AddOp | SubOp | MulOp | DivOp | AndOp | OrOp | XOrOp (* Arithmetic *)
51 | LtOp | EqOp (* Relations *)
52 | RoundOp (m : round_mode) (* Conversions *)
53 | MatchStringOp (* Strings *)
54 | MatchListOp | AppendListOp (* Lists *)
55 | SelectAttrOp | UpdateAttrOp | HasAttrOp
56 | DeleteAttrOp | SingletonAttrOp | MatchAttrOp (* Attribute sets *)
57 | FunctionArgsOp | TypeOfOp.
58
59Global Instance bin_op_eq_dec : EqDecision bin_op.
60Proof. solve_decision. Defined.
61
62Global Instance maybe_RoundOp : Maybe RoundOp := λ op,
63 if op is RoundOp m then Some m else None.
64
65Section expr.
66 Local Unset Elimination Schemes.
67 Inductive expr :=
68 | ELit (bl : base_lit)
69 | EId (x : string) (mke : option (kind * expr))
70 | EAbs (x : string) (e : expr)
71 | EAbsMatch (ms : gmap string (option expr)) (strict : bool) (e : expr)
72 | EApp (e1 e2 : expr)
73 | ESeq (μ : mode) (e1 e2 : expr)
74 | EList (es : list expr)
75 | EAttr (αs : gmap string attr)
76 | ELetAttr (k : kind) (e1 e2 : expr)
77 | EBinOp (op : bin_op) (e1 e2 : expr)
78 | EIf (e1 e2 e3 : expr)
79 with attr :=
80 | Attr (τ : rec) (e : expr).
81End expr.
82
83Definition EId' x := EId x None.
84Notation AttrR := (Attr REC).
85Notation AttrN := (Attr NONREC).
86Notation ESelect e x := (EBinOp SelectAttrOp e (ELit (LitString x))).
87Notation ELet x e := (ELetAttr ABS (EAttr {[ x := AttrN e ]})).
88Notation EWith := (ELetAttr WITH).
89
90Definition attr_expr (α : attr) : expr := match α with Attr _ e => e end.
91Definition attr_rec (α : attr) : rec := match α with Attr μ _ => μ end.
92Definition attr_map (f : expr → expr) (α : attr) : attr :=
93 match α with Attr μ e => Attr μ (f e) end.
94
95Definition from_attr {A} (f g : expr → A) (α : attr) : A :=
96 match α with AttrR e => f e | AttrN e => g e end.
97
98Definition merge_kinded {A} (new old : kind * A) : option (kind * A) :=
99 match new.1, old.1 with
100 | WITH, ABS => Some old
101 | _, _ => Some new
102 end.
103Arguments merge_kinded {_} !_ !_ / : simpl nomatch.
104Notation union_kinded := (union_with merge_kinded).
105
106Definition no_recs : gmap string attr → Prop :=
107 map_Forall (λ _ α, attr_rec α = NONREC).
108
109Definition indirects (αs : gmap string attr) : gmap string (kind * expr) :=
110 map_imap (λ x _, Some (ABS, ESelect (EAttr αs) x)) αs.
111
112Fixpoint subst (ds : gmap string (kind * expr)) (e : expr) : expr :=
113 match e with
114 | ELit b => ELit b
115 | EId x mkd => EId x $ union_kinded (ds !! x) mkd
116 | EAbs x e => EAbs x (subst ds e)
117 | EAbsMatch ms strict e =>
118 EAbsMatch (fmap (M:=option) (subst ds) <$> ms) strict (subst ds e)
119 | EApp e1 e2 => EApp (subst ds e1) (subst ds e2)
120 | ESeq μ e1 e2 => ESeq μ (subst ds e1) (subst ds e2)
121 | EList es => EList (subst ds <$> es)
122 | EAttr αs => EAttr (attr_map (subst ds) <$> αs)
123 | ELetAttr k e1 e2 => ELetAttr k (subst ds e1) (subst ds e2)
124 | EBinOp op e1 e2 => EBinOp op (subst ds e1) (subst ds e2)
125 | EIf e1 e2 e3 => EIf (subst ds e1) (subst ds e2) (subst ds e3)
126 end.
127
128Notation attr_subst ds := (attr_map (subst ds)).
129
130Definition int_min : Z := -(1 ≪ 63).
131Definition int_max : Z := 1 ≪ 63 - 1.
132
133Definition int_ok (i : Z) : bool := bool_decide (int_min ≤ i ≤ int_max)%Z.
134Definition num_ok (n : num) : bool :=
135 match n with NInt i => int_ok i | _ => true end.
136Definition base_lit_ok (bl : base_lit) : bool :=
137 match bl with LitNum n => num_ok n | _ => true end.
138
139Inductive final : mode → expr → Prop :=
140 | ELitFinal μ bl : base_lit_ok bl → final μ (ELit bl)
141 | EAbsFinal μ x e : final μ (EAbs x e)
142 | EAbsMatchFinal μ ms strict e : final μ (EAbsMatch ms strict e)
143 | EListShallowFinal es : final SHALLOW (EList es)
144 | EListDeepFinal es : Forall (final DEEP) es → final DEEP (EList es)
145 | EAttrShallowFinal αs : no_recs αs → final SHALLOW (EAttr αs)
146 | EAttrDeepFinal αs :
147 no_recs αs →
148 map_Forall (λ _, final DEEP ∘ attr_expr) αs →
149 final DEEP (EAttr αs).
150
151Fixpoint sem_eq_list (es1 es2 : list expr) : expr :=
152 match es1, es2 with
153 | [], [] => ELit (LitBool true)
154 | e1 :: es1, e2 :: es2 =>
155 EIf (EBinOp EqOp e1 e2) (sem_eq_list es1 es2) (ELit (LitBool false))
156 | _, _ => ELit (LitBool false)
157 end.
158
159Fixpoint sem_lt_list (es1 es2 : list expr) : expr :=
160 match es1, es2 with
161 | [], _ => ELit (LitBool true)
162 | e1 :: es1, e2 :: es2 =>
163 EIf (EBinOp LtOp e1 e2) (ELit (LitBool true)) $
164 EIf (EBinOp EqOp e1 e2) (sem_lt_list es1 es2) (ELit (LitBool false))
165 | _ :: _, [] => ELit (LitBool false)
166 end.
167
168Definition sem_and_attr (es : gmap string expr) : expr :=
169 map_fold_sorted attr_le
170 (λ _ e1 e2, EIf e1 e2 (ELit (LitBool false)))
171 (ELit (LitBool true)) es.
172
173Definition sem_eq_attr (αs1 αs2 : gmap string attr) : expr :=
174 sem_and_attr $ merge (λ mα1 mα2,
175 α1 ← mα1; α2 ← mα2; Some (EBinOp EqOp (attr_expr α1) (attr_expr α2))) αs1 αs2.
176
177Definition num_to_float (n : num) : float :=
178 match n with
179 | NInt i => Float.of_Z i
180 | NFloat f => f
181 end.
182
183Definition sem_bin_op_lift
184 (fint : Z → Z → Z) (ffloat : float → float → float)
185 (n1 n2 : num) : option num :=
186 match n1, n2 with
187 | NInt i1, NInt i2 =>
188 let i := fint i1 i2 in
189 guard (int_ok i);;
190 Some (NInt i)
191 | _, _ => Some $ NFloat $ ffloat (num_to_float n1) (num_to_float n2)
192 end.
193
194Definition sem_bin_rel_lift
195 (fint : Z → Z → bool) (ffloat : float → float → bool)
196 (n1 n2 : num) : bool :=
197 match n1, n2 with
198 | NInt i1, NInt i2 => fint i1 i2
199 | _, _ => ffloat (num_to_float n1) (num_to_float n2)
200 end.
201
202Definition sem_eq_base_lit (bl1 bl2 : base_lit) : bool :=
203 match bl1, bl2 with
204 | LitNum n1, LitNum n2 => sem_bin_rel_lift Z.eqb Float.eqb n1 n2
205 | LitBool b1, LitBool b2 => bool_decide (b1 = b2)
206 | LitString s1, LitString s2 => bool_decide (s1 = s2)
207 | LitNull, LitNull => true
208 | _, _ => false
209 end.
210
211(** Precondition e1 and e2 are final *)
212Definition sem_eq (e1 e2 : expr) : option expr :=
213 match e1, e2 with
214 | ELit bl1, ELit bl2 => Some $ ELit (LitBool (sem_eq_base_lit bl1 bl2))
215 | EAbs _ _, EAbs _ _ => None
216 | EList es1, EList es2 => Some $
217 if decide (length es1 = length es2) then sem_eq_list es1 es2
218 else ELit $ LitBool false
219 | EAttr αs1, EAttr αs2 => Some $
220 if decide (dom αs1 = dom αs2) then sem_eq_attr αs1 αs2
221 else ELit $ LitBool false
222 | _, _ => Some $ ELit (LitBool false)
223 end.
224
225Definition div_allowed (n : num) : bool :=
226 match n with
227 | NInt n => bool_decide (n ≠ 0%Z)
228 | NFloat f => negb (Float.eqb f (Float.of_Z 0)) (* TODO: Check NaNs *)
229 end.
230
231Definition sem_bin_op_num (op : bin_op) (n1 : num) : option (num → option base_lit) :=
232 match op with
233 | AddOp => Some $ λ n2,
234 LitNum <$> sem_bin_op_lift Z.add Float.add n1 n2
235 | SubOp => Some $ λ n2,
236 LitNum <$> sem_bin_op_lift Z.sub Float.sub n1 n2
237 | MulOp => Some $ λ n2,
238 LitNum <$> sem_bin_op_lift Z.mul Float.mul n1 n2
239 | DivOp => Some $ λ n2,
240 (* Quot can overflow: [MIN_INT `quot` -1] equals [MAX_INT + 1] *)
241 guard (div_allowed n2);;
242 LitNum <$> sem_bin_op_lift Z.quot Float.div n1 n2
243 | AndOp =>
244 i1 ← maybe NInt n1;
245 Some $ λ n2, i2 ← maybe NInt n2;
246 Some $ LitNum $ NInt $ Z.land i1 i2
247 | OrOp =>
248 i1 ← maybe NInt n1;
249 Some $ λ n2, i2 ← maybe NInt n2;
250 Some $ LitNum $ NInt $ Z.lor i1 i2
251 | XOrOp =>
252 i1 ← maybe NInt n1;
253 Some $ λ n2, i2 ← maybe NInt n2;
254 Some $ LitNum $ NInt $ Z.lxor i1 i2
255 | LtOp => Some $ λ n2,
256 Some $ LitBool (sem_bin_rel_lift Z.ltb Float.ltb n1 n2)
257 | _ => None
258 end%Z.
259
260Definition sem_bin_op_string (op : bin_op) : option (string → string → base_lit) :=
261 match op with
262 | AddOp => Some $ λ s1 s2, LitString (s1 +:+ s2)
263 | LtOp => Some $ λ s1 s2, LitBool (bool_decide (strict attr_le s1 s2))
264 | _ => None
265 end.
266
267Definition type_of_num (n : num) : string :=
268 match n with
269 | NInt _ => "int"
270 | NFloat _ => "float"
271 end.
272
273Definition type_of_base_lit (bl : base_lit) : string :=
274 match bl with
275 | LitNum n => type_of_num n
276 | LitBool _ => "bool"
277 | LitString _ => "string"
278 | LitNull => "null"
279 end.
280
281Definition type_of_expr (e : expr) :=
282 match e with
283 | ELit bl => Some (type_of_base_lit bl)
284 | EAbs _ _ | EAbsMatch _ _ _ => Some "lambda"
285 | EList _ => Some "list"
286 | EAttr _ => Some "set"
287 | _ => None
288 end.
289
290(* Used for [RoundOp] *)
291Definition float_to_bounded_Z (f : float) : Z :=
292 match Float.to_Z f with
293 | Some x => if decide (int_ok x) then x else int_min
294 | None => int_min
295 end.
296
297Inductive sem_bin_op : bin_op → expr → (expr → expr → Prop) → Prop :=
298 | EqSem e1 :
299 sem_bin_op EqOp e1 (λ e2 e, sem_eq e1 e2 = Some e)
300 | LitNumSem op n1 f :
301 sem_bin_op_num op n1 = Some f →
302 sem_bin_op op (ELit (LitNum n1)) (λ e2 e, ∃ n2 bl,
303 e2 = ELit (LitNum n2) ∧ f n2 = Some bl ∧ e = ELit bl)
304 | RoundSem m n1 :
305 sem_bin_op (RoundOp m) (ELit (LitNum n1)) (λ e2 e,
306 e2 = ELit LitNull ∧
307 e = ELit $ LitNum $ NInt $ float_to_bounded_Z $ Float.round m $ num_to_float n1)
308 | LitStringSem op s1 f :
309 sem_bin_op_string op = Some f →
310 sem_bin_op op (ELit (LitString s1)) (λ e2 e, ∃ s2,
311 e2 = ELit (LitString s2) ∧ e = ELit (f s1 s2))
312 | MatchStringSem s :
313 sem_bin_op MatchStringOp (ELit (LitString s)) (λ e2 e,
314 e2 = ELit LitNull ∧
315 match s with
316 | EmptyString => e = EAttr {[
317 "empty" := AttrN (ELit (LitBool true));
318 "head" := AttrN (ELit LitNull);
319 "tail" := AttrN (ELit LitNull) ]}
320 | String a s => e = EAttr {[
321 "empty" := AttrN (ELit (LitBool false));
322 "head" := AttrN (ELit (LitString (String a EmptyString)));
323 "tail" := AttrN (ELit (LitString s)) ]}
324 end)
325 | LtListSem es :
326 sem_bin_op LtOp (EList es) (λ e2 e, ∃ es',
327 e2 = EList es' ∧
328 e = sem_lt_list es es')
329 | MatchListSem es :
330 sem_bin_op MatchListOp (EList es) (λ e2 e,
331 e2 = ELit LitNull ∧
332 match es with
333 | [] => e = EAttr {[
334 "empty" := AttrN (ELit (LitBool true));
335 "head" := AttrN (ELit LitNull);
336 "tail" := AttrN (ELit LitNull) ]}
337 | e' :: es => e = EAttr {[
338 "empty" := AttrN (ELit (LitBool false));
339 "head" := AttrN e';
340 "tail" := AttrN (EList es) ]}
341 end)
342 | AppendListSem es :
343 sem_bin_op AppendListOp (EList es) (λ e2 e, ∃ es',
344 e2 = EList es' ∧
345 e = EList (es ++ es'))
346 | SelectAttrSem αs :
347 no_recs αs →
348 sem_bin_op SelectAttrOp (EAttr αs) (λ e2 e, ∃ x,
349 e2 = ELit (LitString x) ∧ αs !! x = Some (AttrN e))
350 | UpdateAttrSem αs1 :
351 no_recs αs1 →
352 sem_bin_op UpdateAttrOp (EAttr αs1) (λ e2 e, ∃ αs2,
353 e2 = EAttr αs2 ∧ no_recs αs2 ∧ e = EAttr (αs2 ∪ αs1))
354 | HasAttrSem αs :
355 no_recs αs →
356 sem_bin_op HasAttrOp (EAttr αs) (λ e2 e, ∃ x,
357 e2 = ELit (LitString x) ∧ e = ELit (LitBool (bool_decide (is_Some (αs !! x)))))
358 | DeleteAttrSem αs :
359 no_recs αs →
360 sem_bin_op DeleteAttrOp (EAttr αs) (λ e2 e, ∃ x,
361 e2 = ELit (LitString x) ∧ e = EAttr (delete x αs))
362 | SingletonAttrSem x :
363 sem_bin_op SingletonAttrOp (ELit (LitString x)) (λ e2 e,
364 e2 = ELit LitNull ∧
365 e = EAbs "t" (EAttr {[ x := AttrN (EId' "t") ]}))
366 | MatchAttrSem αs :
367 no_recs αs →
368 sem_bin_op MatchAttrOp (EAttr αs) (λ e2 e,
369 e2 = ELit LitNull ∧
370 ((αs = ∅ ∧
371 e = EAttr {[
372 "empty" := AttrN (ELit (LitBool true));
373 "key" := AttrN (ELit LitNull);
374 "head" := AttrN (ELit LitNull);
375 "tail" := AttrN (ELit LitNull) ]}) ∨
376 (∃ x e',
377 αs !! x = Some (AttrN e') ∧
378 (∀ y, is_Some (αs !! y) → attr_le x y) ∧
379 e = EAttr {[
380 "empty" := AttrN (ELit (LitBool false));
381 "key" := AttrN (ELit (LitString x));
382 "head" := AttrN e';
383 "tail" := AttrN (EAttr (delete x αs)) ]})))
384 | FunctionArgsAbsSem x e' :
385 sem_bin_op FunctionArgsOp (EAbs x e') (λ e2 e,
386 e2 = ELit LitNull ∧
387 e = EAttr ∅)
388 | FunctionArgsAbsMatchSem ms strict e' :
389 sem_bin_op FunctionArgsOp (EAbsMatch ms strict e') (λ e2 e,
390 e2 = ELit LitNull ∧
391 e = EAttr (AttrN ∘ ELit ∘ LitBool ∘ from_option (λ _, true) false <$> ms))
392 | TypeOfSem e1 :
393 sem_bin_op TypeOfOp e1 (λ e2 e, ∃ x,
394 e2 = ELit LitNull ∧
395 type_of_expr e1 = Some x ∧
396 e = ELit (LitString x)).
397
398Inductive matches :
399 gmap string expr → gmap string (option expr) → bool → gmap string attr → Prop :=
400 | MatchEmpty strict :
401 matches ∅ ∅ strict ∅
402 | MatchAny es :
403 matches es ∅ false ∅
404 | MatchAvail x e es ms md strict βs :
405 es !! x = None →
406 ms !! x = None →
407 matches es ms strict βs →
408 matches (<[x:=e]> es) (<[x:=md]> ms) strict (<[x:=AttrN e]> βs)
409 | MatchOptDefault x es ms d strict βs :
410 es !! x = None →
411 ms !! x = None →
412 matches es ms strict βs →
413 matches es (<[x:=Some d]> ms) strict (<[x:=AttrR d]> βs).
414
415Reserved Notation "e1 -{ μ }-> e2"
416 (right associativity, at level 55, μ at level 1, format "e1 -{ μ }-> e2").
417
418Inductive ctx1 : mode → mode → (expr → expr) → Prop :=
419 | CList es1 es2 :
420 Forall (final DEEP) es1 →
421 ctx1 DEEP DEEP (λ e, EList (es1 ++ e :: es2))
422 | CAttr αs x :
423 no_recs αs →
424 αs !! x = None →
425 (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) →
426 ctx1 DEEP DEEP (λ e, EAttr (<[x:=AttrN e]> αs))
427 | CAppL μ e2 :
428 ctx1 SHALLOW μ (λ e1, EApp e1 e2)
429 | CAppR μ ms strict e1 :
430 ctx1 SHALLOW μ (EApp (EAbsMatch ms strict e1))
431 | CSeq μ μ' e2 :
432 ctx1 μ' μ (λ e1, ESeq μ' e1 e2)
433 | CLetAttr μ k e2 :
434 ctx1 SHALLOW μ (λ e1, ELetAttr k e1 e2)
435 | CBinOpL μ op e2 :
436 ctx1 SHALLOW μ (λ e1, EBinOp op e1 e2)
437 | CBinOpR μ op e1 Φ :
438 final SHALLOW e1 →
439 sem_bin_op op e1 Φ →
440 ctx1 SHALLOW μ (EBinOp op e1)
441 | CIf μ e2 e3 :
442 ctx1 SHALLOW μ (λ e1, EIf e1 e2 e3).
443
444Inductive step : mode → relation expr :=
445 | Sβ μ x e1 e2 :
446 EApp (EAbs x e1) e2 -{μ}-> subst {[x:=(ABS, e2)]} e1
447 | SβMatch μ ms strict e1 αs βs :
448 no_recs αs →
449 matches (attr_expr <$> αs) ms strict βs →
450 EApp (EAbsMatch ms strict e1) (EAttr αs) -{μ}->
451 subst (indirects βs) e1
452 | SFunctor μ αs e1 e2 :
453 no_recs αs →
454 αs !! "__functor" = Some (AttrN e1) →
455 EApp (EAttr αs) e2 -{μ}-> EApp (EApp e1 (EAttr αs)) e2
456 | SSeqFinal μ μ' e1 e2 :
457 final μ' e1 → ESeq μ' e1 e2 -{μ}-> e2
458 | SLetAttrAttr μ k αs e :
459 no_recs αs →
460 ELetAttr k (EAttr αs) e -{μ}-> subst ((k,.) ∘ attr_expr <$> αs) e
461 | SAttr_rec μ αs :
462 ¬no_recs αs →
463 EAttr αs -{μ}->
464 EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs)
465 | SBinOp μ op e1 Φ e2 e :
466 final SHALLOW e1 →
467 final SHALLOW e2 →
468 sem_bin_op op e1 Φ → Φ e2 e →
469 EBinOp op e1 e2 -{μ}-> e
470 | SIfBool μ b e2 e3 :
471 EIf (ELit (LitBool b)) e2 e3 -{μ}-> if b then e2 else e3
472 | SId μ x k e :
473 EId x (Some (k,e)) -{μ}-> e
474 | SCtx K μ μ' e e' :
475 ctx1 μ μ' K → e -{μ}-> e' → K e -{μ'}-> K e'
476where "e1 -{ μ }-> e2" := (step μ e1 e2).
477
478Notation "e1 -{ μ }->* e2" := (rtc (step μ) e1 e2)
479 (right associativity, at level 55, μ at level 1, format "e1 -{ μ }->* e2").
480Notation "e1 -{ μ }->+ e2" := (tc (step μ) e1 e2)
481 (right associativity, at level 55, μ at level 1, format "e1 -{ μ }->+ e2").
482
483Definition stuck (μ : mode) (e : expr) : Prop :=
484 nf (step μ) e ∧ ¬final μ e.
485
486(** Induction *)
487Fixpoint expr_size (e : expr) : nat :=
488 match e with
489 | ELit _ => 1
490 | EId _ mkd => S (from_option (expr_size ∘ snd) 1 mkd)
491 | EAbs _ d => S (expr_size d)
492 | EAbsMatch ms _ e =>
493 S (map_sum_with (from_option expr_size 1) ms + expr_size e)
494 | EApp e1 e2 | ESeq _ e1 e2 => S (expr_size e1 + expr_size e2)
495 | EList es => S (sum_list_with expr_size es)
496 | EAttr eτs => S (map_sum_with (expr_size ∘ attr_expr) eτs)
497 | ELetAttr _ e1 e2 => S (expr_size e1 + expr_size e2)
498 | EBinOp _ e1 e2 => S (expr_size e1 + expr_size e2)
499 | EIf e1 e2 e3 => S (expr_size e1 + expr_size e2 + expr_size e3)
500 end.
501
502Lemma expr_ind (P : expr → Prop) :
503 (∀ b, P (ELit b)) →
504 (∀ x mkd, from_option (P ∘ snd) True mkd → P (EId x mkd)) →
505 (∀ x e, P e → P (EAbs x e)) →
506 (∀ ms strict e,
507 map_Forall (λ _, from_option P True) ms → P e → P (EAbsMatch ms strict e)) →
508 (∀ e1 e2, P e1 → P e2 → P (EApp e1 e2)) →
509 (∀ μ e1 e2, P e1 → P e2 → P (ESeq μ e1 e2)) →
510 (∀ es, Forall P es → P (EList es)) →
511 (∀ αs, map_Forall (λ _, P ∘ attr_expr) αs → P (EAttr αs)) →
512 (∀ k e1 e2, P e1 → P e2 → P (ELetAttr k e1 e2)) →
513 (∀ op e1 e2, P e1 → P e2 → P (EBinOp op e1 e2)) →
514 (∀ e1 e2 e3, P e1 → P e2 → P e3 → P (EIf e1 e2 e3)) →
515 ∀ e, P e.
516Proof.
517 intros Hlit Hid Habs Hmatch Happ Hseq Hlist Hattr Hlet Hop Hif e.
518 induction (Nat.lt_wf_0_projected expr_size e) as [e _ IH].
519 destruct e; repeat destruct select (option _); simpl in *; eauto with lia.
520 - apply Hmatch; [|by eauto with lia]=> y [e'|] Hx //=. apply IH, Nat.lt_succ_r.
521 etrans; [|apply Nat.le_add_r].
522 eapply (map_sum_with_lookup_le (from_option expr_size 1) _ _ _ Hx).
523 - apply Hlist, Forall_forall=> e ?. apply IH, Nat.lt_succ_r.
524 by apply sum_list_with_in.
525 - apply Hattr, map_Forall_lookup=> y e ?. apply IH, Nat.lt_succ_r.
526 by eapply (map_sum_with_lookup_le (expr_size ∘ attr_expr)).
527Qed.
diff --git a/theories/nix/operational_props.v b/theories/nix/operational_props.v
new file mode 100644
index 0000000..4041bfe
--- /dev/null
+++ b/theories/nix/operational_props.v
@@ -0,0 +1,680 @@
1From mininix Require Export utils nix.operational.
2From stdpp Require Import options.
3
4(** Properties of operational semantics *)
5Lemma float_to_bounded_Z_ok f : int_ok (float_to_bounded_Z f).
6Proof.
7 rewrite /float_to_bounded_Z.
8 destruct (Float.to_Z f); simplify_option_eq; done.
9Qed.
10
11Lemma int_ok_alt i :
12 int_ok i ↔ ∀ n, (63 ≤ n)%Z → Z.testbit i n = bool_decide (i < 0)%Z.
13Proof.
14 rewrite -Z.bounded_iff_bits //.
15 rewrite /int_ok bool_decide_spec /int_min /int_max Z.shiftl_1_l. lia.
16Qed.
17
18Lemma int_ok_land i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.land i1 i2).
19Proof.
20 rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.land_spec Hi1 // Hi2 //.
21 apply eq_bool_prop_intro. rewrite andb_True !bool_decide_spec Z.land_neg //.
22Qed.
23
24Lemma int_ok_lor i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.lor i1 i2).
25Proof.
26 rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.lor_spec Hi1 // Hi2 //.
27 apply eq_bool_prop_intro. rewrite orb_True !bool_decide_spec Z.lor_neg //.
28Qed.
29
30Lemma int_ok_lxor i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.lxor i1 i2).
31Proof.
32 rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.lxor_spec Hi1 // Hi2 //.
33 apply eq_bool_prop_intro. rewrite xorb_True !bool_decide_spec.
34 rewrite !Z.lt_nge Z.lxor_nonneg. lia.
35Qed.
36
37Lemma sem_bin_op_num_ok {op f n1 n2 bl} :
38 num_ok n1 → num_ok n2 →
39 sem_bin_op_num op n1 = Some f → f n2 = Some bl → base_lit_ok bl.
40Proof.
41 intros; destruct op, n1, n2; simplify_option_eq;
42 try (by apply (bool_decide_pack _));
43 auto using int_ok_land, int_ok_lor, int_ok_lxor.
44Qed.
45
46Lemma sem_bin_op_string_ok {op f s1 s2} :
47 sem_bin_op_string op = Some f → base_lit_ok (f s1 s2).
48Proof. intros; destruct op; naive_solver. Qed.
49
50Global Hint Extern 0 (no_recs (_ <$> _)) => by apply map_Forall_fmap : core.
51
52Ltac inv_step := repeat
53 match goal with
54 | H : ¬no_recs (_ <$> _) |- _ => destruct H; by apply map_Forall_fmap
55 | H : ?e -{_}-> _ |- _ => assert_succeeds (is_app_constructor e); inv H
56 | H : ctx1 _ _ ?K |- _ => is_var K; inv H
57 end.
58
59Global Instance Attr_inj τ : Inj (=) (=) (Attr τ).
60Proof. by injection 1. Qed.
61
62Lemma fmap_attr_expr_Attr τ (es : gmap string expr) :
63 attr_expr <$> (Attr τ <$> es) = es.
64Proof. apply map_eq=> x. rewrite !lookup_fmap. by destruct (_ !! _). Qed.
65
66Lemma no_recs_insert αs x e : no_recs αs → no_recs (<[x:=AttrN e]> αs).
67Proof. by apply map_Forall_insert_2. Qed.
68Lemma no_recs_insert_inv αs x τ e :
69 αs !! x = None → no_recs (<[x:=Attr τ e]> αs) → no_recs αs.
70Proof. intros ??%map_Forall_insert; naive_solver. Qed.
71Lemma no_recs_lookup αs x τ e : no_recs αs → αs !! x = Some (Attr τ e) → τ = NONREC.
72Proof. intros Hall. apply Hall. Qed.
73
74Lemma no_recs_attr_subst αs ds : no_recs αs → no_recs (attr_subst ds <$> αs).
75Proof.
76 intros. eapply map_Forall_fmap, map_Forall_impl; [done|]. by intros ? [[]] [=].
77Qed.
78
79Lemma from_attr_no_recs {A} (f g : expr → A) (αs : gmap string attr) :
80 no_recs αs → from_attr f g <$> αs = g ∘ attr_expr <$> αs.
81Proof.
82 intros Hrecs. apply map_eq=> x. rewrite !lookup_fmap. specialize (Hrecs x).
83 destruct (αs !! x) as [[]|] eqn:?; naive_solver.
84Qed.
85
86Lemma sem_and_attr_empty : sem_and_attr ∅ = ELit (LitBool true).
87Proof. done. Qed.
88Lemma sem_and_attr_insert es x e :
89 es !! x = None → (∀ y, is_Some (es !! y) → attr_le x y) →
90 sem_and_attr (<[x:=e]> es) = EIf e (sem_and_attr es) (ELit (LitBool false)).
91Proof. intros. by rewrite /sem_and_attr map_fold_sorted_insert. Qed.
92
93Lemma matches_strict es ms ds x e :
94 es !! x = None →
95 ms !! x = None →
96 matches es ms false ds →
97 matches (<[x:=e]> es) ms false ds.
98Proof.
99 remember false as strict.
100 induction 3; simplify_eq/=;
101 repeat match goal with
102 | H : <[ _ := _ ]> _ !! _ = None |- _ => apply lookup_insert_None in H as [??]
103 | _ => rewrite (insert_commute _ x) //
104 | _ => constructor
105 | _ => apply lookup_insert_None
106 end; eauto.
107Qed.
108
109Lemma subst_empty e : subst ∅ e = e.
110Proof.
111 induction e; repeat destruct select (option _); do 2 f_equal/=; auto.
112 - apply map_eq=> x. rewrite lookup_fmap.
113 destruct (_ !! x) as [[e'|]|] eqn:Hx; do 2 f_equal/=. apply (H _ _ Hx).
114 - induction H; f_equal/=; auto.
115 - apply map_eq; intros i. rewrite lookup_fmap.
116 destruct (_ !! i) as [[τ e]|] eqn:?; do 2 f_equal/=.
117 by eapply (H _ (Attr _ _)).
118Qed.
119
120Lemma subst_union ds1 ds2 e :
121 subst (union_kinded ds1 ds2) e = subst ds1 (subst ds2 e).
122Proof.
123 revert ds1 ds2. induction e; intros ds1 ds2; f_equal/=; auto.
124 - rewrite lookup_union_with.
125 destruct mkd as [[[]]|],
126 (ds1 !! x) as [[[] t1]|], (ds2 !! x) as [[[] t2]|]; naive_solver.
127 - apply map_eq=> y. rewrite !lookup_fmap.
128 destruct (_ !! y) as [[e'|]|] eqn:Hy; do 2 f_equal/=.
129 rewrite -(H _ _ Hy) //.
130 - induction H; f_equal/=; auto.
131 - apply map_eq=> y. rewrite !lookup_fmap.
132 destruct (_ !! y) as [[τ e]|] eqn:Hy; do 2 f_equal/=.
133 rewrite -(H _ _ Hy) //.
134Qed.
135
136Lemma SAppL μ e1 e1' e2 :
137 e1 -{SHALLOW}-> e1' → EApp e1 e2 -{μ}-> EApp e1' e2.
138Proof. apply (SCtx (λ e, EApp e _)). constructor. Qed.
139Lemma SAppR μ ms strict e1 e2 e2' :
140 e2 -{SHALLOW}-> e2' →
141 EApp (EAbsMatch ms strict e1) e2 -{μ}-> EApp (EAbsMatch ms strict e1) e2'.
142Proof. apply SCtx. constructor. Qed.
143Lemma SSeq μ μ' e1 e1' e2 :
144 e1 -{μ'}-> e1' → ESeq μ' e1 e2 -{μ}-> ESeq μ' e1' e2.
145Proof. apply (SCtx (λ e, ESeq _ e _)). constructor. Qed.
146Lemma SList es1 e e' es2 :
147 Forall (final DEEP) es1 →
148 e -{DEEP}-> e' →
149 EList (es1 ++ e :: es2) -{DEEP}-> EList (es1 ++ e' :: es2).
150Proof. intros ?. apply (SCtx (λ e, EList (_ ++ e :: _))). by constructor. Qed.
151Lemma SAttr αs x e e' :
152 no_recs αs →
153 αs !! x = None →
154 (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) →
155 e -{DEEP}-> e' →
156 EAttr (<[x:=AttrN e]> αs) -{DEEP}-> EAttr (<[x:=AttrN e']> αs).
157Proof. intros ???. apply (SCtx (λ e, EAttr (<[x:=AttrN e]> _))). by constructor. Qed.
158Lemma SLetAttr μ k e1 e1' e2 :
159 e1 -{SHALLOW}-> e1' → ELetAttr k e1 e2 -{μ}-> ELetAttr k e1' e2.
160Proof. apply (SCtx (λ e, ELetAttr _ e _)). constructor. Qed.
161Lemma SBinOpL μ op e1 e1' e2 :
162 e1 -{SHALLOW}-> e1' → EBinOp op e1 e2 -{μ}-> EBinOp op e1' e2.
163Proof. apply (SCtx (λ e, EBinOp _ e _)). constructor. Qed.
164Lemma SBinOpR μ op e1 Φ e2 e2' :
165 final SHALLOW e1 → sem_bin_op op e1 Φ →
166 e2 -{SHALLOW}-> e2' → EBinOp op e1 e2 -{μ}-> EBinOp op e1 e2'.
167Proof. intros ??. apply SCtx. by econstructor. Qed.
168Lemma SIf μ e1 e1' e2 e3 :
169 e1 -{SHALLOW}-> e1' → EIf e1 e2 e3 -{μ}-> EIf e1' e2 e3.
170Proof. apply (SCtx (λ e, EIf e _ _)). constructor. Qed.
171
172Global Hint Constructors step : step.
173Global Hint Resolve SAppL SAppR SSeq SList SAttr SLetAttr SBinOpL SBinOpR SIf : step.
174
175Lemma step_not_final μ e1 e2 : e1 -{μ}-> e2 → ¬final μ e1.
176Proof.
177 assert (∀ (αs : gmap string attr) x μ e,
178 map_Forall (λ _, final DEEP ∘ attr_expr) (<[x:=Attr μ e]> αs) → final DEEP e).
179 { intros αs x μ' e Hall. eapply (Hall _ (Attr _ _)), lookup_insert. }
180 induction 1; inv 1; inv_step; decompose_Forall; naive_solver.
181Qed.
182Lemma final_nf μ e : final μ e → nf (step μ) e.
183Proof. by intros ? [??%step_not_final]. Qed.
184
185Lemma step_any_shallow μ e1 e2 :
186 e1 -{μ}-> e2 → e1 -{SHALLOW}-> e2 ∨ final SHALLOW e1.
187Proof.
188 induction 1; inv_step;
189 naive_solver eauto using final, no_recs_insert with step.
190Qed.
191
192Lemma step_shallow_any μ e1 e2 : e1 -{SHALLOW}-> e2 → e1 -{μ}-> e2.
193Proof.
194 remember SHALLOW as μ'. induction 1; inv_step; simplify_eq/=; eauto with step.
195Qed.
196Lemma steps_shallow_any μ e1 e2 : e1 -{SHALLOW}->* e2 → e1 -{μ}->* e2.
197Proof. induction 1; eauto using rtc, step_shallow_any. Qed.
198Lemma final_any_shallow μ e : final μ e → final SHALLOW e.
199Proof. destruct μ; [done|]. induction 1; simplify_eq/=; eauto using final. Qed.
200Lemma stuck_shallow_any μ e : stuck SHALLOW e → stuck μ e.
201Proof.
202 intros [Hnf Hfinal]. split; [|naive_solver eauto using final_any_shallow].
203 intros [e' Hstep%step_any_shallow]; naive_solver.
204Qed.
205
206Lemma step_final_shallow μ e1 e2 :
207 final SHALLOW e1 → e1 -{μ}-> e2 → final SHALLOW e2.
208Proof.
209 induction 1; intros; inv_step; decompose_Forall;
210 eauto using step, final, no_recs_insert; try done.
211 - by odestruct step_not_final.
212 - apply map_Forall_insert in H0 as [??]; simpl in *; last done.
213 by odestruct step_not_final.
214Qed.
215
216Lemma SAppL_rtc μ e1 e1' e2 :
217 e1 -{SHALLOW}->* e1' → EApp e1 e2 -{μ}->* EApp e1' e2.
218Proof. induction 1; econstructor; eauto with step. Qed.
219Lemma SAppR_rtc μ ms strict e1 e2 e2' :
220 e2 -{SHALLOW}->* e2' →
221 EApp (EAbsMatch ms strict e1) e2 -{μ}->* EApp (EAbsMatch ms strict e1) e2'.
222Proof. induction 1; econstructor; eauto with step. Qed.
223Lemma SSeq_rtc μ μ' e1 e1' e2 :
224 e1 -{μ'}->* e1' → ESeq μ' e1 e2 -{μ}->* ESeq μ' e1' e2.
225Proof. induction 1; econstructor; eauto with step. Qed.
226Lemma SList_rtc es1 e e' es2 :
227 Forall (final DEEP) es1 →
228 e -{DEEP}->* e' →
229 EList (es1 ++ e :: es2) -{DEEP}->* EList (es1 ++ e' :: es2).
230Proof. induction 2; econstructor; eauto with step. Qed.
231Lemma SLetAttr_rtc μ k e1 e1' e2 :
232 e1 -{SHALLOW}->* e1' → ELetAttr k e1 e2 -{μ}->* ELetAttr k e1' e2.
233Proof. induction 1; econstructor; eauto with step. Qed.
234Lemma SBinOpL_rtc μ op e1 e1' e2 :
235 e1 -{SHALLOW}->* e1' → EBinOp op e1 e2 -{μ}->* EBinOp op e1' e2.
236Proof. induction 1; econstructor; eauto with step. Qed.
237Lemma SBinOpR_rtc μ op e1 Φ e2 e2' :
238 final SHALLOW e1 → sem_bin_op op e1 Φ →
239 e2 -{SHALLOW}->* e2' → EBinOp op e1 e2 -{μ}->* EBinOp op e1 e2'.
240Proof. induction 3; econstructor; eauto with step. Qed.
241Lemma SIf_rtc μ e1 e1' e2 e3 :
242 e1 -{SHALLOW}->* e1' → EIf e1 e2 e3 -{μ}->* EIf e1' e2 e3.
243Proof. induction 1; econstructor; eauto with step. Qed.
244
245Lemma SApp_tc μ e1 e1' e2 :
246 e1 -{SHALLOW}->+ e1' → EApp e1 e2 -{μ}->+ EApp e1' e2.
247Proof. induction 1; by econstructor; eauto with step. Qed.
248Lemma SSeq_tc μ μ' e1 e1' e2 :
249 e1 -{μ'}->+ e1' → ESeq μ' e1 e2 -{μ}->+ ESeq μ' e1' e2.
250Proof. induction 1; by econstructor; eauto with step. Qed.
251Lemma SList_tc es1 e e' es2 :
252 Forall (final DEEP) es1 →
253 e -{DEEP}->+ e' →
254 EList (es1 ++ e :: es2) -{DEEP}->+ EList (es1 ++ e' :: es2).
255Proof. induction 2; by econstructor; eauto with step. Qed.
256Lemma SLetAttr_tc μ k e1 e1' e2 :
257 e1 -{SHALLOW}->+ e1' → ELetAttr k e1 e2 -{μ}->+ ELetAttr k e1' e2.
258Proof. induction 1; by econstructor; eauto with step. Qed.
259Lemma SBinOpL_tc μ op e1 e1' e2 :
260 e1 -{SHALLOW}->+ e1' → EBinOp op e1 e2 -{μ}->+ EBinOp op e1' e2.
261Proof. induction 1; by econstructor; eauto with step. Qed.
262Lemma SBinOpR_tc μ op e1 Φ e2 e2' :
263 final SHALLOW e1 → sem_bin_op op e1 Φ →
264 e2 -{SHALLOW}->+ e2' → EBinOp op e1 e2 -{μ}->+ EBinOp op e1 e2'.
265Proof. induction 3; by econstructor; eauto with step. Qed.
266Lemma SIf_tc μ e1 e1' e2 e3 :
267 e1 -{SHALLOW}->+ e1' → EIf e1 e2 e3 -{μ}->+ EIf e1' e2 e3.
268Proof. induction 1; by econstructor; eauto with step. Qed.
269
270Lemma SList_inv es1 e2 :
271 EList es1 -{DEEP}-> e2 ↔ ∃ ds1 ds2 e e',
272 es1 = ds1 ++ e :: ds2 ∧ e2 = EList (ds1 ++ e' :: ds2) ∧
273 Forall (final DEEP) ds1 ∧
274 e -{DEEP}-> e'.
275Proof. split; intros; inv_step; naive_solver eauto using SList. Qed.
276
277Lemma List_nf_cons_final es e :
278 final DEEP e →
279 nf (step DEEP) (EList es) →
280 nf (step DEEP) (EList (e :: es)).
281Proof.
282 intros Hfinal Hnf [e' (ds1 & ds2 & e1 & e2 & ? & -> & Hds1 & Hstep)%SList_inv].
283 destruct Hds1; simplify_eq/=.
284 - by apply step_not_final in Hstep.
285 - naive_solver eauto with step.
286Qed.
287Lemma List_nf_cons es e :
288 ¬final DEEP e →
289 nf (step DEEP) e →
290 nf (step DEEP) (EList (e :: es)).
291Proof.
292 intros Hfinal Hnf [e' (ds1 & ds2 & e1 & e2 & ? & -> & Hds1 & Hstep)%SList_inv].
293 destruct Hds1; naive_solver.
294Qed.
295
296Lemma List_steps_cons es1 es2 e :
297 final DEEP e →
298 EList es1 -{DEEP}->* EList es2 →
299 EList (e :: es1) -{DEEP}->* EList (e :: es2).
300Proof.
301 intros ? Hstep.
302 remember (EList es1) as e1 eqn:He1; remember (EList es2) as e2 eqn:He2.
303 revert es1 es2 He1 He2.
304 induction Hstep as [|e1 e2 e3 Hstep Hstep' IH];
305 intros es1 es3 ??; simplify_eq/=; [done|].
306 inv_step. eapply rtc_l; [apply (SList (_ :: _))|]; naive_solver.
307Qed.
308
309Lemma SAttr_rec_rtc μ αs :
310 EAttr αs -{μ}->*
311 EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs).
312Proof.
313 destruct (decide (no_recs αs)) as [Hαs|]; [|by eauto using rtc_once, step].
314 eapply reflexive_eq. f_equal. apply map_eq=> x. rewrite lookup_fmap.
315 destruct (αs !! x) as [[τ e]|] eqn:?; [|done].
316 assert (τ = NONREC) as -> by eauto using no_recs_lookup. done.
317Qed.
318
319Lemma SAttr_lookup_rtc αs x e e' :
320 no_recs αs →
321 αs !! x = None →
322 (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) →
323 e -{DEEP}->* e' →
324 EAttr (<[x:=AttrN e]> αs) -{DEEP}->* EAttr (<[x:=AttrN e']> αs).
325Proof.
326 intros Hrecs Hx Hfirst He. revert αs Hrecs Hx Hfirst.
327 induction He as [e|e1 e2 e3 He12 He23 IH]; intros eτs Hrec Hx Hfirst; [done|].
328 eapply rtc_l; first by eapply SAttr. apply IH; [done..|].
329 apply step_not_final in He12. naive_solver.
330Qed.
331
332Lemma SAttr_inv αs1 e2 :
333 no_recs αs1 →
334 EAttr αs1 -{DEEP}-> e2 ↔ ∃ αs x e e',
335 αs1 = <[x:=AttrN e]> αs ∧ e2 = EAttr (<[x:=AttrN e']> αs) ∧
336 αs !! x = None ∧
337 (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) ∧
338 e -{DEEP}-> e'.
339Proof.
340 split; [intros; inv_step|];
341 naive_solver eauto using SAttr, no_recs_insert_inv.
342Qed.
343
344Lemma Attr_nf_insert_final αs x e :
345 no_recs αs →
346 αs !! x = None →
347 final DEEP e →
348 (∀ y, is_Some (αs !! y) → attr_le x y) →
349 nf (step DEEP) (EAttr αs) →
350 nf (step DEEP) (EAttr (<[x:=AttrN e]> αs)).
351Proof.
352 intros Hrecs Hx Hfinal Hleast Hnf
353 [? (αs'&x'&e'&e''&Hαs&->&Hx'&?&Hstep)%SAttr_inv];
354 last by eauto using no_recs_insert.
355 assert (x ≠ x').
356 { intros ->. apply (f_equal (.!! x')) in Hαs. rewrite !lookup_insert in Hαs.
357 apply step_not_final in Hstep. naive_solver. }
358 destruct Hnf. exists (EAttr (<[x':=AttrN e'']> (delete x αs'))).
359 rewrite -(delete_insert αs x (AttrN e)) // Hαs delete_insert_ne //.
360 refine (SCtx _ _ _ _ _ (CAttr _ _ _ _ _) _);
361 [|by rewrite lookup_delete_ne| |done].
362 - apply (no_recs_insert _ x e) in Hrecs. rewrite Hαs in Hrecs.
363 apply no_recs_insert_inv in Hrecs; last done. by apply map_Forall_delete.
364 - intros ?? ?%lookup_delete_Some; naive_solver.
365Qed.
366Lemma Attr_nf_insert αs x e :
367 no_recs αs →
368 αs !! x = None →
369 ¬final DEEP e →
370 (∀ y, is_Some (αs !! y) → attr_le x y) →
371 nf (step DEEP) e →
372 nf (step DEEP) (EAttr (<[x:=AttrN e]> αs)).
373Proof.
374 intros Hrecs Hx ?? Hnf [? (αs'&x'&e'&e''&Hαs&->&Hx'&Hleast'&Hstep)%SAttr_inv];
375 last eauto using no_recs_insert.
376 assert (x ≠ x') as Hxx'.
377 { intros ->. apply (f_equal (.!! x')) in Hαs. rewrite !lookup_insert in Hαs.
378 naive_solver. }
379 odestruct (Hleast' x (AttrN e)); [|done|].
380 - apply (f_equal (.!! x)) in Hαs.
381 by rewrite lookup_insert lookup_insert_ne in Hαs.
382 - apply (f_equal (.!! x')) in Hαs.
383 rewrite lookup_insert lookup_insert_ne // in Hαs.
384 destruct Hxx'. apply (anti_symm attr_le); naive_solver.
385Qed.
386
387Lemma Attr_step_dom μ αs1 e2 :
388 EAttr αs1 -{μ}-> e2 →
389 ∃ αs2, e2 = EAttr αs2 ∧ ∀ i, αs1 !! i = None ↔ αs2 !! i = None.
390Proof.
391 intros; inv_step; (eexists; split; [done|]).
392 - intros i. by rewrite lookup_fmap fmap_None.
393 - intros i. rewrite !lookup_insert_None; naive_solver.
394Qed.
395Lemma Attr_steps_dom μ αs1 αs2 :
396 EAttr αs1 -{μ}->* EAttr αs2 → ∀ i, αs1 !! i = None ↔ αs2 !! i = None.
397Proof.
398 intros Hstep.
399 remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2.
400 revert αs1 αs2 He1 He2. induction Hstep as [|e1 e2 e3 Hstep Hstep' IH];
401 intros αs1 αs3 ??; simplify_eq/=; [done|].
402 apply Attr_step_dom in Hstep; naive_solver.
403Qed.
404
405Lemma Attr_step_recs αs1 αs2 :
406 EAttr αs1 -{DEEP}-> EAttr αs2 → no_recs αs1 → no_recs αs2.
407Proof. intros. inv_step; by eauto using no_recs_insert. Qed.
408Lemma Attr_steps_recs αs1 αs2 :
409 EAttr αs1 -{DEEP}->* EAttr αs2 → no_recs αs1 → no_recs αs2.
410Proof.
411 intros Hstep.
412 remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2.
413 revert αs1 αs2 He1 He2. induction Hstep as [|e1 e2 e3 Hstep Hstep' IH];
414 intros αs1 αs3 ???; simplify_eq/=; [done|].
415 pose proof (Attr_step_dom _ _ _ Hstep) as (es2 & -> & ?).
416 apply Attr_step_recs in Hstep; naive_solver.
417Qed.
418
419Lemma Attr_step_insert αs1 αs2 x e :
420 no_recs αs1 →
421 αs1 !! x = None →
422 final DEEP e →
423 EAttr αs1 -{DEEP}-> EAttr αs2 →
424 EAttr (<[x:=AttrN e]> αs1) -{DEEP}-> EAttr (<[x:=AttrN e]> αs2).
425Proof.
426 intros Hrecs Hx ?
427 (αs' & x' & e1 & e1' & ? & ? & ? & ? & ?)%SAttr_inv; [|done]; simplify_eq.
428 apply lookup_insert_None in Hx as [??]. rewrite !(insert_commute _ x) //.
429 eapply SAttr; [|by rewrite lookup_insert_ne| |done].
430 - by eapply no_recs_insert, no_recs_insert_inv.
431 - intros y e' ?%lookup_insert_Some; naive_solver.
432Qed.
433Lemma Attr_steps_insert αs1 αs2 x e :
434 no_recs αs1 →
435 αs1 !! x = None →
436 final DEEP e →
437 EAttr αs1 -{DEEP}->* EAttr αs2 →
438 EAttr (<[x:=AttrN e]> αs1) -{DEEP}->* EAttr (<[x:=AttrN e]> αs2).
439Proof.
440 intros Hrecs Hx ? Hstep.
441 remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2.
442 revert αs1 αs2 Hx Hrecs He1 He2.
443 induction Hstep as [|e1 e2 e3 Hstep Hstep' IH];
444 intros αs1 αs3 ????; simplify_eq/=; [done|].
445 pose proof (Attr_step_dom _ _ _ Hstep) as (αs2 & -> & Hdom).
446 eapply rtc_l; first by eapply Attr_step_insert.
447 eapply IH; naive_solver eauto using Attr_step_recs.
448Qed.
449
450Reserved Infix "=D=>" (right associativity, at level 55).
451
452Inductive step_delayed : relation expr :=
453 | RDrefl e :
454 e =D=> e
455 | RDId x e1 e2 :
456 e1 =D=> e2 →
457 EId x (Some (ABS, e1)) =D=> e2
458 | RDBinOp op e1 e1' e2 e2' :
459 e1 =D=> e1' → e2 =D=> e2' → EBinOp op e1 e2 =D=> EBinOp op e1' e2'
460 | RDIf e1 e1' e2 e2' e3 e3' :
461 e1 =D=> e1' → e2 =D=> e2' → e3 =D=> e3' → EIf e1 e2 e3 =D=> EIf e1' e2' e3'
462where "e1 =D=> e2" := (step_delayed e1 e2).
463
464Global Instance step_delayed_po : PreOrder step_delayed.
465Proof.
466 split; [constructor|].
467 intros e1 e2 e3 Hstep. revert e3.
468 induction Hstep; inv 1; eauto using step_delayed.
469Qed.
470Hint Extern 0 (_ =D=> _) => reflexivity : core.
471
472Lemma delayed_final_l e1 e2 :
473 final SHALLOW e1 →
474 e1 =D=> e2 →
475 e1 = e2.
476Proof. intros Hfinal. induction 1; try by inv Hfinal. Qed.
477
478Lemma delayed_final_r μ e1 e2 :
479 final μ e2 →
480 e1 =D=> e2 →
481 e1 -{μ}->* e2.
482Proof.
483 intros Hfinal. induction 1; try by inv Hfinal.
484 eapply rtc_l; [constructor|]. eauto.
485Qed.
486
487Lemma delayed_step_l μ e1 e1' e2 :
488 e1 =D=> e1' →
489 e1 -{μ}-> e2 →
490 ∃ e2', e1' -{μ}->* e2' ∧ e2 =D=> e2'.
491Proof.
492 intros Hrem. revert μ e2.
493 induction Hrem; intros μ ? Hstep.
494 - eauto using rtc_once.
495 - inv_step. by exists e2.
496 - inv_step.
497 + eapply delayed_final_l in Hrem1 as ->, Hrem2 as ->; [|by eauto..].
498 eexists; split; [|done]. eapply rtc_once. by econstructor.
499 + apply IHHrem1 in H2 as (e1'' & ? & ?).
500 eexists; split; [by eapply SBinOpL_rtc|]. by constructor.
501 + eapply delayed_final_l in Hrem1 as ->; [|by eauto..].
502 apply IHHrem2 in H2 as (e2'' & ? & ?).
503 eexists (EBinOp _ e1' e2''); split; [|by constructor].
504 by eapply SBinOpR_rtc.
505 - inv_step.
506 + eapply delayed_final_l in Hrem1 as <-; [|by repeat constructor].
507 eexists; split; [eapply rtc_once; constructor|]. by destruct b.
508 + apply IHHrem1 in H2 as (e1'' & ? & ?).
509 eexists; split; [by eapply SIf_rtc|]. by constructor.
510Qed.
511
512Lemma delayed_steps_l μ e1 e1' e2 :
513 e1 =D=> e1' →
514 e1 -{μ}->* e2 →
515 ∃ e2', e1' -{μ}->* e2' ∧ e2 =D=> e2'.
516Proof.
517 intros Hdel Hsteps. revert e1' Hdel.
518 induction Hsteps as [e|e1 e2 e3 Hstep Hsteps IH]; intros e1' Hdel.
519 { eexists; by split. }
520 eapply delayed_step_l in Hstep as (e2' & Hstep2 & Hdel2); [|done].
521 apply IH in Hdel2 as (e3' & ? & ?). eexists; by split; [etrans|].
522Qed.
523
524Lemma delayed_step_r μ e1 e1' e2 :
525 e1' =D=> e1 →
526 e1 -{μ}-> e2 →
527 ∃ e2', e1' -{μ}->+ e2' ∧ e2' =D=> e2.
528Proof.
529 intros Hrem. revert μ e2.
530 induction Hrem; intros μ ? Hstep.
531 - eauto using tc_once.
532 - apply IHHrem in Hstep as (e1' & ? & ?).
533 eexists. split; [|done]. eapply tc_l; [econstructor|done].
534 - inv_step.
535 + exists e0; split; [|done].
536 eapply tc_rtc_l; [by eapply SBinOpL_rtc, delayed_final_r, Hrem1|].
537 eapply tc_rtc_l; [by eapply SBinOpR_rtc, delayed_final_r, Hrem2|].
538 eapply tc_once. by econstructor.
539 + apply IHHrem1 in H2 as (e1'' & ? & ?).
540 eexists; split; [by eapply SBinOpL_tc|]. by constructor.
541 + apply IHHrem2 in H2 as (e2'' & ? & ?).
542 eexists (EBinOp _ e1' e2''); split; [|by apply RDBinOp].
543 eapply tc_rtc_l; [by eapply SBinOpL_rtc, delayed_final_r, Hrem1|].
544 by eapply SBinOpR_tc.
545 - inv_step.
546 + exists (if b then e2 else e3). split; [|by destruct b].
547 eapply tc_rtc_l;
548 [eapply SIf_rtc, delayed_final_r, Hrem1; by repeat constructor|].
549 eapply tc_once; constructor.
550 + apply IHHrem1 in H2 as (e1'' & ? & ?).
551 eexists; split; [by eapply SIf_tc|]. by constructor.
552Qed.
553
554Lemma delayed_steps_r μ e1 e1' e2 :
555 e1' =D=> e1 →
556 e1 -{μ}->* e2 →
557 ∃ e2', e1' -{μ}->* e2' ∧ e2' =D=> e2.
558Proof.
559 intros Hdel Hsteps. revert e1' Hdel.
560 induction Hsteps as [e|e1 e2 e3 Hstep Hsteps IH]; intros e1' Hdel.
561 { eexists; by split. }
562 eapply delayed_step_r in Hstep as (e2' & Hstep2%tc_rtc & Hdel2); [|done].
563 apply IH in Hdel2 as (e3' & ? & ?). eexists; by split; [etrans|].
564Qed.
565
566(** Determinism *)
567
568Lemma bin_op_det op e Φ Ψ :
569 sem_bin_op op e Φ →
570 sem_bin_op op e Ψ →
571 Φ = Ψ.
572Proof. by destruct 1; inv 1. Qed.
573
574Lemma bin_op_rel_det op e1 Φ e2 d1 d2 :
575 sem_bin_op op e1 Φ →
576 Φ e2 d1 →
577 Φ e2 d2 →
578 d1 = d2.
579Proof.
580 assert (AntiSymm eq attr_le) by apply _.
581 unfold AntiSymm in *. inv 1; repeat case_match; naive_solver.
582Qed.
583
584Lemma matches_present x e md es ms strict βs :
585 es !! x = Some e → ms !! x = Some md →
586 matches es ms strict βs →
587 βs !! x = Some (AttrN e).
588Proof.
589 intros Hes Hms. induction 1; try done.
590 - by apply lookup_insert_Some in Hes as [[]|[]]; simplify_map_eq.
591 - by simplify_map_eq.
592Qed.
593
594Lemma matches_default x es ms d strict βs :
595 es !! x = None →
596 ms !! x = Some (Some d) →
597 matches es ms strict βs →
598 βs !! x = Some (AttrR d).
599Proof.
600 intros Hes Hms. induction 1; try done.
601 - by apply lookup_insert_None in Hes as []; simplify_map_eq.
602 - by apply lookup_insert_Some in Hms as [[]|[]]; simplify_map_eq.
603Qed.
604
605Lemma matches_weaken x es ms strict βs :
606 matches es ms strict βs →
607 matches (delete x es) (delete x ms) strict (delete x βs).
608Proof.
609 induction 1; [constructor|constructor|..]; rename x0 into y;
610 (destruct (decide (x = y)) as [->|Hxy];
611 [ rewrite !delete_insert_delete //
612 | rewrite !delete_insert_ne //; constructor;
613 by simplify_map_eq ]).
614Qed.
615
616Lemma matches_det es ms strict βs1 βs2 :
617 matches es ms strict βs1 →
618 matches es ms strict βs2 →
619 βs1 = βs2.
620Proof.
621 intros Hβs1. revert βs2. induction Hβs1; intros βs2 Hβs2;
622 try (inv Hβs2; done || (by exfalso; eapply (insert_non_empty (M:=stringmap)))).
623 - eapply (matches_weaken x) in Hβs2 as Hβs2'.
624 rewrite !delete_insert // in Hβs2'.
625 rewrite (IHHβs1 _ Hβs2') insert_delete //.
626 eapply matches_present; eauto; apply lookup_insert.
627 - eapply (matches_weaken x) in Hβs2 as Hβs2'.
628 rewrite delete_notin // delete_insert // in Hβs2'.
629 rewrite (IHHβs1 _ Hβs2') insert_delete //.
630 eapply matches_default; eauto. apply lookup_insert.
631Qed.
632
633Lemma ctx_det K1 K2 e1 e2 μ μ1' μ2' :
634 K1 e1 = K2 e2 →
635 ctx1 μ1' μ K1 →
636 ctx1 μ2' μ K2 →
637 red (step μ1') e1 →
638 red (step μ2') e2 →
639 K1 = K2 ∧ e1 = e2 ∧ μ1' = μ2'.
640Proof.
641 intros Hes HK1 HK2 Hred1 Hred2.
642 induction HK1; inv HK2; try done.
643 - apply not_elem_of_app_cons_inv_l in Hes as [<- [<- <-]]; first done.
644 + intros He1. apply (proj1 (Forall_forall _ _) H0) in He1.
645 inv Hred1. by apply step_not_final in H1.
646 + intros He2. apply (proj1 (Forall_forall _ _) H) in He2.
647 inv Hred2. by apply step_not_final in H1.
648 - destruct (decide (x = x0)) as [<-|].
649 { by apply map_insert_inv_eq in Hes as [[= ->] [= ->]]. }
650 apply map_insert_inv_ne in Hes as (Hx0 & Hx & Hαs); try done.
651 apply H1 in Hx0 as [contra | Hxlex0].
652 + inv Hred2. by apply step_not_final in H5.
653 + apply H4 in Hx as [contra | Hx0lex].
654 * inv Hred1. by apply step_not_final in H5.
655 * assert (Hasym : AntiSymm eq attr_le) by apply _.
656 by pose proof (Hasym _ _ Hxlex0 Hx0lex).
657 - inv Hred1. inv_step.
658 - inv Hred2. inv_step.
659 - inv Hred1. by apply step_not_final in H1.
660 - inv Hred2. by apply step_not_final in H1.
661Qed.
662
663Lemma step_det μ e d1 d2 :
664 e -{μ}-> d1 →
665 e -{μ}-> d2 →
666 d1 = d2.
667Proof.
668 intros Hred1. revert d2.
669 induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step.
670 - by apply (matches_det _ _ _ _ _ H0) in H8 as <-.
671 - inv_step. by apply step_not_final in H3.
672 - inv_step. destruct H. by apply no_recs_insert.
673 - assert (Φ = Φ0) as <- by (by eapply bin_op_det).
674 by eapply bin_op_rel_det.
675 - inv_step; by apply step_not_final in H6.
676 - inv_step. by apply step_not_final in Hred1.
677 - inv_step. destruct H2. by apply no_recs_insert.
678 - inv_step; by apply step_not_final in Hred1.
679 - eapply ctx_det in H0 as (?&?&?); [|by eauto..]; naive_solver.
680Qed.
diff --git a/theories/nix/tests.v b/theories/nix/tests.v
new file mode 100644
index 0000000..cbce874
--- /dev/null
+++ b/theories/nix/tests.v
@@ -0,0 +1,185 @@
1From mininix Require Export nix.interp nix.notations.
2From stdpp Require Import options.
3Open Scope Z_scope.
4
5(** Compare base vals without comparing the proofs. Since we do not have
6definitional proof irrelevance, comparing the proofs would fail (and in practice
7make Coq loop). *)
8Definition res_eq (rv : res val) (bl2 : base_lit) :=
9 match rv with
10 | Res (Some (VLit bl1 _)) => bl1 = bl2
11 | _ => False
12 end.
13Infix "=?" := res_eq.
14
15Definition float_1 :=
16 ceil: (Float.of_Z 20 /: 3).
17Goal interp 100 ∅ float_1 =? 7.
18Proof. by vm_compute. Qed.
19
20Definition float_2 :=
21 Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *:
22 Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *:
23 Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *:
24 Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *:
25 Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000.
26Goal interp 100 ∅ float_2 =? NFloat (Binary.B754_infinity false).
27Proof. by vm_compute. Qed.
28
29Definition float_3 := float_2 /: float_2.
30Goal interp 100 ∅ float_3 =? NFloat (`Float.indef_nan).
31Proof. by vm_compute. Qed.
32
33Definition let_let :=
34 let: "x" := 1 in let: "x" := 2 in "x".
35Goal interp 100 ∅ let_let =? 2.
36Proof. by vm_compute. Qed.
37
38Definition with_let :=
39 with: EAttr {[ "x" := AttrN 1 ]} in let: "x" := 2 in "x".
40Goal interp 100 ∅ with_let =? 2.
41Proof. by vm_compute. Qed.
42
43Definition let_with :=
44 let: "x" := 1 in with: EAttr {[ "x" := AttrN 2 ]} in "x".
45Goal interp 100 ∅ let_with =? 1.
46Proof. by vm_compute. Qed.
47
48Definition with_with :=
49 with: EAttr {[ "x" := AttrN 1 ]} in with: EAttr {[ "x" := AttrN 2 ]} in "x".
50Goal interp 100 ∅ with_with =? 2.
51Proof. by vm_compute. Qed.
52
53Definition with_with_inherit :=
54 with: EAttr {[ "x" := AttrN 1 ]} in with: EAttr {[ "x" := AttrN "x" ]} in "x".
55Goal interp 100 ∅ with_with_inherit =? 1.
56Proof. by vm_compute. Qed.
57
58Definition with_loop :=
59 with: EAttr {[ "x" := AttrR "x" ]} in "x".
60Goal interp 100 ∅ with_loop = NoFuel.
61Proof. by vm_compute. Qed.
62
63Definition rec_attr_shadow_1 :=
64 let: "foo" := EAttr {[ "bar" := AttrN 10 ]} in
65 EAttr {[
66 "bar" := AttrR ("foo" .: "bar");
67 "foo" := AttrR (EAttr {[ "bar" := AttrN 20 ]})
68 ]} .: "bar".
69Goal interp 100 ∅ rec_attr_shadow_1 =? 20.
70Proof. by vm_compute. Qed.
71
72Definition rec_attr_shadow_2 :=
73 EAttr {[
74 "y" := AttrR (EAttr {[ "y" := AttrN "z" ]} .: "y");
75 "z" := AttrR 20
76 ]} .: "y".
77Goal interp 100 ∅ rec_attr_shadow_2 =? 20.
78Proof. by vm_compute. Qed.
79
80Definition nested_functor_1 :=
81 EAttr {[ "__functor" := AttrN $ λ: "self",
82 EAttr {[ "__functor" := AttrN $ λ: "self" "x", 10 ]} ]} 10.
83Goal interp 100 ∅ nested_functor_1 =? 10.
84Proof. by vm_compute. Qed.
85
86Definition nested_functor_2 :=
87 EAttr {[ "__functor" := AttrN $
88 EAttr {[ "__functor" := AttrN $ λ: "self" "self" "x", 10 ]} ]} 10.
89Goal interp 100 ∅ nested_functor_2 =? 10.
90Proof. by vm_compute. Qed.
91
92Definition functor_loop_1 :=
93 EAttr {[ "__functor" := AttrN $
94 λ: "self", "self" "self"
95 ]} 10.
96Goal interp 1000 ∅ functor_loop_1 = NoFuel.
97Proof. by vm_compute. Qed.
98
99Definition functor_loop_2 :=
100 EAttr {[ "__functor" := AttrN $
101 λ: "self" "f", "f" ("self" "f")
102 ]} (λ: "go" "x", "go" "x") 10.
103Goal interp 1000 ∅ functor_loop_2 = NoFuel.
104Proof. by vm_compute. Qed.
105
106Fixpoint many_lets (i : nat) (e : expr) : expr :=
107 match i with
108 | O => e
109 | S i => let: "x" +:+ pretty i := 0 in many_lets i e
110 end.
111
112Fixpoint many_adds (i : nat) : expr :=
113 match i with
114 | O => 0
115 | S i => ("x" +:+ pretty i) +: many_adds i
116 end.
117
118Definition big_prog (i : nat) : expr := many_lets i $ many_adds i.
119
120Definition big := big_prog 1000.
121
122Goal interp 5000 ∅ big =? 0.
123Proof. by vm_compute. Qed.
124
125Definition matching_1 :=
126 (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y")
127 (EAttr {[ "x" := AttrN 10; "y" := AttrN 11 ]}).
128Goal interp 1000 ∅ matching_1 =? 21.
129Proof. by vm_compute. Qed.
130
131Definition matching_2 :=
132 (λattr: {[ "x" := None; "y" := Some (EId' "x") ]}, "x" +: "y")
133 (EAttr {[ "x" := AttrN 10 ]}).
134Goal interp 1000 ∅ matching_2 =? 20.
135Proof. by vm_compute. Qed.
136
137Definition matching_3 :=
138 (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y")
139 (EAttr {[ "x" := AttrN 10 ]}).
140Goal interp 1000 ∅ matching_3 = mfail.
141Proof. by vm_compute. Qed.
142
143Definition matching_4 :=
144 (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y")
145 (EAttr {[ "x" := AttrN 10; "y" := AttrN 11; "z" := AttrN 12 ]}).
146Goal interp 1000 ∅ matching_4 = mfail.
147Proof. by vm_compute. Qed.
148
149Definition matching_5 :=
150 (λattr: {[ "x" := None; "y" := None ]} .., "x" +: "y")
151 (EAttr {[ "x" := AttrN 10; "y" := AttrN 11; "z" := AttrN 12 ]}).
152Goal interp 1000 ∅ matching_5 =? 21.
153Proof. by vm_compute. Qed.
154
155Definition matching_6 :=
156 (λattr: {[ "y" := Some (EId' "y") ]}, "y")
157 (EAttr {[ "y" := AttrN 10 ]}).
158Goal interp 1000 ∅ matching_6 =? 10.
159Proof. by vm_compute. Qed.
160
161Definition matching_7 :=
162 (λattr: {[ "y" := Some (EId' "y") ]}, "y") (EAttr ∅).
163Goal interp 1000 ∅ matching_7 = NoFuel.
164Proof. by vm_compute. Qed.
165
166Definition matching_8 :=
167 (λattr: {[ "y" := Some (EId' "y") ]}.., "y")
168 (EAttr {[ "x" := AttrN 10 ]}).
169Goal interp 1000 ∅ matching_8 = NoFuel.
170Proof. by vm_compute. Qed.
171
172Definition list_lt_1 :=
173 EList [ELit 2; ELit 3] <: EList [ELit 3].
174Goal interp 1000 ∅ list_lt_1 =? true.
175Proof. by vm_compute. Qed.
176
177Definition list_lt_2 :=
178 EList [ELit 2; ELit 3] <: EList [ELit 2].
179Goal interp 1000 ∅ list_lt_2 =? false.
180Proof. by vm_compute. Qed.
181
182Definition list_lt_3 :=
183 EList [ELit 2] <: EList [ELit 2; ELit 3].
184Goal interp 1000 ∅ list_lt_3 =? true.
185Proof. by vm_compute. Qed.
diff --git a/theories/nix/wp.v b/theories/nix/wp.v
new file mode 100644
index 0000000..0eca6e1
--- /dev/null
+++ b/theories/nix/wp.v
@@ -0,0 +1,143 @@
1From mininix Require Export nix.operational_props.
2From stdpp Require Import options.
3
4Definition wp (μ : mode) (e : expr) (Φ : expr → Prop) : Prop :=
5 ∃ e', e -{μ}->* e' ∧ final μ e' ∧ Φ e'.
6
7Lemma Lit_wp μ Φ bl :
8 base_lit_ok bl →
9 Φ (ELit bl) →
10 wp μ (ELit bl) Φ.
11Proof. exists (ELit bl). by repeat constructor. Qed.
12
13Lemma Abs_wp μ Φ x e :
14 Φ (EAbs x e) →
15 wp μ (EAbs x e) Φ.
16Proof. exists (EAbs x e). by repeat constructor. Qed.
17
18Lemma AbsMatch_wp μ Φ ms strict e :
19 Φ (EAbsMatch ms strict e) →
20 wp μ (EAbsMatch ms strict e) Φ.
21Proof. exists (EAbsMatch ms strict e). by repeat constructor. Qed.
22
23Lemma LetAttr_no_recs_wp μ Φ k αs e :
24 no_recs αs →
25 wp μ (subst ((k,.) ∘ attr_expr <$> αs) e) Φ →
26 wp μ (ELetAttr k (EAttr αs) e) Φ.
27Proof.
28 intros Hαs (e' & Hsteps & ? & HΦ). exists e'. split; [|done].
29 etrans; [|apply Hsteps]. apply rtc_once. by constructor.
30Qed.
31
32Lemma BinOp_wp μ Φ op e1 e2 :
33 wp SHALLOW e1 (λ e1', ∃ Φop,
34 sem_bin_op op e1' Φop ∧
35 wp SHALLOW e2 (λ e2', ∃ e', Φop e2' e' ∧ wp μ e' Φ)) →
36 wp μ (EBinOp op e1 e2) Φ.
37Proof.
38 intros (e1' & Hsteps1 & ? & Φop & Hop1 & e2' & Hsteps2 & ?
39 & e' & Hop2 & e'' & Hsteps & ? & HΦ).
40 exists e''. split; [|done].
41 etrans; [by apply SBinOpL_rtc|].
42 etrans; [by eapply SBinOpR_rtc|].
43 eapply rtc_l; [by econstructor|]. done.
44Qed.
45
46Lemma Id_wp μ Φ x k e :
47 wp μ e Φ →
48 wp μ (EId x (Some (k,e))) Φ.
49Proof.
50 intros (e' & Hsteps & ? & HΦ). exists e'. split; [|done].
51 etrans; [|apply Hsteps]. apply rtc_once. constructor.
52Qed.
53
54Lemma App_wp μ Φ e1 e2 :
55 wp SHALLOW e1 (λ e1', wp μ (EApp e1' e2) Φ) ↔
56 wp μ (EApp e1 e2) Φ.
57Proof.
58 split.
59 - intros (e1' & Hsteps1 & ? & e' & Hsteps2 & ? & HΦ).
60 exists e'; split; [|done]. etrans; [|apply Hsteps2].
61 by apply SAppL_rtc.
62 - intros (e' & Hsteps & Hfinal & HΦ).
63 cut (∃ e1', e1 -{SHALLOW}->* e1' ∧ final SHALLOW e1' ∧ EApp e1' e2 -{μ}->* e').
64 { intros (e1'&?&?&?). exists e1'. split_and!; [done..|]. by exists e'. }
65 clear Φ HΦ. apply rtc_nsteps in Hsteps as [n Hsteps].
66 revert e1 Hsteps. induction n as [|n IH]; intros e1 Hsteps.
67 { inv Hsteps. inv Hfinal. }
68 inv Hsteps. inv H0.
69 + eexists; split_and!; [done|by constructor|].
70 eapply rtc_l; [by constructor|by eapply rtc_nsteps_2].
71 + eexists; split_and!; [done|by constructor|].
72 eapply rtc_l; [by constructor|by eapply rtc_nsteps_2].
73 + eexists; split_and!; [done|by constructor|].
74 eapply rtc_l; [by constructor|by eapply rtc_nsteps_2].
75 + inv H2.
76 * apply IH in H1 as (e'' & Hsteps & ? & ?).
77 exists e''; split; [|done]. by eapply rtc_l.
78 * eexists; split_and!; [done|by constructor|].
79 eapply rtc_l; [by eapply SAppR|]. by eapply rtc_nsteps_2.
80Qed.
81
82Lemma Attr_wp_shallow Φ αs :
83 Φ (EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs)) →
84 wp SHALLOW (EAttr αs) Φ.
85Proof.
86 eexists (EAttr (AttrN ∘ _ <$> αs)); split_and!; [ |by constructor|done].
87 destruct (decide (no_recs αs)); [|apply rtc_once; by constructor].
88 apply reflexive_eq; f_equal. apply map_eq=> x. rewrite lookup_fmap.
89 destruct (αs !! x) as [[? e]|] eqn:?; f_equal/=.
90 by assert (τ = NONREC) as -> by eauto using no_recs_lookup.
91Qed.
92
93Lemma β_wp μ Φ x e1 e2 :
94 wp μ (subst {[x:=(ABS, e2)]} e1) Φ →
95 wp μ (EApp (EAbs x e1) e2) Φ.
96Proof.
97 intros (e' & Hsteps & ? & ?). exists e'. split; [|done].
98 eapply rtc_l; [|done]. by constructor.
99Qed.
100
101Lemma βMatch_wp μ Φ ms strict e1 αs βs :
102 no_recs αs →
103 matches (attr_expr <$> αs) ms strict βs →
104 wp μ (subst (indirects βs) e1) Φ →
105 wp μ (EApp (EAbsMatch ms strict e1) (EAttr αs)) Φ.
106Proof.
107 intros ?? (e' & Hsteps & ? & ?). exists e'. split; [|done].
108 eapply rtc_l; [|done]. by constructor.
109Qed.
110
111Lemma Functor_wp μ Φ αs e1 e2 :
112 no_recs αs →
113 αs !! "__functor" = Some (AttrN e1) →
114 wp μ (EApp (EApp e1 (EAttr αs)) e2) Φ →
115 wp μ (EApp (EAttr αs) e2) Φ.
116Proof.
117 intros ?? (e' & Hsteps & ? & ?). exists e'. split; [|done].
118 eapply rtc_l; [|done]. by constructor.
119Qed.
120
121Lemma If_wp μ Φ e1 e2 e3 :
122 wp SHALLOW e1 (λ e1', ∃ b : bool,
123 e1' = ELit (LitBool b) ∧ wp μ (if b then e2 else e3) Φ) →
124 wp μ (EIf e1 e2 e3) Φ.
125Proof.
126 intros (e1' & Hsteps & ? & b & -> & e' & Hsteps' & ? & HΦ).
127 exists e'; split; [|done]. etrans; [by apply SIf_rtc|].
128 eapply rtc_l; [|done]. destruct b; constructor.
129Qed.
130
131Lemma wp_mono μ e Φ Ψ :
132 wp μ e Φ →
133 (∀ e', Φ e' → Ψ e') →
134 wp μ e Ψ.
135Proof. intros (e' & ? & ? & ?) ?. exists e'. naive_solver. Qed.
136
137Lemma union_kinded_abs {A} mkv (v2 : A) :
138 union_kinded (pair WITH <$> mkv) (Some (ABS, v2)) = Some (ABS, v2).
139Proof. by destruct mkv. Qed.
140
141Lemma union_kinded_with {A} (v : A) mkv2 :
142 union_kinded (Some (WITH, v)) (pair WITH <$> mkv2) = Some (WITH, v).
143Proof. by destruct mkv2. Qed.
diff --git a/theories/nix/wp_examples.v b/theories/nix/wp_examples.v
new file mode 100644
index 0000000..7bc2109
--- /dev/null
+++ b/theories/nix/wp_examples.v
@@ -0,0 +1,164 @@
1From mininix Require Import nix.wp nix.notations.
2From stdpp Require Import options.
3Local Open Scope Z_scope.
4
5Definition test αs :=
6 let: "x" := 1 in
7 with: EAttr αs in
8 with: EAttr {[ "y" := AttrN 2 ]} in
9 "x" =: "y".
10
11Example test_wp μ αs :
12 no_recs αs →
13 wp μ (test αs) (.= false).
14Proof.
15 intros Hαs. rewrite /test. apply LetAttr_no_recs_wp.
16 { by apply no_recs_insert. }
17 rewrite /= !map_fmap_singleton /= right_id_L lookup_singleton lookup_singleton_ne //=.
18 apply LetAttr_no_recs_wp.
19 { by apply no_recs_attr_subst. }
20 rewrite /= !map_fmap_singleton /= right_id_L.
21 rewrite (map_fmap_compose attr_expr) lookup_fmap union_kinded_abs.
22 rewrite !lookup_fmap.
23 apply LetAttr_no_recs_wp.
24 { by apply no_recs_insert. }
25 rewrite /= map_fmap_singleton lookup_singleton lookup_singleton_ne //=.
26 rewrite union_kinded_with.
27 apply BinOp_wp.
28 apply Id_wp, Lit_wp; first done. eexists; split; [constructor|].
29 apply Id_wp, Lit_wp; first done.
30 eexists; split; [done|]. by apply Lit_wp.
31Qed.
32
33Definition neg := λ: "b", if: "b" then false else true.
34
35Lemma neg_wp μ (Φ : expr → Prop) e :
36 wp SHALLOW e (λ e', ∃ b : bool, e' = b ∧ Φ (negb b)) →
37 wp μ (neg e) Φ.
38Proof.
39 intros Hwp. apply β_wp. rewrite /= lookup_singleton /=.
40 apply If_wp, Id_wp. eapply wp_mono; [done|].
41 intros ? (b & -> & ?). exists b; split; [done|].
42 destruct b; by apply Lit_wp.
43Qed.
44
45(* rec { f = x: if x = 0 then true else !(f (x - 1)); }.f n *)
46Definition even_rec_attr :=
47 EAttr {[ "f" := AttrR (λ: "x", if: "x" =: 0 then true else neg ("f" ("x" -: 1))) ]} .: "f".
48
49Lemma even_rec_attr_wp e n :
50 0 ≤ n ≤ int_max →
51 wp SHALLOW e (.= n) →
52 wp SHALLOW (even_rec_attr e) (.= Z.even n).
53Proof.
54 intros Hn Hwp. apply App_wp.
55 revert e Hwp. induction (Z.lt_wf 0 n) as [n _ IH]; intros e Hwp.
56 apply BinOp_wp. apply Attr_wp_shallow.
57 eexists; split; [by constructor|].
58 apply Lit_wp; [done|]. eexists; split; [by eexists|].
59 rewrite /=. apply Abs_wp, β_wp.
60 rewrite /= !lookup_singleton /= !lookup_singleton_ne //=.
61 rewrite !union_with_None_l !union_with_None_r.
62 rewrite /indirects map_imap_insert map_imap_empty lookup_insert.
63 rewrite -/even_rec_attr -/neg.
64 apply If_wp, BinOp_wp, Id_wp.
65 eapply wp_mono; [apply Hwp|]; intros ? ->.
66 eexists; split; [by constructor|].
67 apply Lit_wp; [done|]. eexists; split; [by eexists|]. simpl.
68 destruct (n =? 0) eqn:Hn0; (apply Lit_wp; [done|]; eexists; split; [done|]; simpl).
69 { apply Lit_wp; [done|]. by apply Z.eqb_eq in Hn0 as ->. }
70 apply neg_wp, App_wp, Id_wp.
71 eapply wp_mono; [apply (IH (n-1))|]; [lia..| |].
72 2:{ intros e' He'. eapply wp_mono; [apply He'|].
73 intros ? ->. eexists; split; [done|].
74 by rewrite Z.negb_even Z.sub_1_r Z.odd_pred. }
75 eapply BinOp_wp, Id_wp. eapply wp_mono; [apply Hwp|]. intros ? ->.
76 eexists; split; [by constructor|]. apply Lit_wp; [done|].
77 eexists; split; [eexists _, _; split_and!; [done| |done]|].
78 - rewrite /= option_guard_True //. apply bool_decide_pack.
79 rewrite /int_min Z.shiftl_mul_pow2 //. lia.
80 - apply Lit_wp; [|done]. apply bool_decide_pack.
81 rewrite /int_min Z.shiftl_mul_pow2 //. lia.
82Qed.
83
84Lemma even_rec_attr_wp' n :
85 0 ≤ n ≤ int_max →
86 wp SHALLOW (even_rec_attr n) (.= Z.even n).
87Proof.
88 intros ?. apply even_rec_attr_wp; [done|]. apply Lit_wp; [|done].
89 rewrite /= /int_ok. apply bool_decide_pack.
90 rewrite /int_min Z.shiftl_mul_pow2 //. lia.
91Qed.
92
93(* { "__functor " = r: x: if x == 0 then true else !(r (x - 1)); } n *)
94Definition even_rec_functor :=
95 EAttr {[ "__functor" :=
96 AttrN (λ: "r" "x", if: "x" =: 0 then true else neg ("r" ("x" -: 1))) ]}.
97
98Lemma even_rec_functor_wp e n :
99 0 ≤ n ≤ int_max →
100 wp SHALLOW e (.= n) →
101 wp SHALLOW (even_rec_functor e) (.= Z.even n).
102Proof.
103 intros Hn Hwp. apply App_wp.
104 revert e Hwp. induction (Z.lt_wf 0 n) as [n _ IH]; intros e Hwp.
105 apply Attr_wp_shallow. rewrite map_fmap_singleton /=. eapply Functor_wp.
106 { by apply no_recs_insert. }
107 { done. }
108 apply App_wp. apply β_wp.
109 rewrite /= !lookup_singleton !lookup_singleton_ne //=. apply Abs_wp, β_wp.
110 rewrite /= !lookup_singleton /= !lookup_singleton_ne //=.
111 rewrite -/even_rec_functor -/neg.
112 apply If_wp, BinOp_wp, Id_wp.
113 eapply wp_mono; [apply Hwp|]; intros ? ->.
114 eexists; split; [by constructor|].
115 apply Lit_wp; [done|]. eexists; split; [by eexists|]. simpl.
116 destruct (n =? 0) eqn:Hn0; (apply Lit_wp; [done|]; eexists; split; [done|]; simpl).
117 { apply Lit_wp; [done|]. by apply Z.eqb_eq in Hn0 as ->. }
118 apply neg_wp, App_wp, Id_wp.
119 eapply wp_mono; [apply (IH (n-1))|]; [lia..| |].
120 2:{ intros e' He'. eapply wp_mono; [apply He'|].
121 intros ? ->. eexists; split; [done|].
122 by rewrite Z.negb_even Z.sub_1_r Z.odd_pred. }
123 eapply BinOp_wp, Id_wp. eapply wp_mono; [apply Hwp|]. intros ? ->.
124 eexists; split; [by constructor|]. apply Lit_wp; [done|].
125 eexists; split; [eexists _, _; split_and!; [done| |done]|].
126 - rewrite /= option_guard_True //. apply bool_decide_pack.
127 rewrite /int_min Z.shiftl_mul_pow2 //. lia.
128 - apply Lit_wp; [|done]. apply bool_decide_pack.
129 rewrite /int_min Z.shiftl_mul_pow2 //. lia.
130Qed.
131
132Lemma even_rec_functor_wp' n :
133 0 ≤ n ≤ int_max →
134 wp SHALLOW (even_rec_functor n) (.= Z.even n).
135Proof.
136 intros ?. apply even_rec_functor_wp; [done|]. apply Lit_wp; [|done].
137 rewrite /= /int_ok. apply bool_decide_pack.
138 rewrite /int_min Z.shiftl_mul_pow2 //. lia.
139Qed.
140
141(* ({ f ? (x: if x == 0 then true else !(f (x - 1))) }: f) {} n *)
142Definition even_rec_default :=
143 (λattr:
144 {[ "f" := Some (λ: "x", if: "x" =: 0 then true else neg ("f" ("x" -: 1))) ]}, "f")
145 (EAttr ∅).
146
147Lemma even_rec_default_wp e n :
148 0 ≤ n ≤ int_max →
149 wp SHALLOW e (.= n) →
150 wp SHALLOW (even_rec_default e) (.= Z.even n).
151Proof.
152 intros Hn Hwp. apply App_wp.
153 eapply βMatch_wp; [done|repeat econstructor|]. simplify_map_eq.
154 rewrite -/even_rec_attr. by apply Id_wp, App_wp, even_rec_attr_wp.
155Qed.
156
157Lemma even_rec_default_wp' n :
158 0 ≤ n ≤ int_max →
159 wp SHALLOW (even_rec_default n) (.= Z.even n).
160Proof.
161 intros ?. apply even_rec_default_wp; [done|]. apply Lit_wp; [|done].
162 rewrite /= /int_ok. apply bool_decide_pack.
163 rewrite /int_min Z.shiftl_mul_pow2 //. lia.
164Qed.
diff --git a/theories/res.v b/theories/res.v
new file mode 100644
index 0000000..d13bfee
--- /dev/null
+++ b/theories/res.v
@@ -0,0 +1,75 @@
1From mininix Require Export utils.
2From stdpp Require Import options.
3
4Variant res A :=
5 | Res (x : option A)
6 | NoFuel.
7Arguments Res {_} _.
8Arguments NoFuel {_}.
9
10Instance res_fail : MFail res := λ {A} _, Res None.
11
12Instance res_mret : MRet res := λ {A} x, Res (Some x).
13
14Instance res_mbind : MBind res := λ {A B} f rx,
15 match rx with
16 | Res mx => default mfail (f <$> mx)
17 | NoFuel => NoFuel
18 end.
19
20Instance res_fmap : FMap res := λ {A B} f rx,
21 match rx with
22 | Res mx => Res (f <$> mx)
23 | NoFuel => NoFuel
24 end.
25
26Instance Res_inj A : Inj (=) (=) (@Res A).
27Proof. by injection 1. Qed.
28
29Ltac simplify_res :=
30 repeat match goal with
31 | H : Res _ = mfail |- _ => apply (inj Res) in H
32 | H : mfail = Res _ |- _ => apply (inj Res) in H
33 | H : Res _ = mret _ |- _ => apply (inj Res) in H
34 | H : mret _ = Res _ |- _ => apply (inj Res) in H
35 | _ => progress simplify_eq/=
36 end.
37
38Lemma mapM_Res_impl {A B} (f g : A → res B) (xs : list A) ys :
39 mapM f xs = Res ys →
40 (∀ x y, f x = Res y → g x = Res y) →
41 mapM g xs = Res ys.
42Proof.
43 intros Hxs Hf. revert ys Hxs.
44 induction xs as [|x xs IH]; intros ys ?; simplify_res; [done|].
45 destruct (f x) as [my|] eqn:?; simplify_res. rewrite (Hf x my) //=.
46 destruct my as [y|]; simplify_res; [|done].
47 destruct (mapM f _) as [mys|]; simplify_res; [|done..].
48 by rewrite (IH _ eq_refl).
49Qed.
50
51Lemma map_mapM_sorted_Res_impl `{FinMap K M}
52 (R : relation K) `{!RelDecision R, !PartialOrder R, !Total R}
53 {A B} (f g : A → res B) (m1 : M A) m2 :
54 map_mapM_sorted R f m1 = Res m2 →
55 (∀ x y, f x = Res y → g x = Res y) →
56 map_mapM_sorted R g m1 = Res m2.
57Proof.
58 intros Hm Hf. revert m2 Hm.
59 induction m1 as [|i x m1 ?? IH] using (map_sorted_ind R); intros m2.
60 { by rewrite !map_mapM_sorted_empty. }
61 rewrite !map_mapM_sorted_insert //. intros.
62 destruct (f x) as [my|] eqn:?; simplify_res. rewrite (Hf x my) //=.
63 destruct my as [y|]; simplify_res; [|done].
64 destruct (map_mapM_sorted _ f _) as [mm2'|]; simplify_res; [|done..].
65 by rewrite (IH _ eq_refl).
66Qed.
67
68Lemma mapM_res_app {A B} (f : A → res B) xs1 xs2 :
69 mapM f (xs1 ++ xs2) = ys1 ← mapM f xs1; ys2 ← mapM f xs2; mret (ys1 ++ ys2).
70Proof.
71 induction xs1 as [|x1 xs1 IH]; simpl.
72 { by destruct (mapM f xs2) as [[]|]. }
73 destruct (f x1) as [[y1|]|]; simpl; [|done..].
74 rewrite IH. by destruct (mapM f xs1) as [[]|], (mapM f xs2) as [[]|].
75Qed.
diff --git a/theories/utils.v b/theories/utils.v
new file mode 100644
index 0000000..0cb1b33
--- /dev/null
+++ b/theories/utils.v
@@ -0,0 +1,275 @@
1(* Stuff that should be upstreamed to std++ *)
2From stdpp Require Export gmap stringmap ssreflect.
3From stdpp Require Import sorting.
4From stdpp Require Import options.
5Set Default Proof Using "Type*".
6
7(* Succeeds if [t] is syntactically a constructor applied to some arguments.
8Note that Coq's [is_constructor] succeeds on [S], but fails on [S n]. *)
9Ltac is_app_constructor t :=
10 lazymatch t with
11 | ?t _ => is_app_constructor t
12 | _ => is_constructor t
13 end.
14
15Lemma xorb_True b1 b2 : xorb b1 b2 ↔ ¬(b1 ↔ b2).
16Proof. destruct b1, b2; naive_solver. Qed.
17
18Definition option_to_eq_Some {A} (mx : option A) : option { x | mx = Some x } :=
19 match mx with
20 | Some x => Some (x ↾ eq_refl)
21 | None => None
22 end.
23
24(* Premise can probably be weakened to something with [ProofIrrel]. *)
25Lemma option_to_eq_Some_Some `{!EqDecision A} (mx : option A) x (H : mx = Some x) :
26 option_to_eq_Some mx = Some (x ↾ H).
27Proof.
28 destruct mx as [x'|]; simplify_eq/=; f_equal/=.
29 assert (x' = x) as Hx by congruence. destruct Hx.
30 f_equal. apply (proof_irrel _).
31Qed.
32
33Definition from_sum {A B C} (f : A → C) (g : B → C) (xy : A + B) : C :=
34 match xy with inl x => f x | inr y => g y end.
35
36Global Instance maybe_String : Maybe2 String := λ s,
37 if s is String a s then Some (a,s) else None.
38
39Global Instance String_inj a : Inj (=) (=) (String a).
40Proof. by injection 1. Qed.
41
42Global Instance full_relation_dec {A} : RelDecision (λ _ _ : A, True).
43Proof. unfold RelDecision. apply _. Defined.
44
45Global Instance prod_relation_dec `{RA : relation A, RB : relation B} :
46 RelDecision RA → RelDecision RB → RelDecision (prod_relation RA RB).
47Proof. unfold RelDecision. apply _. Defined.
48
49Global Hint Extern 0 (from_option _ _ _) => progress simpl : core.
50
51Definition map_sum_with `{MapFold K A M} (f : A → nat) : M → nat :=
52 map_fold (λ _, plus ∘ f) 0.
53Lemma map_sum_with_lookup_le `{FinMap K M} {A} (f : A → nat) (m : M A) i x :
54 m !! i = Some x → f x ≤ map_sum_with f m.
55Proof.
56 intros. rewrite /map_sum_with (map_fold_delete_L _ _ i x m) /=; auto with lia.
57Qed.
58
59Lemma map_Forall2_dom `{FinMapDom K M C} {A B} (P : K → A → B → Prop)
60 (m1 : M A) (m2 : M B) :
61 map_Forall2 P m1 m2 → dom m1 ≡ dom m2.
62Proof.
63 revert m2. induction m1 as [|i x1 m1 ? IH] using map_ind; intros m2.
64 { intros ->%map_Forall2_empty_inv_l. by rewrite !dom_empty. }
65 intros (x2 & m2' & -> & ? & ? & ?)%map_Forall2_insert_inv_l; last done.
66 rewrite !dom_insert IH //.
67Qed.
68Lemma map_Forall2_dom_L `{FinMapDom K M C, !LeibnizEquiv C} {A B}
69 (P : K → A → B → Prop) (m1 : M A) (m2 : M B) :
70 map_Forall2 P m1 m2 → dom m1 = dom m2.
71Proof. unfold_leibniz. apply map_Forall2_dom. Qed.
72
73Definition map_mapM
74 `{!∀ A, MapFold K A (M A), !∀ A, Empty (M A), !∀ A, Insert K A (M A)}
75 `{MBind F, MRet F} {A B} (f : A → F B) (m : M A) : F (M B) :=
76 map_fold (λ i x mm, y ← f x; m ← mm; mret $ <[i:=y]> m) (mret ∅) m.
77
78Section fin_map.
79 Context `{FinMap K M}.
80
81 Lemma map_insert_inv_eq {A} {m1 m2 : M A} x v u :
82 m1 !! x = None →
83 m2 !! x = None →
84 <[x:=v]> m1 = <[x:=u]> m2 →
85 v = u ∧ m1 = m2.
86 Proof.
87 intros Hm1 Hm2 Heq. split.
88 - assert (Huv : <[x:=v]> m1 !! x = Some v). { apply lookup_insert. }
89 rewrite Heq lookup_insert in Huv. by injection Huv as ->.
90 - apply map_eq. intros i.
91 replace m1 with (delete x (<[x:=v]> m1)) by (apply delete_insert; done).
92 replace m2 with (delete x (<[x:=u]> m2)) by (apply delete_insert; done).
93 by rewrite Heq.
94 Qed.
95
96 Lemma map_insert_inv_ne {A} {m1 m2 : M A} x1 x2 v1 v2 :
97 x1 ≠ x2 →
98 m1 !! x1 = None →
99 m2 !! x2 = None →
100 <[x1:=v1]> m1 = <[x2:=v2]> m2 →
101 m1 !! x2 = Some v2 ∧ m2 !! x1 = Some v1 ∧ delete x2 m1 = delete x1 m2.
102 Proof.
103 intros Hx1x2 Hm1 Hm2 Hm1m2. rewrite map_eq_iff in Hm1m2. split_and!.
104 - rewrite -(lookup_insert_ne _ x1 _ v1) // Hm1m2 lookup_insert //.
105 - rewrite -(lookup_insert_ne _ x2 _ v2) // -Hm1m2 lookup_insert //.
106 - apply map_eq. intros y. destruct (decide (y = x1)) as [->|];
107 first rewrite lookup_delete_ne // lookup_delete //.
108 destruct (decide (y = x2)) as [->|];
109 first rewrite lookup_delete lookup_delete_ne //.
110 rewrite !lookup_delete_ne //
111 -(lookup_insert_ne m2 x2 _ v2) //
112 -(lookup_insert_ne m1 x1 _ v1) //.
113 Qed.
114
115 Lemma map_mapM_empty `{MBind F, MRet F} {A B} (f : A → F B) :
116 map_mapM f (∅ : M A) =@{F (M B)} mret ∅.
117 Proof. unfold map_mapM. by rewrite map_fold_empty. Qed.
118
119 Lemma map_mapM_insert `{MBind F, MRet F} {A B} (f : A → F B) (m : M A) i x :
120 m !! i = None → map_first_key (<[i:=x]> m) i →
121 map_mapM f (<[i:=x]> m) = y ← f x; m ← map_mapM f m; mret $ <[i:=y]> m.
122 Proof. intros. rewrite /map_mapM map_fold_insert_first_key //. Qed.
123
124 Lemma map_mapM_insert_option {A B} (f : A → option B) (m : M A) i x :
125 m !! i = None →
126 map_mapM f (<[i:=x]> m) = y ← f x; m ← map_mapM f m; mret $ <[i:=y]> m.
127 Proof.
128 intros. apply: map_fold_insert; [|done].
129 intros ?? z1 z2 my ???. destruct (f z1), (f z2), my; f_equal/=.
130 by apply insert_commute.
131 Qed.
132End fin_map.
133
134Definition map_minimal_key `{MapFold K A M} (R : relation K) `{!RelDecision R}
135 (m : M) : option K :=
136 map_fold (λ i _ mj,
137 match mj with
138 | Some j => if decide (R i j) then Some i else Some j
139 | None => Some i
140 end) None m.
141
142Section map_sorted.
143 Context `{FinMap K M} (R : relation K) .
144
145 Lemma map_minimal_key_None {A} `{!RelDecision R} (m : M A) :
146 map_minimal_key R m = None ↔ m = ∅.
147 Proof.
148 split; [|intros ->; apply map_fold_empty].
149 induction m as [|j x m ?? _] using map_first_key_ind; intros Hm; [done|].
150 rewrite /map_minimal_key map_fold_insert_first_key // in Hm.
151 repeat case_match; simplify_option_eq.
152 Qed.
153
154 Lemma map_minimal_key_Some_1 {A} `{!RelDecision R, !PreOrder R, !Total R}
155 (m : M A) i :
156 map_minimal_key R m = Some i →
157 is_Some (m !! i) ∧ ∀ j, is_Some (m !! j) → R i j.
158 Proof.
159 revert i. induction m as [|j x m ?? IH] using map_first_key_ind; intros i Hm.
160 { by rewrite /map_minimal_key map_fold_empty in Hm. }
161 rewrite /map_minimal_key map_fold_insert_first_key // in Hm.
162 destruct (map_fold _ _ m) as [i'|] eqn:Hfold; simplify_eq.
163 - apply IH in Hfold as [??]. rewrite lookup_insert_is_Some.
164 case_decide as HR; simplify_eq/=.
165 + split; [by auto|]. intros j [->|[??]]%lookup_insert_is_Some; [done|].
166 trans i'; eauto.
167 + split.
168 { right; split; [|done]. intros ->. by destruct HR. }
169 intros j' [->|[??]]%lookup_insert_is_Some; [|by eauto].
170 by destruct (total R i j').
171 - apply map_minimal_key_None in Hfold as ->.
172 split; [rewrite lookup_insert; by eauto|].
173 intros j' [->|[? Hj']]%lookup_insert_is_Some; [done|].
174 rewrite lookup_empty in Hj'. by destruct Hj'.
175 Qed.
176
177 Lemma map_minimal_key_Some {A} `{!RelDecision R, !PartialOrder R, !Total R}
178 (m : M A) i :
179 map_minimal_key R m = Some i ↔
180 is_Some (m !! i) ∧ ∀ j, is_Some (m !! j) → R i j.
181 Proof.
182 split; [apply map_minimal_key_Some_1|].
183 intros [Hi ?]. destruct (map_minimal_key R m) as [i'|] eqn:Hmin.
184 - f_equal. apply map_minimal_key_Some_1 in Hmin as [??].
185 apply (anti_symm R); eauto.
186 - apply map_minimal_key_None in Hmin as ->.
187 rewrite lookup_empty in Hi. by destruct Hi.
188 Qed.
189
190 Lemma map_sorted_ind {A} `{!PreOrder R, !Total R} (P : M A → Prop) :
191 P ∅ →
192 (∀ i x m,
193 m !! i = None →
194 (∀ j, is_Some (m !! j) → R i j) →
195 P m →
196 P (<[i:=x]> m)) →
197 (∀ m, P m).
198 Proof.
199 intros Hemp Hins m. induction (Nat.lt_wf_0_projected size m) as [m _ IH].
200 cut (m = ∅ ∨ map_Exists (λ i _, ∀ j, is_Some (m !! j) → R i j) m).
201 { intros [->|(i & x & Hi & ?)]; [done|]. rewrite -(insert_delete m i x) //.
202 apply Hins; [by rewrite lookup_delete|..].
203 - intros j ?%lookup_delete_is_Some. naive_solver.
204 - apply IH.
205 rewrite -{2}(insert_delete m i x) // map_size_insert lookup_delete. lia. }
206 clear P Hemp Hins IH. induction m as [|i x m ? IH] using map_ind; [by auto|].
207 right. destruct IH as [->|(i' & x' & ? & ?)].
208 { rewrite insert_empty map_Exists_singleton.
209 by intros j [y [-> ->]%lookup_singleton_Some]. }
210 apply map_Exists_insert; first done. destruct (total R i i').
211 - left. intros j [->|[??]]%lookup_insert_is_Some; [done|]. trans i'; eauto.
212 - right. exists i', x'. split; [done|].
213 intros j [->|[??]]%lookup_insert_is_Some; eauto.
214 Qed.
215End map_sorted.
216
217Definition map_fold_sorted `{!MapFold K A M} {B}
218 (R : relation K) `{!RelDecision R}
219 (f : K → A → B → B) (b : B)
220 (m : M) : B := foldr (λ '(i,x), f i x) b $
221 merge_sort (prod_relation R (λ _ _, True)) (map_to_list m).
222
223Definition map_mapM_sorted
224 `{!∀ A, MapFold K A (M A), !∀ A, Empty (M A), !∀ A, Insert K A (M A)}
225 `{MBind F, MRet F} {A B}
226 (R : relation K) `{!RelDecision R}
227 (f : A → F B) (m : M A) : F (M B) :=
228 map_fold_sorted R (λ i x mm, y ← f x; m ← mm; mret $ <[i:=y]> m) (mret ∅) m.
229
230Section fin_map.
231 Context `{FinMap K M}.
232 Context (R : relation K) `{!RelDecision R, !PartialOrder R, !Total R}.
233
234 Lemma map_fold_sorted_empty {A B} (f : K → A → B → B) b :
235 map_fold_sorted R f b (∅ : M A) = b.
236 Proof. by rewrite /map_fold_sorted map_to_list_empty. Qed.
237
238 Lemma map_fold_sorted_insert {A B} (f : K → A → B → B) (m : M A) b i x :
239 m !! i = None → (∀ j, is_Some (m !! j) → R i j) →
240 map_fold_sorted R f b (<[i:=x]> m) = f i x (map_fold_sorted R f b m).
241 Proof.
242 intros Hi Hleast. unfold map_fold_sorted.
243 set (R' := prod_relation R _).
244 assert (PreOrder R').
245 { split; [done|].
246 intros [??] [??] [??] [??] [??]; split; [by etrans|done]. }
247 assert (Total R').
248 { intros [i1 ?] [i2 ?]. destruct (total R i1 i2); [by left|by right]. }
249 assert (merge_sort R' (map_to_list (<[i:=x]> m))
250 = (i,x) :: merge_sort R' (map_to_list m)) as ->; [|done].
251 eapply (Sorted_unique_strong R').
252 - intros [i1 y1] [i2 y2].
253 rewrite !merge_sort_Permutation elem_of_cons !elem_of_map_to_list.
254 rewrite lookup_insert_Some. intros ?? [? _] [? _].
255 assert (i1 = i2) as -> by (by apply (anti_symm R)); naive_solver.
256 - apply (Sorted_merge_sort _).
257 - apply Sorted_cons; [apply (Sorted_merge_sort _)|].
258 destruct (merge_sort R' (map_to_list m))
259 as [|[i' x'] ixs] eqn:Hixs; repeat constructor; simpl.
260 apply Hleast. exists x'. apply elem_of_map_to_list.
261 rewrite -(merge_sort_Permutation R' (map_to_list m)) Hixs. left.
262 - by rewrite !merge_sort_Permutation map_to_list_insert.
263 Qed.
264
265 Lemma map_mapM_sorted_empty `{MBind F, MRet F} {A B} (f : A → F B) :
266 map_mapM_sorted R f (∅ : M A) =@{F (M B)} mret ∅.
267 Proof. by rewrite /map_mapM_sorted map_fold_sorted_empty. Qed.
268
269 Lemma map_mapM_sorted_insert `{MBind F, MRet F}
270 {A B} (f : A → F B) (m : M A) i x :
271 m !! i = None → (∀ j, is_Some (m !! j) → R i j) →
272 map_mapM_sorted R f (<[i:=x]> m)
273 = y ← f x; m ← map_mapM_sorted R f m; mret $ <[i:=y]> m.
274 Proof. intros. by rewrite /map_mapM_sorted map_fold_sorted_insert. Qed.
275End fin_map.