├── .gitignore ├── LICENSE ├── README.md ├── doc ├── coqpl │ ├── ACM-Reference-Format.bst │ ├── Makefile │ ├── acmart.cls │ ├── acmthm.sty │ ├── coqpl.bib │ ├── coqpl18.pptx │ ├── ett.ott │ ├── listproc.sty │ ├── mathpartir.sty │ ├── ottalt.sty │ ├── paper.mng │ ├── paper.pdf │ ├── rae.bib │ └── weirich.bib └── icfp17 │ ├── ACM-Reference-Format.bst │ ├── Makefile │ ├── abstract.tex │ ├── acmart.cls │ ├── acmthm.sty │ ├── appendix.pdf │ ├── artifact_available.png │ ├── artifact_evaluated-functional.png │ ├── artifact_evaluated-reusable.png │ ├── comment.cut │ ├── ett.ott │ ├── icfp17.ott │ ├── listproc.sty │ ├── mathpartir.sty │ ├── ottalt.sty │ ├── paper.mng │ ├── permissions.pdf │ ├── proposal.bib │ ├── rae.bib │ ├── weirich.bib │ └── zip.hs ├── spec ├── ett.ott └── ett.ott~ └── src └── FcEtt ├── .gitignore ├── LIBRARIES.md ├── LICENSE ├── Makefile ├── README.md ├── _CoqProject ├── beta.v ├── congruence.v ├── dep_prog.v ├── erase.v ├── erase_syntax.v ├── ett_ind.v ├── ett_inf.v ├── ett_inf_cs.v ├── ett_ott.v ├── ett_par.v ├── ett_value.v ├── ext_consist.v ├── ext_context_fv.v ├── ext_invert.v ├── ext_red.v ├── ext_red_one.v ├── ext_subst.v ├── ext_weak.v ├── ext_wf.v ├── fc_consist.v ├── fc_context_fv.v ├── fc_dec.v ├── fc_dec_aux.v ├── fc_dec_fuel.v ├── fc_dec_fun.v ├── fc_get.v ├── fc_head_reduction.v ├── fc_invert.v ├── fc_preservation.v ├── fc_subst.v ├── fc_unique.v ├── fc_weak.v ├── fc_wf.v ├── fix_typing.v ├── fset_facts.v ├── imports.v ├── main.v ├── sigs.v ├── tactics.v ├── toplevel.v └── utils.v /.gitignore: -------------------------------------------------------------------------------- 1 | .*.aux 2 | *.a 3 | *.cma 4 | *.cmi 5 | *.cmo 6 | *.cmx 7 | *.cmxa 8 | *.cmxs 9 | *.glob 10 | *.ml.d 11 | *.ml4.d 12 | *.mli.d 13 | *.mllib.d 14 | *.mlpack.d 15 | *.native 16 | *.o 17 | *.v.d 18 | *.vio 19 | *.vo 20 | CoqSrc.mk 21 | .coq-native/ 22 | .csdp.cache 23 | .lia.cache 24 | .nia.cache 25 | .nlia.cache 26 | .nra.cache 27 | csdp.cache 28 | lia.cache 29 | nia.cache 30 | nlia.cache 31 | nra.cache 32 | *.v-e 33 | *.aux 34 | *.bbl 35 | *.blg 36 | *.fdb_latexmk 37 | *.fls 38 | *.log 39 | *.out 40 | *-rules.tex 41 | #* 42 | .#* 43 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2017, Stephanie Weirich 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | * Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | *See:* 2 | 3 | This version extends the ICFP 17 system with eta-equivalence rules. The pure 4 | icfp17 system is available at tag icfp17. 5 | 6 | - [src](src/FcEtt) for Coq development. 7 | 8 | - [spec](spec/ett.ott) for [Ott](http://www.cl.cam.ac.uk/~pes20/ott/) specification. 9 | 10 | - [doc](doc/icfp17) for ICFP 17 paper "A Specification for Dependent Types in 11 | Haskell". 12 | 13 | - [doc](doc/coqpl) for CoqPL abstract "Locally Nameless at Scale" 14 | 15 | - See paper [TYPES 2019 paper "Eta-Equivalence in Core Dependent Haskell"](https://drops.dagstuhl.de/opus/volltexte/2020/13071/pdf/LIPIcs-TYPES-2019-7.pdf) for a description of the modifications needed for eta-equivalence rules. 16 | 17 | *Acknowledgements* 18 | This material is based upon work supported by the National Science Foundation 19 | under Grant No. 1319880 and Grant No. 1521539. 20 | -------------------------------------------------------------------------------- /doc/coqpl/Makefile: -------------------------------------------------------------------------------- 1 | ## Makefile for paper 2 | 3 | OTT_SOURCE = ett 4 | OTT_LOC = . 5 | 6 | OTTFILES = $(foreach i, $(OTT_SOURCE), $(OTT_LOC)/$(i).ott) 7 | OTTIFLAGS = $(foreach i, $(OTT_SOURCE), -i $(OTT_LOC)/$(i).ott) 8 | RULESFILE = ett-rules.tex 9 | 10 | TOP=paper 11 | PDFS=paper.pdf 12 | 13 | all: $(TOP).pdf 14 | paper: $(TOP).pdf 15 | 16 | %.tex: $(RULESFILE) %.mng Makefile 17 | ott $(OTTIFLAGS) \ 18 | -tex_wrap false \ 19 | -tex_show_meta false \ 20 | -tex_filter $*.mng $*.tex 21 | 22 | ett-rules.tex: $(OTTFILES) 23 | ott $(OTTIFLAGS) -o $(RULESFILE) \ 24 | -tex_wrap false \ 25 | -tex_show_meta false 26 | 27 | %.pdf : paper.tex Makefile 28 | latexmk -bibtex -pdf paper.tex 29 | 30 | paperclean: 31 | rm -if *-rules.tex $(TOP).tex *.log ./*~ *.aux $(PDFS) *.bbl *.blg *.fdb_latexmk *.fls *.out 32 | 33 | clean: paperclean 34 | -------------------------------------------------------------------------------- /doc/coqpl/acmthm.sty: -------------------------------------------------------------------------------- 1 | %% 2 | %% This is file `acmthm.sty', 3 | %% generated with the docstrip utility. 4 | %% 5 | %% The original source files were: 6 | %% 7 | %% acmart.dtx (with options: `acmthm') 8 | %% 9 | %% IMPORTANT NOTICE: 10 | %% 11 | %% For the copyright see the source file. 12 | %% 13 | %% Any modified versions of this file must be renamed 14 | %% with new filenames distinct from acmthm.sty. 15 | %% 16 | %% For distribution of the original source see the terms 17 | %% for copying and modification in the file acmart.dtx. 18 | %% 19 | %% This generated file may be distributed as long as the 20 | %% original source files, as listed above, are part of the 21 | %% same distribution. (The sources need not necessarily be 22 | %% in the same archive or directory.) 23 | %% \CharacterTable 24 | %% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z 25 | %% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z 26 | %% Digits \0\1\2\3\4\5\6\7\8\9 27 | %% Exclamation \! Double quote \" Hash (number) \# 28 | %% Dollar \$ Percent \% Ampersand \& 29 | %% Acute accent \' Left paren \( Right paren \) 30 | %% Asterisk \* Plus \+ Comma \, 31 | %% Minus \- Point \. Solidus \/ 32 | %% Colon \: Semicolon \; Less than \< 33 | %% Equals \= Greater than \> Question mark \? 34 | %% Commercial at \@ Left bracket \[ Backslash \\ 35 | %% Right bracket \] Circumflex \^ Underscore \_ 36 | %% Grave accent \` Left brace \{ Vertical bar \| 37 | %% Right brace \} Tilde \~} 38 | \ProvidesPackage{acmthm} 39 | [2017/08/15 v1.45 Typesetting articles for Association of 40 | Computing Machinery] 41 | \def\@acmplainbodyfont{\itshape} 42 | \def\@acmplainindent{\parindent} 43 | \def\@acmplainheadfont{\scshape} 44 | \def\@acmplainnotefont{\@empty} 45 | \ifcase\ACM@format@nr 46 | \relax % manuscript 47 | \or % acmsmall 48 | \or % acmlarge 49 | \or % acmtog 50 | \or % sigconf 51 | \or % siggraph 52 | \or % sigplan 53 | \def\@acmplainbodyfont{\itshape} 54 | \def\@acmplainindent{\z@} 55 | \def\@acmplainheadfont{\bfseries} 56 | \def\@acmplainnotefont{\normalfont} 57 | \or % sigchi 58 | \or % sigchi-a 59 | \fi 60 | \newtheoremstyle{acmplain}% 61 | {.5\baselineskip\@plus.2\baselineskip 62 | \@minus.2\baselineskip}% space above 63 | {.5\baselineskip\@plus.2\baselineskip 64 | \@minus.2\baselineskip}% space below 65 | {\@acmplainbodyfont}% body font 66 | {\@acmplainindent}% indent amount 67 | {\@acmplainheadfont}% head font 68 | {.}% punctuation after head 69 | {.5em}% spacing after head 70 | {\thmname{#1}\thmnumber{ #2}\thmnote{ {\@acmplainnotefont(#3)}}}% head spec 71 | \def\@acmdefinitionbodyfont{\normalfont} 72 | \def\@acmdefinitionindent{\parindent} 73 | \def\@acmdefinitionheadfont{\itshape} 74 | \def\@acmdefinitionnotefont{\@empty} 75 | \ifcase\ACM@format@nr 76 | \relax % manuscript 77 | \or % acmsmall 78 | \or % acmlarge 79 | \or % acmtog 80 | \or % sigconf 81 | \or % siggraph 82 | \or % sigplan 83 | \def\@acmdefinitionbodyfont{\normalfont} 84 | \def\@acmdefinitionindent{\z@} 85 | \def\@acmdefinitionheadfont{\bfseries} 86 | \def\@acmdefinitionnotefont{\normalfont} 87 | \or % sigchi 88 | \or % sigchi-a 89 | \fi 90 | \newtheoremstyle{acmdefinition}% 91 | {.5\baselineskip\@plus.2\baselineskip 92 | \@minus.2\baselineskip}% space above 93 | {.5\baselineskip\@plus.2\baselineskip 94 | \@minus.2\baselineskip}% space below 95 | {\@acmdefinitionbodyfont}% body font 96 | {\@acmdefinitionindent}% indent amount 97 | {\@acmdefinitionheadfont}% head font 98 | {.}% punctuation after head 99 | {.5em}% spacing after head 100 | {\thmname{#1}\thmnumber{ #2}\thmnote{ {\@acmdefinitionnotefont(#3)}}}% head spec 101 | \theoremstyle{acmplain} 102 | \newtheorem{theorem}{Theorem}[section] 103 | \newtheorem{conjecture}[theorem]{Conjecture} 104 | \newtheorem{proposition}[theorem]{Proposition} 105 | \newtheorem{lemma}[theorem]{Lemma} 106 | \newtheorem{corollary}[theorem]{Corollary} 107 | \theoremstyle{acmdefinition} 108 | \newtheorem{example}[theorem]{Example} 109 | \newtheorem{definition}[theorem]{Definition} 110 | \theoremstyle{acmplain} 111 | \def\@proofnamefont{\scshape} 112 | \def\@proofindent{\indent} 113 | \ifcase\ACM@format@nr 114 | \relax % manuscript 115 | \or % acmsmall 116 | \or % acmlarge 117 | \or % acmtog 118 | \or % sigconf 119 | \or % siggraph 120 | \or % sigplan 121 | \def\@proofnamefont{\itshape} 122 | \def\@proofindent{\noindent} 123 | \or % sigchi 124 | \or % sigchi-a 125 | \fi 126 | \renewenvironment{proof}[1][\proofname]{\par 127 | \pushQED{\qed}% 128 | \normalfont \topsep6\p@\@plus6\p@\relax 129 | \trivlist 130 | \item[\@proofindent\hskip\labelsep 131 | {\@proofnamefont #1\@addpunct{.}}]\ignorespaces 132 | }{% 133 | \popQED\endtrivlist\@endpefalse 134 | } 135 | \endinput 136 | %% 137 | %% End of file `acmthm.sty'. 138 | -------------------------------------------------------------------------------- /doc/coqpl/coqpl.bib: -------------------------------------------------------------------------------- 1 | @article{Weirich:systemd, 2 | author = {Weirich, Stephanie and Voizard, Antoine and de Amorim, Pedro Henrique Avezedo and Eisenberg, Richard A.}, 3 | title = {A Specification for Dependent Types in Haskell}, 4 | journal = {Proc. ACM Program. Lang.}, 5 | issue_date = {September 2017}, 6 | volume = {1}, 7 | number = {ICFP}, 8 | month = aug, 9 | year = {2017}, 10 | issn = {2475-1421}, 11 | pages = {31:1--31:29}, 12 | articleno = {31}, 13 | numpages = {29}, 14 | url = {http://doi.acm.org/10.1145/3110275}, 15 | doi = {10.1145/3110275}, 16 | acmid = {3110275}, 17 | publisher = {ACM}, 18 | address = {New York, NY, USA}, 19 | keywords = {Dependent Types, Haskell}, 20 | } 21 | 22 | 23 | @INPROCEEDINGS{SchaeferEtAl:2015:Autosubst:-Reasoning, 24 | title = {Autosubst: Reasoning with de Bruijn Terms and Parallel Substitutions}, 25 | author = {Steven Sch{\"a}fer and Tobias Tebbi and Gert Smolka}, 26 | year = {2015}, 27 | month = {Aug}, 28 | editor = {Xingyuan Zhang and Christian Urban}, 29 | publisher = {Springer-Verlag}, 30 | booktitle = {Interactive Theorem Proving - 6th International Conference, {ITP} 2015, Nanjing, China, August 24-27, 2015}, 31 | series = {LNAI}, 32 | } 33 | 34 | @inproceedings{keuchel2016needle, 35 | title={Needle \& Knot: Binder boilerplate tied up}, 36 | author={Keuchel, Steven and Weirich, Stephanie and Schrijvers, Tom}, 37 | booktitle={European Symposium on Programming Languages and Systems}, 38 | pages={419--445}, 39 | year={2016}, 40 | organization={Springer} 41 | } -------------------------------------------------------------------------------- /doc/coqpl/coqpl18.pptx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/coqpl/coqpl18.pptx -------------------------------------------------------------------------------- /doc/coqpl/ett.ott: -------------------------------------------------------------------------------- 1 | ../icfp17/ett.ott -------------------------------------------------------------------------------- /doc/coqpl/listproc.sty: -------------------------------------------------------------------------------- 1 | %% 2 | %% This is file `listproc.sty', 3 | %% generated with the docstrip utility. 4 | %% 5 | %% The original source files were: 6 | %% 7 | %% listproc.dtx (with options: `package') 8 | %% 9 | %% Copyright (C) 2011 by Jesse A. Tov 10 | %% 11 | %% This file may be distributed and/or modified under the conditions of the 12 | %% LaTeX Project Public License, either version 1.2 of this license or (at 13 | %% your option) any later version. The latest version of this license is 14 | %% in: 15 | %% 16 | %% http://www.latex-project.org/lppl.txt 17 | %% 18 | %% and version 1.2 or later is part of all distributions of LaTeX 19 | %% version 1999/12/01 or later. 20 | %% 21 | \NeedsTeXFormat{LaTeX2e}[1999/12/01] 22 | \ProvidesPackage{listproc}[2011/08/03 v0.2 (list processing)] 23 | \newcommand\newlist{\@lstp@def{}\newcommand} 24 | \newcommand\renewlist{\@lstp@def{}\renewcommand} 25 | \newcommand\deflist{\@lstp@def{}\def} 26 | \newcommand\gdeflist{\@lstp@def\global\def} 27 | \newcommand\@lstp@def[4]{% 28 | #2#3{}% 29 | \@for\lstp@def@temp:=#4\do{% 30 | \expandafter\SnocTo\expandafter{\lstp@def@temp}#3% 31 | }% 32 | #1\let#3#3% 33 | \let\lstp@def@temp\@undefined 34 | } 35 | \newtoks\lstp@ta 36 | \newtoks\lstp@tb 37 | \newcommand\ConsTo{\@lstp@ConsTo\relax\def} 38 | \newcommand\gConsTo{\@lstp@ConsTo\global\def} 39 | \newcommand\eConsTo{\@lstp@ConsTo\relax\edef} 40 | \newcommand\xConsTo{\@lstp@ConsTo\global\edef} 41 | \newcommand\@lstp@ConsTo[4]{% 42 | \long#2\lstp@temp{#3}% 43 | \lstp@ta=\expandafter{\expandafter\listitem\expandafter{\lstp@temp}}% 44 | \lstp@tb=\expandafter{#4}% 45 | #1\edef#4{\the\lstp@ta\the\lstp@tb}% 46 | } 47 | \newcommand\SnocTo{\@lstp@SnocTo\relax\def} 48 | \newcommand\gSnocTo{\@lstp@SnocTo\global\def} 49 | \newcommand\eSnocTo{\@lstp@SnocTo\relax\edef} 50 | \newcommand\xSnocTo{\@lstp@SnocTo\global\edef} 51 | \newcommand\@lstp@SnocTo[4]{% 52 | \long#2\lstp@temp{#3}% 53 | \lstp@ta=\expandafter{\expandafter\listitem\expandafter{\lstp@temp}}% 54 | \lstp@tb=\expandafter{#4}% 55 | #1\edef#4{\the\lstp@tb\the\lstp@ta}% 56 | } 57 | \newcommand\AppendTo{\@lstp@AppendTo\relax} 58 | \newcommand\gAppendTo{\@lstp@AppendTo\global} 59 | \newcommand\@lstp@AppendTo[3]{% 60 | \lstp@ta=\expandafter{#2}% 61 | \lstp@tb=\expandafter{#3}% 62 | #1\edef#3{\the\lstp@ta\the\lstp@tb}% 63 | } 64 | \long\def\@LopOff\listitem#1#2\@LopOff#3#4{% 65 | #3{#1}% 66 | #4{#2}% 67 | } 68 | \newcommand\@lstp@LopTo[4]{\expandafter\@LopOff#3\@LopOff{#1\def#4}{#2\def#3}} 69 | \newcommand\@lstp@RestTo[3]{\expandafter\@LopOff#2\@LopOff{\@gobble}{#1\def#3}} 70 | \newcommand\LopTo{\@lstp@LopTo\relax\relax} 71 | \newcommand\gLopTo{\@lstp@LopTo\global\global} 72 | \newcommand\glLopTo{\@lstp@LopTo\global\relax} 73 | \newcommand\lgLopTo{\@lstp@LopTo\relax\global} 74 | \newcommand\FirstTo{\@lstp@LopTo\relax\@gobblethree} 75 | \newcommand\gFirstTo{\@lstp@LopTo\global\@gobblethree} 76 | \newcommand\RestTo{\@lstp@RestTo\relax} 77 | \newcommand\gRestTo{\@lstp@RestTo\global} 78 | \newcommand*\IfList[1]{% 79 | {% 80 | \expandafter\@IfList#1\@IfList 81 | }% 82 | } 83 | \def\@IfList#1#2\@IfList{% 84 | \ifx\listitem#1\relax 85 | \aftergroup\@firstoftwo 86 | \else 87 | \aftergroup\@secondoftwo 88 | \fi 89 | } 90 | \def\@forList#1:=#2\do#3{% 91 | \long\def\lstp@for@listitem##1{% 92 | \long\def#1{##1}% 93 | #3% 94 | \let\listitem\lstp@for@listitem% 95 | }% 96 | \let\listitem\lstp@for@listitem% 97 | #2% 98 | \let\listitem\@undefined% 99 | } 100 | \newcommand\SetToListLength[2]{% 101 | \lstp@length{#2}{\value{#1}}% 102 | } 103 | \newcommand\lstp@length[2]{% 104 | #2=0 % 105 | \long\def\listitem##1{\advance#2 by1 }% 106 | #1\let\listitem\@undefined% 107 | } 108 | \newcommand\MapListTo{\@lstp@MapListTo\relax} 109 | \newcommand\gMapListTo{\@lstp@MapListTo\global} 110 | \newcommand\MapAndAppendTo{\@lstp@MapAndAppendTo\relax} 111 | \newcommand\gMapAndAppendTo{\@lstp@MapAndAppendTo\global} 112 | \newcommand\@lstp@MapListTo[4]{% 113 | \let\lstp@map@temp#3% 114 | #1\let#4\empty% 115 | \@lstp@MapAndAppendTo{#1}{#2}\lstp@map@temp#4% 116 | \let\lstp@map@temp\@undefined% 117 | } 118 | \newcommand\@lstp@MapAndAppendTo[4]{% 119 | \long\def\listitem##1{\@lstp@SnocTo{#1}\def{#2}{#4}}% 120 | #3% 121 | \let\listitem\@undefined% 122 | } 123 | \newcommand\lstp@insert[3]{% 124 | \edef\lstp@insert@temp@a{#2{#1}}% 125 | \let\lstp@insert@temp@i#3% 126 | \let#3\empty 127 | \long\def\lstp@insert@listitem##1{% 128 | \edef\lstp@insert@temp@b{#2{##1}}% 129 | \ifnum\lstp@insert@temp@a<\lstp@insert@temp@b 130 | \SnocTo{#1}{#3}% 131 | \let\listitem\lstp@insert@listitem@done 132 | \else 133 | \let\listitem\lstp@insert@listitem 134 | \fi 135 | \SnocTo{##1}{#3}% 136 | }% 137 | \long\def\lstp@insert@listitem@done##1{\SnocTo{##1}{#3}}% 138 | \let\listitem\lstp@insert@listitem 139 | \lstp@insert@temp@i% 140 | \ifx\listitem\lstp@insert@listitem% 141 | \SnocTo{#1}{#3}% 142 | \fi% 143 | \let\lstp@insert@temp@i\@undefined% 144 | \let\listitem\@undefined% 145 | } 146 | \providecommand\@apply@group[2]{#1#2} 147 | \newcommand\SortList[2][\@apply@group{}]{% 148 | \let\lstp@sort@temp@i#2% 149 | \let#2\empty 150 | \long\def\lstp@sort@listitem##1{% 151 | \lstp@insert{##1}{#1}{#2}% 152 | \let\listitem\lstp@sort@listitem 153 | }% 154 | \let\listitem\lstp@sort@listitem 155 | \lstp@sort@temp@i 156 | \let\lstp@sort@temp@i\@undefined 157 | \let\listitem\@undefined 158 | } 159 | \newcounter{lstp@ifsucc} 160 | \newcommand\lstp@ifsucc[2]{% 161 | \setcounter{lstp@ifsucc}{#1}% 162 | \addtocounter{lstp@ifsucc}{1}% 163 | \ifnum#2=\value{lstp@ifsucc}% 164 | \let\@lstp@ifsucc@kont\@firstoftwo 165 | \else 166 | \let\@lstp@ifsucc@kont\@secondoftwo 167 | \fi 168 | \@lstp@ifsucc@kont 169 | } 170 | \newcommand\CompressList[2][\@apply@group{}]{% 171 | \let\lstp@compress@temp@i#2% 172 | \let#2\empty 173 | \def\lstp@compress@add@single{% 174 | \expandafter\SnocTo\expandafter 175 | {\expandafter\@single\expandafter{\lstp@compress@temp@a}}{#2}% 176 | }% 177 | \def\lstp@compress@add@range{% 178 | \expandafter\expandafter\expandafter\SnocTo 179 | \expandafter\expandafter\expandafter{% 180 | \expandafter\expandafter\expandafter\@range 181 | \expandafter\expandafter\expandafter{% 182 | \expandafter\lstp@compress@temp@a\expandafter}% 183 | \expandafter{\lstp@compress@temp@b}}#2% 184 | }% 185 | \long\def\lstp@compress@listitem@start##1{% 186 | \def\lstp@compress@temp@a{##1}% 187 | \edef\lstp@compress@temp@a@key{#1{##1}}% 188 | \let\listitem\lstp@compress@listitem@single 189 | }% 190 | \long\def\lstp@compress@listitem@single##1{% 191 | \def\lstp@compress@temp@b{##1}% 192 | \edef\lstp@compress@temp@b@key{#1{##1}}% 193 | \ifnum\lstp@compress@temp@a@key=\lstp@compress@temp@b@key 194 | \let\listitem\lstp@compress@listitem@single 195 | \else 196 | \lstp@ifsucc{\lstp@compress@temp@a@key}{\lstp@compress@temp@b@key} 197 | {\let\listitem\lstp@compress@listitem@range} 198 | {\lstp@compress@add@single 199 | \let\lstp@compress@temp@a\lstp@compress@temp@b 200 | \let\lstp@compress@temp@a@key\lstp@compress@temp@b@key 201 | \let\listitem\lstp@compress@listitem@single}% 202 | \fi 203 | }% 204 | \long\def\lstp@compress@listitem@range##1{% 205 | \def\lstp@compress@temp@c{##1}% 206 | \edef\lstp@compress@temp@c@key{#1{##1}}% 207 | \ifnum\lstp@compress@temp@b@key=\lstp@compress@temp@c@key 208 | \let\listitem\lstp@compress@listitem@range 209 | \else 210 | \lstp@ifsucc{\lstp@compress@temp@b@key}{\lstp@compress@temp@c@key} 211 | {% 212 | \let\lstp@compress@temp@b\lstp@compress@temp@c 213 | \let\lstp@compress@temp@b@key\lstp@compress@temp@c@key 214 | \let\listitem\lstp@compress@listitem@range 215 | } 216 | {% 217 | \lstp@compress@add@range 218 | \let\lstp@compress@temp@a\lstp@compress@temp@c 219 | \let\lstp@compress@temp@a@key\lstp@compress@temp@c@key 220 | \let\listitem\lstp@compress@listitem@single 221 | }% 222 | \fi 223 | }% 224 | \let\listitem\lstp@compress@listitem@start 225 | \lstp@compress@temp@i 226 | \ifx\listitem\lstp@compress@listitem@single 227 | \lstp@compress@add@single 228 | \else 229 | \ifx\listitem\lstp@compress@listitem@range 230 | \lstp@compress@add@range 231 | \fi 232 | \fi 233 | \let\lstp@compress@temp@a\@undefined 234 | \let\lstp@compress@temp@b\@undefined 235 | \let\lstp@compress@temp@c\@undefined 236 | \let\lstp@compress@temp@a@key\@undefined 237 | \let\lstp@compress@temp@b@key\@undefined 238 | \let\lstp@compress@temp@c@key\@undefined 239 | \let\lstp@compress@temp@i\@undefined 240 | \let\listitem\@undefined 241 | } 242 | \newcommand\FormatListSepTwo{ and } 243 | \newcommand\FormatListSepMore{, } 244 | \newcommand\FormatListSepLast{, and } 245 | \newcounter{lstp@FormatList@length} 246 | \newcounter{lstp@FormatList@posn} 247 | \newcommand\FormatList[4]{{% 248 | \deflist\lstp@FormatList@list{#4}% 249 | \SetToListLength{lstp@FormatList@length}\lstp@FormatList@list% 250 | \setcounter{lstp@FormatList@posn}{0}% 251 | \ifnum\value{lstp@FormatList@length}=1% 252 | #1% 253 | \else% 254 | #2% 255 | \fi% 256 | \def\listitem##1{% 257 | \addtocounter{lstp@FormatList@posn}{1}% 258 | \ifnum1<\value{lstp@FormatList@posn}% 259 | \ifnum2=\value{lstp@FormatList@length}% 260 | \FormatListSepTwo 261 | \else 262 | \ifnum\value{lstp@FormatList@length}=\value{lstp@FormatList@posn}% 263 | \FormatListSepLast 264 | \else 265 | \FormatListSepMore 266 | \fi 267 | \fi 268 | \fi 269 | #3{##1}% 270 | }% 271 | \lstp@FormatList@list 272 | }} 273 | \newcommand\ListExpr[1]{\@lstp@ListExpr{#1}\relax} 274 | \newcommand\ListExprTo[2]{\@lstp@ListExpr{#1}{\def#2}} 275 | \newcommand\gListExprTo[2]{\@lstp@ListExpr{#1}{\gdef#2}} 276 | \newcommand\@lstp@defbinop[2]{% 277 | \newcommand#1[2]{% 278 | \Eval{##1}\let\@lstp@tmp\@lstp@acc 279 | {\Eval{##2}}% 280 | #2\@lstp@tmp\@lstp@acc 281 | }% 282 | } 283 | \newcommand\@lstp@defunop[2]{% 284 | \newcommand#1[1]{% 285 | \Eval{##1}% 286 | #2\@lstp@acc\@lstp@acc 287 | }% 288 | } 289 | \newcommand\@lstp@definplaceunopopt[3][]{% 290 | \newcommand#2[2][#1]{% 291 | \Eval{##2}% 292 | #3[##1]\@lstp@acc 293 | \global\let\@lstp@acc\@lstp@acc 294 | }% 295 | } 296 | \newcommand\@lstp@ListExpr[2]{% 297 | {% 298 | \gdef\@lstp@acc{}% 299 | \def\Eval##1{% 300 | \IfList{##1}{% 301 | \global\let\@lstp@acc##1% 302 | }{% 303 | \@lstp@ifListOp##1\@lstp@ifListOp{% 304 | ##1% 305 | }{% 306 | \xdef\@lstp@acc{##1}% 307 | }% 308 | }% 309 | }% 310 | \def\Q##1{\gdef\@lstp@acc{##1}}% 311 | \def\Nil{\global\let\@lstp@acc\empty}% 312 | \def\List##1{\gdeflist\@lstp@acc{##1}}% 313 | \@lstp@defbinop\Cons\xConsTo 314 | \@lstp@defbinop\Snoc\xSnocTo 315 | \@lstp@defunop\First\gFirstTo 316 | \@lstp@defunop\Rest\gRestTo 317 | \@lstp@defbinop\Append\gAppendTo 318 | \@lstp@definplaceunopopt[\@apply@group{}]\Sort\SortList 319 | \@lstp@definplaceunopopt[\@apply@group{}]\Compress\CompressList 320 | \newcommand\Map[2]{% 321 | \Eval{##2}% 322 | \gMapListTo{##1}\@lstp@acc\@lstp@acc 323 | }% 324 | \Eval{#1}% 325 | }% 326 | \def\@lstp@finish##1{#2{##1}}% 327 | \expandafter\@lstp@finish\expandafter{\@lstp@acc}% 328 | } 329 | \def\@lstp@ifListOp#1#2\@lstp@ifListOp{% 330 | \@lstp@ifInToks#1{ 331 | \Q\Nil\List\Cons\Snoc\Append 332 | \First\Rest\Sort\Compress\Map 333 | } 334 | } 335 | \newcommand\@lstp@ifInToks[2]{% 336 | {% 337 | \def\@tester##1#1##2\@tester{% 338 | \ifx\@notfound##2\relax 339 | \aftergroup\@secondoftwo 340 | \else 341 | \aftergroup\@firstoftwo 342 | \fi 343 | }% 344 | \@tester#2\@lstp@ifInToks#1\@notfound\@tester 345 | }% 346 | } 347 | \endinput 348 | %% 349 | %% End of file `listproc.sty'. 350 | -------------------------------------------------------------------------------- /doc/coqpl/mathpartir.sty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/coqpl/mathpartir.sty -------------------------------------------------------------------------------- /doc/coqpl/ottalt.sty: -------------------------------------------------------------------------------- 1 | %% 2 | %% This is file `ottalt.sty', 3 | %% generated with the docstrip utility. 4 | %% 5 | %% The original source files were: 6 | %% 7 | %% ottalt.dtx (with options: `package') 8 | %% 9 | %% Copyright (C) 2011 by Jesse A. Tov 10 | %% 11 | %% This file may be distributed and/or modified under the conditions of the 12 | %% LaTeX Project Public License, either version 1.2 of this license or (at 13 | %% your option) any later version. The latest version of this license is 14 | %% in: 15 | %% 16 | %% http://www.latex-project.org/lppl.txt 17 | %% 18 | %% and version 1.2 or later is part of all distributions of LaTeX 19 | %% version 1999/12/01 or later. 20 | %% 21 | \NeedsTeXFormat{LaTeX2e}[1999/12/01] 22 | \ProvidesPackage{ottalt} 23 | [2013/03/14 v0.11 alternate Ott layout style] 24 | \RequirePackage{mathpartir} 25 | \RequirePackage{ifthen} 26 | \RequirePackage{keyval} 27 | \RequirePackage{listproc} 28 | \DeclareOption{implicitPremiseBreaks}{ 29 | \renewcommand\ottaltpremisesep{\\} 30 | \renewcommand\ottaltpremisebreak{\\} 31 | } 32 | \DeclareOption{lineBreakHack}{ 33 | \renewcommand\ottaltpremisesep{\and} 34 | \renewcommand\ottaltpremisebreak{\\\\} 35 | } 36 | \DeclareOption{implicitLineBreakHack}{ 37 | \renewcommand\ottaltpremisesep{\\} 38 | \renewcommand\ottaltpremisebreak{\\\\} 39 | } 40 | \DeclareOption{alternateNonterms}{ 41 | \let\ifnotalternateNonterms\@secondoftwo 42 | } 43 | \DeclareOption{supertabular}{ 44 | \ottalt@supertabulartrue 45 | } 46 | \newcommand\ottaltpremisesep{\\} 47 | \newcommand\ottaltpremisebreak{\\} 48 | \let\ifnotalternateNonterms\@firstoftwo 49 | \newif\ifottalt@supertabular 50 | \ProcessOptions 51 | \ifottalt@supertabular 52 | \RequirePackage{supertabular} 53 | \fi 54 | \newcommand\inputott[2][ott]{ 55 | \input{#2} 56 | \renewottcommands[#1] 57 | } 58 | \newcommand\ottaltcurrentprefix{ott} 59 | \newcommand\renewottcommands[1][ott]{ 60 | \renewcommand\ottaltcurrentprefix{#1} 61 | \def\renewottcomm@nd##1{ 62 | \expandafter\renewcommand\csname #1##1\endcsname 63 | } 64 | \renewottcomm@nd{drule}[4][]{ 65 | \def\ottalt@nextpremise{} 66 | \ottalt@premisetoks={ } 67 | ##2 68 | \expandafter\ottalt@inferrule\expandafter 69 | {\the\ottalt@premisetoks}{##3}{##4}{##1} 70 | } 71 | \renewottcomm@nd{premise}[1]{% 72 | \ottalt@premisetoks= 73 | \expandafter\expandafter\expandafter 74 | {\expandafter\the\expandafter\ottalt@premisetoks 75 | \ottalt@nextpremise##1} 76 | \ottalt@iflinebreakhack##1\ottlinebreakhack\ottalt@iflinebreakhack{ 77 | \let\ottalt@nextpremise\ottaltpremisebreak 78 | }{ 79 | \let\ottalt@nextpremise\ottaltpremisesep 80 | } 81 | } 82 | \renewottcomm@nd{usedrule}[1]{% 83 | \ifottalt@firstrule 84 | \ottalt@firstrulefalse 85 | \else 86 | \and 87 | \fi 88 | \ensuremath{##1} 89 | } 90 | \renewenvironment{#1defnblock}[3][] 91 | {\begin{drulepar}{##2}{##3}} 92 | {\end{drulepar}} 93 | \renewottcomm@nd{drulename}[1]{% 94 | \ottalt@replace@cs\ranchor\_-{}##1\\ 95 | } 96 | \renewottcomm@nd{prodline}[6]{ 97 | \ifthenelse{\equal{##3}{}}{ 98 | \\ & & $##1$ & $##2$ & & $##5$ & $##6$ 99 | }{} 100 | } 101 | \renewottcomm@nd{prodnewline}{\relax} 102 | \renewottcomm@nd{grammartabular}[1]{% 103 | \begin{ottaltgrammar}##1\end{ottaltgrammar}% 104 | } 105 | } 106 | \newcommand*\drule@h@lper[3]{% 107 | \expandafter\ifx\csname\ottaltcurrentprefix drule#3\endcsname\relax 108 | \PackageWarning{ottalt}{Unknown ott rule: #3}% 109 | \mbox{\textbf{(#2?)}}% 110 | \else 111 | \csname\ottaltcurrentprefix usedrule\endcsname 112 | {\csname\ottaltcurrentprefix drule#3\endcsname{#1}}% 113 | \fi 114 | } 115 | \newcommand*\nonterm@h@lper[1]{\csname\ottaltcurrentprefix#1\endcsname} 116 | \newcommand\rrefruletext{rule} 117 | \newcommand\Rrefruletext{\expandafter\MakeUppercase\rrefruletext} 118 | \newcommand\rrefrulestext{\rrefruletext s} 119 | \newcommand\Rrefrulestext{\Rrefruletext s} 120 | \newcommand\rrefstyle{\normalfont\scshape} 121 | \newcommand\ranchorstyle{\rrefstyle} 122 | \providecommand\wraparoundrref{\relax} 123 | \newcommand*\rref{% 124 | \@ifnextchar* 125 | {\rref@star} 126 | {\rref@with\rrefruletext\rrefrulestext}} 127 | \newcommand*\Rref{% 128 | \@ifnextchar* 129 | {\rref@star} 130 | {\rref@with\Rrefruletext\Rrefrulestext}} 131 | \newcommand*\rref@with[2]{\FormatList{#1~}{#2~}{\one@rref}} 132 | \newcommand*\rref@star[1]{\FormatList{}{}{\one@rref}} 133 | \newcommand*\@one@rref@nohyper[1]{\wraparoundrref{{\rrefstyle{#1}}}} 134 | \newcommand*\@ranchor@nohyper[1]{{\ranchorstyle{#1}}} 135 | \AtBeginDocument{ 136 | \ifcsname hypertarget\endcsname 137 | \newcommand*\one@rref[1]{% 138 | \hyperlink 139 | {ottalt:rule:\ottaltcurrentprefix:#1} 140 | {\@one@rref@nohyper{#1}}% 141 | } 142 | \newcommand*\ranchor[1]{% 143 | \hypertarget 144 | {ottalt:rule:\ottaltcurrentprefix:#1} 145 | {\@ranchor@nohyper{#1}}% 146 | } 147 | \else 148 | \newcommand\one@rref{\@one@rref@nohyper} 149 | \newcommand\ranchor{\@ranchor@nohyper} 150 | \fi 151 | } 152 | \newcommand*{\drules}[4][\relax]{% 153 | \begin{drulepar}[#1]{#2}{#3} 154 | \@for\@ottalt@each:=#4\do{% 155 | \expandafter\drule\expandafter{\@ottalt@each} 156 | } 157 | \end{drulepar}% 158 | } 159 | \newenvironment{drulepar}[3][\relax] 160 | {\begin{rulesection}[#1]{#2}{#3}% 161 | \begin{mathparpagebreakable}} 162 | {\end{mathparpagebreakable}% 163 | \end{rulesection}} 164 | \newenvironment{drulepar*}[3][\relax] 165 | {\begin{rulesection*}[#1]{#2}{#3}% 166 | \begin{mathparpagebreakable}} 167 | {\end{mathparpagebreakable}% 168 | \end{rulesection*}} 169 | \newenvironment{rulesection}[3][\relax] 170 | {\trivlist\item 171 | \ifx#1\relax\else\def\ottalt@rulesection@prefix{#1-}\fi 172 | \drulesectionhead{#2}{#3}% 173 | \nopagebreak[4]% 174 | \noindent} 175 | {\endtrivlist} 176 | \newenvironment{rulesection*}[3][\relax] 177 | {\trivlist\item 178 | \ifx#1\relax\else\def\ottalt@rulesection@prefix{#1-}\fi 179 | \drulesectionhead*{#2}{#3}% 180 | \nopagebreak[4]% 181 | \noindent} 182 | {\endtrivlist} 183 | \newcommand\ottalt@rulesection@prefix{} 184 | \newcommand*{\drulesectionhead}{% 185 | \@ifnextchar *{\drulesectionheadMany}{\drulesectionheadOne}% 186 | } 187 | \newcommand*{\drulesectionheadOne}[2]{% 188 | \FormatDruleSectionHead{#1}% 189 | \hfill\FormatDruleSectionHeadRight{#2}% 190 | \par 191 | } 192 | \newcommand*{\drulesectionheadMany}[3]{% 193 | {% 194 | \let\FormatListSepTwo\FormatDruleSepTwo 195 | \let\FormatListSepMore\FormatDruleSepMore 196 | \let\FormatListSepLast\FormatDruleSepLast 197 | \FormatList{}{}{\FormatDruleSectionHeads}{#2}% 198 | }% 199 | \hfill\FormatDruleSectionHeadRight{#3}% 200 | \par 201 | } 202 | \newcommand*\FormatDruleSepTwo{\,,~} 203 | \newcommand*\FormatDruleSepMore{\FormatDruleSepTwo} 204 | \newcommand*\FormatDruleSepLast{\FormatDruleSepTwo} 205 | \newcommand*\FormatDruleSectionHead[1]{\fbox{#1}} 206 | \newcommand*\FormatDruleSectionHeads[1]{\fbox{\strut#1}} 207 | \newcommand*\FormatDruleSectionHeadRight[1]{\emph{(#1)}} 208 | \newcommand*\drule[2][]{% 209 | \expandafter\drule@helper\expandafter{\ottalt@rulesection@prefix}{#1}{#2}% 210 | } 211 | \newcommand*\drule@helper[3]{% 212 | \ottalt@replace@cs{\drule@h@lper{#2}{#1#3}}-{XX}{}#1#3\\ 213 | } 214 | \newcommand\ottaltinferrule[4]{ 215 | \inferrule*[narrower=0.3,lab=#1,#2] 216 | {#3} 217 | {#4} 218 | } 219 | \newcommand\ottalt@inferrule[4]{ 220 | \ottaltinferrule{#3}{#4}{#1}{#2} 221 | } 222 | \newif\ifottalt@firstrule \ottalt@firstruletrue 223 | \newcommand{\ottalt@nextpremise}{\relax} 224 | \newtoks\ottalt@premisetoks 225 | \newcommand{\ottlinebreakhack}{\relax} 226 | \def\ottalt@iflinebreakhack#1\ottlinebreakhack #2\ottalt@iflinebreakhack{% 227 | \ifthenelse{\equal{#2}{}}\@secondoftwo\@firstoftwo 228 | } 229 | \newcommand\ottalt@replace@cs[5]{% 230 | \ifx\\#5\relax 231 | \def\ottalt@replace@cs@kont{#1{#4}}% 232 | \else 233 | \ifx#2#5\relax 234 | \def\ottalt@replace@cs@kont{\ottalt@replace@cs{#1}{#2}{#3}{#4#3}}% 235 | \else 236 | \def\ottalt@replace@cs@kont{\ottalt@replace@cs{#1}{#2}{#3}{#4#5}}% 237 | \fi 238 | \fi 239 | \ottalt@replace@cs@kont 240 | } 241 | \newcommand*\nonterms[2][8pt]{ 242 | \begin{ottaltgrammar}[#1] 243 | \@for\@ottalt@each:=#2\do{% 244 | \expandafter\nt\expandafter{\@ottalt@each} 245 | } 246 | \end{ottaltgrammar} 247 | } 248 | \newenvironment{ottaltgrammar}[1][8pt]{% 249 | \begingroup 250 | \trivlist\item 251 | \def\OTTALTNEWLINE{\\[#1]}% 252 | \def\nt##1{\OTTALTNEWLINE\relax\nonterm@h@lper{##1}\ignorespaces}% 253 | \newcommand\ottaltintertext[2]{% 254 | \multicolumn{8}{l}{% 255 | \begin{minipage}{##1}% 256 | ##2% 257 | \end{minipage}% 258 | }% 259 | }% 260 | \ifottalt@supertabular 261 | \begin{supertabular}{llcllllll} 262 | \else 263 | \begin{tabular}{llcllllll} 264 | \fi 265 | \let\OTTALTNEWLINE\relax 266 | \ignorespaces 267 | } 268 | {% 269 | \@ifundefined{ottafterlastrule}{\\}{\ottafterlastrule}% 270 | \ifottalt@supertabular 271 | \end{supertabular} 272 | \else 273 | \end{tabular} 274 | \fi 275 | \endtrivlist 276 | \endgroup 277 | \ignorespaces 278 | } 279 | \newcommand\newNTclass[2][\ifnotalternateNonterms]{ 280 | \expandafter\newcommand\csname new#2s\endcsname[4][]{ 281 | #1{ 282 | \expandafter\newcommand\csname ottalt@NT@#2@##2\endcsname{##1{##3}} 283 | }{ 284 | \expandafter\newcommand\csname ottalt@NT@#2@##2\endcsname{##4} 285 | } 286 | } 287 | \expandafter\newcommand\csname new#2\endcsname[3][]{ 288 | \csname new#2s\endcsname[##1]{##2}{##3}{##3} 289 | } 290 | \expandafter\newcommand\csname #2\endcsname[1]{% 291 | \csname ottalt@NT@#2@##1\endcsname 292 | } 293 | } 294 | \providecommand\@ifToif[1]{% 295 | #1\iftrue\iffalse 296 | } 297 | \providecommand\ifTo@if[1]{% 298 | #1% 299 | \expandafter\@firstoftwo 300 | \else 301 | \expandafter\@secondoftwo 302 | \fi 303 | } 304 | \newcommand\NTOVERLINE{\NTCAPTURE\overline} 305 | \newcommand\NTUNDERLINE{\NTCAPTURE\underline} 306 | \newcommand\NTTEXTCOLOR[1]{\NTCAPTURE{\textcolor{#1}}} 307 | \newcommand\NTCAPTURE[1]{\NTCAPTURELOW{\NTCAPTURE@FINISH{#1}}} 308 | \newcommand\NTCAPTURE@FINISH[4]{#1{#2_{#3}#4}} 309 | \newcommand\NTCAPTURELOW[2]{\NT@CAPTURE@LOOP{#1}{#2}\relax\relax} 310 | \newcommand\NT@CAPTURE@LOOP[4]{% 311 | \@ifnextchar _{% 312 | \NT@CAPTURE@SUB{#1}{#2}{#3}{#4}% 313 | }{\@ifnextchar '{% 314 | \NT@CAPTURE@PRIME{#1}{#2}{#3}{#4}% 315 | }{% 316 | {#1{#2}{#3}{#4}}% 317 | }}% 318 | } 319 | \def\NT@CAPTURE@SUB#1#2#3#4_#5{\NT@CAPTURE@LOOP{#1}{#2}{#3#5}{#4}} 320 | \def\NT@CAPTURE@PRIME#1#2#3#4'{\NT@CAPTURE@LOOP{#1}{#2}{#3}{#4'}} 321 | \endinput 322 | %% 323 | %% End of file `ottalt.sty'. 324 | -------------------------------------------------------------------------------- /doc/coqpl/paper.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/coqpl/paper.pdf -------------------------------------------------------------------------------- /doc/icfp17/Makefile: -------------------------------------------------------------------------------- 1 | ## Makefile for paper 2 | 3 | OTT_SOURCE = ett icfp17 4 | OTT_LOC = . 5 | 6 | OTTFILES = $(foreach i, $(OTT_SOURCE), $(OTT_LOC)/$(i).ott) 7 | OTTIFLAGS = $(foreach i, $(OTT_SOURCE), -i $(OTT_LOC)/$(i).ott) 8 | RULESFILE = ett-rules.tex 9 | 10 | TOP=paper 11 | PDFS=paper.pdf 12 | 13 | all: $(TOP).pdf 14 | paper: $(TOP).pdf 15 | 16 | %.tex: $(RULESFILE) %.mng Makefile 17 | ott $(OTTIFLAGS) \ 18 | -tex_wrap false \ 19 | -tex_show_meta false \ 20 | -tex_filter $*.mng $*.tex 21 | 22 | ett-rules.tex: $(OTTFILES) 23 | ott $(OTTIFLAGS) -o $(RULESFILE) \ 24 | -tex_wrap false \ 25 | -tex_show_meta false 26 | 27 | %.pdf : paper.tex abstract.tex Makefile 28 | latexmk -bibtex -pdf paper.tex 29 | 30 | paperclean: 31 | rm -if *-rules.tex $(TOP).tex *.log ./*~ *.aux $(PDFS) *.bbl *.blg *.fdb_latexmk *.fls *.out 32 | 33 | clean: paperclean 34 | -------------------------------------------------------------------------------- /doc/icfp17/abstract.tex: -------------------------------------------------------------------------------- 1 | We propose a core semantics for Dependent Haskell, an extension of Haskell 2 | with full-spectrum dependent types. Our semantics consists of two related 3 | languages. The first is a Curry-style dependently-typed language with 4 | nontermination, irrelevant arguments, and equality abstraction. The second, 5 | inspired by the Glasgow Haskell Compiler's core language FC, is its 6 | explicitly-typed analogue, suitable for implementation in GHC. All of our 7 | results---chiefly, type safety, along with theorems that relate these two 8 | languages---have been formalized using the Coq proof assistant. Because our 9 | work is backwards compatible with Haskell, our type safety proof holds in the 10 | presence of nonterminating computation. However, unlike other full-spectrum 11 | dependently-typed languages, such as Coq, Agda or Idris, because of this 12 | nontermination, Haskell's term language does not correspond to a consistent 13 | logic. 14 | -------------------------------------------------------------------------------- /doc/icfp17/acmthm.sty: -------------------------------------------------------------------------------- 1 | %% 2 | %% This is file `acmthm.sty', 3 | %% generated with the docstrip utility. 4 | %% 5 | %% The original source files were: 6 | %% 7 | %% acmart.dtx (with options: `acmthm') 8 | %% 9 | %% IMPORTANT NOTICE: 10 | %% 11 | %% For the copyright see the source file. 12 | %% 13 | %% Any modified versions of this file must be renamed 14 | %% with new filenames distinct from acmthm.sty. 15 | %% 16 | %% For distribution of the original source see the terms 17 | %% for copying and modification in the file acmart.dtx. 18 | %% 19 | %% This generated file may be distributed as long as the 20 | %% original source files, as listed above, are part of the 21 | %% same distribution. (The sources need not necessarily be 22 | %% in the same archive or directory.) 23 | %% \CharacterTable 24 | %% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z 25 | %% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z 26 | %% Digits \0\1\2\3\4\5\6\7\8\9 27 | %% Exclamation \! Double quote \" Hash (number) \# 28 | %% Dollar \$ Percent \% Ampersand \& 29 | %% Acute accent \' Left paren \( Right paren \) 30 | %% Asterisk \* Plus \+ Comma \, 31 | %% Minus \- Point \. Solidus \/ 32 | %% Colon \: Semicolon \; Less than \< 33 | %% Equals \= Greater than \> Question mark \? 34 | %% Commercial at \@ Left bracket \[ Backslash \\ 35 | %% Right bracket \] Circumflex \^ Underscore \_ 36 | %% Grave accent \` Left brace \{ Vertical bar \| 37 | %% Right brace \} Tilde \~} 38 | \ProvidesPackage{acmthm} 39 | [2017/08/15 v1.45 Typesetting articles for Association of 40 | Computing Machinery] 41 | \def\@acmplainbodyfont{\itshape} 42 | \def\@acmplainindent{\parindent} 43 | \def\@acmplainheadfont{\scshape} 44 | \def\@acmplainnotefont{\@empty} 45 | \ifcase\ACM@format@nr 46 | \relax % manuscript 47 | \or % acmsmall 48 | \or % acmlarge 49 | \or % acmtog 50 | \or % sigconf 51 | \or % siggraph 52 | \or % sigplan 53 | \def\@acmplainbodyfont{\itshape} 54 | \def\@acmplainindent{\z@} 55 | \def\@acmplainheadfont{\bfseries} 56 | \def\@acmplainnotefont{\normalfont} 57 | \or % sigchi 58 | \or % sigchi-a 59 | \fi 60 | \newtheoremstyle{acmplain}% 61 | {.5\baselineskip\@plus.2\baselineskip 62 | \@minus.2\baselineskip}% space above 63 | {.5\baselineskip\@plus.2\baselineskip 64 | \@minus.2\baselineskip}% space below 65 | {\@acmplainbodyfont}% body font 66 | {\@acmplainindent}% indent amount 67 | {\@acmplainheadfont}% head font 68 | {.}% punctuation after head 69 | {.5em}% spacing after head 70 | {\thmname{#1}\thmnumber{ #2}\thmnote{ {\@acmplainnotefont(#3)}}}% head spec 71 | \def\@acmdefinitionbodyfont{\normalfont} 72 | \def\@acmdefinitionindent{\parindent} 73 | \def\@acmdefinitionheadfont{\itshape} 74 | \def\@acmdefinitionnotefont{\@empty} 75 | \ifcase\ACM@format@nr 76 | \relax % manuscript 77 | \or % acmsmall 78 | \or % acmlarge 79 | \or % acmtog 80 | \or % sigconf 81 | \or % siggraph 82 | \or % sigplan 83 | \def\@acmdefinitionbodyfont{\normalfont} 84 | \def\@acmdefinitionindent{\z@} 85 | \def\@acmdefinitionheadfont{\bfseries} 86 | \def\@acmdefinitionnotefont{\normalfont} 87 | \or % sigchi 88 | \or % sigchi-a 89 | \fi 90 | \newtheoremstyle{acmdefinition}% 91 | {.5\baselineskip\@plus.2\baselineskip 92 | \@minus.2\baselineskip}% space above 93 | {.5\baselineskip\@plus.2\baselineskip 94 | \@minus.2\baselineskip}% space below 95 | {\@acmdefinitionbodyfont}% body font 96 | {\@acmdefinitionindent}% indent amount 97 | {\@acmdefinitionheadfont}% head font 98 | {.}% punctuation after head 99 | {.5em}% spacing after head 100 | {\thmname{#1}\thmnumber{ #2}\thmnote{ {\@acmdefinitionnotefont(#3)}}}% head spec 101 | \theoremstyle{acmplain} 102 | \newtheorem{theorem}{Theorem}[section] 103 | \newtheorem{conjecture}[theorem]{Conjecture} 104 | \newtheorem{proposition}[theorem]{Proposition} 105 | \newtheorem{lemma}[theorem]{Lemma} 106 | \newtheorem{corollary}[theorem]{Corollary} 107 | \theoremstyle{acmdefinition} 108 | \newtheorem{example}[theorem]{Example} 109 | \newtheorem{definition}[theorem]{Definition} 110 | \theoremstyle{acmplain} 111 | \def\@proofnamefont{\scshape} 112 | \def\@proofindent{\indent} 113 | \ifcase\ACM@format@nr 114 | \relax % manuscript 115 | \or % acmsmall 116 | \or % acmlarge 117 | \or % acmtog 118 | \or % sigconf 119 | \or % siggraph 120 | \or % sigplan 121 | \def\@proofnamefont{\itshape} 122 | \def\@proofindent{\noindent} 123 | \or % sigchi 124 | \or % sigchi-a 125 | \fi 126 | \renewenvironment{proof}[1][\proofname]{\par 127 | \pushQED{\qed}% 128 | \normalfont \topsep6\p@\@plus6\p@\relax 129 | \trivlist 130 | \item[\@proofindent\hskip\labelsep 131 | {\@proofnamefont #1\@addpunct{.}}]\ignorespaces 132 | }{% 133 | \popQED\endtrivlist\@endpefalse 134 | } 135 | \endinput 136 | %% 137 | %% End of file `acmthm.sty'. 138 | -------------------------------------------------------------------------------- /doc/icfp17/appendix.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/icfp17/appendix.pdf -------------------------------------------------------------------------------- /doc/icfp17/artifact_available.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/icfp17/artifact_available.png -------------------------------------------------------------------------------- /doc/icfp17/artifact_evaluated-functional.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/icfp17/artifact_evaluated-functional.png -------------------------------------------------------------------------------- /doc/icfp17/artifact_evaluated-reusable.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/icfp17/artifact_evaluated-reusable.png -------------------------------------------------------------------------------- /doc/icfp17/comment.cut: -------------------------------------------------------------------------------- 1 | %% acks environment is optional 2 | %% contents suppressed with 'anonymous' 3 | %% Commands \grantsponsor{}{}{} and 4 | %% \grantnum[]{}{} should be used to 5 | %% acknowledge financial support and will be used by metadata 6 | %% extraction tools. 7 | Thanks to Simon Peyton Jones, Adam Gundry and Iavor Diatchki for feedback 8 | and suggestions. 9 | This material is based upon work supported by the 10 | \grantsponsor{GS100000001}{National Science 11 | Foundation}{http://dx.doi.org/10.13039/100000001} under Grant 12 | No.~\grantnum{GS100000001}{1319880} and Grant 13 | No.~\grantnum{GS100000001}{1521539}. Any opinions, findings, and 14 | conclusions or recommendations expressed in this material are those 15 | of the author and do not necessarily reflect the views of the 16 | National Science Foundation. 17 | -------------------------------------------------------------------------------- /doc/icfp17/icfp17.ott: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 3 | %% Only needed for typesetting ICFP 17 paper 4 | %% not part of semantics of the language 5 | 6 | defns 7 | Jtex :: '' ::= 8 | 9 | 10 | defn 11 | G |-- a ~ g b ok :: :: wffalt :: 'AltAn_' 12 | {{ tex [[G]] \vdash [[a]] [[~]]_{[[g]]} [[b]] [[ok]] }} 13 | by 14 | 15 | G |- a : A 16 | G |- b : B 17 | G ; dom G |- g : A ~ B 18 | ------------------ :: Wff 19 | G |-- a ~g b ok 20 | 21 | defn 22 | Good G D :: :: GoodDefn :: '' 23 | by 24 | 25 | defn G |== a : A :: :: alternative :: 'EA_' 26 | {{ com alternative rules for comparison }} 27 | {{ tex [[G]] \vDash [[a]] : [[A]] }} 28 | by 29 | 30 | G |= A : TYPE 31 | G, x:A |== a : B 32 | x notin fv a 33 | ----------------------- :: IrrelAbs 34 | G |== a : all- x:A -> B 35 | 36 | G |= a : all - x:A -> B 37 | G |= b : A 38 | ----------------------- :: IrrelApp 39 | G |== a : B { b / x } 40 | 41 | G |= phi ok 42 | G,c:phi |= a : B 43 | ----------------------- :: CAbs 44 | G |== a : all c:phi. B 45 | 46 | G |= a : all c:(a ~ b : A). B 47 | G; dom G |= a == b : A 48 | ----------------------- :: CApp 49 | G |== a : B { o / c } 50 | 51 | defn 52 | G |== a : A == b : B :: :: hetalt :: 'EA_' 53 | by 54 | 55 | c : (a : A ~ b : B) in G 56 | -------------------------- :: Kind 57 | G |== A : TYPE == B : TYPE 58 | 59 | 60 | defn G |-- a : A :: :: altantyp :: 'AltAn_' 61 | {{ tex [[G]] \vdash [[a]] : [[A]] }} 62 | by 63 | 64 | G |-- a : A 65 | |A| = |B| 66 | ------------------ :: Conv 67 | G |-- a : B 68 | 69 | defn G ; D |-- g : a ~ b :: :: altande :: 'AltAn_' 70 | {{ tex [[G]] ; [[D]] \vdash [[g]] : [[a]] \sim [[b]] }} 71 | 72 | by 73 | G ; D |- g1 : a1 ~ b1 74 | G ; D |- g2 : a2 ~ b2 75 | G |- a1 rho a2 : A 76 | G |- b1 rho b2 : B 77 | -------------------------------------- :: AppCong 78 | G ; D |-- g1 rho g2 : a1 rho a2 ~ b1 rho b2 79 | 80 | 81 | G ; D |- g1 : a1 ~ b1 82 | G ; D |- g2 : a2 ~ b2 83 | G |- a1 rho a2 : A 84 | G |- b1 rho b2 : B 85 | G ; D |- g : B ~ A 86 | ------------------------------------------------------------- :: AppCongEq 87 | G ; D |-- ((# g1 rho g2 #) |> g) : (a1 rho a2) ~ ((# b1 rho b2 #) |> g) 88 | 89 | 90 | G ; D |- g1 : A1 ~ A2 91 | G, x : A1 ; D |- g2 : B1 ~ B2 92 | B3 = B2 { x |> sym g1 / x } 93 | G |- (all rho x:A1 -> B1) : TYPE 94 | G |- (all rho x:A2 -> B3) : TYPE 95 | ---------------------------------------------------------- :: PiCong 96 | G ; D |-- all rho x:g1 -> g2 : (all rho x:A1 -> B1) ~ (all rho x:A2 -> B3) 97 | 98 | G ; D |- g1 : phi1 == phi2 99 | G, c:phi1 ; D |- g3 : B1 ~ B2 100 | B3 = B2 { c |> sym g1 / c } 101 | G |- all c:phi1 . B1 : TYPE 102 | G |- all c:phi2 . B3 : TYPE 103 | ----------------------------------------------------- :: CPiCong 104 | G ; D |-- (all c: g1. g3) : (all c:phi1. B1) ~ (all c:phi2. B3) 105 | -------------------------------------------------------------------------------- /doc/icfp17/listproc.sty: -------------------------------------------------------------------------------- 1 | %% 2 | %% This is file `listproc.sty', 3 | %% generated with the docstrip utility. 4 | %% 5 | %% The original source files were: 6 | %% 7 | %% listproc.dtx (with options: `package') 8 | %% 9 | %% Copyright (C) 2011 by Jesse A. Tov 10 | %% 11 | %% This file may be distributed and/or modified under the conditions of the 12 | %% LaTeX Project Public License, either version 1.2 of this license or (at 13 | %% your option) any later version. The latest version of this license is 14 | %% in: 15 | %% 16 | %% http://www.latex-project.org/lppl.txt 17 | %% 18 | %% and version 1.2 or later is part of all distributions of LaTeX 19 | %% version 1999/12/01 or later. 20 | %% 21 | \NeedsTeXFormat{LaTeX2e}[1999/12/01] 22 | \ProvidesPackage{listproc}[2011/08/03 v0.2 (list processing)] 23 | \newcommand\newlist{\@lstp@def{}\newcommand} 24 | \newcommand\renewlist{\@lstp@def{}\renewcommand} 25 | \newcommand\deflist{\@lstp@def{}\def} 26 | \newcommand\gdeflist{\@lstp@def\global\def} 27 | \newcommand\@lstp@def[4]{% 28 | #2#3{}% 29 | \@for\lstp@def@temp:=#4\do{% 30 | \expandafter\SnocTo\expandafter{\lstp@def@temp}#3% 31 | }% 32 | #1\let#3#3% 33 | \let\lstp@def@temp\@undefined 34 | } 35 | \newtoks\lstp@ta 36 | \newtoks\lstp@tb 37 | \newcommand\ConsTo{\@lstp@ConsTo\relax\def} 38 | \newcommand\gConsTo{\@lstp@ConsTo\global\def} 39 | \newcommand\eConsTo{\@lstp@ConsTo\relax\edef} 40 | \newcommand\xConsTo{\@lstp@ConsTo\global\edef} 41 | \newcommand\@lstp@ConsTo[4]{% 42 | \long#2\lstp@temp{#3}% 43 | \lstp@ta=\expandafter{\expandafter\listitem\expandafter{\lstp@temp}}% 44 | \lstp@tb=\expandafter{#4}% 45 | #1\edef#4{\the\lstp@ta\the\lstp@tb}% 46 | } 47 | \newcommand\SnocTo{\@lstp@SnocTo\relax\def} 48 | \newcommand\gSnocTo{\@lstp@SnocTo\global\def} 49 | \newcommand\eSnocTo{\@lstp@SnocTo\relax\edef} 50 | \newcommand\xSnocTo{\@lstp@SnocTo\global\edef} 51 | \newcommand\@lstp@SnocTo[4]{% 52 | \long#2\lstp@temp{#3}% 53 | \lstp@ta=\expandafter{\expandafter\listitem\expandafter{\lstp@temp}}% 54 | \lstp@tb=\expandafter{#4}% 55 | #1\edef#4{\the\lstp@tb\the\lstp@ta}% 56 | } 57 | \newcommand\AppendTo{\@lstp@AppendTo\relax} 58 | \newcommand\gAppendTo{\@lstp@AppendTo\global} 59 | \newcommand\@lstp@AppendTo[3]{% 60 | \lstp@ta=\expandafter{#2}% 61 | \lstp@tb=\expandafter{#3}% 62 | #1\edef#3{\the\lstp@ta\the\lstp@tb}% 63 | } 64 | \long\def\@LopOff\listitem#1#2\@LopOff#3#4{% 65 | #3{#1}% 66 | #4{#2}% 67 | } 68 | \newcommand\@lstp@LopTo[4]{\expandafter\@LopOff#3\@LopOff{#1\def#4}{#2\def#3}} 69 | \newcommand\@lstp@RestTo[3]{\expandafter\@LopOff#2\@LopOff{\@gobble}{#1\def#3}} 70 | \newcommand\LopTo{\@lstp@LopTo\relax\relax} 71 | \newcommand\gLopTo{\@lstp@LopTo\global\global} 72 | \newcommand\glLopTo{\@lstp@LopTo\global\relax} 73 | \newcommand\lgLopTo{\@lstp@LopTo\relax\global} 74 | \newcommand\FirstTo{\@lstp@LopTo\relax\@gobblethree} 75 | \newcommand\gFirstTo{\@lstp@LopTo\global\@gobblethree} 76 | \newcommand\RestTo{\@lstp@RestTo\relax} 77 | \newcommand\gRestTo{\@lstp@RestTo\global} 78 | \newcommand*\IfList[1]{% 79 | {% 80 | \expandafter\@IfList#1\@IfList 81 | }% 82 | } 83 | \def\@IfList#1#2\@IfList{% 84 | \ifx\listitem#1\relax 85 | \aftergroup\@firstoftwo 86 | \else 87 | \aftergroup\@secondoftwo 88 | \fi 89 | } 90 | \def\@forList#1:=#2\do#3{% 91 | \long\def\lstp@for@listitem##1{% 92 | \long\def#1{##1}% 93 | #3% 94 | \let\listitem\lstp@for@listitem% 95 | }% 96 | \let\listitem\lstp@for@listitem% 97 | #2% 98 | \let\listitem\@undefined% 99 | } 100 | \newcommand\SetToListLength[2]{% 101 | \lstp@length{#2}{\value{#1}}% 102 | } 103 | \newcommand\lstp@length[2]{% 104 | #2=0 % 105 | \long\def\listitem##1{\advance#2 by1 }% 106 | #1\let\listitem\@undefined% 107 | } 108 | \newcommand\MapListTo{\@lstp@MapListTo\relax} 109 | \newcommand\gMapListTo{\@lstp@MapListTo\global} 110 | \newcommand\MapAndAppendTo{\@lstp@MapAndAppendTo\relax} 111 | \newcommand\gMapAndAppendTo{\@lstp@MapAndAppendTo\global} 112 | \newcommand\@lstp@MapListTo[4]{% 113 | \let\lstp@map@temp#3% 114 | #1\let#4\empty% 115 | \@lstp@MapAndAppendTo{#1}{#2}\lstp@map@temp#4% 116 | \let\lstp@map@temp\@undefined% 117 | } 118 | \newcommand\@lstp@MapAndAppendTo[4]{% 119 | \long\def\listitem##1{\@lstp@SnocTo{#1}\def{#2}{#4}}% 120 | #3% 121 | \let\listitem\@undefined% 122 | } 123 | \newcommand\lstp@insert[3]{% 124 | \edef\lstp@insert@temp@a{#2{#1}}% 125 | \let\lstp@insert@temp@i#3% 126 | \let#3\empty 127 | \long\def\lstp@insert@listitem##1{% 128 | \edef\lstp@insert@temp@b{#2{##1}}% 129 | \ifnum\lstp@insert@temp@a<\lstp@insert@temp@b 130 | \SnocTo{#1}{#3}% 131 | \let\listitem\lstp@insert@listitem@done 132 | \else 133 | \let\listitem\lstp@insert@listitem 134 | \fi 135 | \SnocTo{##1}{#3}% 136 | }% 137 | \long\def\lstp@insert@listitem@done##1{\SnocTo{##1}{#3}}% 138 | \let\listitem\lstp@insert@listitem 139 | \lstp@insert@temp@i% 140 | \ifx\listitem\lstp@insert@listitem% 141 | \SnocTo{#1}{#3}% 142 | \fi% 143 | \let\lstp@insert@temp@i\@undefined% 144 | \let\listitem\@undefined% 145 | } 146 | \providecommand\@apply@group[2]{#1#2} 147 | \newcommand\SortList[2][\@apply@group{}]{% 148 | \let\lstp@sort@temp@i#2% 149 | \let#2\empty 150 | \long\def\lstp@sort@listitem##1{% 151 | \lstp@insert{##1}{#1}{#2}% 152 | \let\listitem\lstp@sort@listitem 153 | }% 154 | \let\listitem\lstp@sort@listitem 155 | \lstp@sort@temp@i 156 | \let\lstp@sort@temp@i\@undefined 157 | \let\listitem\@undefined 158 | } 159 | \newcounter{lstp@ifsucc} 160 | \newcommand\lstp@ifsucc[2]{% 161 | \setcounter{lstp@ifsucc}{#1}% 162 | \addtocounter{lstp@ifsucc}{1}% 163 | \ifnum#2=\value{lstp@ifsucc}% 164 | \let\@lstp@ifsucc@kont\@firstoftwo 165 | \else 166 | \let\@lstp@ifsucc@kont\@secondoftwo 167 | \fi 168 | \@lstp@ifsucc@kont 169 | } 170 | \newcommand\CompressList[2][\@apply@group{}]{% 171 | \let\lstp@compress@temp@i#2% 172 | \let#2\empty 173 | \def\lstp@compress@add@single{% 174 | \expandafter\SnocTo\expandafter 175 | {\expandafter\@single\expandafter{\lstp@compress@temp@a}}{#2}% 176 | }% 177 | \def\lstp@compress@add@range{% 178 | \expandafter\expandafter\expandafter\SnocTo 179 | \expandafter\expandafter\expandafter{% 180 | \expandafter\expandafter\expandafter\@range 181 | \expandafter\expandafter\expandafter{% 182 | \expandafter\lstp@compress@temp@a\expandafter}% 183 | \expandafter{\lstp@compress@temp@b}}#2% 184 | }% 185 | \long\def\lstp@compress@listitem@start##1{% 186 | \def\lstp@compress@temp@a{##1}% 187 | \edef\lstp@compress@temp@a@key{#1{##1}}% 188 | \let\listitem\lstp@compress@listitem@single 189 | }% 190 | \long\def\lstp@compress@listitem@single##1{% 191 | \def\lstp@compress@temp@b{##1}% 192 | \edef\lstp@compress@temp@b@key{#1{##1}}% 193 | \ifnum\lstp@compress@temp@a@key=\lstp@compress@temp@b@key 194 | \let\listitem\lstp@compress@listitem@single 195 | \else 196 | \lstp@ifsucc{\lstp@compress@temp@a@key}{\lstp@compress@temp@b@key} 197 | {\let\listitem\lstp@compress@listitem@range} 198 | {\lstp@compress@add@single 199 | \let\lstp@compress@temp@a\lstp@compress@temp@b 200 | \let\lstp@compress@temp@a@key\lstp@compress@temp@b@key 201 | \let\listitem\lstp@compress@listitem@single}% 202 | \fi 203 | }% 204 | \long\def\lstp@compress@listitem@range##1{% 205 | \def\lstp@compress@temp@c{##1}% 206 | \edef\lstp@compress@temp@c@key{#1{##1}}% 207 | \ifnum\lstp@compress@temp@b@key=\lstp@compress@temp@c@key 208 | \let\listitem\lstp@compress@listitem@range 209 | \else 210 | \lstp@ifsucc{\lstp@compress@temp@b@key}{\lstp@compress@temp@c@key} 211 | {% 212 | \let\lstp@compress@temp@b\lstp@compress@temp@c 213 | \let\lstp@compress@temp@b@key\lstp@compress@temp@c@key 214 | \let\listitem\lstp@compress@listitem@range 215 | } 216 | {% 217 | \lstp@compress@add@range 218 | \let\lstp@compress@temp@a\lstp@compress@temp@c 219 | \let\lstp@compress@temp@a@key\lstp@compress@temp@c@key 220 | \let\listitem\lstp@compress@listitem@single 221 | }% 222 | \fi 223 | }% 224 | \let\listitem\lstp@compress@listitem@start 225 | \lstp@compress@temp@i 226 | \ifx\listitem\lstp@compress@listitem@single 227 | \lstp@compress@add@single 228 | \else 229 | \ifx\listitem\lstp@compress@listitem@range 230 | \lstp@compress@add@range 231 | \fi 232 | \fi 233 | \let\lstp@compress@temp@a\@undefined 234 | \let\lstp@compress@temp@b\@undefined 235 | \let\lstp@compress@temp@c\@undefined 236 | \let\lstp@compress@temp@a@key\@undefined 237 | \let\lstp@compress@temp@b@key\@undefined 238 | \let\lstp@compress@temp@c@key\@undefined 239 | \let\lstp@compress@temp@i\@undefined 240 | \let\listitem\@undefined 241 | } 242 | \newcommand\FormatListSepTwo{ and } 243 | \newcommand\FormatListSepMore{, } 244 | \newcommand\FormatListSepLast{, and } 245 | \newcounter{lstp@FormatList@length} 246 | \newcounter{lstp@FormatList@posn} 247 | \newcommand\FormatList[4]{{% 248 | \deflist\lstp@FormatList@list{#4}% 249 | \SetToListLength{lstp@FormatList@length}\lstp@FormatList@list% 250 | \setcounter{lstp@FormatList@posn}{0}% 251 | \ifnum\value{lstp@FormatList@length}=1% 252 | #1% 253 | \else% 254 | #2% 255 | \fi% 256 | \def\listitem##1{% 257 | \addtocounter{lstp@FormatList@posn}{1}% 258 | \ifnum1<\value{lstp@FormatList@posn}% 259 | \ifnum2=\value{lstp@FormatList@length}% 260 | \FormatListSepTwo 261 | \else 262 | \ifnum\value{lstp@FormatList@length}=\value{lstp@FormatList@posn}% 263 | \FormatListSepLast 264 | \else 265 | \FormatListSepMore 266 | \fi 267 | \fi 268 | \fi 269 | #3{##1}% 270 | }% 271 | \lstp@FormatList@list 272 | }} 273 | \newcommand\ListExpr[1]{\@lstp@ListExpr{#1}\relax} 274 | \newcommand\ListExprTo[2]{\@lstp@ListExpr{#1}{\def#2}} 275 | \newcommand\gListExprTo[2]{\@lstp@ListExpr{#1}{\gdef#2}} 276 | \newcommand\@lstp@defbinop[2]{% 277 | \newcommand#1[2]{% 278 | \Eval{##1}\let\@lstp@tmp\@lstp@acc 279 | {\Eval{##2}}% 280 | #2\@lstp@tmp\@lstp@acc 281 | }% 282 | } 283 | \newcommand\@lstp@defunop[2]{% 284 | \newcommand#1[1]{% 285 | \Eval{##1}% 286 | #2\@lstp@acc\@lstp@acc 287 | }% 288 | } 289 | \newcommand\@lstp@definplaceunopopt[3][]{% 290 | \newcommand#2[2][#1]{% 291 | \Eval{##2}% 292 | #3[##1]\@lstp@acc 293 | \global\let\@lstp@acc\@lstp@acc 294 | }% 295 | } 296 | \newcommand\@lstp@ListExpr[2]{% 297 | {% 298 | \gdef\@lstp@acc{}% 299 | \def\Eval##1{% 300 | \IfList{##1}{% 301 | \global\let\@lstp@acc##1% 302 | }{% 303 | \@lstp@ifListOp##1\@lstp@ifListOp{% 304 | ##1% 305 | }{% 306 | \xdef\@lstp@acc{##1}% 307 | }% 308 | }% 309 | }% 310 | \def\Q##1{\gdef\@lstp@acc{##1}}% 311 | \def\Nil{\global\let\@lstp@acc\empty}% 312 | \def\List##1{\gdeflist\@lstp@acc{##1}}% 313 | \@lstp@defbinop\Cons\xConsTo 314 | \@lstp@defbinop\Snoc\xSnocTo 315 | \@lstp@defunop\First\gFirstTo 316 | \@lstp@defunop\Rest\gRestTo 317 | \@lstp@defbinop\Append\gAppendTo 318 | \@lstp@definplaceunopopt[\@apply@group{}]\Sort\SortList 319 | \@lstp@definplaceunopopt[\@apply@group{}]\Compress\CompressList 320 | \newcommand\Map[2]{% 321 | \Eval{##2}% 322 | \gMapListTo{##1}\@lstp@acc\@lstp@acc 323 | }% 324 | \Eval{#1}% 325 | }% 326 | \def\@lstp@finish##1{#2{##1}}% 327 | \expandafter\@lstp@finish\expandafter{\@lstp@acc}% 328 | } 329 | \def\@lstp@ifListOp#1#2\@lstp@ifListOp{% 330 | \@lstp@ifInToks#1{ 331 | \Q\Nil\List\Cons\Snoc\Append 332 | \First\Rest\Sort\Compress\Map 333 | } 334 | } 335 | \newcommand\@lstp@ifInToks[2]{% 336 | {% 337 | \def\@tester##1#1##2\@tester{% 338 | \ifx\@notfound##2\relax 339 | \aftergroup\@secondoftwo 340 | \else 341 | \aftergroup\@firstoftwo 342 | \fi 343 | }% 344 | \@tester#2\@lstp@ifInToks#1\@notfound\@tester 345 | }% 346 | } 347 | \endinput 348 | %% 349 | %% End of file `listproc.sty'. 350 | -------------------------------------------------------------------------------- /doc/icfp17/mathpartir.sty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/icfp17/mathpartir.sty -------------------------------------------------------------------------------- /doc/icfp17/ottalt.sty: -------------------------------------------------------------------------------- 1 | %% 2 | %% This is file `ottalt.sty', 3 | %% generated with the docstrip utility. 4 | %% 5 | %% The original source files were: 6 | %% 7 | %% ottalt.dtx (with options: `package') 8 | %% 9 | %% Copyright (C) 2011 by Jesse A. Tov 10 | %% 11 | %% This file may be distributed and/or modified under the conditions of the 12 | %% LaTeX Project Public License, either version 1.2 of this license or (at 13 | %% your option) any later version. The latest version of this license is 14 | %% in: 15 | %% 16 | %% http://www.latex-project.org/lppl.txt 17 | %% 18 | %% and version 1.2 or later is part of all distributions of LaTeX 19 | %% version 1999/12/01 or later. 20 | %% 21 | \NeedsTeXFormat{LaTeX2e}[1999/12/01] 22 | \ProvidesPackage{ottalt} 23 | [2013/03/14 v0.11 alternate Ott layout style] 24 | \RequirePackage{mathpartir} 25 | \RequirePackage{ifthen} 26 | \RequirePackage{keyval} 27 | \RequirePackage{listproc} 28 | \DeclareOption{implicitPremiseBreaks}{ 29 | \renewcommand\ottaltpremisesep{\\} 30 | \renewcommand\ottaltpremisebreak{\\} 31 | } 32 | \DeclareOption{lineBreakHack}{ 33 | \renewcommand\ottaltpremisesep{\and} 34 | \renewcommand\ottaltpremisebreak{\\\\} 35 | } 36 | \DeclareOption{implicitLineBreakHack}{ 37 | \renewcommand\ottaltpremisesep{\\} 38 | \renewcommand\ottaltpremisebreak{\\\\} 39 | } 40 | \DeclareOption{alternateNonterms}{ 41 | \let\ifnotalternateNonterms\@secondoftwo 42 | } 43 | \DeclareOption{supertabular}{ 44 | \ottalt@supertabulartrue 45 | } 46 | \newcommand\ottaltpremisesep{\\} 47 | \newcommand\ottaltpremisebreak{\\} 48 | \let\ifnotalternateNonterms\@firstoftwo 49 | \newif\ifottalt@supertabular 50 | \ProcessOptions 51 | \ifottalt@supertabular 52 | \RequirePackage{supertabular} 53 | \fi 54 | \newcommand\inputott[2][ott]{ 55 | \input{#2} 56 | \renewottcommands[#1] 57 | } 58 | \newcommand\ottaltcurrentprefix{ott} 59 | \newcommand\renewottcommands[1][ott]{ 60 | \renewcommand\ottaltcurrentprefix{#1} 61 | \def\renewottcomm@nd##1{ 62 | \expandafter\renewcommand\csname #1##1\endcsname 63 | } 64 | \renewottcomm@nd{drule}[4][]{ 65 | \def\ottalt@nextpremise{} 66 | \ottalt@premisetoks={ } 67 | ##2 68 | \expandafter\ottalt@inferrule\expandafter 69 | {\the\ottalt@premisetoks}{##3}{##4}{##1} 70 | } 71 | \renewottcomm@nd{premise}[1]{% 72 | \ottalt@premisetoks= 73 | \expandafter\expandafter\expandafter 74 | {\expandafter\the\expandafter\ottalt@premisetoks 75 | \ottalt@nextpremise##1} 76 | \ottalt@iflinebreakhack##1\ottlinebreakhack\ottalt@iflinebreakhack{ 77 | \let\ottalt@nextpremise\ottaltpremisebreak 78 | }{ 79 | \let\ottalt@nextpremise\ottaltpremisesep 80 | } 81 | } 82 | \renewottcomm@nd{usedrule}[1]{% 83 | \ifottalt@firstrule 84 | \ottalt@firstrulefalse 85 | \else 86 | \and 87 | \fi 88 | \ensuremath{##1} 89 | } 90 | \renewenvironment{#1defnblock}[3][] 91 | {\begin{drulepar}{##2}{##3}} 92 | {\end{drulepar}} 93 | \renewottcomm@nd{drulename}[1]{% 94 | \ottalt@replace@cs\ranchor\_-{}##1\\ 95 | } 96 | \renewottcomm@nd{prodline}[6]{ 97 | \ifthenelse{\equal{##3}{}}{ 98 | \\ & & $##1$ & $##2$ & & $##5$ & $##6$ 99 | }{} 100 | } 101 | \renewottcomm@nd{prodnewline}{\relax} 102 | \renewottcomm@nd{grammartabular}[1]{% 103 | \begin{ottaltgrammar}##1\end{ottaltgrammar}% 104 | } 105 | } 106 | \newcommand*\drule@h@lper[3]{% 107 | \expandafter\ifx\csname\ottaltcurrentprefix drule#3\endcsname\relax 108 | \PackageWarning{ottalt}{Unknown ott rule: #3}% 109 | \mbox{\textbf{(#2?)}}% 110 | \else 111 | \csname\ottaltcurrentprefix usedrule\endcsname 112 | {\csname\ottaltcurrentprefix drule#3\endcsname{#1}}% 113 | \fi 114 | } 115 | \newcommand*\nonterm@h@lper[1]{\csname\ottaltcurrentprefix#1\endcsname} 116 | \newcommand\rrefruletext{rule} 117 | \newcommand\Rrefruletext{\expandafter\MakeUppercase\rrefruletext} 118 | \newcommand\rrefrulestext{\rrefruletext s} 119 | \newcommand\Rrefrulestext{\Rrefruletext s} 120 | \newcommand\rrefstyle{\normalfont\scshape} 121 | \newcommand\ranchorstyle{\rrefstyle} 122 | \providecommand\wraparoundrref{\relax} 123 | \newcommand*\rref{% 124 | \@ifnextchar* 125 | {\rref@star} 126 | {\rref@with\rrefruletext\rrefrulestext}} 127 | \newcommand*\Rref{% 128 | \@ifnextchar* 129 | {\rref@star} 130 | {\rref@with\Rrefruletext\Rrefrulestext}} 131 | \newcommand*\rref@with[2]{\FormatList{#1~}{#2~}{\one@rref}} 132 | \newcommand*\rref@star[1]{\FormatList{}{}{\one@rref}} 133 | \newcommand*\@one@rref@nohyper[1]{\wraparoundrref{{\rrefstyle{#1}}}} 134 | \newcommand*\@ranchor@nohyper[1]{{\ranchorstyle{#1}}} 135 | \AtBeginDocument{ 136 | \ifcsname hypertarget\endcsname 137 | \newcommand*\one@rref[1]{% 138 | \hyperlink 139 | {ottalt:rule:\ottaltcurrentprefix:#1} 140 | {\@one@rref@nohyper{#1}}% 141 | } 142 | \newcommand*\ranchor[1]{% 143 | \hypertarget 144 | {ottalt:rule:\ottaltcurrentprefix:#1} 145 | {\@ranchor@nohyper{#1}}% 146 | } 147 | \else 148 | \newcommand\one@rref{\@one@rref@nohyper} 149 | \newcommand\ranchor{\@ranchor@nohyper} 150 | \fi 151 | } 152 | \newcommand*{\drules}[4][\relax]{% 153 | \begin{drulepar}[#1]{#2}{#3} 154 | \@for\@ottalt@each:=#4\do{% 155 | \expandafter\drule\expandafter{\@ottalt@each} 156 | } 157 | \end{drulepar}% 158 | } 159 | \newenvironment{drulepar}[3][\relax] 160 | {\begin{rulesection}[#1]{#2}{#3}% 161 | \begin{mathparpagebreakable}} 162 | {\end{mathparpagebreakable}% 163 | \end{rulesection}} 164 | \newenvironment{drulepar*}[3][\relax] 165 | {\begin{rulesection*}[#1]{#2}{#3}% 166 | \begin{mathparpagebreakable}} 167 | {\end{mathparpagebreakable}% 168 | \end{rulesection*}} 169 | \newenvironment{rulesection}[3][\relax] 170 | {\trivlist\item 171 | \ifx#1\relax\else\def\ottalt@rulesection@prefix{#1-}\fi 172 | \drulesectionhead{#2}{#3}% 173 | \nopagebreak[4]% 174 | \noindent} 175 | {\endtrivlist} 176 | \newenvironment{rulesection*}[3][\relax] 177 | {\trivlist\item 178 | \ifx#1\relax\else\def\ottalt@rulesection@prefix{#1-}\fi 179 | \drulesectionhead*{#2}{#3}% 180 | \nopagebreak[4]% 181 | \noindent} 182 | {\endtrivlist} 183 | \newcommand\ottalt@rulesection@prefix{} 184 | \newcommand*{\drulesectionhead}{% 185 | \@ifnextchar *{\drulesectionheadMany}{\drulesectionheadOne}% 186 | } 187 | \newcommand*{\drulesectionheadOne}[2]{% 188 | \FormatDruleSectionHead{#1}% 189 | \hfill\FormatDruleSectionHeadRight{#2}% 190 | \par 191 | } 192 | \newcommand*{\drulesectionheadMany}[3]{% 193 | {% 194 | \let\FormatListSepTwo\FormatDruleSepTwo 195 | \let\FormatListSepMore\FormatDruleSepMore 196 | \let\FormatListSepLast\FormatDruleSepLast 197 | \FormatList{}{}{\FormatDruleSectionHeads}{#2}% 198 | }% 199 | \hfill\FormatDruleSectionHeadRight{#3}% 200 | \par 201 | } 202 | \newcommand*\FormatDruleSepTwo{\,,~} 203 | \newcommand*\FormatDruleSepMore{\FormatDruleSepTwo} 204 | \newcommand*\FormatDruleSepLast{\FormatDruleSepTwo} 205 | \newcommand*\FormatDruleSectionHead[1]{\fbox{#1}} 206 | \newcommand*\FormatDruleSectionHeads[1]{\fbox{\strut#1}} 207 | \newcommand*\FormatDruleSectionHeadRight[1]{\emph{(#1)}} 208 | \newcommand*\drule[2][]{% 209 | \expandafter\drule@helper\expandafter{\ottalt@rulesection@prefix}{#1}{#2}% 210 | } 211 | \newcommand*\drule@helper[3]{% 212 | \ottalt@replace@cs{\drule@h@lper{#2}{#1#3}}-{XX}{}#1#3\\ 213 | } 214 | \newcommand\ottaltinferrule[4]{ 215 | \inferrule*[narrower=0.3,lab=#1,#2] 216 | {#3} 217 | {#4} 218 | } 219 | \newcommand\ottalt@inferrule[4]{ 220 | \ottaltinferrule{#3}{#4}{#1}{#2} 221 | } 222 | \newif\ifottalt@firstrule \ottalt@firstruletrue 223 | \newcommand{\ottalt@nextpremise}{\relax} 224 | \newtoks\ottalt@premisetoks 225 | \newcommand{\ottlinebreakhack}{\relax} 226 | \def\ottalt@iflinebreakhack#1\ottlinebreakhack #2\ottalt@iflinebreakhack{% 227 | \ifthenelse{\equal{#2}{}}\@secondoftwo\@firstoftwo 228 | } 229 | \newcommand\ottalt@replace@cs[5]{% 230 | \ifx\\#5\relax 231 | \def\ottalt@replace@cs@kont{#1{#4}}% 232 | \else 233 | \ifx#2#5\relax 234 | \def\ottalt@replace@cs@kont{\ottalt@replace@cs{#1}{#2}{#3}{#4#3}}% 235 | \else 236 | \def\ottalt@replace@cs@kont{\ottalt@replace@cs{#1}{#2}{#3}{#4#5}}% 237 | \fi 238 | \fi 239 | \ottalt@replace@cs@kont 240 | } 241 | \newcommand*\nonterms[2][8pt]{ 242 | \begin{ottaltgrammar}[#1] 243 | \@for\@ottalt@each:=#2\do{% 244 | \expandafter\nt\expandafter{\@ottalt@each} 245 | } 246 | \end{ottaltgrammar} 247 | } 248 | \newenvironment{ottaltgrammar}[1][8pt]{% 249 | \begingroup 250 | \trivlist\item 251 | \def\OTTALTNEWLINE{\\[#1]}% 252 | \def\nt##1{\OTTALTNEWLINE\relax\nonterm@h@lper{##1}\ignorespaces}% 253 | \newcommand\ottaltintertext[2]{% 254 | \multicolumn{8}{l}{% 255 | \begin{minipage}{##1}% 256 | ##2% 257 | \end{minipage}% 258 | }% 259 | }% 260 | \ifottalt@supertabular 261 | \begin{supertabular}{llcllllll} 262 | \else 263 | \begin{tabular}{llcllllll} 264 | \fi 265 | \let\OTTALTNEWLINE\relax 266 | \ignorespaces 267 | } 268 | {% 269 | \@ifundefined{ottafterlastrule}{\\}{\ottafterlastrule}% 270 | \ifottalt@supertabular 271 | \end{supertabular} 272 | \else 273 | \end{tabular} 274 | \fi 275 | \endtrivlist 276 | \endgroup 277 | \ignorespaces 278 | } 279 | \newcommand\newNTclass[2][\ifnotalternateNonterms]{ 280 | \expandafter\newcommand\csname new#2s\endcsname[4][]{ 281 | #1{ 282 | \expandafter\newcommand\csname ottalt@NT@#2@##2\endcsname{##1{##3}} 283 | }{ 284 | \expandafter\newcommand\csname ottalt@NT@#2@##2\endcsname{##4} 285 | } 286 | } 287 | \expandafter\newcommand\csname new#2\endcsname[3][]{ 288 | \csname new#2s\endcsname[##1]{##2}{##3}{##3} 289 | } 290 | \expandafter\newcommand\csname #2\endcsname[1]{% 291 | \csname ottalt@NT@#2@##1\endcsname 292 | } 293 | } 294 | \providecommand\@ifToif[1]{% 295 | #1\iftrue\iffalse 296 | } 297 | \providecommand\ifTo@if[1]{% 298 | #1% 299 | \expandafter\@firstoftwo 300 | \else 301 | \expandafter\@secondoftwo 302 | \fi 303 | } 304 | \newcommand\NTOVERLINE{\NTCAPTURE\overline} 305 | \newcommand\NTUNDERLINE{\NTCAPTURE\underline} 306 | \newcommand\NTTEXTCOLOR[1]{\NTCAPTURE{\textcolor{#1}}} 307 | \newcommand\NTCAPTURE[1]{\NTCAPTURELOW{\NTCAPTURE@FINISH{#1}}} 308 | \newcommand\NTCAPTURE@FINISH[4]{#1{#2_{#3}#4}} 309 | \newcommand\NTCAPTURELOW[2]{\NT@CAPTURE@LOOP{#1}{#2}\relax\relax} 310 | \newcommand\NT@CAPTURE@LOOP[4]{% 311 | \@ifnextchar _{% 312 | \NT@CAPTURE@SUB{#1}{#2}{#3}{#4}% 313 | }{\@ifnextchar '{% 314 | \NT@CAPTURE@PRIME{#1}{#2}{#3}{#4}% 315 | }{% 316 | {#1{#2}{#3}{#4}}% 317 | }}% 318 | } 319 | \def\NT@CAPTURE@SUB#1#2#3#4_#5{\NT@CAPTURE@LOOP{#1}{#2}{#3#5}{#4}} 320 | \def\NT@CAPTURE@PRIME#1#2#3#4'{\NT@CAPTURE@LOOP{#1}{#2}{#3}{#4'}} 321 | \endinput 322 | %% 323 | %% End of file `ottalt.sty'. 324 | -------------------------------------------------------------------------------- /doc/icfp17/permissions.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sweirich/corespec/ee2d477fb26f3d0155be438a93a2c1427511cb24/doc/icfp17/permissions.pdf -------------------------------------------------------------------------------- /doc/icfp17/zip.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeInType, GADTs, TypeFamilies, KindSignatures, ScopedTypeVariables #-} 2 | 3 | import Prelude hiding (zip) 4 | import Data.Kind (Type) 5 | infixr :> 6 | 7 | data Nat :: Type where 8 | O :: Nat 9 | S :: Nat -> Nat 10 | 11 | data Vec :: Type -> Nat -> Type where 12 | Nil :: (n ~ O) => Vec a n 13 | (:>) :: (n ~ S m) => a -> Vec a m -> Vec a n 14 | 15 | type One = S O 16 | 17 | type family Plus (x :: Nat) (y :: Nat) :: Nat where 18 | Plus O y = y 19 | Plus (S x) y = S (Plus x y) 20 | 21 | example :: Vec Char (Plus One (Plus One One)) 22 | example = 'G' :> 'H' :> 'C' :> Nil 23 | 24 | 25 | zip :: forall n a b. Vec a n -> Vec b n -> Vec (a,b) n 26 | zip Nil Nil = Nil 27 | zip (x :> xs) (y :> ys) = (x,y) :> zip xs ys 28 | 29 | main :: IO () 30 | main = return () 31 | -------------------------------------------------------------------------------- /src/FcEtt/.gitignore: -------------------------------------------------------------------------------- 1 | .lia.cache 2 | -------------------------------------------------------------------------------- /src/FcEtt/LIBRARIES.md: -------------------------------------------------------------------------------- 1 | **(OPTIONAL) To set up a separate Opam "universe" -- useful if you want 2 | multiple versions of Coq -- do:** 3 | 4 | 1. `opam switch install coq8.5 --alias-of system` 5 | 2. `` eval `opam config env` `` 6 | 7 | **To install Coq 8.6 and MathComp (which now includes SSReflect):** 8 | 9 | 1. `opam repo add coq-released https://coq.inria.fr/opam/released` (for 10 | SSReflect and MathComp) 11 | 2. `opam update` 12 | 3. `opam install coq.8.6 coq-mathcomp-ssreflect.1.6.1` 13 | 14 | **install `metalib`:** 15 | 16 | 1. See [instructions](https://github.com/plclub/metalib) 17 | 18 | **(OPTIONAL) To install `lngen`:** 19 | 20 | 1. `git clone https://github.com/plclub/lngen.git` in the same directory as 21 | `src` (so `src` and `lngen` are siblings). 22 | 2. In the `lngen` directory, compile lngen 23 | `cabal sandbox init` 24 | `cabal install` 25 | 3. Makefile will look here 26 | -------------------------------------------------------------------------------- /src/FcEtt/LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 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 | -------------------------------------------------------------------------------- /src/FcEtt/Makefile: -------------------------------------------------------------------------------- 1 | ## Paths to executables. Do not include options here. 2 | ## Modify these to suit your Coq installation, if necessary. 3 | 4 | COQC = coqc 5 | COQDEP = coqdep 6 | 7 | ## Include directories, one per line. 8 | 9 | INCDIRS = \ 10 | . \ 11 | ../metalib \ 12 | 13 | OTT_SOURCE = ett 14 | OTT_LOC = ../../spec 15 | FILES = ett_ott ett_inf 16 | 17 | ## Library name used for the imports in Coq 18 | 19 | LIBNAME=FcEtt 20 | METALIBLOCATION=../metalib 21 | LNGEN=lngen 22 | 23 | 24 | ## Name of the submakefile generated by coq_makefile 25 | COQMKFILENAME=CoqSrc.mk 26 | 27 | 28 | VFILES = $(foreach i, $(FILES), $(i).v) 29 | VOFILES = $(foreach i, $(FILES), $(i).vo) 30 | INCFLAGS = $(foreach i, $(INCDIRS), -I $(i)) 31 | 32 | .SECONDARY: $(VFILES) 33 | 34 | METALIBFILES= $(METALIBLOCATION)/*.v $(METALIBLOCATION)/Makefile $(METALIBLOCATION)/README.txt 35 | 36 | all: coq 37 | 38 | quick: $(COQMKFILENAME) 39 | @$(MAKE) -f CoqSrc.mk quick 40 | 41 | 42 | coq: $(COQMKFILENAME) 43 | @$(MAKE) -f CoqSrc.mk 44 | 45 | 46 | %.vo: %.v 47 | @$(MAKE) -f CoqSrc.mk $*.vo 48 | 49 | 50 | %_ott.v: $(OTT_LOC)/%.ott Makefile 51 | ott -i $(OTT_LOC)/$*.ott -o $*_ott.v -coq_lngen true 52 | make METALIB.FIX_$*_ott 53 | 54 | 55 | %_inf.v: $(OTT_LOC)/%.ott Makefile 56 | $(LNGEN) --coq-no-proofs --coq $*_inf.v --coq-ott $*_ott $(OTT_LOC)/$*.ott 57 | make METALIB.FIX_$*_inf 58 | 59 | $(COQMKFILENAME): Makefile $(shell ls *.v | grep -v _ott.v | grep -v _inf.v) 60 | { echo "-R . $(LIBNAME) " ; ls *.v ; } > _CoqProject && coq_makefile -arg '-w -variable-collision,-meta-collision,-require-in-module' -f _CoqProject -o $(COQMKFILENAME) 61 | 62 | # Target to be called with some filename appended to it 63 | # It is a quick hack to fix the imports to metalib 64 | METALIB.FIX_%: 65 | sed -i -e 's/Metatheory/Metalib.Metatheory/g' $*.v 66 | sed -i -e 's/LibLNgen/Metalib.LibLNgen/g' $*.v 67 | sed '1d' $*.v > __TMP__; mv __TMP__ $*.v 68 | 69 | coqclean: 70 | rm -if *.v.d *.vo *.glob $(VOFILES) $(COQMKFILENAME) 71 | 72 | clean: coqclean 73 | -------------------------------------------------------------------------------- /src/FcEtt/README.md: -------------------------------------------------------------------------------- 1 | This repository must be built with Coq 8.6. 2 | 3 | It requires MathComp (v1.6), and the 8.6 branch of 4 | [metalib](https://github.com/plclub/metalib) to 5 | install. The former comes from opam, the latter from Github. For full 6 | installation instructions, see LIBRARIES.md. 7 | 8 | To build the Coq, run `make coq`. 9 | 10 | This work checks with Coq's native theory -- it includes no Axioms or other 11 | extensions. 12 | 13 | Note: sigs.v contains the definition of several Coq module types that allow us 14 | to break the development into multiple pieces. These signatures use the 15 | keyword "Axiom" to specify the expected results of the modules. All of these 16 | "Axioms" are proved in the development. 17 | 18 | Modules and Sigs: 19 | ext_wf : ext_wf_sig 20 | ext_weak : ext_weak_sig 21 | ext_subst : ext_subst_sig 22 | ext_invert : ext_invert_sig 23 | fc_wf : fc_wf_sig 24 | fc_weak : fc_weak_sig 25 | fc_subst : fc_subst_sig 26 | fc_unique : fc_unique_sig 27 | 28 | Libraries (not language specific) 29 | * dep_prog.v - support for dependently-typed programming in Coq 30 | * fset_facts.v - lemmas about finite sets 31 | * imports.v - external libraries (such as ssreflect) and global settings 32 | * tactics.v - (our own) general purpose tactics & solvers 33 | * utils.v - auxiliary definitions 34 | 35 | Syntactic definitions 36 | * ett.ott - source definitions in OTT 37 | * ett_ott.v - Coq definitions from OTT [generated] 38 | * ett_inf.v - Coq definitions & lemmas from lngen [generated] 39 | * ett_inf_tc.v - ett_inf plus typeclasses [not used] 40 | * ett_inf_cs.v - ett_inf plus canonical structures 41 | * ett_ind.v - induction scheme, gather_atoms 42 | more syntactic infrastructure results 43 | 44 | 45 | 46 | Example concrete signature 47 | 48 | * fix_typing.v - defines toplevel signature to include fixed point operator 49 | * toplevel.v - properties about the toplevel signatures 50 | 51 | Properties about type-agnostic functions and relations: 52 | 53 | * beta.v - lc / subst for beta reduction relation 54 | * ett_par.v - facts about parallel reduction 55 | * erase_syntax.v - interaction between erasure & syntactic functions 56 | * ett_value.v - Value/CoercedValue/Path/DataTy 57 | 58 | 59 | Metatheory of Implicit Language 60 | * ext_wf.v - well-formedness of judgements, i.e. local closure, ctx wff 61 | done, but could use more automation 62 | * ext_context_fv.v - free variables contained in the context 63 | * ext_weak.v - weakening lemma 64 | * ext_subst.v - substitution lemma 65 | * ext_invert.v - inversion lemmas, regularity G |- a : A => G |- A : * 66 | * ext_red.v - preservation lemma (reduction_in_one) 67 | * ext_red_one.v - facts about Values & reduction_in_one 68 | * ext_consist.v - consistency via confluence & reduction 69 | 70 | 71 | Metatheory of Explicit Language 72 | * fc_wf.v - well-formedness of judgements, i.e. local closure, ctx wff 73 | * fc_weak.v - weakening lemma 74 | * fc_subst.v - substitution lemma & smart constructors 75 | * fc_head_reduction - weakening/substitution properties of head_reduction relation 76 | * fc_unique.v - uniqueness of typing 77 | * fc_preservation.v - preservation theorem 78 | * fc_invert.v - regularity lemmas 79 | 80 | Decidability of type checking 81 | * fc_get.v - function to get the type of a well typed term 82 | * fc_dec_aux.v - decidability of various relations 83 | (tm equality, binds, RhoCheck, beta) 84 | * fc_dec_fuel.v - recursive structure of typechecking function 85 | * fc_dec_fun.v - type checking function(s) (including correctness) 86 | * fc_dec.v - decidability of typing 87 | 88 | 89 | Connection between languages 90 | * erase.v - connection between implicit and explicit languages 91 | uses canonical structures 92 | 93 | Results that depend on annotation/erasure 94 | * fc_consist.v - progress lemma for fc 95 | * congruence.v - substitutivity 96 | -------------------------------------------------------------------------------- /src/FcEtt/_CoqProject: -------------------------------------------------------------------------------- 1 | -R . FcEtt 2 | beta.v 3 | congruence.v 4 | dep_prog.v 5 | erase.v 6 | erase_syntax.v 7 | ett_ind.v 8 | ett_inf.v 9 | ett_inf_cs.v 10 | ett_ott.v 11 | ett_par.v 12 | ett_value.v 13 | ext_consist.v 14 | ext_context_fv.v 15 | ext_invert.v 16 | ext_red.v 17 | ext_red_one.v 18 | ext_subst.v 19 | ext_weak.v 20 | ext_wf.v 21 | fc_consist.v 22 | fc_context_fv.v 23 | fc_dec.v 24 | fc_dec_aux.v 25 | fc_dec_fuel.v 26 | fc_dec_fun.v 27 | fc_get.v 28 | fc_head_reduction.v 29 | fc_invert.v 30 | fc_preservation.v 31 | fc_subst.v 32 | fc_unique.v 33 | fc_weak.v 34 | fc_wf.v 35 | fix_typing.v 36 | fset_facts.v 37 | imports.v 38 | main.v 39 | sigs.v 40 | tactics.v 41 | toplevel.v 42 | utils.v 43 | -------------------------------------------------------------------------------- /src/FcEtt/beta.v: -------------------------------------------------------------------------------- 1 | Set Bullet Behavior "Strict Subproofs". 2 | Set Implicit Arguments. 3 | 4 | Require Export FcEtt.tactics. 5 | Require Export FcEtt.imports. 6 | Require Export FcEtt.ett_inf. 7 | Require Export FcEtt.ett_ott. 8 | Require Export FcEtt.ett_ind. 9 | 10 | Require Export FcEtt.ext_context_fv. 11 | 12 | Require Import FcEtt.ext_wf. 13 | Import ext_wf. 14 | 15 | Require Import FcEtt.fc_wf. 16 | Import fc_wf. 17 | 18 | Require Import FcEtt.utils. 19 | Require Import FcEtt.erase_syntax. 20 | Require Export FcEtt.toplevel. 21 | Require Import FcEtt.ett_value. 22 | 23 | (** comment *) 24 | Lemma Beta_lc1 : forall a a' , Beta a a' -> lc_tm a. 25 | intros. induction H; auto. 26 | eapply Value_lc in H. eauto. 27 | Qed. 28 | 29 | Lemma Beta_lc2 : forall a a' , Beta a a' -> lc_tm a'. 30 | intros. induction H; auto. 31 | - inversion H. apply lc_body_tm_wrt_tm; auto. 32 | - apply Value_lc in H. inversion H. 33 | apply lc_body_tm_wrt_tm; auto. 34 | - inversion H. apply lc_body_tm_wrt_co; auto. 35 | - apply Toplevel_lc in H. inversion H. auto. 36 | Qed. 37 | 38 | Lemma cf : forall A B (f : A -> B) (a b : A), a = b -> f a = f b. 39 | intros. f_equal. 40 | auto. 41 | Qed. 42 | Lemma Beta_tm_subst : forall a a' b x, Beta a a' -> lc_tm b -> Beta (tm_subst_tm_tm b x a) (tm_subst_tm_tm b x a'). 43 | Proof. 44 | intros. 45 | destruct H. 46 | - simpl. 47 | rewrite tm_subst_tm_tm_open_tm_wrt_tm; eauto 2. 48 | econstructor; eauto using tm_subst_tm_tm_lc_tm. 49 | apply tm_subst_tm_tm_lc_tm with (a2 := b) (x1:=x) in H; auto. 50 | - simpl. 51 | rewrite tm_subst_tm_tm_open_tm_wrt_tm; eauto 2. 52 | econstructor; eauto using tm_subst_tm_tm_lc_tm. 53 | eapply Value_tm_subst_tm_tm in H; eauto. 54 | - simpl. 55 | rewrite tm_subst_tm_tm_open_tm_wrt_co; eauto 2. 56 | simpl. 57 | econstructor. 58 | apply tm_subst_tm_tm_lc_tm with (a2 := b) (x1:=x) in H; auto. 59 | - move: (toplevel_closed H) => h. 60 | simpl. 61 | rewrite tm_subst_tm_tm_fresh_eq. eauto. 62 | move: (first context_fv_mutual _ _ _ h) => Fr. simpl in Fr. 63 | fsetdec. 64 | Qed. 65 | 66 | Lemma Beta_co_subst : forall a a' b x, Beta a a' -> lc_co b -> Beta (co_subst_co_tm b x a) (co_subst_co_tm b x a'). 67 | Proof. 68 | intros. 69 | destruct H. 70 | - simpl. 71 | rewrite co_subst_co_tm_open_tm_wrt_tm; eauto 2. 72 | econstructor; eauto using co_subst_co_tm_lc_tm. 73 | apply co_subst_co_tm_lc_tm with (g1 := b) (c1:=x) in H; auto. 74 | - simpl. 75 | rewrite co_subst_co_tm_open_tm_wrt_tm; eauto 2. 76 | econstructor; eauto using co_subst_co_tm_lc_tm. 77 | eapply Value_co_subst_co_tm in H; eauto. 78 | - simpl. 79 | rewrite co_subst_co_tm_open_tm_wrt_co; eauto 2. 80 | simpl. 81 | econstructor. 82 | apply co_subst_co_tm_lc_tm with (g1 := b) (c1:=x) in H; auto. 83 | - move: (toplevel_closed H) => h. 84 | simpl. 85 | rewrite co_subst_co_tm_fresh_eq. eauto. 86 | move: (first context_fv_mutual _ _ _ h) => Fr. simpl in Fr. 87 | fsetdec. 88 | Qed. 89 | -------------------------------------------------------------------------------- /src/FcEtt/dep_prog.v: -------------------------------------------------------------------------------- 1 | (* Tools for dependent programming *) 2 | 3 | (* This is the *total* version of these tools, not the fueled one *) 4 | 5 | Require FcEtt.imports. 6 | 7 | 8 | Notation "f >-> g" := (fun x => (g (f x))) (at level 70). 9 | 10 | Inductive sig2el (A:Type) (B:Type) (P : A -> B -> Prop) : Type := 11 | exist2el : forall (x : A) (y : B), P x y -> sig2el P. 12 | 13 | Notation "{ x , y | P }" := (sig2el (fun x y => P)) (at level 0, x at level 99, y at level 99) : type_scope. 14 | 15 | (* 16 | Notation "< e , f >" := (exist2el _ e f _). 17 | *) 18 | 19 | Notation "'yeah'" := (left _ _). 20 | Notation "'nope'" := (right _ _). 21 | 22 | (* Notation "[[ x ]]" := (inleft _ [x]). *) 23 | Notation "<< x >>" := (inleft _ (exist _ x _)). 24 | (* 25 | Notation "<< x , y >>" := (inleft _ ). 26 | *) 27 | Notation "<< x , y >>" := (inleft _ (exist2el _ x y _)). 28 | Notation "!!" := (inright _ _). 29 | 30 | 31 | (* Do not use constructors on this: eauto would be tempted to make it run out of fuel all the time (after all, why bother computing a result?) *) 32 | Hint Resolve inleft inright left right. 33 | 34 | (* Notations: _ <- _; _ is the notation for destructing a fueled sumor (sumorf), >--> for destructing a fueled sumbool (sumboolf). 35 | Rule: the arrows are 1 dash longer when the return (type) constructor is different, e.g. destructing a sumboolf to return a sumorf. *) 36 | Notation "x <- e1 ; e2" := 37 | (match e1 with 38 | | inright _ => !! 39 | | inleft (exist x _) => e2 40 | end) 41 | (right associativity, at level 60). 42 | 43 | (* TODO: this form should check the shape *) 44 | Notation "x <~ e1 ; e2" := 45 | (match e1 with 46 | | inright _ => !! 47 | | inleft (exist x _) => e2 48 | end) 49 | (right associativity, at level 60). 50 | 51 | Notation "x <-- e1 ; e2" := 52 | (match e1 with 53 | | inright _ => nope 54 | | inleft (exist x _) => e2 55 | end) 56 | (right associativity, at level 60). 57 | 58 | Notation "x & y <- e1 ; e2" := 59 | (match e1 with 60 | | inright _ => !! 61 | | inleft (exist2el x y _) => e2 62 | end) 63 | (right associativity, at level 60, y at level 0). 64 | 65 | Notation "x & y <-- e1 ; e2" := 66 | (match e1 with 67 | | inright _ => nope 68 | | inleft (exist2el x y _) => e2 69 | end) 70 | (right associativity, at level 60, y at level 0). 71 | 72 | Notation "e1 >--> e2" := 73 | (match e1 with 74 | | right _ => nope 75 | | left _ => e2 76 | end) 77 | (right associativity, at level 60). 78 | 79 | Notation "e1 >---> e2" := 80 | (match e1 with 81 | | right _ => !! 82 | | left _ => e2 83 | end) 84 | (right associativity, at level 60). 85 | -------------------------------------------------------------------------------- /src/FcEtt/ett_inf_cs.v: -------------------------------------------------------------------------------- 1 | (* Completing the infrastructure of ett 2 | 3 | Current additions: 4 | - polymorphic functions (via canonical structures) 5 | *) 6 | 7 | Require Import FcEtt.ett_inf. 8 | Require Import FcEtt.imports. 9 | 10 | (**** Operators on syntactic sorts ****) 11 | (* TODO: better name? *) 12 | Module Operators. 13 | 14 | Module Close. 15 | 16 | Record class1 (ssort : Type) (vartype : Type) := Class1 {close_ : vartype -> ssort -> ssort; close_rec_ : nat -> vartype -> ssort -> ssort}. 17 | 18 | Record class (ssort : Type) := Class {class_tm : class1 ssort tmvar; class_co : class1 ssort covar}. 19 | 20 | Arguments Class {ssort} class_tm class_co. 21 | Arguments Class1 {ssort vartype} close_ close_rec_. 22 | 23 | End Close. 24 | 25 | 26 | Module Open. 27 | 28 | (* TODO *) 29 | 30 | End Open. 31 | 32 | 33 | Module Erase. 34 | 35 | Record class (ssort : Type) := Class {erase_ssort : ssort -> ssort}. 36 | 37 | Arguments Class {ssort} erase_ssort. 38 | 39 | End Erase. 40 | 41 | 42 | Module FV. 43 | 44 | Record class (ssort : Type) := Class {fv_tm : ssort -> atoms; fv_co : ssort -> atoms}. 45 | 46 | Arguments Class {ssort} fv_tm fv_co. 47 | 48 | End FV. 49 | 50 | (* TODO; open, fv *) 51 | Structure type := Pack {stxsort : Type; class_close : Close.class stxsort; class_Erase : Erase.class stxsort; class_Fv : FV.class stxsort}. 52 | 53 | Definition close_tm' (e : type) : tmvar -> stxsort e -> stxsort e := 54 | let 'Pack _ (Close.Class (Close.Class1 c _) _) _ _ := e return tmvar -> stxsort e -> stxsort e in c. 55 | 56 | Definition close_tm_rec' (e : type) : nat -> tmvar -> stxsort e -> stxsort e := 57 | let 'Pack _ (Close.Class (Close.Class1 _ c) _) _ _ := e return nat -> tmvar -> stxsort e -> stxsort e in c. 58 | 59 | Definition close_co' (e : type) : covar -> stxsort e -> stxsort e := 60 | let 'Pack _ (Close.Class _ (Close.Class1 c _)) _ _ := e return covar -> stxsort e -> stxsort e in c. 61 | 62 | Definition close_co_rec' (e : type) : nat -> covar -> stxsort e -> stxsort e := 63 | let 'Pack _ (Close.Class _ (Close.Class1 _ c)) _ _ := e return nat -> covar -> stxsort e -> stxsort e in c. 64 | 65 | Definition erase' (e : type) : stxsort e -> stxsort e := 66 | let 'Pack _ _ (Erase.Class c) _ := e in c. 67 | 68 | Definition fv_tm' (e : type) : stxsort e -> atoms := 69 | let 'Pack _ _ _ (FV.Class c _) := e in c. 70 | 71 | Definition fv_co' (e : type) : stxsort e -> atoms := 72 | let 'Pack _ _ _ (FV.Class _ c) := e in c. 73 | 74 | Arguments close_tm' {e} s v : simpl nomatch. 75 | Arguments close_tm_rec' {e} k s v : simpl nomatch. 76 | Arguments close_co' {e} s v : simpl nomatch. 77 | Arguments close_co_rec' {e} k s v : simpl nomatch. 78 | Arguments erase' {e} s : simpl nomatch. 79 | Arguments fv_tm' {e} s : simpl nomatch. 80 | Arguments fv_co' {e} s : simpl nomatch. 81 | 82 | 83 | Module Theory. 84 | 85 | Notation close_tm := close_tm'. 86 | Notation close_tm_rec := close_tm_rec'. 87 | Notation close_co := close_co'. 88 | Notation close_co_rec := close_co_rec'. 89 | 90 | Notation erase := erase'. 91 | 92 | Notation fv_tm := fv_tm'. 93 | Notation fv_co := fv_co'. 94 | 95 | End Theory. 96 | 97 | End Operators. 98 | 99 | Export Operators.Theory. 100 | 101 | 102 | Definition tm_Closecl : Operators.Close.class tm := Operators.Close.Class (Operators.Close.Class1 close_tm_wrt_tm close_tm_wrt_tm_rec) (Operators.Close.Class1 close_tm_wrt_co close_tm_wrt_co_rec). 103 | Definition co_Closecl : Operators.Close.class co := Operators.Close.Class (Operators.Close.Class1 close_co_wrt_tm close_co_wrt_tm_rec) (Operators.Close.Class1 close_co_wrt_co close_co_wrt_co_rec). 104 | Definition brs_Closecl : Operators.Close.class brs := Operators.Close.Class (Operators.Close.Class1 close_brs_wrt_tm close_brs_wrt_tm_rec) (Operators.Close.Class1 close_brs_wrt_co close_brs_wrt_co_rec). 105 | Definition constraint_Closecl : Operators.Close.class constraint := Operators.Close.Class (Operators.Close.Class1 close_constraint_wrt_tm close_constraint_wrt_tm_rec) (Operators.Close.Class1 close_constraint_wrt_co close_constraint_wrt_co_rec). 106 | 107 | 108 | (* TODO: this function is not yet defined with the other erase_*, as it's pretty much useless, but do we want to define it in the ott file? *) 109 | Definition erase_co (_ : co) := g_Triv. 110 | 111 | Definition tm_Erasecl : Operators.Erase.class tm := Operators.Erase.Class erase_tm. 112 | Definition co_Erasecl : Operators.Erase.class co := Operators.Erase.Class erase_co. 113 | Definition brs_Erasecl : Operators.Erase.class brs := Operators.Erase.Class erase_brs. 114 | Definition constraint_Erasecl : Operators.Erase.class constraint := Operators.Erase.Class erase_constraint. 115 | 116 | Definition tm_FVcl : Operators.FV.class tm := Operators.FV.Class fv_tm_tm_tm fv_co_co_tm. 117 | Definition co_FVcl : Operators.FV.class co := Operators.FV.Class fv_tm_tm_co fv_co_co_co. 118 | Definition brs_FVcl : Operators.FV.class brs := Operators.FV.Class fv_tm_tm_brs fv_co_co_brs. 119 | Definition constraint_FVcl : Operators.FV.class constraint := Operators.FV.Class fv_tm_tm_constraint fv_co_co_constraint. 120 | 121 | Canonical Structure tm_OpsTy : Operators.type := Operators.Pack tm_Closecl tm_Erasecl tm_FVcl. 122 | Canonical Structure co_OpsTy : Operators.type := Operators.Pack co_Closecl co_Erasecl co_FVcl. 123 | Canonical Structure brs_OpsTy : Operators.type := Operators.Pack brs_Closecl brs_Erasecl brs_FVcl. 124 | Canonical Structure constraint_OpsTy : Operators.type := Operators.Pack constraint_Closecl constraint_Erasecl constraint_FVcl. 125 | 126 | 127 | Module Test. 128 | 129 | 130 | (* 131 | Check close_tm x a_Star. 132 | Check close_tm x (g_Refl a_Star). 133 | Check close_tm x (Eq a_Star a_Star). 134 | Check close_tm x br_None. 135 | 136 | Check erase a_Star. 137 | Check erase (g_Refl a_Star). 138 | Check erase (Eq a_Star a_Star). 139 | Check erase br_None. 140 | *) 141 | 142 | End Test. 143 | 144 | 145 | (* TODO: could be nicer with some more canonical structures *) 146 | Module Rew. 147 | Definition r_erase_tm : forall x, erase_tm x = erase x := fun _ => eq_refl. 148 | Definition r_erase_co : forall x, erase_co x = erase x := fun _ => eq_refl. 149 | Definition r_erase_brs : forall x, erase_brs x = erase x := fun _ => eq_refl. 150 | Definition r_erase_constraint : forall x, erase_constraint x = erase x := fun _ => eq_refl. 151 | 152 | Definition r_close_tm_tm : forall x t, close_tm_wrt_tm x t = close_tm x t := fun _ _ => eq_refl. 153 | Definition r_close_tm_co : forall x t, close_co_wrt_tm x t = close_tm x t := fun _ _ => eq_refl. 154 | Definition r_close_tm_brs : forall x t, close_brs_wrt_tm x t = close_tm x t := fun _ _ => eq_refl. 155 | Definition r_close_tm_constraint : forall x t, close_constraint_wrt_tm x t = close_tm x t := fun _ _ => eq_refl. 156 | 157 | Definition r_close_co_tm : forall x t, close_tm_wrt_co x t = close_co x t := fun _ _ => eq_refl. 158 | Definition r_close_co_co : forall x t, close_co_wrt_co x t = close_co x t := fun _ _ => eq_refl. 159 | Definition r_close_co_brs : forall x t, close_brs_wrt_co x t = close_co x t := fun _ _ => eq_refl. 160 | Definition r_close_co_constraint : forall x t, close_constraint_wrt_co x t = close_co x t := fun _ _ => eq_refl. 161 | 162 | 163 | (* Proper/canonical name for this module? *) 164 | Module Exprt. 165 | Hint Rewrite -> r_erase_tm r_erase_co r_erase_brs r_erase_constraint : rewdb_cs. 166 | 167 | (* Ugly but autorewrite fails weirdly with the facts above *) 168 | Ltac autorewcs := 169 | rewrite ? r_erase_tm; 170 | rewrite ? r_erase_co; 171 | rewrite ? r_erase_brs; 172 | rewrite ? r_erase_constraint; 173 | 174 | rewrite ? r_close_tm_tm; 175 | rewrite ? r_close_tm_co; 176 | rewrite ? r_close_tm_brs; 177 | rewrite ? r_close_tm_constraint; 178 | 179 | rewrite ? r_close_co_tm; 180 | rewrite ? r_close_co_co; 181 | rewrite ? r_close_co_brs; 182 | rewrite ? r_close_co_constraint. 183 | 184 | (* Ugly but autorewrite fails weirdly with the facts above *) 185 | Ltac autorewcshyp H := 186 | rewrite ? r_erase_tm in H; 187 | rewrite ? r_erase_co in H; 188 | rewrite ? r_erase_brs in H; 189 | rewrite ? r_erase_constraint in H; 190 | 191 | rewrite ? r_close_tm_tm in H; 192 | rewrite ? r_close_tm_co in H; 193 | rewrite ? r_close_tm_brs in H; 194 | rewrite ? r_close_tm_constraint in H; 195 | 196 | rewrite ? r_close_co_tm in H; 197 | rewrite ? r_close_co_co in H; 198 | rewrite ? r_close_co_brs in H; 199 | rewrite ? r_close_co_constraint in H. 200 | End Exprt. 201 | End Rew. 202 | 203 | Export Rew.Exprt. 204 | -------------------------------------------------------------------------------- /src/FcEtt/ett_value.v: -------------------------------------------------------------------------------- 1 | Set Bullet Behavior "Strict Subproofs". 2 | Set Implicit Arguments. 3 | 4 | Require Export FcEtt.tactics. 5 | Require Export FcEtt.imports. 6 | Require Export FcEtt.ett_inf. 7 | Require Export FcEtt.ett_ott. 8 | Require Export FcEtt.ett_ind. 9 | 10 | 11 | Require Export FcEtt.ext_context_fv. 12 | 13 | Require Import FcEtt.ext_wf. 14 | Import ext_wf. 15 | 16 | Require Import FcEtt.utils. 17 | Require Import FcEtt.erase_syntax. 18 | Require Export FcEtt.toplevel. 19 | 20 | 21 | (* ------------------------------------------ *) 22 | 23 | (* Paths *) 24 | 25 | (* 26 | Lemma Path_tm_subst_tm_tm : forall T a x b, Path T a -> lc_tm b -> Path T (tm_subst_tm_tm b x a). 27 | Proof. induction 1; try destruct rho; simpl; eauto with lngen. 28 | Qed. 29 | 30 | Lemma Path_co_subst_co_tm : forall T a x b, Path T a -> lc_co b -> Path T (co_subst_co_tm b x a). 31 | Proof. induction 1; try destruct rho; simpl; eauto with lngen. 32 | Qed. 33 | 34 | Hint Resolve Path_tm_subst_tm_tm Path_co_subst_co_tm : lngen. 35 | 36 | Lemma Path_unique : forall T1 T2 a, Path T1 a -> Path T2 a -> T1 = T2. 37 | Proof. 38 | induction 1; intros P; inversion P; auto. 39 | Qed. 40 | 41 | (* DataTy *) 42 | 43 | Lemma DataTy_tm_subst_tm_tm : forall b x A, 44 | DataTy A a_Star -> lc_tm b -> DataTy (tm_subst_tm_tm b x A) a_Star. 45 | Proof. 46 | intros. dependent induction H; simpl; eauto. 47 | - pick fresh y and apply DT_Pi. 48 | eauto with lngen. 49 | autorewrite with subst_open_var; eauto. 50 | - pick fresh y and apply DT_CPi. 51 | eauto with lngen. 52 | autorewrite with subst_open_var; eauto. 53 | Qed. 54 | 55 | Lemma DataTy_co_subst_co_tm : forall b x A, 56 | DataTy A a_Star -> lc_co b -> DataTy (co_subst_co_tm b x A) a_Star. 57 | Proof. 58 | intros. dependent induction H; simpl; eauto. 59 | - pick fresh y and apply DT_Pi. 60 | eauto with lngen. 61 | autorewrite with subst_open_var; eauto. 62 | - pick fresh y and apply DT_CPi. 63 | eauto with lngen. 64 | autorewrite with subst_open_var; eauto. 65 | Qed. 66 | 67 | Hint Resolve DataTy_tm_subst_tm_tm DataTy_co_subst_co_tm : lngen. 68 | *) 69 | (* ------------------------------------------- *) 70 | (* 71 | Definition decide_Path : forall a, lc_tm a -> (exists T, Path T a) \/ (forall T, not (Path T a)). 72 | Proof. 73 | induction a; intro lc. 74 | all: try solve [left; eauto]. 75 | all: try solve [right; move => T h1; inversion h1]. 76 | - lc_inversion c. destruct IHa1 as [[T h0]|n]. 77 | auto. 78 | left; eauto. 79 | right. move => T h1. inversion h1. 80 | subst. unfold not in n. eauto. 81 | - lc_inversion c. destruct IHa as [[T h0]|n]. 82 | auto. 83 | left; eauto. 84 | right. intros T h; inversion h; subst; unfold not in n; eauto. 85 | - lc_inversion c. destruct IHa as [[T h0]|n]. 86 | auto. 87 | left. exists T. auto. 88 | right. intros T h; inversion h; subst; unfold not in n; eauto. 89 | Qed. 90 | *) 91 | (* ------------------------------------------- *) 92 | 93 | (* Values and CoercedValues *) 94 | 95 | Lemma tm_subst_tm_tm_Value_mutual : 96 | (forall v, CoercedValue v -> forall b x, lc_tm b -> CoercedValue (tm_subst_tm_tm b x v)) /\ 97 | (forall v, Value v -> forall b x, lc_tm b -> Value (tm_subst_tm_tm b x v)). 98 | Proof. 99 | apply CoercedValue_Value_mutual; simpl. 100 | all: try solve [inversion 1 | econstructor; eauto]; eauto. 101 | all: try solve [intros; 102 | eauto using tm_subst_tm_tm_lc_tm, 103 | tm_subst_tm_constraint_lc_constraint, 104 | tm_subst_tm_co_lc_co]. 105 | all: try solve [intros; 106 | constructor; eauto using tm_subst_tm_tm_lc_tm, tm_subst_tm_constraint_lc_constraint; 107 | match goal with [H: lc_tm (?a1 ?a2), K : lc_tm ?b |- _ ] => 108 | move: (tm_subst_tm_tm_lc_tm _ _ x H K) => h0; auto end]. 109 | 110 | - intros L a v H b x H0. 111 | econstructor; eauto. 112 | instantiate (1 := L \u singleton x) => x0 h0. 113 | rewrite tm_subst_tm_tm_open_tm_wrt_tm_var; auto. 114 | - intros L A a l c H b x H0. 115 | econstructor; eauto. 116 | apply tm_subst_tm_tm_lc_tm; auto. 117 | instantiate (1 := L \u singleton x) => x0 h0. 118 | rewrite tm_subst_tm_tm_open_tm_wrt_tm_var; auto. 119 | Qed. 120 | 121 | Lemma Value_tm_subst_tm_tm : 122 | (forall v b x, Value v -> lc_tm b -> Value (tm_subst_tm_tm b x v)). 123 | Proof. 124 | intros v b x H H0. 125 | apply tm_subst_tm_tm_Value_mutual; auto. 126 | Qed. 127 | 128 | Lemma CoercedValue_tm_subst_tm_tm : 129 | (forall v b x, CoercedValue v -> lc_tm b -> CoercedValue (tm_subst_tm_tm b x v)). 130 | Proof. 131 | intros v b x H H0. 132 | destruct (tm_subst_tm_tm_Value_mutual); auto. 133 | Qed. 134 | 135 | (* ------------------------------------------------- *) 136 | 137 | Lemma Value_UAbsIrrel_exists : ∀ x (a : tm), 138 | x `notin` fv_tm a 139 | → (Value (open_tm_wrt_tm a (a_Var_f x))) 140 | → Value (a_UAbs Irrel a). 141 | Proof. 142 | intros. 143 | eapply (Value_UAbsIrrel ({{x}})); eauto. 144 | intros. 145 | rewrite (tm_subst_tm_tm_intro x); eauto. 146 | eapply Value_tm_subst_tm_tm; auto. 147 | Qed. 148 | 149 | Lemma Value_AbsIrrel_exists : ∀ x (A a : tm), 150 | x `notin` fv_tm a 151 | -> lc_tm A 152 | → (CoercedValue (open_tm_wrt_tm a (a_Var_f x))) 153 | → Value (a_Abs Irrel A a). 154 | Proof. 155 | intros. 156 | eapply (Value_AbsIrrel ({{x}})); eauto. 157 | intros. 158 | rewrite (tm_subst_tm_tm_intro x); eauto. 159 | eapply CoercedValue_tm_subst_tm_tm; auto. 160 | Qed. 161 | 162 | (* ----- *) 163 | 164 | Lemma co_subst_co_tm_Value_mutual : 165 | (forall v, CoercedValue v -> forall b x, lc_co b -> CoercedValue (co_subst_co_tm b x v)) /\ 166 | (forall v, Value v -> forall b x, lc_co b -> Value (co_subst_co_tm b x v)). 167 | Proof. 168 | apply CoercedValue_Value_mutual; simpl. 169 | all: try solve [inversion 1 | econstructor; eauto]; eauto. 170 | all: try solve [intros; 171 | eauto using co_subst_co_tm_lc_tm, 172 | co_subst_co_constraint_lc_constraint, 173 | co_subst_co_co_lc_co]. 174 | all: try solve [intros; 175 | constructor; eauto using co_subst_co_tm_lc_tm, 176 | co_subst_co_constraint_lc_constraint; 177 | match goal with [H: lc_tm (?a1 ?a2), K : lc_co ?b |- _ ] => 178 | move: (co_subst_co_tm_lc_tm _ _ x H K) => h0; auto end]. 179 | - intros. 180 | pick fresh y. 181 | eapply Value_UAbsIrrel_exists with (x:=y). 182 | eapply fv_tm_tm_tm_co_subst_co_tm_notin; eauto. 183 | move: (H y ltac:(eauto) b x H0) => h0. 184 | rewrite co_subst_co_tm_open_tm_wrt_tm in h0. 185 | simpl in h0. auto. auto. 186 | - intros. 187 | pick fresh y. 188 | eapply Value_AbsIrrel_exists with (x:=y). 189 | eapply fv_tm_tm_tm_co_subst_co_tm_notin; eauto. 190 | eapply co_subst_co_tm_lc_tm; eauto. 191 | move: (H y ltac:(eauto) b x H0) => h0. 192 | rewrite co_subst_co_tm_open_tm_wrt_tm in h0; auto. 193 | Qed. 194 | 195 | Lemma Value_co_subst_co_tm : 196 | (forall v b x, Value v -> lc_co b -> Value (co_subst_co_tm b x v)). 197 | Proof. 198 | intros v b x H H0. 199 | apply co_subst_co_tm_Value_mutual; auto. 200 | Qed. 201 | 202 | Lemma CoercedValue_co_subst_co_tm : 203 | (forall v b x, CoercedValue v -> lc_co b -> CoercedValue (co_subst_co_tm b x v)). 204 | Proof. 205 | intros v b x H H0. 206 | destruct (co_subst_co_tm_Value_mutual); auto. 207 | Qed. 208 | 209 | 210 | 211 | (* ------------------------------------------ *) 212 | 213 | (* 214 | Lemma decide_Value_mutual : forall a, 215 | lc_tm a -> 216 | (Value a \/ not (Value a)) /\ (CoercedValue a \/ (not (CoercedValue a))). 217 | Proof. 218 | induction 1; try destruct rho. 219 | all: try solve [split; left; auto]. 220 | all: try solve [split; right; intro h; inversion h; try inversion H; 221 | try inversion H1]. 222 | - pick fresh x. 223 | destruct (H1 x) as [[V|NV][CV|NCV]]. 224 | all: try solve [split; left; eauto using Value_AbsIrrel_exists]. 225 | + split; 226 | right; intro h; inversion h; try inversion H2; subst; 227 | apply NCV; 228 | pick fresh y; 229 | rewrite (tm_subst_tm_tm_intro y); eauto; 230 | eapply CoercedValue_tm_subst_tm_tm; eauto. 231 | - pick fresh x. 232 | destruct (H0 x) as [[V|NV]_]. 233 | all: try solve [split; left; eauto using Value_UAbsIrrel_exists]. 234 | split. 235 | all: right; intro h; inversion h; try inversion H1; subst; apply NV; 236 | pick fresh y; 237 | rewrite (tm_subst_tm_tm_intro y); eauto; 238 | eapply Value_tm_subst_tm_tm; eauto. 239 | - destruct (IHlc_tm) as [[V|NV][CV|NCV]]. 240 | all: split. 241 | all: try solve [left; eauto]. 242 | all: try solve [right; intro h; inversion h; try inversion H1; eapply NP; eauto]. 243 | all: try solve [right; intro h; inversion h; try inversion H1; done]. 244 | Qed. 245 | 246 | 247 | Lemma decide_Value : forall a, lc_tm a -> (Value a \/ not (Value a)). 248 | Proof. 249 | intros a. 250 | eapply decide_Value_mutual. 251 | Qed. 252 | 253 | Lemma decide_CoercedValue : forall a, lc_tm a -> (CoercedValue a \/ not (CoercedValue a)). 254 | Proof. 255 | intros a. 256 | eapply decide_Value_mutual. 257 | Qed. 258 | *) 259 | 260 | (* ------------------------------------------ *) 261 | (* 262 | Lemma DataTy_value_type : forall A, DataTy A a_Star -> value_type A. 263 | Proof. 264 | intros A H. 265 | dependent induction H; eauto with lc. 266 | Qed. *) 267 | -------------------------------------------------------------------------------- /src/FcEtt/ext_context_fv.v: -------------------------------------------------------------------------------- 1 | Require Export FcEtt.tactics. 2 | Require Export FcEtt.ett_inf. 3 | 4 | Require Import FcEtt.utils. 5 | Require Import FcEtt.imports. 6 | 7 | Require Import FcEtt.ett_ind. 8 | Require Import FcEtt.toplevel. 9 | 10 | Set Bullet Behavior "Strict Subproofs". 11 | Set Implicit Arguments. 12 | 13 | 14 | (* --------------------------------------------------------------------------- *) 15 | (* --------------------------------------------------------------------------- *) 16 | (* --------------------------------------------------------------------------- *) 17 | 18 | Ltac solve_binds := 19 | match goal with 20 | | [ b : binds ?v _ ?G 21 | , H : forall v' _, binds v' _ ?G -> _ [<=] dom ?G ∧ _ [<=] dom ?G 22 | |- _ ] => 23 | apply H in b; simpl in b; split_hyp; (done || fsetdec) 24 | end. 25 | 26 | 27 | (* 28 | Definition tm_context_fv_statement G a A (H: Typing G a A) := 29 | 30 | Definition PropWff_context_fv_statement G phi (H : PropWff G phi) := 31 | fv_tm_tm_constraint phi [<=] dom G. 32 | Definition Iso_context_fv_statement G D p1 p2 (H : Iso G D p1 p2) := 33 | fv_tm_tm_constraint p1 [<=] dom G /\ 34 | fv_tm_tm_constraint p2 [<=] dom G. 35 | Definition DefEq_context_fv_statement G D A B T (H : DefEq G D A B T) := 36 | fv_tm_tm_tm A [<=] dom G /\ fv_tm_tm_tm B [<=] dom G. 37 | Definition Ctx_context_fv_statement G (H : Ctx G) := 38 | forall x A, binds x (Tm A) G -> fv_tm_tm_tm A [<=] dom G. 39 | *) 40 | 41 | 42 | (* FIXME: ? *) 43 | Import AtomSetImpl. 44 | 45 | Lemma in_singleton_subset : forall x (G : context), x `in` dom G -> singleton x [<=] dom G. 46 | Proof. 47 | unfold Subset. 48 | intros. 49 | apply singleton_1 in H0. 50 | subst. 51 | done. 52 | Qed. 53 | 54 | Hint Unfold AtomSetImpl.Subset. 55 | Hint Resolve binds_In AtomSetImpl.singleton_1 in_singleton_subset. 56 | 57 | 58 | (* 59 | *) 60 | 61 | Theorem context_fv_mutual : 62 | (forall G (a : tm) A (H: Typing G a A), 63 | fv_tm_tm_tm a [<=] dom G /\ fv_co_co_tm a [<=] dom G /\ 64 | fv_tm_tm_tm A [<=] dom G /\ fv_co_co_tm A [<=] dom G) 65 | /\ 66 | (forall G phi (H : PropWff G phi), 67 | fv_tm_tm_constraint phi [<=] dom G /\ fv_co_co_constraint phi [<=] dom G) 68 | /\ 69 | (forall G D p1 p2 (H : Iso G D p1 p2), 70 | fv_tm_tm_constraint p1 [<=] dom G /\ fv_co_co_constraint p1 [<=] dom G /\ 71 | fv_tm_tm_constraint p2 [<=] dom G /\ fv_co_co_constraint p2 [<=] dom G) 72 | /\ 73 | (forall G D A B T (H : DefEq G D A B T), 74 | (fv_tm_tm_tm A [<=] dom G /\ fv_co_co_tm A [<=] dom G /\ 75 | fv_tm_tm_tm B [<=] dom G /\ fv_co_co_tm B [<=] dom G /\ 76 | fv_tm_tm_tm T [<=] dom G /\ fv_co_co_tm T [<=] dom G)) 77 | 78 | /\ 79 | (forall G (H : Ctx G), 80 | (forall x A, 81 | binds x (Tm A) G -> 82 | fv_tm_tm_tm A [<=] dom G /\ fv_co_co_tm A [<=] dom G) /\ 83 | (forall c phi, 84 | binds c (Co phi) G -> 85 | fv_tm_tm_constraint phi [<=] dom G /\ fv_co_co_constraint phi [<=] dom G)). 86 | 87 | Proof. 88 | eapply typing_wff_iso_defeq_mutual. 89 | all: autounfold. 90 | 91 | (* We can't just use `repeat split` because we don't want to split under foralls *) 92 | all: intros; repeat match goal with |- _ ∧ _ => split end; split_hyp; simpl. 93 | all: eauto 1. 94 | (* split all asummptions about unions *) 95 | 96 | (* Do the cases about the context at the end. *) 97 | all: try (intros x0 A0 BI). 98 | all: try solve [inversion BI]. 99 | all: try (match goal with |- _ ∧ _ => split end). 100 | 101 | 102 | all: try (intros y h1; inversion BI; [ 103 | match goal with 104 | [ H5 : (_,_) = (_,_) |- _ ] => 105 | inversion H5; subst; clear H5; eauto end| 106 | match goal with 107 | [ H5 : List.In (?x0, ?s ?a) ?G, 108 | H : forall x A, binds x (?s A) ?G -> _ |- _ ] => 109 | destruct (H x0 _ H5); eauto end]). 110 | 111 | (* rest of the cases *) 112 | all: intros y IN. 113 | 114 | (* more splitting, assumption has a union type *) 115 | all: try match goal with 116 | [ H7 : ?y `in` union ?A ?B |- _ ] => 117 | apply F.union_iff in H7; destruct H7; eauto end. 118 | 119 | all: try solve [ apply notin_empty_1 in IN; contradiction]. 120 | all: try solve [ assert (x = y) by auto; subst; eapply binds_In; eauto ]. 121 | all: try solve [ destruct (H _ _ b); eauto ]. 122 | 123 | all: try solve [apply H1; eauto; simpl; auto]. 124 | all: try solve [apply H2; eauto; simpl; auto]. 125 | all: try solve [apply H3; eauto; simpl; auto]. 126 | all: try solve [apply H4; eauto; simpl; auto]. 127 | 128 | 129 | all: try match goal with 130 | [ H5 : forall x : atom, (x `in` ?L -> False) -> ( _ /\ _ ) |- _ ] => 131 | pick fresh x; destruct (H5 x); eauto; split_hyp 132 | end. 133 | 134 | all: try match goal with 135 | [ H4 : ?y `in` fv_tm_tm_tm ?B, 136 | H5 : ∀ a : atom, 137 | a `in` fv_tm_tm_tm (open_tm_wrt_tm ?B (a_Var_f ?x)) 138 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 139 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 140 | (eapply H5; eauto; 141 | eapply fv_tm_tm_tm_open_tm_wrt_tm_lower; auto); 142 | simpl in h0; apply F.add_neq_iff in h0; auto 143 | end. 144 | all: try match goal with 145 | [ H4 : ?y `in` fv_co_co_tm ?B, 146 | H5 : ∀ a : atom, 147 | a `in` fv_co_co_tm (open_tm_wrt_tm ?B (a_Var_f ?x)) 148 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 149 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 150 | (eapply H5; eauto; 151 | eapply fv_co_co_tm_open_tm_wrt_tm_lower; auto); 152 | simpl in h0; apply F.add_neq_iff in h0; auto 153 | end. 154 | all: try match goal with 155 | [ H4 : ?y `in` fv_tm_tm_tm ?B, 156 | H5 : ∀ a : atom, 157 | a `in` fv_tm_tm_tm (open_tm_wrt_co ?B (g_Var_f ?x)) 158 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 159 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 160 | (eapply H5; eauto; 161 | eapply fv_tm_tm_tm_open_tm_wrt_co_lower; auto); 162 | simpl in h0; apply F.add_neq_iff in h0; auto 163 | end. 164 | all: try match goal with 165 | [ H4 : ?y `in` fv_co_co_tm ?B, 166 | H5 : ∀ a : atom, 167 | a `in` fv_co_co_tm (open_tm_wrt_co ?B (g_Var_f ?x)) 168 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 169 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 170 | (eapply H5; eauto; 171 | eapply fv_co_co_tm_open_tm_wrt_co_lower; auto); 172 | simpl in h0; apply F.add_neq_iff in h0; auto 173 | end. 174 | 175 | all: try (simpl in *; eapply fv_tm_tm_tm_open_tm_wrt_tm_upper in IN; 176 | apply F.union_iff in IN; destruct IN; eauto). 177 | all: try (simpl in *; eapply fv_co_co_tm_open_tm_wrt_tm_upper in IN; 178 | apply F.union_iff in IN; destruct IN; eauto). 179 | all: try (simpl in *; eapply fv_tm_tm_tm_open_tm_wrt_co_upper in IN; 180 | apply F.union_iff in IN; destruct IN; eauto). 181 | all: try (simpl in *; eapply fv_co_co_tm_open_tm_wrt_co_upper in IN; 182 | apply F.union_iff in IN; destruct IN; eauto). 183 | 184 | all: try (apply H0 in IN; apply notin_empty_1 in IN; contradiction). 185 | all: try (apply H1 in IN; apply notin_empty_1 in IN; contradiction). 186 | 187 | all: try match goal with 188 | [ H7 : ?y `in` union ?A ?B |- _ ] => 189 | apply F.union_iff in H7; destruct H7; eauto end. 190 | 191 | all: try (simpl in *; match goal with [ H : ?y `in` Metatheory.empty |- _ ] => apply notin_empty_1 in H; done end). 192 | 193 | all: try solve [destruct phi1; simpl in *; eauto]. 194 | 195 | all: try solve [ simpl in *; eauto]. 196 | 197 | (* all: try solve [ assert (c = y) by auto; subst; eapply binds_In; eauto ]. *) 198 | all: try solve [ destruct (H0 _ _ b0); simpl in *; eauto]. 199 | 200 | all: try match goal with 201 | [ IN : ?y `in` ?fv_tm_tm_tm ?a, 202 | H : ∀ a : atom, a `in` ?fv_tm_tm_tm ?b → a `in` dom ?G, 203 | e : ∀ x : atom, 204 | (x `in` ?L → False) → 205 | ?open_tm_wrt_tm ?a (a_Var_f x) = ?c 206 | |- _ ] => 207 | eapply H; pick fresh x; move: (e x ltac:(auto)) => h0; 208 | assert (x <> y); [ fsetdec|]; 209 | clear Fr; 210 | have h1: y `in` fv_tm_tm_tm (open_tm_wrt_tm a (a_Var_f x)); 211 | [ move: (fv_tm_tm_tm_open_tm_wrt_tm_lower a (a_Var_f x)) => ?; 212 | move: (fv_co_co_tm_open_tm_wrt_tm_lower a (a_Var_f x)) => ?; 213 | fsetdec| 214 | rewrite h0 in h1; 215 | simpl in h1; 216 | fsetdec ] 217 | end. 218 | 219 | all: try match goal with 220 | [ IN : ?y `in` ?fv_tm_tm_tm ?a, 221 | H : ∀ a : atom, a `in` ?fv_tm_tm_tm ?b → a `in` dom ?G, 222 | e : ∀ x : atom, 223 | (x `in` ?L → False) → 224 | ?open_tm_wrt_tm ?a (g_Var_f x) = ?c 225 | |- _ ] => 226 | eapply H; pick fresh x; move: (e x ltac:(auto)) => h0; 227 | clear Fr; 228 | have h1: y `in` fv_tm_tm_tm (open_tm_wrt_tm a (g_Var_f x)); 229 | [ move: (fv_tm_tm_tm_open_tm_wrt_co_lower a (g_Var_f x)) => ?; 230 | move: (fv_co_co_tm_open_tm_wrt_co_lower a (g_Var_f x)) => ?; 231 | fsetdec|]; 232 | rewrite h0 in h1; 233 | simpl in h1; 234 | fsetdec 235 | end. 236 | Qed. 237 | 238 | 239 | Definition Typing_context_fv := first context_fv_mutual. 240 | Definition ProfWff_context_fv := second context_fv_mutual. 241 | Definition Iso_context_fv := third context_fv_mutual. 242 | Definition DefEq_context_fv := fourth context_fv_mutual. 243 | 244 | 245 | 246 | (* 247 | Lemma context_fv_mutual2 : 248 | (forall G0 (b : tm) B H, @tm_context_fv_statement G0 b B H 249 | fv_tm_tm_tm a [<=] dom G /\ fv_tm_tm_tm A [<=] dom G. 250 | ) /\ 251 | (forall G0 phi H, @PropWff_context_fv_statement G0 phi H) /\ 252 | (forall G0 D p1 p2 H, @Iso_context_fv_statement G0 D p1 p2 H) /\ 253 | (forall G0 D A B T H, @DefEq_context_fv_statement G0 D A B T H) /\ 254 | (forall G H, @Ctx_context_fv_statement G H). 255 | Proof. 256 | repeat split; intros. 257 | all: try eapply (first context_fv_mutual _ _ _ H); eauto. 258 | all: try eapply (second context_fv_mutual _ _ H); eauto. 259 | all: try eapply (third context_fv_mutual _ _ _ _ H); eauto. 260 | - eapply (first (fourth context_fv_mutual _ _ _ _ _ H)); eauto. 261 | - eapply (third (fourth context_fv_mutual _ _ _ _ _ H)); eauto. 262 | - unfold Ctx_context_fv_statement. 263 | intros x A H0. 264 | eapply ((fifth context_fv_mutual _ H)); eauto. 265 | Qed. 266 | 267 | Definition typing_context_fv := @first _ _ _ _ _ context_fv_mutual2. 268 | Definition ProfWff_context_fv := @second _ _ _ _ _ context_fv_mutual2. 269 | Definition iso_context_fv := @third _ _ _ _ _ context_fv_mutual2. 270 | Definition defeq_context_fv := @fourth _ _ _ _ _ context_fv_mutual2. 271 | 272 | Definition tm_context_fv_co_statement G a A (H: Typing G a A) := 273 | fv_co_co_tm a [<=] dom G /\ fv_co_co_tm A [<=] dom G. 274 | Definition PropWff_context_fv_co_statement G phi (H : PropWff G phi) := 275 | fv_co_co_constraint phi [<=] dom G. 276 | Definition Iso_context_fv_co_statement G D p1 p2 (H : Iso G D p1 p2) := 277 | fv_co_co_constraint p1 [<=] dom G /\ 278 | fv_co_co_constraint p2 [<=] dom G. 279 | Definition DefEq_context_fv_co_statement G D A B T (H : DefEq G D A B T) := 280 | fv_co_co_tm A [<=] dom G /\ fv_co_co_tm B [<=] dom G. 281 | Definition Ctx_context_fv_co_statement G (H : Ctx G) := True. 282 | 283 | 284 | Lemma context_fv_co_mutual : 285 | (forall G0 (b : tm) B H, @tm_context_fv_co_statement G0 b B H) /\ 286 | (forall G0 phi H, @PropWff_context_fv_co_statement G0 phi H) /\ 287 | (forall G0 D p1 p2 H, @Iso_context_fv_co_statement G0 D p1 p2 H) /\ 288 | (forall G0 D A B T H, @DefEq_context_fv_co_statement G0 D A B T H) /\ 289 | (forall G H, @Ctx_context_fv_co_statement G H). 290 | Proof. 291 | repeat split; intros. 292 | all: try eapply (first context_fv_mutual _ _ _ H); eauto. 293 | all: try eapply (second context_fv_mutual _ _ H); eauto. 294 | all: try eapply (third context_fv_mutual _ _ _ _ H); eauto. 295 | - eapply (second (fourth context_fv_mutual _ _ _ _ _ H)); eauto. 296 | - eapply (fourth (fourth context_fv_mutual _ _ _ _ _ H)); eauto. 297 | Qed. 298 | 299 | Definition typing_context_fv_co := @first _ _ _ _ _ context_fv_co_mutual. 300 | Definition ProfWff_context_fv_co := @second _ _ _ _ _ context_fv_co_mutual. 301 | Definition iso_context_fv_co := @third _ _ _ _ _ context_fv_co_mutual. 302 | Definition defeq_context_fv_co := @fourth _ _ _ _ _ context_fv_co_mutual. 303 | *) 304 | -------------------------------------------------------------------------------- /src/FcEtt/ext_red_one.v: -------------------------------------------------------------------------------- 1 | 2 | Require Import FcEtt.sigs. 3 | 4 | Require Export FcEtt.imports. 5 | Require Import FcEtt.utils. 6 | Require Export FcEtt.tactics. 7 | 8 | Require Export FcEtt.ett_ott. 9 | Require Export FcEtt.ett_inf. 10 | Require Export FcEtt.ett_ind. 11 | 12 | Require Export FcEtt.ett_par. 13 | Require Export FcEtt.erase_syntax. 14 | 15 | 16 | Module ext_red_one (invert : ext_invert_sig). 17 | Import invert. 18 | 19 | Set Implicit Arguments. 20 | Set Bullet Behavior "Strict Subproofs". 21 | 22 | 23 | 24 | Lemma reduction_in_one_lc : forall a a', reduction_in_one a a' -> lc_tm a -> lc_tm a'. 25 | Proof. 26 | induction 1; intros; lc_solve. 27 | Unshelve. 28 | all: try exact nil. 29 | all: try exact {}. 30 | Qed. 31 | 32 | (* ------------------------------------------------------------ *) 33 | 34 | (* tactics for substitution proofs. *) 35 | 36 | Ltac subst_helper x x0 b0 := 37 | replace (a_Var_f x) with (tm_subst_tm_tm b0 x0 (a_Var_f x)); 38 | [idtac| rewrite tm_subst_tm_tm_var_neq; auto]; 39 | replace (g_Var_f x) with (tm_subst_tm_co b0 x0 (g_Var_f x)); 40 | [idtac| simpl; auto]; 41 | try (rewrite <- tm_subst_tm_tm_open_tm_wrt_co; eauto); 42 | try (rewrite <- tm_subst_tm_tm_open_tm_wrt_co; eauto); 43 | try (rewrite <- tm_subst_tm_tm_open_tm_wrt_tm; eauto); 44 | try (rewrite <- tm_subst_tm_tm_open_tm_wrt_tm; eauto); 45 | eauto using tm_subst_tm_tm_lc_tm. 46 | 47 | (* Most of the substitution cases below are about 48 | showing that the term is locally closed after the substiution. 49 | This tactic takes care of that argument. 50 | *) 51 | 52 | Ltac lc_subst_case x0 b0 := 53 | let x:= fresh in 54 | lc_inversion x; subst; 55 | try (rewrite tm_subst_tm_tm_open_tm_wrt_tm; eauto); 56 | try (rewrite tm_subst_tm_tm_open_tm_wrt_co; eauto); 57 | 58 | econstructor; eauto using Value_lc, 59 | tm_subst_tm_tm_lc_tm, tm_subst_tm_co_lc_co, 60 | tm_subst_tm_constraint_lc_constraint; 61 | apply_lc_exists x; 62 | eauto using tm_subst_tm_tm_lc_tm, tm_subst_tm_co_lc_co, 63 | Value_lc, tm_subst_tm_constraint_lc_constraint; 64 | subst_helper x x0 b0. 65 | 66 | (* ------------------------------------------------- *) 67 | 68 | Lemma subst_reduction_in_one : forall a a', 69 | reduction_in_one a a' -> forall b x, lc_tm b -> 70 | reduction_in_one (tm_subst_tm_tm b x a) 71 | (tm_subst_tm_tm b x a'). 72 | Proof. 73 | intros a a' R. induction R; intros b0 x0 LC; 74 | simpl; eauto using tm_subst_tm_tm_lc_tm, 75 | tm_subst_tm_co_lc_co. 76 | - eapply (E_AbsTerm (L \u {{x0}})); eauto. intros x Fr. 77 | subst_helper x x0 b0. 78 | - autorewrite with subst_open; eauto. 79 | econstructor; eauto using tm_subst_tm_tm_lc_tm. 80 | pick fresh x. 81 | eapply lc_a_UAbs_exists with (x1:=x). 82 | inversion H; subst. 83 | move: (H2 x) => h0. 84 | replace (a_Var_f x) with (tm_subst_tm_tm b0 x0 (a_Var_f x)). 85 | rewrite <- tm_subst_tm_tm_open_tm_wrt_tm; eauto. 86 | apply tm_subst_tm_tm_lc_tm; eauto. 87 | apply tm_subst_tm_tm_var_neq. fsetdec. 88 | - autorewrite with subst_open; eauto. 89 | econstructor; eauto using tm_subst_tm_tm_lc_tm. 90 | match goal with | [ H0 : Value _ |- _ ] => 91 | eapply Value_tm_subst_tm_tm in H0; eauto end. 92 | - lc_subst_case x0 b0. 93 | - rewrite tm_subst_tm_tm_fresh_eq. 94 | eapply E_Axiom; eauto. 95 | match goal with 96 | | [H : binds ?c ?phi ?G |- _ ] => 97 | move: (toplevel_closed H) => h0 98 | end. 99 | move: (Typing_context_fv h0) => ?. split_hyp. 100 | fsetdec. 101 | Qed. 102 | 103 | 104 | Lemma E_AbsTerm_exists : ∀ x (a a' : tm), 105 | x `notin` (fv_tm a \u fv_tm a') -> 106 | reduction_in_one (open_tm_wrt_tm a (a_Var_f x)) 107 | (open_tm_wrt_tm a' (a_Var_f x)) 108 | → reduction_in_one (a_UAbs Irrel a) (a_UAbs Irrel a'). 109 | Proof. 110 | intros. 111 | eapply (E_AbsTerm ({{x}})). 112 | intros. 113 | rewrite (tm_subst_tm_tm_intro x); auto. 114 | rewrite (tm_subst_tm_tm_intro x a'); auto. 115 | eapply subst_reduction_in_one; auto. 116 | Qed. 117 | 118 | 119 | (* Coerced values and values are terminal. *) 120 | Lemma no_Value_reduction : 121 | (forall a, Value a -> forall b, not (reduction_in_one a b)). 122 | Proof. 123 | intros a V; induction V. 124 | all: intros. 125 | all: intros NH; inversion NH; subst. 126 | all: try solve [eapply IHV; eauto]. 127 | 128 | all: try solve [inversion H0]. 129 | 130 | - pick fresh x. 131 | move: (H0 x ltac:(auto)) => h0. 132 | move: (H2 x ltac:(auto)) => h5. 133 | eapply h0; eauto. 134 | Qed. 135 | 136 | (* The reduction relation is deterministic *) 137 | Lemma reduction_in_one_deterministic : 138 | forall a a1, reduction_in_one a a1 -> forall a2, reduction_in_one a a2 -> a1 = a2. 139 | Proof. 140 | intros a a1 H. 141 | induction H; intros a2 h0. 142 | all: inversion h0; subst. 143 | (* already equal *) 144 | all: auto. 145 | 146 | (* follows by induction *) 147 | all: try solve [erewrite IHreduction_in_one; eauto]. 148 | 149 | (* impossible case, reduction of value *) 150 | all: try solve [(have: False by eapply no_Value_reduction; eauto); done]. 151 | 152 | all: try ((have: False by eapply (@no_Value_reduction (a_UCAbs b)); eauto); done). 153 | 154 | - pick fresh x. 155 | move: (H2 x ltac:(auto)) => h7. 156 | move: (H0 x ltac:(auto)) => h1. 157 | apply h1 in h7. 158 | apply open_tm_wrt_tm_inj in h7; eauto. rewrite h7. auto. 159 | - inversion H0. 160 | - inversion H5. 161 | - have: (Ax a A = Ax a2 A0). eapply binds_unique; eauto using uniq_toplevel. 162 | move => h; inversion h; done. 163 | Qed. 164 | 165 | 166 | End ext_red_one. 167 | -------------------------------------------------------------------------------- /src/FcEtt/ext_weak.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.sigs. 2 | 3 | Require Import FcEtt.tactics. 4 | Require Import FcEtt.utils. 5 | Require Export FcEtt.imports. 6 | Require Export FcEtt.ett_inf. 7 | Require Export FcEtt.ett_par. 8 | Require Export FcEtt.ett_ind. 9 | 10 | 11 | Module ext_weak (wf: ext_wf_sig). 12 | 13 | Include wf. 14 | 15 | Set Bullet Behavior "Strict Subproofs". 16 | Set Implicit Arguments. 17 | 18 | (* TODO: this tactic is not so "automated" (e.g. has to link a_Pi to E_Pi), 19 | but it is hard to make it more 20 | "searchy" without trying extensively all the lemmas. We could probably work something out, though *) 21 | (* 22 | Ltac E_pick_fresh x := 23 | match goal with 24 | | [ |- Typing _ ?shape _ ] => 25 | let v := match shape with 26 | | a_Pi _ _ _ => E_Pi 27 | | a_UAbs _ _ => E_Abs 28 | | a_CPi _ _ => E_CPi 29 | | a_CAbs _ _ => E_CAbs 30 | | a_UCAbs _ => E_CAbs 31 | end 32 | in pick fresh x and apply v 33 | | [ |- DefEq _ _ ?shape _ _ ] => 34 | let v := match shape with 35 | | a_Pi _ _ _ => E_PiCong 36 | | a_UAbs _ _ => E_AbsCong 37 | | a_CPi _ _ => E_CPiCong 38 | | a_CAbs _ _ => E_CAbsCong 39 | | a_UCAbs _ => E_CAbsCong 40 | end 41 | in pick fresh x and apply v 42 | | [ |- Par _ _ ?shape _ ] => 43 | let v := match shape with 44 | | a_Pi _ _ _ => Par_Pi 45 | | a_UAbs _ _ => Par_Abs 46 | | a_CPi _ _ => Par_CPi 47 | | a_CAbs _ _ => Par_CAbs 48 | | a_UCAbs _ => Par_CAbs 49 | end 50 | in pick fresh x and apply v 51 | end. 52 | *) 53 | 54 | (* ------------------------------------------------------------------- *) 55 | (* Weakening Lemmas for the available set *) 56 | 57 | (* Can replace set with an equivalent *) 58 | Lemma respects_atoms_eq_mutual : 59 | (forall G a A, Typing G a A -> True) /\ 60 | (forall G phi, PropWff G phi -> True) /\ 61 | (forall G D p1 p2, Iso G D p1 p2 -> forall D', D [=] D' -> Iso G D' p1 p2) /\ 62 | (forall G D A B T, DefEq G D A B T -> forall D', D [=] D' -> DefEq G D' A B T) /\ 63 | (forall G, Ctx G -> True). 64 | Proof. 65 | ext_induction CON; intros; subst; eauto 2. 66 | all: try solve [eapply CON; eauto 2; try fsetdec]. 67 | 68 | (* these are hard to find. *) 69 | (* 70 | eapply E_LeftRel with (b:=b)(b':=b'); eauto 2. 71 | eapply E_LeftIrrel with (b:=b)(b':=b'); eauto 2. 72 | eapply E_Right with (a:=a)(a':=a'); eauto 2. 73 | *) 74 | Qed. 75 | 76 | Definition Iso_respects_atoms_eq := third respects_atoms_eq_mutual. 77 | Definition DefEq_respects_atoms_eq := fourth respects_atoms_eq_mutual. 78 | (* 79 | Instance Iso_atoms_eq_mor : Morphisms.Proper 80 | (eq ==> AtomSetImpl.Equal ==> eq ==> eq ==> iff) 81 | Iso. 82 | Proof. 83 | simpl_relation; split=> ?; 84 | eauto using Iso_respects_atoms_eq, AtomSetProperties.equal_sym. 85 | Qed. 86 | 87 | Instance DefEq_atoms_eq_mor : Morphisms.Proper 88 | (eq ==> AtomSetImpl.Equal ==> eq ==> eq ==> eq ==> iff) 89 | DefEq. 90 | Proof. 91 | simpl_relation; split=> ?; 92 | eauto using DefEq_respects_atoms_eq, AtomSetProperties.equal_sym. 93 | Qed. 94 | 95 | *) 96 | (* ----- *) 97 | 98 | Ltac binds_cons := 99 | let H5 := fresh in 100 | match goal with 101 | [ 102 | H4 : (∃ phi : constraint, binds ?x (Co phi) ?G) → False 103 | |- ((exists phi, binds ?x (Co phi) ([(?y, ?s)] ++ ?G)) -> False) ] => 104 | intro H5; destruct H5; apply H4; simpl in H5; 105 | destruct (binds_cons_1 _ x y _ s G H5); split_hyp; subst; 106 | try done; eauto 107 | end. 108 | 109 | 110 | Lemma strengthen_available_noncovar: 111 | (forall G1 a A, Typing G1 a A -> True) /\ 112 | (forall G1 phi, PropWff G1 phi -> True) /\ 113 | (forall G1 D p1 p2, Iso G1 D p1 p2 -> forall x, not (exists phi, binds x (Co phi) G1) -> 114 | Iso G1 (remove x D) p1 p2) /\ 115 | (forall G1 D A B A1,DefEq G1 D A B A1 -> forall x, not (exists phi, binds x (Co phi) G1) -> 116 | DefEq G1 (remove x D) A B A1) /\ 117 | (forall G1 , Ctx G1 -> True). 118 | Proof. 119 | eapply typing_wff_iso_defeq_mutual; eauto 3; try done. 120 | all: intros; unfold not in *. Focus 5. destruct rho. Unfocus. 121 | all: try (E_pick_fresh y; eauto 3). 122 | all: try solve [destruct (x == c); [ subst; assert False; eauto | eauto]]. 123 | all: try (eapply H0; auto; binds_cons). 124 | all: try (eapply H; auto; binds_cons). 125 | all: try (move: H5 => /binds_cons_iff [[? [?]] | /= H5]; subst; 126 | assert (y <> y); [fsetdec|done|fsetdec|done]). 127 | all: eauto 4. 128 | - move: H2 => /binds_cons_iff [[? [?]] | /= H2]; subst; 129 | assert (y <> y); [fsetdec|done|fsetdec|done]. 130 | Qed. (* strengthen_available_nocovar *) 131 | 132 | Lemma DefEq_strengthen_available_tmvar : 133 | forall G D g A B, DefEq G D g A B -> forall x A', binds x (Tm A') G -> 134 | forall D', D' [=] remove x D -> 135 | DefEq G D' g A B. 136 | Proof. 137 | intros. eapply respects_atoms_eq_mutual. 138 | eapply (fourth strengthen_available_noncovar). eauto. 139 | unfold not. 140 | intros b. destruct b as [phi b]. 141 | assert (Tm A' = Co phi). eapply binds_unique; eauto. 142 | inversion H2. 143 | fsetdec. 144 | Qed. 145 | 146 | (* ----- *) 147 | 148 | Lemma weaken_available_mutual: 149 | (forall G1 a A, Typing G1 a A -> True) /\ 150 | (forall G1 phi, PropWff G1 phi -> True) /\ 151 | (forall G1 D p1 p2, Iso G1 D p1 p2 -> forall D', D [<=] D' -> Iso G1 D' p1 p2) /\ 152 | (forall G1 D A B T, DefEq G1 D A B T -> forall D', D [<=] D' -> DefEq G1 D' A B T) /\ 153 | (forall G1 , Ctx G1 -> True). 154 | Proof. 155 | ext_induction CON. 156 | all: try done. 157 | all: intros; try solve [eapply CON; eauto 2]. 158 | (* 159 | - eapply E_LeftRel with (b := b) (b' := b'); eauto 2. 160 | - eapply E_LeftIrrel with (b:=b) (b' := b'); eauto 2. 161 | - eapply E_Right with (a:=a)(a':=a'); eauto 2. 162 | *) 163 | Qed. 164 | 165 | Lemma remove_available_mutual: 166 | (forall G1 a A, Typing G1 a A -> True) /\ 167 | (forall G1 phi, PropWff G1 phi -> True) /\ 168 | (forall G1 D p1 p2, Iso G1 D p1 p2 -> 169 | Iso G1 (AtomSetImpl.inter D (dom G1)) p1 p2) /\ 170 | (forall G1 D A B T, DefEq G1 D A B T -> 171 | DefEq G1 (AtomSetImpl.inter D (dom G1)) A B T) /\ 172 | (forall G1 , Ctx G1 -> True). 173 | Proof. 174 | ext_induction CON. 175 | all: try done. 176 | all: eauto 2. 177 | all: intros; try solve [eapply CON; eauto 2]. 178 | (* only binding constructors left *) 179 | all: eapply (CON (L \u dom G \u D)); auto; 180 | intros; 181 | eapply (fourth respects_atoms_eq_mutual); 182 | [match goal with [H0 : forall x, x `notin` ?L -> DefEq _ (AtomSetImpl.inter _ _) _ _ _ |- _ ] => eapply H0 end; auto| 183 | auto; simpl; fsetdec]. 184 | Qed. 185 | 186 | (* 187 | Instance Iso_atoms_sub_mor : Morphisms.Proper 188 | (eq ==> AtomSetImpl.Subset ==> eq ==> eq ==> impl) 189 | Iso. 190 | Proof. 191 | simpl_relation; eapply (third weaken_available_mutual); eassumption. 192 | Qed. 193 | 194 | Instance DefEq_atoms_sub_mor : Morphisms.Proper 195 | (eq ==> AtomSetImpl.Subset ==> eq ==> eq ==> eq ==> impl) 196 | DefEq. 197 | Proof. 198 | simpl_relation; eapply (fourth weaken_available_mutual); eassumption. 199 | Qed. 200 | *) 201 | 202 | Lemma DefEq_weaken_available : 203 | forall G D A B T, DefEq G D A B T -> DefEq G (dom G) A B T. 204 | Proof. 205 | intros. 206 | remember (AtomSetImpl.inter D (dom G)) as D'. 207 | eapply (fourth weaken_available_mutual). 208 | eapply (fourth remove_available_mutual). 209 | eauto. subst. fsetdec. 210 | Qed. 211 | 212 | Lemma Iso_weaken_available : 213 | forall G D A B, Iso G D A B -> Iso G (dom G) A B. 214 | Proof. 215 | intros G D. intros. 216 | remember (AtomSetImpl.inter D (dom G)) as D'. 217 | eapply (third weaken_available_mutual). 218 | eapply (third remove_available_mutual). 219 | eauto. subst. fsetdec. 220 | Qed. 221 | 222 | Hint Resolve DefEq_weaken_available Iso_weaken_available. 223 | 224 | 225 | Lemma typing_weakening_mutual: 226 | (forall G0 a A, Typing G0 a A -> 227 | forall E F G, (G0 = F ++ G) -> Ctx (F ++ E ++ G) -> Typing (F ++ E ++ G) a A) /\ 228 | (forall G0 phi, PropWff G0 phi -> 229 | forall E F G, (G0 = F ++ G) -> Ctx (F ++ E ++ G) -> PropWff (F ++ E ++ G) phi) /\ 230 | (forall G0 D p1 p2, Iso G0 D p1 p2 -> 231 | forall E F G, (G0 = F ++ G) -> Ctx (F ++ E ++ G) -> Iso (F ++ E ++ G) D p1 p2) /\ 232 | (forall G0 D A B T, DefEq G0 D A B T -> 233 | forall E F G, (G0 = F ++ G) -> Ctx (F ++ E ++ G) -> DefEq (F ++ E ++ G) D A B T) /\ 234 | (forall G0, Ctx G0 -> 235 | forall E F G, (G0 = F ++ G) -> Ctx (F ++ E ++ G) -> Ctx (F ++ E ++ G)). 236 | Proof. 237 | ext_induction CON. 238 | all: intros; subst; try done. 239 | 240 | (* TODO: move E_LeftRel etc. first using ensure_case *) 241 | 242 | all: try solve [eapply CON; eauto 2]. 243 | all: try solve [eapply CON; eauto 2; eapply DefEq_weaken_available; eauto 2]. 244 | Focus 6. destruct rho. Unfocus. 245 | all: try solve [E_pick_fresh y; try auto_rew_env; apply_first_hyp; try simpl_env; eauto 3]. 246 | (* 247 | eapply E_LeftRel with (b:=b)(b':=b'); eauto 2; 248 | try eapply DefEq_weaken_available; eauto 2. 249 | eapply E_LeftIrrel with (b:=b)(b':=b'); eauto 2; 250 | try eapply DefEq_weaken_available; eauto 2. 251 | eapply E_Right with (a:=a)(a':=a'); eauto 2; 252 | try eapply DefEq_weaken_available; eauto 2. 253 | *) 254 | Qed. 255 | 256 | 257 | Definition Typing_weakening := first typing_weakening_mutual. 258 | Definition PropWff_weakening := second typing_weakening_mutual. 259 | Definition Iso_weakening := third typing_weakening_mutual. 260 | Definition DefEq_weakening := fourth typing_weakening_mutual. 261 | Definition Ctx_weakening := fifth typing_weakening_mutual. 262 | 263 | 264 | (* 265 | Lemma Typing_weakening : ∀ (E F G : context) (a A : tm), Typing (F ++ G) a A → Ctx (F ++ E ++ G) -> 266 | Typing (F ++ E ++ G) a A. 267 | Proof. intros. apply (first typing_weakening_mutual) with (G0 := F ++ G)(F:=F)(E:=E)(G:=G); auto. Qed. 268 | 269 | 270 | Lemma PropWff_weakening : forall (E F G : context) phi, PropWff (F ++ G) phi -> Ctx (F ++ E ++ G) → PropWff (F ++ E ++ G) phi. 271 | Proof. intros. apply (second typing_weakening_mutual) with (G0 := F ++ G)(F:=F)(E:=E)(G:=G); auto. Qed. 272 | 273 | Lemma Iso_weakening : ∀ (E F G : context) (D : available_props) (p1 p2 : constraint), 274 | Iso (F ++ G) D p1 p2 -> Ctx (F ++ E ++ G) → Iso (F ++ E ++ G) D p1 p2. 275 | Proof. intros. apply (third typing_weakening_mutual) with (G0 := F ++ G)(F:=F)(E:=E)(G:=G); auto. Qed. 276 | 277 | Lemma DefEq_weakening : ∀ (E F G : context) (D : available_props) (A B T : tm), 278 | DefEq (F ++ G) D A B T → Ctx (F ++ E ++ G) → DefEq (F ++ E ++ G) D A B T. 279 | Proof. intros. apply (fourth typing_weakening_mutual) with (G0 := F ++ G)(F:=F)(E:=E)(G:=G); auto. Qed. 280 | 281 | Lemma Ctx_weakening : ∀ (E F G: context), 282 | Ctx (F ++ G) → Ctx (F ++ E ++ G) → Ctx (F ++ E ++ G). 283 | Proof. intros. apply (fifth typing_weakening_mutual) with (G0 := F ++ G)(F:=F)(E:=E)(G:=G); auto. Qed. 284 | 285 | 286 | Lemma Iso_weakening_dom : 287 | ∀ (E F G : context) (D : available_props) (p1 p2 : constraint), 288 | Iso (F ++ G) (dom (F ++ G)) p1 p2 -> Ctx (F ++ E ++ G) → Iso (F ++ E ++ G) (dom(F ++ E ++ G)) p1 p2. 289 | Proof. 290 | intros. 291 | eapply Iso_weaken_available. 292 | eapply Iso_weakening. 293 | eassumption. 294 | auto. 295 | Qed. 296 | 297 | Lemma DefEq_weakening_dom : ∀ (E F G : context) (D : available_props) (A B T : tm), 298 | DefEq (F ++ G) (dom (F ++ G)) A B T → Ctx (F ++ E ++ G) → DefEq (F ++ E ++ G) (dom (F ++ E ++ G)) A B T. 299 | Proof. 300 | intros. 301 | eapply DefEq_weaken_available. 302 | eapply DefEq_weakening. 303 | eassumption. 304 | auto. 305 | Qed. 306 | *) 307 | 308 | 309 | End ext_weak. 310 | -------------------------------------------------------------------------------- /src/FcEtt/ext_wf.v: -------------------------------------------------------------------------------- 1 | Set Bullet Behavior "Strict Subproofs". 2 | Set Implicit Arguments. 3 | 4 | Require Import FcEtt.imports. 5 | 6 | Require Export FcEtt.ett_inf. 7 | Require Export FcEtt.ett_ind. 8 | Require Import FcEtt.tactics. 9 | 10 | Require Import FcEtt.utils. 11 | 12 | Require Import FcEtt.sigs. 13 | Require Import FcEtt.toplevel. 14 | 15 | (* This file contains these results: 16 | 17 | -- the context is well-formed in any judgement 18 | -- all components are locally closed in any judgement 19 | *) 20 | 21 | (* 22 | Lemma Path_lc : forall T a, Path T a -> lc_tm a. 23 | Proof. induction 1; eauto. Qed. 24 | 25 | Hint Resolve Path_lc : lc. 26 | 27 | 28 | Lemma DataTy_lc : forall A, DataTy A a_Star -> lc_tm A. 29 | Proof. 30 | intros. induction H; lc_solve. 31 | Qed. 32 | Hint Resolve DataTy_lc : lc. 33 | *) 34 | 35 | Lemma CoercedValue_Value_lc_mutual: (forall A, CoercedValue A -> lc_tm A) /\ 36 | (forall A, Value A -> lc_tm A). 37 | Proof. 38 | apply CoercedValue_Value_mutual; eauto. 39 | Qed. 40 | 41 | Lemma Value_lc : forall A, Value A -> lc_tm A. 42 | destruct (CoercedValue_Value_lc_mutual); auto. 43 | Qed. 44 | Lemma CoercedValue_lc : forall A, CoercedValue A -> lc_tm A. 45 | destruct (CoercedValue_Value_lc_mutual); auto. 46 | Qed. 47 | 48 | Hint Resolve Value_lc CoercedValue_lc : lc. 49 | 50 | 51 | (* -------------------------------- *) 52 | 53 | Lemma ctx_wff_mutual : 54 | (forall G0 a A, Typing G0 a A -> Ctx G0) /\ 55 | (forall G0 phi, PropWff G0 phi -> Ctx G0) /\ 56 | (forall G0 D p1 p2, Iso G0 D p1 p2 -> Ctx G0) /\ 57 | (forall G0 D A B T, DefEq G0 D A B T -> Ctx G0) /\ 58 | (forall G0, Ctx G0 -> True). 59 | Proof. 60 | eapply typing_wff_iso_defeq_mutual; auto. 61 | Qed. 62 | 63 | Definition Typing_Ctx := first ctx_wff_mutual. 64 | Definition PropWff_Ctx := second ctx_wff_mutual. 65 | Definition Iso_Ctx := third ctx_wff_mutual. 66 | Definition DefEq_Ctx := fourth ctx_wff_mutual. 67 | 68 | (* TODO: put these hints in a database? *) 69 | Hint Resolve Typing_Ctx PropWff_Ctx Iso_Ctx DefEq_Ctx. 70 | 71 | Lemma Ctx_uniq : forall G, Ctx G -> uniq G. 72 | induction G; try auto. 73 | inversion 1; subst; solve_uniq. 74 | Qed. 75 | 76 | Hint Resolve Ctx_uniq. 77 | 78 | 79 | Lemma lc_mutual : 80 | (forall G0 a A, Typing G0 a A -> lc_tm a /\ lc_tm A) /\ 81 | (forall G0 phi, PropWff G0 phi -> lc_constraint phi) /\ 82 | (forall G0 D p1 p2, Iso G0 D p1 p2 -> lc_constraint p1 /\ lc_constraint p2) /\ 83 | (forall G0 D A B T, DefEq G0 D A B T -> lc_tm A /\ lc_tm B /\ lc_tm T) /\ 84 | (forall G0, Ctx G0 -> forall x s , binds x s G0 -> lc_sort s). 85 | Proof. 86 | eapply typing_wff_iso_defeq_mutual. 87 | all: pre; basic_solve_n 2. 88 | all: split_hyp. 89 | all: lc_solve. 90 | Qed. 91 | (* This version of the proof is incredibly slow. *) 92 | (* 93 | all: pre; basic_solve. 94 | all: try oh_c'mon. 95 | all: try invert_open_wrt. 96 | all: try pick fresh c for L. 97 | all: try eapply lc_a_UCAbs_exists; eauto. 98 | all: try apply H; eauto. 99 | all: eapply (lc_a_UAbs_exists c). rewrite e. eauto. done. 100 | Qed.*) 101 | 102 | Definition Typing_lc := first lc_mutual. 103 | Definition PropWff_lc := second lc_mutual. 104 | Definition Iso_lc := third lc_mutual. 105 | Definition DefEq_lc := fourth lc_mutual. 106 | Definition Ctx_lc := fifth lc_mutual. 107 | 108 | Lemma Typing_lc1 : forall G0 a A, Typing G0 a A -> lc_tm a. 109 | Proof. 110 | intros. apply (first lc_mutual) in H. destruct H. auto. 111 | Qed. 112 | Lemma Typing_lc2 : forall G0 a A, Typing G0 a A -> lc_tm A. 113 | Proof. 114 | intros. apply (first lc_mutual) in H. destruct H. auto. 115 | Qed. 116 | 117 | Lemma Iso_lc1 : forall G0 D p1 p2, Iso G0 D p1 p2 -> lc_constraint p1. 118 | Proof. 119 | intros. apply (third lc_mutual) in H. destruct H. auto. 120 | Qed. 121 | Lemma Iso_lc2 : forall G0 D p1 p2, Iso G0 D p1 p2 -> lc_constraint p2. 122 | Proof. 123 | intros. apply (third lc_mutual) in H. destruct H. auto. 124 | Qed. 125 | Lemma DefEq_lc1 : forall G0 D A B T, DefEq G0 D A B T -> lc_tm A. 126 | Proof. 127 | intros. apply (fourth lc_mutual) in H. destruct H. auto. 128 | Qed. 129 | 130 | Lemma DefEq_lc2 : forall G0 D A B T, DefEq G0 D A B T -> lc_tm B. 131 | Proof. 132 | intros. apply (fourth lc_mutual) in H. split_hyp. auto. 133 | Qed. 134 | Lemma DefEq_lc3 : forall G0 D A B T, DefEq G0 D A B T -> lc_tm T. 135 | Proof. 136 | intros. apply (fourth lc_mutual) in H. split_hyp. auto. 137 | Qed. 138 | 139 | Hint Resolve Typing_lc1 Typing_lc2 Iso_lc1 Iso_lc2 DefEq_lc1 DefEq_lc2 DefEq_lc3 Ctx_lc : lc. 140 | 141 | Lemma Toplevel_lc : forall c s, binds c s toplevel -> lc_sig_sort s. 142 | Proof. induction Sig_toplevel. 143 | intros. inversion H. 144 | intros. destruct H2. inversion H2. subst. 145 | simpl in H0. eauto. eauto with lc. 146 | eauto. 147 | 148 | Qed. 149 | -------------------------------------------------------------------------------- /src/FcEtt/fc_context_fv.v: -------------------------------------------------------------------------------- 1 | Require Export FcEtt.tactics. 2 | Require Export FcEtt.ett_inf. 3 | 4 | Require Import FcEtt.utils. 5 | Require Import FcEtt.imports. 6 | 7 | Require Import FcEtt.ett_ind. 8 | 9 | Set Bullet Behavior "Strict Subproofs". 10 | Set Implicit Arguments. 11 | 12 | 13 | (* --------------------------------------------------------------------------- *) 14 | 15 | Hint Resolve AnnCtx_uniq. 16 | Hint Unfold AtomSetImpl.Subset. 17 | 18 | Ltac solve_binds := 19 | match goal with 20 | | [ b : binds ?v _ ?G 21 | , H : forall v' _, binds v' _ ?G -> _ [<=] dom ?G ∧ _ [<=] dom ?G 22 | |- _ ] => 23 | apply H in b; simpl in b; split_hyp; (done || fsetdec) 24 | end. 25 | 26 | Theorem ann_context_fv_mutual : 27 | (forall G (a : tm) A (H: AnnTyping G a A), 28 | fv_tm_tm_tm a [<=] dom G /\ fv_co_co_tm a [<=] dom G /\ 29 | fv_tm_tm_tm A [<=] dom G /\ fv_co_co_tm A [<=] dom G) 30 | /\ 31 | (forall G phi (H : AnnPropWff G phi), 32 | fv_tm_tm_constraint phi [<=] dom G /\ fv_co_co_constraint phi [<=] dom G) 33 | /\ 34 | (forall G D g p1 p2 (H : AnnIso G D g p1 p2), 35 | fv_tm_tm_co g [<=] dom G /\ fv_co_co_co g [<=] dom G /\ 36 | fv_tm_tm_constraint p1 [<=] dom G /\ fv_co_co_constraint p1 [<=] dom G /\ 37 | fv_tm_tm_constraint p2 [<=] dom G /\ fv_co_co_constraint p2 [<=] dom G) 38 | /\ 39 | (forall G D g A B (H : AnnDefEq G D g A B), 40 | fv_tm_tm_co g [<=] dom G /\ fv_co_co_co g [<=] dom G /\ 41 | fv_tm_tm_tm A [<=] dom G /\ fv_co_co_tm A [<=] dom G /\ 42 | fv_tm_tm_tm B [<=] dom G /\ fv_co_co_tm B [<=] dom G) 43 | /\ 44 | (forall G (H : AnnCtx G), 45 | (forall x A, 46 | binds x (Tm A) G -> 47 | fv_tm_tm_tm A [<=] dom G /\ fv_co_co_tm A [<=] dom G) /\ 48 | (forall c phi, 49 | binds c (Co phi) G -> 50 | fv_tm_tm_constraint phi [<=] dom G /\ fv_co_co_constraint phi [<=] dom G)). 51 | 52 | Proof. 53 | eapply ann_typing_wff_iso_defeq_mutual. 54 | all: autounfold. 55 | (* We can't just use `repeat split` because we don't want to split under foralls *) 56 | all: intros; repeat match goal with |- _ ∧ _ => split end; split_hyp; simpl. 57 | all: eauto 1. 58 | (* split all asummptions about unions *) 59 | 60 | (* Do the cases about the context at the end. *) 61 | all: try (intros x0 A0 BI). 62 | all: try solve [inversion BI]. 63 | all: try (match goal with |- _ ∧ _ => split end). 64 | all: try solve 65 | [intros y h1; inversion BI; [inversion H5; subst; clear H5; eauto| 66 | destruct (H x0 _ H5); eauto]]. 67 | all: try solve 68 | [intros y h1; inversion BI; [inversion H5; subst; clear H5; eauto| 69 | destruct (H4 x0 _ H5); eauto]]. 70 | all: try solve 71 | [intros y h1; inversion BI; [inversion H3; subst; clear H3; eauto| 72 | destruct (H x0 _ H3); eauto]]. 73 | all: try solve 74 | [intros y h1; inversion BI; [inversion H3; subst; clear H3; eauto| 75 | destruct (H2 x0 _ H3); eauto]]. 76 | 77 | (* rest of the cases *) 78 | all: intros y IN. 79 | 80 | (* more splitting, assumption has a union type *) 81 | all: try match goal with 82 | [ H7 : ?y `in` union ?A ?B |- _ ] => 83 | apply F.union_iff in H7; destruct H7; eauto end. 84 | 85 | all: try solve [ apply notin_empty_1 in IN; contradiction]. 86 | all: try solve [ assert (x = y) by fsetdec; subst; eapply binds_In; eauto ]. 87 | all: try solve [ destruct (H _ _ b); eauto ]. 88 | 89 | all: try solve [apply H1; eauto; simpl; auto]. 90 | all: try solve [apply H2; eauto; simpl; auto]. 91 | all: try solve [apply H3; eauto; simpl; auto]. 92 | all: try solve [apply H4; eauto; simpl; auto]. 93 | 94 | 95 | all: try match goal with 96 | [ H5 : forall x : atom, (x `in` ?L -> False) -> ( _ /\ _ ) |- _ ] => 97 | pick fresh x; destruct (H5 x); eauto; split_hyp 98 | end. 99 | 100 | all: try match goal with 101 | [ H4 : ?y `in` fv_tm_tm_tm ?B, 102 | H5 : ∀ a : atom, 103 | a `in` fv_tm_tm_tm (open_tm_wrt_tm ?B (a_Var_f ?x)) 104 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 105 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 106 | (eapply H5; auto; 107 | eapply fv_tm_tm_tm_open_tm_wrt_tm_lower; auto); 108 | simpl in h0; apply F.add_neq_iff in h0; auto 109 | end. 110 | all: try match goal with 111 | [ H4 : ?y `in` fv_co_co_tm ?B, 112 | H5 : ∀ a : atom, 113 | a `in` fv_co_co_tm (open_tm_wrt_tm ?B (a_Var_f ?x)) 114 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 115 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 116 | (eapply H5; eauto; 117 | eapply fv_co_co_tm_open_tm_wrt_tm_lower; auto); 118 | simpl in h0; apply F.add_neq_iff in h0; auto 119 | end. 120 | all: try match goal with 121 | [ H4 : ?y `in` fv_tm_tm_tm ?B, 122 | H5 : ∀ a : atom, 123 | a `in` fv_tm_tm_tm (open_tm_wrt_co ?B (g_Var_f ?x)) 124 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 125 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 126 | (eapply H5; eauto; 127 | eapply fv_tm_tm_tm_open_tm_wrt_co_lower; auto); 128 | simpl in h0; apply F.add_neq_iff in h0; auto 129 | end. 130 | all: try match goal with 131 | [ H4 : ?y `in` fv_co_co_tm ?B, 132 | H5 : ∀ a : atom, 133 | a `in` fv_co_co_tm (open_tm_wrt_co ?B (g_Var_f ?x)) 134 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 135 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 136 | (eapply H5; eauto; 137 | eapply fv_co_co_tm_open_tm_wrt_co_lower; auto); 138 | simpl in h0; apply F.add_neq_iff in h0; auto 139 | end. 140 | 141 | all: try (simpl in *; eapply fv_tm_tm_tm_open_tm_wrt_tm_upper in IN; 142 | apply F.union_iff in IN; destruct IN; eauto). 143 | all: try (simpl in *; eapply fv_co_co_tm_open_tm_wrt_tm_upper in IN; 144 | apply F.union_iff in IN; destruct IN; eauto). 145 | all: try (simpl in *; eapply fv_tm_tm_tm_open_tm_wrt_co_upper in IN; 146 | apply F.union_iff in IN; destruct IN; eauto). 147 | all: try (simpl in *; eapply fv_co_co_tm_open_tm_wrt_co_upper in IN; 148 | apply F.union_iff in IN; destruct IN; eauto). 149 | 150 | all: try (apply H0 in IN; apply notin_empty_1 in IN; contradiction). 151 | all: try (apply H1 in IN; apply notin_empty_1 in IN; contradiction). 152 | 153 | all: try match goal with 154 | [ H7 : ?y `in` union ?A ?B |- _ ] => 155 | apply F.union_iff in H7; destruct H7; eauto end. 156 | 157 | all: try solve [apply H1; eauto; simpl; auto]. 158 | all: try solve [apply H2; eauto; simpl; auto]. 159 | all: try solve [apply H3; eauto; simpl; auto]. 160 | all: try solve [apply H4; eauto; simpl; auto]. 161 | all: try solve [apply H5; eauto; simpl; auto]. 162 | 163 | all: try match goal with 164 | [IN : ?y `in` singleton ?c |- _ ] => 165 | assert (c = y) by fsetdec; subst; eapply binds_In; eauto 166 | end. 167 | all: try solve [ destruct (H0 _ _ b0); simpl in *; eauto]. 168 | 169 | all: try match goal with 170 | [ H4 : ?y `in` fv_tm_tm_co ?B, 171 | H5 : ∀ a : atom, 172 | a `in` fv_tm_tm_co (open_co_wrt_tm ?B (a_Var_f ?x)) 173 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 174 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 175 | (eapply H5; eauto; 176 | eapply fv_tm_tm_co_open_co_wrt_tm_lower; auto); 177 | simpl in h0; apply F.add_neq_iff in h0; auto 178 | end. 179 | 180 | all: try match goal with 181 | [ H4 : ?y `in` fv_co_co_co ?B, 182 | H5 : ∀ a : atom, 183 | a `in` fv_co_co_co (open_co_wrt_tm ?B (a_Var_f ?x)) 184 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 185 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 186 | (eapply H5; eauto; 187 | eapply fv_co_co_co_open_co_wrt_tm_lower; auto); 188 | simpl in h0; apply F.add_neq_iff in h0; auto 189 | end. 190 | 191 | all: try match goal with 192 | [ H4 : ?y `in` fv_tm_tm_co ?B, 193 | H5 : ∀ a : atom, 194 | a `in` fv_tm_tm_co (open_co_wrt_co ?B (g_Var_f ?x)) 195 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 196 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 197 | (eapply H5; eauto; 198 | eapply fv_tm_tm_co_open_co_wrt_co_lower; auto); 199 | simpl in h0; apply F.add_neq_iff in h0; auto 200 | end. 201 | 202 | all: try match goal with 203 | [ H4 : ?y `in` fv_co_co_co ?B, 204 | H5 : ∀ a : atom, 205 | a `in` fv_co_co_co (open_co_wrt_co ?B (g_Var_f ?x)) 206 | → a `in` dom ([(?x, ?s)] ++ ?G) |- _ ] => 207 | assert (h0: y `in` dom ([(x,s)] ++ G)) by 208 | (eapply H5; eauto; 209 | eapply fv_co_co_co_open_co_wrt_co_lower; auto); 210 | simpl in h0; apply F.add_neq_iff in h0; auto 211 | end. 212 | 213 | 214 | (* Eta cases *) 215 | 216 | all: try match goal with 217 | [ IN : ?y `in` ?fv_tm_tm_tm ?a, 218 | H : ∀ a : atom, a `in` ?fv_tm_tm_tm ?b → a `in` dom ?G, 219 | e : ∀ x : atom, 220 | (x `in` ?L → False) → 221 | ?open_tm_wrt_tm ?a (a_Var_f x) = ?c 222 | |- _ ] => 223 | eapply H; pick fresh x; move: (e x ltac:(auto)) => h0; 224 | assert (x <> y); [ fsetdec|]; 225 | clear Fr; 226 | have h1: y `in` fv_tm_tm_tm (open_tm_wrt_tm a (a_Var_f x)); 227 | [ move: (fv_tm_tm_tm_open_tm_wrt_tm_lower a (a_Var_f x)) => ?; 228 | move: (fv_co_co_tm_open_tm_wrt_tm_lower a (a_Var_f x)) => ?; 229 | fsetdec| 230 | rewrite h0 in h1; 231 | simpl in h1; 232 | fsetdec ] 233 | end. 234 | 235 | all: try match goal with 236 | [ IN : ?y `in` ?fv_tm_tm_tm ?a, 237 | H : ∀ a : atom, a `in` ?fv_tm_tm_tm ?b → a `in` dom ?G, 238 | e : ∀ x : atom, 239 | (x `in` ?L → False) → 240 | ?open_tm_wrt_tm ?a (g_Var_f x) = ?c 241 | |- _ ] => 242 | eapply H; pick fresh x; move: (e x ltac:(auto)) => h0; 243 | assert (x <> y); [ fsetdec|]; 244 | clear Fr; 245 | have h1: y `in` fv_tm_tm_tm (open_tm_wrt_tm a (g_Var_f x)); 246 | [ move: (fv_tm_tm_tm_open_tm_wrt_co_lower a (g_Var_f x)) => ?; 247 | move: (fv_co_co_tm_open_tm_wrt_co_lower a (g_Var_f x)) => ?; 248 | fsetdec|]; 249 | rewrite h0 in h1; 250 | simpl in h1; 251 | fsetdec 252 | end. 253 | 254 | 255 | (* last hard cases *) 256 | - assert (FR1 : x `notin` L) by auto. assert (FR2 : x <> y) by auto. 257 | clear Fr. clear H0. clear r. clear r0. 258 | clear H19. clear H20. clear H22. clear H24. 259 | clear H10 H12 H13 H7 H4 H9 H6. 260 | move: (e x FR1) => EX. 261 | match goal with 262 | [H18 : y `in` fv_tm_tm_tm b3 |- _ ] => 263 | erewrite fv_tm_tm_tm_open_tm_wrt_tm_lower in H18; 264 | erewrite EX in H18; 265 | erewrite fv_tm_tm_tm_open_tm_wrt_tm_upper in H18; 266 | apply F.union_iff in H18; destruct H18 as [h2 | h3] 267 | end. 268 | simpl in h2. 269 | apply F.union_iff in h2; destruct h2 as [h4 | h5]. 270 | fsetdec. 271 | eauto. 272 | 273 | assert (y `in` dom ((x ~ Tm A1) ++ G)). eapply H23. 274 | eapply fv_tm_tm_tm_open_tm_wrt_tm_lower. auto. 275 | simpl in H0; apply F.add_neq_iff in H0; auto. 276 | - assert (FR1 : x `notin` L) by auto. assert (FR2 : x <> y) by auto. 277 | clear Fr. clear H0. clear r. clear r0. 278 | move: (e x FR1) => EX. 279 | match goal with 280 | [H14 : y `in` fv_co_co_tm b3 |- _ ] => 281 | erewrite fv_co_co_tm_open_tm_wrt_tm_lower in H14; 282 | erewrite EX in H14; 283 | erewrite fv_co_co_tm_open_tm_wrt_tm_upper in H14; 284 | apply F.union_iff in H14; destruct H14 as [h2 | h3] 285 | end. 286 | simpl in h2. 287 | apply F.union_iff in h2; destruct h2 as [h4 | h5]. 288 | fsetdec. 289 | eauto. 290 | 291 | assert (y `in` dom ((x ~ Tm A1) ++ G)). eapply H24. 292 | eapply fv_co_co_tm_open_tm_wrt_tm_lower. auto. 293 | simpl in H0; apply F.add_neq_iff in H0; auto. 294 | Qed. 295 | 296 | Definition AnnTyping_context_fv := @first _ _ _ _ _ ann_context_fv_mutual. 297 | Definition AnnPropWff_context_fv := @second _ _ _ _ _ ann_context_fv_mutual. 298 | Definition AnnIso_context_fv := @third _ _ _ _ _ ann_context_fv_mutual. 299 | Definition AnnDefEq_context_fv := @fourth _ _ _ _ _ ann_context_fv_mutual. 300 | Definition AnnCtx_context_fv := @fifth _ _ _ _ _ ann_context_fv_mutual. 301 | -------------------------------------------------------------------------------- /src/FcEtt/fc_dec.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.sigs. 2 | 3 | Require Import FcEtt.fc_dec_fuel. 4 | Require Import FcEtt.fc_dec_fun. 5 | Require Import FcEtt.fc_dec_aux. 6 | 7 | Require Import FcEtt.imports. 8 | (* Require Export FcEtt.ett_inf_cs. *) 9 | Require Import FcEtt.ett_ind. 10 | Require Export FcEtt.fc_invert. 11 | 12 | Require Import Coq.Init.Specif. 13 | Require Import Coq.micromega.Lia. 14 | 15 | Module fc_dec (wf : fc_wf_sig) (weak : fc_weak_sig) (subst : fc_subst_sig) (unique: fc_unique_sig). 16 | 17 | Module invert := fc_invert wf weak subst. 18 | Module fuel := fc_dec_fuel wf weak subst unique. 19 | Module tc_fun := fc_dec_fun wf weak subst unique. 20 | Module aux := fc_dec_aux wf weak subst unique. 21 | 22 | Import tc_fun fuel aux unique wf subst invert. 23 | 24 | 25 | 26 | Definition fuel_at n : Type := 27 | (∀ a, size_tm a <= n -> fuel_tpg a) * 28 | (∀ phi, size_constraint phi <= n -> fuel_pwf phi) * 29 | (∀ gamma, size_co gamma <= n -> fuel_iso gamma) * 30 | (∀ gamma, size_co gamma <= n -> fuel_deq gamma). 31 | 32 | 33 | 34 | 35 | 36 | Ltac wfind := 37 | match goal with 38 | | [ Hind: ∀ z : nat, z < ?x → fuel_at z |- fuel_tpg ?a ] => eapply (Hind (size_tm a)) 39 | | [ Hind: ∀ z : nat, z < ?x → fuel_at z |- fuel_deq ?g ] => eapply (Hind (size_co g)) 40 | | [ Hind: ∀ z : nat, z < ?x → fuel_at z |- fuel_iso ?g ] => eapply (Hind (size_co g)) 41 | | [ Hind: ∀ z : nat, z < ?x → fuel_at z |- fuel_pwf ?g ] => eapply (Hind (size_constraint g)) 42 | end. 43 | 44 | 45 | 46 | Lemma fuel_all : ∀ n, fuel_at n. 47 | Proof. 48 | intro n. eapply (well_founded_induction_type lt_wf). clear n. intros. 49 | repeat split. 50 | + intros a sz. 51 | destruct a; auto; unfold size_tm in sz; fold size_tm in sz; fold size_co in sz; fold size_constraint in sz. 52 | 53 | all: try econstructor; intros. 54 | all: try wfind. 55 | all: try rewrite size_tm_open_tm_wrt_tm_var; try rewrite size_tm_open_tm_wrt_co_var. 56 | all: try lia. 57 | 58 | + intros phi sz. 59 | destruct phi; auto; unfold size_constraint in sz; fold size_tm in sz; fold size_co in sz; fold size_constraint in sz. 60 | econstructor; intros. 61 | all: wfind. 62 | all: try lia. 63 | 64 | + intros g sz. 65 | destruct g; auto; unfold size_co in sz; unfold size_tm in sz; fold size_tm in sz; fold size_co in sz; fold size_constraint in sz. 66 | (* 67 | Focus 5. 68 | apply FD_Left. 69 | *) 70 | 71 | all: try econstructor; intros. 72 | all: try wfind. 73 | all: try rewrite size_tm_open_tm_wrt_tm_var; try rewrite size_tm_open_tm_wrt_co_var. 74 | all: try lia. 75 | 76 | 77 | 78 | + intros g sz. 79 | destruct g; auto; unfold size_co in sz; unfold size_tm in sz; fold size_tm in sz; fold size_co in sz; fold size_constraint in sz. 80 | all: econstructor; intros. 81 | all: try wfind. 82 | all: try 83 | solve [ lia 84 | | rewrite size_co_open_co_wrt_co_var; lia 85 | | rewrite size_tm_open_tm_wrt_co_var; lia 86 | | rewrite size_co_open_co_wrt_tm_var; lia 87 | | rewrite size_tm_open_tm_wrt_tm_var; lia]. 88 | Qed. 89 | 90 | 91 | Definition gaspump : ∀ t : tm, fuel_tpg t. 92 | Proof. 93 | move => t. 94 | move: (fuel_all (size_tm t)) => f. 95 | do 3 move: f => [f _]. 96 | apply f. 97 | done. 98 | Qed. 99 | 100 | (* TODO: as added bonus, make the function that generates context fuel and write the general function (the one accepting an arbitrary context) *) 101 | Definition FC_typechecker : ∀ t : tm, {T : tm | AnnTyping nil t T } + {(forall T, ¬ AnnTyping nil t T)} := 102 | fun t => AnnTyping_dec nil t (gaspump t) An_Empty. 103 | 104 | Theorem FC_typechecking_decidable : ∀ t : tm, (exists T : tm, AnnTyping nil t T) \/ (∀ T, ¬ AnnTyping nil t T). 105 | Proof. 106 | intros t. 107 | case: (FC_typechecker t). 108 | - intros [T p]. left. exists T. exact p. 109 | - intros n. right. intros T. apply n. 110 | Qed. 111 | 112 | End fc_dec. 113 | -------------------------------------------------------------------------------- /src/FcEtt/fc_dec_fuel.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.sigs. 2 | 3 | Require Import FcEtt.imports. 4 | 5 | Require Import FcEtt.ett_ind. 6 | 7 | Set Bullet Behavior "Strict Subproofs". 8 | 9 | Module fc_dec_fuel (wf : fc_wf_sig) (weak : fc_weak_sig) (subst : fc_subst_sig) (unique: fc_unique_sig). 10 | 11 | Inductive fuel_tpg : tm -> Type := 12 | | FT_Star : 13 | fuel_tpg a_Star 14 | | FT_Var_f : ∀ (x:tmvar), 15 | fuel_tpg (a_Var_f x) 16 | | FT_Pi : ∀ (rho:relflag) (A B:tm), 17 | (∀ x , x \notin (fv_tm_tm_tm B) -> 18 | fuel_tpg (open_tm_wrt_tm B (a_Var_f x))) -> 19 | fuel_tpg A -> 20 | fuel_tpg (a_Pi rho A B) 21 | | FT_Abs : ∀ (rho:relflag) (a A:tm), 22 | (∀ x , x \notin (fv_tm_tm_tm a) -> 23 | fuel_tpg (open_tm_wrt_tm a (a_Var_f x))) -> 24 | fuel_tpg A -> 25 | fuel_tpg (a_Abs rho A a) 26 | | FT_App : ∀ (rho:relflag) (b a:tm), 27 | fuel_tpg b -> 28 | fuel_tpg a -> 29 | fuel_tpg (a_App b rho a) 30 | | FT_Conv : ∀ (a:tm) g, 31 | fuel_tpg a -> 32 | fuel_deq g -> 33 | fuel_tpg (a_Conv a g) 34 | | FT_CPi : ∀ (phi:constraint) (B:tm), 35 | (∀ c, c \notin (fv_co_co_tm B) -> fuel_tpg (open_tm_wrt_co B (g_Var_f c))) -> 36 | fuel_pwf phi -> 37 | fuel_tpg (a_CPi phi B) 38 | | FT_CAbs : ∀ (a:tm) (phi:constraint), 39 | (∀ c, c \notin (fv_co_co_constraint phi \u fv_co_co_tm a) -> fuel_tpg (open_tm_wrt_co a (g_Var_f c))) -> 40 | fuel_pwf phi -> 41 | fuel_tpg (a_CAbs phi a) 42 | | FT_CApp : ∀ (b:tm) g, 43 | fuel_tpg b -> 44 | fuel_deq g -> 45 | fuel_tpg (a_CApp b g) 46 | | FT_Const : ∀ (T:atom), 47 | fuel_tpg (a_Const T) 48 | | FT_Fam : forall (F:tyfam), 49 | fuel_tpg (a_Fam F) 50 | 51 | (* No typing rule for these cases --- they immediately fail. *) 52 | | FT_Var_b : forall n0, 53 | fuel_tpg (a_Var_b n0) 54 | | FT_UAbs : forall rho a, 55 | fuel_tpg (a_UAbs rho a) 56 | | FT_UCAbs : forall a, 57 | fuel_tpg (a_UCAbs a) 58 | | FT_DataCon : forall K, 59 | fuel_tpg (a_DataCon K) 60 | | FT_Case : forall a brs5, 61 | fuel_tpg (a_Case a brs5) 62 | | FT_Bullet : 63 | fuel_tpg a_Bullet 64 | 65 | with fuel_pwf : constraint -> Type := 66 | | FP_fuel_pwf : ∀ a b A, 67 | fuel_tpg a -> 68 | fuel_tpg b -> 69 | fuel_pwf (Eq a b A) 70 | 71 | 72 | with fuel_iso : co -> Type := 73 | | FI_Cong : ∀ (g1:co) (A:tm) (g2:co), 74 | fuel_deq g1 -> 75 | fuel_deq g2 -> 76 | fuel_iso (g_EqCong g1 A g2) 77 | | FI_CPiFst : ∀ (g:co), 78 | fuel_deq g -> 79 | fuel_iso (g_CPiFst g) 80 | | FI_IsoSym : ∀ (g:co), 81 | fuel_iso g -> 82 | fuel_iso (g_Sym g) 83 | | FI_IsoConv : ∀ (g:co) phi1 phi2, 84 | fuel_deq g -> 85 | fuel_pwf phi1 -> 86 | fuel_pwf phi2 -> 87 | fuel_iso (g_IsoConv phi1 phi2 g) 88 | 89 | 90 | (* Trivial cases *) 91 | | FI_Triv : 92 | fuel_iso g_Triv 93 | | FI_Var_b : forall n0, 94 | fuel_iso (g_Var_b n0) 95 | | FI_Var_f : ∀ (c:covar), 96 | fuel_iso (g_Var_f c) 97 | | FI_Refl : ∀ (a:tm), 98 | fuel_iso (g_Refl a) 99 | | FI_Refl2 : ∀ (a b:tm) (g:co), 100 | fuel_iso (g_Refl2 a b g) 101 | | FI_Trans : ∀ (g1 g2: co), 102 | fuel_iso (g_Trans g1 g2) 103 | | FI_Beta : ∀ (a1 a2:tm), 104 | fuel_iso (g_Beta a1 a2) 105 | | FI_PiCong : ∀ (rho:relflag) (g1 g2:co), 106 | fuel_iso (g_PiCong rho g1 g2) 107 | | FI_AbsCong : ∀ (rho:relflag) (g1 g2:co), 108 | fuel_iso ((g_AbsCong rho g1 g2)) 109 | | FI_AppCong : ∀ (g1:co) (g2:co) (rho:relflag), 110 | fuel_iso (g_AppCong g1 rho g2) 111 | | FI_PiFst : ∀ (g:co), 112 | fuel_iso (g_PiFst g) 113 | | FI_PiSnd : ∀ (g1 g2:co), 114 | fuel_iso (g_PiSnd g1 g2) 115 | | FI_CPiCong : ∀ (g1 g3:co), 116 | fuel_iso ((g_CPiCong g1 g3)) 117 | | FI_CAbsCong : ∀ (g1 g3 g4:co), 118 | fuel_iso ((g_CAbsCong g1 g3 g4)) 119 | | FI_CAppCong : ∀ (g1 g2 g3:co), 120 | fuel_iso (g_CAppCong g1 g2 g3) 121 | | FI_CPiSnd : ∀ (g1 g2 g3:co), 122 | fuel_iso (g_CPiSnd g1 g2 g3) 123 | | FI_Cast : ∀ (g1 g2:co), 124 | fuel_iso (g_Cast g1 g2) 125 | | FI_IsoSnd : ∀ (g:co), 126 | fuel_iso (g_IsoSnd g) 127 | 128 | | FI_Eta : forall a, 129 | fuel_iso (g_Eta a) 130 | 131 | 132 | | FI_Left : forall g1 g2, 133 | fuel_iso (g_Left g1 g2) 134 | | FI_Right : forall g1 g2, 135 | fuel_iso (g_Right g1 g2) 136 | 137 | 138 | with fuel_deq : co -> Type := 139 | | FD_Assn : ∀ (c:covar), 140 | fuel_deq (g_Var_f c) 141 | | FD_Refl : ∀ (a:tm), 142 | fuel_tpg a -> 143 | fuel_deq (g_Refl a) 144 | | FD_Refl2 : ∀ (a b:tm) (g:co), 145 | fuel_tpg a -> 146 | fuel_tpg b -> 147 | fuel_deq g -> 148 | fuel_deq (g_Refl2 a b g) 149 | | FD_Sym : ∀ (g:co), 150 | fuel_deq g -> 151 | fuel_deq (g_Sym g) 152 | | FD_Trans : ∀ (g1 g2: co), 153 | fuel_deq g1 -> 154 | fuel_deq g2 -> 155 | fuel_deq (g_Trans g1 g2) 156 | | FD_Beta : ∀ (a1 a2:tm), 157 | fuel_tpg a1 -> 158 | fuel_tpg a2 -> 159 | fuel_deq (g_Beta a1 a2) 160 | 161 | | FD_PiCong : ∀ (rho:relflag) (g1 g2:co), 162 | fuel_deq g1 -> 163 | (∀ x, x \notin (fv_tm_tm_co g1 \u fv_tm_tm_co g2) -> 164 | fuel_deq (open_co_wrt_tm g2 (a_Var_f x))) -> 165 | fuel_deq (g_PiCong rho g1 g2) 166 | | FD_AbsCong : ∀ (rho:relflag) (g1 g2:co), 167 | fuel_deq g1 -> 168 | (∀ x, 169 | x \notin (fv_tm_tm_co g1 \u fv_tm_tm_co g2) -> 170 | fuel_deq (open_co_wrt_tm g2 (a_Var_f x))) -> 171 | fuel_deq ((g_AbsCong rho g1 g2)) 172 | | FD_AppCong : ∀ (g1:co) (g2:co) (rho:relflag), 173 | fuel_deq g1 -> 174 | fuel_deq g2 -> 175 | fuel_deq (g_AppCong g1 rho g2) 176 | | FD_PiFst : ∀ (g:co), 177 | fuel_deq g -> 178 | fuel_deq (g_PiFst g) 179 | | FD_PiSnd : ∀ (g1 g2:co), 180 | fuel_deq g1 -> 181 | fuel_deq g2 -> 182 | fuel_deq (g_PiSnd g1 g2) 183 | | FD_CPiCong : ∀ (g1 g3:co), 184 | fuel_iso g1 -> 185 | (∀ c, 186 | c \notin (fv_co_co_co g1 \u fv_co_co_co g3) -> 187 | fuel_deq (open_co_wrt_co g3 (g_Var_f c))) -> 188 | fuel_deq ((g_CPiCong g1 g3)) 189 | | FD_CAbsCong : ∀ (g1 g3 g4:co), 190 | fuel_iso g1 -> 191 | (∀ c, 192 | c \notin (fv_co_co_co g1 \u fv_co_co_co g3) -> 193 | fuel_deq (open_co_wrt_co g3 (g_Var_f c))) -> 194 | fuel_deq g4 -> 195 | fuel_deq ((g_CAbsCong g1 g3 g4)) 196 | | FD_CAppCong : ∀ (g1 g2 g3:co), 197 | fuel_deq g1 -> 198 | fuel_deq g2 -> 199 | fuel_deq g3 -> 200 | fuel_deq (g_CAppCong g1 g2 g3) 201 | | FD_CPiSnd : ∀ (g1 g2 g3:co), 202 | fuel_deq g1 -> 203 | fuel_deq g2 -> 204 | fuel_deq g3 -> 205 | fuel_deq (g_CPiSnd g1 g2 g3) 206 | | FD_Cast : ∀ (g1 g2:co), 207 | fuel_deq g1 -> 208 | fuel_iso g2 -> 209 | fuel_deq (g_Cast g1 g2) 210 | | FD_IsoSnd : ∀ (g:co), 211 | fuel_iso g -> 212 | fuel_deq (g_IsoSnd g) 213 | 214 | | FD_Triv : 215 | fuel_deq g_Triv 216 | | FD_Var_b : forall n0, 217 | fuel_deq (g_Var_b n0) 218 | | FD_CPiFst : ∀ (g:co), 219 | fuel_deq (g_CPiFst g) 220 | | FD_Cong : ∀ (g1:co) (A:tm) (g2:co), 221 | fuel_deq (g_EqCong g1 A g2) 222 | | FD_IsoConv : ∀ (g:co) phi1 phi2, 223 | fuel_deq (g_IsoConv phi1 phi2 g) 224 | 225 | | FD_Eta : forall a, 226 | fuel_tpg a -> 227 | fuel_deq (g_Eta a) 228 | 229 | | FD_Left : forall g1 g2, 230 | fuel_deq g1 -> 231 | fuel_deq g2 -> 232 | fuel_deq (g_Left g1 g2) 233 | 234 | | FD_Right : forall g1 g2, 235 | fuel_deq g1 -> 236 | fuel_deq g2 -> 237 | fuel_deq (g_Right g1 g2) 238 | 239 | . 240 | 241 | Hint Constructors fuel_deq fuel_iso fuel_pwf fuel_tpg. 242 | 243 | Scheme 244 | ind_fuel_tpg := Induction for fuel_tpg Sort Prop 245 | with ind_fuel_pwf := Induction for fuel_pwf Sort Prop 246 | with ind_fuel_iso := Induction for fuel_iso Sort Prop 247 | with ind_fuel_deq := Induction for fuel_deq Sort Prop. 248 | 249 | Combined Scheme fuel_mutind from ind_fuel_tpg, ind_fuel_pwf, ind_fuel_iso, ind_fuel_deq. 250 | 251 | End fc_dec_fuel. 252 | -------------------------------------------------------------------------------- /src/FcEtt/fc_head_reduction.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.sigs. 2 | Require Import FcEtt.fc_wf. 3 | 4 | Module fc_head_reduction (e_invert : ext_invert_sig) 5 | (wk: fc_weak_sig) (wf : fc_wf_sig) (sub : fc_subst_sig). 6 | 7 | Import e_invert. 8 | Import wk. 9 | Import sub. 10 | 11 | Require Export FcEtt.imports. 12 | Require Import FcEtt.utils. 13 | Require Export FcEtt.tactics. 14 | 15 | Require Export FcEtt.ett_ott. 16 | Require Export FcEtt.ett_inf. 17 | Require Export FcEtt.ett_ind. 18 | 19 | Require Export FcEtt.ett_par. 20 | Require Export FcEtt.erase_syntax. 21 | 22 | Require Import FcEtt.ext_red_one. 23 | Module red1 := ext_red_one e_invert. 24 | Import red1. 25 | 26 | Set Implicit Arguments. 27 | Set Bullet Behavior "Strict Subproofs". 28 | 29 | 30 | Lemma weaken_head_reduction : forall G0 a a', 31 | head_reduction G0 a a' -> 32 | forall E F G, (G0 = F ++ G) -> AnnCtx (F ++ E ++ G) -> head_reduction (F ++ E ++ G) a a'. 33 | Proof. 34 | intros G a a' H. 35 | induction H; pre; subst; eauto 4. 36 | 37 | 38 | all: try (pick fresh x and apply An_AbsTerm; 39 | [eapply AnnTyping_weakening; eauto| 40 | rewrite_env (([(x, Tm A)] ++ F) ++ E ++ G0); eauto; 41 | eapply H1; eauto; 42 | simpl_env; eauto using AnnTyping_weakening]). 43 | all: try solve [econstructor; eauto; 44 | eapply AnnDefEq_weaken_available; eauto; 45 | eapply (AnnDefEq_weakening H0 E F G0); eauto]. 46 | Qed. 47 | 48 | 49 | 50 | Lemma subst_head_reduction : forall G a a', 51 | head_reduction G a a' -> forall G1 G2 A b x, 52 | G = G1 ++ [(x, Tm A)] ++ G2 53 | -> AnnTyping G2 b A 54 | -> head_reduction (map (tm_subst_tm_sort b x) G1 ++ G2) 55 | (tm_subst_tm_tm b x a) 56 | (tm_subst_tm_tm b x a'). 57 | Proof. 58 | intros G a a' R. 59 | induction R; 60 | intros G1 G2 A0 b0 x0 EQ Ty; 61 | simpl; subst; eauto using tm_subst_tm_tm_lc_tm, AnnTyping_lc1, AnnTyping_lc2, 62 | tm_subst_tm_co_lc_co. 63 | - have h0: lc_tm b0 by apply AnnTyping_lc1 in Ty. 64 | rewrite tm_subst_tm_tm_open_tm_wrt_tm; auto. 65 | apply An_AppAbs; simpl; try apply tm_subst_tm_tm_lc_tm; auto. 66 | eapply Value_tm_subst_tm_tm in H0; simpl in H0; eauto. 67 | - have h0: lc_tm b0 by apply AnnTyping_lc1 in Ty. 68 | rewrite tm_subst_tm_tm_open_tm_wrt_co; auto. 69 | apply An_CAppCAbs; simpl. 70 | destruct phi. 71 | apply tm_subst_tm_constraint_lc_constraint; auto. 72 | have h1 := tm_subst_tm_tm_lc_tm _ _ x0 H0 h0; auto. 73 | apply tm_subst_tm_co_lc_co; auto. 74 | - eapply An_AbsTerm with (L := singleton x0 \u L); eauto. 75 | + have h0 := first ann_tm_substitution_mutual _ _ _ H; auto. 76 | simpl in h0. 77 | eapply h0; eauto. 78 | + simpl in H1. 79 | intros x H2. 80 | have h1 : lc_tm b0 by apply AnnTyping_lc1 in Ty. 81 | have h0 := H1 x ltac:(auto) ((x, Tm A) :: G1) G2 A0 b0 x0 ltac:(auto) Ty. 82 | repeat rewrite tm_subst_tm_tm_open_tm_wrt_tm_rec in h0; auto. 83 | simpl. 84 | simpl in h0. 85 | destruct eq_dec; auto. 86 | fsetdec. 87 | - eapply An_Axiom; eauto. 88 | erewrite tm_subst_fresh_2; eauto. 89 | eapply an_toplevel_closed; eauto. 90 | - have h1 : lc_tm b0 by apply AnnTyping_lc1 in Ty. 91 | apply An_Combine; auto. 92 | all: try apply tm_subst_tm_co_lc_co; auto. 93 | apply Value_tm_subst_tm_tm; auto. 94 | - have h1 : lc_tm b0 by apply AnnTyping_lc1 in Ty. 95 | eapply An_Push; eauto. 96 | eapply Value_tm_subst_tm_tm; eauto. 97 | eapply (fourth ann_tm_substitution_mutual) in H0; eauto 2. 98 | simpl in H0. 99 | eapply AnnDefEq_weaken_available; eauto. 100 | - have h1 : lc_tm b0 by apply AnnTyping_lc1 in Ty. 101 | eapply An_CPush; eauto. 102 | eapply Value_tm_subst_tm_tm; eauto. 103 | eapply (fourth ann_tm_substitution_mutual) in H0; eauto 2. 104 | simpl in H0. 105 | eapply AnnDefEq_weaken_available; eauto. 106 | Qed. 107 | 108 | 109 | (* A useful tactic *) 110 | Ltac resolve_open a := 111 | let s := fresh in 112 | match goal with 113 | [ x1 : ?b = open_tm_wrt_tm a (a_Var_f ?x) |- _ ] => 114 | destruct a; inversion x1; 115 | [unfold open_tm_wrt_tm in x1; 116 | simpl in x1; 117 | match goal with [ n:nat |- _ ] => 118 | destruct (lt_eq_lt_dec n 0) as [s | [| s]]; 119 | try destruct s; inversion x1 120 | end | subst; unfold open_tm_wrt_tm in x1; 121 | unfold open_tm_wrt_tm; simpl in *; inversion x1; clear x1] 122 | end. 123 | 124 | 125 | Lemma An_AbsTerm_exists : ∀ G x A (a a' : tm), 126 | x `notin` (fv_tm a \u fv_tm a' \u dom G) -> 127 | AnnTyping G A a_Star -> 128 | head_reduction ([(x, Tm A)] ++ G) (open_tm_wrt_tm a (a_Var_f x)) 129 | (open_tm_wrt_tm a' (a_Var_f x)) 130 | → head_reduction G (a_Abs Irrel A a) (a_Abs Irrel A a'). 131 | Proof. 132 | intros. 133 | pick fresh x0 and apply An_AbsTerm. 134 | auto. 135 | have AC: (AnnCtx ([(x,Tm A)] ++ G)) by eauto with ctx_wff. 136 | intros. 137 | rewrite (tm_subst_tm_tm_intro x); auto. 138 | rewrite (tm_subst_tm_tm_intro x a'); auto. 139 | move: weaken_head_reduction => h. 140 | eapply h with (F:= [(x,Tm A)])(E := [(x0,Tm A)])(G:=G) in H1. 141 | eapply subst_head_reduction with 142 | (G := nil ++ [(x, Tm A)] ++ ([(x0,Tm A)] ++ G))(b := (a_Var_f x0)) (x:=x) in H1; eauto. 143 | simpl_env in H1. auto. 144 | econstructor; eauto with ctx_wff. 145 | auto. 146 | econstructor; eauto with ctx_wff. 147 | eapply AnnTyping_weakening with (F:=nil); eauto 4. 148 | simpl. 149 | econstructor; 150 | eauto with ctx_wff. 151 | Qed. 152 | 153 | 154 | 155 | End fc_head_reduction. 156 | -------------------------------------------------------------------------------- /src/FcEtt/fc_preservation.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.sigs. 2 | 3 | 4 | Require Import FcEtt.imports. 5 | Require Import FcEtt.tactics. 6 | 7 | Require Import FcEtt.ett_ott. 8 | Require Import FcEtt.ett_inf. 9 | Require Import FcEtt.ett_inf_cs. 10 | Require Import FcEtt.ett_ind. 11 | 12 | 13 | Require Import FcEtt.ett_par. 14 | Require Import FcEtt.ext_invert. 15 | Require Import FcEtt.ext_red. 16 | Require Import FcEtt.ext_red_one. 17 | Require Import FcEtt.erase_syntax. 18 | 19 | Require Import FcEtt.fc_invert FcEtt.fc_unique. 20 | 21 | Module fc_preservation (wf : fc_wf_sig) (weak : fc_weak_sig) (subst : fc_subst_sig) 22 | (e_subst : ext_subst_sig). 23 | 24 | Import subst weak wf. 25 | 26 | Module e_invert := ext_invert e_subst. 27 | Import e_invert. 28 | 29 | Module red := ext_red e_invert. 30 | Import red. 31 | 32 | Module red_one := ext_red_one e_invert. 33 | Import red_one. 34 | 35 | Module invert := fc_invert wf weak subst. 36 | Module unique := fc_unique wf subst. 37 | Import invert unique. 38 | 39 | 40 | Set Bullet Behavior "Strict Subproofs". 41 | Set Implicit Arguments. 42 | 43 | 44 | (* This version is just for "head reduction." 45 | *) 46 | 47 | Lemma open_a_Conv : forall a b g, 48 | open_tm_wrt_tm (a_Conv a g) b = 49 | a_Conv (open_tm_wrt_tm a b) (open_co_wrt_tm g b). 50 | intros. 51 | unfold open_tm_wrt_tm. simpl. auto. 52 | Qed. 53 | 54 | Lemma open_a_Conv_co : forall a b g, 55 | open_tm_wrt_co (a_Conv a g) b = 56 | a_Conv (open_tm_wrt_co a b) (open_co_wrt_co g b). 57 | intros. 58 | unfold open_tm_wrt_co. simpl. auto. 59 | Qed. 60 | 61 | (* Helper tactic for below. Solves lc_tm goals using hypotheses from 62 | the annotated language. Perhaps it is useful elsewhere? *) 63 | Ltac lc_erase_hyp := 64 | match goal with 65 | | H : AnnTyping ?G ?a ?A0 |- lc_tm (erase_tm ?a) => eapply lc_erase; apply (AnnTyping_lc H) 66 | | H : AnnTyping ?G ?a ?A0 |- lc_tm ?a => apply (AnnTyping_lc1 H) 67 | | H : lc_tm ?a |- lc_tm (erase ?a) => eapply lc_erase; eauto 68 | | H : lc_tm (a_Abs ?r ?a ?b) |- lc_tm ?c => apply lc_erase in H; simpl in H; auto 69 | | H : lc_tm (a_CAbs ?a ?b) |- lc_tm ?c => apply lc_erase in H; simpl in H; auto 70 | end. 71 | 72 | 73 | Lemma binds_toplevel: forall F a A, 74 | binds F (Ax a A) an_toplevel -> 75 | binds F (Ax (erase a) (erase A)) toplevel. 76 | Proof. 77 | intros. 78 | unfold toplevel. unfold erase_sig. 79 | eapply binds_map with (f:= erase_csort) in H. 80 | auto. 81 | Qed. 82 | 83 | 84 | Ltac do_rho := 85 | match goal with 86 | H : ∀ x : atom, x `notin` ?L → RhoCheck Irrel x (erase_tm (open_tm_wrt_tm ?b (a_Var_f x))) |- 87 | ?x `notin` fv_tm_tm_tm (open_tm_wrt_tm (erase ?b) (a_Var_f ?x)) => 88 | let h := fresh in 89 | let F := fresh in 90 | assert (F : x `notin` L); auto; 91 | move: (H x F) => h; inversion h; subst; 92 | replace (a_Var_f x) with (erase (a_Var_f x)); auto; 93 | rewrite open_tm_erase_tm; auto 94 | end. 95 | 96 | (* A specialized version of eauto that only uses the most common 97 | lc lemmas to cut down the search space. *) 98 | Ltac eauto_lc := simpl; eauto using AnnTyping_lc1, Value_lc, 99 | AnnDefEq_lc3, AnnPropWff_lc. 100 | 101 | 102 | (* We need to know that the term type checks. But if it does, our annotated 103 | operational semantics corresponds with reduction_in_one. *) 104 | Lemma head_reduction_in_one : forall G a b, 105 | head_reduction G a b -> forall A, AnnTyping G a A -> 106 | reduction_in_one (erase a) (erase b) \/ erase a = erase b. 107 | Proof. 108 | move: lc_erase => [lc_er_tm _] G a b H. 109 | induction H; intros AA TT ; inversion TT; try (simpl; eauto). 110 | - destruct rho. 111 | destruct (IHhead_reduction _ H6); subst; simpl. 112 | left. eauto. simpl in H8. rewrite H8. eauto. 113 | destruct (IHhead_reduction _ H6); subst; simpl. 114 | left. eauto. simpl in H8. rewrite H8. eauto. 115 | - subst. destruct rho; left; simpl_erase. 116 | ++ eapply E_AppAbs; eauto using lc_er_tm. 117 | eapply Value_lc in H0. lc_erase_hyp. 118 | ++ inversion H6; clear H6; subst. 119 | pose EB := erase w. 120 | pick fresh x. 121 | rewrite (tm_subst_tm_tm_intro x); auto using fv_tm_erase_tm. 122 | rewrite tm_subst_tm_tm_fresh_eq. 123 | rewrite -(tm_subst_tm_tm_fresh_eq (open_tm_wrt_tm (erase w) (a_Var_f x)) a_Bullet x). 124 | rewrite -tm_subst_tm_tm_intro; eauto. 125 | econstructor. auto. 126 | eapply Value_erase in H0. auto. 127 | do_rho. 128 | do_rho. 129 | - subst. 130 | destruct (IHhead_reduction _ H4); simpl. 131 | eauto. 132 | simpl in H1. rewrite H1. 133 | eauto. 134 | - subst. left. autorewcs. 135 | erewrite <- open_co_erase_tm2. 136 | econstructor. apply lc_er_tm in H0. eauto. 137 | - subst. 138 | pick fresh x. 139 | edestruct (H1 x); eauto. 140 | left. apply E_AbsTerm_exists with (x:=x). 141 | eauto using fv_tm_erase_tm. 142 | rewrite <- open_tm_erase_tm in H2. 143 | rewrite <- open_tm_erase_tm in H2. 144 | simpl in H2. eauto. 145 | right. f_equal. 146 | move: (H9 x ltac:(auto)) => h0. inversion h0. subst. 147 | rewrite <- open_tm_erase_tm in H2. 148 | rewrite <- open_tm_erase_tm in H2. 149 | simpl in H2. 150 | apply open_tm_wrt_tm_inj in H2. 151 | auto. 152 | eauto using fv_tm_erase_tm. 153 | eauto using fv_tm_erase_tm. 154 | - left. 155 | assert (Ax a A = Ax a0 AA). 156 | { eapply binds_unique; eauto. apply uniq_an_toplevel. } inversion H6. subst. 157 | apply binds_toplevel in H. 158 | eauto. 159 | - subst. destruct rho. 160 | simpl. eauto. 161 | simpl. eauto. 162 | Qed. 163 | 164 | 165 | (* We need to know that the term type checks. But if it does, our annotated 166 | operational semantics corresponds with parallel reduction. *) 167 | 168 | Lemma head_reduction_erased : forall G a b, head_reduction G a b -> 169 | forall A, AnnTyping G a A -> Par G (dom G) (erase a) (erase b). 170 | Proof. 171 | intros G a b H. 172 | induction H; intros AA TT ; inversion TT; try (simpl; econstructor; eauto). 173 | + destruct rho; simpl. econstructor; eauto. econstructor. 174 | eapply lc_erase. eapply AnnTyping_lc with (A := A). eauto. 175 | econstructor; eauto. 176 | + destruct rho; simpl_erase. 177 | econstructor. 178 | econstructor. apply Value_lc in H0. lc_erase_hyp. 179 | econstructor. apply Value_lc in H0. lc_erase_hyp. 180 | match goal with 181 | H : AnnTyping ?G (a_Abs Irrel ?A ?b) (a_Pi Irrel ?A0 ?B) |- _ => inversion H; clear H end. subst. 182 | pose EB := (erase w). 183 | pick fresh x. 184 | rewrite (tm_subst_tm_tm_intro x); auto using fv_tm_erase_tm. 185 | rewrite tm_subst_tm_tm_fresh_eq. 186 | rewrite -(tm_subst_tm_tm_fresh_eq (open_tm_wrt_tm (erase w) (a_Var_f x)) a_Bullet x). 187 | rewrite -tm_subst_tm_tm_intro; eauto. 188 | econstructor. econstructor. apply Value_lc in H0. 189 | match goal with H : lc_tm (a_Abs Irrel ?A0 ?b) |- 190 | lc_tm (a_UAbs Irrel (erase ?b)) => eapply lc_erase in H; simpl in H; auto end. 191 | do_rho. 192 | do_rho. 193 | + subst. simpl. 194 | autorewcs. rewrite -(open_co_erase_tm2 _ _ g_Triv). 195 | econstructor. econstructor. lc_erase_hyp. 196 | + intros. 197 | assert (x `notin` L \u L0). eapply H10. 198 | replace (a_Var_f x) with (erase (a_Var_f x)); auto. 199 | rewrite open_tm_erase_tm. 200 | rewrite open_tm_erase_tm. 201 | eapply context_Par_irrelevance; eauto. 202 | + unfold toplevel. unfold erase_sig. 203 | apply binds_map with (f := erase_csort) in H. 204 | simpl in H. 205 | eauto. 206 | + simpl. eauto. 207 | + match goal with 208 | H : AnnTyping ?G (a_Conv ?v ?g1) ?A |- lc_tm (erase_tm ?v) => 209 | inversion H end. 210 | lc_erase_hyp. 211 | + destruct rho; subst; simpl; eauto using lc_erase. 212 | econstructor. eapply AnnTyping_lc1 in TT. eapply lc_tm_erase in TT. eauto. 213 | econstructor. eapply AnnTyping_lc1 in TT. eapply lc_tm_erase in TT. eauto. 214 | + eapply AnnTyping_lc1 in TT. eapply lc_tm_erase in TT. eauto. 215 | Qed. 216 | 217 | Lemma preservation : forall G a A, AnnTyping G a A -> forall a', head_reduction G a a' -> AnnTyping G a' A. 218 | Proof. 219 | intros G a A H. induction H. 220 | - intros. inversion H0. 221 | - intros. inversion H1. 222 | - intros. inversion H2; subst. 223 | - intros. inversion H3. subst. 224 | pick fresh x and apply An_Abs; eauto 3. 225 | have RC: RhoCheck Irrel x (erase_tm (open_tm_wrt_tm a (a_Var_f x))); eauto. 226 | inversion RC. subst. 227 | have HR: head_reduction ([(x, Tm A)] ++ G) (open_tm_wrt_tm a (a_Var_f x)) 228 | (open_tm_wrt_tm b' (a_Var_f x)); eauto. 229 | have Ta: AnnTyping ([(x, Tm A)] ++ G) (open_tm_wrt_tm b' (a_Var_f x)) 230 | (open_tm_wrt_tm B (a_Var_f x)); eauto. 231 | constructor. 232 | eapply Par_fv_preservation; eauto. 233 | eapply head_reduction_erased; eauto. 234 | - (* application case *) 235 | intros. inversion H1; subst. 236 | + eauto. 237 | + inversion H. subst. 238 | pick fresh x. 239 | rewrite (tm_subst_tm_tm_intro x); auto. 240 | rewrite (tm_subst_tm_tm_intro x B); auto. 241 | eapply AnnTyping_tm_subst; eauto. 242 | + (* Push case *) 243 | inversion H. subst. resolve_unique_subst. 244 | move: (AnnDefEq_regularity H7) => [C1 [C2 [g' hyps]]]. split_hyp. 245 | invert_syntactic_equality. 246 | inversion H2. inversion H6. subst. 247 | eapply An_Conv; eauto. 248 | eapply An_PiSnd; eauto. 249 | eapply An_EraseEq; eauto. 250 | eapply AnnTyping_tm_subst_nondep; eauto. 251 | - intros. inversion H2; subst. 252 | + eauto. 253 | + inversion H. subst. 254 | econstructor; eauto 2. 255 | eapply An_Trans with (a1 := A); eauto 2 using AnnTyping_regularity. 256 | eapply An_Refl; eauto with ctx_wff. 257 | - intros. inversion H2. 258 | - intros. inversion H2. 259 | - intros. inversion H1; subst. 260 | + eauto. 261 | + inversion H; subst. 262 | pick fresh c. 263 | rewrite (co_subst_co_tm_intro c); auto. 264 | rewrite (co_subst_co_tm_intro c B); auto. 265 | eapply AnnTyping_co_subst; eauto. 266 | + (* CPush case *) 267 | inversion H. subst. resolve_unique_subst. 268 | move: (AnnDefEq_regularity H5) => [C1 [C2 [g' hyps]]]. split_hyp. 269 | invert_syntactic_equality. 270 | inversion H2. inversion H7. subst. destruct phi1. 271 | eapply An_Conv; eauto. 272 | eapply AnnTyping_co_subst_nondep; eauto. 273 | (* - move=> a' hr. 274 | inversion hr. *) 275 | - move=> a' hr. 276 | inversion hr. subst. 277 | 278 | assert (Ax a A = Ax a' A0). 279 | { eapply binds_unique; eauto. apply uniq_an_toplevel. } 280 | inversion H2. subst. clear H2. clear H0. 281 | apply an_toplevel_closed in H4. 282 | eapply AnnTyping_weakening with (F:=nil)(G:=nil)(E:=G) in H4; eauto. 283 | simpl in H4. 284 | rewrite app_nil_r in H4. 285 | auto. 286 | rewrite app_nil_r. simpl. auto. 287 | Qed. (* preservation *) 288 | 289 | 290 | 291 | 292 | End fc_preservation. 293 | -------------------------------------------------------------------------------- /src/FcEtt/fc_unique.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.sigs. 2 | 3 | Require Export FcEtt.ett_inf_cs. 4 | Require Export FcEtt.ett_ind. 5 | Require Import FcEtt.imports. 6 | Require Import FcEtt.tactics. 7 | 8 | Require Import FcEtt.ett_par. 9 | 10 | 11 | Module fc_unique (wf : fc_wf_sig) (subst : fc_subst_sig) <: fc_unique_sig. 12 | Import wf subst. 13 | 14 | Set Bullet Behavior "Strict Subproofs". 15 | Set Implicit Arguments. 16 | 17 | (* The typing relation for FC produces unique types. *) 18 | 19 | Hint Resolve AnnCtx_uniq. 20 | Hint Rewrite tm_subst_tm_tm_var co_subst_co_co_var. 21 | 22 | (* Automatically apply the IH of typing_unique on the specified tm/coercion *) 23 | Ltac apply_ind a := 24 | match goal with 25 | | H : (forall A2 : tm, AnnTyping ?G a A2 -> ?B = A2), Y : AnnTyping ?G a ?C |- _ => 26 | apply H in Y; inversion Y 27 | | H : forall A B, AnnDefEq ?G ?D a A B -> ?A1 = A /\ ?B1 = B, Y : AnnDefEq ?G ?D a ?A2 ?B2 |- _ => 28 | apply H in Y; split_hyp; subst 29 | | H : ∀ q1 q2 : constraint, AnnIso ?G ?D a q1 q2 → ?phi1 = q1 ∧ ?phi2 = q2, 30 | Y : AnnIso ?G ?D a ?q1 ?q2 |- _ => 31 | apply H in Y; split_hyp; subst 32 | 33 | end. 34 | 35 | (* Apply induction in the case where we need a "fresh" variable. *) 36 | Ltac apply_ind_var c a := 37 | match goal with 38 | | H7 : ∀ c : atom, 39 | ¬ c `in` ?L0 40 | → AnnTyping ?G (open_tm_wrt_co a (g_Var_f c)) ?B, 41 | H0 : ∀ c : atom, 42 | ¬ c `in` ?L 43 | → ∀ A2 : tm, 44 | AnnTyping ?G (open_tm_wrt_co a (g_Var_f c)) A2 → ?C = A2 |- _ => 45 | specialize H7 with c; apply H0 in H7; eauto 46 | | H8 : ∀ x : atom, 47 | ¬ x `in` ?L0 48 | → AnnDefEq ?G ?D (open_co_wrt_tm a (a_Var_f x)) ?B0 ?B5, 49 | H0 : ∀ x : atom, 50 | ¬ x `in` ?L 51 | → ∀ a1 b1 : tm, 52 | AnnDefEq ?G ?D (open_co_wrt_tm a (a_Var_f x)) a1 b1 53 | → ?B1 = a1 ∧ ?B2 = b1 |- _ => 54 | specialize H8 with c; edestruct (H0 c); eauto 55 | end. 56 | 57 | (* For working with PiCong and AbsCong. Look for hypothses that introduce new 58 | equations about the bodies of the terms. (Should be used after induction 59 | hypothesis. *) 60 | Ltac equate_bodies x := 61 | match goal with 62 | H11 : ∀ x : atom, 63 | ¬ x `in` ?L0 → open_tm_wrt_tm ?B4 (a_Var_f x) = open_tm_wrt_tm ?B2 ?C, 64 | e : ∀ x : atom, ¬ x `in` ?L → open_tm_wrt_tm ?B3 (a_Var_f x) = 65 | open_tm_wrt_tm ?B2 ?C 66 | |- _ => 67 | let FR := fresh in 68 | let FR2 := fresh in 69 | specialize H11 with x; 70 | assert (FR: ¬ x `in` L0); eauto; apply H11 in FR; 71 | specialize e with x; 72 | assert (FR2 : ¬ x `in` L); eauto; apply e in FR2; 73 | rewrite -FR in FR2; 74 | apply open_tm_wrt_tm_inj in FR2; try fsetdec_fast 75 | end. 76 | 77 | (* Find matching assumptions about binds, produce an equality EQ between their sorts. *) 78 | Ltac resolve_binds_unique := 79 | let EQ := fresh in 80 | let h := fresh in 81 | match goal with 82 | | b : binds ?c ?A ?G, H4 : binds ?c ?B ?G |- _ => 83 | assert (EQ : uniq G); eauto using AnnCtx_uniq,uniq_an_toplevel; 84 | move: (binds_unique _ _ _ _ _ b H4 EQ) => h; inversion h 85 | end. 86 | 87 | 88 | Lemma unique_mutual : 89 | (forall G a A1, AnnTyping G a A1 -> forall {A2}, AnnTyping G a A2 -> A1 = A2) /\ 90 | (forall G phi, AnnPropWff G phi -> True) /\ 91 | (forall G D g p1 p2, AnnIso G D g p1 p2 -> forall {q1 q2}, AnnIso G D g q1 q2 -> p1 = q1 /\ p2 = q2) /\ 92 | (forall G D g a b, AnnDefEq G D g a b -> forall {a1 b1}, AnnDefEq G D g a1 b1 -> a = a1 /\ b = b1) /\ 93 | (forall G, AnnCtx G -> True). 94 | Proof. 95 | apply ann_typing_wff_iso_defeq_mutual. 96 | all: intros. all: try inversion H1; subst; try solve [try inversion H0; subst; basic_solve'; subst]. 97 | - autotype. 98 | - autotype. f_equal. 99 | pick fresh x. 100 | eapply open_tm_wrt_tm_inj with (x1 := x); auto. 101 | - apply_ind b. done. 102 | - autotype. 103 | apply_ind a. firstorder. 104 | - f_equal. 105 | pick fresh c. 106 | apply_ind_var c a. 107 | eapply open_tm_wrt_co_inj; autotype. 108 | - apply_ind a1. done. 109 | - move: (binds_unique _ _ _ _ _ b H4 uniq_an_toplevel) => E. inversion E. auto. 110 | (* - have E: (Ax a A = Ax a2 A2). eapply binds_unique; eauto using uniq_an_toplevel. 111 | inversion E. auto. *) 112 | - autotype; apply_ind g1; apply_ind g2; autotype. 113 | - autotype; apply_ind g; autotype. 114 | - ann_invert_clear. apply_ind g. auto. 115 | - repeat ann_invert_clear. apply_ind g. auto. 116 | - ann_invert_clear. 117 | resolve_binds_unique. auto. 118 | - ann_invert_clear. auto. 119 | - ann_invert_clear. 120 | edestruct H2; eauto. 121 | - ann_invert_clear. 122 | apply_ind g1. apply_ind g2. apply_ind g2. auto. 123 | - inversion H4. clear a0. 124 | apply_ind g1. 125 | pick fresh x. 126 | apply_ind_var x g2. 127 | apply open_tm_wrt_tm_inj in H5. 128 | apply open_tm_wrt_tm_inj in H6. 129 | subst. 130 | equate_bodies x. 131 | all: fsetdec_fast. 132 | 133 | - (* abs_cong *) (* FIXME: could be prettier *) 134 | inversion H4. 135 | apply_ind g1. 136 | pick fresh x. 137 | have xL : x `notin` L by fsetdec. 138 | have xL0 : x `notin` L0 by clear xL; fsetdec. 139 | move: (H0 x xL _ _ (H9 x xL0)) => [eq1 eq2]. 140 | apply open_tm_wrt_tm_inj in eq1. 141 | apply open_tm_wrt_tm_inj in eq2. 142 | split; first by congruence. 143 | suff: b3 = b5 by move=> ->. 144 | apply: open_tm_wrt_tm_inj. 145 | Focus 3. 146 | erewrite (H10 x xL0). 147 | erewrite (e x xL). 148 | congruence. 149 | all: try fsetdec_fast. 150 | - repeat ann_invert_clear. 151 | apply_ind g1. 152 | apply_ind g2. 153 | auto. 154 | - repeat ann_invert_clear. 155 | apply_ind g. 156 | split; congruence. 157 | - repeat ann_invert_clear. 158 | (* apply_ind seems to have a problem on this one *) 159 | move: (H0 _ _ H7) => [-> ->]. 160 | move: (H _ _ H6) => [? ?]. 161 | split; congruence. 162 | - (* ipi_cong *) 163 | match goal with 164 | [ H3 : AnnDefEq ?G ?D (g_CPiCong ?g1 ?g3) ?a3 ?b1 |- _ ] => inversion H3 165 | end. 166 | match goal with 167 | [ H : ∀ q1 q2 : constraint, AnnIso ?G ?D ?g1 q1 q2 → ?phi1 = q1 ∧ ?phi2 = q2, 168 | H7 : AnnIso ?G ?D ?g1 phi0 phi3 |- _ ] => 169 | move: (H _ _ H7) => [h0 h1]; subst 170 | end. 171 | pick fresh x. 172 | match goal with 173 | [ H8 : ∀ c : atom, ¬ c `in` ?L0 → open_tm_wrt_co B4 (g_Var_f c) = 174 | open_tm_wrt_co B5 (g_Cast (g_Var_f c) (g_Sym ?g1)) |- _ ] => 175 | move: (H8 x ltac:(auto)) => h0; clear H8 176 | end. 177 | match goal with 178 | [ H0 : ∀ c : atom, ¬ c `in` ?L → ∀ a1 b1 : tm, 179 | AnnDefEq ([(c, Co ?phi0)] ++ ?G) ?D (open_co_wrt_co ?g3 (g_Var_f c)) a1 b1 180 | → open_tm_wrt_co B1 (g_Var_f c) = ?a1 ∧ open_tm_wrt_co B2 (g_Var_f c) = ?b1, 181 | H7 : ∀ c : atom, 182 | ¬ c `in` ?L0 183 | → AnnDefEq ([(c, Co ?phi0)] ++ ?G) ?D (open_co_wrt_co ?g3 (g_Var_f c)) (open_tm_wrt_co B0 (g_Var_f c)) 184 | (open_tm_wrt_co B5 (g_Var_f c)) |- _ ] => 185 | move: (H0 x ltac:(auto) _ _ (H7 x ltac:(auto))) => [h1 h2]; clear H7 186 | end. 187 | move: (e x ltac:(auto)) => h3. clear e. 188 | split; f_equal. 189 | apply open_tm_wrt_co_inj with (c1 := x); auto. 190 | apply open_tm_wrt_co_inj with (c1 := x); auto. 191 | rewrite h0. 192 | rewrite h3. 193 | f_equal. 194 | apply open_tm_wrt_co_inj with (c1 := x); auto. 195 | - (* cabs_cong *) 196 | inversion H5. subst. 197 | pick fresh x. 198 | assert (FrL0: x `notin` L0). auto. 199 | assert (FrL: x `notin` L). auto. 200 | move: (H11 x FrL0) => h0. clear H11. 201 | edestruct H. eauto. subst. 202 | move: (H0 x FrL _ _ (H10 x FrL0)) => [h1 h2]. 203 | split; f_equal; auto. 204 | eapply open_tm_wrt_co_inj with (c1 := x); auto. 205 | eapply open_tm_wrt_co_inj with (c1 := x); auto. 206 | rewrite h0. 207 | move: (e x FrL) => h3. 208 | rewrite h3. 209 | f_equal. 210 | apply open_tm_wrt_co_inj with (c1 := x); auto. 211 | - inversion H5. subst. 212 | edestruct H... 213 | autotype. 214 | autotype. 215 | - inversion H2. subst. 216 | apply H in H8. destruct H8 as [h0 h1]. 217 | inversion h0. inversion h1... 218 | autotype. 219 | - apply H0 in H9. 220 | split_hyp. invert_syntactic_equality. 221 | auto. 222 | - inversion H0. subst. apply H in H4. 223 | split_hyp. invert_syntactic_equality. auto. 224 | - ann_invert_clear. 225 | + apply_ind b1. subst. 226 | pick fresh x. 227 | move: (H5 x ltac:(auto)) => h0. 228 | rewrite -e in h0; auto. 229 | apply open_tm_wrt_tm_inj in h0; auto. 230 | subst. auto. 231 | + apply_ind b1. 232 | - ann_invert_clear. 233 | + apply_ind b1. 234 | + apply_ind b1. subst. 235 | pick fresh x. 236 | move: (H5 x ltac:(auto)) => h0. 237 | rewrite -e in h0; auto. 238 | apply open_tm_wrt_co_inj in h0; auto. 239 | subst. auto. 240 | (* Left/Right 241 | - ann_invert_clear. 242 | apply_ind g1. invert_syntactic_equality. auto. 243 | apply_ind g1. done. 244 | - ann_invert_clear. 245 | apply_ind g1. invert_syntactic_equality. auto. 246 | - repeat ann_invert_clear; 247 | apply_ind g1; 248 | apply_ind g2. 249 | done. 250 | invert_syntactic_equality. auto. 251 | *) 252 | Qed. 253 | 254 | 255 | Definition AnnTyping_unique := first unique_mutual. 256 | Definition AnnDefEq_unique := fourth unique_mutual. 257 | Definition AnnIso_unique := third unique_mutual. 258 | 259 | 260 | (* These two tactics look for terms in the context that 261 | are typed with two different types and automatically applies 262 | the uniqueness lemma. 263 | 264 | The first tactic uses subst to resolve the equalities. The second 265 | tries to only eliminate equations between variables. 266 | 267 | *) 268 | 269 | 270 | Ltac resolve_unique_subst := 271 | match goal with 272 | | _ : AnnTyping ?G ?a ?A, H :AnnTyping ?G ?a ?B |- _ => 273 | assert (A = B); try (eapply (first unique_mutual); eauto 1); subst; clear H 274 | | H1 : AnnDefEq ?G ?D ?g ?A1 ?B1, H2 :AnnDefEq ?G ?D ?g ?A2 ?B2 |- _ => 275 | destruct (fourth unique_mutual _ _ _ _ _ H1 _ _ H2); subst; clear H2 276 | end. 277 | 278 | Ltac resolve_unique_nosubst := 279 | match goal with 280 | | H1 : AnnTyping ?G ?a ?A, H2 :AnnTyping ?G ?a ?B |- _ => 281 | assert (A = B); [ eapply (first unique_mutual); 282 | [eapply H1 | eapply H2]|]; subst B; clear H2 283 | | H1 : AnnDefEq ?G ?D ?g ?A1 ?B1, H2 :AnnDefEq ?G ?D ?g ?A2 ?B2 |- _ => 284 | destruct (fourth unique_mutual _ _ _ _ _ H1 _ _ H2); 285 | try subst A2; try subst B2; try subst A1; try subst B1; 286 | clear H2 287 | end. 288 | 289 | (* Coerced values and values are terminal. *) 290 | Lemma no_reduction_mutual : 291 | (forall a, CoercedValue a -> forall G b, not (head_reduction G a b)) /\ 292 | (forall a, Value a -> forall G b, not (head_reduction G a b)). 293 | Proof. 294 | apply CoercedValue_Value_mutual; simpl. 295 | all: intros. 296 | all: intros NH; inversion NH; subst. 297 | all: try solve [eapply H; eauto]. 298 | all: try solve [inversion v]. 299 | all: try solve [inversion p]. 300 | 301 | - pick fresh x. 302 | move: (H x ltac:(auto)) => h0. 303 | move: (H5 x ltac:(auto)) => h5. 304 | eapply h0; eauto. 305 | Qed. 306 | Lemma no_Value_reduction : forall a, Value a -> forall G b, not (head_reduction G a b). 307 | Proof. eapply no_reduction_mutual. Qed. 308 | Lemma no_CoercedValue_reduction : forall a, CoercedValue a -> forall G b, not (head_reduction G a b). 309 | Proof. eapply no_reduction_mutual. Qed. 310 | 311 | (* The reduction relation is deterministic *) 312 | Lemma head_reduction_deterministic : 313 | forall G a a1, head_reduction G a a1 -> forall a2, head_reduction G a a2 -> a1 = a2. 314 | Proof. 315 | intros G a a1 H. 316 | induction H; intros a2 h0. 317 | all: inversion h0; subst. 318 | (* already equal *) 319 | all: auto. 320 | (* follows by induction *) 321 | all: try solve [erewrite IHhead_reduction; eauto]. 322 | 323 | (* impossible case, reduction of value *) 324 | all: try solve [(have: False by eapply no_Value_reduction; eauto); done]. 325 | 326 | (* impossible case, reduction of coerced value *) 327 | all: try match goal with 328 | [ H4 : Value ?a0, H0: head_reduction _ (a_Conv ?a0 ?g) ?a' |- _ ] => 329 | (have CV: CoercedValue (a_Conv a0 g) by eauto using AnnDefEq_lc3); 330 | (have: False by eapply no_CoercedValue_reduction; eauto); done 331 | end. 332 | 333 | all: try ((have: False by eapply (@no_Value_reduction (a_CAbs phi b)); eauto); done). 334 | 335 | - pick fresh x. 336 | move: (H7 x ltac:(auto)) => h7. 337 | move: (H1 x ltac:(auto)) => h1. 338 | apply h1 in h7. 339 | apply open_tm_wrt_tm_inj in h7; eauto. rewrite h7. auto. 340 | - resolve_binds_unique. auto. 341 | Qed. 342 | 343 | End fc_unique. 344 | -------------------------------------------------------------------------------- /src/FcEtt/fc_weak.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.sigs. 2 | Require Export FcEtt.imports. 3 | Require Export FcEtt.ett_inf. 4 | Require Export FcEtt.ett_ind. 5 | 6 | Require Import FcEtt.tactics. 7 | Require Import FcEtt.ett_par. 8 | 9 | Require Import FcEtt.erase_syntax. 10 | 11 | Require Export FcEtt.fc_wf. 12 | 13 | (* can remove this parameter *) 14 | Module fc_weak (wf : fc_wf_sig) <: fc_weak_sig. 15 | 16 | 17 | Set Bullet Behavior "Strict Subproofs". 18 | Set Implicit Arguments. 19 | 20 | (* Weakening *) 21 | 22 | (* ------------------------------------------------------------------- *) 23 | 24 | 25 | Lemma ann_respects_atoms_eq_mutual : 26 | (forall G a A, AnnTyping G a A -> True) /\ 27 | (forall G phi, AnnPropWff G phi -> True) /\ 28 | (forall G D g p1 p2, AnnIso G D g p1 p2 -> forall D', D [=] D' -> AnnIso G D' g p1 p2) /\ 29 | (forall G D g A B, AnnDefEq G D g A B -> forall D', D [=] D' -> AnnDefEq G D' g A B) /\ 30 | (forall G, AnnCtx G -> True). 31 | Proof. 32 | eapply ann_typing_wff_iso_defeq_mutual. 33 | all: pre; subst; eauto 3. 34 | all: econstructor; eauto. 35 | fsetdec. 36 | Qed. 37 | 38 | Definition AnnIso_respects_atoms_eq := third ann_respects_atoms_eq_mutual. 39 | Definition AnnDefEq_respects_atoms_eq := fourth ann_respects_atoms_eq_mutual. 40 | 41 | Instance AnnIso_atoms_eq_mor : Morphisms.Proper 42 | (eq ==> AtomSetImpl.Equal ==> eq ==> eq ==> eq ==> iff) 43 | AnnIso. 44 | Proof. 45 | simpl_relation; split=> ?; 46 | eauto using AnnIso_respects_atoms_eq, AtomSetProperties.equal_sym. 47 | Qed. 48 | 49 | Instance AnnDefEq_atoms_eq_mor : Morphisms.Proper 50 | (eq ==> AtomSetImpl.Equal ==> eq ==> eq ==> eq ==> iff) 51 | AnnDefEq. 52 | Proof. 53 | simpl_relation; split=> ?; 54 | eauto using AnnDefEq_respects_atoms_eq, AtomSetProperties.equal_sym. 55 | Qed. 56 | 57 | 58 | Lemma ann_strengthen_noncovar: 59 | (forall G1 a A, AnnTyping G1 a A -> True) /\ 60 | (forall G1 phi, AnnPropWff G1 phi -> True) /\ 61 | (forall G1 D g p1 p2, AnnIso G1 D g p1 p2 -> forall x, not (exists phi, binds x (Co phi) G1) -> 62 | AnnIso G1 (remove x D) g p1 p2) /\ 63 | (forall G1 D g A B, AnnDefEq G1 D g A B -> forall x, not (exists phi, binds x (Co phi) G1) -> 64 | AnnDefEq G1 (remove x D) g A B) /\ 65 | (forall G1 , AnnCtx G1 -> True). 66 | Proof. 67 | apply ann_typing_wff_iso_defeq_mutual; eauto 3; try done. 68 | - econstructor; eauto. 69 | - intros. destruct (x == c). 70 | + subst. assert False. apply H0. eexists. eauto. done. 71 | + eapply An_Assn; eauto. 72 | - econstructor; eauto. 73 | - intros. 74 | eapply (An_PiCong (L \u singleton x \u dom G)); eauto. 75 | intros. eapply H0; auto. 76 | unfold not in *. intros. destruct H6. apply H4. 77 | simpl in H6. 78 | destruct (binds_cons_1 _ x x0 _ (Tm A1) G H6). destruct H7. inversion H8. 79 | exists x1. auto. 80 | - intros. 81 | eapply (An_AbsCong (L \u singleton x)); eauto. 82 | intros. eapply H0; auto. 83 | unfold not in *. intros. destruct H6. apply H4. 84 | simpl in H6. 85 | destruct (binds_cons_1 _ x x0 _ (Tm A1) G H6). destruct H7. inversion H8. 86 | exists x1. auto. 87 | - eauto. 88 | - eauto. 89 | - intros. 90 | eapply (An_CPiCong (L \u singleton x)); eauto. 91 | intros. 92 | eapply H0; auto. 93 | unfold not in *. intros. destruct H6. apply H4. 94 | simpl in H6. 95 | destruct (binds_cons_1 _ x c _ (Co phi1) G H6). destruct H7. 96 | subst. fsetdec. 97 | exists x0. auto. 98 | - intros. 99 | eapply (An_CAbsCong (L \u singleton x)); eauto. 100 | move=> c Fr. 101 | eapply H0; first fsetdec. 102 | move=> [phi b]. 103 | move: b => /binds_cons_iff [[? [?]] | /= b]; first (subst; fsetdec). 104 | by apply H5; exists phi. 105 | - eauto. 106 | Qed. (* strengthen_nocovar *) 107 | 108 | Lemma AnnDefEq_strengthen_available_tm : 109 | forall G D g A B, AnnDefEq G D g A B -> forall x A', binds x (Tm A') G -> 110 | forall D', D' [=] remove x D -> 111 | AnnDefEq G D' g A B. 112 | Proof. 113 | intros. eapply ann_respects_atoms_eq_mutual. 114 | eapply (fourth ann_strengthen_noncovar). eauto. 115 | unfold not. 116 | intros b. destruct b as [phi b]. 117 | assert (Tm A' = Co phi). eapply binds_unique; eauto with ctx_wff. 118 | inversion H2. 119 | fsetdec. 120 | Qed. 121 | 122 | Lemma ann_weaken_available_mutual: 123 | (forall G1 a A, AnnTyping G1 a A -> True) /\ 124 | (forall G1 phi, AnnPropWff G1 phi -> True) /\ 125 | (forall G1 D g p1 p2, AnnIso G1 D g p1 p2 -> forall D', D [<=] D' -> AnnIso G1 D' g p1 p2) /\ 126 | (forall G1 D g A B, AnnDefEq G1 D g A B -> forall D', D [<=] D' -> AnnDefEq G1 D' g A B) /\ 127 | (forall G1 , AnnCtx G1 -> True). 128 | Proof. 129 | apply ann_typing_wff_iso_defeq_mutual; eauto 3; try done. 130 | all: econstructor; eauto. 131 | Qed. 132 | 133 | Lemma ann_remove_available_mutual: 134 | (forall G1 a A, AnnTyping G1 a A -> True) /\ 135 | (forall G1 phi, AnnPropWff G1 phi -> True) /\ 136 | (forall G1 D g p1 p2, AnnIso G1 D g p1 p2 -> 137 | AnnIso G1 (AtomSetImpl.inter D (dom G1)) g p1 p2) /\ 138 | (forall G1 D g A B, AnnDefEq G1 D g A B -> 139 | AnnDefEq G1 (AtomSetImpl.inter D (dom G1)) g A B) /\ 140 | (forall G1 , AnnCtx G1 -> True). 141 | Proof. 142 | apply ann_typing_wff_iso_defeq_mutual; eauto 3; try done. 143 | - intros L G D. intros. 144 | eapply (An_PiCong (L \u dom G \u D)); eauto. 145 | intros. 146 | eapply (fourth ann_respects_atoms_eq_mutual). eapply H0. eauto. 147 | simpl. fsetdec. 148 | - intros L G D. intros. 149 | eapply (An_AbsCong (L \u dom G \u D)); eauto. 150 | intros. 151 | eapply (fourth ann_respects_atoms_eq_mutual). eapply H0. eauto. 152 | simpl. fsetdec. 153 | - intros L G D. intros. 154 | eapply (An_CPiCong (L \u dom G \u D)); eauto. 155 | intros. 156 | eapply (fourth ann_respects_atoms_eq_mutual). eapply H0. eauto. 157 | simpl. fsetdec. 158 | - intros L G D. intros. 159 | eapply (An_CAbsCong (L \u dom G \u D)); eauto 1. 160 | intros. 161 | eapply (fourth ann_respects_atoms_eq_mutual). eapply H0. eauto. 162 | simpl. fsetdec. 163 | eauto. 164 | Qed. 165 | 166 | Lemma AnnDefEq_weaken_available : 167 | forall G D g A B, AnnDefEq G D g A B -> AnnDefEq G (dom G) g A B. 168 | Proof. 169 | intros. 170 | remember (AtomSetImpl.inter D (dom G)) as D'. 171 | eapply (fourth ann_weaken_available_mutual). 172 | eapply (fourth ann_remove_available_mutual). 173 | eauto. subst. fsetdec. 174 | Qed. 175 | 176 | Lemma AnnIso_weaken_available : 177 | forall G D g A B, AnnIso G D g A B -> AnnIso G (dom G) g A B. 178 | Proof. 179 | intros G D. intros. 180 | remember (AtomSetImpl.inter D (dom G)) as D'. 181 | eapply (third ann_weaken_available_mutual). 182 | eapply (third ann_remove_available_mutual). 183 | eauto. subst. fsetdec. 184 | Qed. 185 | 186 | Instance AnnIso_atoms_sub_mor : Morphisms.Proper 187 | (eq ==> AtomSetImpl.Subset ==> eq ==> eq ==> eq ==> impl) 188 | AnnIso. 189 | Proof. 190 | simpl_relation; eapply (third ann_weaken_available_mutual); eassumption. 191 | Qed. 192 | 193 | Instance AnnDefEq_atoms_sub_mor : Morphisms.Proper 194 | (eq ==> AtomSetImpl.Subset ==> eq ==> eq ==> eq ==> impl) 195 | AnnDefEq. 196 | Proof. 197 | simpl_relation; eapply (fourth ann_weaken_available_mutual); eassumption. 198 | Qed. 199 | 200 | 201 | (* FIXME: temporary hack *) 202 | Ltac ann_weak_speedup := 203 | first [eapply An_AppCong | eapply An_PiSnd]. 204 | 205 | 206 | (* ------------------------------------------------------------------- *) 207 | 208 | Lemma ann_typing_weakening_mutual: 209 | (forall G0 a A, AnnTyping G0 a A -> 210 | forall E F G, (G0 = F ++ G) -> AnnCtx (F ++ E ++ G) -> AnnTyping (F ++ E ++ G) a A) /\ 211 | (forall G0 phi, AnnPropWff G0 phi -> 212 | forall E F G, (G0 = F ++ G) -> 213 | AnnCtx (F ++ E ++ G) -> AnnPropWff (F ++ E ++ G) phi) /\ 214 | (forall G0 D g p1 p2, AnnIso G0 D g p1 p2 -> 215 | forall E F G, (G0 = F ++ G) -> 216 | AnnCtx (F ++ E ++ G) -> AnnIso (F ++ E ++ G) D g p1 p2) /\ 217 | (forall G0 D g A B, AnnDefEq G0 D g A B -> 218 | forall E F G, (G0 = F ++ G) -> 219 | AnnCtx (F ++ E ++ G) -> AnnDefEq (F ++ E ++ G) D g A B) /\ 220 | (forall G0, AnnCtx G0 -> 221 | forall E F G, (G0 = F ++ G) -> 222 | AnnCtx (F ++ E ++ G) -> AnnCtx (F ++ E ++ G)). 223 | Proof. 224 | eapply ann_typing_wff_iso_defeq_mutual. 225 | all: pre; subst. 226 | all: eauto 3. 227 | all: try first [ ann_weak_speedup 228 | | An_pick_fresh x; 229 | try auto_rew_env; 230 | try apply_first_hyp; 231 | try simpl_env]; 232 | eauto 3. 233 | all: try solve [econstructor; eauto 2]. 234 | all: try solve [eapply AnnDefEq_weaken_available; eauto 2]. 235 | all: try solve [try rewrite <- dom_app; try rewrite <- dom_app; 236 | eapply AnnDefEq_weaken_available; eauto]. 237 | all: try solve [econstructor; eauto 2; 238 | eapply AnnDefEq_weaken_available; eauto 2]. 239 | all: try solve [ 240 | (* These are all AnnCtx goals. Need to show the new assumption 241 | is well-formed by using induction on a term that mentions it. 242 | *) 243 | econstructor; eauto 2; 244 | by move: (H1 E F G0 eq_refl ltac:(auto)); inversion 1]. 245 | 246 | (* Left/Right 247 | eapply An_Right with (a:=a)(a':=a'); eauto 2; 248 | eapply AnnDefEq_weaken_available; eauto 2. *) 249 | Qed. 250 | 251 | Definition AnnTyping_weakening := first ann_typing_weakening_mutual. 252 | Definition AnnPropWff_weakening := second ann_typing_weakening_mutual. 253 | Definition AnnIso_weakening := third ann_typing_weakening_mutual. 254 | Definition AnnDefEq_weakening := fourth ann_typing_weakening_mutual. 255 | Definition AnnCtx_weakening := fifth ann_typing_weakening_mutual. 256 | 257 | End fc_weak. 258 | -------------------------------------------------------------------------------- /src/FcEtt/fc_wf.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.sigs. 2 | 3 | Require Export FcEtt.imports. 4 | Require Export FcEtt.ett_inf. 5 | Require Export FcEtt.ett_ind. 6 | 7 | 8 | Require Import FcEtt.tactics. 9 | 10 | Require Import FcEtt.toplevel. 11 | 12 | 13 | Set Bullet Behavior "Strict Subproofs". 14 | Set Implicit Arguments. 15 | 16 | 17 | (* ---------------------------------------------------- *) 18 | 19 | Lemma ann_ctx_wff_mutual : 20 | (forall G0 a A, AnnTyping G0 a A -> AnnCtx G0) /\ 21 | (forall G0 phi, AnnPropWff G0 phi -> AnnCtx G0) /\ 22 | (forall G0 D g p1 p2, AnnIso G0 D g p1 p2 -> AnnCtx G0) /\ 23 | (forall G0 D g A B, AnnDefEq G0 D g A B -> AnnCtx G0) /\ 24 | (forall G0, AnnCtx G0 -> True). 25 | Proof. 26 | eapply ann_typing_wff_iso_defeq_mutual; eauto. 27 | Qed. 28 | 29 | 30 | Definition AnnTyping_AnnCtx := first ann_ctx_wff_mutual. 31 | Definition AnnPropWff_AnnCtx := second ann_ctx_wff_mutual. 32 | Definition AnnIso_AnnCtx := third ann_ctx_wff_mutual. 33 | Definition AnnDefEq_AnnCtx := fourth ann_ctx_wff_mutual. 34 | 35 | Hint Resolve AnnTyping_AnnCtx AnnPropWff_AnnCtx AnnIso_AnnCtx 36 | AnnDefEq_AnnCtx : ctx_wff. 37 | 38 | (* Look for an extended context that we can derive information from *) 39 | Ltac sort_inversion := 40 | let h0 := fresh in 41 | match goal with 42 | | [ H : AnnTyping ([(?x,?s)] ++ ?G) _ _ |- _ ] => 43 | have h0: AnnCtx (x ~ s ++ G); eauto with ctx_wff; 44 | inversion h0; subst; auto 45 | | [ H : AnnDefEq ([(?x,?s)] ++ ?G) _ _ _ |- _ ] => 46 | have h0: AnnCtx (x ~ s ++ G); eauto with ctx_wff; 47 | inversion h0; subst; auto 48 | | [ H : AnnIso ([(?x,?s)] ++ ?G) _ _ _ |- _ ] => 49 | have h0: AnnCtx (x ~ s ++ G); eauto with ctx_wff; 50 | inversion h0; subst; auto 51 | end. 52 | 53 | 54 | (* ---------------------------------------------------- *) 55 | 56 | Lemma AnnCtx_uniq G : AnnCtx G -> uniq G. 57 | Proof. by elim=> * //=; apply uniq_cons. Qed. 58 | 59 | Hint Resolve AnnCtx_uniq. 60 | 61 | (* ---------------------------------------------------- *) 62 | 63 | Hint Resolve lc_open_switch_co : lc. 64 | 65 | Lemma lc_mutual : 66 | (forall G0 a A, AnnTyping G0 a A -> lc_tm a /\ lc_tm A) /\ 67 | (forall G0 phi, AnnPropWff G0 phi -> lc_constraint phi) /\ 68 | (forall G0 D g p1 p2, AnnIso G0 D g p1 p2 -> lc_constraint p1 /\ lc_constraint p2 /\ lc_co g) /\ 69 | (forall G0 D g A B, AnnDefEq G0 D g A B -> lc_tm A /\ lc_tm B /\ lc_co g) /\ 70 | (forall G0, AnnCtx G0 -> forall x s , binds x s G0 -> lc_sort s). 71 | Proof. 72 | apply ann_typing_wff_iso_defeq_mutual. 73 | all: pre; basic_solve_n 2; split_hyp. 74 | all: lc_solve. 75 | Qed. 76 | 77 | Definition AnnTyping_lc := first lc_mutual. 78 | Definition AnnPropWff_lc := second lc_mutual. 79 | Definition AnnIso_lc := third lc_mutual. 80 | Definition AnnDefEq_lc := fourth lc_mutual. 81 | Definition AnnCtx_lc := fifth lc_mutual. 82 | 83 | Lemma AnnTyping_lc1 : forall G a A, AnnTyping G a A -> lc_tm a. 84 | Proof. 85 | intros G a A H. destruct (AnnTyping_lc H); auto. 86 | Qed. 87 | Lemma AnnTyping_lc2 : forall G a A, AnnTyping G a A -> lc_tm A. 88 | intros G a A H. destruct (AnnTyping_lc H); auto. 89 | Qed. 90 | 91 | Lemma AnnIso_lc1 : forall G D g p1 p2, AnnIso G D g p1 p2 -> lc_constraint p1. 92 | Proof. intros. destruct (AnnIso_lc H); auto. Qed. 93 | Lemma AnnIso_lc2 : forall G D g p1 p2, AnnIso G D g p1 p2 -> lc_constraint p2. 94 | Proof. intros. destruct (AnnIso_lc H); split_hyp; auto. Qed. 95 | Lemma AnnIso_lc3 : forall G D g p1 p2, AnnIso G D g p1 p2 -> lc_co g. 96 | Proof. intros. destruct (AnnIso_lc H); split_hyp; auto. Qed. 97 | Lemma AnnDefEq_lc1 : forall G D g A B, AnnDefEq G D g A B -> lc_tm A. 98 | Proof. intros. destruct (AnnDefEq_lc H); auto. Qed. 99 | Lemma AnnDefEq_lc2 : forall G D g A B, AnnDefEq G D g A B -> lc_tm B. 100 | Proof. intros. destruct (AnnDefEq_lc H); split_hyp; auto. Qed. 101 | Lemma AnnDefEq_lc3 : forall G D g A B, AnnDefEq G D g A B -> lc_co g. 102 | Proof. intros. destruct (AnnDefEq_lc H); split_hyp; auto. Qed. 103 | 104 | Hint Resolve AnnTyping_lc1 AnnTyping_lc2 AnnIso_lc1 AnnIso_lc2 AnnIso_lc3 AnnDefEq_lc1 AnnDefEq_lc2 AnnDefEq_lc3 AnnCtx_lc : lc. 105 | 106 | 107 | Lemma AnnToplevel_lc : forall c s, binds c s an_toplevel -> lc_sig_sort s. 108 | Proof. induction AnnSig_an_toplevel. 109 | intros; lc_solve. 110 | all: intros; lc_solve_binds; split_hyp; subst; eauto with lc. 111 | Qed. 112 | -------------------------------------------------------------------------------- /src/FcEtt/fix_typing.v: -------------------------------------------------------------------------------- 1 | Require Import Metalib.Metatheory. 2 | Require Import FcEtt.ett_ott. 3 | Require Import FcEtt.ett_inf. 4 | 5 | Set Bullet Behavior "Strict Subproofs". 6 | Set Implicit Arguments. 7 | 8 | 9 | (* 10 | 11 | This module proves the following results: 12 | 13 | Lemma AnnSig_an_toplevel: AnnSig an_toplevel. 14 | Lemma Sig_toplevel: Sig toplevel. 15 | 16 | 17 | It *should* be the only place in the development that 18 | unfolds the definition of an_toplevel. That way, if we change the 19 | definition of the signature in ett.ott, we only need to change this file. 20 | 21 | In this case, it uses the fact that an_toplevel (defined in ett.ott) 22 | contains the following definitions: 23 | 24 | Definition Fix : atom. 25 | pick fresh F. 26 | exact F. 27 | Qed. 28 | 29 | Definition FixDef : tm := 30 | (a_Abs Irrel a_Star 31 | (a_Abs Rel (a_Pi Rel (a_Var_b 0) (a_Var_b 1)) 32 | (a_App (a_Var_b 0) Rel 33 | (a_App (a_App (a_Fam Fix) Irrel (a_Var_b 1)) Rel (a_Var_b 0))))). 34 | 35 | Definition FixTy : tm := 36 | a_Pi Irrel a_Star 37 | (a_Pi Rel (a_Pi Rel (a_Var_b 0) (a_Var_b 1)) 38 | (a_Var_b 1)). 39 | *) 40 | 41 | Lemma AxFix : binds Fix (Ax FixDef FixTy) an_toplevel. 42 | unfold an_toplevel. 43 | eauto. 44 | Qed. 45 | 46 | Ltac an_use_binder f x := 47 | pick fresh x and apply f; eauto; 48 | unfold open_tm_wrt_tm; simpl; simpl_env; eauto; 49 | match goal with 50 | [ |- AnnTyping ?ctx ?a ?A ] => 51 | assert (AnnCtx ctx); [econstructor; eauto|idtac] 52 | end. 53 | 54 | Lemma An_App_intro : 55 | forall (G : context) (b : tm) (rho : relflag) (a B A C : tm), 56 | AnnTyping G b (a_Pi rho A B) -> (open_tm_wrt_tm B a) = C -> 57 | AnnTyping G a A -> AnnTyping G (a_App b rho a) C. 58 | Proof. 59 | intros. subst. eapply An_App; eauto. 60 | Qed. 61 | 62 | Lemma FixTy_Star : 63 | AnnTyping nil FixTy a_Star. 64 | Proof. 65 | an_use_binder An_Pi X. 66 | an_use_binder An_Pi Z. 67 | an_use_binder An_Pi W. 68 | eauto. 69 | eauto. 70 | an_use_binder An_Pi W. 71 | eauto. 72 | Qed. 73 | 74 | Lemma FixDef_FixTy : 75 | AnnTyping nil FixDef FixTy. 76 | Proof. 77 | an_use_binder An_Abs X. 78 | an_use_binder An_Abs x. 79 | { an_use_binder An_Pi Z. eauto. } 80 | { an_use_binder An_Pi Z. eauto. } 81 | { eapply An_App_intro; eauto. 82 | { eapply An_App_intro; simpl; eauto. 83 | { eapply An_App_intro; simpl; eauto. 84 | econstructor; eauto. 85 | eapply AxFix. 86 | an_use_binder An_Pi Z. 87 | an_use_binder An_Pi W; eauto. 88 | an_use_binder An_Pi M; eauto. 89 | an_use_binder An_Pi N; eauto. 90 | unfold open_tm_wrt_tm. simpl. eauto. } 91 | unfold open_tm_wrt_tm. simpl. eauto. 92 | } 93 | } 94 | Qed. 95 | 96 | Lemma AnnSig_an_toplevel: AnnSig an_toplevel. 97 | Proof. 98 | unfold an_toplevel. 99 | econstructor; eauto. 100 | (* eapply AxFix. *) 101 | eapply FixTy_Star. eauto. 102 | eapply FixDef_FixTy. 103 | Qed. 104 | 105 | (* ---------------------------------------------------------- *) 106 | 107 | Ltac use_binder f x := 108 | pick fresh x and apply f; 109 | unfold open_tm_wrt_tm; simpl; simpl_env; eauto; 110 | match goal with 111 | [ |- Typing ?ctx ?a ?A ] => 112 | assert (Ctx ctx); [econstructor; eauto|idtac] 113 | end. 114 | 115 | Lemma E_App_intro : 116 | forall (G : context) (b : tm) (a B A C : tm), 117 | Typing G b (a_Pi Rel A B) -> (open_tm_wrt_tm B a) = C -> 118 | Typing G a A -> Typing G (a_App b Rel a) C. 119 | Proof. 120 | intros. subst. eapply E_App; eauto. 121 | Qed. 122 | 123 | Lemma E_IApp_intro : 124 | forall (G : context) (b : tm) (a B A C : tm), 125 | Typing G b (a_Pi Irrel A B) -> (open_tm_wrt_tm B a) = C -> 126 | Typing G a A -> Typing G (a_App b Irrel a_Bullet) C. 127 | Proof. 128 | intros. subst. eapply E_IApp; eauto. 129 | Qed. 130 | 131 | Lemma FixTy_erase : 132 | Typing nil (erase_tm FixTy) a_Star. 133 | Proof. 134 | use_binder E_Pi X. 135 | use_binder E_Pi Z. 136 | use_binder E_Pi W. 137 | eauto. 138 | eauto. 139 | use_binder E_Pi W. 140 | eauto. 141 | Qed. 142 | 143 | Lemma FixDef_FixTy_erase : 144 | Typing nil (erase_tm FixDef) (erase_tm FixTy). 145 | Proof. 146 | pose (H := AxFix). clearbody H. 147 | unfold FixDef,FixTy; simpl. 148 | use_binder E_Abs X. 149 | use_binder E_Abs x. 150 | { use_binder E_Pi Z. eauto. } 151 | { eapply E_App_intro; eauto. 152 | { eapply E_App_intro; simpl; eauto. 153 | { eapply E_IApp_intro with (a := (a_Var_f X)); simpl; eauto. 154 | 155 | pose (K := @E_Fam _ Fix (erase_tm FixTy) (erase_tm FixDef) H1). 156 | unfold toplevel, erase_sig in K. 157 | apply binds_map with (f:=erase_csort) in H. 158 | apply K in H. 159 | clear K. 160 | simpl in H. 161 | apply H. 162 | 163 | { simpl. 164 | use_binder E_Pi Z; eauto. 165 | use_binder E_Pi W; eauto. 166 | use_binder E_Pi M; eauto. 167 | use_binder E_Pi N; eauto. } 168 | 169 | { unfold open_tm_wrt_tm. simpl. eauto. } 170 | } 171 | unfold open_tm_wrt_tm. simpl. eauto. 172 | } 173 | } 174 | use_binder E_Pi Z; eauto. 175 | Qed. 176 | 177 | 178 | Lemma Sig_toplevel: Sig toplevel. 179 | Proof. 180 | unfold toplevel, erase_sig. 181 | unfold an_toplevel. 182 | econstructor; eauto. 183 | (* unfold toplevel, erase_sig. 184 | pose (K := AxFix). 185 | eapply binds_map with (f:= erase_csort) in K. 186 | apply K. *) 187 | eapply FixTy_erase. 188 | eapply FixDef_FixTy_erase. 189 | Qed. 190 | -------------------------------------------------------------------------------- /src/FcEtt/fset_facts.v: -------------------------------------------------------------------------------- 1 | Require Export FcEtt.tactics. 2 | Require Export FcEtt.ett_inf. 3 | Require Import FcEtt.imports. 4 | 5 | Lemma union_notin_iff a s1 s2 : 6 | a `notin` union s1 s2 ↔ a `notin` s1 ∧ a `notin` s2. 7 | Proof. fsetdec. Qed. 8 | 9 | Lemma dom_app_mid {C} (E F G : list (atom * C)) : 10 | dom (E ++ F ++ G) [=] union (dom F) (dom (E ++ G)). 11 | Proof. repeat rewrite dom_app; fsetdec. Qed. 12 | Hint Resolve dom_app_mid. 13 | 14 | Lemma dom_app_mid' {C} (E F G : list (atom * C)) : 15 | union (dom F) (dom (E ++ G)) [=] dom (E ++ F ++ G). 16 | Proof. by symmetry. Qed. 17 | Hint Resolve dom_app_mid'. 18 | 19 | Lemma singleton_add_subset (a : atom) (s : atoms) : 20 | singleton a [<=] add a s. 21 | Proof. fsetdec. Qed. 22 | 23 | Lemma union_subset (s1 s2 t : atoms) : 24 | union s1 s2 [<=] t <-> s1 [<=] t /\ s2 [<=] t. 25 | Proof. split; [split | case]; fsetdec. Qed. 26 | 27 | Lemma add_notin (s1 s2 : atoms) (a : atom) : 28 | s1 [<=] add a s2 -> 29 | a `notin` s1 -> 30 | s1 [<=] s2. 31 | Proof. fsetdec. Qed. 32 | 33 | Lemma in_dom_app {A} (a : atom) (G1 G2 : list (atom * A)) : 34 | a `in` dom (G1 ++ G2) ↔ a `in` dom G1 ∨ a `in` dom G2. 35 | Proof. rewrite dom_app; fsetdec. Qed. 36 | 37 | Lemma notin_dom_app {A} (a : atom) (G1 G2 : list (atom * A)) : 38 | a `notin` dom (G1 ++ G2) ↔ a `notin` dom G1 ∧ a `notin` dom G2. 39 | Proof. rewrite dom_app; fsetdec. Qed. 40 | 41 | Lemma not_uniq_app1_app1 {A} (a : atom) (v1 v2 : A) (G1 G2 : list (atom * A)) : 42 | ¬ uniq ((a ~ v1) ++ G1 ++ (a ~ v2) ++ G2). 43 | Proof. rewrite uniq_app_iff disjoint_one_l notin_dom_app /=; fsetdec. Qed. 44 | 45 | Lemma not_uniq_cons_cons {A} (a : atom) (v1 v2 : A) (G1 G2 : list (atom * A)) : 46 | ¬ uniq ((a,v1) :: G1 ++ (a,v2) :: G2). 47 | Proof. rewrite uniq_cons_iff notin_dom_app /=; fsetdec. Qed. 48 | 49 | Lemma notin_remove : 50 | forall x y S, x `notin` S -> x `notin` remove y S. 51 | Proof. 52 | intros. 53 | fsetdec. 54 | Qed. 55 | 56 | Lemma subset_notin : forall x S1 S2, 57 | x `notin` S2 -> S1 [<=] S2 -> x `notin` S1. 58 | Proof. 59 | fsetdec. 60 | Qed. 61 | -------------------------------------------------------------------------------- /src/FcEtt/imports.v: -------------------------------------------------------------------------------- 1 | Require Export Coq.Unicode.Utf8. 2 | 3 | Require Export Coq.Program.Basics. 4 | Require Export Coq.Program.Equality. 5 | 6 | Require Export Metalib.Metatheory. 7 | Require Export Metalib.LibLNgen. 8 | 9 | Require Export FcEtt.ett_ott. 10 | 11 | (* SSR *) 12 | 13 | Require Export mathcomp.ssreflect.ssreflect. 14 | Close Scope boolean_if_scope. 15 | Global Open Scope general_if_scope. 16 | 17 | (* 18 | From mathcomp Require Export ssrfun ssrmatching. 19 | *) 20 | 21 | 22 | Global Set Implicit Arguments. 23 | Global Set Bullet Behavior "Strict Subproofs". 24 | 25 | (* Masking this nasty notation from the stdlib *) 26 | Notation sort := sort (only parsing). 27 | -------------------------------------------------------------------------------- /src/FcEtt/main.v: -------------------------------------------------------------------------------- 1 | (* Combining all the parametrized modules together 2 | This serves both as an entry point for the proofs (combining all results) 3 | and a simple sanity check. *) 4 | 5 | Require Import FcEtt.ext_wf. 6 | Require Import FcEtt.ext_weak. 7 | Require Import FcEtt.ext_subst. 8 | Require Import FcEtt.ext_invert. 9 | Require Import FcEtt.ext_red. 10 | Require Import FcEtt.ext_red_one. 11 | 12 | Require Import FcEtt.fc_wf. 13 | Require Import FcEtt.fc_weak. 14 | Require Import FcEtt.fc_subst. 15 | Require Import FcEtt.fc_unique. 16 | Require Import FcEtt.fc_invert. 17 | Require Import FcEtt.fc_get. 18 | Require Import FcEtt.fc_dec. 19 | Require Import FcEtt.fc_preservation. 20 | Require Import FcEtt.fc_consist. 21 | Require Import FcEtt.fc_head_reduction. 22 | 23 | Require Import FcEtt.erase. 24 | Require Import FcEtt.ext_consist. 25 | 26 | 27 | Module ext_weak := ext_weak ext_wf. 28 | Module ext_subst := ext_subst ext_weak. 29 | Module ext_invert := ext_invert ext_subst. 30 | Module ext_red := ext_red ext_invert. 31 | Module ext_red_one := ext_red_one ext_invert. 32 | 33 | Module fc_weak := fc_weak fc_wf. 34 | Module fc_subst := fc_subst fc_wf fc_weak. 35 | Module fc_unique := fc_unique fc_wf fc_subst. 36 | Module fc_invert := fc_invert fc_wf fc_weak fc_subst. 37 | Module fc_get := fc_get fc_wf fc_weak fc_subst fc_unique. 38 | Module fc_dec := fc_dec fc_wf fc_weak fc_subst fc_unique. 39 | Module fc_preservation := fc_preservation fc_wf fc_weak fc_subst ext_subst. 40 | Module fc_consist := fc_consist fc_wf fc_weak fc_subst. 41 | Module fc_head_reduction := fc_head_reduction ext_invert. 42 | 43 | Module erase := erase fc_wf fc_weak fc_subst. 44 | Module ext_consist := ext_consist ext_invert fc_wf. 45 | -------------------------------------------------------------------------------- /src/FcEtt/toplevel.v: -------------------------------------------------------------------------------- 1 | Set Bullet Behavior "Strict Subproofs". 2 | Set Implicit Arguments. 3 | 4 | Require Export FcEtt.tactics. 5 | Require Export FcEtt.imports. 6 | Require Export FcEtt.ett_inf. 7 | Require Export FcEtt.ett_ott. 8 | Require Export FcEtt.ett_ind. 9 | Require Import FcEtt.utils. 10 | 11 | Require Export FcEtt.fix_typing. 12 | 13 | 14 | (* --------------------------------------------------- *) 15 | 16 | Lemma uniq_an_toplevel : uniq an_toplevel. 17 | Proof. 18 | induction AnnSig_an_toplevel; auto. 19 | Qed. 20 | Lemma uniq_toplevel : uniq toplevel. 21 | Proof. 22 | induction Sig_toplevel; auto. 23 | Qed. 24 | 25 | 26 | (* ------------------------------------------ *) 27 | Lemma toplevel_closed : forall F a A, binds F (Ax a A) toplevel -> 28 | Typing nil a A. 29 | Proof. 30 | have st: Sig toplevel by apply Sig_toplevel. 31 | induction st. 32 | - intros. inversion H. 33 | - intros. inversion H2. inversion H3. subst. auto. 34 | eauto. 35 | Qed. 36 | 37 | (* 38 | Lemma toplevel_to_const : forall T A, binds T (Cs A) toplevel -> Typing nil A a_Star. 39 | Proof. 40 | have st: Sig toplevel by apply Sig_toplevel. 41 | induction st. 42 | - intros. inversion H. 43 | - intros. inversion H2. inversion H3. subst. auto. 44 | eapply IHst. eauto. 45 | - intros. inversion H2. inversion H3. 46 | eauto. 47 | Qed. *) 48 | 49 | 50 | Lemma an_toplevel_closed : forall F a A, binds F (Ax a A) an_toplevel -> 51 | AnnTyping nil a A. 52 | Proof. 53 | have st: AnnSig an_toplevel by apply AnnSig_an_toplevel. 54 | induction st. 55 | - intros. inversion H. 56 | - intros. inversion H2. inversion H3. subst. eauto. eauto. 57 | Qed. 58 | 59 | (* 60 | Lemma an_toplevel_to_const : forall T A, binds T (Cs A) an_toplevel -> AnnTyping nil A a_Star. 61 | Proof. 62 | have st: AnnSig an_toplevel by apply AnnSig_an_toplevel. 63 | induction st. 64 | - intros. inversion H. 65 | - intros. inversion H2. inversion H3. subst. auto. 66 | eapply IHst. eauto. 67 | - intros. inversion H2. inversion H3. 68 | eauto. 69 | Qed. 70 | 71 | 72 | Lemma binds_to_type : forall S T A, AnnSig S -> binds T (Cs A) S -> DataTy A a_Star. 73 | Proof. induction 1. intros. inversion H. 74 | intros. destruct H3. inversion H3. subst. auto. 75 | eauto. 76 | intros. destruct H3. inversion H3. eauto. 77 | Qed. *) 78 | -------------------------------------------------------------------------------- /src/FcEtt/utils.v: -------------------------------------------------------------------------------- 1 | Require Import FcEtt.imports. 2 | 3 | Set Bullet Behavior "Strict Subproofs". 4 | Set Implicit Arguments. 5 | 6 | 7 | Definition first := 8 | fun (A B C D E: Prop) (p : A /\ B /\ C /\ D /\ E) => 9 | match p with 10 | | conj H _ => H 11 | end. 12 | Definition second := 13 | fun (A B C D E : Prop) (p : A /\ B /\ C /\ D /\ E) => 14 | match p with 15 | | conj _ (conj H _) => H 16 | end. 17 | Definition third := 18 | fun (A B C D E : Prop) (p : A /\ B /\ C /\ D /\ E) => 19 | match p with 20 | | conj _ (conj _ (conj H _)) => H 21 | end. 22 | Definition fourth := 23 | fun (A B C D E : Prop) (p : A /\ B /\ C /\ D /\ E) => 24 | match p with 25 | | conj _ (conj _ (conj _ (conj H _))) => H 26 | end. 27 | Definition fifth := 28 | fun (A B C D E : Prop) (p : A /\ B /\ C /\ D /\ E) => 29 | match p with 30 | | conj _ (conj _ (conj _ (conj _ H))) => H 31 | end. 32 | 33 | 34 | (* ------------------------------------- *) 35 | 36 | Lemma dom_subst_inv: forall (G: context) (f: sort -> sort), dom G = dom (map f G). 37 | Proof. 38 | induction G; eauto. 39 | intros f. 40 | destruct a. 41 | simpl. 42 | rewrite (IHG f); auto. 43 | Qed. 44 | 45 | (* -------------------------------------- *) 46 | 47 | Lemma binds_map_3 : 48 | forall a b x s (f : a -> b) G, binds x s (map f G) -> 49 | exists s', f s' = s /\ binds x s' G. 50 | intros. induction G. simpl in H. inversion H. 51 | destruct a0 as [x0 s0]. 52 | simpl in H. 53 | apply binds_cons_iff in H. destruct H. destruct H. subst. 54 | exists s0. auto. 55 | apply IHG in H. destruct H as [s' [ EQ B]]. 56 | exists s'. auto. 57 | Qed. 58 | 59 | (* -------------------------------------- *) 60 | 61 | Lemma binds_cases: forall G F x A y B, 62 | uniq (F ++ [(y, B)] ++ G) -> 63 | @binds sort x A (F ++ [(y, B)] ++ G) -> 64 | (binds x A F /\ x <> y /\ x `notin` dom G) \/ (x = y /\ A = B) \/ (binds x A G /\ x <> y /\ x `notin` dom F). 65 | Proof. 66 | intros G F x A y B U b. 67 | edestruct binds_app_1. eauto 1. 68 | + left. split. 69 | auto. 70 | move: (fresh_app_r _ x A _ F U H) => Fr. 71 | simpl in Fr. 72 | split. eauto. eauto. 73 | + edestruct binds_app_1. eauto 1. 74 | right. left. apply binds_one_iff. auto. 75 | - right. right. 76 | move: (uniq_app_2 _ _ _ U) => U1. 77 | move: (fresh_app_l _ x A _ _ U1 H0) => Fr. 78 | simpl in Fr. 79 | repeat split; eauto. 80 | eapply fresh_app_l; eauto 1. 81 | Qed. 82 | 83 | (* ------------------------------------- *) 84 | 85 | Lemma binds_concat: forall G F E x A, binds x (Tm A) (F ++ E ++ G) <-> binds x (Tm A) (F) \/ binds x (Tm A) (E) \/ binds x (Tm A) (G). 86 | Proof. 87 | intros G F E x A. 88 | split. 89 | - intros H. 90 | apply binds_app_1 in H. 91 | destruct H; auto. 92 | apply binds_app_1 in H. 93 | destruct H; auto. 94 | - intros. 95 | destruct H. 96 | eauto. 97 | destruct H. 98 | auto. 99 | auto. 100 | Qed. 101 | 102 | 103 | (* ------------------------------------- *) 104 | 105 | Lemma fun_cong : forall A B (f : A -> B) (a b : A), a = b -> f a = f b. 106 | Proof. 107 | intros. f_equal. eauto. 108 | Qed. 109 | --------------------------------------------------------------------------------