├── .boringfile ├── INSTALL ├── LICENSE ├── Setup.hs ├── epigram.cabal ├── man └── man.html ├── models ├── Alg-IIR.agda ├── Containers.agda ├── Data.agda ├── Data1.agda ├── Desc.agda ├── Desc.v ├── DescFix.agda ├── DescStrat.agda ├── DescStrat.lhs ├── DescTT.agda ├── FMSB.agda ├── IDesc.agda ├── IDescTT.agda ├── ILabel.agda ├── IMDesc.agda ├── Prob.agda ├── README.Descriptions ├── Records.agda ├── RevisedHutton.agda └── StratSigma.agda ├── notes ├── Epigram2 │ └── Epigram2.tex └── Quotients │ ├── macros.tex │ ├── pig.sty │ └── quotients.tex ├── papers ├── containers-for-dummies │ ├── Makefile │ ├── containers.bib │ └── containers.tex ├── icfp-2010-desc │ ├── Makefile │ ├── TODO.org │ ├── figure_finite_sets.tex │ ├── figure_judgemental_equality.tex │ ├── figure_type_checking.tex │ ├── figure_type_synthesis.tex │ ├── figure_typing_judgements.tex │ ├── flushend.sty │ ├── icfp23l-dagand.pdf │ ├── icfp23l-dagand.ps │ ├── icfp23l-dagand.tex │ ├── macros.tex │ ├── outline.tex │ ├── paper.bib │ ├── paper.tex │ ├── paper_desc.tex │ ├── paper_desc_levitation.tex │ ├── paper_discussion.tex │ ├── paper_idesc.tex │ ├── paper_type_theory.tex │ ├── pig.sty │ ├── propagation.tex │ ├── sigplanconf.cls │ └── type_theory.tex ├── icfp-2010-talk │ ├── Levitation.agda │ ├── Makefile │ ├── levitation.pdf │ ├── levitation.tex │ ├── macros.tex │ └── pig.sty ├── someconf-sometime-binding │ └── paper.tex ├── stratisfaction │ ├── Macros.tex │ ├── Makefile │ ├── figure_annotated.tex │ ├── figure_bidir.tex │ ├── figure_ecce.tex │ ├── figure_infuse.tex │ ├── figure_strat.tex │ ├── paper.tex │ ├── pig.sty │ ├── sigplanconf.cls │ └── stratisfaction.bib ├── type-inference │ ├── Makefile │ ├── abstract.ltx │ ├── lib-short.bib │ ├── lib.bib │ ├── macros.tex │ ├── proof-scratch.lhs │ ├── scratch.lhs │ ├── sigplanconf.cls │ ├── statement.lhs │ ├── traversable.lhs │ ├── type-inference-final.lhs │ ├── type-inference-revised.lhs │ └── type-inference.lhs └── ydtm-rev │ ├── Makefile │ ├── alti.bib │ ├── fontlock.sty │ ├── fundam.bst │ ├── fundam.cls │ ├── handy.bib │ ├── library.ltx │ ├── local.bib │ ├── macros.ltx │ ├── obsdec.bib │ ├── ydtm-rev.tex │ └── ydtm.bib ├── pigmode.el ├── send-line.el ├── src ├── Cochon │ ├── Cochon.lhs │ ├── CommandLexer.lhs │ ├── DevLoad.lhs │ ├── Error.lhs │ └── Introduction.tex ├── Compiler │ ├── Compiler.lhs │ ├── Introduction.tex │ └── OpDef.lhs ├── Detritus │ ├── Cochon.lhs │ ├── Construction.lhs │ ├── Containers.lhs │ ├── DevLoad.lhs │ ├── DisplayMangler.lhs │ ├── DisplayTm.lhs │ ├── Elaborator.lhs │ ├── Elaborator2.lhs │ ├── Features.lhs │ ├── Fibonacci.pig │ ├── Foo.pig │ ├── IDesc.lhs │ ├── IDescOld.lhs │ ├── INu.lhs │ ├── Induction.lhs │ ├── Language.tex │ ├── Main.lhs │ ├── MakeElab.lhs │ ├── Mangler.lhs │ ├── Naming.lhs │ ├── Nat.lhs │ ├── PrettyPrint.lhs │ ├── ProofState.lhs │ ├── PropSimp.lhs │ ├── Relabel.lhs │ ├── RunElab.lhs │ ├── Tactics.lhs │ ├── Tactics.lhs-boot │ ├── TmParse.lhs │ └── Update.lhs ├── DisplayLang │ ├── DisplayTm.lhs │ ├── Introduction.lhs │ ├── Lexer.lhs │ ├── Name.lhs │ ├── PrettyPrint.lhs │ ├── Scheme.lhs │ └── TmParse.lhs ├── Distillation │ ├── Distiller.lhs │ ├── Moonshine.lhs │ └── Scheme.lhs ├── Documentation │ ├── Introduction.tex │ ├── Language.tex │ ├── Macros.tex │ └── wrap.tex ├── Elaboration │ ├── ElabMonad.lhs │ ├── ElabProb.lhs │ ├── Elaborator.lhs │ ├── MakeElab.lhs │ ├── RunElab.lhs │ ├── Scheduler.lhs │ ├── Wire.lhs │ └── Wire.lhs-boot ├── Epitome.bib ├── Epitome.lhs ├── Evidences │ ├── BetaQuotation.lhs │ ├── BetaQuotation.lhs-boot │ ├── DefinitionalEquality.lhs │ ├── DefinitionalEquality.lhs-boot │ ├── Eval.lhs │ ├── Eval.lhs-boot │ ├── Introduction.tex │ ├── Mangler.lhs │ ├── OperatorDSL.lhs │ ├── Operators.lhs │ ├── PropositionalEquality.lhs │ ├── PropositionalEquality.lhs-boot │ ├── Tm.lhs │ ├── TypeChecker.lhs │ └── Utilities.lhs ├── Features │ ├── Anchor.lhs │ ├── Desc.lhs │ ├── Enum.lhs │ ├── Equality.lhs │ ├── Features.lhs │ ├── FreeMonad.lhs │ ├── IDesc.lhs │ ├── Introduction.tex │ ├── Labelled.lhs │ ├── Nu.lhs │ ├── Problem.lhs │ ├── Prop.lhs │ ├── Quotient.lhs │ ├── Record.lhs │ ├── Sigma.lhs │ ├── Skeleton.lhs │ └── UId.lhs ├── Kit │ ├── BwdFwd.lhs │ ├── MissingLibrary.lhs │ ├── Parsley.lhs │ └── Trace.lhs ├── Main.lhs ├── Makefile ├── NameSupply │ ├── Introduction.tex │ ├── NameSupplier.lhs │ └── NameSupply.lhs ├── ProofState │ ├── Edition │ │ ├── Entries.lhs │ │ ├── FakeRef.lhs │ │ ├── GetSet.lhs │ │ ├── Navigation.lhs │ │ ├── NavigationExamples.tex │ │ ├── News.lhs │ │ ├── ProofContext.lhs │ │ ├── ProofState.lhs │ │ └── Scope.lhs │ ├── Interface │ │ ├── Anchor.lhs │ │ ├── Definition.lhs │ │ ├── Lifting.lhs │ │ ├── Module.lhs │ │ ├── Name.lhs │ │ ├── NameResolution.lhs │ │ ├── Parameter.lhs │ │ ├── ProofKit.lhs │ │ ├── Search.lhs │ │ └── Solving.lhs │ ├── Introduction.tex │ └── Structure │ │ ├── Developments.lhs │ │ └── Entries.lhs ├── SourceLang │ ├── Elaborator.lhs │ ├── Example.lhs │ ├── Parser.lhs │ └── Structure.lhs ├── Tactics │ ├── Data.lhs │ ├── Elimination.lhs │ ├── Gadgets.lhs │ ├── IData.lhs │ ├── Information.lhs │ ├── Introduction.tex │ ├── Matching.lhs │ ├── ProblemSimplify.lhs │ ├── PropositionSimplify.lhs │ ├── Record.lhs │ ├── Relabel.lhs │ ├── ShowHaskell.lhs │ └── Unification.lhs ├── Tests │ ├── CochonNat.lhs │ ├── DevLoad.lhs │ ├── Elim.lhs │ ├── Lexer.lhs │ ├── MkRef.lhs │ ├── Tactics.lhs │ └── TmParse.lhs ├── epic │ └── support.e ├── manfnt.sty ├── pig.sty ├── polycode.fmt └── stuff.fmt ├── test ├── Ackermann.pig ├── Ackermann2.pig ├── Baz.pig ├── Both.dev ├── Both.pig ├── BugBoxSum.pig ├── BugDescLoop.pig ├── BugEqgreenMu.pig ├── BugEqgreenMu2.pig ├── BugFakeType.pig ├── BugGoalUnification.pig ├── BugInduction.pig ├── BugLabelLookup.pig ├── BugLetDependent.pig ├── BugLetLambda.pig ├── BugLetOperator.pig ├── BugModuleRelabel.pig ├── BugNameOrder.pig ├── BugNatDesc.pig ├── BugSubstEq.pig ├── BugUnliftedScheme.pig ├── Cat.pig ├── Cat.pig.disabled ├── DataDecl.pig ├── Demo.pig ├── Demo.pig.disabled ├── DescFix.pig ├── DescFix.pig.disabled ├── Differentiation.pig ├── Elab.pig ├── Elim.pig ├── Elim1.pig ├── Elim2.pig ├── Elim3.pig ├── ElimEquality.pig ├── ElimSplit.pig ├── ElimSwitch.pig ├── Empty.pig ├── FeatureMultiInduction.pig ├── Fibonacci.pig ├── Fin.pig ├── Fin.pig.disabled ├── Foo.dev ├── Foo.pig ├── GenericCase.pig ├── HigherHole.pig ├── IData.pig ├── IDescFix.pig ├── IDescFix.pig.disabled ├── Image.pig ├── LabelledNat.pig ├── LambdaCalculus.pig ├── Let.pig ├── LetAdd.pig ├── LetAdd2.pig ├── LetAdd2.pig.disabled ├── LetMul.pig ├── LetVec.pig ├── Levitation.pig ├── List.pig ├── MapSimp.pig ├── Module.dev ├── Module.pig ├── Monad.pig ├── Naming.pig ├── NamingSchemes.pig ├── Nat.pig ├── Nat2.pig ├── Nat3.pig ├── NatDev.dev ├── NatDev.pig ├── NatDev.pig.disabled ├── NatElim.pig ├── NatElim.pig.disabled ├── NatInd.pig ├── NatInd.pig.disabled ├── NatLElim.pig ├── NatLElim.pig.disabled ├── Navigation.dev ├── Navigation.pig ├── NiceInductionPrinciple.pig ├── Partial.dev ├── Partial.pig ├── Pi.dev ├── Pi.pig ├── Plus.pig ├── Pretty.pig ├── Pretty2.dev ├── Pretty2.pig ├── ProgramNat.pig ├── PropSimp.pig ├── Quotient.pig ├── Record.pig ├── Script.pig ├── Shared.dev ├── Shared.pig ├── SimpleIInduction.pig ├── So.pig ├── Solution.pig ├── Sort.pig ├── Sort.pig.disabled ├── Stream.pig ├── Syntax.pig ├── TaggedInduction.pig ├── TestAnchor.pig ├── TestDesc.pig ├── UnifDeep.Pig ├── UnorderedPairs.pig ├── Vec.pig ├── VecAppend.pig ├── VecAppend.pig.disabled ├── VecAppend2.pig ├── VecAppend2.pig.disabled ├── VecAppend3.pig ├── VecAppend3.pig.disabled ├── VecAppend4.pig ├── VecAppend4.pig.disabled ├── hpc.sh ├── opSimp.pig ├── recbug.pig ├── report_stats.sh ├── results │ ├── Ackermann.pig.log │ ├── Ackermann2.pig.log │ ├── Baz.pig.log │ ├── Both.pig.log │ ├── BugBoxSum.pig.log │ ├── BugDescLoop.pig.log │ ├── BugEqgreenMu.pig.log │ ├── BugEqgreenMu2.pig.log │ ├── BugFakeType.pig.log │ ├── BugGoalUnification.pig.log │ ├── BugInduction.pig.log │ ├── BugLabelLookup.pig.log │ ├── BugLetDependent.pig.log │ ├── BugLetLambda.pig.log │ ├── BugLetOperator.pig.log │ ├── BugModuleRelabel.pig.log │ ├── BugNameOrder.pig.log │ ├── BugNatDesc.pig.log │ ├── BugUnliftedScheme.pig.log │ ├── DataDecl.pig.log │ ├── Demo.pig.log │ ├── DescFix.pig.log │ ├── Differentiation.pig.log │ ├── Elab.pig.log │ ├── Elim.pig.log │ ├── Elim1.pig.log │ ├── Elim2.pig.log │ ├── Elim3.pig.log │ ├── ElimEquality.pig.log │ ├── ElimSplit.pig.log │ ├── ElimSwitch.pig.log │ ├── Empty.pig.log │ ├── FeatureMultiInduction.pig.log │ ├── Fibonacci.pig.log │ ├── Foo.pig.log │ ├── GenericCase.pig.log │ ├── HigherHole.pig.log │ ├── IData.pig.log │ ├── IDescFix.pig.log │ ├── Image.pig.log │ ├── LabelledNat.pig.log │ ├── LambdaCalculus.pig.log │ ├── Let.pig.log │ ├── LetAdd.pig.log │ ├── LetAdd2.pig.log │ ├── LetMul.pig.log │ ├── LetVec.pig.log │ ├── List.pig.log │ ├── MapSimp.pig.log │ ├── Module.pig.log │ ├── Monad.pig.log │ ├── Naming.pig.log │ ├── NamingSchemes.pig.log │ ├── Nat.pig.log │ ├── Nat2.pig.log │ ├── Nat3.pig.log │ ├── NatDev.pig.log │ ├── NatElim.pig.log │ ├── NatInd.pig.log │ ├── NatLElim.pig.log │ ├── Navigation.pig.log │ ├── NiceInductionPrinciple.pig.log │ ├── Partial.pig.log │ ├── Pi.pig.log │ ├── Plus.pig.log │ ├── Pretty.pig.log │ ├── Pretty2.pig.log │ ├── ProgramNat.pig.log │ ├── PropSimp.pig.log │ ├── Quotient.pig.log │ ├── Record.pig.log │ ├── Script.pig.log │ ├── Shared.pig.log │ ├── SimpleIInduction.pig.log │ ├── So.pig.log │ ├── Solution.pig.log │ ├── Sort.pig.log │ ├── Stream.pig.log │ ├── Syntax.pig.log │ ├── TaggedInduction.pig.log │ ├── TestAnchor.pig.log │ ├── TestDesc.pig.log │ ├── UnifDeep.pig.log │ ├── UnorderedPairs.pig.log │ ├── Vec.pig.log │ ├── VecAppend.pig.log │ ├── VecAppend2.pig.log │ ├── VecAppend3.pig.log │ ├── VecAppend4.pig.log │ ├── opSimp.pig.log │ └── recbug.pig.log ├── stats.sh └── test.sh └── web ├── community.html ├── default.css ├── docs.html ├── download.html ├── images ├── img01.gif ├── img02.gif ├── img03.gif ├── img04.jpg ├── img05.gif ├── img06.gif ├── img07.gif ├── img08.gif ├── img09.gif └── img10.gif ├── index.html ├── index.old.html ├── reportbug.html └── style.css /.boringfile: -------------------------------------------------------------------------------- 1 | # cabal stuffs 2 | ^dist 3 | 4 | # ICFP paper 5 | papers/icfp-2010-desc/propagation\.pdf 6 | papers/icfp-2010-desc/type_theory\.pdf 7 | 8 | # Type inference paper 9 | papers/type-inference/type-inference.pdf 10 | papers/type-inference/type-inference.tex 11 | 12 | # Agdai files 13 | \.agdai 14 | 15 | # (hpc) HPC results 16 | ^src/\.hpc$ 17 | \.tix$ 18 | 19 | # Boring BUILD flags 20 | BUILD_* 21 | 22 | # Boring compilation results: 23 | ^src/Pig$ 24 | 25 | # Boring test cache: 26 | ^test/.tests$ 27 | 28 | # Boring performance measures 29 | ^test/.measures$ 30 | 31 | # (lhs2TeX) Boring file regexps: 32 | \.aux 33 | \.bbl 34 | \.blg 35 | Epitome.ind 36 | Epitome.ilg 37 | Epitome.idx 38 | [^g]\.log 39 | Epitome\.pdf 40 | paper\.pdf 41 | \.ptb 42 | Epitome.tex 43 | \.toc 44 | \.out 45 | 46 | # (She) Boring file regexps: 47 | \.hers 48 | \.hspp 49 | 50 | # (Makefile) Boring file regexps: 51 | src/\.depend$ 52 | 53 | # NFS is boring 54 | \.nfs0 55 | 56 | # Darcs backups are boring: 57 | -darcs-backup.$ 58 | 59 | # (Darcs) Boring file regexps: 60 | \.hi$ 61 | \.hi-boot$ 62 | \.o-boot$ 63 | \.o$ 64 | \.o\.cmd$ 65 | # *.ko files aren't boring by default because they might 66 | # be Korean translations rather than kernel modules. 67 | # \.ko$ 68 | \.ko\.cmd$ 69 | \.mod\.c$ 70 | (^|/)\.tmp_versions($|/) 71 | (^|/)CVS($|/) 72 | \.cvsignore$ 73 | ^\.# 74 | (^|/)RCS($|/) 75 | ,v$ 76 | (^|/)\.svn($|/) 77 | \.bzr$ 78 | (^|/)SCCS($|/) 79 | ~$ 80 | (^|/)_darcs($|/) 81 | \.bak$ 82 | \.BAK$ 83 | \.orig$ 84 | \.rej$ 85 | (^|/)vssver\.scc$ 86 | \.swp$ 87 | (^|/)MT($|/) 88 | (^|/)\{arch\}($|/) 89 | (^|/).arch-ids($|/) 90 | (^|/), 91 | \.prof$ 92 | (^|/)\.DS_Store$ 93 | (^|/)BitKeeper($|/) 94 | (^|/)ChangeSet($|/) 95 | \.py[co]$ 96 | \.elc$ 97 | \.class$ 98 | \# 99 | (^|/)Thumbs\.db$ 100 | (^|/)autom4te\.cache($|/) 101 | (^|/)config\.(log|status)$ 102 | ^\.depend$ 103 | (^|/)(tags|TAGS)$ 104 | #(^|/)\.[^/] 105 | (^|/|\.)core$ 106 | \.(obj|a|exe|so|lo|la)$ 107 | ^\.darcs-temp-mail$ 108 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | The installation instructions are on the website: 2 | 3 | http://www.e-pig.org/#download 4 | 5 | There is a local copy of it in this repo in the web folder. 6 | 7 | Pig09/web/index.html#downloads 8 | 9 | On a mac you can probably just type this. 10 | 11 | $ open web/index.html#download 12 | 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010, The Epigram Posse. 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import System 2 | 3 | import Data.List 4 | 5 | import Distribution.Simple 6 | import Distribution.Simple.UserHooks 7 | import Distribution.PackageDescription 8 | import Distribution.Simple.LocalBuildInfo 9 | import Distribution.Simple.Setup 10 | 11 | 12 | -- All right. So, if we want to compile that damned thing, we have to 13 | -- call |src/Makefile|. We don't do that because we are sadic, we do 14 | -- it because we are masochist. Indeed, She needs a special treatment 15 | -- in order to compile. For now, only a Makefile can make it. 16 | 17 | -- Therefore, we overwrite the |buildHook| of |Cabal| by our own junk 18 | -- calling the Makefile and copying the binary at the excepted 19 | -- place. We extract the dependencies from the package description and 20 | -- pass it along. 21 | 22 | callMake :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO () 23 | callMake pkgDesc buildInfo userHooks buildFlags = do 24 | let pkgs = "HC_CABAL_PACKAGE=\"" ++ 25 | (intercalate " " 26 | (map (\(Dependency (PackageName name) _) -> "-package " ++ name) $ 27 | buildDepends pkgDesc)) 28 | ++ "\"" 29 | exit <- system $ "cd src; make clean dep " ++ pkgs 30 | if exit /= ExitSuccess 31 | then exitFailure 32 | else return () 33 | exit <- system $ "cd src; make Pig " ++ pkgs 34 | if exit /= ExitSuccess 35 | then exitFailure 36 | else return () 37 | system $ "mkdir -p dist/build/Pig/" 38 | system $ "cp -f src/Pig dist/build/Pig/Pig" 39 | return () 40 | 41 | -- An obvious question remain: We've stripped the package 42 | -- dependencies, good. But is there anything else we should care 43 | -- about? No clue. 44 | 45 | 46 | -- Let's compile, whohoooooo! 47 | 48 | main = defaultMainWithHooks $ 49 | simpleUserHooks { buildHook = callMake } 50 | -------------------------------------------------------------------------------- /epigram.cabal: -------------------------------------------------------------------------------- 1 | Name: Epigram 2 | Version: 0.1 3 | Cabal-Version: >= 1.2 4 | license: MIT 5 | Author: The Epigram Posse 6 | Synopsis: A dependently-typed programming language 7 | Build-Type: Custom 8 | 9 | Executable Pig 10 | Build-Depends: base, mtl, haskell98, pretty, filepath 11 | Main-Is: Main.lhs 12 | Hs-Source-Dirs: src 13 | -------------------------------------------------------------------------------- /models/DescFix.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --type-in-type #-} 2 | 3 | module DescFix where 4 | 5 | open import DescTT 6 | 7 | 8 | aux : (C : Desc)(D : Desc)(P : Mu C -> Set)(x : [| D |] (Mu C)) -> Set 9 | aux C id P (con y) = P (con y) * aux C C P y 10 | aux C (const K) P k = Unit 11 | aux C (prod D D') P (s , t) = aux C D P s * aux C D' P t 12 | aux C (sigma S T) P (s , t) = aux C (T s) P t 13 | aux C (pi S T) P f = (s : S) -> aux C (T s) P (f s) 14 | 15 | 16 | gen : (C : Desc)(D : Desc)(P : Mu C -> Set) 17 | (rec : (y : [| C |] Mu C) -> aux C C P y -> P (con y)) 18 | (x : [| D |] Mu C) -> aux C D P x 19 | gen C id P rec (con x) = rec x (gen C C P rec x) , gen C C P rec x 20 | gen C (const K) P rec k = Void 21 | gen C (prod D D') P rec (s , t) = gen C D P rec s , gen C D' P rec t 22 | gen C (sigma S T) P rec (s , t) = gen C (T s) P rec t 23 | gen C (pi S T) P rec f = \ s -> gen C (T s) P rec (f s) 24 | 25 | 26 | fix : (D : Desc)(P : Mu D -> Set) 27 | (rec : (y : [| D |] Mu D) -> aux D D P y -> P (con y)) 28 | (x : Mu D) -> P x 29 | fix D P rec (con x) = rec x (gen D D P rec x) 30 | 31 | 32 | 33 | plus : Nat -> Nat -> Nat 34 | plus (con (Ze , Void)) n = n 35 | plus (con (Suc , m)) n = suc (plus m n) 36 | 37 | fib : Nat -> Nat 38 | fib = fix NatD (\ _ -> Nat) help 39 | where 40 | help : (m : [| NatD |] Nat) -> aux NatD NatD (\ _ -> Nat) m -> Nat 41 | help (Ze , x) a = suc ze 42 | help (Suc , con (Ze , _)) a = suc ze 43 | help (Suc , con (Suc , con n)) (fib-n , (fib-sn , a)) = plus fib-n fib-sn -------------------------------------------------------------------------------- /models/FMSB.agda: -------------------------------------------------------------------------------- 1 | module FMSB where 2 | 3 | data Nat : Set where 4 | ze : Nat 5 | su : Nat -> Nat 6 | 7 | data Lam (X : Nat -> Set)(n : Nat) : Set where 8 | var : X n -> Lam X n 9 | app : Lam X n -> Lam X n -> Lam X n 10 | lam : Lam X (su n) -> Lam X n 11 | 12 | _->>_ : {I : Set}(X Y : I -> Set) -> Set 13 | X ->> Y = {i : _} -> X i -> Y i 14 | 15 | fmsub : {X Y : Nat -> Set} -> (X ->> Lam Y) -> Lam X ->> Lam Y 16 | fmsub sb (var x) = sb x 17 | fmsub sb (app f s) = app (fmsub sb f) (fmsub sb s) 18 | fmsub sb (lam b) = lam (fmsub sb b) 19 | 20 | data Fin : Nat -> Set where 21 | ze : {n : Nat} -> Fin (su n) 22 | su : {n : Nat} -> Fin n -> Fin (su n) 23 | 24 | D : (Nat -> Set) -> Nat -> Set 25 | D F n = F (su n) 26 | 27 | weak : {F : Nat -> Set} -> (Fin ->> F) -> (F ->> D F) -> 28 | {m n : Nat}-> (Fin m -> F n) -> D Fin m -> D F n 29 | weak v w f ze = v ze 30 | weak v w f (su x) = w (f x) 31 | 32 | _+_ : Nat -> Nat -> Nat 33 | ze + y = y 34 | su x + y = su (x + y) 35 | 36 | _!+_ : (Nat -> Set) -> Nat -> (Nat -> Set) 37 | F !+ n = \ m -> F (m + n) 38 | 39 | weaks : {F : Nat -> Set} -> (Fin ->> F) -> (F ->> D F) -> 40 | {m n : Nat}-> (Fin m -> F n) -> (Fin !+ m) ->> (F !+ n) 41 | weaks v w f {ze} = f 42 | weaks v w f {su i} = weak v w (weaks v w f {i}) 43 | 44 | jing : {m n : Nat} -> Lam Fin (m + n) -> Lam (Fin !+ n) m 45 | jing (var x) = var x 46 | jing (app f s) = app (jing f) (jing s) 47 | jing (lam t) = lam (jing t) 48 | 49 | gnij : {m n : Nat} -> Lam (Fin !+ n) m -> Lam Fin (m + n) 50 | gnij (var x) = var x 51 | gnij (app f s) = app (gnij f) (gnij s) 52 | gnij (lam t) = lam (gnij t) 53 | 54 | ren : {m n : Nat} -> (Fin m -> Fin n) -> Lam Fin m -> Lam Fin n 55 | ren f t = gnij (fmsub (\ {i} x -> var (weaks (\ z -> z) su f {i} x)) {ze} (jing t)) 56 | 57 | sub : {m n : Nat} -> (Fin m -> Lam Fin n) -> Lam Fin m -> Lam Fin n 58 | sub {m}{n} f t = gnij {ze} (fmsub (\ {i} x -> jing {i} (weaks {Lam Fin} var (ren su) f {i} x)) (jing {ze} t)) -------------------------------------------------------------------------------- /models/Prob.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --type-in-type #-} 2 | 3 | module Prob where 4 | 5 | open import DescTT 6 | 7 | mutual 8 | data Sch : Set where 9 | ty : (S : Set) -> Sch 10 | exPi : (s : Sch)(T : toType s -> Sch) -> Sch 11 | imPi : (S : Set)(T : S -> Sch) -> Sch 12 | 13 | toType : Sch -> Set 14 | toType (ty S) = S 15 | toType (exPi s T) = (x : toType s) -> toType (T x) 16 | toType (imPi S T) = (x : S) -> toType (T x) 17 | 18 | 19 | Args : Sch -> Set 20 | Args (ty _) = Unit 21 | Args (exPi s T) = Sigma (toType s) \ x -> Args (T x) 22 | Args (imPi S T) = Sigma S \ x -> Args (T x) 23 | 24 | 25 | postulate 26 | UId : Set 27 | Prp : Set 28 | Prf : Prp -> Set 29 | 30 | data Prob : Set where 31 | label : (u : UId)(s : Sch)(a : Args s) -> Prob 32 | patPi : (u : UId)(S : Set)(p : Prob) -> Prob 33 | hypPi : (p : Prp)(T : Prf p -> Prob) -> Prob 34 | recPi : (rec : Prob)(p : Prob) -> Prob -------------------------------------------------------------------------------- /models/README.Descriptions: -------------------------------------------------------------------------------- 1 | **************************************************************** 2 | Descriptions 3 | **************************************************************** 4 | 5 | 6 | The models of Epigram's universe of descriptions are: 7 | - DescTT.agda: model of descriptions 8 | (with type-in-type) 9 | - Desc.agda: model of descriptions 10 | (with universe polymorphism) 11 | - Desc.v: model of descriptions 12 | (with typical ambiguity) 13 | - DescStrat.agda: model of descriptions, with no fancy stuff 14 | (chopped of at Desc42, 15 | see DescStrat.lhs for cutting at any N) 16 | - IDescTT.agda: model of indexed descriptions 17 | (with type-in-type) 18 | - IDesc.agda: model of indexed descriptions 19 | (with universe polymorphism) 20 | 21 | Each of these file is self-contained: we build our own equipment for 22 | Sigma-type, sums, and equality. This corresponds to the requirements 23 | we have in the paper wrt. the underlying type-theory (excepted for 24 | equality and Pi-types, which we inherit from Agda). 25 | 26 | 27 | These files follow the plan of the paper: 28 | 29 | * Desc.agda implements the universe of inductive types, Desc, the 30 | examples, and generic constructions of Section 3 and 4. 31 | 32 | * DescTT.agda is similar to Desc.agda, excepted that the hierarchy of 33 | Sets is collapsed by --type-in-type. 34 | 35 | * IDescTT.agda implements the universe of inductive families, IDesc, 36 | the examples, and generic constructions of Section 5. 37 | 38 | * IDesc.agda is the stratified implementation of indexed 39 | descriptions. We also describe IDesc in itself and prove that it is 40 | isomorphic to the host one. 41 | 42 | 43 | As shown by Desc.agda and IDesc.agda, --type-in-type is not necessary 44 | for DescTT.agda and IDescTT.agda. But the *TT version make prototyping 45 | easier, as the universe polymorphic version is cluttered with lifting 46 | operations and implicit levels that requires extreme care. -------------------------------------------------------------------------------- /papers/containers-for-dummies/Makefile: -------------------------------------------------------------------------------- 1 | MAIN = containers 2 | 3 | ################ 4 | #### PDFLaTeX 5 | 6 | LATEXC = pdflatex 7 | LATEXOPTS = #-interaction=nonstopmode 8 | 9 | 10 | containers : $(MAIN).tex $(MAIN).bib 11 | $(LATEXC) $(LATEXOPTS) $(MAIN) 12 | bibtex $(MAIN) 13 | $(LATEXC) $(LATEXOPTS) $(MAIN) 14 | if egrep Rerun $(MAIN).log; then $(LATEXC) $(LATEXOPTS) $(MAIN); fi 15 | -------------------------------------------------------------------------------- /papers/icfp-2010-desc/Makefile: -------------------------------------------------------------------------------- 1 | ################ 2 | #### PDFLaTeX 3 | 4 | PDFTEX = pdflatex 5 | PSTEX = latex 6 | LATEXOPTS = #-interaction=nonstopmode 7 | 8 | 9 | ################ 10 | ## Sources 11 | 12 | SRCS=paper.tex 13 | DEPS := $(wildcard *.tex) 14 | 15 | ################ 16 | ## Make machinery 17 | 18 | .SUFFIXES : .tex .pdf .ps 19 | 20 | DOCPS := $(SRCS:.tex=.pdf) 21 | DOCPDF := $(SRCS:.tex=.ps) 22 | 23 | .tex.pdf: 24 | $(PDFTEX) $< 25 | bibtex $* 26 | $(PDFTEX) $< 27 | if egrep Rerun $*.log; then $(PDFTEX) $< ; fi 28 | 29 | .tex.ps: 30 | $(PSTEX) $< 31 | bibtex $* 32 | $(PSTEX) $< 33 | if egrep Rerun $*.log; then $(PSTEX) $< ; fi 34 | dvips -t letter $*.dvi 35 | 36 | ################ 37 | ## Targets 38 | 39 | all: paper 40 | 41 | paper.pdf: $(DEPS) pig.sty paper.bib 42 | 43 | paper.ps: $(DEPS) pig.sty paper.bib 44 | 45 | paper: $(DOCPDF) $(DOCPS) 46 | 47 | 48 | -------------------------------------------------------------------------------- /papers/icfp-2010-desc/figure_finite_sets.tex: -------------------------------------------------------------------------------- 1 | \[\stkc{ 2 | %% UId 3 | \Rule{\Gamma \vdash \Valid} 4 | {\Gamma \vdash \Type{\UId}} 5 | \qquad 6 | %% Tag 7 | \Rule{\Gamma \vdash \Valid} 8 | {\Gamma \vdash \Bhab{\Tag{\V{s}}}{\UId}}\;\V{s} \mbox{ unique identifier} 9 | \\ 10 | %% EnumU 11 | \Rule{\Gamma \vdash \Valid} 12 | {\Gamma \vdash \Type{\EnumU}} 13 | \qquad 14 | %% EnumT 15 | \Rule{\Gamma \vdash \Bhab{\V{e}}{\EnumU}} 16 | {\Gamma \vdash \Type{\EnumT{\V{e}}}} 17 | \\ 18 | %% NilE 19 | \Rule{\Gamma \vdash \Valid} 20 | {\Gamma \vdash \Bhab{\NilE}{\EnumU}} 21 | \qquad 22 | %% ConsE 23 | \Rule{\Gamma \vdash \Bhab{\V{t}}{\UId} \quad 24 | \Gamma \vdash \Bhab{\V{e}}{\EnumU}} 25 | {\Gamma \vdash \Bhab{\ConsE{\V{t}}{\V{e}}}{\EnumU}} 26 | \\ 27 | %% Ze 28 | \Rule{\Gamma \vdash \Valid} 29 | {\Gamma \vdash \Bhab{\Ze}{\EnumT{\ConsE{\V{t}}{\V{e}}}}} 30 | \qquad 31 | %% Su 32 | \Rule{\Gamma \vdash \Bhab{\V{n}}{\EnumT{\V{e}}}} 33 | {\Gamma \vdash \Bhab{\Su{\V{n}}}{\EnumT{\ConsE{\V{t}}{\V{e}}}}} 34 | }\] 35 | -------------------------------------------------------------------------------- /papers/icfp-2010-desc/figure_judgemental_equality.tex: -------------------------------------------------------------------------------- 1 | \[\stkc{ 2 | %% %% Reflexivity 3 | %% \Rule{\Gamma \vdash \Bhab{x}{T}} 4 | %% {\Gamma \vdash \Bhab{x \equiv x}{T}} 5 | %% \qquad 6 | %% %% Symmetry 7 | %% \Rule{\Gamma \vdash \Bhab{x \equiv y}{T}} 8 | %% {\Gamma \vdash \Bhab{y \equiv x}{T}} 9 | %% \qquad 10 | %% %% Transitivity 11 | %% \Rule{\stkl{\Gamma \vdash \Bhab{z \equiv y}{T} \\ 12 | %% \Gamma \vdash \Bhab{y \equiv z}{T} }} 13 | %% {\Gamma \vdash \Bhab{x \equiv z}{T}} 14 | %% \\ 15 | %% Beta-reduction 16 | \Rule{\stkl{\Gamma \vdash \Type{\M{S}} \quad 17 | \Gamma ; \xS \vdash \Bhab{\M{t}}{\M{T}} \\ 18 | \Gamma \vdash \Bhab{\M{s}}{\M{S}}}} 19 | {\Gamma \vdash \Bhab{(\PLAM{\x}{\M{S}} \M{t})\:\M{s} \equiv \M{t}[\M{s}/\x]}{\M{T}[\M{s}/\x]}} 20 | \\ 21 | %% Xi rule 22 | %% \Rule{\Gamma \vdash \Type{S} \quad 23 | %% \Gamma ; \xS \vdash \Bhab{t \equiv t'}{T}} 24 | %% {\Gamma \vdash \Bhab{(\PLAM{\x}{S} t) \equiv (\PLAM{\x}{S} t')}{\PIS{\xS} T}} 25 | %% \\ 26 | %% Projections 27 | \Rule{\stkl{\Gamma \vdash \Bhab{\M{s}}{\M{S}} \quad 28 | \Gamma ; \xS \vdash \Bhab{\M{T}}{\Set} \\ 29 | \Gamma ; \Bhab{\M{s}}{\M{S}} \vdash \Bhab{\M{t}}{\M{T}[\M{s}/\x]}}} 30 | {\Gamma \vdash \Bhab{\fst{(\pair{\M{s}}{\M{t}}{\x.\M{T}})} \equiv \M{s}}{\M{S}}} 31 | \qquad 32 | \Rule{\stkl{\Gamma \vdash \Bhab{\M{s}}{\M{S}} \quad 33 | \Gamma ; \xS \vdash \Bhab{\M{T}}{\Set} \\ 34 | \Gamma ; \Bhab{\M{s}}{\M{S}} \vdash \Bhab{\M{t}}{\M{T}[\M{s}/\x]}}} 35 | {\Gamma \vdash \Bhab{\snd{(\pair{\M{s}}{\M{t}}{\x.\M{T}})} \equiv \M{t}}{\M{T}[\M{s}/\x]}} 36 | }\] 37 | -------------------------------------------------------------------------------- /papers/icfp-2010-desc/figure_type_synthesis.tex: -------------------------------------------------------------------------------- 1 | \[\stkc{ 2 | %% Form 3 | \boxed{\Gamma \Vdash \propag{\exprEx}{\pull{\CN{term}}{\CN{type}}}} 4 | \\ 5 | \\ 6 | %% Reversal 7 | \Rule{\Gamma \Vdash \propag{\push{T}{\Set}} 8 | {T'} \quad 9 | \Gamma \Vdash \propag{\push{t}{T'}} 10 | {t'}} 11 | {\Gamma \Vdash \propag{(\Bhab{t}{T})} 12 | {\pull{t'}{T'}}} 13 | \\ 14 | %% Context 15 | \Rule{\Gamma ; \xS ; \Delta \vdash \Valid} 16 | {\Gamma ; \xS ; \Delta \Vdash \propag{\x} 17 | {\pull{\x}{\M{S}}}} 18 | \qquad 19 | %% Application 20 | \Rule{\stkl{\Gamma \Vdash \propag{\M{f}} 21 | {\pull{\M{f}\M{'}}{\PIS{\xS}{\M{T}}}} \\ 22 | \Gamma \Vdash \propag{\push{\M{s}}{\M{S}}} 23 | {\M{s'}}}} 24 | {\Gamma \Vdash \propag{\M{f}\: \M{s}}{\pull{\M{f'}\: \M{s'}}{\M{T} [\M{s'}/\x]}}} 25 | \\ 26 | %% First projection 27 | \Rule{\Gamma \Vdash \propag{\M{p}} 28 | {\pull{\M{p'}}{\SIGMAS{\xS}{\M{T}}}}} 29 | {\Gamma \Vdash \propag{\fst{\M{p}}} 30 | {\pull{\fst{\M{p'}}}{\M{S}}}} \qquad 31 | %% Second projection 32 | \Rule{\Gamma \Vdash \propag{\M{p}} 33 | {\pull{\M{p'}}{\SIGMAS{\xS}{\M{T}}}}} 34 | {\Gamma \Vdash \propag{\snd{\M{p}}} 35 | {\pull{\snd{\M{p'}}}{\M{T} [\fst{\M{p'}}/\x]}}} 36 | }\] 37 | -------------------------------------------------------------------------------- /papers/icfp-2010-desc/icfp23l-dagand.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/papers/icfp-2010-desc/icfp23l-dagand.pdf -------------------------------------------------------------------------------- /papers/icfp-2010-talk/Levitation.agda: -------------------------------------------------------------------------------- 1 | module Levitation where 2 | 3 | open import Data.Product 4 | 5 | record ⊤ : Set1 where 6 | constructor tt 7 | 8 | 9 | data Desc : Set2 where 10 | `1 : Desc 11 | `Σ : (S : Set1)(D : S → Desc) → Desc 12 | `ind× : (D : Desc) → Desc 13 | `hind× : (H : Set)(D : Desc) → Desc 14 | 15 | ⟦_⟧ : Desc → Set1 → Set1 16 | ⟦ `1 ⟧ X = ⊤ 17 | ⟦ `Σ S D ⟧ X = Σ S (\s → ⟦ D s ⟧ X) 18 | ⟦ `ind× D ⟧ X = X × ⟦ D ⟧ X 19 | ⟦ `hind× H D ⟧ X = (H → X) × ⟦ D ⟧ X 20 | 21 | data Mu (D : Desc) : Set1 where 22 | con : ⟦ D ⟧ (Mu D) → Mu D 23 | 24 | data DescDConst : Set1 where 25 | ``1 : DescDConst 26 | ``Σ : DescDConst 27 | ``ind× : DescDConst 28 | ``hind× : DescDConst 29 | 30 | DescDChoice : DescDConst → Desc 31 | DescDChoice ``1 = `1 32 | DescDChoice ``Σ = `Σ Set (\S → `hind× S `1) 33 | DescDChoice ``ind× = `ind× `1 34 | DescDChoice ``hind× = `Σ Set (\_ → `ind× `1) 35 | 36 | DescD : Desc 37 | DescD = `Σ DescDConst DescDChoice 38 | 39 | Desc' : Set1 40 | Desc' = Mu DescD 41 | 42 | `1' : Desc' 43 | `1' = con (``1 , tt) 44 | 45 | `Σ' : (S : Set)(D : S → Desc') → Desc' 46 | `Σ' S D = con (``Σ , (S , (D , tt))) 47 | 48 | `ind×' : (D : Desc') → Desc' 49 | `ind×' D = con (``ind× , (D , tt)) 50 | 51 | `hind×' : (H : Set)(D : Desc') → Desc' 52 | `hind×' H D = con (``hind× , (H , (D , tt))) -------------------------------------------------------------------------------- /papers/icfp-2010-talk/Makefile: -------------------------------------------------------------------------------- 1 | ################ 2 | #### PDFLaTeX 3 | 4 | PDFTEX = pdflatex 5 | 6 | ################ 7 | ## Sources 8 | 9 | SRCS=levitation.tex 10 | DEPS := $(wildcard *.tex) pig.sty 11 | 12 | ################ 13 | ## Make machinery 14 | 15 | .SUFFIXES : .tex .pdf 16 | 17 | DOCPDF := $(SRCS:.tex=.pdf) 18 | 19 | .tex.pdf: 20 | $(PDFTEX) $< 21 | $(PDFTEX) $< 22 | if egrep Rerun $*.log; then $(PDFTEX) $< ; fi 23 | 24 | ################ 25 | ## Targets 26 | 27 | all: levitation 28 | 29 | levitation.pdf: $(DEPS) 30 | 31 | levitation: $(DOCPDF) 32 | 33 | 34 | -------------------------------------------------------------------------------- /papers/icfp-2010-talk/levitation.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/papers/icfp-2010-talk/levitation.pdf -------------------------------------------------------------------------------- /papers/stratisfaction/Makefile: -------------------------------------------------------------------------------- 1 | ################ 2 | #### PDFLaTeX 3 | 4 | TEX = pdflatex 5 | 6 | ################ 7 | ## Sources 8 | 9 | SRCS=paper.tex 10 | DEPS := $(wildcard figure_*.tex) 11 | 12 | 13 | ################ 14 | ## Make machinery 15 | 16 | .SUFFIXES : .tex .pdf 17 | 18 | DOC := $(SRCS:.tex=.pdf) 19 | 20 | .tex.pdf: 21 | $(TEX) $< 22 | if egrep "\bibliography" $<; then bibtex $*; fi 23 | $(TEX) $< 24 | if egrep Rerun $*.log; then $(TEX) $< ; fi 25 | 26 | ################ 27 | ## Targets 28 | 29 | all: paper 30 | 31 | paper.pdf: $(DEPS) pig.sty Macros.tex stratisfaction.bib 32 | 33 | paper: $(DOC) 34 | 35 | -------------------------------------------------------------------------------- /papers/stratisfaction/figure_ecce.tex: -------------------------------------------------------------------------------- 1 | $$ 2 | \stkc{ 3 | %% Form 4 | \boxed{\Gamma \vdash \Bhab{\CN{term}}{\CN{type}}} 5 | \\ 6 | \\ 7 | %% Set 8 | \AxiomSide{\ruleName{Set}{0}}{\Bhab{\Set{i}}{\Set{i+1}}} 9 | \qquad 10 | %% Arrow 11 | \RuleSide{\Bhab{S}{\Set{i}} \quad 12 | \Bhab{x}{S} \vdash \Bhab{T}{\Set{i}}} 13 | {\ruleName{Pi}{0}} 14 | {\Bhab{\PI{\V{x}}{S}{T}}{\Set{i}}} 15 | \\ 16 | %% Inhabitant of Arrow 17 | \RuleSide{\Bhab{x}{S} \vdash \Bhab{b}{T} } 18 | {\ruleName{Lam}{0}} 19 | {\Bhab{\LAM{\V{x}_S}{b}}{\PI{\V{x}}{S}{T}}} 20 | \\ 21 | %% Variable extraction 22 | \AxiomSide{\ruleName{Var}{0}}{\Bhab{x}{A} \vdash \Bhab{x}{A}} 23 | \qquad 24 | %% Type ascription 25 | \RuleSide{\Bhab{T}{\SetTop} \quad 26 | \Bhab{t}{T}} 27 | {\ruleName{Asc}{0}} 28 | {\Bhab{(\Bhab{t}{T})}{T}} 29 | \qquad 30 | %% Function application 31 | \RuleSide{\Bhab{f}{\PI{\V{x}}{S}{T}} \quad 32 | \Bhab{s}{A}} 33 | {\ruleName{App}{0}} 34 | {\Bhab{f\: s}{T[s/x]}} 35 | \\ 36 | %% Conversion 37 | \RuleSide{\Bhab{M}{A} \quad 38 | \Bhab{A \Eq B}{\Set{i}}} 39 | {\ruleName{Conv}{0}} 40 | {\Bhab{M}{B}} 41 | \\ 42 | %% Set equality 43 | \AxiomSide{\ruleName{Set-Eq}{0}}{\Bhab{\Set{i} \Eq \Set{i}}{\SetTop}} 44 | \\ 45 | %% Variable equality 46 | \AxiomSide{\ruleName{Var-Eq}{0}}{\Bhab{x}{S} \vdash \Bhab{x \Eq x}{S}} 47 | \\ 48 | %% Pi equality 49 | \RuleSide{\Bhab{S_1 \Eq S_2}{\SetTop} \quad 50 | \Bhab{x}{S_2} \vdash \Bhab{T_1 \Eq T_2}{\SetTop}} 51 | {\ruleName{Pi-Eq}{0}} 52 | {\Bhab{\PI{\V{x}}{S_1}{T_1} \Eq 53 | \PI{\V{x}}{S_2}{T_2}}{\SetTop}} 54 | \\ 55 | %% Function equality 56 | \RuleSide{\Bhab{x}{S} \vdash \Bhab{f\: x \Eq g\: x}{T}} 57 | {\ruleName{Lam-Eq}{0}} 58 | {\Bhab{f \Eq g}{\PI{\V{x}}{S}{T}}} 59 | \\ 60 | %% Application equality 61 | \RuleSide{\Bhab{f \Eq g}{\PI{\V{x}}{S}{T}} \quad 62 | \Bhab{a \Eq b}{S}} 63 | {\ruleName{App-Eq}{0}} 64 | {\Bhab{f\: a \Eq g\: b}{T[b/x]}} 65 | \\ 66 | %% Cumulativity 67 | \RuleSide{\Bhab{M}{A}} 68 | {\ruleName{Cuml}{0}} 69 | {\Bhab{M}{\Up{}{A}}} 70 | } 71 | $$ 72 | -------------------------------------------------------------------------------- /papers/stratisfaction/figure_infuse.tex: -------------------------------------------------------------------------------- 1 | \subfigure[Algorithm: cumulative push-side]{ 2 | $$ 3 | \stkc{ 4 | %% Form 5 | \boxed{\Gamma \vdash \pushN{\CN{term}}{2}{\CN{type}}} 6 | \\ 7 | \\ 8 | %% Set 9 | \AxiomSide{i {- 2 | 3 | \subsection{Traversable Foldable Functors} 4 | 5 | This is all just boilerplate. Roll on GHC 6.12! 6 | 7 | > instance Traversable Ty where 8 | > traverse g (V x) = V <$> (g x) 9 | > traverse g (s :-> t) = (:->) <$> (traverse g s) <*> (traverse g t) 10 | > 11 | > instance Functor Ty where 12 | > fmap = fmapDefault 13 | > 14 | > instance Foldable Ty where 15 | > foldMap = foldMapDefault 16 | 17 | 18 | > instance Functor Tm where 19 | > fmap g (X x) = X (g x) 20 | > fmap g (f :$ a) = fmap g f :$ fmap g a 21 | > fmap g (Lam x t) = Lam (g x) (fmap g t) 22 | > fmap g (Let x s t) = Let (g x) (fmap g s) (fmap g t) 23 | 24 | 25 | > instance Traversable Index where 26 | > traverse f Z = pure Z 27 | > traverse f (S a) = S <$> f a 28 | > 29 | > instance Functor Index where 30 | > fmap = fmapDefault 31 | > 32 | > instance Foldable Index where 33 | > foldMap = foldMapDefault 34 | 35 | 36 | > instance Traversable Schm where 37 | > traverse f (Type tau) = Type <$> traverse f tau 38 | > traverse f (All sigma) = All <$> traverse (traverse f) sigma 39 | > traverse f (LetS sigma sigma') = LetS <$> traverse f sigma 40 | > <*> traverse (traverse f) sigma' 41 | > 42 | > instance Functor Schm where 43 | > fmap = fmapDefault 44 | > 45 | > instance Foldable Schm where 46 | > foldMap = foldMapDefault 47 | 48 | > instance Functor Fwd where 49 | > fmap = fmapDefault 50 | 51 | > instance Foldable Fwd where 52 | > foldMap = foldMapDefault 53 | 54 | > instance Traversable Fwd where 55 | > traverse f F0 = pure F0 56 | > traverse f (e :> es) = (:>) <$> f e <*> traverse f es 57 | 58 | > -} -------------------------------------------------------------------------------- /papers/ydtm-rev/Makefile: -------------------------------------------------------------------------------- 1 | ################ 2 | #### PDFLaTeX 3 | 4 | PDFTEX = pdflatex 5 | PSTEX = latex 6 | LATEXOPTS = #-interaction=nonstopmode 7 | 8 | 9 | ################ 10 | ## Sources 11 | 12 | SRCS=ydtm-rev.tex 13 | DEPS := $(wildcard *.tex) 14 | BIBS := $(wildcard *.bib) 15 | 16 | ################ 17 | ## Make machinery 18 | 19 | .SUFFIXES : .tex .pdf .ps 20 | 21 | DOCPS := $(SRCS:.tex=.pdf) 22 | DOCPDF := $(SRCS:.tex=.ps) 23 | 24 | .tex.pdf: 25 | $(PDFTEX) $< 26 | bibtex $* 27 | $(PDFTEX) $< 28 | if egrep Rerun $*.log; then $(PDFTEX) $< ; fi 29 | 30 | .tex.ps: 31 | $(PSTEX) $< 32 | bibtex $* 33 | $(PSTEX) $< 34 | if egrep Rerun $*.log; then $(PSTEX) $< ; fi 35 | dvips -t letter $*.dvi 36 | 37 | ################ 38 | ## Targets 39 | 40 | all: paper 41 | 42 | paper.pdf: $(DEPS) pig.sty $(BIBS) 43 | 44 | paper.ps: $(DEPS) pig.sty $(BIBS) 45 | 46 | paper: $(DOCPDF) $(DOCPS) 47 | 48 | 49 | -------------------------------------------------------------------------------- /papers/ydtm-rev/fontlock.sty: -------------------------------------------------------------------------------- 1 | \usepackage{color} 2 | \newcommand{\red}[1]{\textcolor[rgb]{0.6,0,0}{#1}} 3 | \newcommand{\green}[1]{\textcolor[rgb]{0,0.4,0}{#1}} 4 | \newcommand{\blue}[1]{\textcolor[rgb]{0,0,0.8}{#1}} 5 | \newcommand{\orange}[1]{\textcolor[rgb]{0.8,0.4,0}{#1}} 6 | \newcommand{\purple}[1]{\textcolor[rgb]{0.4,0,0.4}{#1}} 7 | \newcommand{\yellow}[1]{\textcolor{yellow}{#1}} 8 | \newcommand{\brown}[1]{\textcolor[rgb]{0.5,0.2,0.2}{#1}} 9 | \newcommand{\black}[1]{\textcolor[rgb]{0,0,0}{#1}} 10 | \newcommand{\white}[1]{\textcolor[rgb]{1,1,1}{#1}} 11 | \newcommand{\yellowBG}[1]{\colorbox[rgb]{1,1,0.2}{#1}} 12 | \newcommand{\brownBG}[1]{\colorbox[rgb]{1.0,0.7,0.4}{#1}} 13 | -------------------------------------------------------------------------------- /papers/ydtm-rev/obsdec.bib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/papers/ydtm-rev/obsdec.bib -------------------------------------------------------------------------------- /papers/ydtm-rev/ydtm.bib: -------------------------------------------------------------------------------- 1 | @Misc{alti:ydtm, 2 | author = {Thorsten Altenkirch and Conor McBride and James McKinna}, 3 | title = {Why Dependent Types Matter}, 4 | howpublished = {Manuscript, available online}, 5 | month = {April}, 6 | year = {2005}, 7 | } 8 | 9 | -------------------------------------------------------------------------------- /send-line.el: -------------------------------------------------------------------------------- 1 | (defun send-line () 2 | "Send line to other window" 3 | (interactive) 4 | (kill-ring-save (line-beginning-position) 5 | (line-end-position)) 6 | (other-window 1) 7 | (goto-char (point-max)) 8 | (yank) 9 | (comint-send-input) 10 | (other-window 1) 11 | (forward-line 1) 12 | (message "Line executed")) 13 | 14 | (global-set-key "\C-c\C-r" 'send-line) 15 | 16 | (defun send-undo () 17 | "Send undo to other window" 18 | (interactive) 19 | (other-window 1) 20 | (goto-char (point-max)) 21 | (insert "undo") 22 | (comint-send-input) 23 | (other-window 1) 24 | (forward-line -1) 25 | (message "Undone")) 26 | 27 | (global-set-key "\C-c\C-u" 'send-undo) -------------------------------------------------------------------------------- /src/Cochon/Introduction.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/src/Cochon/Introduction.tex -------------------------------------------------------------------------------- /src/Compiler/Introduction.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/src/Compiler/Introduction.tex -------------------------------------------------------------------------------- /src/Detritus/Construction.lhs: -------------------------------------------------------------------------------- 1 | \section{Construction} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | > {-# LANGUAGE TypeOperators, GADTs, KindSignatures, RankNTypes, 7 | > TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-} 8 | 9 | > module Construction where 10 | 11 | > import Control.Applicative 12 | > import Data.Foldable hiding (foldl) 13 | > import Data.Traversable 14 | > import Data.Either 15 | > import Control.Monad 16 | > import MissingLibrary 17 | > import BwdFwd 18 | > import Features 19 | > import Tm 20 | > import Root 21 | > import Rules 22 | 23 | > type Cxty x = (Bwd REF, ENV) -> Root -> x 24 | 25 | > deb :: REF -> Cxty EXTM 26 | > deb x (g, _) _ = V (vf g) where 27 | > vf (g :< s) | x == s = 0 28 | > | otherwise = 1 + vf g 29 | > vf _ = error "discharging non var in Construction" 30 | 31 | > cLam :: String -> (REF -> TY -> Cxty INTM) -> TY -> Cxty INTM 32 | > cLam n f (PI s t) (g, e) = freshRef (n :<: s) $ \ x -> 33 | > f x (t $$ A (pval x)) (g :< x, e :< pval x) 34 | 35 | I think that this is useless, thanks to the shining tactics. 36 | 37 | > {- 38 | > cC :: Can (TY -> Cxty INTM) -> TY -> Cxty INTM 39 | > cC ca (C ty) g@@(_, e) r = C tm where 40 | > Just tm = canTy (\ y k -> let t = k y g r in (t, eval t e)) (ty :>: ca) 41 | > -} 42 | 43 | %endif 44 | -------------------------------------------------------------------------------- /src/Detritus/Elaborator.lhs: -------------------------------------------------------------------------------- 1 | 2 | > elabbedV :: VAL -> ProofState (INTM :=>: VAL) 3 | > elabbedV v = do 4 | > t <- bquoteHere v 5 | > return (t :=>: v) 6 | 7 | 8 | \subsection{$\lambda$-lifting} 9 | 10 | The |gimme| operator elaborates every definition in the proof state, thereby 11 | ensuring it is fully $\lambda$-lifted. Starting from the root of the proof 12 | state, it processes each node in turn, first processing any children, then 13 | the node itself. 14 | 15 | > gimme = much goOut >> processNode 16 | > where 17 | > processNode :: ProofState () 18 | > processNode = do 19 | > optional (do 20 | > goIn 21 | > much goUp 22 | > processNode 23 | > much (goDown >> processNode) 24 | > goOut 25 | > ) 26 | > regive 27 | > 28 | > regive :: ProofState () 29 | > regive = do 30 | > tip <- getDevTip 31 | > m <- getMother 32 | > case {- |trace ("regive " ++ show (motherName m)) $| -} tip of 33 | > Defined tm (tipTyTm :=>: tipTy) -> do 34 | > putDevTip (Unknown (tipTyTm :=>: tipTy)) 35 | > (tm' :=>: tv) <- elaborate True (tipTy :>: tm) 36 | > Unknown tt <- getDevTip 37 | > putDevTip (Defined tm' tt) 38 | > _ -> return () 39 | 40 | 41 | \section{Elab Monad} 42 | 43 | > data Elab x 44 | > = Bale x 45 | > | Cry 46 | > | Hope 47 | > | EDef String INTM (Elab INTM) (VAL -> Elab x) 48 | > | ELam String (VAL -> Elab x) 49 | > | EPi String INTM (VAL -> Elab x) 50 | 51 | > instance Monad Elab where 52 | > return = Bale 53 | > Bale x >>= k = k x 54 | > Cry >>= k = Cry 55 | > Hope >>= k = Hope 56 | > EDef x y d f >>= k = EDef x y d ((k =<<) . f) 57 | > ELam x f >>= k = ELam x ((k =<<) . f) 58 | > EPi x y f >>= k = EPi x y ((k =<<) . f) 59 | > 60 | > instance Functor Elab where 61 | > fmap = ap . return 62 | > 63 | > instance Applicative Elab where 64 | > pure = return 65 | > (<*>) = ap -------------------------------------------------------------------------------- /src/Detritus/Features.lhs: -------------------------------------------------------------------------------- 1 | > import -> ElaborateRules where 2 | > elaborate top (PROP :>: DEqBlue t u) = do 3 | > ((ttm :=>: tv) :<: tty, _) <- elabInfer t 4 | > ((utm :=>: uv) :<: uty, _) <- elabInfer u 5 | > tty' <- bquoteHere tty 6 | > uty' <- bquoteHere uty 7 | > return ((EQBLUE (tty' :>: N ttm) (uty' :>: N utm)) 8 | > :=>: (EQBLUE (tty :>: tv) (uty :>: uv))) -------------------------------------------------------------------------------- /src/Detritus/Fibonacci.pig: -------------------------------------------------------------------------------- 1 | -- Let's prove substitutivity, symmetry and transitivity of equality: 2 | make ship : (X : Set)(x : X)(y : X)(q : :- x == y)(P : X -> Set) -> P x -> P y ; 3 | lambda X, x, y, q, P, px ; 4 | give coe (P x) (P y) ?q px ; 5 | give con (refl (X -> Set) P % x y _) ; 6 | root ; 7 | 8 | make sym := (\ S s t q -> ship S s t _ (\ x -> :- x == s) _) : (S : Set)(s : S)(t : S) -> :- s == t -> :- t == s ; 9 | make trans := (\ S s t u q r -> ship S t s (sym S s t _) (\ x -> :- x == u) r) : (S : Set)(s : S)(t : S)(u : S) -> :- s == t -> :- t == u -> :- s == u ; 10 | 11 | 12 | 13 | 14 | <= [xf] NatCase k ; 15 | = 'suc 'zero ; 16 | <= [xf] NatCase xf^2 ; 17 | = 'suc 'zero ; 18 | 19 | -- Unfortunately, our implementation of elimination with a motive is currently 20 | -- unable to simplify the hypothesis, so we have to extract the justification 21 | -- for the recursive calls by hand. 22 | make rec := ship Nat k ('suc ('suc xf^1)) ? (aux P^2) xf^5 : _ ; 23 | next ; 24 | give trans Nat k ('suc xf^6) ('suc ('suc xf^1)) ? ? ; 25 | give sym Nat ('suc xf^6) k xf^4 ; 26 | give sym Nat ('suc xf^1) xf^6 xf ; 27 | out ; 28 | out ; 29 | 30 | -- Having done that, we can make the recursive call. We need a blunderbuss to 31 | -- deal with finding the labelled types! 32 | = plus (fib xf^1) (fib ('suc xf^1)) ; 33 | give rec - ! ; 34 | give rec ! ; 35 | -------------------------------------------------------------------------------- /src/Detritus/Foo.pig: -------------------------------------------------------------------------------- 1 | S : Set -> Set where 2 | \ X 3 | = X 4 | T : Set where 5 | = S Set 6 | 7 | -------------------------------------------------------------------------------- /src/Detritus/IDesc.lhs: -------------------------------------------------------------------------------- 1 | > makeElab loc (SET :>: DIMU Nothing iI d i) = do 2 | > GirlMother (nom := HOLE _ :<: ty) _ _ _ <- getMother 3 | > let fr = nom := FAKE :<: ty 4 | > xs <- getBoys 5 | > guard (not (null xs)) 6 | > let lt = N (P fr $:$ (map (\x -> A (N (P x))) (init xs))) 7 | > let lv = evTm lt 8 | > (iI :=>: iIv) <- elaborate False (SET :>: iI) 9 | > (d :=>: dv) <- elaborate False (ARR iIv (IDESC iIv) :>: d) 10 | > (i :=>: iv) <- elaborate False (iIv :>: i) 11 | > lastIsIndex <- withNSupply (equal (SET :>: (iv,N (P (last xs))))) 12 | > guard lastIsIndex 13 | > -- should check i doesn't appear in d (fairly safe it's not in iI :)) 14 | > return (IMU (Just lt) iI d i :=>: IMU (Just lv) iIv dv iv) -------------------------------------------------------------------------------- /src/Detritus/Language.tex: -------------------------------------------------------------------------------- 1 | 2 | \begin{itemize} 3 | \item \verb!*! for the universe of sets 4 | \item \verb!#! for the universe of propositions 5 | \item \verb|()| for the unit type 6 | \item \verb!\ x -> t! for the $\lambda$-term $\lambda x.t$ 7 | \item \verb|f a| for $f$ applied to $a$ (no surprises here) 8 | \item \verb!(x : S) -> T! for the $\Pi$-type $\Pi x:S. T$ 9 | \item \verb!S -> T! for the same $\Pi$-type if $T$ is independent of $x$ 10 | \item \verb!(x : S)(y : T) -> U! for the nested $\Pi$-type $\Pi x:S. \Pi y:T. U$ 11 | \item \verb!{| P}! for the type of proofs of $P$ (cf.\ set notation) 12 | \item \verb!{x : S | P}! for the $\Sigma$-type $\Sigma x:S. P$ 13 | \item \verb!{x : S, y : T | P}! for the nested $\Sigma$-type $\Sigma x:S. \Sigma y:T. P$ 14 | \item \verb![a, b, c]! for the tuple $(a, (b, (c, ())))$ (think LISP lists) 15 | \item \verb![a, c, c |]! for the tuple $(a, (b, c))$ (maybe?) 16 | \item \verb!Enum! for the universe of enumerations 17 | \item \verb!{}! for the empty enumerated type 18 | \item \verb!{x, y, z}! for an enumerated type 19 | \item \verb!0, 1, 2, ...! for \verb!zero!, \verb!suc zero!, \verb!suc (suc zero)!, et cetera 20 | \item \verb!2 + tm! for \verb!suc (suc tm)! 21 | \item \verb!@id! for a tag 22 | \item \verb!F(..., ...)! for a fully applied operator 23 | \end{itemize} 24 | 25 | \question{Does this notation for $\Sigma$-types make sense, or should we go with the 26 | original proposal of using an ampersand?} 27 | 28 | \question{Perhaps we could use $[a, b, c, ]$ with a trailing comma to mean 29 | $(a, (b, c))$? Using a vertical bar is problematic because it clashes with the 30 | ``such that'' interpretation.} 31 | -------------------------------------------------------------------------------- /src/Detritus/MakeElab.lhs: -------------------------------------------------------------------------------- 1 | 2 | The |eEnsure| instruction demands that a value should be equal to a canonical 3 | value with the given shape. It returns a term and value with the required shape, 4 | together with a proof that these equal the input. 5 | 6 | > eEnsure :: INTM :=>: VAL -> (Can VAL :>: Can ()) -> Elab (INTM :=>: Can VAL, INTM :=>: VAL) 7 | > eEnsure (tm :=>: C v) (ty :>: t) = case halfZip v t of 8 | > Nothing -> throwError' $ err "eEnsure: halfZip failed!" 9 | > Just _ -> do 10 | > ty' :=>: _ <- eQuote (C ty) 11 | > return (tm :=>: v, N (P refl :$ A ty' :$ A tm) 12 | > :=>: pval refl $$ A (C ty) $$ A (C v)) 13 | > eEnsure (_ :=>: L _) _ = throwError' $ err "eEnsure: failed to match lambda!" 14 | > eEnsure (_ :=>: nv) (ty :>: t) = do 15 | > vu <- unWrapElab $ canTy chev (ty :>: t) 16 | > let v = fmap valueOf vu 17 | > pp <- eHopeFor . PRF $ EQBLUE (C ty :>: nv) (C ty :>: C v) 18 | > return (C (fmap termOf vu) :=>: v, pp) 19 | > where 20 | > chev :: (TY :>: ()) -> WrapElab (INTM :=>: VAL) 21 | > chev (ty :>: ()) = WrapElab (eHopeFor ty) 22 | 23 | 24 | > handleArgs (tm :=>: tv :<: ty) (A a : as) = do 25 | > ty' :=>: _ <- eQuote ty 26 | > (cty :=>: ctyv, q :=>: qv) <- eEnsure (ty' :=>: ty) (Set :>: Pi () ()) 27 | > handleArgs (coe :@ [ty', cty, q, N tm] :=>: coe @@ [ty, C ctyv, qv, tv] :<: C ctyv) (A a : as) 28 | 29 | 30 | > newtype WrapElab x = WrapElab {unWrapElab :: Elab x} 31 | > deriving (Functor, Applicative, Alternative, Monad) 32 | 33 | > instance (MonadError (StackError ())) WrapElab where 34 | > throwError e = WrapElab (throwError [err "WrapElab: cannot unwrap error."]) 35 | > catchError _ _ = WrapElab (throwError [err "WrapElab: cannot catch error."]) 36 | -------------------------------------------------------------------------------- /src/Detritus/Mangler.lhs: -------------------------------------------------------------------------------- 1 | Dead code, waiting to be burried 2 | 3 | \subsection{The Capture mangler} 4 | 5 | Given a list |xs| of |String| parameter names, the |capture| function produces a mangle 6 | that captures those parameters as de Brujin indexed variables. 7 | \question{Do we ever need to do this?} 8 | 9 | < capture :: Bwd String -> Mangle Identity String String 10 | < capture xs = Mang 11 | < { mangP = \ x ies -> (|(either P V (h xs x) $:$) ies|) 12 | < , mangV = \ i ies -> (|(V i $:$) ies|) 13 | < , mangB = \ x -> capture (xs :< x) 14 | < } where 15 | < h B0 x = Left x 16 | < h (ys :< y) x 17 | < | x == y = Right 0 18 | < | otherwise = (|succ (h ys y)|) 19 | -------------------------------------------------------------------------------- /src/Detritus/ProofState.lhs: -------------------------------------------------------------------------------- 1 | > prettyProofState :: ProofState String 2 | > prettyProofState = do 3 | > me <- getMotherName 4 | > gaus <- getGreatAuncles 5 | > ls <- gets fst 6 | > dev <- getDev 7 | > case ls of 8 | > B0 -> return (show (prettyModule gaus me dev)) 9 | > _ :< _ -> return (show (prettyDev gaus me dev)) 10 | -------------------------------------------------------------------------------- /src/Detritus/Relabel.lhs: -------------------------------------------------------------------------------- 1 | > {- proofTrace $ "subst: " ++ show subst 2 | > mapM (\ (ref, val) -> bquoteHere val >>= solveHole ref) subst 3 | > let wtm' = fst $ tellNews (map (\ (n := HOLE Hoping :<: ty, val) -> 4 | > (n := DEFN val :<: ty, GoodNews)) 5 | > subst) wtm -} 6 | 7 | < (q :=>: qv, True) <- runElabHope False (PRF (EQBLUE (s :>: wv) (s :>: a))) 8 | 9 | < tm :=>: _ <- mapStateT (either (Left . (fmap $ fmap $ fmap fst)) Right) 10 | < (match (s :>: (w, a))) 11 | 12 | > match :: TY :>: (InDTmRN, VAL) -> ProofStateT (InDTmRN, VAL) (INTM :=>: VAL) 13 | > match (ty :>: (DNP [(x, Rel 0)], a)) = 14 | > mapStateT (either (Left . error "oh no") Right) $ do 15 | > ty' <- bquoteHere ty 16 | > a' <- bquoteHere a 17 | > make (x :<: ty') 18 | > goIn 19 | > neutralise =<< give a' 20 | > match (C cty :>: (DC dc, C cv)) = case halfZip dc cv of 21 | > Just c -> do 22 | > c' <- canTy match (cty :>: c) 23 | > return $ C (fmap termOf c') :=>: C (fmap valueOf c') 24 | > Nothing -> throwError' $ err "relabel: halfzip failed!" -------------------------------------------------------------------------------- /src/Detritus/RunElab.lhs: -------------------------------------------------------------------------------- 1 | < (p' :=>: p, True) <- runElabHope False 2 | < (PRF (EQBLUE (SET :>: LABEL m u) (SET :>: LABEL l ty))) 3 | 4 | < True <- withNSupply $ equal (SET :>: (u, ty)) 5 | < (p' :=>: p, True) <- runElabHope False 6 | < (PRF (EQBLUE (u :>: m) (ty :>: l))) 7 | 8 | 9 | > m' <- bquoteHere m 10 | > u' <- bquoteHere u 11 | 12 | 13 | < return (N (coe :@ [LABEL m' u', LABEL l' ty', p', tm']) 14 | < :=>: coe @@ [LABEL m u, LABEL l ty, p, tm], True) 15 | 16 | < return (N (coe :@ [LABEL m' u', LABEL l' ty', CON (PAIR (N (p' :? PRF (EQBLUE (u' :>: m') (ty' :>: l')) :$ Out)) (N (P refl :$ A SET :$ A u'))), tm']) 17 | < :=>: coe @@ [LABEL m u, LABEL l ty, CON (PAIR (p $$ Out) (NP refl $$ A SET $$ A u)), tm], True) 18 | -------------------------------------------------------------------------------- /src/Detritus/Update.lhs: -------------------------------------------------------------------------------- 1 | \section{Update} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | > {-# LANGUAGE TypeOperators #-} 7 | 8 | > module Update where 9 | > 10 | > import Data.Foldable 11 | > import Control.Monad 12 | > import Control.Applicative 13 | > import Data.Traversable 14 | > import Data.Monoid 15 | > import Control.Monad.Writer 16 | 17 | > import BwdFwd 18 | > import Tm 19 | > import Root 20 | > import Developments 21 | 22 | %endif 23 | 24 | > afind :: Eq x => [x] -> x -> Writer Any x 25 | > afind [] y = return y 26 | > afind (x:xs) y = if x == y then tell (Any True) >> return x else afind xs y 27 | 28 | > update :: (Traversable f,Eq x) => [x] -> f x -> Writer Any (f x) 29 | > update xs = traverse (afind xs) 30 | 31 | > updateDev :: [REF] -> Dev -> Writer Any Dev 32 | > updateDev rs d = traverseDev (afind rs) d 33 | -------------------------------------------------------------------------------- /src/DisplayLang/Introduction.lhs: -------------------------------------------------------------------------------- 1 | %if False 2 | 3 | > module DisplayLang.Introduction where 4 | 5 | %endif 6 | 7 | The life cycle of a term in the system looks like this, where vertices are 8 | labelled with the type of a representation, and edges are labelled with the 9 | transformation between representations. 10 | 11 | %% TODO: Rewrite this diagram in Tikz or equivalent 12 | 13 | \begin{verbatim} 14 | Lexer Parser Elaborator 15 | String ---------> [Token] ---------> DInTmRN ----------> INTM 16 | ^ | 17 | | | 18 | | Renderer Pretty-printer Distiller | 19 | +-------------- Doc <------------- DInTmRN <------------+ 20 | \end{verbatim} 21 | 22 | In the beginning was the |String|. This gets lexed (section 23 | \ref{sec:DisplayLang.Lexer}) to produce a list of |Token|s, which are 24 | parsed (section \ref{sec:DisplayLang.TmParse}) to give an |DInTm 25 | RelName| (a term in the display syntax containing relative names). The 26 | display term is then elaborated (section 27 | \ref{sec:Elaborator.Elaborator}) in the |ProofState| monad to produce 28 | an |INTM| (a term in the evidence language). 29 | 30 | Reversing the process, the distiller (section 31 | \ref{sec:Distillation.Distiller}) converts an evidence term back to a 32 | display term, and the pretty-printer (section 33 | \ref{sec:DisplayLang.PrettyPrint}) renders this as a |String|. 34 | 35 | %% TODO: this diagram ought to be quickchecked -------------------------------------------------------------------------------- /src/DisplayLang/Name.lhs: -------------------------------------------------------------------------------- 1 | \section{Relative Names} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | 7 | > module DisplayLang.Name where 8 | 9 | > import Data.List 10 | 11 | > import NameSupply.NameSupply 12 | 13 | > import Evidences.Tm 14 | 15 | > import DisplayLang.DisplayTm 16 | 17 | %endif 18 | 19 | 20 | For display and storage purposes, we have a system of local longnames 21 | for referring to entries. Any component of a local name may have a 22 | \textasciicircum|n| or |_n| suffix, where |n| is an integer, 23 | representing a relative or absolute offset. A relative offset 24 | \textasciicircum|n| refers to the $n^\mathrm{th}$ occurrence of the 25 | name encountered when searching upwards, so |x|\textasciicircum|0| 26 | refers to the same reference as |x|, but |x|\textasciicircum|1| skips 27 | past it and refers to the next thing named |x|. An absolute offset 28 | |_n|, by contrast, refers to the exact numerical component of the 29 | name. 30 | 31 | > data Offs = Rel Int | Abs Int deriving (Show, Eq) 32 | > type RelName = [(String,Offs)] 33 | 34 | As a consequence, there is whole new family of objects: terms which 35 | variables are relative names. So it goes: 36 | 37 | > type InTmRN = InTm RelName 38 | > type ExTmRN = ExTm RelName 39 | > type DInTmRN = DInTm REF RelName 40 | > type DExTmRN = DExTm REF RelName 41 | > type DSPINE = DSpine REF RelName 42 | > type DHEAD = DHead REF RelName 43 | > type DSCOPE = DScope REF RelName 44 | 45 | 46 | 47 | \subsection{Names to strings} 48 | 49 | The |showRelName| function converts a relative name to a string by 50 | inserting the appropriate punctuation. 51 | 52 | > showRelName :: RelName -> String 53 | > showRelName = intercalate "." . map showOffName 54 | > where showOffName (x, Rel 0) = x 55 | > showOffName (x, Rel i) = x ++ "^" ++ show i 56 | > showOffName (x, Abs i) = x ++ "_" ++ show i 57 | 58 | The |showName| function converts an absolute name to a string 59 | absolutely. 60 | 61 | > showName :: Name -> String 62 | > showName = showRelName . map (\(x, i) -> (x, Abs i)) 63 | -------------------------------------------------------------------------------- /src/Distillation/Moonshine.lhs: -------------------------------------------------------------------------------- 1 | \section{The Moonshine distillery} 2 | \label{sec:Distillation.Moonshine} 3 | 4 | %if False 5 | 6 | > {-# OPTIONS_GHC -F -pgmF she #-} 7 | > {-# LANGUAGE GADTs, TypeOperators, PatternGuards #-} 8 | 9 | > module Distillation.Moonshine where 10 | 11 | > import Control.Applicative 12 | > import Data.Traversable 13 | 14 | > import Kit.BwdFwd 15 | 16 | > import ProofState.Edition.ProofState 17 | 18 | > import Distillation.Distiller 19 | 20 | > import DisplayLang.DisplayTm 21 | > import DisplayLang.Name 22 | 23 | > import Evidences.Tm 24 | 25 | %endif 26 | 27 | 28 | \subsection{Moonshining} 29 | 30 | The |moonshine| command attempts the dubious task of converting an 31 | Evidence term (possibly of dubious veracity) into a Display term. 32 | This is mostly for error-message generation. 33 | \question{Presumably |moonshine| should accumulate |Entries| like 34 | |distill| and friends?} 35 | 36 | > moonshine :: INTM -> ProofStateT INTM DInTmRN 37 | > moonshine (LK t) = do 38 | > t' <- moonshine t 39 | > return $ DLK t' 40 | > moonshine (L (x :. t)) = do 41 | > t' <- moonshine t 42 | > return $ DL (x ::. t') 43 | > moonshine (C c) = do 44 | > c' <- traverse moonshine c 45 | > return $ DC c' 46 | > moonshine (N n) = (do 47 | > n' :<: ty <- distillInfer B0 n [] 48 | > return $ DN n' 49 | > ) <|> return (DTIN (N n)) 50 | > moonshine t = return (DTIN t) 51 | 52 | 53 | -------------------------------------------------------------------------------- /src/Documentation/wrap.tex: -------------------------------------------------------------------------------- 1 | \documentclass[a4paper]{article} 2 | \usepackage{stmaryrd,wasysym,url, 3 | upgreek,palatino,alltt, 4 | color} 5 | \usepackage{hyperref} 6 | \usepackage{a4wide} 7 | 8 | \begin{document} 9 | 10 | \newcommand{\question}[1]{\textbf{[#1]}} 11 | 12 | \input{Language} 13 | \end{document} -------------------------------------------------------------------------------- /src/Elaboration/Wire.lhs-boot: -------------------------------------------------------------------------------- 1 | > module Elaboration.Wire where 2 | 3 | > import Evidences.Tm 4 | 5 | > import ProofState.Structure.Developments 6 | > import ProofState.Edition.ProofContext 7 | > import ProofState.Edition.News 8 | > import ProofState.Edition.ProofState 9 | > import Kit.BwdFwd 10 | 11 | > data PropagateStatus = NormalPropagate | RecursivePropagate 12 | 13 | > updateRef :: REF -> ProofState () 14 | 15 | > propagateNews :: PropagateStatus -> NewsBulletin -> NewsyEntries -> ProofState NewsBulletin 16 | 17 | > tellEntry :: NewsBulletin -> Entry Bwd -> ProofState (NewsBulletin, Entry Bwd) -------------------------------------------------------------------------------- /src/Evidences/BetaQuotation.lhs-boot: -------------------------------------------------------------------------------- 1 | > {-# OPTIONS_GHC -F -pgmF she #-} 2 | 3 | > module Evidences.BetaQuotation where 4 | 5 | > import NameSupply.NameSupplier 6 | > import Evidences.Tm 7 | 8 | > import Kit.BwdFwd 9 | 10 | > bquote :: NameSupplier m => Bwd REF -> Tm {d,VV} REF -> m (Tm {d,TT} REF) 11 | -------------------------------------------------------------------------------- /src/Evidences/DefinitionalEquality.lhs-boot: -------------------------------------------------------------------------------- 1 | > {-# OPTIONS_GHC -F -pgmF she #-} 2 | > {-# LANGUAGE TypeOperators, GADTs, KindSignatures, 3 | > TypeSynonymInstances, FlexibleInstances, FlexibleContexts, PatternGuards #-} 4 | 5 | > module Evidences.DefinitionalEquality where 6 | 7 | > import NameSupply.NameSupply 8 | 9 | > import Evidences.Tm 10 | 11 | > equal :: (TY :>: (VAL,VAL)) -> NameSupply -> Bool -------------------------------------------------------------------------------- /src/Evidences/Eval.lhs-boot: -------------------------------------------------------------------------------- 1 | > {-# OPTIONS_GHC -F -pgmF she #-} 2 | > {-# LANGUAGE TypeOperators, GADTs, KindSignatures, 3 | > TypeSynonymInstances, FlexibleInstances, FlexibleContexts, PatternGuards #-} 4 | 5 | > module Evidences.Eval where 6 | 7 | > import Data.Foldable 8 | > import Evidences.Tm 9 | 10 | > ($$) :: VAL -> Elim VAL -> VAL 11 | > ($$$) :: (Foldable f) => VAL -> f (Elim VAL) -> VAL 12 | > (@@) :: Op -> [VAL] -> VAL 13 | > eval :: Tm {d, TT} REF -> ENV -> VAL -------------------------------------------------------------------------------- /src/Evidences/Introduction.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/src/Evidences/Introduction.tex -------------------------------------------------------------------------------- /src/Evidences/PropositionalEquality.lhs-boot: -------------------------------------------------------------------------------- 1 | > {-# OPTIONS_GHC -F -pgmF she #-} 2 | > {-# LANGUAGE TypeOperators, GADTs, KindSignatures, 3 | > TypeSynonymInstances, FlexibleInstances, FlexibleContexts, PatternGuards #-} 4 | 5 | > module Evidences.PropositionalEquality where 6 | 7 | > import Evidences.Tm 8 | 9 | 10 | > opRunEqGreen :: [VAL] -> Either NEU VAL 11 | > coerce :: (Can (VAL,VAL)) -> VAL -> VAL -> Either NEU VAL 12 | > partialEq :: VAL -> VAL -> VAL -> Bool -------------------------------------------------------------------------------- /src/Features/Features.lhs: -------------------------------------------------------------------------------- 1 | \section{Features} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | 7 | %endif 8 | 9 | > module Features.Features where 10 | 11 | This module should import all the feature modules. This module 12 | should be imported by all the functionality modules. This module 13 | thus functions as exactly the list of features included in the 14 | current version of the system. 15 | 16 | > import Features.UId () 17 | > import Features.Enum () 18 | > import Features.Sigma () 19 | > import Features.Problem () 20 | > import Features.Prop () 21 | > import Features.Desc () 22 | > import Features.IDesc () 23 | > import Features.Equality () 24 | > import Features.Nu () 25 | > import Features.Labelled () 26 | > import Features.Quotient () 27 | > import Features.FreeMonad () 28 | > import Features.Record () 29 | > import Features.Anchor () 30 | 31 | -------------------------------------------------------------------------------- /src/Features/Introduction.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/src/Features/Introduction.tex -------------------------------------------------------------------------------- /src/Features/Skeleton.lhs: -------------------------------------------------------------------------------- 1 | \section{Skeleton feature} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | 7 | > module Features.Skeleton where 8 | 9 | %endif 10 | 11 | 12 | \subsection{Plugging in canonical forms} 13 | 14 | > import -> CanConstructors where 15 | 16 | > import -> CanTyRules where 17 | 18 | > import -> CanCompile where 19 | 20 | > import -> CanEtaExpand where 21 | 22 | > import -> CanPats where 23 | 24 | > import -> CanDisplayPats where 25 | 26 | > import -> CanPretty where 27 | 28 | > import -> CanTraverse where 29 | 30 | > import -> CanHalfZip where 31 | 32 | \subsection{Plugging in eliminators} 33 | 34 | > import -> ElimTyRules where 35 | 36 | > import -> ElimComputation where 37 | 38 | > import -> ElimCompile where 39 | 40 | > import -> ElimTraverse where 41 | 42 | > import -> ElimPretty where 43 | 44 | \subsection{Plugging in operators} 45 | 46 | > import -> Operators where 47 | 48 | > import -> OpCompile where 49 | 50 | > import -> OpCode where 51 | 52 | \subsection{Plugging in axioms and primitives} 53 | 54 | > import -> RulesCode where 55 | 56 | > import -> Primitives where 57 | 58 | \subsection{Extending the type-checker} 59 | 60 | > import -> Check where 61 | 62 | \subsection{Extending the equality} 63 | 64 | > import -> OpRunEqGreen where 65 | 66 | > import -> Coerce where 67 | 68 | \subsection{Extending the display language} 69 | 70 | > import -> DInTmConstructors where 71 | 72 | > import -> DInTmTraverse where 73 | 74 | > import -> DInTmPretty where 75 | 76 | > import -> Pretty where 77 | 78 | \subsection{Extending the concrete syntax} 79 | 80 | > import -> KeywordConstructors where 81 | 82 | > import -> KeywordTable where 83 | 84 | > import -> ElimParsers where 85 | 86 | > import -> DInTmParsersSpecial where 87 | 88 | > import -> DInTmParsersMore where 89 | 90 | > import -> ParserCode where 91 | 92 | \subsection{Extending the elaborator and distiller} 93 | 94 | > import -> MakeElabRules where 95 | 96 | > import -> DistillRules where -------------------------------------------------------------------------------- /src/Kit/Trace.lhs: -------------------------------------------------------------------------------- 1 | \section{Trace} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | > {-# LANGUAGE NoMonomorphismRestriction #-} 7 | 8 | > module Kit.Trace where 9 | 10 | > import Debug.Trace 11 | 12 | %endif 13 | 14 | Let us enumerate the different flavours of tracing available: 15 | 16 | > data Trace = ProofTrace 17 | > | SimpTrace 18 | > | ElimTrace 19 | > | SchedTrace 20 | > | ElabTrace 21 | > deriving Show 22 | 23 | We then can switch each one on or off individually: 24 | 25 | > traceEnabled :: Trace -> Bool 26 | > traceEnabled ProofTrace = True 27 | > traceEnabled SimpTrace = False 28 | > traceEnabled ElimTrace = False 29 | > traceEnabled SchedTrace = False 30 | > traceEnabled ElabTrace = True 31 | 32 | That's fairly trivial, yet I'm pretty sure this goddamn laziness won't 33 | skip some traces (ML programmer speaking here). 34 | 35 | > monadTrace :: Monad m => Trace -> String -> m () 36 | > monadTrace t s | traceEnabled t = do 37 | > () <- trace ("[" ++ show t ++ "] " ++ s) $ return () 38 | > return () 39 | > | otherwise = return () 40 | 41 | Some handy aliases for the tracing function: 42 | 43 | > proofTrace = monadTrace ProofTrace 44 | > simpTrace = monadTrace SimpTrace 45 | > elimTrace = monadTrace ElimTrace 46 | > schedTrace = monadTrace SchedTrace 47 | > elabTrace = monadTrace ElabTrace -------------------------------------------------------------------------------- /src/NameSupply/Introduction.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/src/NameSupply/Introduction.tex -------------------------------------------------------------------------------- /src/NameSupply/NameSupply.lhs: -------------------------------------------------------------------------------- 1 | \section{NameSupply} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | > {-# LANGUAGE TypeOperators #-} 7 | 8 | > module NameSupply.NameSupply where 9 | 10 | > import Kit.BwdFwd 11 | > import Kit.MissingLibrary 12 | 13 | %endif 14 | 15 | The |NameSupply| is the name generator used throughout Epigram. It is 16 | inspired by the \emph{hierarchical names}~\cite{mcbride:free_variable} 17 | used in Epigram the First. The aim of this structure is to 18 | conveniently, provide unique free variable names. 19 | 20 | A |NameSupply| is composed by a backward list of |(String, Int)| and an 21 | |Int|. This corresponds to a hierarchical namespace and a free name in 22 | that namespace. The structure of the namespace stack is justified as 23 | follows. The |String| component provides name advice, which may not be 24 | unique, while the |Int| uniquely identifies the namespace. 25 | 26 | > type NameSupply = (Bwd (String, Int), Int) 27 | 28 | Therefore, creating a fresh name in a given namespace simply consists 29 | of incrementing the name counter: 30 | 31 | > freshName :: NameSupply -> NameSupply 32 | > freshName (sis, i) = (sis, i + 1) 33 | 34 | Whereas creating a fresh namespace involves stacking up a new name 35 | |s|, uniquely identified by |i|, and initializing the per-namespace 36 | counter to |0|: 37 | 38 | > freshNSpace :: NameSupply -> String -> NameSupply 39 | > freshNSpace (sis, i) s = (sis :< (s,i), 0) 40 | 41 | Intuitively, the function |name| computes a fresh name out of a given 42 | name generator, decorating it with the human-readable label 43 | |s|. Technically, |Name| is defined as 44 | a list of |(String, Int)|. Hence, on that structure, the effect of 45 | |trail| is to flatten the backward namespace into a (unique) |Name|. 46 | 47 | > type Name = [(String, Int)] 48 | > 49 | > mkName :: NameSupply -> String -> Name 50 | > mkName (sis, i) s = trail $ sis :< (s, i) 51 | 52 | -------------------------------------------------------------------------------- /src/ProofState/Edition/FakeRef.lhs: -------------------------------------------------------------------------------- 1 | \section{Fake references} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | > {-# LANGUAGE FlexibleInstances, TypeOperators, TypeSynonymInstances, 7 | > GADTs, RankNTypes #-} 8 | 9 | > module ProofState.Edition.FakeRef where 10 | 11 | > import ProofState.Edition.ProofContext 12 | > import ProofState.Edition.Scope 13 | > import ProofState.Edition.ProofState 14 | > import ProofState.Edition.GetSet 15 | 16 | > import Evidences.Tm 17 | > import Evidences.Eval 18 | 19 | %endif 20 | 21 | 22 | The |getFakeCurrentEntry| command returns a neutral application of a 23 | fake reference that represents the current entry of the current 24 | location. Note that its type is $\lambda$-lifted over its parameters 25 | in global scope, but it is then applied to them (as shared 26 | parameters). 27 | 28 | \pierre{Soon enough, this should disappear. We hope to indroduce 29 | "high-level names" cleanly into the ProofState. They will cover the 30 | role currently played by |FakeRef|s to name label and let us find them 31 | into the ProofState.} 32 | 33 | > getFakeRef :: ProofState REF 34 | > getFakeRef = do 35 | > CDefinition _ (cEntryName := HOLE _ :<: ty) _ _ _ <- getCurrentEntry 36 | > return $ cEntryName := FAKE :<: ty 37 | 38 | > getFakeCurrentEntry :: ProofState (EXTM :=>: VAL) 39 | > getFakeCurrentEntry = do 40 | > r <- getFakeRef 41 | > inScope <- getInScope 42 | > let tm = P r $:$ (paramSpine inScope) 43 | > return $ tm :=>: evTm tm 44 | -------------------------------------------------------------------------------- /src/ProofState/Edition/ProofState.lhs: -------------------------------------------------------------------------------- 1 | \section{The |ProofState| monad} 2 | \label{sec:ProofState.Edition.ProofState} 3 | 4 | %if False 5 | 6 | > {-# OPTIONS_GHC -F -pgmF she #-} 7 | > {-# LANGUAGE FlexibleInstances, TypeOperators, TypeSynonymInstances, 8 | > GADTs, RankNTypes #-} 9 | 10 | > module ProofState.Edition.ProofState where 11 | 12 | > import Control.Monad.State 13 | 14 | > import DisplayLang.Name 15 | 16 | > import ProofState.Edition.ProofContext 17 | 18 | > import Evidences.Tm 19 | 20 | %endif 21 | 22 | 23 | \subsection{Defining the Proof State monad} 24 | 25 | 26 | The proof state monad provides access to the |ProofContext| as in a 27 | |State| monad, but with the possibility of command failure represented 28 | by |Either (StackError e)|. 29 | 30 | > type ProofStateT e = StateT ProofContext (Either (StackError e)) 31 | 32 | Most of the time, we will work in a |ProofStateT| carrying errors 33 | composed with Strings and terms in display syntax. Hence the following 34 | type synonym: 35 | 36 | > type ProofState = ProofStateT DInTmRN 37 | 38 | 39 | \subsection{Error management toolkit} 40 | 41 | Some functions, such as |distill|, are defined in the |ProofStateT 42 | INTM| monad. However, Cochon lives in a |ProofStateT DInTmRN| 43 | monad. Therefore, in order to use it, we will need to lift from the 44 | former to the latter. 45 | 46 | > mapStackError :: (ErrorTok a -> ErrorTok b) -> StackError a -> StackError b 47 | > mapStackError = fmap . fmap 48 | 49 | > liftError :: (a -> b) -> Either (StackError a) c -> Either (StackError b) c 50 | > liftError f = either (Left . mapStackError (fmap f)) Right 51 | 52 | > liftError' :: (ErrorTok a -> ErrorTok b) -> Either (StackError a) c 53 | > -> Either (StackError b) c 54 | > liftError' f = either (Left . mapStackError f) Right 55 | 56 | > liftErrorState :: (a -> b) -> ProofStateT a c -> ProofStateT b c 57 | > liftErrorState f = mapStateT (liftError f) 58 | -------------------------------------------------------------------------------- /src/ProofState/Interface/Name.lhs: -------------------------------------------------------------------------------- 1 | \section{Name management} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | > {-# LANGUAGE FlexibleInstances, TypeOperators, TypeSynonymInstances, 7 | > GADTs, RankNTypes #-} 8 | 9 | > module ProofState.Interface.Name where 10 | 11 | > import Data.Foldable 12 | 13 | > import NameSupply.NameSupply 14 | 15 | > import ProofState.Structure.Developments 16 | > import ProofState.Structure.Entries 17 | 18 | > import ProofState.Edition.Scope 19 | > import ProofState.Edition.ProofState 20 | > import ProofState.Edition.GetSet 21 | 22 | > import Evidences.Tm 23 | > import Evidences.Operators 24 | 25 | 26 | %endif 27 | 28 | 29 | 30 | The |lookupName| function looks up a name in the context (including axioms and 31 | primitives); if found, it returns the reference applied to the spine of 32 | shared parameters. 33 | 34 | > lookupName :: Name -> ProofStateT e (Maybe (EXTM :=>: VAL)) 35 | > lookupName name = do 36 | > inScope <- getInScope 37 | > case find ((name ==) . entryName) inScope of 38 | > Just (EEntity ref _ _ _ _) -> return $ Just $ applySpine ref inScope 39 | > Nothing -> 40 | > case find ((name ==) . refName . snd) primitives of 41 | > Just (_, ref) -> return $ Just $ applySpine ref inScope 42 | > Nothing -> return Nothing 43 | 44 | 45 | 46 | The |pickName| command takes a prefix suggestion and a name suggestion 47 | (either of which may be empty), and returns a more-likely-to-be-unique 48 | name if the name suggestion is empty. 49 | 50 | > pickName :: String -> String -> ProofState String 51 | > pickName "" s = pickName "x" s 52 | > pickName prefix "" = do 53 | > m <- getCurrentName 54 | > r <- getDevNSupply 55 | > return $ prefix ++ show (foldMap snd m + snd r) 56 | > pickName _ s = return s 57 | -------------------------------------------------------------------------------- /src/ProofState/Introduction.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/src/ProofState/Introduction.tex -------------------------------------------------------------------------------- /src/SourceLang/Elaborator.lhs: -------------------------------------------------------------------------------- 1 | \section{Elaborator} 2 | \label{sec:SourceLang.Elaborator} 3 | 4 | %if False 5 | 6 | > {-# OPTIONS_GHC -F -pgmF she #-} 7 | 8 | > module SourceLang.Elaborator where 9 | 10 | > import Control.Applicative 11 | > import Data.Traversable 12 | 13 | > import Evidences.Tm 14 | > import DisplayLang.DisplayTm 15 | > import DisplayLang.Name 16 | 17 | > import Elaboration.ElabProb 18 | > import Elaboration.ElabMonad 19 | > import Elaboration.MakeElab 20 | 21 | > import SourceLang.Structure 22 | 23 | %endif 24 | 25 | Here we explain how to elaborate constructions. The elaborator is going to need 26 | a lot of work in order to actually run these definitions. 27 | 28 | First things first: to elaborate a term, we just use |subElab| defined before. 29 | 30 | > elabTerm :: Loc -> TY -> Parsed -> Elab Elaborated 31 | > elabTerm loc ty (s, tm) = do 32 | > etm :=>: _ <- subElab loc (ty :>: tm) 33 | > return (s, tm, etm) 34 | 35 | The following cases need some thought about exactly what elaboration should do. 36 | 37 | > elabConstr :: Construction Parsed -> Elab (Construction Elaborated) 38 | > elabConstr (LetConstr decl mref) = do 39 | > decl' <- elabDecl decl 40 | > return (LetConstr decl' Nothing) 41 | 42 | > elabDecl :: Decl Parsed -> Elab (Decl Elaborated) 43 | > elabDecl (Decl hyps x ty) = 44 | > (| Decl (traverse elabDecl hyps) ~x (elabTerm (Loc 0) SET ty) |) 45 | 46 | > elabRefinement :: Refinement Parsed -> Elab (Refinement Elaborated) 47 | > elabRefinement (Refinement prob tac wbk) = undefined -------------------------------------------------------------------------------- /src/SourceLang/Example.lhs: -------------------------------------------------------------------------------- 1 | \section{Example} 2 | \label{sec:SourceLang.Example} 3 | 4 | %if False 5 | 6 | > {-# OPTIONS_GHC -F -pgmF she #-} 7 | 8 | 9 | > module SourceLang.Example where 10 | 11 | > import Elaboration.ElabMonad 12 | 13 | > import SourceLang.Structure 14 | > import SourceLang.Parser 15 | > import SourceLang.Elaborator 16 | 17 | %endif 18 | 19 | > plusC :: Construction Lexed 20 | > plusC = LetConstr 21 | > (Decl [(Decl [] "x" "Nat"), 22 | > (Decl [] "y" "Nat") 23 | > ] "plus" "Nat") 24 | > (Just (Refinement 25 | > "plus x y" 26 | > (ByTac "Nat.Ind x" 27 | > [ 28 | > Refinement "plus 'zero y" 29 | > (ReturnTac "y") 30 | > [], 31 | > Refinement "plus ('suc z) y" 32 | > ShedTac 33 | > [] 34 | > ] 35 | > ) 36 | > [] 37 | > )) 38 | 39 | 40 | > parsePlusC :: Construction Parsed 41 | > parsePlusC = case parseConstr plusC of 42 | > Right c -> c 43 | > Left e -> error e 44 | 45 | > elabPlusC :: Elab (Construction Elaborated) 46 | > elabPlusC = elabConstr parsePlusC -------------------------------------------------------------------------------- /src/SourceLang/Parser.lhs: -------------------------------------------------------------------------------- 1 | \section{Parser} 2 | \label{sec:SourceLang.Parser} 3 | 4 | %if False 5 | 6 | > {-# OPTIONS_GHC -F -pgmF she #-} 7 | 8 | > module SourceLang.Parser where 9 | 10 | > import Control.Applicative 11 | > import Data.Traversable 12 | 13 | > import Evidences.Tm 14 | > import DisplayLang.DisplayTm 15 | > import DisplayLang.Name 16 | > import DisplayLang.Lexer 17 | > import DisplayLang.TmParse 18 | 19 | > import SourceLang.Structure 20 | 21 | > import Kit.Parsley 22 | 23 | %endif 24 | 25 | For the moment, we set aside the question of how to get an |EpiDoc Lexed| 26 | and just explain how to parse the terms inside. Parsing documents has yet to be 27 | implemented: we should first lex the file to a string of tokens, 28 | 29 | < lex :: String -> Either String [Token] 30 | 31 | then organise the tokens into a list of constructions, 32 | 33 | < firstParse :: [Token] -> Either String (EpiDoc Lexed) 34 | 35 | and finally invoke the following to parse the terms within the constructions. 36 | (We might also want a better representation of parse errors.) 37 | 38 | > parseEpiDoc :: EpiDoc Lexed -> Either String (EpiDoc Parsed) 39 | > parseEpiDoc = traverse parseConstr 40 | 41 | > parseConstr :: Construction Lexed -> Either String (Construction Parsed) 42 | > parseConstr = traverse parseTerm 43 | > where 44 | > parseTerm :: String -> Either String (String, DInTmRN) 45 | > parseTerm s = case parse tokenize s of 46 | > Left err -> Left (show err) 47 | > Right toks -> case parse pDInTm toks of 48 | > Left err -> Left (show err) 49 | > Right tm -> return (s, tm) 50 | -------------------------------------------------------------------------------- /src/Tactics/Introduction.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/epigram2/8c46f766bddcec2218ddcaa79996e087699a75f2/src/Tactics/Introduction.tex -------------------------------------------------------------------------------- /src/Tactics/Record.lhs: -------------------------------------------------------------------------------- 1 | \section{Record declaration} 2 | 3 | %if False 4 | 5 | > {-# OPTIONS_GHC -F -pgmF she #-} 6 | > {-# LANGUAGE TypeOperators, TypeSynonymInstances, GADTs #-} 7 | 8 | > module Tactics.Record where 9 | 10 | > import Evidences.Tm 11 | > import Evidences.Mangler 12 | 13 | > import ProofState.Edition.ProofState 14 | 15 | > import DisplayLang.Name 16 | 17 | %endif 18 | 19 | > elabRecord :: String -> [(String , DInTmRN)] -> ProofState (EXTM :=>: VAL) 20 | > elabRecord name fields = undefined -- XXX: not yet implemented 21 | 22 | 23 | > import -> CochonTactics where 24 | > : CochonTactic 25 | > { ctName = "record" 26 | > , ctParse = do 27 | > nom <- tokenString 28 | > keyword KwDefn 29 | > scs <- tokenListArgs (bracket Round $ tokenPairArgs 30 | > tokenString 31 | > (keyword KwAsc) 32 | > tokenInTm) 33 | > (keyword KwSemi) 34 | > return $ B0 :< nom :< pars :< scs 35 | > , ctIO = (\ [StrArg nom, pars, cons] -> simpleOutput $ 36 | > elabRecord nom (argList (argPair argToStr argToIn) pars) 37 | > (argList (argPair argToStr argToIn) cons) 38 | > >> return "Record'd.") 39 | > , ctHelp = "record []* := [(