├── .gitignore ├── CoqMakefile ├── CoqMakefile.conf ├── LICENSE ├── LICENSE.txt ├── Makefile ├── Makefile.coq ├── PEPM25_slides.pdf ├── README ├── README.txt ├── SK.glob ├── SK.v ├── SK.vo ├── SK.vok ├── SK.vos ├── _CoqProject ├── classify.glob ├── classify.v ├── classify.vo ├── classify.vok ├── classify.vos ├── classify_derive.glob ├── classify_derive.v ├── classify_derive.vo ├── classify_derive.vok ├── classify_derive.vos ├── derive.glob ├── derive.v ├── derive.vo ├── derive.vok ├── derive.vos ├── derive.v~ ├── lambda.v ├── reduction_preserves_typing.glob ├── reduction_preserves_typing.v ├── reduction_preserves_typing.vo ├── reduction_preserves_typing.vok ├── reduction_preserves_typing.vos ├── rewriting_theorems.glob ├── rewriting_theorems.v ├── rewriting_theorems.vo ├── rewriting_theorems.vok ├── rewriting_theorems.vos ├── size.v ├── subtypes.glob ├── subtypes.v ├── subtypes.vo ├── subtypes.vok ├── subtypes.vos ├── terms.glob ├── terms.v ├── terms.vo ├── terms.vok ├── terms.vos ├── terms.v~ ├── typed_evaluator.glob ├── typed_evaluator.v ├── typed_evaluator.vo ├── typed_evaluator.vok ├── typed_evaluator.vos ├── typed_lambda.glob ├── typed_lambda.v ├── typed_lambda.vo ├── typed_lambda.vok ├── typed_lambda.vos ├── typed_program_analysis.pdf ├── typed_recursion.glob ├── typed_recursion.v ├── typed_recursion.vo ├── typed_recursion.vok ├── typed_recursion.vos ├── typed_triage.glob ├── typed_triage.v ├── typed_triage.vo ├── typed_triage.vok ├── typed_triage.vos ├── types.glob ├── types.v ├── types.vo ├── types.vok └── types.vos /.gitignore: -------------------------------------------------------------------------------- 1 | .*.aux 2 | .*.d 3 | *.a 4 | *.cma 5 | *.cmi 6 | *.cmo 7 | *.cmx 8 | *.cmxa 9 | *.cmxs 10 | *.glob 11 | *.ml.d 12 | *.ml4.d 13 | *.mlg.d 14 | *.mli.d 15 | *.mllib.d 16 | *.mlpack.d 17 | *.native 18 | *.o 19 | *.v.d 20 | *.vio 21 | *.vo 22 | *.vok 23 | *.vos 24 | .coq-native 25 | .csdp.cache 26 | .lia.cache 27 | .nia.cache 28 | .nlia.cache 29 | .nra.cache 30 | csdp.cache 31 | lia.cache 32 | nia.cache 33 | nlia.cache 34 | nra.cache 35 | native_compute_profile_*.data 36 | 37 | # generated timing files 38 | *.timing.diff 39 | *.v.after-timing 40 | *.v.before-timing 41 | *.v.timing 42 | time-of-build-after.log 43 | time-of-build-before.log 44 | time-of-build-both.log 45 | time-of-build-pretty.log 46 | -------------------------------------------------------------------------------- /CoqMakefile: -------------------------------------------------------------------------------- 1 | ########################################################################## 2 | ## # The Coq Proof Assistant / The Coq Development Team ## 3 | ## v # Copyright INRIA, CNRS and contributors ## 4 | ## /dev/null 2>/dev/null; echo $$?)) 72 | STDTIME?=command time -f $(TIMEFMT) 73 | else 74 | ifeq (0,$(shell gtime -f "" true >/dev/null 2>/dev/null; echo $$?)) 75 | STDTIME?=gtime -f $(TIMEFMT) 76 | else 77 | STDTIME?=command time 78 | endif 79 | endif 80 | else 81 | STDTIME?=command time -f $(TIMEFMT) 82 | endif 83 | 84 | ifneq (,$(COQBIN)) 85 | # add an ending / 86 | COQBIN:=$(COQBIN)/ 87 | endif 88 | 89 | # Coq binaries 90 | COQC ?= "$(COQBIN)coqc" 91 | COQTOP ?= "$(COQBIN)coqtop" 92 | COQCHK ?= "$(COQBIN)coqchk" 93 | COQDEP ?= "$(COQBIN)coqdep" 94 | COQDOC ?= "$(COQBIN)coqdoc" 95 | COQPP ?= "$(COQBIN)coqpp" 96 | COQMKFILE ?= "$(COQBIN)coq_makefile" 97 | OCAMLLIBDEP ?= "$(COQBIN)ocamllibdep" 98 | 99 | # Timing scripts 100 | COQMAKE_ONE_TIME_FILE ?= "$(COQLIB)/tools/make-one-time-file.py" 101 | COQMAKE_BOTH_TIME_FILES ?= "$(COQLIB)/tools/make-both-time-files.py" 102 | COQMAKE_BOTH_SINGLE_TIMING_FILES ?= "$(COQLIB)/tools/make-both-single-timing-files.py" 103 | BEFORE ?= 104 | AFTER ?= 105 | 106 | # FIXME this should be generated by Coq (modules already linked by Coq) 107 | CAMLDONTLINK=str,unix,dynlink,threads,zarith 108 | 109 | # OCaml binaries 110 | CAMLC ?= "$(OCAMLFIND)" ocamlc -c 111 | CAMLOPTC ?= "$(OCAMLFIND)" opt -c 112 | CAMLLINK ?= "$(OCAMLFIND)" ocamlc -linkpkg -dontlink $(CAMLDONTLINK) 113 | CAMLOPTLINK ?= "$(OCAMLFIND)" opt -linkpkg -dontlink $(CAMLDONTLINK) 114 | CAMLDOC ?= "$(OCAMLFIND)" ocamldoc 115 | CAMLDEP ?= "$(OCAMLFIND)" ocamldep -slash -ml-synonym .mlpack 116 | 117 | # DESTDIR is prepended to all installation paths 118 | DESTDIR ?= 119 | 120 | # Debug builds, typically -g to OCaml, -debug to Coq. 121 | CAMLDEBUG ?= 122 | COQDEBUG ?= 123 | 124 | # Extra packages to be linked in (as in findlib -package) 125 | CAMLPKGS ?= 126 | 127 | # Option for making timing files 128 | TIMING?= 129 | # Option for changing sorting of timing output file 130 | TIMING_SORT_BY ?= auto 131 | # Option for changing the fuzz parameter on the output file 132 | TIMING_FUZZ ?= 0 133 | # Option for changing whether to use real or user time for timing tables 134 | TIMING_REAL?= 135 | # Option for including the memory column(s) 136 | TIMING_INCLUDE_MEM?= 137 | # Option for sorting by the memory column 138 | TIMING_SORT_BY_MEM?= 139 | # Output file names for timed builds 140 | TIME_OF_BUILD_FILE ?= time-of-build.log 141 | TIME_OF_BUILD_BEFORE_FILE ?= time-of-build-before.log 142 | TIME_OF_BUILD_AFTER_FILE ?= time-of-build-after.log 143 | TIME_OF_PRETTY_BUILD_FILE ?= time-of-build-pretty.log 144 | TIME_OF_PRETTY_BOTH_BUILD_FILE ?= time-of-build-both.log 145 | TIME_OF_PRETTY_BUILD_EXTRA_FILES ?= - # also output to the command line 146 | 147 | TGTS ?= 148 | 149 | # Retro compatibility (DESTDIR is standard on Unix, DSTROOT is not) 150 | ifdef DSTROOT 151 | DESTDIR := $(DSTROOT) 152 | endif 153 | 154 | # Substitution of the path by appending $(DESTDIR) if needed. 155 | # The variable $(COQMF_WINDRIVE) can be needed for Cygwin environments. 156 | windrive_path = $(if $(COQMF_WINDRIVE),$(subst $(COQMF_WINDRIVE),/,$(1)),$(1)) 157 | destination_path = $(if $(DESTDIR),$(DESTDIR)/$(call windrive_path,$(1)),$(1)) 158 | 159 | # Installation paths of libraries and documentation. 160 | COQLIBINSTALL ?= $(call destination_path,$(COQLIB)/user-contrib) 161 | COQDOCINSTALL ?= $(call destination_path,$(DOCDIR)/user-contrib) 162 | COQTOPINSTALL ?= $(call destination_path,$(COQLIB)/toploop) # FIXME: Unused variable? 163 | 164 | ########## End of parameters ################################################## 165 | # What follows may be relevant to you only if you need to 166 | # extend this Makefile. If so, look for 'Extension point' here and 167 | # put in CoqMakefile.local double colon rules accordingly. 168 | # E.g. to perform some work after the all target completes you can write 169 | # 170 | # post-all:: 171 | # echo "All done!" 172 | # 173 | # in CoqMakefile.local 174 | # 175 | ############################################################################### 176 | 177 | 178 | 179 | 180 | # Flags ####################################################################### 181 | # 182 | # We define a bunch of variables combining the parameters. 183 | # To add additional flags to coq, coqchk or coqdoc, set the 184 | # {COQ,COQCHK,COQDOC}EXTRAFLAGS variable to whatever you want to add. 185 | # To overwrite the default choice and set your own flags entirely, set the 186 | # {COQ,COQCHK,COQDOC}FLAGS variable. 187 | 188 | SHOW := $(if $(VERBOSE),@true "",@echo "") 189 | HIDE := $(if $(VERBOSE),,@) 190 | 191 | TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD)) 192 | 193 | OPT?= 194 | 195 | # The DYNOBJ and DYNLIB variables are used by "coqdep -dyndep var" in .v.d 196 | ifeq '$(OPT)' '-byte' 197 | USEBYTE:=true 198 | DYNOBJ:=.cma 199 | DYNLIB:=.cma 200 | else 201 | USEBYTE:= 202 | DYNOBJ:=.cmxs 203 | DYNLIB:=.cmxs 204 | endif 205 | 206 | # these variables are meant to be overridden if you want to add *extra* flags 207 | COQEXTRAFLAGS?= 208 | COQCHKEXTRAFLAGS?= 209 | COQDOCEXTRAFLAGS?= 210 | 211 | # these flags do NOT contain the libraries, to make them easier to overwrite 212 | COQFLAGS?=-q $(OTHERFLAGS) $(COQEXTRAFLAGS) 213 | COQCHKFLAGS?=-silent -o $(COQCHKEXTRAFLAGS) 214 | COQDOCFLAGS?=-interpolate -utf8 $(COQDOCEXTRAFLAGS) 215 | 216 | COQDOCLIBS?=$(COQLIBS_NOML) 217 | 218 | # The version of Coq being run and the version of coq_makefile that 219 | # generated this makefile 220 | COQ_VERSION:=$(shell $(COQC) --print-version | cut -d " " -f 1) 221 | COQMAKEFILE_VERSION:=8.13.2 222 | 223 | COQSRCLIBS?= $(foreach d,$(COQ_SRC_SUBDIRS), -I "$(COQLIB)/$(d)") 224 | 225 | CAMLFLAGS+=$(OCAMLLIBS) $(COQSRCLIBS) 226 | # ocamldoc fails with unknown argument otherwise 227 | CAMLDOCFLAGS:=$(filter-out -annot, $(filter-out -bin-annot, $(CAMLFLAGS))) 228 | CAMLFLAGS+=$(OCAMLWARN) 229 | 230 | ifneq (,$(TIMING)) 231 | TIMING_ARG=-time 232 | ifeq (after,$(TIMING)) 233 | TIMING_EXT=after-timing 234 | else 235 | ifeq (before,$(TIMING)) 236 | TIMING_EXT=before-timing 237 | else 238 | TIMING_EXT=timing 239 | endif 240 | endif 241 | else 242 | TIMING_ARG= 243 | endif 244 | 245 | # Files ####################################################################### 246 | # 247 | # We here define a bunch of variables about the files being part of the 248 | # Coq project in order to ease the writing of build target and build rules 249 | 250 | VDFILE := .CoqMakefile.d 251 | 252 | ALLSRCFILES := \ 253 | $(MLGFILES) \ 254 | $(MLFILES) \ 255 | $(MLPACKFILES) \ 256 | $(MLLIBFILES) \ 257 | $(MLIFILES) 258 | 259 | # helpers 260 | vo_to_obj = $(addsuffix .o,\ 261 | $(filter-out Warning: Error:,\ 262 | $(shell $(COQTOP) -q -noinit -batch -quiet -print-mod-uid $(1)))) 263 | strip_dotslash = $(patsubst ./%,%,$(1)) 264 | 265 | # without this we get undefined variables in the expansion for the 266 | # targets of the [deprecated,use-mllib-or-mlpack] rule 267 | with_undef = $(if $(filter-out undefined, $(origin $(1))),$($(1))) 268 | 269 | VO = vo 270 | VOS = vos 271 | 272 | VOFILES = $(VFILES:.v=.$(VO)) 273 | GLOBFILES = $(VFILES:.v=.glob) 274 | HTMLFILES = $(VFILES:.v=.html) 275 | GHTMLFILES = $(VFILES:.v=.g.html) 276 | BEAUTYFILES = $(addsuffix .beautified,$(VFILES)) 277 | TEXFILES = $(VFILES:.v=.tex) 278 | GTEXFILES = $(VFILES:.v=.g.tex) 279 | CMOFILES = \ 280 | $(MLGFILES:.mlg=.cmo) \ 281 | $(MLFILES:.ml=.cmo) \ 282 | $(MLPACKFILES:.mlpack=.cmo) 283 | CMXFILES = $(CMOFILES:.cmo=.cmx) 284 | OFILES = $(CMXFILES:.cmx=.o) 285 | CMAFILES = $(MLLIBFILES:.mllib=.cma) $(MLPACKFILES:.mlpack=.cma) 286 | CMXAFILES = $(CMAFILES:.cma=.cmxa) 287 | CMIFILES = \ 288 | $(CMOFILES:.cmo=.cmi) \ 289 | $(MLIFILES:.mli=.cmi) 290 | # the /if/ is because old _CoqProject did not list a .ml(pack|lib) but just 291 | # a .mlg file 292 | CMXSFILES = \ 293 | $(MLPACKFILES:.mlpack=.cmxs) \ 294 | $(CMXAFILES:.cmxa=.cmxs) \ 295 | $(if $(MLPACKFILES)$(CMXAFILES),,\ 296 | $(MLGFILES:.mlg=.cmxs) $(MLFILES:.ml=.cmxs)) 297 | 298 | # files that are packed into a plugin (no extension) 299 | PACKEDFILES = \ 300 | $(call strip_dotslash, \ 301 | $(foreach lib, \ 302 | $(call strip_dotslash, \ 303 | $(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES)),$(call with_undef,$(lib)))) 304 | # files that are archived into a .cma (mllib) 305 | LIBEDFILES = \ 306 | $(call strip_dotslash, \ 307 | $(foreach lib, \ 308 | $(call strip_dotslash, \ 309 | $(MLLIBFILES:.mllib=_MLLIB_DEPENDENCIES)),$(call with_undef,$(lib)))) 310 | CMIFILESTOINSTALL = $(filter-out $(addsuffix .cmi,$(PACKEDFILES)),$(CMIFILES)) 311 | CMOFILESTOINSTALL = $(filter-out $(addsuffix .cmo,$(PACKEDFILES)),$(CMOFILES)) 312 | OBJFILES = $(call vo_to_obj,$(VOFILES)) 313 | ALLNATIVEFILES = \ 314 | $(OBJFILES:.o=.cmi) \ 315 | $(OBJFILES:.o=.cmx) \ 316 | $(OBJFILES:.o=.cmxs) 317 | # trick: wildcard filters out non-existing files, so that `install` doesn't show 318 | # warnings and `clean` doesn't pass to rm a list of files that is too long for 319 | # the shell. 320 | NATIVEFILES = $(wildcard $(ALLNATIVEFILES)) 321 | FILESTOINSTALL = \ 322 | $(VOFILES) \ 323 | $(VFILES) \ 324 | $(GLOBFILES) \ 325 | $(NATIVEFILES) \ 326 | $(CMIFILESTOINSTALL) 327 | BYTEFILESTOINSTALL = \ 328 | $(CMOFILESTOINSTALL) \ 329 | $(CMAFILES) 330 | ifeq '$(HASNATDYNLINK)' 'true' 331 | DO_NATDYNLINK = yes 332 | FILESTOINSTALL += $(CMXSFILES) $(CMXAFILES) $(CMOFILESTOINSTALL:.cmo=.cmx) 333 | else 334 | DO_NATDYNLINK = 335 | endif 336 | 337 | ALLDFILES = $(addsuffix .d,$(ALLSRCFILES)) $(VDFILE) 338 | 339 | # Compilation targets ######################################################### 340 | 341 | all: 342 | $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all 343 | $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all 344 | $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all 345 | .PHONY: all 346 | 347 | all.timing.diff: 348 | $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all 349 | $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all.timing.diff TIME_OF_PRETTY_BUILD_EXTRA_FILES="" 350 | $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all 351 | .PHONY: all.timing.diff 352 | 353 | ifeq (0,$(TIMING_REAL)) 354 | TIMING_REAL_ARG := 355 | TIMING_USER_ARG := --user 356 | else 357 | ifeq (1,$(TIMING_REAL)) 358 | TIMING_REAL_ARG := --real 359 | TIMING_USER_ARG := 360 | else 361 | TIMING_REAL_ARG := 362 | TIMING_USER_ARG := 363 | endif 364 | endif 365 | 366 | ifeq (0,$(TIMING_INCLUDE_MEM)) 367 | TIMING_INCLUDE_MEM_ARG := --no-include-mem 368 | else 369 | TIMING_INCLUDE_MEM_ARG := 370 | endif 371 | 372 | ifeq (1,$(TIMING_SORT_BY_MEM)) 373 | TIMING_SORT_BY_MEM_ARG := --sort-by-mem 374 | else 375 | TIMING_SORT_BY_MEM_ARG := 376 | endif 377 | 378 | make-pretty-timed-before:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_BEFORE_FILE) 379 | make-pretty-timed-after:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_AFTER_FILE) 380 | make-pretty-timed make-pretty-timed-before make-pretty-timed-after:: 381 | $(HIDE)rm -f pretty-timed-success.ok 382 | $(HIDE)($(MAKE) --no-print-directory -f "$(PARENT)" $(TGTS) TIMED=1 2>&1 && touch pretty-timed-success.ok) | tee -a $(TIME_OF_BUILD_FILE) 383 | $(HIDE)rm pretty-timed-success.ok # must not be -f; must fail if the touch failed 384 | print-pretty-timed:: 385 | $(HIDE)$(COQMAKE_ONE_TIME_FILE) $(TIMING_INCLUDE_MEM_ARG) $(TIMING_SORT_BY_MEM_ARG) $(TIMING_REAL_ARG) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) 386 | print-pretty-timed-diff:: 387 | $(HIDE)$(COQMAKE_BOTH_TIME_FILES) --sort-by=$(TIMING_SORT_BY) $(TIMING_INCLUDE_MEM_ARG) $(TIMING_SORT_BY_MEM_ARG) $(TIMING_REAL_ARG) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) 388 | ifeq (,$(BEFORE)) 389 | print-pretty-single-time-diff:: 390 | @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing' 391 | $(HIDE)false 392 | else 393 | ifeq (,$(AFTER)) 394 | print-pretty-single-time-diff:: 395 | @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing' 396 | $(HIDE)false 397 | else 398 | print-pretty-single-time-diff:: 399 | $(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) --fuzz=$(TIMING_FUZZ) --sort-by=$(TIMING_SORT_BY) $(TIMING_USER_ARG) $(AFTER) $(BEFORE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) 400 | endif 401 | endif 402 | pretty-timed: 403 | $(HIDE)$(MAKE) --no-print-directory -f "$(PARENT)" make-pretty-timed 404 | $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-timed 405 | .PHONY: pretty-timed make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff 406 | 407 | # Extension points for actions to be performed before/after the all target 408 | pre-all:: 409 | @# Extension point 410 | $(HIDE)if [ "$(COQMAKEFILE_VERSION)" != "$(COQ_VERSION)" ]; then\ 411 | echo "W: This Makefile was generated by Coq $(COQMAKEFILE_VERSION)";\ 412 | echo "W: while the current Coq version is $(COQ_VERSION)";\ 413 | fi 414 | .PHONY: pre-all 415 | 416 | post-all:: 417 | @# Extension point 418 | .PHONY: post-all 419 | 420 | real-all: $(VOFILES) $(if $(USEBYTE),bytefiles,optfiles) 421 | .PHONY: real-all 422 | 423 | real-all.timing.diff: $(VOFILES:.vo=.v.timing.diff) 424 | .PHONY: real-all.timing.diff 425 | 426 | bytefiles: $(CMOFILES) $(CMAFILES) 427 | .PHONY: bytefiles 428 | 429 | optfiles: $(if $(DO_NATDYNLINK),$(CMXSFILES)) 430 | .PHONY: optfiles 431 | 432 | # FIXME, see Ralf's bugreport 433 | # quick is deprecated, now renamed vio 434 | vio: $(VOFILES:.vo=.vio) 435 | .PHONY: vio 436 | quick: vio 437 | $(warning "'make quick' is deprecated, use 'make vio' or consider using 'vos' files") 438 | .PHONY: quick 439 | 440 | vio2vo: 441 | $(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) \ 442 | -schedule-vio2vo $(J) $(VOFILES:%.vo=%.vio) 443 | .PHONY: vio2vo 444 | 445 | # quick2vo is undocumented 446 | quick2vo: 447 | $(HIDE)make -j $(J) vio 448 | $(HIDE)VIOFILES=$$(for vofile in $(VOFILES); do \ 449 | viofile="$$(echo "$$vofile" | sed "s/\.vo$$/.vio/")"; \ 450 | if [ "$$vofile" -ot "$$viofile" -o ! -e "$$vofile" ]; then printf "$$viofile "; fi; \ 451 | done); \ 452 | echo "VIO2VO: $$VIOFILES"; \ 453 | if [ -n "$$VIOFILES" ]; then \ 454 | $(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) -schedule-vio2vo $(J) $$VIOFILES; \ 455 | fi 456 | .PHONY: quick2vo 457 | 458 | checkproofs: 459 | $(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) \ 460 | -schedule-vio-checking $(J) $(VOFILES:%.vo=%.vio) 461 | .PHONY: checkproofs 462 | 463 | vos: $(VOFILES:%.vo=%.vos) 464 | .PHONY: vos 465 | 466 | vok: $(VOFILES:%.vo=%.vok) 467 | .PHONY: vok 468 | 469 | validate: $(VOFILES) 470 | $(TIMER) $(COQCHK) $(COQCHKFLAGS) $(COQLIBS_NOML) $^ 471 | .PHONY: validate 472 | 473 | only: $(TGTS) 474 | .PHONY: only 475 | 476 | # Documentation targets ####################################################### 477 | 478 | html: $(GLOBFILES) $(VFILES) 479 | $(SHOW)'COQDOC -d html $(GAL)' 480 | $(HIDE)mkdir -p html 481 | $(HIDE)$(COQDOC) \ 482 | -toc $(COQDOCFLAGS) -html $(GAL) $(COQDOCLIBS) -d html $(VFILES) 483 | 484 | mlihtml: $(MLIFILES:.mli=.cmi) 485 | $(SHOW)'CAMLDOC -d $@' 486 | $(HIDE)mkdir $@ || rm -rf $@/* 487 | $(HIDE)$(CAMLDOC) -html \ 488 | -d $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES) 489 | 490 | all-mli.tex: $(MLIFILES:.mli=.cmi) 491 | $(SHOW)'CAMLDOC -latex $@' 492 | $(HIDE)$(CAMLDOC) -latex \ 493 | -o $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES) 494 | 495 | all.ps: $(VFILES) 496 | $(SHOW)'COQDOC -ps $(GAL)' 497 | $(HIDE)$(COQDOC) \ 498 | -toc $(COQDOCFLAGS) -ps $(GAL) $(COQDOCLIBS) \ 499 | -o $@ `$(COQDEP) -sort $(VFILES)` 500 | 501 | all.pdf: $(VFILES) 502 | $(SHOW)'COQDOC -pdf $(GAL)' 503 | $(HIDE)$(COQDOC) \ 504 | -toc $(COQDOCFLAGS) -pdf $(GAL) $(COQDOCLIBS) \ 505 | -o $@ `$(COQDEP) -sort $(VFILES)` 506 | 507 | # FIXME: not quite right, since the output name is different 508 | gallinahtml: GAL=-g 509 | gallinahtml: html 510 | 511 | all-gal.ps: GAL=-g 512 | all-gal.ps: all.ps 513 | 514 | all-gal.pdf: GAL=-g 515 | all-gal.pdf: all.pdf 516 | 517 | # ? 518 | beautify: $(BEAUTYFILES) 519 | for file in $^; do mv $${file%.beautified} $${file%beautified}old && mv $${file} $${file%.beautified}; done 520 | @echo 'Do not do "make clean" until you are sure that everything went well!' 521 | @echo 'If there were a problem, execute "for file in $$(find . -name \*.v.old -print); do mv $${file} $${file%.old}; done" in your shell/' 522 | .PHONY: beautify 523 | 524 | # Installation targets ######################################################## 525 | # 526 | # There rules can be extended in CoqMakefile.local 527 | # Extensions can't assume when they run. 528 | 529 | install: 530 | $(HIDE)code=0; for f in $(FILESTOINSTALL); do\ 531 | if ! [ -f "$$f" ]; then >&2 echo $$f does not exist; code=1; fi \ 532 | done; exit $$code 533 | $(HIDE)for f in $(FILESTOINSTALL); do\ 534 | df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`";\ 535 | if [ "$$?" != "0" -o -z "$$df" ]; then\ 536 | echo SKIP "$$f" since it has no logical path;\ 537 | else\ 538 | install -d "$(COQLIBINSTALL)/$$df" &&\ 539 | install -m 0644 "$$f" "$(COQLIBINSTALL)/$$df" &&\ 540 | echo INSTALL "$$f" "$(COQLIBINSTALL)/$$df";\ 541 | fi;\ 542 | done 543 | $(HIDE)$(MAKE) install-extra -f "$(SELF)" 544 | install-extra:: 545 | @# Extension point 546 | .PHONY: install install-extra 547 | 548 | install-byte: 549 | $(HIDE)for f in $(BYTEFILESTOINSTALL); do\ 550 | df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`";\ 551 | if [ "$$?" != "0" -o -z "$$df" ]; then\ 552 | echo SKIP "$$f" since it has no logical path;\ 553 | else\ 554 | install -d "$(COQLIBINSTALL)/$$df" &&\ 555 | install -m 0644 "$$f" "$(COQLIBINSTALL)/$$df" &&\ 556 | echo INSTALL "$$f" "$(COQLIBINSTALL)/$$df";\ 557 | fi;\ 558 | done 559 | 560 | install-doc:: html mlihtml 561 | @# Extension point 562 | $(HIDE)install -d "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html" 563 | $(HIDE)for i in html/*; do \ 564 | dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\ 565 | install -m 0644 "$$i" "$$dest";\ 566 | echo INSTALL "$$i" "$$dest";\ 567 | done 568 | $(HIDE)install -d \ 569 | "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml" 570 | $(HIDE)for i in mlihtml/*; do \ 571 | dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\ 572 | install -m 0644 "$$i" "$$dest";\ 573 | echo INSTALL "$$i" "$$dest";\ 574 | done 575 | .PHONY: install-doc 576 | 577 | uninstall:: 578 | @# Extension point 579 | $(HIDE)for f in $(FILESTOINSTALL); do \ 580 | df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`" &&\ 581 | instf="$(COQLIBINSTALL)/$$df/`basename $$f`" &&\ 582 | rm -f "$$instf" &&\ 583 | echo RM "$$instf" &&\ 584 | (rmdir "$(COQLIBINSTALL)/$$df/" 2>/dev/null || true); \ 585 | done 586 | .PHONY: uninstall 587 | 588 | uninstall-doc:: 589 | @# Extension point 590 | $(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html' 591 | $(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html" 592 | $(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml' 593 | $(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml" 594 | $(HIDE) rmdir "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/" || true 595 | .PHONY: uninstall-doc 596 | 597 | # Cleaning #################################################################### 598 | # 599 | # There rules can be extended in CoqMakefile.local 600 | # Extensions can't assume when they run. 601 | 602 | clean:: 603 | @# Extension point 604 | $(SHOW)'CLEAN' 605 | $(HIDE)rm -f $(CMOFILES) 606 | $(HIDE)rm -f $(CMIFILES) 607 | $(HIDE)rm -f $(CMAFILES) 608 | $(HIDE)rm -f $(CMOFILES:.cmo=.cmx) 609 | $(HIDE)rm -f $(CMXAFILES) 610 | $(HIDE)rm -f $(CMXSFILES) 611 | $(HIDE)rm -f $(CMOFILES:.cmo=.o) 612 | $(HIDE)rm -f $(CMXAFILES:.cmxa=.a) 613 | $(HIDE)rm -f $(MLGFILES:.mlg=.ml) 614 | $(HIDE)rm -f $(ALLDFILES) 615 | $(HIDE)rm -f $(NATIVEFILES) 616 | $(HIDE)find . -name .coq-native -type d -empty -delete 617 | $(HIDE)rm -f $(VOFILES) 618 | $(HIDE)rm -f $(VOFILES:.vo=.vio) 619 | $(HIDE)rm -f $(VOFILES:.vo=.vos) 620 | $(HIDE)rm -f $(VOFILES:.vo=.vok) 621 | $(HIDE)rm -f $(BEAUTYFILES) $(VFILES:=.old) 622 | $(HIDE)rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob all-mli.tex 623 | $(HIDE)rm -f $(VFILES:.v=.glob) 624 | $(HIDE)rm -f $(VFILES:.v=.tex) 625 | $(HIDE)rm -f $(VFILES:.v=.g.tex) 626 | $(HIDE)rm -f pretty-timed-success.ok 627 | $(HIDE)rm -rf html mlihtml 628 | .PHONY: clean 629 | 630 | cleanall:: clean 631 | @# Extension point 632 | $(SHOW)'CLEAN *.aux *.timing' 633 | $(HIDE)rm -f $(foreach f,$(VFILES:.v=),$(dir $(f)).$(notdir $(f)).aux) 634 | $(HIDE)rm -f $(TIME_OF_BUILD_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) 635 | $(HIDE)rm -f $(VOFILES:.vo=.v.timing) 636 | $(HIDE)rm -f $(VOFILES:.vo=.v.before-timing) 637 | $(HIDE)rm -f $(VOFILES:.vo=.v.after-timing) 638 | $(HIDE)rm -f $(VOFILES:.vo=.v.timing.diff) 639 | $(HIDE)rm -f .lia.cache .nia.cache 640 | .PHONY: cleanall 641 | 642 | archclean:: 643 | @# Extension point 644 | $(SHOW)'CLEAN *.cmx *.o' 645 | $(HIDE)rm -f $(NATIVEFILES) 646 | $(HIDE)rm -f $(CMOFILES:%.cmo=%.cmx) 647 | .PHONY: archclean 648 | 649 | 650 | # Compilation rules ########################################################### 651 | 652 | $(MLIFILES:.mli=.cmi): %.cmi: %.mli 653 | $(SHOW)'CAMLC -c $<' 654 | $(HIDE)$(TIMER) $(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $< 655 | 656 | $(MLGFILES:.mlg=.ml): %.ml: %.mlg 657 | $(SHOW)'COQPP $<' 658 | $(HIDE)$(COQPP) $< 659 | 660 | # Stupid hack around a deficient syntax: we cannot concatenate two expansions 661 | $(filter %.cmo, $(MLFILES:.ml=.cmo) $(MLGFILES:.mlg=.cmo)): %.cmo: %.ml 662 | $(SHOW)'CAMLC -c $<' 663 | $(HIDE)$(TIMER) $(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $< 664 | 665 | # Same hack 666 | $(filter %.cmx, $(MLFILES:.ml=.cmx) $(MLGFILES:.mlg=.cmx)): %.cmx: %.ml 667 | $(SHOW)'CAMLOPT -c $(FOR_PACK) $<' 668 | $(HIDE)$(TIMER) $(CAMLOPTC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $(FOR_PACK) $< 669 | 670 | 671 | $(MLLIBFILES:.mllib=.cmxs): %.cmxs: %.cmxa 672 | $(SHOW)'CAMLOPT -shared -o $@' 673 | $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ 674 | -linkall -shared -o $@ $< 675 | 676 | $(MLLIBFILES:.mllib=.cma): %.cma: | %.mllib 677 | $(SHOW)'CAMLC -a -o $@' 678 | $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^ 679 | 680 | $(MLLIBFILES:.mllib=.cmxa): %.cmxa: | %.mllib 681 | $(SHOW)'CAMLOPT -a -o $@' 682 | $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -a -o $@ $^ 683 | 684 | 685 | $(MLPACKFILES:.mlpack=.cmxs): %.cmxs: %.cmxa 686 | $(SHOW)'CAMLOPT -shared -o $@' 687 | $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ 688 | -shared -linkall -o $@ $< 689 | 690 | $(MLPACKFILES:.mlpack=.cmxa): %.cmxa: %.cmx 691 | $(SHOW)'CAMLOPT -a -o $@' 692 | $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -a -o $@ $< 693 | 694 | $(MLPACKFILES:.mlpack=.cma): %.cma: %.cmo | %.mlpack 695 | $(SHOW)'CAMLC -a -o $@' 696 | $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^ 697 | 698 | $(MLPACKFILES:.mlpack=.cmo): %.cmo: | %.mlpack 699 | $(SHOW)'CAMLC -pack -o $@' 700 | $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) -pack -o $@ $^ 701 | 702 | $(MLPACKFILES:.mlpack=.cmx): %.cmx: | %.mlpack 703 | $(SHOW)'CAMLOPT -pack -o $@' 704 | $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -pack -o $@ $^ 705 | 706 | # This rule is for _CoqProject with no .mllib nor .mlpack 707 | $(filter-out $(MLLIBFILES:.mllib=.cmxs) $(MLPACKFILES:.mlpack=.cmxs) $(addsuffix .cmxs,$(PACKEDFILES)) $(addsuffix .cmxs,$(LIBEDFILES)),$(MLFILES:.ml=.cmxs) $(MLGFILES:.mlg=.cmxs)): %.cmxs: %.cmx 708 | $(SHOW)'[deprecated,use-mllib-or-mlpack] CAMLOPT -shared -o $@' 709 | $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ 710 | -shared -o $@ $< 711 | 712 | ifneq (,$(TIMING)) 713 | TIMING_EXTRA = > $<.$(TIMING_EXT) 714 | else 715 | TIMING_EXTRA = 716 | endif 717 | 718 | $(VOFILES): %.vo: %.v 719 | $(SHOW)COQC $< 720 | $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(TIMING_ARG) $(COQFLAGS) $(COQLIBS) $< $(TIMING_EXTRA) 721 | 722 | # FIXME ?merge with .vo / .vio ? 723 | $(GLOBFILES): %.glob: %.v 724 | $(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $< 725 | 726 | $(VFILES:.v=.vio): %.vio: %.v 727 | $(SHOW)COQC -vio $< 728 | $(HIDE)$(TIMER) $(COQC) -vio $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $< 729 | 730 | $(VFILES:.v=.vos): %.vos: %.v 731 | $(SHOW)COQC -vos $< 732 | $(HIDE)$(TIMER) $(COQC) -vos $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $< 733 | 734 | $(VFILES:.v=.vok): %.vok: %.v 735 | $(SHOW)COQC -vok $< 736 | $(HIDE)$(TIMER) $(COQC) -vok $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $< 737 | 738 | $(addsuffix .timing.diff,$(VFILES)): %.timing.diff : %.before-timing %.after-timing 739 | $(SHOW)PYTHON TIMING-DIFF $*.{before,after}-timing 740 | $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-single-time-diff BEFORE=$*.before-timing AFTER=$*.after-timing TIME_OF_PRETTY_BUILD_FILE="$@" 741 | 742 | $(BEAUTYFILES): %.v.beautified: %.v 743 | $(SHOW)'BEAUTIFY $<' 744 | $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) -beautify $< 745 | 746 | $(TEXFILES): %.tex: %.v 747 | $(SHOW)'COQDOC -latex $<' 748 | $(HIDE)$(COQDOC) $(COQDOCFLAGS) -latex $< -o $@ 749 | 750 | $(GTEXFILES): %.g.tex: %.v 751 | $(SHOW)'COQDOC -latex -g $<' 752 | $(HIDE)$(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@ 753 | 754 | $(HTMLFILES): %.html: %.v %.glob 755 | $(SHOW)'COQDOC -html $<' 756 | $(HIDE)$(COQDOC) $(COQDOCFLAGS) -html $< -o $@ 757 | 758 | $(GHTMLFILES): %.g.html: %.v %.glob 759 | $(SHOW)'COQDOC -html -g $<' 760 | $(HIDE)$(COQDOC) $(COQDOCFLAGS) -html -g $< -o $@ 761 | 762 | # Dependency files ############################################################ 763 | 764 | ifndef MAKECMDGOALS 765 | -include $(ALLDFILES) 766 | else 767 | ifneq ($(filter-out archclean clean cleanall printenv make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff,$(MAKECMDGOALS)),) 768 | -include $(ALLDFILES) 769 | endif 770 | endif 771 | 772 | .SECONDARY: $(ALLDFILES) 773 | 774 | redir_if_ok = > "$@" || ( RV=$$?; rm -f "$@"; exit $$RV ) 775 | 776 | GENMLFILES:=$(MLGFILES:.mlg=.ml) 777 | $(addsuffix .d,$(ALLSRCFILES)): $(GENMLFILES) 778 | 779 | $(addsuffix .d,$(MLIFILES)): %.mli.d: %.mli 780 | $(SHOW)'CAMLDEP $<' 781 | $(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok) 782 | 783 | $(addsuffix .d,$(MLGFILES)): %.mlg.d: %.ml 784 | $(SHOW)'CAMLDEP $<' 785 | $(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok) 786 | 787 | $(addsuffix .d,$(MLFILES)): %.ml.d: %.ml 788 | $(SHOW)'CAMLDEP $<' 789 | $(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok) 790 | 791 | $(addsuffix .d,$(MLLIBFILES)): %.mllib.d: %.mllib 792 | $(SHOW)'OCAMLLIBDEP $<' 793 | $(HIDE)$(OCAMLLIBDEP) -c $(OCAMLLIBS) "$<" $(redir_if_ok) 794 | 795 | $(addsuffix .d,$(MLPACKFILES)): %.mlpack.d: %.mlpack 796 | $(SHOW)'OCAMLLIBDEP $<' 797 | $(HIDE)$(OCAMLLIBDEP) -c $(OCAMLLIBS) "$<" $(redir_if_ok) 798 | 799 | # If this makefile is created using a _CoqProject we have coqdep get 800 | # options from it. This avoids argument length limits for pathological 801 | # projects. Note that extra options might be on the command line. 802 | VDFILE_FLAGS:=$(if _CoqProject,-f _CoqProject,) $(CMDLINE_COQLIBS) $(CMDLINE_VFILES) 803 | 804 | $(VDFILE): _CoqProject $(VFILES) 805 | $(SHOW)'COQDEP VFILES' 806 | $(HIDE)$(COQDEP) -vos -dyndep var $(VDFILE_FLAGS) $(redir_if_ok) 807 | 808 | # Misc ######################################################################## 809 | 810 | byte: 811 | $(HIDE)$(MAKE) all "OPT:=-byte" -f "$(SELF)" 812 | .PHONY: byte 813 | 814 | opt: 815 | $(HIDE)$(MAKE) all "OPT:=-opt" -f "$(SELF)" 816 | .PHONY: opt 817 | 818 | # This is deprecated. To extend this makefile use 819 | # extension points and CoqMakefile.local 820 | printenv:: 821 | $(warning printenv is deprecated) 822 | $(warning write extensions in CoqMakefile.local or include CoqMakefile.conf) 823 | @echo 'LOCAL = $(LOCAL)' 824 | @echo 'COQLIB = $(COQLIB)' 825 | @echo 'DOCDIR = $(DOCDIR)' 826 | @echo 'OCAMLFIND = $(OCAMLFIND)' 827 | @echo 'HASNATDYNLINK = $(HASNATDYNLINK)' 828 | @echo 'SRC_SUBDIRS = $(SRC_SUBDIRS)' 829 | @echo 'COQ_SRC_SUBDIRS = $(COQ_SRC_SUBDIRS)' 830 | @echo 'OCAMLFIND = $(OCAMLFIND)' 831 | @echo 'PP = $(PP)' 832 | @echo 'COQFLAGS = $(COQFLAGS)' 833 | @echo 'COQLIB = $(COQLIBS)' 834 | @echo 'COQLIBINSTALL = $(COQLIBINSTALL)' 835 | @echo 'COQDOCINSTALL = $(COQDOCINSTALL)' 836 | .PHONY: printenv 837 | 838 | # Generate a .merlin file. If you need to append directives to this 839 | # file you can extend the merlin-hook target in CoqMakefile.local 840 | .merlin: 841 | $(SHOW)'FILL .merlin' 842 | $(HIDE)echo 'FLG $(COQMF_CAMLFLAGS)' > .merlin 843 | $(HIDE)echo 'B $(COQLIB)' >> .merlin 844 | $(HIDE)echo 'S $(COQLIB)' >> .merlin 845 | $(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \ 846 | echo 'B $(COQLIB)$(d)' >> .merlin;) 847 | $(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \ 848 | echo 'S $(COQLIB)$(d)' >> .merlin;) 849 | $(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'B $(d)' >> .merlin;) 850 | $(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'S $(d)' >> .merlin;) 851 | $(HIDE)$(MAKE) merlin-hook -f "$(SELF)" 852 | .PHONY: merlin 853 | 854 | merlin-hook:: 855 | @# Extension point 856 | .PHONY: merlin-hook 857 | 858 | # prints all variables 859 | debug: 860 | $(foreach v,\ 861 | $(sort $(filter-out $(INITIAL_VARS) INITIAL_VARS,\ 862 | $(.VARIABLES))),\ 863 | $(info $(v) = $($(v)))) 864 | .PHONY: debug 865 | 866 | .DEFAULT_GOAL := all 867 | 868 | # Local Variables: 869 | # mode: makefile-gmake 870 | # End: 871 | -------------------------------------------------------------------------------- /CoqMakefile.conf: -------------------------------------------------------------------------------- 1 | # This configuration file was generated by running: 2 | # coq_makefile -f _CoqProject -o CoqMakefile 3 | 4 | 5 | ############################################################################### 6 | # # 7 | # Project files. # 8 | # # 9 | ############################################################################### 10 | 11 | COQMF_VFILES = SK.v terms.v rewriting_theorems.v types.v subtypes.v derive.v typed_lambda.v typed_recursion.v typed_triage.v typed_evaluator.v classify.v classify_derive.v reduction_preserves_typing.v 12 | COQMF_MLIFILES = 13 | COQMF_MLFILES = 14 | COQMF_MLGFILES = 15 | COQMF_MLPACKFILES = 16 | COQMF_MLLIBFILES = 17 | COQMF_CMDLINE_VFILES = 18 | 19 | ############################################################################### 20 | # # 21 | # Path directives (-I, -R, -Q). # 22 | # # 23 | ############################################################################### 24 | 25 | COQMF_OCAMLLIBS = 26 | COQMF_SRC_SUBDIRS = 27 | COQMF_COQLIBS = -R . Triage 28 | COQMF_COQLIBS_NOML = -R . Triage 29 | COQMF_CMDLINE_COQLIBS = 30 | 31 | ############################################################################### 32 | # # 33 | # Coq configuration. # 34 | # # 35 | ############################################################################### 36 | 37 | COQMF_LOCAL=0 38 | COQMF_COQLIB=/opt/local/lib/coq/ 39 | COQMF_DOCDIR=/opt/local/share/doc/coq/ 40 | COQMF_OCAMLFIND=/opt/local/bin/ocamlfind 41 | COQMF_CAMLFLAGS=-thread -rectypes -w +a-4-9-27-41-42-44-45-48-58-67 -safe-string -strict-sequence 42 | COQMF_WARN=-warn-error +a-3 43 | COQMF_HASNATDYNLINK=true 44 | COQMF_COQ_SRC_SUBDIRS=config lib clib kernel library engine pretyping interp gramlib gramlib/.pack parsing proofs tactics toplevel printing ide stm vernac plugins/btauto plugins/cc plugins/derive plugins/extraction plugins/firstorder plugins/funind plugins/ltac plugins/micromega plugins/nsatz plugins/omega plugins/ring plugins/rtauto plugins/ssr plugins/ssrmatching plugins/ssrsearch plugins/syntax 45 | COQMF_COQ_NATIVE_COMPILER_DEFAULT=ondemand 46 | COQMF_WINDRIVE= 47 | 48 | ############################################################################### 49 | # # 50 | # Extra variables. # 51 | # # 52 | ############################################################################### 53 | 54 | COQMF_OTHERFLAGS = 55 | COQMF_INSTALLCOQDOCROOT = Triage 56 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2024 Barry Jay 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Makefile originally taken from coq-club 2 | 3 | %: Makefile.coq phony 4 | +make -f Makefile.coq $@ 5 | 6 | all: Makefile.coq 7 | +make -f Makefile.coq all 8 | 9 | clean: Makefile.coq 10 | +make -f Makefile.coq clean 11 | rm -f Makefile.coq 12 | 13 | Makefile.coq: _CoqProject Makefile 14 | coq_makefile -f _CoqProject | sed 's/$$(COQCHK) $$(COQCHKFLAGS) $$(COQLIBS)/$$(COQCHK) $$(COQCHKFLAGS) $$(subst -Q,-R,$$(COQLIBS))/' > Makefile.coq 15 | 16 | _CoqProject: ; 17 | 18 | Makefile: ; 19 | 20 | phony: ; 21 | 22 | .PHONY: all clean phony 23 | -------------------------------------------------------------------------------- /Makefile.coq: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/Makefile.coq -------------------------------------------------------------------------------- /PEPM25_slides.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/PEPM25_slides.pdf -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | This directory contains the Coq verification of the theorems in the 2 | paper "Typed Program Analysis Without Encodings" written by Barry Jay. 3 | Theorem names are identical in the paper and this implementation. 4 | The list of source files can be found in _CoqProject, used by the make files to do the verification. 5 | The directoty also includes some experimental files that are not used in the paper 6 | (and won't compile if you try). 7 | 8 | terms.v covers all of the examples and their behaviour under reduction. 9 | rewriting_theorems.v covers the properties of rewriting required to show 10 | that bf represents the breadth-first evaluation strategy. 11 | types.v introduces the types and handles the deBruijn indices 12 | subtypes.v introduces subtyping 13 | derive.v introduces type derivation 14 | typed_lambda.v, typed_recursion.v, typed_triage.v, and typed_evaluator.v 15 | type all of the examples 16 | classify.v classifies subtyping according to the structure of the subtype 17 | classify_derive.v classifies type derivations 18 | reduction_preserves_typing.v shows that reduction preserves typing 19 | 20 | 21 | 25-01-09 has improved the style of all proofs by using more hooks. 22 | 23 | The branch optimised_terms optimises the definitions of fixpoint functions, 24 | which then requires modifications to the subtyping relation to ensure that reduction preserves typing. 25 | 26 | 25-01-22 Uploaded slides from my talk at PEPM'25 as PEPM25_slides.pdf 27 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | This directory contains the Coq verification of the theorems in the 2 | paper "Typed Program Analysis Without Encodings" written by Barry Jay. 3 | Theorem names are identical in the paper and this implementation. 4 | The list of source files can be found in _CoqProject, used by the make files to do the verification. 5 | The directoty also includes some experimental files that are not used in the paper 6 | (and won't compile if you try). 7 | 8 | terms.v covers all of the examples and their behaviour under reduction. 9 | rewriting_theorems.v covers the properties of rewriting required to show 10 | that bf represents the breadth-first evaluation strategy. 11 | types.v introduces the types and handles the deBruijn indices 12 | subtypes.v introduces subtyping 13 | derive.v introduces type derivation 14 | typed_lambda.v, typed_recursion.v, typed_triage.v, and typed_evaluator.v 15 | type all of the examples 16 | classify.v classifies subtyping according to the structure of the subtype 17 | classify_derive.v classifies type derivations 18 | reduction_preserves_typing.v shows that reduction preserves typing 19 | -------------------------------------------------------------------------------- /SK.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/SK.vo -------------------------------------------------------------------------------- /SK.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/SK.vok -------------------------------------------------------------------------------- /SK.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/SK.vos -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -R . Triage 2 | 3 | SK.v 4 | terms.v 5 | rewriting_theorems.v 6 | types.v 7 | subtypes.v 8 | derive.v 9 | typed_lambda.v 10 | typed_recursion.v 11 | typed_triage.v 12 | typed_evaluator.v 13 | classify.v 14 | classify_derive.v 15 | reduction_preserves_typing.v 16 | 17 | 18 | # coq_makefile -f _CoqProject -o CoqMakefile 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /classify.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/classify.vo -------------------------------------------------------------------------------- /classify.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/classify.vok -------------------------------------------------------------------------------- /classify.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/classify.vos -------------------------------------------------------------------------------- /classify_derive.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Classifying Derivation *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | 34 | 35 | Require Import String Arith Lia Bool List Nat. 36 | Require Import terms types subtypes derive classify. 37 | 38 | Open Scope string_scope. 39 | Open Scope nat_scope. 40 | 41 | Set Default Proof Using "Type". 42 | 43 | 44 | 45 | 46 | Proposition derive_ref_rev: 47 | forall gamma x ty, 48 | derive gamma (Ref x) ty -> 49 | exists ty0, get x gamma = Some ty0 /\ subtype ty0 ty. 50 | Proof. 51 | cut(forall gamma M ty, 52 | derive gamma M ty -> 53 | forall x, M = Ref x -> 54 | exists ty0, get x gamma = Some ty0 /\ subtype ty0 ty). 55 | intros; eapply H; eauto. 56 | intros gamma M ty d; induction d; intros; subst; try discriminate. 57 | inv_out H1. repeat eexists; auto_t. 58 | Qed. 59 | 60 | 61 | 62 | Proposition derive_leaf_rev: forall gamma ty, derive gamma Node ty -> subtype Leaf ty. 63 | Proof. 64 | cut(forall gamma M ty, derive gamma M ty -> M = Node -> subtype Leaf ty). 65 | intros; eapply H; eauto. 66 | intros gamma M ty d; induction d; intros; subst; try discriminate; auto. 67 | Qed. 68 | 69 | 70 | 71 | Proposition derive_stem_rev: 72 | forall gamma M ty, 73 | derive gamma M ty -> 74 | forall N, M = Node @ N -> exists ty1, derive gamma N ty1 /\ subtype (Stem ty1) ty. 75 | Proof. 76 | intros gamma M ty d; induction d; intros; subst; eauto; try discriminate. 77 | clear IHd1 IHd2; inv_out H. 78 | repeat eexists; eauto. 79 | assert(subtype Leaf (Funty u ty)) by (eapply derive_leaf_rev; eauto); no_quant. 80 | eelim (subtype_from_leafty2 nil); intros; eauto. split_all. no_quanta. 81 | eelim (subtype_from_quanta_funty); intros. 2: eapply H0. 2: instantiate(3:= true :: nil); auto. 82 | split_all. no_quanta. inv_out H2. 83 | eapply sub_trans; eauto. 84 | eapply sub_trans. eapply sub_stem; eauto. 85 | rewrite trim_stem. eapply stem_quant_commute. 86 | Qed. 87 | 88 | 89 | 90 | 91 | Proposition derive_fork_rev: 92 | forall gamma M ty, 93 | derive gamma M ty -> 94 | forall N P, 95 | M = Node @ N @ P -> 96 | ((exists ty1 ty2, derive gamma N ty1 /\ derive gamma P ty2 /\ subtype (Fork ty1 ty2) ty)). 97 | Proof. 98 | intros gamma M ty d; induction d; intros; subst; eauto; try discriminate. 99 | clear IHd1 IHd2; inv_out H. 100 | (* 1 *) 101 | assert(exists ty1, derive gamma N0 ty1 /\ subtype (Stem ty1) (Funty u ty)) 102 | by (eapply derive_stem_rev; eauto); no_quant. clear d1. 103 | assert(subtype (Fork x u) ty) by (eapply subtype_from_stemty_to_fun; eauto). 104 | repeat eexists; eauto; eapply sub_trans; eauto. 105 | Qed. 106 | 107 | 108 | Theorem derive_stem : 109 | forall gamma P ty, 110 | derive gamma (Node @ P) ty -> 111 | (exists k pty, derive gamma P (quant k pty) /\ subtype (quant k (Stem pty)) ty). 112 | Proof. 113 | cut(forall gamma M ty, 114 | derive gamma M ty -> 115 | forall P, M = Node @ P -> 116 | (exists k pty, derive gamma P (quant k pty) /\ subtype (quant k (Stem pty)) ty)). 117 | intros; eapply H; eauto. 118 | intros gamma M ty d; induction d; intros; subst; try discriminate. 119 | clear IHd1 IHd2; inv_out H. 120 | assert(subtype Leaf (Funty u ty)) by (eapply derive_leaf_rev; eauto); 121 | clear d1; disjunction_tac; no_quant. 122 | eelim (subtype_from_leafty2 nil); intros; eauto. split_all. no_quanta. 123 | eelim (subtype_from_quanta_funty); intros. 2: eapply H0. 2: instantiate(3:= true :: nil); auto. 124 | split_all. no_quanta. inv_out H2. 125 | exists 0; repeat eexists; eauto. 126 | eapply sub_trans; eauto. rewrite trim_stem. 127 | eapply sub_trans. eapply sub_stem. eauto. eapply stem_quant_commute. 128 | Qed. 129 | 130 | 131 | 132 | Theorem derive_fork : 133 | forall gamma P Q ty, 134 | derive gamma (Node @ P @ Q) ty -> 135 | ((exists scs kp pty scsq kq qty kr, 136 | derive gamma P (quant kp pty) /\ 137 | chip_count scs kp kq /\ 138 | derive gamma Q (quant kq qty) /\ 139 | chip_count scsq kq kr /\ 140 | subtype (quant kr (Fork (trim scsq (trim scs pty)) 141 | (trim scsq qty))) ty) 142 | ). 143 | Proof. 144 | cut(forall gamma M ty, 145 | derive gamma M ty -> 146 | forall P Q, 147 | M = (Node @ P @ Q) -> 148 | ((exists scs kp pty scsq kq qty kr, 149 | derive gamma P (quant kp pty) /\ 150 | chip_count scs kp kq /\ 151 | derive gamma Q (quant kq qty) /\ 152 | chip_count scsq kq kr /\ 153 | subtype (quant kr (Fork (trim scsq (trim scs pty)) 154 | (trim scsq qty))) ty)) 155 | ) 156 | . 157 | intros; eapply H; eauto. 158 | intros gamma M ty d; induction d; intros; subst; try discriminate. 159 | clear IHd1 IHd2. inv_out H. 160 | eelim derive_stem; intros; eauto; clear d1; disjunction_tac; no_quant. 161 | assert(subtype (Fork (quant x x0) u) ty). 162 | eapply subtype_from_stemty_to_fun; eapply sub_trans; [ eapply stem_quant_commute | eauto]. 163 | repeat eexists; eauto. 164 | 2: eapply derive_subtype; eauto; eapply subtype_lift. 165 | 1,2: eapply chip_count_nil. 166 | simpl. eapply sub_trans; eauto. 167 | eapply sub_trans. eapply subtype_quant_fork. 168 | eapply sub_fork. eapply sub_zero. eapply subtype_lift2. 169 | Qed. 170 | 171 | 172 | 173 | 174 | 175 | Theorem programs_have_principal_types: 176 | forall p, program p -> 177 | forall gamma ty, derive gamma p ty -> subtype (program_type p) ty. 178 | Proof. 179 | cut (forall n p, 180 | term_size p < n -> program p -> 181 | forall gamma ty, derive gamma p ty -> subtype (program_type p) ty). 182 | intros; eapply H; eauto. 183 | induction n; intros; try lia. 184 | inv_out H0; simpl. 185 | (* 3 *) 186 | eapply derive_leaf_rev; eauto. 187 | (* 2 *) 188 | eelim derive_stem_rev; intros. 2: eapply H1. 2: eauto. no_quant. clear H1. 189 | eapply sub_trans. eapply sub_stem. eapply IHn; simpl in *; eauto; try lia. auto. 190 | (* 1 *) 191 | eelim derive_fork_rev; intros. 2: eapply H1. 2: eauto. no_quant. 192 | eapply sub_trans. 2: eauto. 193 | simpl in *; eapply sub_fork; eapply IHn; eauto; lia. 194 | Qed. 195 | 196 | 197 | 198 | 199 | Theorem normal_types: forall gamma p ty, normal_type gamma p = Some ty -> derive gamma p ty. 200 | Proof. 201 | induction p; intros; inv_out H; auto_t. 202 | caseEq p1; intros; subst; try discriminate. 203 | caseEq (normal_type gamma p2); intros; rewrite H in *. 204 | inv_out H1. 205 | eapply derive_app. eapply derive_node. auto_t. eauto. discriminate. 206 | (* 1 *) 207 | caseEq t; intros; subst; try discriminate. 208 | caseEq (normal_type gamma t0); intros; rewrite H in *. 209 | caseEq (normal_type gamma p2); intros; rewrite H0 in *. 210 | inv_out H1. 211 | eapply derive_app. eapply derive_subtype. eapply IHp1. simpl. rewrite H. eauto. 212 | auto_t. 213 | eauto. 214 | 1,2: discriminate. 215 | Qed. 216 | 217 | 218 | Theorem principal_types: 219 | forall gamma p ty, normal_type gamma p = Some ty -> 220 | forall ty2, derive gamma p ty2 -> subtype ty ty2. 221 | Proof. 222 | induction p; intros. 223 | eelim derive_ref_rev; eauto; intros; split_all. 224 | simpl in *. rewrite H in *. inv_out H2. auto. 225 | simpl in *. inv_out H. eapply derive_leaf_rev; eauto. 226 | caseEq p1; intros; subst; simpl in *; try discriminate. 227 | caseEq (normal_type gamma p2); intros; rewrite H1 in *; inv_out H. 228 | eelim derive_stem_rev; intros. 2: eapply H0. 2: eauto. no_quant. 229 | eapply sub_trans; eauto. eapply sub_stem; auto. 230 | caseEq t; intros; subst; try discriminate. 231 | (* 1 *) 232 | eelim derive_fork_rev; intros. 2: eapply H0. 2: eauto. no_quant. 233 | caseEq (normal_type gamma t0); intros; rewrite H3 in *; inv_out H. 234 | caseEq (normal_type gamma p2); intros; rewrite H in *; inv_out H6. 235 | eelim derive_fork_rev; intros. 2: eapply H0. 2: eauto. no_quant. 236 | eapply sub_trans; eauto. eapply sub_fork; auto. 237 | assert(subtype (Stem d) (Stem x1)). eapply IHp1; eauto. 238 | eapply derive_app. eapply derive_node. eapply sub_leaf_fun. auto. 239 | eapply subtype_of_stemty; eauto. 240 | Qed. 241 | 242 | 243 | 244 | 245 | -------------------------------------------------------------------------------- /classify_derive.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/classify_derive.vo -------------------------------------------------------------------------------- /classify_derive.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/classify_derive.vok -------------------------------------------------------------------------------- /classify_derive.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/classify_derive.vos -------------------------------------------------------------------------------- /derive.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Type Derivation in Tree Calculus *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | 34 | Require Import String Arith Lia Bool List Nat Datatypes. 35 | Require Import terms types subtypes. 36 | 37 | 38 | Set Default Proof Using "Type". 39 | 40 | Open Scope string_scope. 41 | Open Scope nat_scope. 42 | 43 | 44 | 45 | 46 | (* Type derivation *) 47 | 48 | 49 | Inductive derive: list (string * dtype) -> Tree -> dtype -> Prop := 50 | | derive_ref : forall gamma x uty ty, get x gamma = Some uty -> subtype uty ty -> derive gamma (Ref x) ty 51 | | derive_node : forall gamma uty, subtype Leaf uty -> derive gamma Node uty 52 | | derive_app: forall gamma M N ty u, derive gamma M (Funty u ty) -> derive gamma N u -> derive gamma (M@N) ty 53 | . 54 | 55 | Global Hint Constructors derive: TreeHintDb. 56 | 57 | 58 | 59 | Theorem derive_subtype: 60 | forall gamma M ty1, derive gamma M ty1 -> forall ty2, subtype ty1 ty2 -> derive gamma M ty2. 61 | Proof. intros gamma M ty1 d; induction d; intros; auto_t. Qed. 62 | 63 | 64 | Lemma lift_rec_preserves_derive: 65 | forall gamma M ty, derive gamma M ty -> forall n k, derive (lift_rec_context n k gamma) M (lift_rec ty n k). 66 | Proof. 67 | intros gamma M ty d; induction d; intros; simpl; auto_t. 68 | - eapply derive_ref; simpl; eauto; [ 69 | rewrite get_lift_rec; rewrite H; eauto | 70 | eapply lift_rec_preserves_subtype; eauto]. 71 | - eapply derive_node; 72 | replace Leaf with (lift_rec Leaf n k) by auto; eapply lift_rec_preserves_subtype; eauto. 73 | Qed. 74 | 75 | Lemma derive_subst_rec: 76 | forall gamma M ty, 77 | derive gamma M ty -> 78 | forall u k, derive (subst_rec_context u k gamma) M (subst_rec ty u k). 79 | Proof. 80 | intros gamma M ty d; induction d; intros; simpl; auto_t. 81 | - eapply derive_ref; auto; [ 82 | rewrite get_subst_rec; rewrite H;auto | 83 | eapply subst_rec_preserves_subtype; eauto]. 84 | - eapply derive_node; 85 | replace Leaf with (subst_rec Leaf u k) by auto; eapply subst_rec_preserves_subtype; eauto. 86 | Qed. 87 | 88 | 89 | Theorem derive_generalisation: 90 | forall gamma M T, derive (lift_context 1 gamma) M T -> derive gamma M (Quant T). 91 | Proof. 92 | cut(forall gamma M T, derive gamma M T -> 93 | forall gamma1, gamma = (lift_context 1 gamma1) -> derive gamma1 M (Quant T)); 94 | [ intros; eapply H; eauto |]; 95 | intros gamma M T d; induction d; intros; subst; auto. 96 | - unfold lift_context in *; rewrite get_lift_rec in *; 97 | caseEq (get x gamma1); intros; rewrite H1 in *. 98 | + eapply derive_ref; eauto; inv_out H; eapply sub_trans; [ eapply sub_lift |]; 99 | eapply sub_quant; eauto. 100 | + discriminate. 101 | - eapply derive_node; eapply sub_trans; [ eapply sub_lift | eapply sub_quant; cbv; eauto]. 102 | - eapply derive_app; [ eapply derive_subtype; [ eapply IHd1; auto | apply sub_dist] | eapply IHd2; auto]. 103 | Qed. 104 | 105 | Corollary derive_generalisation_q: 106 | forall k gamma M T, derive (lift_context k gamma) M T -> derive gamma M (quant k T). 107 | Proof. 108 | induction k; intros. 109 | - rewrite lift_context_zero in *; auto. 110 | - simpl; replace (S k) with (k+1) in *; try lia; erewrite <- lift_rec_lift_context in *; [ 111 | eapply IHk; eapply derive_generalisation; unfold lift_context; rewrite lift_rec_lift_context in *; 112 | replace (1+k) with (k+1) by lia; auto; lia | 113 | apply 0 | lia]. 114 | Qed. 115 | 116 | 117 | Theorem derive_generalisation2: 118 | forall gamma M T, derive gamma M (Quant T) -> derive (lift_context 1 gamma) M T. 119 | Proof. 120 | intros; eapply derive_subtype. 121 | - eapply lift_rec_preserves_derive; eauto. 122 | - simpl; subst_tac; rewrite subst_rec_lift_rec0; rewrite lift_rec_null; eapply sub_zero. 123 | Qed. 124 | 125 | Corollary derive_generalisation2_q: 126 | forall k gamma M T, derive gamma M (quant k T) -> derive (lift_context k gamma) M T. 127 | Proof. 128 | induction k; intros; simpl in *. 129 | - rewrite lift_context_zero; auto. 130 | - assert(derive (lift_context k gamma) M (Quant T)). eapply IHk; eauto. 131 | replace (S k) with (1+k) by lia; erewrite <- lift_rec_lift_context; [ 132 | instantiate(1:= 0); eapply derive_generalisation2; eauto | 133 | apply 0 | lia]. 134 | Qed. 135 | 136 | 137 | Theorem derive_K: forall gamma uty vty, derive gamma K (Funty uty (Funty vty uty)). 138 | Proof. 139 | intros; eapply derive_subtype; [ 140 | eapply derive_app; eapply derive_node; [ eapply sub_leaf_fun | eapply sub_zero] 141 | | auto_t]. 142 | Qed. 143 | 144 | 145 | Lemma derive_K1: forall gamma M uty vty, derive gamma M uty -> derive gamma (K@M) (Funty vty uty). 146 | Proof. intros; eapply derive_app; [ eapply derive_K | eauto]. Qed. 147 | 148 | 149 | Theorem derive_S1 : forall gamma f uty vty wty, 150 | derive gamma f (Funty uty (Funty vty wty)) -> 151 | derive gamma (S1 f) (Funty (Funty uty vty) (Funty uty wty)). 152 | Proof. 153 | intros; eapply derive_app. 154 | - eapply derive_node; eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_funty_tac]; sub_fork2_tac. 155 | - eapply derive_app; eauto; eapply derive_node; simpl; eapply sub_leaf_fun. 156 | Qed. 157 | 158 | Theorem derive_S2 : forall gamma f g uty vty wty, 159 | derive gamma f (Funty uty (Funty vty wty)) -> derive gamma g (Funty uty vty) -> 160 | derive gamma (S1 f @ g) (Funty uty wty). 161 | Proof. intros; eapply derive_app; eauto; eapply derive_S1; eauto. Qed. 162 | 163 | Theorem derive_S : forall gamma uty vty wty, 164 | derive gamma Sop (Funty (Funty uty (Funty vty wty)) (Funty (Funty uty vty) (Funty uty wty))). 165 | Proof. 166 | intros; eapply derive_S2. 167 | - eapply derive_K1; eapply derive_node; auto_t. 168 | - eapply derive_node; auto_t. 169 | Qed. 170 | 171 | Theorem derive_I: forall gamma uty, derive gamma I (Funty uty uty). 172 | Proof. intros; eapply derive_S2; eapply derive_K. Unshelve. apply Leaf. Qed. 173 | 174 | 175 | Theorem derive_swap: 176 | forall gamma f u v w, derive gamma f (Funty u (Funty v w)) -> derive gamma (swap f) (Funty v (Funty u w)). 177 | Proof. 178 | intros; unfold swap; eapply derive_S2; [ eapply derive_K1; eapply derive_S1; eauto | eapply derive_K]. 179 | Qed. 180 | 181 | Theorem derive_wait: 182 | forall gamma M N uty k vty wty, 183 | derive gamma M (Funty uty (quant k (Funty vty wty))) -> derive gamma N uty -> 184 | derive gamma (wait M N) (quant k (Funty vty wty)). 185 | Proof. 186 | intros; unfold wait; eapply derive_generalisation_q; eapply derive_S2; [ | eapply derive_I]; 187 | eapply derive_S2; eapply derive_K1; eapply derive_generalisation2_q; 188 | eapply derive_subtype; eauto; [ | eapply subtype_lift]; 189 | eapply sub_trans; [ eapply subtype_lift |]; 190 | eapply subtype_quant; unfold lift; simpl; sub_fun_tac; eapply subtype_lift3. 191 | Qed. 192 | 193 | 194 | 195 | Theorem derive_wait2: 196 | forall gamma M N P u1 u2 u3 ty, 197 | derive gamma M (Funty u1 (Funty u2 (Funty u3 ty))) -> 198 | derive gamma N u1 -> derive gamma P u2 -> derive gamma (wait2 M N P) (Funty u3 ty). 199 | Proof. 200 | intros; eapply derive_S2; [ | eapply derive_I]; 201 | repeat eapply derive_S2; eapply derive_K1; eauto. 202 | Qed. 203 | 204 | 205 | Theorem derive_basic: 206 | (forall gamma uty vty, derive gamma K (Funty uty (Funty vty uty))) /\ 207 | (forall gamma uty vty wty, 208 | derive gamma Sop (Funty (Funty uty (Funty vty wty)) (Funty (Funty uty vty) (Funty uty wty)))) /\ 209 | (forall gamma uty, derive gamma I (Funty uty uty)) /\ 210 | (forall gamma f u v w, derive gamma f (Funty u (Funty v w)) -> derive gamma (swap f) (Funty v (Funty u w))) /\ 211 | (forall gamma M N uty k vty wty, 212 | derive gamma M (Funty uty (quant k (Funty vty wty))) -> derive gamma N uty -> 213 | derive gamma (wait M N) (quant k (Funty vty wty))) /\ 214 | (forall gamma M N P u1 u2 u3 ty, 215 | derive gamma M (Funty u1 (Funty u2 (Funty u3 ty))) -> 216 | derive gamma N u1 -> derive gamma P u2 -> derive gamma (wait2 M N P) (Funty u3 ty)). 217 | Proof. 218 | repeat split;[ eapply derive_K | eapply derive_S | eapply derive_I | eapply derive_swap 219 | | eapply derive_wait | eapply derive_wait2]. 220 | Qed. 221 | 222 | 223 | Theorem programs_have_types: forall p gamma, program p -> derive gamma p (program_type p). 224 | Proof. 225 | cut (forall n p gamma, term_size p < n -> program p -> derive gamma p (program_type p)); [ 226 | intros; eapply H; eauto |]; 227 | induction n; intros; try lia; inv_out H0; simpl; auto_t; simpl in *. 228 | - assert(derive gamma M (program_type M)); [ 229 | eapply IHn; eauto; lia | 230 | eapply derive_app; eauto; eapply derive_node; eapply sub_leaf_fun]. 231 | - assert(derive gamma M (program_type M)); [ 232 | eapply IHn; eauto; lia |]; 233 | assert(derive gamma N (program_type N)) by (eapply IHn; eauto; lia); 234 | repeat eapply derive_app; eauto; eapply derive_node; eapply subtype_leaf_fork. 235 | Qed. 236 | 237 | -------------------------------------------------------------------------------- /derive.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/derive.vo -------------------------------------------------------------------------------- /derive.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/derive.vok -------------------------------------------------------------------------------- /derive.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/derive.vos -------------------------------------------------------------------------------- /derive.v~: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Type Derivation in Tree Calculus *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | 34 | Require Import String Arith Lia Bool List Nat Datatypes. 35 | Require Import terms types subtypes. 36 | 37 | 38 | Set Default Proof Using "Type". 39 | 40 | Open Scope string_scope. 41 | Open Scope nat_scope. 42 | 43 | 44 | 45 | 46 | (* Type derivation *) 47 | 48 | 49 | Inductive derive: list (string * dtype) -> Tree -> dtype -> Prop := 50 | | derive_ref : forall gamma x uty ty, get x gamma = Some uty -> subtype uty ty -> derive gamma (Ref x) ty 51 | | derive_node : forall gamma uty, subtype Leaf uty -> derive gamma Node uty 52 | | derive_app: forall gamma M N ty u, derive gamma M (Funty u ty) -> derive gamma N u -> derive gamma (M@N) ty 53 | . 54 | 55 | Hint Constructors derive: TreeHintDb. 56 | 57 | 58 | 59 | Theorem derive_subtype: 60 | forall gamma M ty1, derive gamma M ty1 -> forall ty2, subtype ty1 ty2 -> derive gamma M ty2. 61 | Proof. intros gamma M ty1 d; induction d; intros; auto_t. Qed. 62 | 63 | 64 | Lemma lift_rec_preserves_derive: 65 | forall gamma M ty, derive gamma M ty -> forall n k, derive (lift_rec_context n k gamma) M (lift_rec ty n k). 66 | Proof. 67 | intros gamma M ty d; induction d; intros; simpl; auto_t. 68 | eapply derive_ref; simpl; eauto. rewrite get_lift_rec; rewrite H. eauto. 69 | eapply lift_rec_preserves_subtype; eauto. 70 | eapply derive_node. 71 | replace Leaf with (lift_rec Leaf n k) by auto; eapply lift_rec_preserves_subtype; eauto. 72 | Qed. 73 | 74 | Lemma derive_subst_rec: 75 | forall gamma M ty, 76 | derive gamma M ty -> 77 | forall u k, derive (subst_rec_context u k gamma) M (subst_rec ty u k). 78 | Proof. 79 | intros gamma M ty d; induction d; intros; simpl; auto_t. 80 | eapply derive_ref; auto. rewrite get_subst_rec; rewrite H;auto . 81 | eapply subst_rec_preserves_subtype; eauto. 82 | eapply derive_node. 83 | replace Leaf with (subst_rec Leaf u k) by auto; eapply subst_rec_preserves_subtype; eauto. 84 | Qed. 85 | 86 | 87 | Theorem derive_generalisation: 88 | forall gamma M T, derive (lift_context 1 gamma) M T -> derive gamma M (Quant T). 89 | Proof. 90 | cut(forall gamma M T, derive gamma M T -> 91 | forall gamma1, gamma = (lift_context 1 gamma1) -> derive gamma1 M (Quant T)). 92 | intros; eapply H; eauto. 93 | intros gamma M T d; induction d; intros; subst; auto. 94 | (* 4 *) 95 | unfold lift_context in *. rewrite get_lift_rec in *. 96 | caseEq (get x gamma1); intros; rewrite H1 in *. eapply derive_ref; eauto. 97 | inv_out H. eapply sub_trans. eapply sub_lift. eapply sub_quant; eauto. discriminate. 98 | (* 2 *) 99 | eapply derive_node. eapply sub_trans. eapply sub_lift. eapply sub_quant. cbv; eauto. 100 | (* 2 *) 101 | eapply derive_app. eapply derive_subtype. eapply IHd1; auto. apply sub_dist. eapply IHd2; auto. 102 | Qed. 103 | 104 | Corollary derive_generalisation_q: 105 | forall k gamma M T, derive (lift_context k gamma) M T -> derive gamma M (quant k T). 106 | Proof. 107 | induction k; intros. 108 | rewrite lift_context_zero in *; auto. 109 | simpl. replace (S k) with (k+1) in *; try lia. erewrite <- lift_rec_lift_context in *. 110 | eapply IHk. eapply derive_generalisation. unfold lift_context. rewrite lift_rec_lift_context in *. 111 | replace (1+k) with (k+1) by lia; auto. 112 | apply 0. 113 | instantiate(1:= 0). all: try lia. all: apply 0. 114 | Qed. 115 | 116 | 117 | Theorem derive_generalisation2: 118 | forall gamma M T, derive gamma M (Quant T) -> derive (lift_context 1 gamma) M T. 119 | Proof. 120 | intros. eapply derive_subtype. eapply lift_rec_preserves_derive; eauto. simpl. 121 | subst_tac. rewrite subst_rec_lift_rec0. rewrite lift_rec_null. eapply sub_zero. 122 | Qed. 123 | 124 | Corollary derive_generalisation2_q: 125 | forall k gamma M T, derive gamma M (quant k T) -> derive (lift_context k gamma) M T. 126 | Proof. 127 | induction k; intros; simpl in *. rewrite lift_context_zero; auto. 128 | assert(derive (lift_context k gamma) M (Quant T)). eapply IHk; eauto. 129 | replace (S k) with (1+k) by lia. erewrite <- lift_rec_lift_context. 130 | instantiate(1:= 0). eapply derive_generalisation2; eauto. 131 | apply 0. lia. 132 | Qed. 133 | 134 | 135 | Theorem derive_K: forall gamma uty vty, derive gamma K (Funty uty (Funty vty uty)). 136 | Proof. 137 | intros; eapply derive_subtype; [ 138 | eapply derive_app; eapply derive_node; [ eapply sub_leaf_fun | eapply sub_zero] 139 | | auto_t]. 140 | Qed. 141 | 142 | 143 | Lemma derive_K1: forall gamma M uty vty, derive gamma M uty -> derive gamma (K@M) (Funty vty uty). 144 | Proof. intros; eapply derive_app; [ eapply derive_K | eauto]. Qed. 145 | 146 | 147 | Theorem derive_S1 : forall gamma f uty vty wty, 148 | derive gamma f (Funty uty (Funty vty wty)) -> 149 | derive gamma (S1 f) (Funty (Funty uty vty) (Funty uty wty)). 150 | Proof. 151 | intros; eapply derive_app. 152 | 2: eapply derive_app; eauto; eapply derive_node; simpl; eapply sub_leaf_fun. 153 | eapply derive_node. eapply sub_trans. eapply subtype_leaf_fork. do 2 sub_funty_tac. sub_fork2_tac. 154 | Qed. 155 | 156 | Theorem derive_S2 : forall gamma f g uty vty wty, 157 | derive gamma f (Funty uty (Funty vty wty)) -> derive gamma g (Funty uty vty) -> 158 | derive gamma (S1 f @ g) (Funty uty wty). 159 | Proof. intros; eapply derive_app; eauto; eapply derive_S1; eauto. Qed. 160 | 161 | Theorem derive_S : forall gamma uty vty wty, 162 | derive gamma Sop (Funty (Funty uty (Funty vty wty)) (Funty (Funty uty vty) (Funty uty wty))). 163 | Proof. 164 | intros; eapply derive_S2. eapply derive_K1. 1,2: eapply derive_node. 165 | 2: eapply sub_leaf_fun. 166 | eapply sub_trans. eapply subtype_leaf_fork. do 2 sub_fun_tac. sub_fork2_tac. 167 | Qed. 168 | 169 | Theorem derive_I: forall gamma uty, derive gamma I (Funty uty uty). 170 | Proof. intros; eapply derive_S2; eapply derive_K. Unshelve. apply Leaf. Qed. 171 | 172 | 173 | Theorem derive_swap: 174 | forall gamma f u v w, derive gamma f (Funty u (Funty v w)) -> derive gamma (swap f) (Funty v (Funty u w)). 175 | Proof. 176 | intros; unfold swap. eapply derive_S2. rewrite String.eqb_refl. 177 | eapply derive_K1. 178 | eapply derive_app. eapply derive_node. eapply sub_trans. eapply subtype_leaf_fork. do 2 sub_fun_tac. 179 | all: cycle 1. 180 | eapply derive_app. eapply derive_node. eapply sub_leaf_fun. 181 | eapply derive_S2. eapply derive_K1. eauto. eapply derive_I. 182 | eapply derive_S2. eapply derive_K1. eapply derive_K. eapply derive_I. 183 | eapply sub_fork_stem. 184 | Qed. 185 | 186 | Theorem derive_wait: 187 | forall gamma M N uty k vty wty, 188 | derive gamma M (Funty uty (quant k (Funty vty wty))) -> derive gamma N uty -> 189 | derive gamma (wait M N) (quant k (Funty vty wty)). 190 | Proof. 191 | intros; unfold wait. 192 | eapply derive_generalisation_q. eapply derive_S2. 2: eapply derive_I. 193 | eapply derive_S2; eapply derive_K1; eapply derive_generalisation2_q; eapply derive_subtype; eauto. 194 | 2: eapply subtype_lift. eapply sub_trans. eapply subtype_lift. eapply subtype_quant. 195 | unfold lift; simpl; sub_fun_tac. eapply subtype_lift3. 196 | Qed. 197 | 198 | 199 | 200 | Theorem derive_wait2: 201 | forall gamma M N P u1 u2 u3 ty, 202 | derive gamma M (Funty u1 (Funty u2 (Funty u3 ty))) -> 203 | derive gamma N u1 -> derive gamma P u2 -> derive gamma (wait2 M N P) (Funty u3 ty). 204 | Proof. 205 | intros; eapply derive_S2. 2: eapply derive_I. 206 | repeat eapply derive_S2; eapply derive_K1; eauto. 207 | Qed. 208 | 209 | 210 | Theorem derive_basic: 211 | (forall gamma uty vty, derive gamma K (Funty uty (Funty vty uty))) /\ 212 | (forall gamma uty vty wty, 213 | derive gamma Sop (Funty (Funty uty (Funty vty wty)) (Funty (Funty uty vty) (Funty uty wty)))) /\ 214 | (forall gamma uty, derive gamma I (Funty uty uty)) /\ 215 | (forall gamma f u v w, derive gamma f (Funty u (Funty v w)) -> derive gamma (swap f) (Funty v (Funty u w))) /\ 216 | (forall gamma M N uty k vty wty, 217 | derive gamma M (Funty uty (quant k (Funty vty wty))) -> derive gamma N uty -> 218 | derive gamma (wait M N) (quant k (Funty vty wty))) /\ 219 | (forall gamma M N P u1 u2 u3 ty, 220 | derive gamma M (Funty u1 (Funty u2 (Funty u3 ty))) -> 221 | derive gamma N u1 -> derive gamma P u2 -> derive gamma (wait2 M N P) (Funty u3 ty)). 222 | Proof. 223 | repeat split;[ eapply derive_K | eapply derive_S | eapply derive_I | eapply derive_swap 224 | | eapply derive_wait | eapply derive_wait2]. 225 | Qed. 226 | 227 | 228 | Theorem programs_have_types: forall p gamma, program p -> derive gamma p (program_type p). 229 | Proof. 230 | cut (forall n p gamma, term_size p < n -> program p -> derive gamma p (program_type p)). 231 | intros; eapply H; eauto. 232 | induction n; intros; try lia. 233 | inv_out H0; simpl; auto_t; simpl in *. 234 | (* 2 *) 235 | assert(derive gamma M (program_type M)). eapply IHn; eauto; lia. 236 | eapply derive_app; eauto. eapply derive_node. eapply sub_leaf_fun. 237 | (* 1 *) 238 | assert(derive gamma M (program_type M)). eapply IHn; eauto; lia. 239 | assert(derive gamma N (program_type N)). eapply IHn; eauto; lia. 240 | repeat eapply derive_app; eauto. eapply derive_node. eapply subtype_leaf_fork. 241 | Unshelve. all: apply 0. 242 | Qed. 243 | 244 | -------------------------------------------------------------------------------- /lambda.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Lambda Abstraction *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | Require Import Arith Lia Bool List Nat Datatypes String. 34 | 35 | 36 | Set Default Proof Using "Type". 37 | 38 | Open Scope string_scope. 39 | 40 | 41 | 42 | (* 4.3: Variable Binding *) 43 | 44 | 45 | Fixpoint substitute M x N := 46 | match M with 47 | | Ref y => if eqb x y then N else Ref y 48 | | △ => △ 49 | | M1 @ M2 => (substitute M1 x N) @ (substitute M2 x N) 50 | end. 51 | 52 | Lemma substitute_app: 53 | forall M1 M2 x N, substitute (M1@ M2) x N = (substitute M1 x N) @ (substitute M2 x N). 54 | Proof. auto. Qed. 55 | 56 | Lemma substitute_node: 57 | forall x N, substitute △ x N = △. 58 | Proof. auto. Qed. 59 | 60 | 61 | 62 | Lemma substitute_preserves_t_red: 63 | forall M x N N', t_red N N' -> t_red (substitute M x N) (substitute M x N'). 64 | Proof. 65 | induction M; intros; simpl; zerotac; 66 | [ match goal with |- t_red (if ?b then _ else _) _ => caseEq b; intros; zerotac; auto end | 67 | apply preserves_app_t_red; auto]. 68 | Qed. 69 | 70 | 71 | (* Bracket Abstraction *) 72 | 73 | 74 | Fixpoint bracket x M := 75 | match M with 76 | | Ref y => if eqb x y then I else (K@ (Ref y)) 77 | | △ => K@ △ 78 | | App M1 M2 => S1 (bracket x M1) @ (bracket x M2) 79 | end 80 | . 81 | 82 | Theorem bracket_beta: forall M x N, t_red ((bracket x M) @ N) (substitute M x N). 83 | Proof. 84 | induction M; intros; unfold S1; simpl; 85 | [ match goal with |- t_red ((if ?b then _ else _) @ _) _ => case b; tree_red end | 86 | tree_red | 87 | unfold S1; eapply succ_red; auto_t; apply preserves_app_t_red; trtac; auto]; [ 88 | eapply IHM1 | 89 | eapply IHM2]. 90 | Qed. 91 | 92 | 93 | (* star abstraction *) 94 | 95 | 96 | Fixpoint occurs x M := 97 | match M with 98 | | Ref y => eqb x y 99 | | △ => false 100 | | M1@ M2 => (occurs x M1) || (occurs x M2) 101 | end. 102 | 103 | 104 | Lemma substitute_occurs_false: forall M x N, occurs x M = false -> substitute M x N = M. 105 | Proof. 106 | induction M; simpl; intros x N e; split_all; 107 | [ rewrite e; auto | rewrite orb_false_iff in *; rewrite IHM1; try tauto; rewrite IHM2; tauto]. 108 | Qed. 109 | 110 | 111 | Fixpoint star x M := (* no eta-contractions because argument types must be invariant *) 112 | match M with 113 | | Ref y => if eqb x y then I else (K@ (Ref y)) 114 | | △ => K@ △ 115 | | App M1 M2 => if occurs x (M1 @ M2) 116 | then S1 (star x M1) @ (star x M2) 117 | else K@ (M1 @ M2) 118 | end. 119 | 120 | Notation "\" := star : tree_scope. 121 | 122 | 123 | 124 | Theorem star_beta: forall M x N, t_red ((\x M) @ N) (substitute M x N). 125 | Proof. 126 | induction M as [s | | M1 ? M2]; intros x N; simpl; auto. 127 | caseEq (x=?s); intros; tree_red . 128 | tree_red. 129 | unfold S1; caseEq (occurs x M1 || occurs x M2); intros; trtac. apply preserves_app_t_red; auto. 130 | rewrite orb_false_iff in *; split_all; rewrite ! substitute_occurs_false; auto; zerotac. 131 | Qed. 132 | 133 | 134 | Theorem derive_star: 135 | forall M gamma x uty ty, derive ((x,uty) :: gamma) M ty -> derive gamma (star x M) (Funty uty ty). 136 | Proof. 137 | cut(forall M gamma0 ty, 138 | derive gamma0 M ty -> 139 | forall x uty gamma, gamma0 = ((x,uty)::gamma) -> derive gamma (star x M) (Funty uty ty)). 140 | intros; eapply H; eauto. 141 | intros M gamma0 ty d; induction d; intros; subst; simpl in *. 142 | (* 4 *) 143 | caseEq (x0=?x)%string; intros; subst; rewrite H1 in *. inv_out H. eapply derive_subtype. eapply derive_I. 144 | sub_fun_tac; auto. 145 | all: try (eapply derive_app; [ eapply derive_K | auto_t]). 146 | (* 1 *) 147 | caseEq N; intros; subst. 148 | (* 3 *) 149 | caseEq (x=? s)%string; intros. assert(x = s) by (eapply String.eqb_eq; eauto); subst. 150 | assert(subtype uty u) by (eapply derive_ref_sub; eauto); split_all. 151 | (* 4 *) 152 | caseEq (occurs s M); intros; simpl. 153 | eapply derive_S1. eauto. 154 | rewrite String.eqb_refl. eapply derive_subtype. eapply derive_I. sub_funty_tac. auto. 155 | rewrite String.eqb_refl. eapply derive_S1. eauto. eapply derive_subtype. eapply derive_I. 156 | sub_funty_tac. auto. 157 | (* 3 *) 158 | caseEq (occurs x M); intros; simpl; rewrite H. 159 | eapply derive_S1. eauto. 160 | eapply derive_K1. eapply derive_occurs_false; eauto. 161 | eapply derive_K1. eapply derive_app; eauto; eapply derive_occurs_false; eauto. 162 | (* 2 *) 163 | caseEq (occurs x M); intros; simpl. 164 | eapply derive_S1. eauto. eapply derive_K1. 165 | eapply derive_occurs_false; eauto. 166 | eapply derive_K1. eapply derive_app; eapply derive_occurs_false; eauto. 167 | (* 1 *) 168 | caseEq (occurs x M|| occurs x (t @ t0)); intros. 169 | eapply derive_S1. eapply IHd1; eauto. eapply IHd2; eauto. 170 | eapply derive_K1. eapply derive_occurs_false. 3: simpl; eauto. 171 | eapply derive_app; eauto. eauto. 172 | Qed. 173 | 174 | 175 | 176 | -------------------------------------------------------------------------------- /reduction_preserves_typing.glob: -------------------------------------------------------------------------------- 1 | DIGEST f5a36fa944a094da1b79c0a3538cc0f1 2 | FTriage.reduction_preserves_typing 3 | R2155:2160 Coq.Strings.String <> <> lib 4 | R2162:2166 Coq.Arith.Arith <> <> lib 5 | R2168:2170 Coq.micromega.Lia <> <> lib 6 | R2172:2175 Coq.Bool.Bool <> <> lib 7 | R2177:2180 Coq.Lists.List <> <> lib 8 | R2182:2184 Coq.Init.Nat <> <> lib 9 | R2186:2194 Coq.Init.Datatypes <> <> lib 10 | R2212:2216 Triage.terms <> <> lib 11 | R2218:2222 Triage.types <> <> lib 12 | R2224:2231 Triage.subtypes <> <> lib 13 | R2233:2238 Triage.derive <> <> lib 14 | R2240:2247 Triage.classify <> <> lib 15 | R2249:2263 Triage.classify_derive <> <> lib 16 | prf 2393:2408 <> derive_fork_leaf 17 | binder 2421:2425 <> gamma:1 18 | binder 2427:2427 <> N:2 19 | binder 2429:2431 <> vty:3 20 | binder 2433:2434 <> ty:4 21 | R2472:2475 Coq.Init.Logic <> ::type_scope:x_'->'_x not 22 | R2437:2442 Triage.derive <> derive ind 23 | R2444:2448 Triage.reduction_preserves_typing <> gamma:1 var 24 | R2452:2454 Triage.terms <> ::tree_scope:x_'@'_x not 25 | R2451:2451 Triage.terms <> K def 26 | R2455:2455 Triage.reduction_preserves_typing <> N:2 var 27 | R2459:2463 Triage.types <> Funty constr 28 | R2465:2467 Triage.reduction_preserves_typing <> vty:3 var 29 | R2469:2470 Triage.reduction_preserves_typing <> ty:4 var 30 | R2476:2481 Triage.derive <> derive ind 31 | R2483:2487 Triage.reduction_preserves_typing <> gamma:1 var 32 | R2489:2489 Triage.reduction_preserves_typing <> N:2 var 33 | R2491:2492 Triage.reduction_preserves_typing <> ty:4 var 34 | R2511:2511 Triage.terms <> K def 35 | R2529:2539 Triage.classify_derive <> derive_fork thm 36 | R2529:2539 Triage.classify_derive <> derive_fork thm 37 | R2586:2592 Triage.subtypes <> subtype ind 38 | R2594:2597 Triage.types <> Leaf constr 39 | R2600:2604 Triage.types <> quant def 40 | R2625:2639 Triage.classify_derive <> derive_leaf_rev thm 41 | R2586:2592 Triage.subtypes <> subtype ind 42 | R2594:2597 Triage.types <> Leaf constr 43 | R2600:2604 Triage.types <> quant def 44 | R2625:2639 Triage.classify_derive <> derive_leaf_rev thm 45 | R2679:2685 Triage.subtypes <> subtype ind 46 | R2688:2691 Triage.types <> Fork constr 47 | R2693:2696 Triage.types <> Leaf constr 48 | R2699:2703 Triage.types <> quant def 49 | R2714:2718 Triage.types <> Funty constr 50 | R2679:2685 Triage.subtypes <> subtype ind 51 | R2688:2691 Triage.types <> Fork constr 52 | R2693:2696 Triage.types <> Leaf constr 53 | R2699:2703 Triage.types <> quant def 54 | R2714:2718 Triage.types <> Funty constr 55 | R2740:2748 Triage.subtypes <> sub_trans constr 56 | R2740:2748 Triage.subtypes <> sub_trans constr 57 | R2775:2783 Triage.classify <> trim_fork thm 58 | R2775:2783 Triage.classify <> trim_fork thm 59 | R2775:2783 Triage.classify <> trim_fork thm 60 | R2795:2803 Triage.subtypes <> sub_trans constr 61 | R2795:2803 Triage.subtypes <> sub_trans constr 62 | R2830:2838 Triage.subtypes <> sub_trans constr 63 | R2830:2838 Triage.subtypes <> sub_trans constr 64 | R2851:2868 Triage.subtypes <> fork_quant_commute thm 65 | R2851:2868 Triage.subtypes <> fork_quant_commute thm 66 | R2878:2885 Triage.subtypes <> sub_fork constr 67 | R2878:2885 Triage.subtypes <> sub_fork constr 68 | R2895:2906 Triage.subtypes <> subtype_lift thm 69 | R2895:2906 Triage.subtypes <> subtype_lift thm 70 | R2916:2923 Triage.subtypes <> sub_zero constr 71 | R2916:2923 Triage.subtypes <> sub_zero constr 72 | R2936:2948 Triage.subtypes <> subtype_quant thm 73 | R2936:2948 Triage.subtypes <> subtype_quant thm 74 | R2958:2979 Triage.classify <> trim_preserves_subtype thm 75 | R2958:2979 Triage.classify <> trim_preserves_subtype thm 76 | R2989:2996 Triage.subtypes <> sub_fork constr 77 | R2989:2996 Triage.subtypes <> sub_fork constr 78 | R3009:3016 Triage.subtypes <> sub_zero constr 79 | R3009:3016 Triage.subtypes <> sub_zero constr 80 | R3028:3031 Triage.types <> lift def 81 | R3041:3049 Triage.subtypes <> sub_trans constr 82 | R3041:3049 Triage.subtypes <> sub_trans constr 83 | R3059:3084 Triage.subtypes <> lift_rec_preserves_subtype thm 84 | R3059:3084 Triage.subtypes <> lift_rec_preserves_subtype thm 85 | R3096:3104 Triage.subtypes <> sub_trans constr 86 | R3096:3104 Triage.subtypes <> sub_trans constr 87 | R3132:3139 Triage.subtypes <> sub_zero constr 88 | R3132:3139 Triage.subtypes <> sub_zero constr 89 | R3149:3161 Triage.subtypes <> subtype_lift3 thm 90 | R3149:3161 Triage.subtypes <> subtype_lift3 thm 91 | R3184:3197 Triage.derive <> derive_subtype thm 92 | R3184:3197 Triage.derive <> derive_subtype thm 93 | R3233:3264 Triage.classify <> subtype_from_fork_of_leaf_to_fun thm 94 | R3233:3264 Triage.classify <> subtype_from_fork_of_leaf_to_fun thm 95 | prf 3294:3309 <> derive_fork_stem 96 | binder 3322:3326 <> gamma:5 97 | binder 3328:3328 <> M:6 98 | binder 3330:3330 <> N:7 99 | binder 3332:3332 <> P:8 100 | binder 3334:3336 <> vty:9 101 | binder 3338:3339 <> ty:10 102 | R3397:3400 Coq.Init.Logic <> ::type_scope:x_'->'_x not 103 | R3346:3351 Triage.derive <> derive ind 104 | R3353:3357 Triage.reduction_preserves_typing <> gamma:5 var 105 | R3377:3379 Triage.terms <> ::tree_scope:x_'@'_x not 106 | R3364:3367 Triage.terms <> ::tree_scope:x_'@'_x not 107 | R3376:3376 Triage.terms <> ::tree_scope:x_'@'_x not 108 | R3360:3363 Triage.terms <> Node constr 109 | R3372:3374 Triage.terms <> ::tree_scope:x_'@'_x not 110 | R3368:3371 Triage.terms <> Node constr 111 | R3375:3375 Triage.reduction_preserves_typing <> M:6 var 112 | R3380:3380 Triage.reduction_preserves_typing <> N:7 var 113 | R3384:3388 Triage.types <> Funty constr 114 | R3390:3392 Triage.reduction_preserves_typing <> vty:9 var 115 | R3394:3395 Triage.reduction_preserves_typing <> ty:10 var 116 | R3419:3426 Coq.Init.Logic <> ::type_scope:x_'->'_x not 117 | R3401:3406 Triage.derive <> derive ind 118 | R3408:3412 Triage.reduction_preserves_typing <> gamma:5 var 119 | R3414:3414 Triage.reduction_preserves_typing <> P:8 var 120 | R3416:3418 Triage.reduction_preserves_typing <> vty:9 var 121 | R3427:3432 Triage.derive <> derive ind 122 | R3434:3438 Triage.reduction_preserves_typing <> gamma:5 var 123 | R3446:3449 Triage.terms <> ::tree_scope:x_'@'_x not 124 | R3455:3455 Triage.terms <> ::tree_scope:x_'@'_x not 125 | R3442:3444 Triage.terms <> ::tree_scope:x_'@'_x not 126 | R3441:3441 Triage.reduction_preserves_typing <> M:6 var 127 | R3445:3445 Triage.reduction_preserves_typing <> P:8 var 128 | R3451:3453 Triage.terms <> ::tree_scope:x_'@'_x not 129 | R3450:3450 Triage.reduction_preserves_typing <> N:7 var 130 | R3454:3454 Triage.reduction_preserves_typing <> P:8 var 131 | R3458:3459 Triage.reduction_preserves_typing <> ty:10 var 132 | R3513:3527 Triage.classify_derive <> derive_fork_rev thm 133 | R3513:3527 Triage.classify_derive <> derive_fork_rev thm 134 | R3591:3605 Triage.classify_derive <> derive_stem_rev thm 135 | R3591:3605 Triage.classify_derive <> derive_stem_rev thm 136 | R3665:3698 Triage.classify <> subtype_from_fork_of_stem_to_funty thm 137 | R3665:3698 Triage.classify <> subtype_from_fork_of_stem_to_funty thm 138 | R3721:3729 Triage.subtypes <> sub_trans constr 139 | R3746:3753 Triage.subtypes <> sub_fork constr 140 | R3770:3777 Triage.subtypes <> sub_zero constr 141 | R3721:3729 Triage.subtypes <> sub_trans constr 142 | R3746:3753 Triage.subtypes <> sub_fork constr 143 | R3770:3777 Triage.subtypes <> sub_zero constr 144 | R3810:3819 Triage.derive <> derive_app constr 145 | R3836:3849 Triage.derive <> derive_subtype thm 146 | R3867:3872 Triage.types <> quant0 thm 147 | R3903:3913 Triage.types <> quant_plus2 thm 148 | R3925:3933 Triage.subtypes <> sub_trans constr 149 | R3945:3957 Triage.subtypes <> subtype_quant thm 150 | R3998:4007 Triage.classify <> trim_funty thm 151 | R4042:4049 Triage.subtypes <> sub_zero constr 152 | R3810:3819 Triage.derive <> derive_app constr 153 | R3810:3819 Triage.derive <> derive_app constr 154 | R3810:3819 Triage.derive <> derive_app constr 155 | R3810:3819 Triage.derive <> derive_app constr 156 | R3810:3819 Triage.derive <> derive_app constr 157 | R3810:3819 Triage.derive <> derive_app constr 158 | R3810:3819 Triage.derive <> derive_app constr 159 | R3836:3849 Triage.derive <> derive_subtype thm 160 | R3836:3849 Triage.derive <> derive_subtype thm 161 | prf 4071:4091 <> derive_fork_fork_leaf 162 | binder 4104:4108 <> gamma:11 163 | binder 4110:4110 <> P:12 164 | binder 4112:4112 <> Q:13 165 | binder 4114:4114 <> M:14 166 | binder 4116:4116 <> N:15 167 | binder 4118:4119 <> ty:16 168 | R4182:4185 Coq.Init.Logic <> ::type_scope:x_'->'_x not 169 | R4126:4131 Triage.derive <> derive ind 170 | R4133:4137 Triage.reduction_preserves_typing <> gamma:11 var 171 | R4161:4163 Triage.terms <> ::tree_scope:x_'@'_x not 172 | R4144:4147 Triage.terms <> ::tree_scope:x_'@'_x not 173 | R4160:4160 Triage.terms <> ::tree_scope:x_'@'_x not 174 | R4140:4143 Triage.terms <> Node constr 175 | R4156:4158 Triage.terms <> ::tree_scope:x_'@'_x not 176 | R4152:4154 Triage.terms <> ::tree_scope:x_'@'_x not 177 | R4148:4151 Triage.terms <> Node constr 178 | R4155:4155 Triage.reduction_preserves_typing <> P:12 var 179 | R4159:4159 Triage.reduction_preserves_typing <> Q:13 var 180 | R4164:4164 Triage.reduction_preserves_typing <> M:14 var 181 | R4168:4172 Triage.types <> Funty constr 182 | R4174:4177 Triage.types <> Leaf constr 183 | R4179:4180 Triage.reduction_preserves_typing <> ty:16 var 184 | R4205:4212 Coq.Init.Logic <> ::type_scope:x_'->'_x not 185 | R4186:4191 Triage.derive <> derive ind 186 | R4193:4197 Triage.reduction_preserves_typing <> gamma:11 var 187 | R4199:4199 Triage.reduction_preserves_typing <> N:15 var 188 | R4201:4204 Triage.types <> Leaf constr 189 | R4213:4218 Triage.derive <> derive ind 190 | R4220:4224 Triage.reduction_preserves_typing <> gamma:11 var 191 | R4226:4226 Triage.reduction_preserves_typing <> P:12 var 192 | R4228:4229 Triage.reduction_preserves_typing <> ty:16 var 193 | R4284:4298 Triage.classify_derive <> derive_fork_rev thm 194 | R4284:4298 Triage.classify_derive <> derive_fork_rev thm 195 | R4362:4376 Triage.classify_derive <> derive_fork_rev thm 196 | R4362:4376 Triage.classify_derive <> derive_fork_rev thm 197 | R4438:4451 Triage.derive <> derive_subtype thm 198 | R4438:4451 Triage.derive <> derive_subtype thm 199 | R4471:4503 Triage.classify <> subtype_from_fork_of_fork_of_leaf thm 200 | R4471:4503 Triage.classify <> subtype_from_fork_of_fork_of_leaf thm 201 | R4513:4521 Triage.subtypes <> sub_trans constr 202 | R4538:4545 Triage.subtypes <> sub_fork constr 203 | R4562:4569 Triage.subtypes <> sub_zero constr 204 | R4513:4521 Triage.subtypes <> sub_trans constr 205 | R4538:4545 Triage.subtypes <> sub_fork constr 206 | R4562:4569 Triage.subtypes <> sub_zero constr 207 | prf 4592:4612 <> derive_fork_fork_stem 208 | binder 4625:4629 <> gamma:17 209 | binder 4631:4631 <> P:18 210 | binder 4633:4633 <> Q:19 211 | binder 4635:4635 <> M:20 212 | binder 4637:4637 <> N:21 213 | binder 4639:4641 <> zty:22 214 | binder 4643:4644 <> ty:23 215 | R4713:4716 Coq.Init.Logic <> ::type_scope:x_'->'_x not 216 | R4651:4656 Triage.derive <> derive ind 217 | R4658:4662 Triage.reduction_preserves_typing <> gamma:17 var 218 | R4686:4688 Triage.terms <> ::tree_scope:x_'@'_x not 219 | R4669:4672 Triage.terms <> ::tree_scope:x_'@'_x not 220 | R4685:4685 Triage.terms <> ::tree_scope:x_'@'_x not 221 | R4665:4668 Triage.terms <> Node constr 222 | R4681:4683 Triage.terms <> ::tree_scope:x_'@'_x not 223 | R4677:4679 Triage.terms <> ::tree_scope:x_'@'_x not 224 | R4673:4676 Triage.terms <> Node constr 225 | R4680:4680 Triage.reduction_preserves_typing <> P:18 var 226 | R4684:4684 Triage.reduction_preserves_typing <> Q:19 var 227 | R4689:4689 Triage.reduction_preserves_typing <> M:20 var 228 | R4693:4697 Triage.types <> Funty constr 229 | R4700:4703 Triage.types <> Stem constr 230 | R4705:4707 Triage.reduction_preserves_typing <> zty:22 var 231 | R4710:4711 Triage.reduction_preserves_typing <> ty:23 var 232 | R4742:4749 Coq.Init.Logic <> ::type_scope:x_'->'_x not 233 | R4717:4722 Triage.derive <> derive ind 234 | R4724:4728 Triage.reduction_preserves_typing <> gamma:17 var 235 | R4730:4730 Triage.reduction_preserves_typing <> N:21 var 236 | R4733:4736 Triage.types <> Stem constr 237 | R4738:4740 Triage.reduction_preserves_typing <> zty:22 var 238 | R4750:4755 Triage.derive <> derive ind 239 | R4757:4761 Triage.reduction_preserves_typing <> gamma:17 var 240 | R4763:4763 Triage.reduction_preserves_typing <> Q:19 var 241 | R4766:4770 Triage.types <> Funty constr 242 | R4772:4774 Triage.reduction_preserves_typing <> zty:22 var 243 | R4776:4777 Triage.reduction_preserves_typing <> ty:23 var 244 | R4836:4850 Triage.classify_derive <> derive_fork_rev thm 245 | R4836:4850 Triage.classify_derive <> derive_fork_rev thm 246 | R4914:4928 Triage.classify_derive <> derive_fork_rev thm 247 | R4914:4928 Triage.classify_derive <> derive_fork_rev thm 248 | R4991:5004 Triage.derive <> derive_subtype thm 249 | R4991:5004 Triage.derive <> derive_subtype thm 250 | R5042:5074 Triage.classify <> subtype_from_fork_of_fork_of_stem thm 251 | R5042:5074 Triage.classify <> subtype_from_fork_of_fork_of_stem thm 252 | R5086:5094 Triage.subtypes <> sub_trans constr 253 | R5111:5118 Triage.subtypes <> sub_fork constr 254 | R5135:5142 Triage.subtypes <> sub_zero constr 255 | R5086:5094 Triage.subtypes <> sub_trans constr 256 | R5111:5118 Triage.subtypes <> sub_fork constr 257 | R5135:5142 Triage.subtypes <> sub_zero constr 258 | prf 5165:5185 <> derive_fork_fork_fork 259 | binder 5198:5202 <> gamma:24 260 | binder 5204:5204 <> P:25 261 | binder 5206:5206 <> Q:26 262 | binder 5208:5208 <> M:27 263 | binder 5210:5210 <> N:28 264 | binder 5212:5215 <> zty1:29 265 | binder 5217:5220 <> zty2:30 266 | binder 5222:5223 <> ty:31 267 | R5298:5305 Coq.Init.Logic <> ::type_scope:x_'->'_x not 268 | R5230:5235 Triage.derive <> derive ind 269 | R5237:5241 Triage.reduction_preserves_typing <> gamma:24 var 270 | R5265:5267 Triage.terms <> ::tree_scope:x_'@'_x not 271 | R5248:5251 Triage.terms <> ::tree_scope:x_'@'_x not 272 | R5264:5264 Triage.terms <> ::tree_scope:x_'@'_x not 273 | R5244:5247 Triage.terms <> Node constr 274 | R5260:5262 Triage.terms <> ::tree_scope:x_'@'_x not 275 | R5256:5258 Triage.terms <> ::tree_scope:x_'@'_x not 276 | R5252:5255 Triage.terms <> Node constr 277 | R5259:5259 Triage.reduction_preserves_typing <> P:25 var 278 | R5263:5263 Triage.reduction_preserves_typing <> Q:26 var 279 | R5268:5268 Triage.reduction_preserves_typing <> M:27 var 280 | R5272:5276 Triage.types <> Funty constr 281 | R5279:5282 Triage.types <> Fork constr 282 | R5284:5287 Triage.reduction_preserves_typing <> zty1:29 var 283 | R5289:5292 Triage.reduction_preserves_typing <> zty2:30 var 284 | R5295:5296 Triage.reduction_preserves_typing <> ty:31 var 285 | R5337:5344 Coq.Init.Logic <> ::type_scope:x_'->'_x not 286 | R5306:5311 Triage.derive <> derive ind 287 | R5313:5317 Triage.reduction_preserves_typing <> gamma:24 var 288 | R5319:5319 Triage.reduction_preserves_typing <> N:28 var 289 | R5322:5325 Triage.types <> Fork constr 290 | R5327:5330 Triage.reduction_preserves_typing <> zty1:29 var 291 | R5332:5335 Triage.reduction_preserves_typing <> zty2:30 var 292 | R5345:5350 Triage.derive <> derive ind 293 | R5352:5356 Triage.reduction_preserves_typing <> gamma:24 var 294 | R5358:5358 Triage.reduction_preserves_typing <> M:27 var 295 | R5361:5365 Triage.types <> Funty constr 296 | R5367:5370 Triage.reduction_preserves_typing <> zty1:29 var 297 | R5373:5377 Triage.types <> Funty constr 298 | R5379:5382 Triage.reduction_preserves_typing <> zty2:30 var 299 | R5384:5385 Triage.reduction_preserves_typing <> ty:31 var 300 | R5451:5465 Triage.classify_derive <> derive_fork_rev thm 301 | R5451:5465 Triage.classify_derive <> derive_fork_rev thm 302 | R5529:5543 Triage.classify_derive <> derive_fork_rev thm 303 | R5529:5543 Triage.classify_derive <> derive_fork_rev thm 304 | R5606:5619 Triage.derive <> derive_subtype thm 305 | R5606:5619 Triage.derive <> derive_subtype thm 306 | R5670:5702 Triage.classify <> subtype_from_fork_of_fork_of_fork thm 307 | R5670:5702 Triage.classify <> subtype_from_fork_of_fork_of_fork thm 308 | R5714:5722 Triage.subtypes <> sub_trans constr 309 | R5739:5746 Triage.subtypes <> sub_fork constr 310 | R5763:5770 Triage.subtypes <> sub_zero constr 311 | R5714:5722 Triage.subtypes <> sub_trans constr 312 | R5739:5746 Triage.subtypes <> sub_fork constr 313 | R5763:5770 Triage.subtypes <> sub_zero constr 314 | prf 5788:5813 <> reduction_preserves_typing 315 | binder 5825:5829 <> gamma:32 316 | binder 5831:5831 <> M:33 317 | binder 5833:5834 <> ty:34 318 | R5854:5857 Coq.Init.Logic <> ::type_scope:x_'->'_x not 319 | R5837:5842 Triage.derive <> derive ind 320 | R5844:5848 Triage.reduction_preserves_typing <> gamma:32 var 321 | R5850:5850 Triage.reduction_preserves_typing <> M:33 var 322 | R5852:5853 Triage.reduction_preserves_typing <> ty:34 var 323 | binder 5865:5865 <> N:35 324 | R5878:5881 Coq.Init.Logic <> ::type_scope:x_'->'_x not 325 | R5868:5873 Triage.terms <> t_red1 ind 326 | R5875:5875 Triage.reduction_preserves_typing <> M:33 var 327 | R5877:5877 Triage.reduction_preserves_typing <> N:35 var 328 | R5882:5887 Triage.derive <> derive ind 329 | R5889:5893 Triage.reduction_preserves_typing <> gamma:32 var 330 | R5895:5895 Triage.reduction_preserves_typing <> N:35 var 331 | R5897:5898 Triage.reduction_preserves_typing <> ty:34 var 332 | R6024:6039 Triage.reduction_preserves_typing <> derive_fork_leaf thm 333 | R6024:6039 Triage.reduction_preserves_typing <> derive_fork_leaf thm 334 | R6058:6073 Triage.reduction_preserves_typing <> derive_fork_stem thm 335 | R6058:6073 Triage.reduction_preserves_typing <> derive_fork_stem thm 336 | R6102:6108 Triage.subtypes <> subtype ind 337 | R6110:6113 Triage.types <> Leaf constr 338 | R6129:6143 Triage.classify_derive <> derive_leaf_rev thm 339 | R6102:6108 Triage.subtypes <> subtype ind 340 | R6110:6113 Triage.types <> Leaf constr 341 | R6129:6143 Triage.classify_derive <> derive_leaf_rev thm 342 | R6164:6184 Triage.reduction_preserves_typing <> derive_fork_fork_leaf thm 343 | R6164:6184 Triage.reduction_preserves_typing <> derive_fork_fork_leaf thm 344 | R6195:6208 Triage.derive <> derive_subtype thm 345 | R6195:6208 Triage.derive <> derive_subtype thm 346 | R6245:6259 Triage.classify_derive <> derive_stem_rev thm 347 | R6245:6259 Triage.classify_derive <> derive_stem_rev thm 348 | R6297:6306 Triage.derive <> derive_app constr 349 | R6297:6306 Triage.derive <> derive_app constr 350 | R6330:6350 Triage.reduction_preserves_typing <> derive_fork_fork_stem thm 351 | R6330:6350 Triage.reduction_preserves_typing <> derive_fork_fork_stem thm 352 | R6360:6373 Triage.derive <> derive_subtype thm 353 | R6360:6373 Triage.derive <> derive_subtype thm 354 | R6391:6400 Triage.derive <> derive_app constr 355 | R6391:6400 Triage.derive <> derive_app constr 356 | R6412:6422 Triage.derive <> derive_node constr 357 | R6412:6422 Triage.derive <> derive_node constr 358 | R6458:6472 Triage.classify_derive <> derive_fork_rev thm 359 | R6458:6472 Triage.classify_derive <> derive_fork_rev thm 360 | R6510:6519 Triage.derive <> derive_app constr 361 | R6510:6519 Triage.derive <> derive_app constr 362 | R6540:6549 Triage.derive <> derive_app constr 363 | R6540:6549 Triage.derive <> derive_app constr 364 | R6572:6592 Triage.reduction_preserves_typing <> derive_fork_fork_fork thm 365 | R6572:6592 Triage.reduction_preserves_typing <> derive_fork_fork_fork thm 366 | R6602:6615 Triage.derive <> derive_subtype thm 367 | R6602:6615 Triage.derive <> derive_subtype thm 368 | R6633:6642 Triage.derive <> derive_app constr 369 | R6633:6642 Triage.derive <> derive_app constr 370 | R6654:6663 Triage.derive <> derive_app constr 371 | R6654:6663 Triage.derive <> derive_app constr 372 | R6675:6685 Triage.derive <> derive_node constr 373 | R6675:6685 Triage.derive <> derive_node constr 374 | R6695:6711 Triage.subtypes <> subtype_leaf_fork thm 375 | R6695:6711 Triage.subtypes <> subtype_leaf_fork thm 376 | R6748:6757 Triage.derive <> derive_app constr 377 | R6748:6757 Triage.derive <> derive_app constr 378 | R6798:6807 Triage.derive <> derive_app constr 379 | R6798:6807 Triage.derive <> derive_app constr 380 | -------------------------------------------------------------------------------- /reduction_preserves_typing.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Subject Reduction *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | Require Import String Arith Lia Bool List Nat Datatypes. 34 | Require Import terms types subtypes derive classify classify_derive. 35 | 36 | Set Default Proof Using "Type". 37 | 38 | 39 | 40 | (* Each reduction rule of tree calculus must be shown to preserve typing *) 41 | 42 | 43 | Proposition derive_fork_leaf : 44 | forall gamma N vty ty, derive gamma (K @ N) (Funty vty ty) -> derive gamma N ty. 45 | Proof. 46 | unfold K; intros. eelim derive_fork; intros; eauto; clear H; no_quant. 47 | assert(subtype Leaf (quant x0 x1)) by (eapply derive_leaf_rev; eauto); clear H; split_all. 48 | assert(subtype (Fork Leaf (quant x3 x4)) (Funty vty ty)). 49 | eapply sub_trans. 2: eauto. 50 | rewrite <- trim_fork. eapply sub_trans. 2: trim2_tac. 51 | eapply sub_trans. 2: eapply fork_quant_commute. eapply sub_fork. eapply subtype_lift. eapply sub_zero. 52 | eapply subtype_quant. eapply trim_preserves_subtype. eapply sub_fork. 2: eapply sub_zero. 53 | unfold lift; eapply sub_trans. eapply lift_rec_preserves_subtype. 54 | eapply sub_trans. eauto. trim2_tac. eapply sub_zero. eapply subtype_lift3. 55 | (* 1 *) 56 | eapply derive_subtype; eauto. clear H1 H3 H4. 57 | eapply subtype_from_fork_of_leaf_to_fun; eauto. 58 | Qed. 59 | 60 | 61 | Proposition derive_fork_stem : 62 | forall gamma M N P vty ty, 63 | derive gamma (Node @ (Node @ M) @ N) (Funty vty ty) -> derive gamma P vty -> 64 | derive gamma (M @ P @ (N @ P)) ty. 65 | Proof. 66 | intros gamma M N P vty ty d1 d2. 67 | eelim derive_fork_rev; intros. 2: eapply d1. 2:eauto. clear d1; no_quant. 68 | eelim derive_stem_rev; intros. 2: eapply H. 2:eauto. clear H; no_quant. 69 | eelim subtype_from_fork_of_stem_to_funty; intros. 70 | 2: eapply sub_trans; eauto; eapply sub_fork; eauto; eapply sub_zero. 71 | split_all. 72 | repeat eapply derive_app; eauto; eapply derive_subtype; eauto; rewrite quant0 at 1; trim2_tac; 73 | rewrite quant_plus2; (eapply sub_trans; [ eapply subtype_quant; eauto |]); 74 | trim2_tac; rewrite ! trim_funty; repeat (dist_tac; auto); eapply sub_zero. 75 | Qed. 76 | 77 | 78 | Proposition derive_fork_fork_leaf : 79 | forall gamma P Q M N ty, 80 | derive gamma (Node @ (Node @ P @ Q) @ M) (Funty Leaf ty) -> derive gamma N Leaf -> 81 | derive gamma P ty. 82 | Proof. 83 | intros gamma P Q M N vty d1 d2. 84 | eelim derive_fork_rev; intros. 2: eapply d1. 2: eauto. clear d1; no_quant. 85 | eelim derive_fork_rev; intros. 2: eapply H. 2: eauto. clear H; no_quant. 86 | eapply derive_subtype; eauto. 87 | eapply subtype_from_fork_of_fork_of_leaf. eapply sub_trans; eauto; eapply sub_fork; eauto; eapply sub_zero. 88 | Qed. 89 | 90 | 91 | Proposition derive_fork_fork_stem : 92 | forall gamma P Q M N zty ty, 93 | derive gamma (Node @ (Node @ P @ Q) @ M) (Funty (Stem zty) ty) -> derive gamma N (Stem zty) -> 94 | derive gamma Q (Funty zty ty). 95 | Proof. 96 | intros gamma P Q M N zty ty d1 d2. 97 | eelim derive_fork_rev; intros. 2: eapply d1. 2: eauto. clear d1; no_quant. 98 | eelim derive_fork_rev; intros. 2: eapply H. 2: eauto. clear H; no_quant. 99 | eapply derive_subtype; eauto. clear d2 H0 H1 H. 100 | eapply subtype_from_fork_of_fork_of_stem. 101 | eapply sub_trans; eauto; eapply sub_fork; eauto; eapply sub_zero. 102 | Qed. 103 | 104 | 105 | Proposition derive_fork_fork_fork : 106 | forall gamma P Q M N zty1 zty2 ty, 107 | derive gamma (Node @ (Node @ P @ Q) @ M) (Funty (Fork zty1 zty2) ty) -> 108 | derive gamma N (Fork zty1 zty2) -> 109 | derive gamma M (Funty zty1 (Funty zty2 ty)). 110 | Proof. 111 | intros gamma P Q M N zty1 zty2 ty d1 d2. 112 | eelim derive_fork_rev; intros. 2: eapply d1. 2: eauto. clear d1; no_quant. 113 | eelim derive_fork_rev; intros. 2: eapply H. 2: eauto. clear H; no_quant. 114 | eapply derive_subtype; eauto. clear gamma P Q M N d2 H H0 H1. 115 | eapply subtype_from_fork_of_fork_of_fork. 116 | eapply sub_trans; eauto; eapply sub_fork; eauto; eapply sub_zero. 117 | Qed. 118 | 119 | 120 | Theorem reduction_preserves_typing: 121 | forall gamma M ty, derive gamma M ty -> forall N, t_red1 M N -> derive gamma N ty. 122 | Proof. 123 | intros gamma M ty d; induction d; intros; try (inv_out H0; fail); inv_out H. 124 | (* 8 *) 125 | inv_out H1. 126 | eapply derive_fork_leaf; eauto. 127 | eapply derive_fork_stem; eauto. 128 | (* 5 *) 129 | assert(subtype Leaf u) by (eapply derive_leaf_rev; eauto). 130 | eapply derive_fork_fork_leaf. eapply derive_subtype; auto_t. auto_t. 131 | (* 4 *) 132 | eelim derive_stem_rev; intros; eauto; split_all. 133 | eapply derive_app. 2: eauto. 134 | eapply derive_fork_fork_stem. eapply derive_subtype; auto_t. eapply derive_app. 135 | eapply derive_node. auto_t. eauto. 136 | (* 3 *) 137 | eelim derive_fork_rev; intros; eauto; split_all. 138 | eapply derive_app. 2: eauto. eapply derive_app. 2: eauto. 139 | eapply derive_fork_fork_fork. eapply derive_subtype; auto_t. eapply derive_app. 140 | eapply derive_app. eapply derive_node. eapply subtype_leaf_fork. eauto. eauto. 141 | (* 2 *) 142 | eapply derive_app; [ eapply IHd1 | ]; eauto. 143 | eapply derive_app; eauto; eapply IHd2; auto. 144 | Qed. 145 | 146 | 147 | 148 | 149 | -------------------------------------------------------------------------------- /reduction_preserves_typing.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/reduction_preserves_typing.vo -------------------------------------------------------------------------------- /reduction_preserves_typing.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/reduction_preserves_typing.vok -------------------------------------------------------------------------------- /reduction_preserves_typing.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/reduction_preserves_typing.vos -------------------------------------------------------------------------------- /rewriting_theorems.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/rewriting_theorems.vo -------------------------------------------------------------------------------- /rewriting_theorems.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/rewriting_theorems.vok -------------------------------------------------------------------------------- /rewriting_theorems.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/rewriting_theorems.vos -------------------------------------------------------------------------------- /subtypes.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Subtyping *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | 34 | 35 | Require Import String Arith Lia Bool List Nat. 36 | Require Import terms types. 37 | 38 | Open Scope string_scope. 39 | Open Scope nat_scope. 40 | 41 | Set Default Proof Using "Type". 42 | 43 | 44 | (*** Subtyping *) 45 | 46 | 47 | Definition omega21_ty := program_type omega21. 48 | Definition omega22_ty := program_type omega22. 49 | Definition omega2_ty := (Fork (Stem omega21_ty) omega22_ty). 50 | 51 | Definition eval_ty := quant 1 (Funty (Var 0) (Asf (Var 0))). 52 | Definition eager_ty := quant 2 (Funty (Funty (Var 0) (Var 1)) (Funty (Var 0) (Var 1))). 53 | 54 | Definition bfff_aug uty := Fork (Stem (Fork Leaf eval_ty)) (Asf uty). 55 | Definition bffs_aug uty := Fork (Stem (Fork Leaf eager_ty)) (bfff_aug uty). 56 | 57 | 58 | Inductive subtype : dtype -> dtype -> Prop := 59 | (* a pre-order *) 60 | | sub_zero : forall ty, subtype ty ty 61 | | sub_trans : forall ty1 ty2 ty3, subtype ty1 ty2 -> subtype ty2 ty3 -> subtype ty1 ty3 62 | (* a congruence, except for contravariance in function types *) 63 | | sub_stem : forall uty1 uty2, subtype uty1 uty2 -> subtype (Stem uty1) (Stem uty2) 64 | | sub_fork : forall uty1 uty2 vty1 vty2, subtype uty1 uty2 -> subtype vty1 vty2 -> 65 | subtype (Fork uty1 vty1) (Fork uty2 vty2) 66 | | sub_asf : forall uty1 uty2, subtype uty1 uty2 -> subtype (Asf uty1) (Asf uty2) 67 | | sub_funty : forall uty1 uty2 vty1 vty2, subtype uty2 uty1 -> subtype vty1 vty2 -> 68 | subtype (Funty uty1 vty1) (Funty uty2 vty2) 69 | | sub_quant : forall vty1 vty2, subtype vty1 vty2 -> subtype (Quant vty1) (Quant vty2) 70 | (* commuting with quantifiers *) 71 | | sub_quant_stem: forall uty, subtype (Quant (Stem uty)) (Stem (Quant uty)) 72 | | sub_quant_fork: forall uty vty, subtype (Quant (Fork uty vty)) (Fork (Quant uty) (Quant vty)) 73 | | sub_quant_asf: forall uty, subtype (Quant (Asf uty)) (Asf (Quant uty)) 74 | | sub_dist: forall uty vty, subtype (Quant (Funty uty vty)) (Funty (Quant uty) (Quant vty)) 75 | (* instantiating and introducing quantifiers *) 76 | | sub_inst : forall ty u, subtype (Quant ty) (subst ty u) 77 | | sub_lift: forall ty, subtype ty (Quant (lift 1 ty)) 78 | (* building trees *) 79 | | sub_leaf_fun:forall uty, subtype Leaf (Funty uty (Stem uty)) 80 | | sub_stem_fun: forall uty vty, subtype (Stem uty) (Funty vty (Fork uty vty)) 81 | (* reduction rules *) 82 | | sub_fork_leaf: forall uty vty, subtype (Fork Leaf uty) (Funty vty uty) 83 | | sub_fork_stem: forall uty vty wty, 84 | subtype (Fork (Stem (Funty uty (Funty vty wty))) (Funty uty vty)) (Funty uty wty) 85 | | sub_fork_fork_leaf: forall uty vty wty, 86 | subtype (Fork (Fork uty vty) wty) (Funty Leaf uty) 87 | | sub_fork_fork_stem: 88 | forall uty vty1 vty2 wty, 89 | subtype (Fork (Fork uty (Funty vty1 vty2)) wty) (Funty (Stem vty1) vty2) 90 | | sub_fork_fork_fork: 91 | forall uty vty wty1 wty2 wty3, 92 | subtype (Fork (Fork uty vty) (Funty wty1 (Funty wty2 wty3))) (Funty (Fork wty1 wty2) wty3) 93 | (* recursion *) 94 | | sub_recursion: 95 | forall k uty vty, 96 | subtype omega2_ty 97 | (Funty 98 | omega2_ty 99 | (Funty 100 | (Funty (quant k (Funty uty vty)) (quant k (Funty uty vty))) 101 | (quant k (Funty uty vty)))) 102 | | sub_tree: forall ty uty, 103 | covariant ty -> 104 | subtype (Fork 105 | (Fork 106 | (subst ty Leaf) 107 | (quant 1 (Funty (Var 0) (subst (lift_rec ty 1 1) (Stem (Var 0)))))) 108 | (quant 109 | 2 110 | (Funty 111 | (Var 1) 112 | (Funty (Var 0) (subst (lift_rec ty 1 2) (Fork (Var 1) (Var 0))))) 113 | )) 114 | (Funty uty (subst ty uty)) 115 | | sub_to_asf: forall ty, subtype ty (Asf ty) 116 | | sub_from_asf: forall uty vty, subtype (Asf (Funty uty vty)) (Funty uty vty) 117 | | sub_bffs: forall uty vty, subtype (Fork (Stem (bffs_aug uty)) (Asf vty)) (Asf (Fork (Stem uty) vty)) 118 | | sub_bfff : forall uty vty wty, subtype (Fork (Fork uty (Asf vty)) (bfff_aug wty)) 119 | (Asf (Fork (Fork uty vty) wty)) 120 | . 121 | 122 | 123 | Global Hint Constructors subtype : TreeHintDb. 124 | 125 | 126 | Ltac var_tac := 127 | unfold subst, lift; refold lift_rec; refold subst_rec; 128 | repeat (rewrite subst_rec_lift_rec; [ | lia | lia]); 129 | repeat relocate_tac; repeat insert_Var_tac; 130 | unfold lift; rewrite ? lift_rec_null; try eapply sub_zero. 131 | 132 | Ltac sub_funty_tac := 133 | (eapply sub_funty; [ eapply sub_zero | ]) 134 | || (eapply sub_funty; [ | eapply sub_zero ]). 135 | 136 | 137 | Ltac subst_tac := eapply sub_trans; [ eapply sub_inst | var_tac]. 138 | 139 | 140 | 141 | Lemma subtype_quant: 142 | forall n uty vty, subtype uty vty -> subtype (quant n uty) (quant n vty). 143 | Proof. induction n; intros; simpl in *; auto; eapply IHn; auto_t. Qed. 144 | 145 | Lemma subtype_quanta: forall bs ty1 ty2, subtype ty1 ty2 -> subtype (quanta bs ty1) (quanta bs ty2). 146 | Proof. induction bs; intros; simpl; auto_t; caseEq a; intros; simpl; auto_t. Qed. 147 | 148 | Lemma subtype_dist: forall n uty vty, subtype (quant n (Funty uty vty)) (Funty (quant n uty) (quant n vty)). 149 | Proof. 150 | induction n; intros; simpl in *; try eapply sub_zero; 151 | eapply sub_trans; [ eapply subtype_quant; eapply sub_dist | apply IHn]. 152 | Qed. 153 | 154 | Lemma subtype_quant_to_quanta: forall bs ty, subtype (quant (quant_count bs) ty) (quanta bs ty). 155 | Proof. 156 | induction bs; intros; simpl; auto_t; caseEq a; intros; subst; simpl; auto; 157 | eapply sub_trans; [ eapply subtype_quant; eapply sub_to_asf | eauto]. 158 | Qed. 159 | 160 | 161 | Lemma lift_rec_preserves_subtype: 162 | forall ty1 ty2, subtype ty1 ty2 -> forall n k, subtype (lift_rec ty1 n k) (lift_rec ty2 n k). 163 | Proof. 164 | intros ty1 ty2 s; induction s; intros; refold lift_rec; try relocate_tac; 165 | unfold lift; rewrite ? lift_lift_rec; try lia; eauto 2 with TreeHintDb. 166 | - subst_tac; replace n with (0+n) at 2 by lia; rewrite lift_rec_subst_rec; var_tac. 167 | - replace (lift_rec omega2_ty n k0) with omega2_ty by (cbv; auto); 168 | rewrite ! lift_rec_preserves_quant; eapply sub_recursion. 169 | - var_tac; 170 | eapply sub_trans; [ 171 | eapply sub_trans; [ | eapply sub_tree] | 172 | sub_funty_tac; unfold subst; replace n with (0+n) at 2 by lia; rewrite lift_rec_subst_rec; eapply sub_zero]; [ 173 | | 174 | unfold covariant in *; simpl; replace 0 with (relocate 0 (S n) k) by auto; 175 | rewrite lift_rec_preserves_variant; auto]; 176 | eapply sub_fork; [ eapply sub_fork; [ 177 | simpl; unfold subst; replace n with (0+n) at 1 by lia; rewrite lift_rec_subst_rec; eapply sub_zero | 178 | simpl; var_tac; replace (S n) with (0+ S n) at 1 by lia; 179 | rewrite lift_rec_subst_rec; try lia; simpl; 180 | rewrite (lift_lift_rec); try lia; var_tac] | ]; 181 | unfold subst; simpl; var_tac; replace (S (S n)) with (0+ S (S n)) at 1 by lia; 182 | rewrite lift_rec_subst_rec; try lia; simpl; var_tac; 183 | replace (S (S (S n))) with (2 + S n) by lia; rewrite (lift_lift_rec); try lia; var_tac. 184 | - unfold bffs_aug, bfff_aug; simpl; var_tac; eapply sub_bffs. 185 | - unfold bffs_aug, bfff_aug; simpl; var_tac; eapply sub_bfff. 186 | Qed. 187 | 188 | 189 | Lemma subst_rec_preserves_subtype: 190 | forall uty vty, subtype uty vty -> forall ty k, subtype (subst_rec uty ty k) (subst_rec vty ty k). 191 | Proof. 192 | intros ty1 ty2 s; induction s; intros; unfold lift; 193 | refold subst_rec; try insert_Var_tac; 194 | unfold lift; rewrite ? subst_rec_lift_rec1; try lia; eauto 2 with TreeHintDb. 195 | - subst_tac; eapply sub_trans; [ | rewrite subst_rec_subst_rec; try lia]; eapply sub_zero. 196 | - replace (subst_rec omega2_ty ty k0) with omega2_ty by (cbv; auto); 197 | rewrite ! subst_rec_preserves_quant; eapply sub_recursion. 198 | - unfold subst; rewrite subst_rec_subst_rec; try lia; 199 | replace (k-0) with k by lia; 200 | eapply sub_trans; [ eapply sub_trans; [ | eapply sub_tree] |]; [ 201 | eapply sub_fork; [ 202 | eapply sub_fork; [ 203 | simpl; eapply sub_zero | 204 | simpl; var_tac; rewrite subst_rec_subst_rec; try lia; simpl; var_tac; 205 | rewrite subst_rec_lift_rec1; try lia; simpl; eapply sub_zero] |]; 206 | simpl; var_tac; rewrite subst_rec_subst_rec; try lia; simpl; var_tac; 207 | replace (S (S (S k))) with (2 + S k) by lia; 208 | rewrite subst_rec_lift_rec1; try lia; simpl; eapply sub_zero | 209 | unfold covariant in *; replace k with (k+0) by lia; rewrite variant_subst_rec_miss; auto | 210 | sub_funty_tac; unfold subst; rewrite (subst_rec_subst_rec _ uty); try lia; 211 | replace (k-0) with k by lia; eapply sub_zero]. 212 | - unfold bffs_aug, bfff_aug; simpl; var_tac; eapply sub_bffs. 213 | - unfold bffs_aug, bfff_aug; simpl; var_tac; eapply sub_bfff. 214 | Qed. 215 | 216 | 217 | Lemma subtype_lift: forall n ty, subtype ty (quant n (lift n ty)). 218 | Proof. 219 | induction n; intros; subst; simpl. 220 | - unfold lift; rewrite lift_rec_null; auto_t. 221 | - replace (S n) with (1+n) by auto; eapply sub_trans; [ 222 | eapply sub_lift | ]; 223 | replace (quant n (Quant (lift (1+n) ty))) with (quant n (lift n (Quant (lift 1 ty)))); [ 224 | eapply IHn | 225 | unfold lift; simpl; rewrite lift_rec_lift_rec; try lia; repeat f_equal; lia]. 226 | Qed. 227 | 228 | 229 | Lemma subtype_lift2 : forall n ty, subtype (quant n (lift n ty)) ty. 230 | Proof. 231 | induction n; intros. 232 | - unfold lift; rewrite lift_rec_null; simpl; apply sub_zero. 233 | - unfold lift; simpl; replace (S n) with (1+n) by lia; erewrite <- lift_rec_lift_rec. 234 | + instantiate(1:= 0); eapply sub_trans; [ eapply subtype_quant; eapply sub_inst |]; 235 | unfold subst; rewrite subst_rec_lift_rec; try lia. 236 | rewrite lift_rec_null; eapply IHn. 237 | + lia. 238 | + lia. 239 | Unshelve. apply Leaf. 240 | Qed. 241 | 242 | 243 | Lemma subtype_lift3: forall (n : nat) (ty : dtype), subtype (lift n (quant n ty)) ty. 244 | Proof. 245 | induction n; intros; unfold lift; simpl. 246 | - rewrite lift_rec_null; apply sub_zero. 247 | - replace (S n) with (1+n) by lia; 248 | erewrite <- lift_rec_lift_rec. 249 | + replace (1+n) with (n+1) by lia; eapply sub_trans; [ 250 | eapply lift_rec_preserves_subtype; eapply IHn |]. 251 | simpl; eapply sub_trans; [ eapply sub_inst | ]; 252 | unfold subst; simpl; rewrite subst_rec_lift_rec0; try lia; 253 | rewrite lift_rec_null; apply sub_zero. 254 | + lia. 255 | + lia. 256 | Qed. 257 | 258 | Lemma subtype_lift4 : forall n ty, subtype (quant n (lift_rec ty n n)) ty. 259 | Proof. 260 | intros; 261 | replace (quant n (lift_rec ty n n)) with (lift n (quant n ty)) 262 | by (unfold lift; rewrite lift_rec_preserves_quant; f_equal; f_equal; lia); 263 | eapply subtype_lift3. 264 | Qed. 265 | 266 | 267 | Lemma subtype_quant_stem: forall k uty, subtype (quant k (Stem uty)) (Stem (quant k uty)). 268 | Proof. 269 | induction k; intros; simpl. 270 | - eapply sub_zero. 271 | - eapply sub_trans; [ eapply subtype_quant; eapply sub_quant_stem | eauto]. 272 | Qed. 273 | 274 | 275 | Lemma subtype_quant_fork: 276 | forall k uty vty, subtype (quant k (Fork uty vty)) (Fork (quant k uty) (quant k vty)). 277 | Proof. 278 | induction k; intros; simpl; try eapply sub_zero; 279 | eapply sub_trans; [ eapply subtype_quant; eapply sub_quant_fork | eauto]. 280 | Qed. 281 | 282 | 283 | 284 | Lemma asf_Quant_commute: forall ty, subtype (Asf (Quant ty)) (Quant (Asf ty)) . 285 | Proof. 286 | intros; eapply sub_trans; [ eapply sub_lift |]; 287 | eapply sub_quant; unfold lift; simpl; 288 | eapply sub_asf; eapply sub_trans; [ eapply sub_inst |]; 289 | unfold subst; simpl; erewrite subst_rec_lift_rec0; rewrite lift_rec_null; apply sub_zero. 290 | Qed. 291 | 292 | Lemma subtype_asf_quanta: forall bs ty, subtype (Asf (quanta bs ty)) (quanta bs (Asf ty)). 293 | Proof. 294 | induction bs; intros; simpl; auto_t; caseEq a; intros; simpl; [ 295 | eapply sub_trans; [ eapply IHbs |]; eapply subtype_quanta; eapply asf_Quant_commute | 296 | eapply IHbs]. 297 | Qed. 298 | 299 | Lemma subtype_quanta_asf: forall bs ty, subtype (quanta bs (Asf ty)) (Asf (quanta bs ty)) . 300 | Proof. 301 | induction bs; intros; simpl; auto_t; caseEq a; intros; simpl; [ 302 | eapply sub_trans; [ | eapply IHbs]; eapply subtype_quanta; eapply sub_quant_asf | 303 | eapply IHbs]. 304 | Qed. 305 | 306 | Lemma subtype_quant_asf: forall n ty, subtype (quant n (Asf ty)) (Asf (quant n ty)) . 307 | Proof. 308 | induction n; intros; simpl; auto_t; eapply sub_trans; [ | eapply IHn]; eapply subtype_quant; eapply sub_quant_asf. 309 | Qed. 310 | 311 | Lemma subtype_quanta_to_quant_count: 312 | forall bs bs2 uty vty, 313 | subtype (quanta bs (quanta bs2 (Funty uty vty))) (quant (quant_count bs) (quanta bs2 (Funty uty vty))). 314 | Proof. 315 | induction bs; intros; simpl; auto_t; caseEq a; intros; subst; simpl. 316 | - replace (Quant (quanta bs2 (Funty uty vty))) with (quanta (app bs2 (true :: nil)) (Funty uty vty)) by 317 | (rewrite quanta_app; simpl; auto); eapply IHbs. 318 | - replace (Asf (quanta bs2 (Funty uty vty))) with (quanta (app bs2 (false :: nil)) (Funty uty vty)) by 319 | (rewrite quanta_app; simpl; auto); 320 | eapply sub_trans; [ eapply IHbs |]; 321 | eapply subtype_quant; rewrite quanta_app; simpl; 322 | eapply sub_trans; [ eapply subtype_asf_quanta | eapply subtype_quanta; auto_t]. 323 | Qed. 324 | 325 | Lemma quanta_leaf: forall bs, subtype Leaf (quanta bs Leaf). 326 | Proof. 327 | induction bs; intros; simpl in *. 328 | - eapply sub_zero. 329 | - caseEq a; intros; subst; (eapply sub_trans; [ eapply IHbs | eapply subtype_quanta]). 330 | + replace Leaf with (lift 1 Leaf) at 2 by auto; eapply sub_lift. 331 | + auto_t. 332 | Qed. 333 | 334 | Lemma subtype_quant_to_quanta2: forall n ty, quant n ty = quanta (iter n (cons true) nil) ty. 335 | Proof. induction n; intros; simpl; auto. Qed. 336 | 337 | Lemma subtype_quant_quantf: forall m n ty, subtype (quant m (quantf n ty)) (quantf n (quant m ty)). 338 | Proof. 339 | induction m; intros; simpl; auto_t; eapply sub_trans; [ | eapply IHm]; 340 | eapply subtype_quant; 341 | clear; induction n; intros; simpl; auto_t; 342 | rewrite 2 quantf_succ; 343 | eapply sub_trans; [ eapply sub_quant_asf | eapply sub_asf; eauto]. 344 | Qed. 345 | 346 | Lemma subtype_quantf: forall n ty1 ty2, subtype ty1 ty2 -> subtype (quantf n ty1) (quantf n ty2). 347 | Proof. induction n; intros; simpl; auto_t. Qed. 348 | 349 | Lemma subtype_quantf_Quant: forall n ty, subtype (quantf n (Quant ty)) (Quant (quantf n ty)). 350 | Proof. 351 | intros; eapply sub_trans; [ eapply sub_lift |]; 352 | eapply sub_quant; 353 | unfold lift; rewrite lift_rec_preserves_quantf; eapply subtype_quantf; 354 | replace Quant with (quant 1) by auto; 355 | eapply subtype_lift3. 356 | Qed. 357 | 358 | 359 | 360 | Lemma subtype_leaf_fork: 361 | forall uty vty, subtype Leaf (Funty uty (Funty vty (Fork uty vty))). 362 | Proof. auto_t. Qed. 363 | 364 | 365 | 366 | 367 | Ltac fn_of_leaf_tac := eapply sub_trans; 368 | [ eapply sub_fork_leaf | repeat sub_funty_tac ]. 369 | 370 | Ltac sub_fork_tac := eapply sub_trans; [ eapply sub_fork ; [ eapply sub_stem |] | eapply sub_fork_stem]. 371 | Ltac stem_fork_tac := eapply sub_stem_fun. 372 | Ltac subtype_leaf_stem_tac := eapply sub_leaf_fun. 373 | Ltac subtype_leaf_fork_tac := eapply subtype_leaf_fork; repeat sub_funty_tac. 374 | Ltac dist_tac := eapply sub_trans; [ eapply subtype_dist | eapply sub_funty]. 375 | Ltac sub_fun_tac := (eapply sub_funty; [ eapply sub_zero | ]) || (eapply sub_funty; [ | eapply sub_zero ]) . 376 | 377 | Ltac qlift_tac:= 378 | eapply sub_trans; [ eapply subtype_quant; eapply sub_trans; [ eapply sub_lift | eapply sub_zero] |]. 379 | 380 | Ltac split_all := 381 | intros; 382 | match goal with 383 | | H:_ /\ _ |- _ => inversion_clear H; split_all 384 | | H:exists _, _ |- _ => inversion H; clear H; split_all 385 | | _ => try (split; split_all); subst; try contradiction 386 | end; try congruence. 387 | 388 | 389 | Ltac sub_fork2_tac := 390 | (eapply sub_zero 391 | || sub_fork_tac 392 | || fn_of_leaf_tac 393 | || sub_funty_tac 394 | || eapply sub_leaf_fun 395 | || eapply subtype_leaf_fork 396 | || stem_fork_tac 397 | || subtype_leaf_stem_tac); 398 | var_tac; repeat sub_funty_tac 399 | . 400 | 401 | 402 | Lemma stem_Quant_commute: forall ty, subtype (Stem (Quant ty)) (Quant (Stem ty)) . 403 | Proof. 404 | intros; eapply sub_trans; [ eapply sub_lift |]; 405 | eapply sub_quant; unfold lift; simpl; 406 | eapply sub_stem; 407 | eapply sub_trans; [ eapply sub_inst |]; 408 | unfold subst; simpl; erewrite subst_rec_lift_rec0; rewrite lift_rec_null; apply sub_zero. 409 | Qed. 410 | 411 | 412 | Lemma stem_quant_commute: forall k ty, subtype (Stem (quant k ty)) (quant k (Stem ty)) . 413 | Proof. 414 | induction k; intros; simpl; try eapply sub_zero; 415 | rewrite ! quant_succ; 416 | eapply sub_trans; [ eapply stem_Quant_commute |]; 417 | eapply sub_quant; eauto. 418 | Qed. 419 | 420 | 421 | Lemma asf_quant_commute: forall k ty, subtype (Asf (quant k ty)) (quant k (Asf ty)) . 422 | Proof. 423 | induction k; intros; simpl; try eapply sub_zero; 424 | rewrite ! quant_succ; 425 | eapply sub_trans; [ eapply asf_Quant_commute |]; 426 | eapply sub_quant; eauto. 427 | Qed. 428 | 429 | 430 | Lemma fork_Quant_commute: forall ty1 ty2, subtype (Fork (Quant ty1) (Quant ty2)) (Quant (Fork ty1 ty2)) . 431 | Proof. 432 | intros; eapply sub_trans; [ eapply sub_lift |]; 433 | eapply sub_quant; unfold lift; simpl; 434 | eapply sub_fork; (eapply sub_trans; [ eapply sub_inst | 435 | unfold subst; erewrite subst_rec_lift_rec0; rewrite lift_rec_null; apply sub_zero]). 436 | Qed. 437 | 438 | 439 | Lemma fork_quant_commute: 440 | forall k ty1 ty2, subtype (Fork(quant k ty1)(quant k ty2)) (quant k (Fork ty1 ty2)). 441 | Proof. 442 | induction k; intros; simpl; try eapply sub_zero; 443 | rewrite ! quant_succ; 444 | replace (S (k + S k)) with (2 + (k+k)) by lia; 445 | eapply sub_trans; [ eapply fork_Quant_commute |]; 446 | eapply sub_quant; eauto. 447 | Qed. 448 | 449 | 450 | Lemma subtype_quant_leaf: forall k, subtype (quant k Leaf) Leaf. 451 | Proof. 452 | induction k; intros; simpl; try eapply sub_zero; 453 | replace (S k) with (1+k) by lia; eapply sub_trans; [ eapply subtype_quant; eapply sub_inst | 454 | unfold subst; simpl; eauto]. 455 | Unshelve. apply Leaf. 456 | Qed. 457 | 458 | Lemma subtype_leaf_quant: forall k, subtype Leaf (quant k Leaf). 459 | Proof. 460 | induction k; intros; simpl; try eapply sub_zero; 461 | replace (S k) with (k+1) by lia; eapply sub_trans; [ eapply IHk | eapply subtype_quant; 462 | eapply sub_trans; [ eapply sub_lift | unfold lift; simpl; eapply sub_zero]]. 463 | Qed. 464 | 465 | 466 | 467 | Lemma subtype_Kty: forall uty vty, subtype (Stem Leaf) (Funty uty (Funty vty uty)). 468 | Proof. intros; auto_t. Qed. 469 | -------------------------------------------------------------------------------- /subtypes.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/subtypes.vo -------------------------------------------------------------------------------- /subtypes.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/subtypes.vok -------------------------------------------------------------------------------- /subtypes.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/subtypes.vos -------------------------------------------------------------------------------- /terms.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/terms.vo -------------------------------------------------------------------------------- /terms.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/terms.vok -------------------------------------------------------------------------------- /terms.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/terms.vos -------------------------------------------------------------------------------- /typed_evaluator.glob: -------------------------------------------------------------------------------- 1 | DIGEST d8f73cbbe9c2cecd26f3c39cd350d26b 2 | FTriage.typed_evaluator 3 | R2155:2160 Coq.Strings.String <> <> lib 4 | R2162:2166 Coq.Arith.Arith <> <> lib 5 | R2168:2170 Coq.micromega.Lia <> <> lib 6 | R2172:2175 Coq.Bool.Bool <> <> lib 7 | R2177:2180 Coq.Lists.List <> <> lib 8 | R2182:2184 Coq.Init.Nat <> <> lib 9 | R2186:2194 Coq.Init.Datatypes <> <> lib 10 | R2212:2216 Triage.terms <> <> lib 11 | R2218:2222 Triage.types <> <> lib 12 | R2224:2231 Triage.subtypes <> <> lib 13 | R2233:2238 Triage.derive <> <> lib 14 | R2240:2251 Triage.typed_lambda <> <> lib 15 | R2253:2264 Triage.typed_triage <> <> lib 16 | R2266:2280 Triage.typed_recursion <> <> lib 17 | def 2328:2337 <> eager_s_ty 18 | R2342:2346 Triage.types <> quant def 19 | R2351:2355 Triage.types <> Funty constr 20 | R2358:2360 Triage.types <> Var constr 21 | R2366:2370 Triage.types <> Funty constr 22 | R2373:2377 Triage.types <> Funty constr 23 | R2380:2382 Triage.types <> Var constr 24 | R2388:2390 Triage.types <> Var constr 25 | R2397:2399 Triage.types <> Var constr 26 | prf 2420:2433 <> derive_eager_s 27 | binder 2497:2501 <> gamma:1 28 | R2504:2509 Triage.derive <> derive ind 29 | R2511:2515 Triage.typed_evaluator <> gamma:1 var 30 | R2517:2523 Triage.terms <> eager_s def 31 | R2525:2534 Triage.typed_evaluator <> eager_s_ty def 32 | R2561:2583 Triage.derive <> derive_generalisation_q thm 33 | R2598:2602 Triage.types <> Funty constr 34 | R2605:2609 Triage.types <> Funty constr 35 | R2612:2614 Triage.types <> Var constr 36 | R2620:2622 Triage.types <> Var constr 37 | R2629:2631 Triage.types <> Var constr 38 | R2647:2651 Triage.types <> subst def 39 | R2654:2658 Triage.types <> Funty constr 40 | R2661:2665 Triage.types <> Funty constr 41 | R2668:2670 Triage.types <> Var constr 42 | R2676:2678 Triage.types <> Var constr 43 | R2685:2687 Triage.types <> Var constr 44 | R2694:2696 Triage.types <> Var constr 45 | R2729:2741 Triage.typed_triage <> derive_triage thm 46 | R2779:2783 Triage.types <> subst def 47 | R2823:2843 Triage.derive <> derive_generalisation thm 48 | R2858:2866 Triage.derive <> derive_S2 thm 49 | R2561:2583 Triage.derive <> derive_generalisation_q thm 50 | R2598:2602 Triage.types <> Funty constr 51 | R2605:2609 Triage.types <> Funty constr 52 | R2612:2614 Triage.types <> Var constr 53 | R2620:2622 Triage.types <> Var constr 54 | R2629:2631 Triage.types <> Var constr 55 | R2647:2651 Triage.types <> subst def 56 | R2654:2658 Triage.types <> Funty constr 57 | R2661:2665 Triage.types <> Funty constr 58 | R2668:2670 Triage.types <> Var constr 59 | R2676:2678 Triage.types <> Var constr 60 | R2685:2687 Triage.types <> Var constr 61 | R2694:2696 Triage.types <> Var constr 62 | R2729:2741 Triage.typed_triage <> derive_triage thm 63 | R2823:2843 Triage.derive <> derive_generalisation thm 64 | R2823:2843 Triage.derive <> derive_generalisation thm 65 | R2823:2843 Triage.derive <> derive_generalisation thm 66 | R2823:2843 Triage.derive <> derive_generalisation thm 67 | R2823:2843 Triage.derive <> derive_generalisation thm 68 | R2823:2843 Triage.derive <> derive_generalisation thm 69 | R2858:2866 Triage.derive <> derive_S2 thm 70 | R2858:2866 Triage.derive <> derive_S2 thm 71 | R2858:2866 Triage.derive <> derive_S2 thm 72 | R2880:2887 Triage.derive <> derive_I thm 73 | R2880:2887 Triage.derive <> derive_I thm 74 | R2901:2909 Triage.derive <> derive_K1 thm 75 | R2919:2929 Triage.derive <> derive_node constr 76 | R2901:2909 Triage.derive <> derive_K1 thm 77 | R2919:2929 Triage.derive <> derive_node constr 78 | R2952:2960 Triage.derive <> derive_K1 thm 79 | R2970:2979 Triage.derive <> derive_app constr 80 | R3007:3016 Triage.derive <> derive_app constr 81 | R3028:3038 Triage.derive <> derive_node constr 82 | R3048:3059 Triage.subtypes <> sub_leaf_fun constr 83 | R3070:3077 Triage.derive <> derive_I thm 84 | R3095:3105 Triage.derive <> derive_node constr 85 | R3115:3123 Triage.subtypes <> sub_trans constr 86 | R3135:3151 Triage.subtypes <> subtype_leaf_fork thm 87 | R2952:2960 Triage.derive <> derive_K1 thm 88 | R2970:2979 Triage.derive <> derive_app constr 89 | R3007:3016 Triage.derive <> derive_app constr 90 | R3028:3038 Triage.derive <> derive_node constr 91 | R3048:3059 Triage.subtypes <> sub_leaf_fun constr 92 | R3070:3077 Triage.derive <> derive_I thm 93 | R3095:3105 Triage.derive <> derive_node constr 94 | R3115:3123 Triage.subtypes <> sub_trans constr 95 | R3135:3151 Triage.subtypes <> subtype_leaf_fork thm 96 | R3200:3208 Triage.derive <> derive_S2 thm 97 | R3220:3228 Triage.derive <> derive_K1 thm 98 | R3238:3245 Triage.derive <> derive_K thm 99 | R3264:3272 Triage.derive <> derive_S2 thm 100 | R3284:3292 Triage.derive <> derive_K1 thm 101 | R3302:3312 Triage.derive <> derive_node constr 102 | R3322:3333 Triage.subtypes <> sub_leaf_fun constr 103 | R3344:3351 Triage.derive <> derive_I thm 104 | R3200:3208 Triage.derive <> derive_S2 thm 105 | R3220:3228 Triage.derive <> derive_K1 thm 106 | R3238:3245 Triage.derive <> derive_K thm 107 | R3264:3272 Triage.derive <> derive_S2 thm 108 | R3284:3292 Triage.derive <> derive_K1 thm 109 | R3302:3312 Triage.derive <> derive_node constr 110 | R3322:3333 Triage.subtypes <> sub_leaf_fun constr 111 | R3344:3351 Triage.derive <> derive_I thm 112 | R3366:3374 Triage.derive <> derive_K1 thm 113 | R3384:3393 Triage.derive <> derive_app constr 114 | R3417:3426 Triage.derive <> derive_app constr 115 | R3438:3448 Triage.derive <> derive_node constr 116 | R3458:3469 Triage.subtypes <> sub_leaf_fun constr 117 | R3480:3488 Triage.derive <> derive_K1 thm 118 | R3505:3514 Triage.derive <> derive_app constr 119 | R3526:3536 Triage.derive <> derive_node constr 120 | R3546:3557 Triage.subtypes <> sub_leaf_fun constr 121 | R3576:3585 Triage.derive <> derive_app constr 122 | R3596:3606 Triage.derive <> derive_node constr 123 | R3616:3627 Triage.subtypes <> sub_leaf_fun constr 124 | R3638:3645 Triage.derive <> derive_I thm 125 | R3663:3673 Triage.derive <> derive_node constr 126 | R3684:3692 Triage.subtypes <> sub_trans constr 127 | R3704:3720 Triage.subtypes <> subtype_leaf_fork thm 128 | R3771:3779 Triage.subtypes <> sub_trans constr 129 | R3790:3801 Triage.subtypes <> sub_stem_fun constr 130 | R3366:3374 Triage.derive <> derive_K1 thm 131 | R3384:3393 Triage.derive <> derive_app constr 132 | R3417:3426 Triage.derive <> derive_app constr 133 | R3438:3448 Triage.derive <> derive_node constr 134 | R3458:3469 Triage.subtypes <> sub_leaf_fun constr 135 | R3480:3488 Triage.derive <> derive_K1 thm 136 | R3505:3514 Triage.derive <> derive_app constr 137 | R3526:3536 Triage.derive <> derive_node constr 138 | R3546:3557 Triage.subtypes <> sub_leaf_fun constr 139 | R3576:3585 Triage.derive <> derive_app constr 140 | R3596:3606 Triage.derive <> derive_node constr 141 | R3616:3627 Triage.subtypes <> sub_leaf_fun constr 142 | R3638:3645 Triage.derive <> derive_I thm 143 | R3663:3673 Triage.derive <> derive_node constr 144 | R3684:3692 Triage.subtypes <> sub_trans constr 145 | R3704:3720 Triage.subtypes <> subtype_leaf_fork thm 146 | R3771:3779 Triage.subtypes <> sub_trans constr 147 | R3790:3801 Triage.subtypes <> sub_stem_fun constr 148 | R3845:3853 Triage.derive <> derive_S2 thm 149 | R3845:3853 Triage.derive <> derive_S2 thm 150 | R3869:3877 Triage.derive <> derive_K1 thm 151 | R3887:3896 Triage.derive <> derive_app constr 152 | R3928:3937 Triage.derive <> derive_app constr 153 | R3948:3958 Triage.derive <> derive_node constr 154 | R3969:3980 Triage.subtypes <> sub_leaf_fun constr 155 | R3991:3999 Triage.derive <> derive_K1 thm 156 | R4009:4016 Triage.derive <> derive_K thm 157 | R4036:4046 Triage.derive <> derive_node constr 158 | R4056:4064 Triage.subtypes <> sub_trans constr 159 | R4076:4092 Triage.subtypes <> subtype_leaf_fork thm 160 | R3869:3877 Triage.derive <> derive_K1 thm 161 | R3887:3896 Triage.derive <> derive_app constr 162 | R3928:3937 Triage.derive <> derive_app constr 163 | R3948:3958 Triage.derive <> derive_node constr 164 | R3969:3980 Triage.subtypes <> sub_leaf_fun constr 165 | R3991:3999 Triage.derive <> derive_K1 thm 166 | R4009:4016 Triage.derive <> derive_K thm 167 | R4036:4046 Triage.derive <> derive_node constr 168 | R4056:4064 Triage.subtypes <> sub_trans constr 169 | R4076:4092 Triage.subtypes <> subtype_leaf_fork thm 170 | R4144:4152 Triage.derive <> derive_S2 thm 171 | R4144:4152 Triage.derive <> derive_S2 thm 172 | R4170:4178 Triage.derive <> derive_S2 thm 173 | R4215:4223 Triage.derive <> derive_S2 thm 174 | R4235:4243 Triage.derive <> derive_K1 thm 175 | R4253:4263 Triage.derive <> derive_node constr 176 | R4273:4284 Triage.subtypes <> sub_leaf_fun constr 177 | R4312:4320 Triage.derive <> derive_K1 thm 178 | R4331:4341 Triage.derive <> derive_node constr 179 | R4351:4359 Triage.subtypes <> sub_trans constr 180 | R4371:4387 Triage.subtypes <> subtype_leaf_fork thm 181 | R4445:4453 Triage.derive <> derive_S2 thm 182 | R4465:4473 Triage.derive <> derive_K1 thm 183 | R4483:4490 Triage.derive <> derive_K thm 184 | R4514:4522 Triage.derive <> derive_S2 thm 185 | R4534:4542 Triage.derive <> derive_K1 thm 186 | R4552:4562 Triage.derive <> derive_node constr 187 | R4572:4588 Triage.subtypes <> subtype_leaf_fork thm 188 | R4599:4606 Triage.derive <> derive_I thm 189 | R4170:4178 Triage.derive <> derive_S2 thm 190 | R4215:4223 Triage.derive <> derive_S2 thm 191 | R4235:4243 Triage.derive <> derive_K1 thm 192 | R4253:4263 Triage.derive <> derive_node constr 193 | R4273:4284 Triage.subtypes <> sub_leaf_fun constr 194 | R4312:4320 Triage.derive <> derive_K1 thm 195 | R4331:4341 Triage.derive <> derive_node constr 196 | R4351:4359 Triage.subtypes <> sub_trans constr 197 | R4371:4387 Triage.subtypes <> subtype_leaf_fork thm 198 | R4445:4453 Triage.derive <> derive_S2 thm 199 | R4465:4473 Triage.derive <> derive_K1 thm 200 | R4483:4490 Triage.derive <> derive_K thm 201 | R4514:4522 Triage.derive <> derive_S2 thm 202 | R4534:4542 Triage.derive <> derive_K1 thm 203 | R4552:4562 Triage.derive <> derive_node constr 204 | R4572:4588 Triage.subtypes <> subtype_leaf_fork thm 205 | R4599:4606 Triage.derive <> derive_I thm 206 | R4625:4633 Triage.derive <> derive_K1 thm 207 | R4643:4651 Triage.derive <> derive_S2 thm 208 | R4661:4668 Triage.derive <> derive_K thm 209 | R4625:4633 Triage.derive <> derive_K1 thm 210 | R4643:4651 Triage.derive <> derive_S2 thm 211 | R4661:4668 Triage.derive <> derive_K thm 212 | R4661:4668 Triage.derive <> derive_K thm 213 | R4689:4692 Triage.types <> Leaf constr 214 | R4689:4692 Triage.types <> Leaf constr 215 | prf 4711:4722 <> derive_eager 216 | binder 4786:4790 <> gamma:2 217 | R4793:4798 Triage.derive <> derive ind 218 | R4800:4804 Triage.typed_evaluator <> gamma:2 var 219 | R4806:4810 Triage.terms <> eager def 220 | R4812:4819 Triage.subtypes <> eager_ty def 221 | R4846:4868 Triage.derive <> derive_generalisation_q thm 222 | R4883:4893 Triage.typed_lambda <> derive_star thm 223 | R4907:4916 Triage.derive <> derive_app constr 224 | R4928:4937 Triage.derive <> derive_app constr 225 | R4951:4960 Triage.derive <> derive_ref constr 226 | R4984:4991 Triage.subtypes <> sub_zero constr 227 | R5028:5037 Triage.derive <> derive_ref constr 228 | R5061:5068 Triage.subtypes <> sub_zero constr 229 | R5084:5097 Triage.derive <> derive_subtype thm 230 | R5109:5122 Triage.typed_evaluator <> derive_eager_s thm 231 | R4846:4868 Triage.derive <> derive_generalisation_q thm 232 | R4883:4893 Triage.typed_lambda <> derive_star thm 233 | R4883:4893 Triage.typed_lambda <> derive_star thm 234 | R4907:4916 Triage.derive <> derive_app constr 235 | R4928:4937 Triage.derive <> derive_app constr 236 | R4951:4960 Triage.derive <> derive_ref constr 237 | R4984:4991 Triage.subtypes <> sub_zero constr 238 | R5028:5037 Triage.derive <> derive_ref constr 239 | R5061:5068 Triage.subtypes <> sub_zero constr 240 | R5084:5097 Triage.derive <> derive_subtype thm 241 | R5109:5122 Triage.typed_evaluator <> derive_eager_s thm 242 | prf 5165:5174 <> subtype_bf 243 | R5177:5183 Triage.subtypes <> subtype ind 244 | R5186:5189 Triage.types <> Fork constr 245 | R5192:5195 Triage.types <> Fork constr 246 | R5197:5200 Triage.types <> Leaf constr 247 | R5202:5205 Triage.types <> Leaf constr 248 | R5233:5237 Triage.types <> quant def 249 | R5242:5246 Triage.types <> Funty constr 250 | R5249:5251 Triage.types <> Var constr 251 | R5257:5261 Triage.types <> Funty constr 252 | R5264:5266 Triage.types <> Var constr 253 | R5272:5274 Triage.types <> Asf constr 254 | R5277:5280 Triage.types <> Fork constr 255 | R5283:5285 Triage.types <> Var constr 256 | R5291:5293 Triage.types <> Var constr 257 | R5330:5336 Triage.subtypes <> eval_ty def 258 | R5355:5363 Triage.subtypes <> sub_trans constr 259 | R5375:5382 Triage.subtypes <> sub_lift constr 260 | R5400:5408 Triage.subtypes <> sub_quant constr 261 | R5418:5421 Triage.types <> lift def 262 | R5454:5456 Triage.types <> Asf constr 263 | R5459:5461 Triage.types <> Var constr 264 | R5473:5477 Triage.types <> subst def 265 | R5480:5482 Triage.types <> Asf constr 266 | R5485:5487 Triage.types <> Var constr 267 | R5494:5496 Triage.types <> Var constr 268 | R5529:5537 Triage.subtypes <> sub_trans constr 269 | R5551:5558 Triage.subtypes <> sub_tree constr 270 | R5584:5588 Triage.types <> subst def 271 | R5614:5621 Triage.subtypes <> sub_fork constr 272 | R5635:5642 Triage.subtypes <> sub_zero constr 273 | R5657:5664 Triage.subtypes <> sub_fork constr 274 | R5355:5363 Triage.subtypes <> sub_trans constr 275 | R5375:5382 Triage.subtypes <> sub_lift constr 276 | R5400:5408 Triage.subtypes <> sub_quant constr 277 | R5454:5456 Triage.types <> Asf constr 278 | R5459:5461 Triage.types <> Var constr 279 | R5473:5477 Triage.types <> subst def 280 | R5480:5482 Triage.types <> Asf constr 281 | R5485:5487 Triage.types <> Var constr 282 | R5494:5496 Triage.types <> Var constr 283 | R5529:5537 Triage.subtypes <> sub_trans constr 284 | R5551:5558 Triage.subtypes <> sub_tree constr 285 | R5614:5621 Triage.subtypes <> sub_fork constr 286 | R5635:5642 Triage.subtypes <> sub_zero constr 287 | R5657:5664 Triage.subtypes <> sub_fork constr 288 | prf 5692:5700 <> derive_bf 289 | R5704:5709 Triage.derive <> derive ind 290 | R5711:5713 Coq.Init.Datatypes <> nil constr 291 | R5715:5716 Triage.terms <> bf def 292 | R5718:5724 Triage.subtypes <> eval_ty def 293 | R5745:5752 Triage.typed_recursion <> derive_Z thm 294 | R5762:5772 Triage.typed_lambda <> derive_star thm 295 | R5787:5800 Triage.derive <> derive_subtype thm 296 | R5814:5823 Triage.typed_evaluator <> subtype_bf thm 297 | R5839:5848 Triage.derive <> derive_app constr 298 | R5875:5884 Triage.derive <> derive_app constr 299 | R5894:5904 Triage.derive <> derive_node constr 300 | R5942:5950 Triage.subtypes <> sub_trans constr 301 | R5962:5978 Triage.subtypes <> subtype_leaf_fork thm 302 | R5922:5929 Triage.subtypes <> sub_zero constr 303 | R6010:6017 Triage.subtypes <> sub_zero constr 304 | R6050:6072 Triage.derive <> derive_generalisation_q thm 305 | R6089:6093 Triage.types <> Funty constr 306 | R6096:6098 Triage.types <> Var constr 307 | R6104:6106 Triage.types <> Asf constr 308 | R6109:6112 Triage.types <> Fork constr 309 | R6115:6117 Triage.types <> Var constr 310 | R6123:6125 Triage.types <> Var constr 311 | R6144:6148 Triage.types <> subst def 312 | R6151:6155 Triage.types <> Funty constr 313 | R6158:6160 Triage.types <> Var constr 314 | R6166:6168 Triage.types <> Asf constr 315 | R6171:6174 Triage.types <> Fork constr 316 | R6177:6179 Triage.types <> Var constr 317 | R6185:6187 Triage.types <> Var constr 318 | R6196:6198 Triage.types <> Var constr 319 | R6232:6245 Triage.derive <> derive_subtype thm 320 | R6259:6266 Triage.subtypes <> sub_tree constr 321 | R6294:6298 Triage.types <> subst def 322 | R6336:6345 Triage.derive <> derive_app constr 323 | R5745:5752 Triage.typed_recursion <> derive_Z thm 324 | R5762:5772 Triage.typed_lambda <> derive_star thm 325 | R5787:5800 Triage.derive <> derive_subtype thm 326 | R5814:5823 Triage.typed_evaluator <> subtype_bf thm 327 | R5839:5848 Triage.derive <> derive_app constr 328 | R5875:5884 Triage.derive <> derive_app constr 329 | R5875:5884 Triage.derive <> derive_app constr 330 | R5875:5884 Triage.derive <> derive_app constr 331 | R5875:5884 Triage.derive <> derive_app constr 332 | R5875:5884 Triage.derive <> derive_app constr 333 | R5875:5884 Triage.derive <> derive_app constr 334 | R5875:5884 Triage.derive <> derive_app constr 335 | R5894:5904 Triage.derive <> derive_node constr 336 | R5894:5904 Triage.derive <> derive_node constr 337 | R5894:5904 Triage.derive <> derive_node constr 338 | R5894:5904 Triage.derive <> derive_node constr 339 | R5922:5929 Triage.subtypes <> sub_zero constr 340 | R5942:5950 Triage.subtypes <> sub_trans constr 341 | R5962:5978 Triage.subtypes <> subtype_leaf_fork thm 342 | R5922:5929 Triage.subtypes <> sub_zero constr 343 | R5942:5950 Triage.subtypes <> sub_trans constr 344 | R5962:5978 Triage.subtypes <> subtype_leaf_fork thm 345 | R5922:5929 Triage.subtypes <> sub_zero constr 346 | R5922:5929 Triage.subtypes <> sub_zero constr 347 | R6010:6017 Triage.subtypes <> sub_zero constr 348 | R6010:6017 Triage.subtypes <> sub_zero constr 349 | R6050:6072 Triage.derive <> derive_generalisation_q thm 350 | R6089:6093 Triage.types <> Funty constr 351 | R6096:6098 Triage.types <> Var constr 352 | R6104:6106 Triage.types <> Asf constr 353 | R6109:6112 Triage.types <> Fork constr 354 | R6115:6117 Triage.types <> Var constr 355 | R6123:6125 Triage.types <> Var constr 356 | R6144:6148 Triage.types <> subst def 357 | R6151:6155 Triage.types <> Funty constr 358 | R6158:6160 Triage.types <> Var constr 359 | R6166:6168 Triage.types <> Asf constr 360 | R6171:6174 Triage.types <> Fork constr 361 | R6177:6179 Triage.types <> Var constr 362 | R6185:6187 Triage.types <> Var constr 363 | R6196:6198 Triage.types <> Var constr 364 | R6232:6245 Triage.derive <> derive_subtype thm 365 | R6259:6266 Triage.subtypes <> sub_tree constr 366 | R6336:6345 Triage.derive <> derive_app constr 367 | R6361:6370 Triage.derive <> derive_app constr 368 | R6391:6401 Triage.derive <> derive_node constr 369 | R6441:6449 Triage.subtypes <> sub_trans constr 370 | R6461:6477 Triage.subtypes <> subtype_leaf_fork thm 371 | R6421:6428 Triage.subtypes <> sub_zero constr 372 | R6518:6525 Triage.subtypes <> sub_zero constr 373 | R6545:6554 Triage.derive <> derive_app constr 374 | R6583:6592 Triage.derive <> derive_app constr 375 | R6602:6612 Triage.derive <> derive_node constr 376 | R6635:6643 Triage.subtypes <> sub_trans constr 377 | R6655:6671 Triage.subtypes <> subtype_leaf_fork thm 378 | R6701:6708 Triage.subtypes <> sub_zero constr 379 | R6730:6738 Triage.subtypes <> sub_trans constr 380 | R6750:6766 Triage.subtypes <> subtype_leaf_fork thm 381 | R6795:6804 Triage.subtypes <> sub_to_asf constr 382 | R6827:6834 Triage.subtypes <> sub_zero constr 383 | R6361:6370 Triage.derive <> derive_app constr 384 | R6391:6401 Triage.derive <> derive_node constr 385 | R6421:6428 Triage.subtypes <> sub_zero constr 386 | R6441:6449 Triage.subtypes <> sub_trans constr 387 | R6461:6477 Triage.subtypes <> subtype_leaf_fork thm 388 | R6518:6525 Triage.subtypes <> sub_zero constr 389 | R6545:6554 Triage.derive <> derive_app constr 390 | R6583:6592 Triage.derive <> derive_app constr 391 | R6583:6592 Triage.derive <> derive_app constr 392 | R6583:6592 Triage.derive <> derive_app constr 393 | R6583:6592 Triage.derive <> derive_app constr 394 | R6583:6592 Triage.derive <> derive_app constr 395 | R6602:6612 Triage.derive <> derive_node constr 396 | R6602:6612 Triage.derive <> derive_node constr 397 | R6602:6612 Triage.derive <> derive_node constr 398 | R6635:6643 Triage.subtypes <> sub_trans constr 399 | R6655:6671 Triage.subtypes <> subtype_leaf_fork thm 400 | R6701:6708 Triage.subtypes <> sub_zero constr 401 | R6730:6738 Triage.subtypes <> sub_trans constr 402 | R6750:6766 Triage.subtypes <> subtype_leaf_fork thm 403 | R6795:6804 Triage.subtypes <> sub_to_asf constr 404 | R6827:6834 Triage.subtypes <> sub_zero constr 405 | R6869:6889 Triage.derive <> derive_generalisation thm 406 | R6906:6916 Triage.typed_lambda <> derive_star thm 407 | R6926:6939 Triage.derive <> derive_subtype thm 408 | R6953:6960 Triage.subtypes <> sub_bffs constr 409 | R6978:6987 Triage.derive <> derive_app constr 410 | R7009:7018 Triage.derive <> derive_app constr 411 | R7030:7040 Triage.derive <> derive_node constr 412 | R7050:7066 Triage.subtypes <> subtype_leaf_fork thm 413 | R7088:7097 Triage.derive <> derive_app constr 414 | R7109:7119 Triage.derive <> derive_node constr 415 | R7129:7140 Triage.subtypes <> sub_leaf_fun constr 416 | R7162:7171 Triage.derive <> derive_app constr 417 | R7195:7204 Triage.derive <> derive_app constr 418 | R7217:7227 Triage.derive <> derive_node constr 419 | R7237:7253 Triage.subtypes <> subtype_leaf_fork thm 420 | R7277:7286 Triage.derive <> derive_app constr 421 | R7298:7308 Triage.derive <> derive_node constr 422 | R7318:7329 Triage.subtypes <> sub_leaf_fun constr 423 | R7353:7362 Triage.derive <> derive_app constr 424 | R7388:7397 Triage.derive <> derive_app constr 425 | R7409:7419 Triage.derive <> derive_node constr 426 | R7429:7445 Triage.subtypes <> subtype_leaf_fork thm 427 | R7471:7481 Triage.derive <> derive_node constr 428 | R7491:7498 Triage.subtypes <> sub_zero constr 429 | R7522:7533 Triage.typed_evaluator <> derive_eager thm 430 | R7556:7565 Triage.derive <> derive_app constr 431 | R7591:7600 Triage.derive <> derive_app constr 432 | R7612:7622 Triage.derive <> derive_node constr 433 | R7632:7648 Triage.subtypes <> subtype_leaf_fork thm 434 | R7674:7683 Triage.derive <> derive_app constr 435 | R7695:7705 Triage.derive <> derive_node constr 436 | R7715:7726 Triage.subtypes <> sub_leaf_fun constr 437 | R7752:7761 Triage.derive <> derive_app constr 438 | R7789:7798 Triage.derive <> derive_app constr 439 | R7810:7820 Triage.derive <> derive_node constr 440 | R7830:7846 Triage.subtypes <> subtype_leaf_fork thm 441 | R7875:7885 Triage.derive <> derive_node constr 442 | R7895:7902 Triage.subtypes <> sub_zero constr 443 | R7928:7937 Triage.derive <> derive_ref constr 444 | R7961:7968 Triage.subtypes <> sub_zero constr 445 | R7993:8002 Triage.derive <> derive_app constr 446 | R8012:8021 Triage.derive <> derive_ref constr 447 | R8059:8066 Triage.subtypes <> sub_zero constr 448 | R8089:8098 Triage.derive <> derive_app constr 449 | R8108:8117 Triage.derive <> derive_ref constr 450 | R8155:8162 Triage.subtypes <> sub_zero constr 451 | R6869:6889 Triage.derive <> derive_generalisation thm 452 | R6906:6916 Triage.typed_lambda <> derive_star thm 453 | R6906:6916 Triage.typed_lambda <> derive_star thm 454 | R6926:6939 Triage.derive <> derive_subtype thm 455 | R6953:6960 Triage.subtypes <> sub_bffs constr 456 | R6978:6987 Triage.derive <> derive_app constr 457 | R7009:7018 Triage.derive <> derive_app constr 458 | R7030:7040 Triage.derive <> derive_node constr 459 | R7050:7066 Triage.subtypes <> subtype_leaf_fork thm 460 | R7088:7097 Triage.derive <> derive_app constr 461 | R7109:7119 Triage.derive <> derive_node constr 462 | R7129:7140 Triage.subtypes <> sub_leaf_fun constr 463 | R7162:7171 Triage.derive <> derive_app constr 464 | R7195:7204 Triage.derive <> derive_app constr 465 | R7217:7227 Triage.derive <> derive_node constr 466 | R7237:7253 Triage.subtypes <> subtype_leaf_fork thm 467 | R7277:7286 Triage.derive <> derive_app constr 468 | R7298:7308 Triage.derive <> derive_node constr 469 | R7318:7329 Triage.subtypes <> sub_leaf_fun constr 470 | R7353:7362 Triage.derive <> derive_app constr 471 | R7388:7397 Triage.derive <> derive_app constr 472 | R7409:7419 Triage.derive <> derive_node constr 473 | R7429:7445 Triage.subtypes <> subtype_leaf_fork thm 474 | R7471:7481 Triage.derive <> derive_node constr 475 | R7491:7498 Triage.subtypes <> sub_zero constr 476 | R7522:7533 Triage.typed_evaluator <> derive_eager thm 477 | R7556:7565 Triage.derive <> derive_app constr 478 | R7591:7600 Triage.derive <> derive_app constr 479 | R7612:7622 Triage.derive <> derive_node constr 480 | R7632:7648 Triage.subtypes <> subtype_leaf_fork thm 481 | R7674:7683 Triage.derive <> derive_app constr 482 | R7695:7705 Triage.derive <> derive_node constr 483 | R7715:7726 Triage.subtypes <> sub_leaf_fun constr 484 | R7752:7761 Triage.derive <> derive_app constr 485 | R7789:7798 Triage.derive <> derive_app constr 486 | R7810:7820 Triage.derive <> derive_node constr 487 | R7830:7846 Triage.subtypes <> subtype_leaf_fork thm 488 | R7875:7885 Triage.derive <> derive_node constr 489 | R7895:7902 Triage.subtypes <> sub_zero constr 490 | R7928:7937 Triage.derive <> derive_ref constr 491 | R7961:7968 Triage.subtypes <> sub_zero constr 492 | R7993:8002 Triage.derive <> derive_app constr 493 | R8012:8021 Triage.derive <> derive_ref constr 494 | R8012:8021 Triage.derive <> derive_ref constr 495 | R8059:8066 Triage.subtypes <> sub_zero constr 496 | R8089:8098 Triage.derive <> derive_app constr 497 | R8108:8117 Triage.derive <> derive_ref constr 498 | R8108:8117 Triage.derive <> derive_ref constr 499 | R8155:8162 Triage.subtypes <> sub_zero constr 500 | R8203:8223 Triage.derive <> derive_generalisation thm 501 | R8240:8250 Triage.typed_lambda <> derive_star thm 502 | R8262:8275 Triage.derive <> derive_subtype thm 503 | R8295:8304 Triage.derive <> derive_app constr 504 | R8326:8335 Triage.derive <> derive_app constr 505 | R8347:8357 Triage.derive <> derive_node constr 506 | R8367:8383 Triage.subtypes <> subtype_leaf_fork thm 507 | R8405:8414 Triage.derive <> derive_app constr 508 | R8438:8447 Triage.derive <> derive_app constr 509 | R8459:8469 Triage.derive <> derive_node constr 510 | R8479:8495 Triage.subtypes <> subtype_leaf_fork thm 511 | R8519:8528 Triage.derive <> derive_ref constr 512 | R8552:8559 Triage.subtypes <> sub_zero constr 513 | R8581:8590 Triage.derive <> derive_app constr 514 | R8600:8609 Triage.derive <> derive_ref constr 515 | R8652:8659 Triage.subtypes <> sub_zero constr 516 | R8681:8690 Triage.derive <> derive_app constr 517 | R8704:8713 Triage.derive <> derive_ref constr 518 | R8737:8744 Triage.subtypes <> sub_zero constr 519 | R8764:8774 Triage.typed_lambda <> derive_star thm 520 | R8808:8817 Triage.derive <> derive_app constr 521 | R8849:8859 Triage.derive <> derive_node constr 522 | R8828:8837 Triage.derive <> derive_ref constr 523 | R8888:8895 Triage.subtypes <> sub_zero constr 524 | R8957:8973 Triage.subtypes <> subtype_leaf_fork thm 525 | R8934:8945 Triage.subtypes <> sub_leaf_fun constr 526 | R8915:8922 Triage.subtypes <> sub_zero constr 527 | R9017:9021 Triage.types <> Quant constr 528 | R9024:9028 Triage.types <> Funty constr 529 | R9031:9033 Triage.types <> Var constr 530 | R9039:9041 Triage.types <> Asf constr 531 | R9044:9046 Triage.types <> Var constr 532 | R9059:9065 Triage.subtypes <> eval_ty def 533 | R9090:9097 Triage.subtypes <> sub_bfff constr 534 | R8203:8223 Triage.derive <> derive_generalisation thm 535 | R8203:8223 Triage.derive <> derive_generalisation thm 536 | R8240:8250 Triage.typed_lambda <> derive_star thm 537 | R8240:8250 Triage.typed_lambda <> derive_star thm 538 | R8240:8250 Triage.typed_lambda <> derive_star thm 539 | R8262:8275 Triage.derive <> derive_subtype thm 540 | R8295:8304 Triage.derive <> derive_app constr 541 | R8326:8335 Triage.derive <> derive_app constr 542 | R8347:8357 Triage.derive <> derive_node constr 543 | R8367:8383 Triage.subtypes <> subtype_leaf_fork thm 544 | R8405:8414 Triage.derive <> derive_app constr 545 | R8438:8447 Triage.derive <> derive_app constr 546 | R8459:8469 Triage.derive <> derive_node constr 547 | R8479:8495 Triage.subtypes <> subtype_leaf_fork thm 548 | R8519:8528 Triage.derive <> derive_ref constr 549 | R8552:8559 Triage.subtypes <> sub_zero constr 550 | R8581:8590 Triage.derive <> derive_app constr 551 | R8600:8609 Triage.derive <> derive_ref constr 552 | R8600:8609 Triage.derive <> derive_ref constr 553 | R8652:8659 Triage.subtypes <> sub_zero constr 554 | R8681:8690 Triage.derive <> derive_app constr 555 | R8704:8713 Triage.derive <> derive_ref constr 556 | R8737:8744 Triage.subtypes <> sub_zero constr 557 | R8764:8774 Triage.typed_lambda <> derive_star thm 558 | R8808:8817 Triage.derive <> derive_app constr 559 | R8808:8817 Triage.derive <> derive_app constr 560 | R8808:8817 Triage.derive <> derive_app constr 561 | R8808:8817 Triage.derive <> derive_app constr 562 | R8808:8817 Triage.derive <> derive_app constr 563 | R8808:8817 Triage.derive <> derive_app constr 564 | R8808:8817 Triage.derive <> derive_app constr 565 | R8808:8817 Triage.derive <> derive_app constr 566 | R8808:8817 Triage.derive <> derive_app constr 567 | R8808:8817 Triage.derive <> derive_app constr 568 | R8808:8817 Triage.derive <> derive_app constr 569 | R8808:8817 Triage.derive <> derive_app constr 570 | R8808:8817 Triage.derive <> derive_app constr 571 | R8828:8837 Triage.derive <> derive_ref constr 572 | R8849:8859 Triage.derive <> derive_node constr 573 | R8828:8837 Triage.derive <> derive_ref constr 574 | R8849:8859 Triage.derive <> derive_node constr 575 | R8828:8837 Triage.derive <> derive_ref constr 576 | R8849:8859 Triage.derive <> derive_node constr 577 | R8828:8837 Triage.derive <> derive_ref constr 578 | R8849:8859 Triage.derive <> derive_node constr 579 | R8828:8837 Triage.derive <> derive_ref constr 580 | R8828:8837 Triage.derive <> derive_ref constr 581 | R8828:8837 Triage.derive <> derive_ref constr 582 | R8888:8895 Triage.subtypes <> sub_zero constr 583 | R8888:8895 Triage.subtypes <> sub_zero constr 584 | R8888:8895 Triage.subtypes <> sub_zero constr 585 | R8888:8895 Triage.subtypes <> sub_zero constr 586 | R8888:8895 Triage.subtypes <> sub_zero constr 587 | R8888:8895 Triage.subtypes <> sub_zero constr 588 | R8888:8895 Triage.subtypes <> sub_zero constr 589 | R8915:8922 Triage.subtypes <> sub_zero constr 590 | R8934:8945 Triage.subtypes <> sub_leaf_fun constr 591 | R8957:8973 Triage.subtypes <> subtype_leaf_fork thm 592 | R8915:8922 Triage.subtypes <> sub_zero constr 593 | R8934:8945 Triage.subtypes <> sub_leaf_fun constr 594 | R8915:8922 Triage.subtypes <> sub_zero constr 595 | R8934:8945 Triage.subtypes <> sub_leaf_fun constr 596 | R8957:8973 Triage.subtypes <> subtype_leaf_fork thm 597 | R8915:8922 Triage.subtypes <> sub_zero constr 598 | R8934:8945 Triage.subtypes <> sub_leaf_fun constr 599 | R8957:8973 Triage.subtypes <> subtype_leaf_fork thm 600 | R9017:9021 Triage.types <> Quant constr 601 | R9024:9028 Triage.types <> Funty constr 602 | R9031:9033 Triage.types <> Var constr 603 | R9039:9041 Triage.types <> Asf constr 604 | R9044:9046 Triage.types <> Var constr 605 | R9059:9065 Triage.subtypes <> eval_ty def 606 | R9090:9097 Triage.subtypes <> sub_bfff constr 607 | -------------------------------------------------------------------------------- /typed_evaluator.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Typed Evaluator *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | Require Import String Arith Lia Bool List Nat Datatypes. 34 | Require Import terms types subtypes derive typed_lambda typed_triage typed_recursion. 35 | 36 | Set Default Proof Using "Type". 37 | 38 | Definition eager_s_ty := quant 2 (Funty (Var 0) (Funty (Funty (Var 0) (Var 1)) (Var 1))). 39 | 40 | Proposition derive_eager_s: (* note the use of double-negative covariance ! *) 41 | forall gamma, derive gamma eager_s eager_s_ty. 42 | Proof. 43 | intros; eapply derive_generalisation_q; 44 | replace (Funty (Funty (Var 0) (Var 1)) (Var 1)) 45 | with (subst (Funty (Funty (Var 0) (Var 2)) (Var 2)) (Var 0)) by (cbv; auto); 46 | eapply derive_triage; try (cbv; eauto; fail); 47 | unfold subst; simpl; var_tac; simpl; repeat eapply derive_generalisation; 48 | eapply derive_S2. 49 | - eapply derive_I. 50 | - eapply derive_K1; eapply derive_node; auto_t. 51 | - eapply derive_K1; eapply derive_app; [ 52 | | 53 | eapply derive_app; [ eapply derive_node; eapply sub_leaf_fun | eapply derive_I]]; 54 | eapply derive_node; eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac; sub_fork2_tac]. 55 | - eapply derive_S2; [ eapply derive_K1; eapply derive_K |]; 56 | eapply derive_S2; [ eapply derive_K1; eapply derive_node; eapply sub_leaf_fun | eapply derive_I]. 57 | - eapply derive_K1; eapply derive_app; [ 58 | | 59 | eapply derive_app; [ eapply derive_node; eapply sub_leaf_fun | eapply derive_K1]; 60 | eapply derive_app; [ eapply derive_node; eapply sub_leaf_fun |]; 61 | eapply derive_app; [eapply derive_node; eapply sub_leaf_fun | eapply derive_I]]; 62 | eapply derive_node; eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac]; 63 | sub_fork2_tac; eapply sub_trans; [eapply sub_stem_fun | sub_fun_tac; sub_fork2_tac]. 64 | - eapply derive_S2. 65 | + eapply derive_K1; eapply derive_app; [ 66 | | 67 | eapply derive_app; [eapply derive_node; eapply sub_leaf_fun | eapply derive_K1; eapply derive_K]]; 68 | eapply derive_node; eapply sub_trans; [ eapply subtype_leaf_fork |]; do 2 sub_fun_tac; sub_fork2_tac. 69 | + eapply derive_S2. 70 | * eapply derive_S2; [ 71 | | 72 | eapply derive_S2; [ eapply derive_K1; eapply derive_node; eapply sub_leaf_fun |]]; [ 73 | eapply derive_K1; eapply derive_node; eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac; sub_fork2_tac] |]; 74 | eapply derive_S2; [ eapply derive_K1; eapply derive_K |]; 75 | eapply derive_S2; [ eapply derive_K1; eapply derive_node; eapply subtype_leaf_fork | eapply derive_I]. 76 | * eapply derive_K1; eapply derive_S2; eapply derive_K. 77 | Unshelve. apply Leaf. 78 | Qed. 79 | 80 | 81 | Theorem derive_eager: (* note the use of double-negative covariance ! *) 82 | forall gamma, derive gamma eager eager_ty. 83 | Proof. 84 | intros; eapply derive_generalisation_q; do 2 eapply derive_star; 85 | eapply derive_app; [ eapply derive_app; [ | eapply derive_ref; simpl; eauto; eapply sub_zero] | 86 | eapply derive_ref; simpl; eauto; eapply sub_zero]; 87 | eapply derive_subtype; [ eapply derive_eager_s | do 2 subst_tac]. 88 | Qed. 89 | 90 | 91 | 92 | 93 | Proposition subtype_bf: subtype (Fork (Fork Leaf Leaf) 94 | (quant 2 (Funty (Var 1) (Funty (Var 0) (Asf (Fork (Var 1) (Var 0))))))) 95 | eval_ty. 96 | Proof. 97 | eapply sub_trans; [ eapply sub_lift | ]; 98 | eapply sub_quant; unfold lift; simpl; var_tac; 99 | replace (Asf (Var 0)) with (subst (Asf (Var 0)) (Var 0)) by (cbv; auto); 100 | eapply sub_trans; [ | eapply sub_tree; cbv; auto]; 101 | unfold subst; simpl; var_tac; eapply sub_fork; [ | eapply sub_zero]; 102 | eapply sub_fork; auto_t. 103 | Qed. 104 | 105 | 106 | 107 | Theorem derive_bf : derive nil bf eval_ty. 108 | Proof. 109 | eapply derive_Z; eapply derive_star; 110 | eapply derive_subtype; [ | eapply subtype_bf]; 111 | eapply derive_app; [ 112 | repeat eapply derive_app; eapply derive_node; 113 | (eapply sub_zero || (eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac])); eapply sub_zero |]; 114 | (* bff *) 115 | eapply derive_generalisation_q; 116 | replace (Funty (Var 0) (Asf (Fork (Var 1) (Var 0)))) with 117 | (subst (Funty (Var 1) (Asf (Fork (Var 0) (Var 1)))) (Var 1)) by (cbv; auto); 118 | eapply derive_subtype; [ | eapply sub_tree; cbv; eauto]; 119 | unfold subst; simpl; var_tac; simpl; 120 | eapply derive_app. 121 | + eapply derive_app; [ 122 | eapply derive_node; 123 | (eapply sub_zero || (eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac])); 124 | eapply sub_zero |]; 125 | eapply derive_app; [ 126 | repeat eapply derive_app; eapply derive_node; [ 127 | eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac]; eapply sub_zero | 128 | eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac; eapply sub_to_asf] | 129 | eapply sub_zero] |]. 130 | (* bffs *) 131 | eapply derive_generalisation; do 2 eapply derive_star; eapply derive_subtype; [ | eapply sub_bffs]; 132 | eapply derive_app; [ 133 | eapply derive_app; [ eapply derive_node; eapply subtype_leaf_fork |]; 134 | eapply derive_app; [ eapply derive_node; eapply sub_leaf_fun |]; 135 | eapply derive_app; [ 136 | eapply derive_app; [ eapply derive_node; eapply subtype_leaf_fork |]; 137 | eapply derive_app; [ eapply derive_node; eapply sub_leaf_fun |]; 138 | eapply derive_app; [ 139 | eapply derive_app; [ eapply derive_node; eapply subtype_leaf_fork |]; 140 | eapply derive_node; eapply sub_zero | 141 | eapply derive_eager] | 142 | eapply derive_app; [ 143 | eapply derive_app; [ eapply derive_node; eapply subtype_leaf_fork |]; 144 | eapply derive_app; [ eapply derive_node; eapply sub_leaf_fun |]; 145 | eapply derive_app; [ 146 | eapply derive_app; [ eapply derive_node; eapply subtype_leaf_fork |]; 147 | eapply derive_node; eapply sub_zero | 148 | eapply derive_ref; simpl; eauto; eapply sub_zero] | 149 | eapply derive_app; eapply derive_ref; simpl; eauto; [ subst_tac | eapply sub_zero]]] | 150 | eapply derive_app; eapply derive_ref; simpl; eauto; [ subst_tac | eapply sub_zero]]. 151 | + (* bfff *) 152 | do 2 eapply derive_generalisation; do 3 eapply derive_star; eapply derive_subtype; [ 153 | eapply derive_app; [ 154 | eapply derive_app; [ eapply derive_node; eapply subtype_leaf_fork |]; 155 | eapply derive_app; [ 156 | eapply derive_app; [ eapply derive_node; eapply subtype_leaf_fork |]; 157 | eapply derive_ref; simpl; eauto; eapply sub_zero | 158 | eapply derive_app; eapply derive_ref; simpl; eauto; [ cbv; subst_tac | eapply sub_zero]] | 159 | eapply derive_app; [ | eapply derive_ref; simpl; eauto; eapply sub_zero]; 160 | eapply derive_star; cbv; 161 | repeat eapply derive_app; (eapply derive_ref || eapply derive_node); simpl; eauto; try eapply sub_zero; 162 | (eapply sub_zero || eapply sub_leaf_fun || eapply subtype_leaf_fork || subst_tac || idtac)] | 163 | replace (Quant (Funty (Var 0) (Asf (Var 0)))) with eval_ty by (cbv; auto); eapply sub_bfff]. 164 | Qed. 165 | 166 | -------------------------------------------------------------------------------- /typed_evaluator.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_evaluator.vo -------------------------------------------------------------------------------- /typed_evaluator.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_evaluator.vok -------------------------------------------------------------------------------- /typed_evaluator.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_evaluator.vos -------------------------------------------------------------------------------- /typed_lambda.glob: -------------------------------------------------------------------------------- 1 | DIGEST 8c248a54641ac1f8709844a7cf0cd868 2 | FTriage.typed_lambda 3 | R2156:2160 Coq.Arith.Arith <> <> lib 4 | R2162:2164 Coq.micromega.Lia <> <> lib 5 | R2166:2169 Coq.Bool.Bool <> <> lib 6 | R2171:2174 Coq.Lists.List <> <> lib 7 | R2176:2178 Coq.Init.Nat <> <> lib 8 | R2180:2188 Coq.Init.Datatypes <> <> lib 9 | R2190:2195 Coq.Strings.String <> <> lib 10 | R2213:2217 Triage.terms <> <> lib 11 | R2219:2223 Triage.types <> <> lib 12 | R2225:2232 Triage.subtypes <> <> lib 13 | R2234:2239 Triage.derive <> <> lib 14 | prf 2311:2329 <> derive_occurs_false 15 | binder 2341:2345 <> gamma:1 16 | binder 2347:2347 <> M:2 17 | binder 2349:2350 <> ty:3 18 | R2370:2394 Coq.Init.Logic <> ::type_scope:x_'->'_x not 19 | R2353:2358 Triage.derive <> derive ind 20 | R2360:2364 Triage.typed_lambda <> gamma:1 var 21 | R2366:2366 Triage.typed_lambda <> M:2 var 22 | R2368:2369 Triage.typed_lambda <> ty:3 var 23 | binder 2402:2402 <> x:4 24 | binder 2404:2406 <> uty:5 25 | binder 2408:2413 <> gamma1:6 26 | R2440:2443 Coq.Init.Logic <> ::type_scope:x_'->'_x not 27 | R2421:2423 Coq.Init.Logic <> ::type_scope:x_'='_x not 28 | R2416:2420 Triage.typed_lambda <> gamma:1 var 29 | R2431:2433 Coq.Init.Datatypes <> ::list_scope:x_'::'_x not 30 | R2424:2424 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 31 | R2426:2426 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 32 | R2430:2430 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 33 | R2425:2425 Triage.typed_lambda <> x:4 var 34 | R2427:2429 Triage.typed_lambda <> uty:5 var 35 | R2434:2439 Triage.typed_lambda <> gamma1:6 var 36 | R2462:2507 Coq.Init.Logic <> ::type_scope:x_'->'_x not 37 | R2454:2456 Coq.Init.Logic <> ::type_scope:x_'='_x not 38 | R2444:2449 Triage.terms <> occurs def 39 | R2451:2451 Triage.typed_lambda <> x:4 var 40 | R2453:2453 Triage.typed_lambda <> M:2 var 41 | R2457:2461 Coq.Init.Datatypes <> false constr 42 | R2508:2513 Triage.derive <> derive ind 43 | R2515:2520 Triage.typed_lambda <> gamma1:6 var 44 | R2522:2522 Triage.typed_lambda <> M:2 var 45 | R2524:2525 Triage.typed_lambda <> ty:3 var 46 | R2634:2643 Triage.derive <> derive_ref constr 47 | R2634:2643 Triage.derive <> derive_ref constr 48 | R2665:2677 Coq.Bool.Bool <> orb_false_iff thm 49 | R2704:2713 Triage.derive <> derive_app constr 50 | R2665:2677 Coq.Bool.Bool <> orb_false_iff thm 51 | R2665:2677 Coq.Bool.Bool <> orb_false_iff thm 52 | R2704:2713 Triage.derive <> derive_app constr 53 | prf 2766:2785 <> derive_occurs_false2 54 | binder 2797:2801 <> gamma:7 55 | binder 2803:2803 <> M:8 56 | binder 2805:2806 <> ty:9 57 | R2826:2850 Coq.Init.Logic <> ::type_scope:x_'->'_x not 58 | R2809:2814 Triage.derive <> derive ind 59 | R2816:2820 Triage.typed_lambda <> gamma:7 var 60 | R2822:2822 Triage.typed_lambda <> M:8 var 61 | R2824:2825 Triage.typed_lambda <> ty:9 var 62 | binder 2858:2858 <> x:10 63 | binder 2860:2862 <> uty:11 64 | R2883:2928 Coq.Init.Logic <> ::type_scope:x_'->'_x not 65 | R2875:2877 Coq.Init.Logic <> ::type_scope:x_'='_x not 66 | R2865:2870 Triage.terms <> occurs def 67 | R2872:2872 Triage.typed_lambda <> x:10 var 68 | R2874:2874 Triage.typed_lambda <> M:8 var 69 | R2878:2882 Coq.Init.Datatypes <> false constr 70 | R2941:2944 Coq.Init.Logic <> ::type_scope:x_'->'_x not 71 | R2934:2937 Coq.Init.Logic <> ::type_scope:x_'<>'_x not 72 | R2929:2933 Triage.typed_lambda <> gamma:7 var 73 | R2938:2940 Coq.Init.Datatypes <> nil constr 74 | R2945:2950 Triage.derive <> derive ind 75 | R2960:2962 Coq.Init.Datatypes <> ::list_scope:x_'::'_x not 76 | R2953:2953 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 77 | R2955:2955 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 78 | R2959:2959 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 79 | R2954:2954 Triage.typed_lambda <> x:10 var 80 | R2956:2958 Triage.typed_lambda <> uty:11 var 81 | R2963:2967 Triage.typed_lambda <> gamma:7 var 82 | R2970:2970 Triage.typed_lambda <> M:8 var 83 | R2972:2973 Triage.typed_lambda <> ty:9 var 84 | R3067:3069 Triage.types <> get def 85 | R3086:3088 Triage.types <> get def 86 | R3102:3105 Coq.Init.Datatypes <> ::list_scope:x_'::'_x not 87 | R3093:3093 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 88 | R3096:3097 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 89 | R3101:3101 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 90 | R3157:3166 Triage.derive <> derive_ref constr 91 | R3067:3069 Triage.types <> get def 92 | R3086:3088 Triage.types <> get def 93 | R3102:3105 Coq.Init.Datatypes <> ::list_scope:x_'::'_x not 94 | R3093:3093 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 95 | R3096:3097 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 96 | R3101:3101 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 97 | R3157:3166 Triage.derive <> derive_ref constr 98 | R3216:3228 Coq.Bool.Bool <> orb_false_iff thm 99 | R3254:3263 Triage.derive <> derive_app constr 100 | R3216:3228 Coq.Bool.Bool <> orb_false_iff thm 101 | R3216:3228 Coq.Bool.Bool <> orb_false_iff thm 102 | R3254:3263 Triage.derive <> derive_app constr 103 | prf 3323:3336 <> derive_ref_sub 104 | binder 3348:3352 <> gamma:12 105 | binder 3354:3354 <> M:13 106 | binder 3356:3357 <> ty:14 107 | R3381:3388 Coq.Init.Logic <> ::type_scope:x_'->'_x not 108 | R3364:3369 Triage.derive <> derive ind 109 | R3371:3375 Triage.typed_lambda <> gamma:12 var 110 | R3377:3377 Triage.typed_lambda <> M:13 var 111 | R3379:3380 Triage.typed_lambda <> ty:14 var 112 | binder 3396:3396 <> s:15 113 | binder 3398:3400 <> uty:16 114 | binder 3402:3407 <> gamma1:17 115 | R3434:3437 Coq.Init.Logic <> ::type_scope:x_'->'_x not 116 | R3415:3417 Coq.Init.Logic <> ::type_scope:x_'='_x not 117 | R3410:3414 Triage.typed_lambda <> gamma:12 var 118 | R3425:3427 Coq.Init.Datatypes <> ::list_scope:x_'::'_x not 119 | R3418:3418 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 120 | R3420:3420 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 121 | R3424:3424 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 122 | R3419:3419 Triage.typed_lambda <> s:15 var 123 | R3421:3423 Triage.typed_lambda <> uty:16 var 124 | R3428:3433 Triage.typed_lambda <> gamma1:17 var 125 | R3447:3450 Coq.Init.Logic <> ::type_scope:x_'->'_x not 126 | R3439:3441 Coq.Init.Logic <> ::type_scope:x_'='_x not 127 | R3438:3438 Triage.typed_lambda <> M:13 var 128 | R3442:3444 Triage.terms <> Ref constr 129 | R3446:3446 Triage.typed_lambda <> s:15 var 130 | R3451:3457 Triage.subtypes <> subtype ind 131 | R3459:3461 Triage.typed_lambda <> uty:16 var 132 | R3463:3464 Triage.typed_lambda <> ty:14 var 133 | R3587:3601 Coq.Strings.String <> eqb_refl thm 134 | R3587:3601 Coq.Strings.String <> eqb_refl thm 135 | R3587:3601 Coq.Strings.String <> eqb_refl thm 136 | prf 3642:3652 <> derive_star 137 | binder 3664:3664 <> M:18 138 | binder 3666:3670 <> gamma:19 139 | binder 3672:3672 <> x:20 140 | binder 3674:3676 <> uty:21 141 | binder 3678:3679 <> ty:22 142 | R3712:3715 Coq.Init.Logic <> ::type_scope:x_'->'_x not 143 | R3682:3687 Triage.derive <> derive ind 144 | R3697:3700 Coq.Init.Datatypes <> ::list_scope:x_'::'_x not 145 | R3690:3690 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 146 | R3692:3692 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 147 | R3696:3696 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 148 | R3691:3691 Triage.typed_lambda <> x:20 var 149 | R3693:3695 Triage.typed_lambda <> uty:21 var 150 | R3701:3705 Triage.typed_lambda <> gamma:19 var 151 | R3708:3708 Triage.typed_lambda <> M:18 var 152 | R3710:3711 Triage.typed_lambda <> ty:22 var 153 | R3716:3721 Triage.derive <> derive ind 154 | R3723:3727 Triage.typed_lambda <> gamma:19 var 155 | R3730:3733 Triage.terms <> star def 156 | R3735:3735 Triage.typed_lambda <> x:20 var 157 | R3737:3737 Triage.typed_lambda <> M:18 var 158 | R3741:3745 Triage.types <> Funty constr 159 | R3747:3749 Triage.typed_lambda <> uty:21 var 160 | R3751:3752 Triage.typed_lambda <> ty:22 var 161 | binder 3776:3776 <> M:23 162 | binder 3778:3783 <> gamma0:24 163 | binder 3785:3786 <> ty:25 164 | R3816:3828 Coq.Init.Logic <> ::type_scope:x_'->'_x not 165 | R3798:3803 Triage.derive <> derive ind 166 | R3805:3810 Triage.typed_lambda <> gamma0:24 var 167 | R3812:3812 Triage.typed_lambda <> M:23 var 168 | R3814:3815 Triage.typed_lambda <> ty:25 var 169 | binder 3836:3836 <> x:26 170 | binder 3838:3840 <> uty:27 171 | binder 3842:3846 <> gamma:28 172 | R3874:3877 Coq.Init.Logic <> ::type_scope:x_'->'_x not 173 | R3855:3858 Coq.Init.Logic <> ::type_scope:x_'='_x not 174 | R3873:3873 Coq.Init.Logic <> ::type_scope:x_'='_x not 175 | R3849:3854 Triage.typed_lambda <> gamma0:24 var 176 | R3866:3867 Coq.Init.Datatypes <> ::list_scope:x_'::'_x not 177 | R3859:3859 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 178 | R3861:3861 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 179 | R3865:3865 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 180 | R3860:3860 Triage.typed_lambda <> x:26 var 181 | R3862:3864 Triage.typed_lambda <> uty:27 var 182 | R3868:3872 Triage.typed_lambda <> gamma:28 var 183 | R3878:3883 Triage.derive <> derive ind 184 | R3885:3889 Triage.typed_lambda <> gamma:28 var 185 | R3892:3895 Triage.terms <> star def 186 | R3897:3897 Triage.typed_lambda <> x:26 var 187 | R3899:3899 Triage.typed_lambda <> M:23 var 188 | R3903:3907 Triage.types <> Funty constr 189 | R3909:3911 Triage.typed_lambda <> uty:27 var 190 | R3913:3914 Triage.typed_lambda <> ty:25 var 191 | binder 3776:3776 <> M:29 192 | binder 3778:3783 <> gamma0:30 193 | binder 3785:3786 <> ty:31 194 | R3816:3828 Coq.Init.Logic <> ::type_scope:x_'->'_x not 195 | R3798:3803 Triage.derive <> derive ind 196 | R3805:3810 Triage.typed_lambda <> gamma0:30 var 197 | R3812:3812 Triage.typed_lambda <> M:29 var 198 | R3814:3815 Triage.typed_lambda <> ty:31 var 199 | binder 3836:3836 <> x:32 200 | binder 3838:3840 <> uty:33 201 | binder 3842:3846 <> gamma:34 202 | R3874:3877 Coq.Init.Logic <> ::type_scope:x_'->'_x not 203 | R3855:3858 Coq.Init.Logic <> ::type_scope:x_'='_x not 204 | R3873:3873 Coq.Init.Logic <> ::type_scope:x_'='_x not 205 | R3849:3854 Triage.typed_lambda <> gamma0:30 var 206 | R3866:3867 Coq.Init.Datatypes <> ::list_scope:x_'::'_x not 207 | R3859:3859 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 208 | R3861:3861 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 209 | R3865:3865 Coq.Init.Datatypes <> ::core_scope:'('_x_','_x_','_'..'_','_x_')' not 210 | R3860:3860 Triage.typed_lambda <> x:32 var 211 | R3862:3864 Triage.typed_lambda <> uty:33 var 212 | R3868:3872 Triage.typed_lambda <> gamma:34 var 213 | R3878:3883 Triage.derive <> derive ind 214 | R3885:3889 Triage.typed_lambda <> gamma:34 var 215 | R3892:3895 Triage.terms <> star def 216 | R3897:3897 Triage.typed_lambda <> x:32 var 217 | R3899:3899 Triage.typed_lambda <> M:29 var 218 | R3903:3907 Triage.types <> Funty constr 219 | R3909:3911 Triage.typed_lambda <> uty:33 var 220 | R3913:3914 Triage.typed_lambda <> ty:31 var 221 | R4035:4036 Coq.Strings.String <> ::string_scope:x_'=?'_x not 222 | R4108:4121 Triage.derive <> derive_subtype thm 223 | R4134:4141 Triage.derive <> derive_I thm 224 | R4182:4190 Triage.derive <> derive_K1 thm 225 | R4035:4036 Coq.Strings.String <> ::string_scope:x_'=?'_x not 226 | R4108:4121 Triage.derive <> derive_subtype thm 227 | R4134:4141 Triage.derive <> derive_I thm 228 | R4182:4190 Triage.derive <> derive_K1 thm 229 | R4213:4221 Triage.derive <> derive_K1 thm 230 | R4213:4221 Triage.derive <> derive_K1 thm 231 | R4276:4278 Coq.Strings.String <> ::string_scope:x_'=?'_x not 232 | R4276:4278 Coq.Strings.String <> ::string_scope:x_'=?'_x not 233 | R4315:4317 Coq.Init.Logic <> ::type_scope:x_'='_x not 234 | R4332:4344 Coq.Strings.String <> eqb_eq thm 235 | R4371:4377 Triage.subtypes <> subtype ind 236 | R4397:4410 Triage.typed_lambda <> derive_ref_sub thm 237 | R4439:4444 Triage.terms <> occurs def 238 | R4488:4496 Triage.derive <> derive_S2 thm 239 | R4527:4541 Coq.Strings.String <> eqb_refl thm 240 | R4551:4559 Triage.derive <> derive_S2 thm 241 | R4571:4584 Triage.derive <> derive_subtype thm 242 | R4698:4711 Triage.derive <> derive_subtype thm 243 | R4723:4730 Triage.derive <> derive_I thm 244 | R4315:4317 Coq.Init.Logic <> ::type_scope:x_'='_x not 245 | R4332:4344 Coq.Strings.String <> eqb_eq thm 246 | R4371:4377 Triage.subtypes <> subtype ind 247 | R4397:4410 Triage.typed_lambda <> derive_ref_sub thm 248 | R4439:4444 Triage.terms <> occurs def 249 | R4488:4496 Triage.derive <> derive_S2 thm 250 | R4527:4541 Coq.Strings.String <> eqb_refl thm 251 | R4527:4541 Coq.Strings.String <> eqb_refl thm 252 | R4551:4559 Triage.derive <> derive_S2 thm 253 | R4571:4584 Triage.derive <> derive_subtype thm 254 | R4698:4711 Triage.derive <> derive_subtype thm 255 | R4723:4730 Triage.derive <> derive_I thm 256 | R4777:4782 Triage.terms <> occurs def 257 | R4837:4845 Triage.derive <> derive_S2 thm 258 | R4865:4873 Triage.derive <> derive_K1 thm 259 | R4884:4902 Triage.typed_lambda <> derive_occurs_false thm 260 | R4934:4942 Triage.derive <> derive_K1 thm 261 | R4952:4961 Triage.derive <> derive_app constr 262 | R4978:4996 Triage.typed_lambda <> derive_occurs_false thm 263 | R4777:4782 Triage.terms <> occurs def 264 | R4837:4845 Triage.derive <> derive_S2 thm 265 | R4865:4873 Triage.derive <> derive_K1 thm 266 | R4884:4902 Triage.typed_lambda <> derive_occurs_false thm 267 | R4934:4942 Triage.derive <> derive_K1 thm 268 | R4952:4961 Triage.derive <> derive_app constr 269 | R4978:4996 Triage.typed_lambda <> derive_occurs_false thm 270 | R4978:4996 Triage.typed_lambda <> derive_occurs_false thm 271 | R5020:5025 Triage.terms <> occurs def 272 | R5068:5076 Triage.derive <> derive_S2 thm 273 | R5093:5101 Triage.derive <> derive_K1 thm 274 | R5111:5129 Triage.typed_lambda <> derive_occurs_false thm 275 | R5157:5165 Triage.derive <> derive_K1 thm 276 | R5175:5184 Triage.derive <> derive_app constr 277 | R5194:5212 Triage.typed_lambda <> derive_occurs_false thm 278 | R5020:5025 Triage.terms <> occurs def 279 | R5068:5076 Triage.derive <> derive_S2 thm 280 | R5093:5101 Triage.derive <> derive_K1 thm 281 | R5111:5129 Triage.typed_lambda <> derive_occurs_false thm 282 | R5157:5165 Triage.derive <> derive_K1 thm 283 | R5175:5184 Triage.derive <> derive_app constr 284 | R5194:5212 Triage.typed_lambda <> derive_occurs_false thm 285 | R5194:5212 Triage.typed_lambda <> derive_occurs_false thm 286 | R5250:5252 Coq.Init.Datatypes <> ::bool_scope:x_'||'_x not 287 | R5240:5245 Triage.terms <> occurs def 288 | R5253:5258 Triage.terms <> occurs def 289 | R5264:5266 Triage.terms <> ::tree_scope:x_'@'_x not 290 | R5301:5309 Triage.derive <> derive_S2 thm 291 | R5375:5383 Triage.derive <> derive_K1 thm 292 | R5393:5411 Triage.typed_lambda <> derive_occurs_false thm 293 | R5444:5453 Triage.derive <> derive_app constr 294 | R5250:5252 Coq.Init.Datatypes <> ::bool_scope:x_'||'_x not 295 | R5240:5245 Triage.terms <> occurs def 296 | R5253:5258 Triage.terms <> occurs def 297 | R5264:5266 Triage.terms <> ::tree_scope:x_'@'_x not 298 | R5301:5309 Triage.derive <> derive_S2 thm 299 | R5375:5383 Triage.derive <> derive_K1 thm 300 | R5393:5411 Triage.typed_lambda <> derive_occurs_false thm 301 | R5444:5453 Triage.derive <> derive_app constr 302 | -------------------------------------------------------------------------------- /typed_lambda.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Lambda Abstraction *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | Require Import Arith Lia Bool List Nat Datatypes String. 34 | Require Import terms types subtypes derive. 35 | 36 | 37 | Set Default Proof Using "Type". 38 | 39 | Open Scope string_scope. 40 | 41 | 42 | Lemma derive_occurs_false: 43 | forall gamma M ty, derive gamma M ty -> 44 | forall x uty gamma1, gamma = (x,uty):: gamma1 -> occurs x M = false -> 45 | derive gamma1 M ty. 46 | Proof. 47 | intros gamma M ty d; induction d; intros; subst; simpl in *; auto_t. 48 | - rewrite H2 in *; eapply derive_ref; eauto. 49 | - rewrite orb_false_iff in *; split_all; eapply derive_app; [ eapply IHd1 | eapply IHd2]; eauto. 50 | Qed. 51 | 52 | Lemma derive_occurs_false2: 53 | forall gamma M ty, derive gamma M ty -> 54 | forall x uty, occurs x M = false -> 55 | gamma <> nil -> derive ((x,uty):: gamma) M ty. 56 | Proof. 57 | intros gamma M ty d; induction d; intros; subst; simpl in *; auto_t. 58 | - replace (get x gamma) with (get x ((x0, uty) :: gamma)) by (simpl; rewrite H1; auto); 59 | eapply derive_ref; simpl; [rewrite H1; eauto | auto]. 60 | - rewrite orb_false_iff in *; split_all; eapply derive_app; [ eapply IHd1 | eapply IHd2]; eauto. 61 | Qed. 62 | 63 | 64 | Proposition derive_ref_sub: 65 | forall gamma M ty, 66 | derive gamma M ty -> 67 | forall s uty gamma1, gamma = (s,uty):: gamma1 -> M = Ref s -> subtype uty ty. 68 | Proof. 69 | intros gamma M ty d; induction d; intros; subst; auto_t; try discriminate; 70 | inv_out H2; simpl in *; rewrite String.eqb_refl in *; inv_out H; auto. 71 | Qed. 72 | 73 | 74 | Theorem derive_star: 75 | forall M gamma x uty ty, derive ((x,uty) :: gamma) M ty -> derive gamma (star x M) (Funty uty ty). 76 | Proof. 77 | cut(forall M gamma0 ty, 78 | derive gamma0 M ty -> 79 | forall x uty gamma, gamma0 = ((x,uty)::gamma) -> derive gamma (star x M) (Funty uty ty)); [ 80 | intros; eapply H; eauto |]; 81 | intros M gamma0 ty d; induction d; intros; subst; simpl in *. 82 | - caseEq (x0=?x)%string; intros; subst; rewrite H1 in *; [ 83 | inv_out H; eapply derive_subtype; [ eapply derive_I | sub_fun_tac; auto] | 84 | eapply derive_K1; auto_t]. 85 | - eapply derive_K1; auto_t. 86 | - caseEq N; intros; subst. 87 | + caseEq (x=? s)%string; intros. 88 | * assert(x = s) by (eapply String.eqb_eq; eauto); subst; assert(subtype uty u) by (eapply derive_ref_sub; eauto); 89 | caseEq (occurs s M); intros; simpl; [ 90 | eapply derive_S2; eauto | 91 | rewrite String.eqb_refl; eapply derive_S2; [ eapply derive_subtype; [ eapply IHd1; eauto |sub_funty_tac; auto_t] | 92 | eapply derive_subtype; [ eapply derive_I | sub_funty_tac; auto_t]]]. 93 | * caseEq (occurs x M); intros; simpl; rewrite H; [ 94 | eapply derive_S2; [ eauto | eapply derive_K1; eapply derive_occurs_false; eauto] |]; 95 | eapply derive_K1; eapply derive_app; eauto; eapply derive_occurs_false; eauto. 96 | + caseEq (occurs x M); intros; simpl; [ 97 | eapply derive_S2; eauto; eapply derive_K1; eapply derive_occurs_false; eauto | 98 | eapply derive_K1; eapply derive_app; eapply derive_occurs_false; eauto]. 99 | + caseEq (occurs x M|| occurs x (t @ t0)); intros; [ 100 | eapply derive_S2; [ eapply IHd1; eauto | eapply IHd2; eauto] | 101 | eapply derive_K1; eapply derive_occurs_false; [ | | simpl; eauto]; [ eapply derive_app; eauto | eauto]]. 102 | Qed. 103 | 104 | 105 | 106 | -------------------------------------------------------------------------------- /typed_lambda.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_lambda.vo -------------------------------------------------------------------------------- /typed_lambda.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_lambda.vok -------------------------------------------------------------------------------- /typed_lambda.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_lambda.vos -------------------------------------------------------------------------------- /typed_program_analysis.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_program_analysis.pdf -------------------------------------------------------------------------------- /typed_recursion.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Typed Recursion *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | 34 | 35 | Require Import String Arith Lia Bool List Nat Datatypes. 36 | Require Import terms types subtypes derive typed_lambda. 37 | 38 | 39 | Open Scope string_scope. 40 | Open Scope nat_scope. 41 | 42 | 43 | 44 | Set Default Proof Using "Type". 45 | 46 | 47 | (*** Fixpoints *) 48 | 49 | 50 | 51 | Theorem derive_Z: 52 | forall k gamma f uty vty, 53 | derive gamma f (Funty ((quant k (Funty uty vty))) ((quant k (Funty uty vty)))) -> 54 | derive gamma (Z f) (quant k (Funty uty vty)). 55 | Proof. 56 | intros; eapply derive_generalisation_q; eapply derive_wait2; eauto; [ | | 57 | eapply derive_generalisation2_q; eapply derive_subtype; eauto; eapply subtype_lift]; [ 58 | | eapply lift_rec_preserves_derive; eapply programs_have_types; program_tac]; 59 | eapply derive_subtype; [ eapply lift_rec_preserves_derive; eapply programs_have_types; program_tac |]; 60 | eapply sub_trans; [ | do 2 sub_fun_tac; eapply subtype_lift3]; 61 | unfold lift; rewrite <- ! lift_rec_funty; eapply lift_rec_preserves_subtype; eapply sub_recursion. 62 | Qed. 63 | 64 | 65 | 66 | 67 | Theorem derive_Y2: 68 | forall gamma f uty vty, 69 | derive gamma f (Funty uty (Funty (Funty uty vty) vty)) -> 70 | derive gamma (Yop2 f) (Funty uty vty). 71 | Proof. 72 | intros; eapply derive_subtype; [ eapply (derive_Z 0); eapply derive_swap; eauto | apply sub_zero]. 73 | Qed. 74 | 75 | 76 | 77 | (*** Booleans and Arithmetic *) 78 | 79 | Definition Bool_ty := Quant (Funty (Var 0) (Funty (Var 0) (Var 0))). 80 | 81 | Lemma derive_true: forall gamma, derive gamma K Bool_ty. 82 | Proof. intro; repeat eapply derive_generalisation; eapply derive_K. Qed. 83 | 84 | Lemma derive_false: forall gamma, derive gamma KI Bool_ty. 85 | Proof. 86 | intro; repeat eapply derive_generalisation; eapply derive_app; [eapply derive_K | eapply derive_I]. 87 | Qed. 88 | 89 | 90 | Definition Nat_ty := Quant (Funty (Funty (Var 0) (Var 0)) (Funty (Var 0) (Var 0))). 91 | 92 | 93 | Lemma derive_Kn : forall utys gamma ty, derive gamma (Kn (length utys)) (Funty ty (fold_right Funty ty utys)). 94 | Proof. 95 | induction utys; intros; simpl. 96 | - eapply derive_I. 97 | - rewrite orb_true_r; eapply derive_S2; [ 98 | eapply derive_K1; eapply derive_K | 99 | eapply derive_S2; [ | eapply derive_I]; eapply derive_star; eauto]. 100 | Qed. 101 | 102 | Lemma derive_compose1 : 103 | forall utys gamma vty wty, 104 | derive gamma (compose1 (length utys)) 105 | (Funty (fold_right Funty (Funty vty wty) utys) 106 | (Funty (fold_right Funty vty utys) 107 | (fold_right Funty wty utys) 108 | )). 109 | Proof. 110 | induction utys; intros; simpl. 111 | - eapply derive_I. 112 | - rewrite ! orb_true_r; do 2 eapply derive_star; eapply derive_S2; [ 113 | eapply derive_S2; [ eapply derive_star; eapply IHutys |] | 114 | eapply derive_S2; [ eapply derive_K1; eapply derive_ref; simpl; eauto; eapply sub_zero | eapply derive_I]]; 115 | eapply derive_S2; [ eapply derive_K1; eapply derive_ref; simpl; eauto; eapply sub_zero | eapply derive_I]. 116 | Qed. 117 | 118 | Lemma derive_compose0 : 119 | forall vtys gamma utys wty, 120 | derive gamma (compose0 (length vtys) (length utys)) 121 | (Funty 122 | (fold_right Funty (fold_right Funty wty vtys) utys) (* type of g *) 123 | (fold_right Funty (fold_right Funty wty utys) 124 | (map (fun vty => fold_right Funty vty utys) vtys) (* types of fs *) 125 | )). 126 | Proof. 127 | induction vtys; intros; simpl. 128 | - eapply derive_I. 129 | - rewrite ! orb_true_r; 130 | rewrite compose1_closed; unfold orb; 131 | eapply derive_star; eapply derive_S2. eapply derive_star; eauto. 132 | eapply derive_S2; [ | eapply derive_I]; eapply derive_K1; 133 | eapply derive_app; [ eapply derive_compose1 | 134 | eapply derive_ref; simpl; eauto; eapply sub_zero]. 135 | Qed. 136 | 137 | 138 | Theorem derive_compose : 139 | forall gamma vtys utys wty, 140 | derive gamma (compose (length vtys) (length utys)) 141 | (Funty 142 | (fold_right Funty wty vtys) (* type of g *) 143 | (fold_right Funty (fold_right Funty wty utys) 144 | (map (fun vty => fold_right Funty vty utys) vtys) (* types of fs *) 145 | )). 146 | Proof. intros; eapply derive_S2; [ eapply derive_K1; eapply derive_compose0 | eapply derive_Kn]. Qed. 147 | 148 | 149 | Definition product uty vty := 150 | Quant (Funty (Funty (lift 1 uty) (Funty (lift 1 vty) (Var 0))) (Var 0)). 151 | 152 | 153 | 154 | Theorem derive_pairL : forall gamma m n uty vty, 155 | derive gamma m uty -> derive gamma n vty -> derive gamma (pairL m n) (product uty vty). 156 | Proof. 157 | intros; eapply derive_generalisation; eapply derive_S2; [ eapply derive_S2; [ eapply derive_I |] |]; eapply derive_K1; eapply lift_rec_preserves_derive; eauto. 158 | Qed. 159 | 160 | 161 | Theorem derive_fstL : forall gamma uty vty, derive gamma fstL (Funty (product uty vty) uty). 162 | Proof. 163 | intros; eapply derive_S2; [ eapply derive_subtype; [ eapply derive_I | sub_fun_tac; subst_tac] | 164 | eapply derive_K1; eapply derive_K]. 165 | Qed. 166 | 167 | Theorem derive_sndL : forall gamma uty vty, derive gamma sndL (Funty (product uty vty) vty). 168 | Proof. 169 | intros; eapply derive_S2; [ eapply derive_subtype; [ eapply derive_I | sub_fun_tac; subst_tac] | 170 | eapply derive_K1; eapply derive_app; [ eapply derive_K | eapply derive_I]]. 171 | Qed. 172 | 173 | 174 | 175 | Theorem derive_succ1: forall gamma, derive gamma succ1 (Funty Nat_ty Nat_ty). 176 | Proof. 177 | intros; eapply derive_subtype with 178 | (quant 1 (Funty Nat_ty (Funty (Funty (Var 0) (Var 0)) (Funty (Var 0) (Var 0))))); [ 179 | | 180 | dist_tac; [ eapply sub_trans; [ eapply sub_lift | cbv; eapply sub_zero] | eapply sub_zero]]; 181 | eapply derive_generalisation; eapply derive_app; [ 182 | | 183 | eapply derive_app; [ 184 | eapply derive_node; eapply sub_leaf_fun | 185 | repeat eapply derive_S2; repeat eapply derive_K1; [ | | eapply derive_K]; eapply derive_node; eapply sub_leaf_fun]]; 186 | eapply derive_node; eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac; repeat sub_fork2_tac; [ | subst_tac]; auto_t]. 187 | Qed. 188 | 189 | 190 | 191 | Lemma num_closed: forall k x, occurs x (num k) = false. 192 | Proof. induction k; intros; simpl; auto; rewrite IHk; auto. Qed. 193 | 194 | Lemma derive_num: forall k gamma, derive gamma (num k) Nat_ty. 195 | Proof. 196 | induction k; intros; unfold num; fold num; simpl. 197 | - eapply derive_generalisation; simpl; eapply derive_K1; eapply derive_I. 198 | - replace (iter k (fun x => succ1 @ x) zero) with (num k) by auto; eapply derive_app; [ eapply derive_succ1 | eauto]. 199 | Qed. 200 | 201 | 202 | Theorem derive_isZero: forall gamma, derive gamma isZero (Funty Nat_ty Bool_ty). 203 | Proof. 204 | intros; eapply derive_star; eapply derive_app; [ eapply derive_app | ]; [ 205 | eapply derive_subtype; [ eapply derive_ref; simpl; eauto; eapply sub_zero | subst_tac] | 206 | eapply derive_K1; eapply derive_false | 207 | eapply derive_true]. 208 | Qed. 209 | 210 | 211 | Theorem derive_cond: forall gamma ty, derive gamma cond (Funty Bool_ty (Funty ty (Funty ty ty))). 212 | Proof. 213 | intros; eapply derive_S2; [ eapply derive_subtype; [ eapply derive_K | do 2 sub_fun_tac; subst_tac] | eapply derive_K]. 214 | Unshelve. apply Leaf. 215 | Qed. 216 | 217 | 218 | Proposition derive_PZero : forall gamma, derive gamma PZero (product Nat_ty Nat_ty). 219 | Proof. intros; eapply derive_pairL; eapply derive_generalisation; eapply derive_K1; eapply derive_I. Qed. 220 | 221 | Proposition derive_PSucc : forall gamma, derive gamma PSucc (Funty (product Nat_ty Nat_ty) (product Nat_ty Nat_ty)). 222 | Proof. 223 | intros; unfold PSucc; eapply derive_star; eapply derive_pairL; [ 224 | | eapply derive_app; [ eapply derive_succ1 |]]; 225 | (eapply derive_app; [ eapply derive_sndL 226 | | eapply derive_ref; simpl; eauto]; eapply sub_zero). 227 | Qed. 228 | 229 | 230 | 231 | Theorem derive_predN : forall gamma, derive gamma predN (Funty Nat_ty Nat_ty). 232 | Proof. 233 | intros; unfold predN; eapply derive_star; eapply derive_app; [ 234 | eapply derive_fstL |]; 235 | eapply derive_app; [ 236 | eapply derive_app; [ 237 | eapply derive_ref; simpl; eauto; subst_tac | 238 | eapply derive_PSucc] | 239 | eapply derive_PZero]. 240 | Qed. 241 | 242 | 243 | Proposition derive_primrec0: 244 | forall gamma g h, derive gamma g Nat_ty -> derive gamma h (Funty Nat_ty (Funty Nat_ty Nat_ty)) -> 245 | derive gamma (primrec0 g h) (Funty Nat_ty Nat_ty). 246 | Proof. 247 | intros; unfold primrec0; eapply derive_Y2; repeat eapply derive_S2; try eapply derive_K1; eauto; try eapply derive_K; 248 | try eapply derive_predN; [ 249 | | | 250 | eapply derive_subtype; [ eapply derive_isZero | sub_fun_tac; subst_tac] | | | 251 | eapply derive_app; [ | eapply derive_app; [ | eapply derive_I]; eapply derive_node; eapply sub_leaf_fun]]; 252 | eapply derive_node; try eapply sub_leaf_fun; try eapply subtype_leaf_fork; 253 | eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac; auto_t]. 254 | Unshelve. all: apply Leaf. 255 | Qed. 256 | 257 | 258 | Theorem derive_primrec: 259 | forall gamma xs g h, derive gamma g (iter (length xs) (Funty Nat_ty) Nat_ty) -> 260 | derive gamma h (iter (2 + length xs) (Funty Nat_ty) Nat_ty) -> 261 | Forall (fun x => derive gamma x Nat_ty) xs -> 262 | derive gamma (primrec g h xs) (Funty Nat_ty Nat_ty). 263 | Proof. 264 | intros; unfold primrec; eapply derive_primrec0. 265 | - generalize g H H1; clear; induction xs; intros; simpl in *; auto; eapply IHxs; [ 266 | eapply derive_app; eauto; inv_out H1; auto | 267 | inv_out H1; auto]. 268 | - generalize h H0 H1; clear; induction xs; intros; simpl in *; auto; eapply IHxs; [ 269 | eapply derive_app; eauto; inv_out H1; auto | inv_out H1; auto]. 270 | Qed. 271 | 272 | 273 | Proposition derive_minrec0: 274 | forall gamma f, derive gamma f (Funty Nat_ty Bool_ty) -> 275 | derive gamma (minrec0 f) (Funty Nat_ty Nat_ty). 276 | Proof. 277 | intros; eapply derive_Y2; eapply derive_S2; [ 278 | | 279 | eapply derive_S2; [ 280 | eapply derive_app; [ 281 | eapply derive_K | 282 | eapply derive_app; [ 283 | eapply derive_node; eapply subtype_leaf_fork | 284 | eapply derive_app; [ eapply derive_node; eapply sub_leaf_fun | eapply derive_I]]] | 285 | eapply derive_star; eapply derive_app; [ eapply derive_K | 286 | eapply derive_app; [ eapply derive_succ1 |]]; eapply derive_ref; simpl; eauto; eapply sub_zero]]; 287 | repeat eapply derive_app; 288 | try eapply derive_node; 289 | try eapply derive_ref; 290 | try eapply sub_zero; 291 | try eapply sub_leaf_stem; 292 | try eapply sub_leaf_fork; 293 | try eapply sub_leaf_fun; 294 | try eapply subtype_leaf_fork; 295 | eauto; 296 | eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac]; 297 | eapply sub_trans; [ eapply sub_fork | eapply sub_fork_stem]; [ 298 | eapply sub_stem; eapply sub_trans; [ eapply sub_fork_leaf | sub_fun_tac]; 299 | eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_fun_tac]; 300 | eapply sub_trans; [ eapply sub_fork | eapply sub_fork_stem]; [ 301 | eapply sub_stem; eapply sub_fork_leaf | 302 | eapply sub_trans; [ eapply sub_fork |eapply sub_fork_stem]; eapply sub_zero] |]; 303 | 304 | eapply sub_trans; [ eapply sub_fork | eapply sub_fork_stem]; [ 305 | eapply sub_stem; eapply sub_trans; [eapply sub_fork_leaf |]; sub_fun_tac; eapply sub_leaf_fun |]; 306 | eapply sub_trans; [ eapply sub_fork | eapply sub_fork_stem]; [ 307 | eapply sub_stem; eapply sub_trans; [ eapply sub_fork_leaf | sub_fun_tac]; eapply sub_stem_fun |]; 308 | eapply sub_trans; [ eapply sub_fork | eapply sub_fork_stem]; [ 309 | eapply sub_stem; eapply sub_trans; [ eapply sub_fork | eapply sub_fork_stem]; [ 310 | eapply sub_stem; eapply sub_trans; [ eapply sub_fork_leaf | do 2 sub_fun_tac; subst_tac] |]; 311 | eapply sub_trans; [ eapply sub_fork | eapply sub_fork_stem]; [ 312 | eapply sub_stem; eapply sub_trans; [ eapply sub_stem_fun | sub_fun_tac]; eapply sub_fork_leaf |]; 313 | eapply sub_stem_fun |]; 314 | eapply sub_trans; [ eapply sub_fork | eapply sub_fork_stem]; [ 315 | eapply sub_stem; eapply sub_trans; [ eapply sub_stem_fun | sub_fun_tac; eapply sub_fork_leaf] |]; 316 | eapply sub_stem_fun. 317 | Qed. 318 | 319 | Theorem derive_minrec: 320 | forall gamma xs f, derive gamma f (iter (length xs) (Funty Nat_ty) (Funty Nat_ty Bool_ty)) -> 321 | Forall (fun x => derive gamma x Nat_ty) xs -> 322 | derive gamma (minrec f xs) (Funty Nat_ty Nat_ty). 323 | Proof. 324 | intros; unfold minrec; eapply derive_minrec0; 325 | generalize f H H0; clear; induction xs; intros; simpl in *; auto; eapply IHxs; [ 326 | eapply derive_app; eauto; inv_out H0; auto | 327 | inv_out H0; auto]. 328 | Qed. 329 | 330 | 331 | 332 | -------------------------------------------------------------------------------- /typed_recursion.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_recursion.vo -------------------------------------------------------------------------------- /typed_recursion.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_recursion.vok -------------------------------------------------------------------------------- /typed_recursion.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_recursion.vos -------------------------------------------------------------------------------- /typed_triage.v: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* Copyright 2024 Barry Jay *) 3 | (* *) 4 | (* Permission is hereby granted, free of charge, to any person *) 5 | (* obtaining a copy of this software and associated documentation *) 6 | (* files (the "Software"), to deal in the Software without *) 7 | (* restriction, including without limitation the rights to use, copy, *) 8 | (* modify, merge, publish, distribute, sublicense, and/or sell copies *) 9 | (* of the Software, and to permit persons to whom the Software is *) 10 | (* furnished to do so, subject to the following conditions: *) 11 | (* *) 12 | (* The above copyright notice and this permission notice shall be *) 13 | (* included in all copies or substantial portions of the Software. *) 14 | (* *) 15 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 16 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *) 17 | (* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 18 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) 19 | (* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) 20 | (* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, *) 21 | (* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (**********************************************************************) 24 | 25 | (**********************************************************************) 26 | (* Typed Triage *) 27 | (* *) 28 | (* Barry Jay *) 29 | (* *) 30 | (**********************************************************************) 31 | 32 | 33 | Require Import String Arith Lia Bool List Nat Datatypes. 34 | Require Import terms types subtypes derive typed_lambda typed_recursion. 35 | 36 | Set Default Proof Using "Type". 37 | 38 | 39 | 40 | 41 | Theorem derive_triage : 42 | forall gamma ty f0 f1 f2, 43 | covariant ty -> 44 | derive gamma f0 (subst ty Leaf) -> 45 | derive gamma f1 (Quant (Funty (Var 0) (subst (lift_rec ty 1 1) (Stem (Var 0))))) -> 46 | derive gamma f2 (Quant (Quant 47 | (Funty (Var 1) 48 | (Funty (Var 0) 49 | (subst (lift_rec ty 1 2) (Fork (Var 1) (Var 0))))))) -> 50 | derive gamma (triage f0 f1 f2) (Funty (Var 0) (subst_rec ty (Var 0) 0)). 51 | Proof. 52 | intros; repeat eapply derive_app; eauto; eapply derive_node; [ 53 | (eapply sub_trans; [ eapply subtype_leaf_fork | do 2 sub_funty_tac]); 54 | eapply sub_tree; auto_t | 55 | eapply subtype_leaf_fork]. 56 | Qed. 57 | 58 | 59 | Theorem derive_query : 60 | forall gamma f0 f1 f2 vty, 61 | derive gamma f0 (lift 1 vty) -> 62 | derive gamma f1 (Quant (Funty (Var 0) (lift 2 vty))) -> 63 | derive gamma f2 64 | (Quant 65 | (Quant (Funty (Var 1) 66 | (Funty (Var 0) 67 | (lift 3 vty))))) -> 68 | derive gamma (triage f0 f1 f2) (Funty (Var 0) (lift 1 vty)). 69 | Proof. 70 | intros; 71 | replace (lift 1 vty) with (subst (lift 2 vty) (Var 0)) 72 | by (unfold subst, lift; rewrite subst_rec_lift_rec; try lia; auto); 73 | eapply derive_triage. 74 | - unfold covariant, lift; eapply lift_rec_preserves_variant2. 75 | - unfold subst, lift; rewrite subst_rec_lift_rec; try lia; auto_t. 76 | - unfold subst, lift; rewrite lift_rec_lift_rec; try lia; rewrite subst_rec_lift_rec; try lia; auto_t. 77 | - unfold subst, lift; rewrite lift_rec_lift_rec; try lia; simpl; rewrite subst_rec_lift_rec; try lia; auto. 78 | Qed. 79 | 80 | 81 | 82 | Theorem derive_update : 83 | forall gamma f0 f1 f2, 84 | derive gamma f0 Leaf -> 85 | derive gamma f1 (Quant (Funty (Var 0) (Stem (Var 0)))) -> 86 | derive gamma f2 (Quant (Quant (Funty (Var 1) (Funty (Var 0) (Fork(Var 1) (Var 0)))))) -> 87 | derive gamma (triage f0 f1 f2) (Funty (Var 0) (Var 0)). 88 | Proof. 89 | intros; replace (Var 0) with (subst (Var 0) (Var 0)) at 2 by (cbv; auto); 90 | eapply derive_triage; eauto; cbv; auto_t. 91 | Qed. 92 | 93 | 94 | 95 | 96 | (* querying trees *) 97 | 98 | 99 | Definition isLeaf := triage K (K@ KI) (K @ (K @ KI)). 100 | Definition isStem := triage KI (K@ K) (K @ (K @ KI)). 101 | Definition isFork := triage KI (K@ KI) (K @ (K @ K)). 102 | 103 | 104 | Theorem derive_isLeaf: forall gamma, derive gamma isLeaf (Quant (Funty (Var 0) Bool_ty)). 105 | Proof. 106 | intros; eapply derive_generalisation; 107 | replace Bool_ty with (lift 1 Bool_ty) by (cbv; auto); 108 | eapply derive_query. 109 | - eapply derive_true. 110 | - eapply derive_generalisation; eapply derive_app; [ eapply derive_K | eapply derive_false]. 111 | - repeat eapply derive_generalisation; eapply derive_app; [ eapply derive_K |]; 112 | eapply derive_app; [ eapply derive_K | eapply derive_false]. 113 | Qed. 114 | 115 | Theorem derive_isStem: forall gamma, derive gamma isStem (Quant (Funty (Var 0) Bool_ty)). 116 | Proof. 117 | intros; eapply derive_generalisation; 118 | replace Bool_ty with (lift 1 Bool_ty) by (cbv; auto); 119 | eapply derive_query. 120 | - eapply derive_false. 121 | - eapply derive_generalisation; eapply derive_app; [ eapply derive_K | eapply derive_true]. 122 | - repeat eapply derive_generalisation; 123 | eapply derive_app; [ eapply derive_K | 124 | eapply derive_app; [ eapply derive_K | eapply derive_false]]. 125 | Qed. 126 | 127 | 128 | Theorem derive_isFork: forall gamma, derive gamma isFork (Quant (Funty (Var 0) Bool_ty)). 129 | Proof. 130 | intros; eapply derive_generalisation; 131 | replace Bool_ty with (lift 1 Bool_ty) by (cbv; auto); 132 | eapply derive_query. 133 | - eapply derive_false. 134 | - eapply derive_generalisation; eapply derive_app; [ eapply derive_K | eapply derive_false]. 135 | - repeat eapply derive_generalisation; eapply derive_app; [ eapply derive_K |]; 136 | eapply derive_app; [ eapply derive_K | eapply derive_true]. 137 | Qed. 138 | 139 | (*** Size *) 140 | 141 | 142 | Lemma derive_prim_plus: 143 | forall gamma, derive gamma prim_plus 144 | (Funty (Quant (Funty (Funty (Var 0) (Var 0)) (Funty (Var 0) (Var 0)))) 145 | (Funty (Quant (Funty (Funty (Var 0) (Var 0)) (Funty (Var 0) (Var 0)))) 146 | Nat_ty)). 147 | Proof. 148 | intros; eapply derive_star; unfold prim_plus0; eapply derive_primrec; simpl. 149 | - eapply derive_I. 150 | - do 2 eapply derive_K1; eapply derive_S2; [ | eapply derive_I]; eapply derive_K1; 151 | eapply derive_subtype with (Quant (Funty (Funty (Funty (Var 0) (Var 0)) (Funty (Var 0) (Var 0))) 152 | (Funty (Funty (Var 0) (Var 0)) (Funty (Var 0) (Var 0))))); [ | 153 | eapply sub_dist]; 154 | eapply derive_generalisation; 155 | eapply derive_S1; eapply derive_S2; [ eapply derive_K1; eapply derive_node | ]; [ 156 | eapply sub_trans; [ 157 | eapply subtype_leaf_fork; apply sub_fork_stem | 158 | do 2 sub_fun_tac]; sub_fork2_tac |]; 159 | eapply derive_S2; [ 160 | eapply derive_K1; eapply derive_node; eapply sub_leaf_fun | 161 | eapply derive_K]. 162 | - eapply Forall_cons; [ | eapply Forall_nil]; eapply derive_ref; simpl; auto_t. 163 | Qed. 164 | 165 | Lemma derive_prim_succ_plus: 166 | forall gamma, derive gamma prim_succ_plus 167 | (Funty (Quant (Funty (Funty (Var 0) (Var 0)) (Funty (Var 0) (Var 0)))) 168 | (Funty (Quant (Funty (Funty (Var 0) (Var 0)) (Funty (Var 0) (Var 0)))) 169 | Nat_ty)). 170 | Proof. 171 | intros; do 2 eapply derive_star; 172 | eapply derive_app; [ eapply derive_succ1 |]; 173 | eapply derive_app; [ eapply derive_app; [ eapply derive_prim_plus |] |]; 174 | eapply derive_ref; simpl; auto_t. 175 | Qed. 176 | 177 | 178 | Theorem derive_size : forall gamma, derive gamma size (quant 1 (Funty (Var 0) Nat_ty)). 179 | Proof. 180 | intros; eapply derive_Z; eapply derive_star; eapply derive_generalisation; 181 | replace Nat_ty with (lift 1 Nat_ty) by (cbv; auto); eapply derive_query. 182 | - replace (lift 1 Nat_ty) with Nat_ty by (cbv; auto); 183 | eapply derive_app; [ eapply derive_succ1 |]; 184 | eapply derive_generalisation; eapply derive_app; [ eapply derive_K | eapply derive_I]. 185 | - replace (lift 2 Nat_ty) with Nat_ty by (cbv; auto); 186 | eapply derive_generalisation; 187 | eapply derive_star; eapply derive_app; [ eapply derive_succ1 |]; 188 | eapply derive_app; eapply derive_ref; simpl; eauto; try eapply sub_zero; subst_tac; 189 | do 2 (replace (relocate 0 1 1) with 0 by (cbv; auto)); var_tac. 190 | - replace (lift 3 Nat_ty) with Nat_ty by (cbv; auto); 191 | do 2 eapply derive_generalisation; do 2 eapply derive_star; 192 | eapply derive_app; [ 193 | eapply derive_app; [ eapply derive_prim_succ_plus |] |]; 194 | eapply derive_app; eapply derive_ref; simpl; eauto; try subst_tac; try eapply sub_zero; 195 | repeat (replace (relocate 0 1 1) with 0 by (cbv; auto)); var_tac. 196 | Qed. 197 | 198 | 199 | 200 | (*** Equality *) 201 | 202 | 203 | Theorem derive_equal: forall gamma, derive gamma equal (quant 2 (Funty (Var 0) (Funty (Var 1) Bool_ty))). 204 | Proof. 205 | intros; eapply derive_Z; 206 | eapply derive_subtype with 207 | (quant 2 (Funty (quant 2 (Funty (Var 0) (Funty (Var 1) Bool_ty))) 208 | (Funty (Var 0) (Funty (Var 1) Bool_ty)))); [ 209 | | dist_tac; [ | eapply sub_zero]; eapply sub_trans; [ eapply (subtype_lift 2) | cbv; eapply sub_zero]]; 210 | eapply derive_generalisation_q; eapply derive_swap; 211 | replace (Funty (quant 2 (Funty (Var 0) (Funty (Var 1) Bool_ty))) (Funty (Var 1) Bool_ty)) 212 | with (subst (Funty (quant 2 (Funty (Var 0) (Funty (Var 1) Bool_ty))) (Funty (Var 2) Bool_ty)) (Var 0)) 213 | by (cbv; auto); 214 | eapply derive_triage. 215 | - cbv; eauto. 216 | - unfold subst; refold subst_rec; eapply derive_star; insert_Var_tac; unfold pred; eapply derive_subtype; [ 217 | | 218 | replace (subst_rec Bool_ty Leaf 0) with (subst Bool_ty (Var 1)) by (cbv; auto); 219 | eapply sub_tree; cbv; eauto]; 220 | eapply derive_app; eapply derive_app. 221 | + eapply derive_node; eapply subtype_leaf_fork. 222 | + eapply derive_app; eapply derive_app. 223 | * eapply derive_node; eapply subtype_leaf_fork. 224 | * unfold subst, Bool_ty; refold lift_rec; refold subst_rec; eapply derive_generalisation; repeat eapply derive_star; eapply derive_K. 225 | * eapply derive_subtype; [ eapply derive_generalisation; eapply derive_K | eapply sub_dist]. 226 | * replace (subst (lift_rec Bool_ty 1 1) (Stem (Var 0))) with Bool_ty by (cbv; auto); eapply derive_generalisation; eapply derive_false. 227 | + eapply derive_subtype; [ eapply derive_generalisation_q; eapply derive_K | dist_tac; eapply sub_zero]. 228 | + replace (subst (lift_rec Bool_ty 1 2) (Fork (Var 1) (Var 0))) with Bool_ty by (cbv; auto); eapply derive_generalisation_q; eapply derive_K1; eapply derive_false. 229 | - unfold subst; refold lift_rec; refold subst_rec; eapply derive_generalisation; repeat eapply derive_star; var_tac; simpl; var_tac; 230 | replace (Quant (Funty (Var 0) (Funty (Var 0) (Var 0)))) with (subst Bool_ty (Var 2)) by (cbv; auto); eapply derive_subtype; [ 231 | eapply (derive_generalisation_q 2); instantiate(1:= Funty (Var 0) (subst Bool_ty (Var 0))) | 232 | do 2 subst_tac]; 233 | eapply derive_triage. 234 | + cbv; auto. 235 | + replace (subst Bool_ty Leaf) with Bool_ty by (cbv; auto); eapply derive_false. 236 | + eapply derive_generalisation; eapply derive_app; eapply derive_ref; simpl; eauto; try eapply sub_zero; do 2 subst_tac; 237 | unfold relocate, test; simpl; var_tac; simpl; do 2 sub_funty_tac; 238 | rewrite subst_rec_lift_rec; try lia; rewrite lift_rec_null; eapply sub_zero. 239 | + do 2 eapply derive_generalisation; do 2 eapply derive_K1; 240 | replace (subst (lift_rec Bool_ty 1 2) (Fork (Var 1) (Var 0))) with Bool_ty by (cbv; auto); eapply derive_false. 241 | - do 2 eapply derive_generalisation; 242 | unfold subst; refold lift_rec; refold subst_rec; repeat eapply derive_star; eapply derive_subtype; [ | var_tac; simpl; var_tac]; 243 | eapply derive_subtype; [ | simpl; var_tac]; 244 | eapply derive_subtype; [ | replace (Quant (Funty (Var 0) (Funty (Var 0) (Var 0)))) with (subst Bool_ty (Var 3)) by (cbv; auto)]. 245 | + eapply derive_generalisation; eapply derive_triage. 246 | * instantiate(1:= Bool_ty); cbv; auto. 247 | * eapply derive_subtype; [ eapply derive_false | cbv; eapply sub_zero]. 248 | * eapply derive_generalisation; eapply derive_K1; eapply derive_false. 249 | * do 2 eapply derive_generalisation; do 2 eapply derive_star; eapply derive_app. 250 | repeat eapply derive_app; eapply derive_ref; simpl; eauto; var_tac. 251 | cbv. do 2 subst_tac. do 2 sub_fun_tac. subst_tac. 252 | cbv. do 2 subst_tac. 253 | eapply derive_false. 254 | + subst_tac. 255 | Unshelve. apply Leaf. 256 | Qed. 257 | 258 | -------------------------------------------------------------------------------- /typed_triage.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_triage.vo -------------------------------------------------------------------------------- /typed_triage.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_triage.vok -------------------------------------------------------------------------------- /typed_triage.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/typed_triage.vos -------------------------------------------------------------------------------- /types.vo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/types.vo -------------------------------------------------------------------------------- /types.vok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/types.vok -------------------------------------------------------------------------------- /types.vos: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/barry-jay-personal/typed_tree_calculus/ad90b250806f8e033db7d8b2681c989f1023a705/types.vos --------------------------------------------------------------------------------