├── .gitignore ├── README.md ├── constructor-subtyping ├── README.md ├── church │ ├── etyp.ced │ ├── int.ced │ ├── list.ced │ ├── nat.ced │ ├── results.ced │ ├── stlc.ced │ ├── stlce.ced │ ├── typ.ced │ └── vectree.ced ├── generic │ ├── README.md │ ├── encoding.ced │ ├── encoding │ │ ├── alg.ced │ │ ├── ind.ced │ │ └── prfalg.ced │ ├── examples │ │ ├── int-ext.ced │ │ ├── int-reuse-nat.ced │ │ ├── int-sig.ced │ │ ├── int.ced │ │ ├── nat-ext.ced │ │ ├── nat-sig.ced │ │ └── nat.ced │ ├── extensible-signature.ced │ ├── extensible-signature │ │ ├── sig.ced │ │ └── sub.ced │ ├── reuse.ced │ └── reuse │ │ ├── fix2fix.ced │ │ └── signature-subtyping.ced └── lib │ ├── bool.ced │ ├── cast.ced │ ├── castDep.ced │ ├── label.ced │ ├── lib.ced │ ├── not.ced │ ├── sigma.ced │ ├── top.ced │ └── unit.ced ├── efficient-mendler-codata ├── .cedille │ └── options ├── README.org ├── everything.ced ├── examples │ ├── stream.ced │ ├── streamf.ced │ ├── streamrel.ced │ └── streamrelf.ced ├── nu │ ├── lambek.ced │ └── nu.ced ├── utils.ced └── utils │ ├── cast.ced │ ├── rec.ced │ ├── sigma.ced │ ├── sum.ced │ └── unit.ced ├── efficient-mendler-prime ├── .cedille │ └── options ├── FixIndM.ced ├── FixM.ced ├── Id.ced ├── IdPlus.ced ├── InitialM.ced ├── README.md └── Sigma.ced ├── efficient-mendler ├── .cedille │ └── options ├── Everything.ced ├── Examples │ ├── ITree │ │ ├── IF.ced │ │ └── ITree.ced │ ├── Nat │ │ ├── NF.ced │ │ └── Nat.ced │ ├── PTree │ │ ├── PF.ced │ │ └── PTree.ced │ └── UTree │ │ ├── UF.ced │ │ └── UTree.ced ├── MendlerInduction │ ├── ConstantTimeDestructor.ced │ ├── FixIndM.ced │ ├── FixM.ced │ ├── Id.ced │ ├── IdMapping.ced │ ├── InductionM.ced │ ├── LiftPred.ced │ └── SubstComp.ced ├── README └── Utilities │ ├── Bool.ced │ ├── Cast.ced │ ├── Empty.ced │ ├── Functor.ced │ ├── Product.ced │ ├── Sigma.ced │ ├── Sum.ced │ ├── Top.ced │ ├── Unit.ced │ └── Utils.ced ├── generic-reuse ├── .cedille │ └── options ├── Base │ ├── Bool.ced │ ├── Empty.ced │ ├── Eq.ced │ ├── Id.ced │ ├── Product.ced │ ├── Sigma.ced │ └── Unit.ced ├── Datatypes │ ├── All.ced │ ├── AllF.ced │ ├── Ctx.ced │ ├── Env.ced │ ├── List.ced │ ├── ListF.ced │ ├── Lookup.ced │ ├── Mem.ced │ ├── MemF.ced │ ├── Nat.ced │ ├── NatF.ced │ ├── Raw.ced │ ├── RawF.ced │ ├── Raws.ced │ ├── Taking.ced │ ├── Term.ced │ ├── TermF.ced │ ├── Tp.ced │ ├── TpF.ced │ ├── Typed.ced │ ├── Vec.ced │ └── VecF.ced ├── EverythingList.ced ├── EverythingTerm.ced ├── Examples │ ├── AllListReuse.ced │ ├── AppendReuse.ced │ ├── ListVecReuse.ced │ ├── RawTermReuse.ced │ ├── StepReuse.ced │ ├── SubReuse.ced │ ├── TermRawReuse.ced │ └── VecListReuse.ced ├── GenericReuse │ ├── EnrFix.ced │ ├── EnrFun.ced │ ├── FogFix.ced │ ├── FogFun.ced │ └── Util.ced ├── IndexedMendlerInduction │ ├── AlgM.ced │ ├── FixIndM.ced │ ├── IFixIndM.ced │ ├── IFixM.ced │ ├── IIdPlus.ced │ └── UnitLift.ced └── README.md ├── idem-quotients ├── README.md ├── bool.ced ├── int.ced ├── listset.ced ├── modk.ced ├── nat.ced ├── or.ced ├── pair.ced ├── parity.ced ├── quotient-comb.ced ├── quotient-defs.ced ├── quotient.ced └── uip.ced ├── impred-ind ├── Church │ ├── ConvC.ced │ ├── FixC.ced │ ├── FixIndC.ced │ ├── InductionC.ced │ ├── IsoC.ced │ ├── PropertiesC.ced │ ├── TheProblemWithAlignment.ced │ ├── WithFixIndC.ced │ └── examples │ │ ├── NatC.ced │ │ └── NatF.ced ├── Everything.ced ├── Mendler │ ├── ConvM.ced │ ├── FixIndM.ced │ ├── FixM.ced │ ├── InductionM.ced │ ├── IsoM.ced │ ├── PrfAlgEqM.ced │ ├── PropertiesM.ced │ ├── WithFixIndM.ced │ └── examples │ │ ├── ListF.ced │ │ └── ListM.ced ├── README.md └── Utilities │ ├── Functor.ced │ ├── PredicateLifting.ced │ ├── Product.ced │ ├── Sigma.ced │ ├── SigmaImplicit.ced │ ├── Sum.ced │ ├── Top.ced │ ├── Unary.ced │ ├── Unit.ced │ ├── Utils.ced │ └── WithWitness.ced ├── induction-induction ├── README.md ├── encoding │ ├── alg.ced │ ├── idxind.ced │ └── prfalg.ced ├── example.ced ├── indind.ced ├── indind2 │ ├── constraint.ced │ ├── ind.ced │ ├── mono.ced │ └── shape.ced └── lib │ ├── bot.ced │ ├── cast.ced │ ├── idata.ced │ ├── top.ced │ ├── tpeq.ced │ └── tuple.ced ├── large-elim-sim ├── .cedille │ └── options ├── README.md ├── core.ced ├── large-elim │ ├── concrete │ │ ├── nary.ced │ │ ├── stlc.ced │ │ ├── universe │ │ │ ├── decode.ced │ │ │ ├── decodeR.ced │ │ │ ├── descr.ced │ │ │ ├── encoding.ced │ │ │ ├── list.ced │ │ │ ├── nat.ced │ │ │ ├── noconfusion.ced │ │ │ ├── noconfusion2.ced │ │ │ ├── noconfusionR.ced │ │ │ └── udata.ced │ │ └── zipwith │ │ │ ├── nvecMap.ced │ │ │ ├── tpvec.ced │ │ │ └── tpvec │ │ │ ├── base.ced │ │ │ ├── cons.ced │ │ │ ├── fold.ced │ │ │ └── foldr.ced │ ├── everything.ced │ ├── example-nary.ced │ └── generic │ │ ├── algty.ced │ │ ├── encoding.ced │ │ ├── example │ │ ├── nary.ced │ │ ├── nat.ced │ │ └── strongind.ced │ │ └── large.ced ├── lib.ced └── lib │ ├── categories │ ├── functor-defs.ced │ ├── functor.ced │ └── rawfunctor-defs.ced │ ├── data │ ├── bitstring.ced │ ├── bool-thms.ced │ ├── bool.ced │ ├── decidable.ced │ ├── existstm.ced │ ├── existsty.ced │ ├── fin.ced │ ├── list-cv.ced │ ├── list-sort.ced │ ├── list-thms.ced │ ├── list.ced │ ├── nat-cv.ced │ ├── nat-thms.ced │ ├── nat-thms │ │ ├── order.ced │ │ └── simple.ced │ ├── nat.ced │ ├── option.ced │ ├── reuse │ │ └── list-vec.ced │ ├── sigma-thms.ced │ ├── sigma.ced │ ├── sum.ced │ ├── tree.ced │ ├── unit.ced │ ├── vec-thms.ced │ ├── vec.ced │ ├── w-type.ced │ └── wksigma.ced │ └── encodings │ ├── mendler.ced │ └── template.ced ├── lfmtp19 ├── Lfmtp19.hs ├── README.md ├── RecAlg.hs ├── RecType2.ced ├── bool.ced ├── cast.ced ├── cast2.ced ├── lftmp19.ced ├── nat.ced ├── top.ced └── view.ced └── recursive-representation-of-data ├── .cedille └── options ├── README.org ├── README.txt ├── cast.ced ├── data-char.ced ├── data-char ├── case-typing.ced ├── case.ced ├── destruct.ced ├── iter-typing.ced ├── iter.ced ├── lr-typing.ced ├── lr.ced ├── primrec-typing.ced └── primrec.ced ├── everything.ced ├── functor.ced ├── functorThms.ced ├── inftreeFunctor.ced ├── lepigre-raffalli.ced ├── lepigre-raffalli ├── concrete │ ├── nat-old.ced │ ├── nat1.ced │ └── nat2.ced ├── examples │ ├── itree.ced │ └── list.ced └── generic │ ├── encoding.ced │ ├── induction.ced │ └── props.ced ├── mono.ced ├── parigot.ced ├── parigot ├── concrete │ └── nat.ced ├── examples │ ├── list-data.ced │ ├── list.ced │ └── rosetree-data.ced └── generic │ ├── encoding.ced │ └── props.ced ├── recType.ced ├── scott.ced ├── scott ├── concrete │ └── nat.ced └── generic │ ├── encoding.ced │ └── props.ced ├── signatures ├── itree.ced ├── list.ced ├── nat.ced └── tree.ced ├── utils.ced ├── utils ├── id.ced ├── sigma.ced ├── sum.ced ├── top.ced ├── unit.ced ├── wksigma.ced └── wrap.ced └── view.ced /.gitignore: -------------------------------------------------------------------------------- 1 | **/#* 2 | .#* 3 | *.*~ 4 | *.cede 5 | *.DS_Store 6 | core 7 | -------------------------------------------------------------------------------- /constructor-subtyping/church/stlce.ced: -------------------------------------------------------------------------------- 1 | import ../lib/lib. 2 | import etyp as ETyp. 3 | import nat as Nat. 4 | import list as List. 5 | 6 | module stlce. 7 | 8 | Nat : ★ = Nat.Nat. 9 | Index : ★ = Nat.Nat. 10 | Typ : ★ = ETyp.ETyp. 11 | nat = ETyp.nat. 12 | base = ETyp.base. 13 | arr = ETyp.arr. 14 | typ_eq = ETyp.typ_eq. 15 | 16 | Ctx : ★ = List.List·Typ. 17 | nil = List.nil·Typ. 18 | cons = List.cons·Typ. 19 | length = List.length. 20 | at = List.at·Typ typ_eq. 21 | 22 | StlcePack : (Ctx ➔ Typ ➔ ★) ➔ Label ➔ ★ = λ X:Ctx ➔ Typ ➔ ★. λ l:Label. ι _: 23 | {l ≃ lvar} ➾ ∀ g:Ctx. ∀ a:Typ. Π i:Index. {at i a g ≃ tt} ➾ X g a. ι _: 24 | {l ≃ labs} ➾ ∀ g:Ctx. ∀ a:Typ. ∀ b:Typ. X (cons a g) b ➔ X g (arr a b). ι _: 25 | {l ≃ lapp} ➾ ∀ g:Ctx. ∀ a:Typ. ∀ b:Typ. X g (arr a b) ➔ X g a ➔ X g b. ι _: 26 | {l ≃ lnum} ➾ ∀ g:Ctx. Nat ➔ X g nat. 27 | {l ≃ ladd} ➾ ∀ g:Ctx. X g nat ➔ X g nat ➔ X g nat. 28 | 29 | Stlce : Ctx ➔ Typ ➔ ★ = λ g:Ctx. λ ty:Typ. 30 | ∀ X:Ctx ➔ Typ ➔ ★. (Π l:Label. StlcePack·X l) ➔ X g ty. 31 | 32 | var : ∀ g:Ctx. ∀ a:Typ. Π i:Index. {at i a g ≃ tt} ➾ Stlce g a 33 | = Λ g. Λ a. λ i. Λ e. Λ X. λ f. [v = (f lvar).1 -β] 34 | - v -g -a i -e. 35 | 36 | abs : ∀ g:Ctx. ∀ a:Typ. ∀ b:Typ. Stlce (cons a g) b ➔ Stlce g (arr a b) 37 | = Λ g. Λ a. Λ b. λ body. Λ X. λ f. [abs = (f labs).2.1 -β] 38 | - abs -g -a -b (body·X f). 39 | 40 | app : ∀ g:Ctx. ∀ a:Typ. ∀ b:Typ. Stlce g (arr a b) ➔ Stlce g a ➔ Stlce g b 41 | = Λ g. Λ a. Λ b. λ fn. λ arg. Λ X. λ f. [app = (f lapp).2.2.1 -β] 42 | - app -g -a -b (fn·X f) (arg·X f). 43 | 44 | num : ∀ g:Ctx. Nat ➔ Stlce g nat 45 | = Λ g. λ n. Λ X. λ f. [num = (f lnum).2.2.2.1 -β] - num -g n. 46 | 47 | add : ∀ g:Ctx. Stlce g nat ➔ Stlce g nat ➔ Stlce g nat 48 | = Λ g. λ x. λ y. Λ X. λ f. [add = (f ladd).2.2.2.2 -β] - add -g (x·X f) (y·X f). 49 | -------------------------------------------------------------------------------- /constructor-subtyping/church/vectree.ced: -------------------------------------------------------------------------------- 1 | import ../lib/lib. 2 | import nat as N. 3 | 4 | module vectree. 5 | 6 | Nat : ★ = N.Nat. 7 | zero = N.zero. 8 | succ = N.succ. 9 | add = N.add. 10 | 11 | VecTreePack' : ★ ➔ (Nat ➔ ★) ➔ Label ➔ ★ = λ A:★. λ X:Nat ➔ ★. λ l:Label. ι _: 12 | {l ≃ lnil} ➾ X zero. ι _: 13 | {l ≃ lcons} ➾ ∀ n:Nat. A ➔ X n ➔ X (succ n). 14 | {l ≃ lbranch} ➾ ∀ a:Nat. ∀ b:Nat. X a ➔ X b ➔ X (add a b). 15 | 16 | VecTree' : ★ ➔ Nat ➔ ★ = λ A:★. λ n:Nat. ∀ X:(Nat ➔ ★). (Π l:Label. VecTreePack'·A·X l) ➔ X n. 17 | 18 | nil' : ∀ A:★. VecTree'·A zero 19 | = Λ A. Λ X. λ f. (f lnil).1 -β. 20 | 21 | cons' : ∀ A:★. ∀ n:Nat. A ➔ VecTree'·A n ➔ VecTree'·A (succ n) 22 | = Λ A. Λ n. λ a. λ l. Λ X. λ f. [c = (f lcons).2.1 -β] 23 | - c -n a (l f). 24 | 25 | branch' : ∀ A:★. ∀ a:Nat. ∀ b:Nat. VecTree'·A a ➔ VecTree'·A b ➔ VecTree'·A (add a b) 26 | = Λ A. Λ a. Λ b. λ v1. λ v2. Λ X. λ f. [br = (f lbranch).2.2 -β] 27 | - br -a -b (v1 f) (v2 f). 28 | 29 | VecTreeIndPack : Π A:★. (Π n:Nat. VecTree'·A n ➔ ★) ➔ Label ➔ ★ = λ A:★. λ P:Π n:Nat. VecTree'·A n ➔ ★. λ l:Label. ι _: 30 | {l ≃ lnil} ➾ P zero (nil'·A). ι _: 31 | {l ≃ lcons} ➾ ∀ m:Nat. ∀ v:VecTree'·A m. Π a:A. P m v ➔ P (succ m) (cons' -m a v). 32 | {l ≃ lbranch} ➾ ∀ a:Nat. ∀ b:Nat. ∀ v1:VecTree'·A a. ∀ v2:VecTree'·A b. P a v1 ➔ P b v2 ➔ P (add a b) (branch' -a -b v1 v2). 33 | 34 | VecTreeInd : Π A:★. Π n:Nat. VecTree'·A n ➔ ★ = λ A:★. λ n:Nat. λ v:VecTree'·A n. ∀ P: Π n:Nat. VecTree'·A n ➔ ★. 35 | (Π l:Label. VecTreeIndPack·A·P l) ➔ P n v. 36 | 37 | VecTree : ★ ➔ Nat ➔ ★ = λ A:★. λ n:Nat. ι v:VecTree'·A n. VecTreeInd·A n v. 38 | 39 | nil : ∀ A:★. VecTree·A zero 40 | = Λ A. [nil'·A, Λ P. λ f. (f lnil).1 -β]. 41 | 42 | cons : ∀ A:★. ∀ n:Nat. A ➔ VecTree·A n ➔ VecTree·A (succ n) 43 | = Λ A. Λ n. λ a. λ l. [cons' -n a l.1, Λ P. λ f. [c = (f lcons).2.1 -β] 44 | - c -n -l.1 a (l.2·P f)]. 45 | 46 | branch : ∀ A:★. ∀ a:Nat. ∀ b:Nat. VecTree·A a ➔ VecTree·A b ➔ VecTree·A (add a b) 47 | = Λ A. Λ a. Λ b. λ v1. λ v2. [branch'·A -a -b v1.1 v2.1, Λ P. λ f. [br = (f lbranch).2.2 -β] 48 | - br -a -b -v1.1 -v2.1 (v1.2·P f) (v2.2·P f)]. 49 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/README.md: -------------------------------------------------------------------------------- 1 | # File listings 2 | 3 | - `encoding.ced` 4 | The generic encoding of Mendler-style inductive types by Firsov et al. (2018). 5 | The file renames and re-exports definitions to match the interface used in the 6 | paper 7 | 8 | - `reuse.ced` 9 | Exports the implementaiton of the results used from Diehl et al. (2018) used in the paper: 10 | 11 | - `reuse/signature-subtyping.ced` 12 | Signature containment ("identity algebra" of Diehl et al.) 13 | 14 | - `reuse/fix2fix.ced` 15 | Non-indexed version of `ifix2fix` from Diehl et al. 16 | 17 | - `extensible-signature.ced` 18 | Exports definitions from: 19 | 20 | - `extensible-signatures/sig.ced` 21 | The generic signature `Sig` that over-approximates the scheme of encoding proposed 22 | in the paper 23 | 24 | - `extensible-signature/sub.ced` 25 | The sufficient condition for zero-cost reuse for inductive types defined using `Sig` 26 | 27 | - `examples/` 28 | 29 | - `nat-sig.ced`, `nat-ext.ced`, `nat.ced` 30 | Signature for natural numbers, extensible constructors and addition, and the inductive type Nat itself 31 | 32 | - `int-sig.ced`, `int-reuse-nat.ced`, `int.ced` 33 | Signature for integers, proof of inclusion of Nat signature into Int 34 | signature and generic reuse for Nat functions, the inductive type Int with 35 | `izero`, `isucc`, and addition reused from Nat. 36 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/encoding.ced: -------------------------------------------------------------------------------- 1 | import ../lib/lib . 2 | 3 | module generic/encoding (F: ★ ➔ ★) {mono: Monotonic ·F} . 4 | 5 | import encoding/alg as alg ·F . 6 | import encoding/prfalg as prfalg ·F -mono . 7 | import encoding/ind as ind ·F -mono . 8 | 9 | Alg : ★ ➔ ★ = alg.AlgM . 10 | PrfAlg : Π X: ★. (X ➔ ★) ➔ (F ·X ➔ X) ➔ ★ = prfalg.PrfAlgM . 11 | Ind : ★ = prfalg.IndM . 12 | in : F ·Ind ➔ Ind = prfalg.inIndM . 13 | out : Ind ➔ F ·Ind = ind.outM . 14 | induction : ∀ P: Ind ➔ ★. PrfAlg ·Ind ·P in ➔ Π x: Ind. P x 15 | = ind.inductionM . 16 | fold : ∀ X: ★. Alg ·X ➔ Ind ➔ X 17 | = ind.foldIndM . 18 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/encoding/alg.ced: -------------------------------------------------------------------------------- 1 | module generic/encoding/alg (F: ★ ➔ ★). 2 | 3 | AlgM : ★ ➔ ★ = λ X: ★. ∀ R: ★. (R ➔ X) ➔ F ·R ➔ X. 4 | FixM : ★ = ∀ X: ★. AlgM ·X ➔ X. 5 | 6 | foldM : ∀ X: ★. AlgM ·X ➔ FixM ➔ X 7 | = Λ X. λ alg. λ d. d alg. 8 | 9 | inM : F ·FixM ➔ FixM = λ ds. Λ X. λ alg. alg (foldM alg) ds. 10 | {- 1. We introduce our collection of subdata `ds` 11 | -- 2. We are given an arbitrary algebra 12 | -- 3. We give the algebra what it wants to compute X: something to make 13 | -- recursive calls with `(foldM alg)` (we may pick how to instantiate `R`) and 14 | -- some subdata to operate on. 15 | -} 16 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/encoding/ind.ced: -------------------------------------------------------------------------------- 1 | 2 | import ../../lib/lib. 3 | 4 | module generic/encoding/ind (F: ★ ➔ ★) {mono: Monotonic ·F}. 5 | 6 | import alg ·F. 7 | import prfalg ·F -mono. 8 | 9 | Lift : (IndM ➔ ★) ➔ FixM ➔ ★ 10 | = λ P: IndM ➔ ★. λ x: FixM. 11 | Sigma ·IndM ·(λ y: IndM. Sigma ·{y ≃ x} ·(λ eq: {y ≃ x}. P (φ eq - y { x }))). 12 | 13 | IhPlus : Π R: ★. Cast ·R ·FixM ➔ (IndM ➔ ★) ➔ ★ 14 | = λ R: ★. λ c: Cast ·R ·FixM. λ P: IndM ➔ ★. 15 | Π r: R. Lift ·P (elimCast -c r). 16 | 17 | castIhPlus 18 | : ∀ R: ★. ∀ c: Cast ·R ·FixM. ∀ P: IndM ➔ ★. IhPlus ·R c ·P ➔ Cast ·R ·IndM 19 | = Λ R. Λ c. Λ P. λ ih. 20 | intrCast (λ r. proj1 (ih r)) (λ r. proj1 (proj2 (ih r))). 21 | 22 | prfIhPlus 23 | : ∀ R: ★. ∀ c: Cast ·R ·FixM. ∀ P: IndM ➔ ★. Π ih: IhPlus ·R c ·P. 24 | Π r: R. P (elimCast -(castIhPlus -c ih) r) 25 | = Λ R. Λ c. Λ P. λ ih. λ r. 26 | (proj2 (proj2 (ih r))). 27 | 28 | 29 | convAlg : ∀ P: IndM ➔ ★. PrfAlgM ·IndM ·P inIndM ➔ PrfAlgM ·FixM ·(Lift ·P) inM 30 | = Λ P. λ alg. Λ R. Λ c. λ ih. λ xs. 31 | [c' = castIhPlus -c ih] -- by the IH, there is a "reflection-like" identity function 32 | - [x = inIndM (elimCast -(mono c') xs)] -- reflect inM xs: FixM to inIndM xs: FixIndM 33 | - [ih' = prfIhPlus -c ih] 34 | - mksigma x (mksigma β (alg ·R -c' ih' xs)). 35 | 36 | inductionM : ∀ P: IndM ➔ ★. PrfAlgM ·IndM ·P inIndM ➔ Π d: IndM. P d 37 | = Λ P. λ alg. λ d. proj2 (proj2 (d.2 (convAlg alg))). 38 | 39 | outM : IndM ➔ F ·IndM 40 | = inductionM ·(λ _: IndM. F ·IndM) (Λ R. Λ c. λ _. λ xs. elimCast -(mono c) xs). 41 | 42 | foldIndM : ∀ X: ★. AlgM ·X ➔ IndM ➔ X 43 | = Λ X. λ a. inductionM ·(λ _: IndM. X) (Λ R. Λ _. a ·R) . 44 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/encoding/prfalg.ced: -------------------------------------------------------------------------------- 1 | 2 | import ../../lib/lib. 3 | 4 | module generic/encoding/prfalg (F: ★ ➔ ★) {mono: Monotonic ·F}. 5 | 6 | import alg ·F. 7 | 8 | PrfAlgM : Π X: ★. (X ➔ ★) ➔ (F ·X ➔ X) ➔ ★ 9 | = λ X: ★. λ P: X ➔ ★. λ in: F ·X ➔ X. 10 | ∀ R: ★. ∀ c: Cast ·R ·X. Π ih: (Π r: R. P (elimCast -c r)). 11 | Π rs: F ·R. P (in (elimCast -(mono c) rs)). 12 | 13 | InductiveM : FixM ➔ ★ 14 | = λ x: FixM. ∀ P: FixM ➔ ★. PrfAlgM ·FixM ·P inM ➔ P x. 15 | 16 | IndM : ★ = ι x: FixM. InductiveM x. 17 | 18 | toFixM : Cast ·IndM ·FixM 19 | = intrCast (λ x. x.1) (λ _. β). 20 | 21 | inIndM1 : F ·IndM ➔ FixM 22 | = λ xs. inM (elimCast -(mono toFixM) xs). 23 | 24 | _ : {inIndM1 ≃ inM} = β. 25 | 26 | inIndM2 : Π xs: F ·IndM. InductiveM (inIndM1 xs) 27 | = λ xs. Λ P. λ alg. alg -toFixM (λ d. d.2 alg) xs. 28 | 29 | _ : {inIndM2 ≃ inM} = β. 30 | 31 | inIndM : F ·IndM ➔ IndM 32 | = λ xs. [ inIndM1 xs , inIndM2 xs ]. 33 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/examples/int-ext.ced: -------------------------------------------------------------------------------- 1 | import ../../lib/lib . 2 | import ../reuse . 3 | 4 | import int-sig . 5 | import int-reuse-nat . 6 | import nat-sig . 7 | 8 | module generic/examples/int-ext (F: ★ ➔ ★) {mono: Monotonic ·F} {sub: SigSub ·IntSig ·F} . 9 | 10 | subNat : SigSub ·NatSig ·F 11 | = sigsubTrans -snat2sint -sub . 12 | 13 | int2sigf : ∀ X: ★. IntSig ·X ➔ F ·X 14 | = Λ X. cast -(sub -(castRefl ·X)) . 15 | 16 | import ../encoding as D ·F -mono . 17 | import ../encoding as Nat ·NatSig -monoNatSig . 18 | import ../encoding as Int ·IntSig -monoIntSig . 19 | 20 | import nat-ext ·F -mono -subNat . 21 | 22 | izeroE : D.Ind = zeroE . 23 | isuccE : D.Ind ➔ D.Ind = succE . 24 | ipredE : D.Ind ➔ D.Ind 25 | = λ n. D.in (int2sigf (ipredS n)) . 26 | 27 | iaddAlg : Int.Alg ·(D.Ind ➔ D.Ind) 28 | = nat2intalg addAlg 29 | (Λ R. λ iadd. λ m. λ n. 30 | ipredE (iadd (m.2.2.1 -β) n)) . 31 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/examples/int-reuse-nat.ced: -------------------------------------------------------------------------------- 1 | import ../../lib/lib . 2 | 3 | module generic/examples/int-reuse-nat . 4 | 5 | import nat-sig . 6 | import int-sig . 7 | 8 | nat2intPack : Π l: Label. ∀ R: ★. Cast ·(NatPack l ·R) ·(IntPack l ·R) 9 | = λ l. Λ R. 10 | intrCastI (λ x. [[x.1, [x.2.1, 11 | [Λ e. x.2.2 12 | -([Λ n. [k:{lpred ≃ lzero} = ρ ς e - ρ ς n - β] - δ - k, 13 | Λ n. [k:{lpred ≃ lsucc} = ρ ς e - ρ ς n - β] - δ - k]) ·R, 14 | Λ e. x.2.2 -[e.1, e.2.1] 15 | ]]], 16 | β{x}]). 17 | 18 | import ../reuse . 19 | import ../extensible-signature . 20 | 21 | snat2sint : SigSub ·NatSig ·IntSig 22 | = sigsub -monoNatPack -monoIntPack (castRefl ·Label) nat2intPack . 23 | 24 | import ../encoding as Nat ·NatSig -monoNatSig . 25 | import ../encoding as Int ·IntSig -monoIntSig . 26 | import ../encoding as PredInt ·(IntPack lpred) -(monoIntPack lpred) . 27 | 28 | nat2intalg : ∀ X: ★. Nat.Alg ·X ➔ PredInt.Alg ·X ➔ Int.Alg ·X 29 | = Λ X. λ a. λ p. Λ R. λ rec. λ i. 30 | caseIntSig i (a rec (zeroS ·R)) (λ i'. a rec (succS i')) (λ i'. p rec (ipredP i')) . 31 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/examples/int.ced: -------------------------------------------------------------------------------- 1 | import ../../lib/lib. 2 | 3 | import int-sig . 4 | 5 | import ../encoding ·IntSig -monoIntSig . 6 | 7 | module generic/examples/int . 8 | 9 | import int-reuse-nat . 10 | import nat-ext ·IntSig -monoIntSig -snat2sint . 11 | 12 | Int : ★ = Ind . 13 | 14 | izero = zeroE . 15 | isucc = succE . 16 | ipred : Int ➔ Int = λ i. in (ipredS i) . 17 | 18 | -- some functions 19 | 20 | import ../encoding as PredInt ·(IntPack lpred) -(monoIntPack lpred) . 21 | addPred : PredInt.Alg ·(Int ➔ Int) 22 | = Λ R. λ add. λ m. λ n. 23 | ipred (add (m.2.2.1 -β) n) . 24 | 25 | addInt : Int ➔ Int ➔ Int 26 | = fold (nat2intalg addE addPred) . 27 | 28 | _ : { addInt (isucc izero) (ipred izero) ≃ isucc (ipred izero)} = β . 29 | 30 | {- 31 | foldIntG : ∀ X: ★. (SIntPack lzero ·X ➔ X) ➔ (SIntPack lsucc ·X ➔ X) ➔ (SIntPack lpred ·X ➔ X) ➔ Int ➔ X 32 | = Λ X. λ z. λ s. λ p. 33 | induction ·(λ i: Int. X) 34 | Λ R. Λ c. λ ih. 35 | indSigma ·Label ·(λ l: Label. SIntPack l ·R) ·(λ x: SInt ·R. X) 36 | λ l. λ ctors. caseSIntPack z s p l (fmapSIntPack ih l ctors) 37 | . 38 | 39 | caseIntG : ∀ I: ★. ∀ X: ★. X ➔ (I ➔ X) ➔ (I ➔ X) ➔ SInt ·I ➔ X 40 | = Λ I. Λ X. λ z. λ s. λ p. 41 | indSigma ·Label ·(λ l: Label. SIntPack l ·I) ·(λ _: SInt ·I. X) 42 | λ l. σ (eq l lzero) @(λ x: Bool. { eq l lzero ≃ x } ➾ SIntPack l ·I ➔ X) { 43 | | tt ➔ Λ e. λ _. z 44 | | ff ➔ Λ e. σ (eq l lsucc) @(λ x: Bool. { eq l lsucc ≃ x } ➾ SIntPack l ·I ➔ X) { 45 | | tt ➔ Λ e'. λ x. s (x.2.1 -(exact l lsucc e')) 46 | | ff ➔ Λ e'. σ (eq l lpred) @(λ x: Bool. { eq l lpred ≃ x } ➾ SIntPack l ·I ➔ X) { 47 | | tt ➔ Λ e''. λ x. p (x.2.2.1 -(exact l lpred e'')) 48 | | ff ➔ Λ e''. λ x. 49 | x.2.2.2 -[ nexact l lzero e , [ nexact l lsucc e' , nexact l lpred e'' ]] ·X 50 | } -β 51 | } -β 52 | } -β 53 | . 54 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/examples/nat-ext.ced: -------------------------------------------------------------------------------- 1 | import ../../lib/lib . 2 | 3 | import nat-sig . 4 | 5 | import ../reuse . 6 | 7 | module generic/examples/nat-ext (F: ★ ➔ ★) {mono: Monotonic ·F} {sub: SigSub ·NatSig ·F} . 8 | 9 | import ../encoding as D ·F -mono . 10 | import ../encoding as Nat ·NatSig -monoNatSig . 11 | 12 | natsig2f : ∀ X: ★. NatSig ·X ➔ F ·X 13 | = Λ X. cast -(sub -(castRefl ·X)) . 14 | 15 | zeroE : D.Ind 16 | = D.in (natsig2f (zeroS ·D.Ind)) . 17 | 18 | succE : D.Ind ➔ D.Ind 19 | = λ n. D.in (natsig2f (succS n)) . 20 | 21 | addAlg : Nat.Alg ·(D.Ind ➔ D.Ind) 22 | = Λ R. λ add. λ m. λ n. 23 | caseNatSig m ·D.Ind n 24 | (λ m'. succE (add m' n)) 25 | . 26 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/examples/nat-sig.ced: -------------------------------------------------------------------------------- 1 | import ../../lib/lib. 2 | 3 | module generic/examples/nat-sig . 4 | 5 | NatPack : Label ➔ ★ ➔ ★ 6 | = λ l: Label. λ R: ★. 7 | ι _: {l ≃ lzero} ➾ Unit. ι _: {l ≃ lsucc} ➾ R. (ι _:Not·{l ≃ lzero}. Not·{l ≃ lsucc}) ➾ False. 8 | 9 | monoNatPack : Π l: Label. Monotonic ·(NatPack l) 10 | = λ l. Λ R1. Λ R2. λ c. 11 | intrCastI 12 | (λ x. [[x.1, [Λ e. cast -c (x.2.1 -e), Λ e. x.2.2 -e]], β{x}]) 13 | . 14 | 15 | import ../extensible-signature ·Label ·NatPack -monoNatPack . 16 | 17 | NatSig : ★ ➔ ★ = Sig . 18 | monoNatSig = monoSig . 19 | 20 | zeroP : ∀ N: ★. NatPack lzero ·N 21 | = Λ N. [ Λ _. unit , [ Λ e. explode' -(δ - e) β{unit} , 22 | Λ e. explode' -(e.1 -β) β{unit} ] ] . 23 | 24 | succP : ∀ N: ★. N ➔ NatPack lsucc ·N 25 | = Λ N. λ n. [ Λ e. explode' -(δ - e) β{n} , [ Λ _. n , 26 | Λ e. explode' -(e.2 -β) β{n} ] ] . 27 | 28 | zeroS : ∀ N: ★. NatSig ·N = Λ N. mksigma lzero (zeroP ·N) . 29 | 30 | succS : ∀ N: ★. N ➔ NatSig ·N = Λ N. λ n. mksigma lsucc (succP n) . 31 | 32 | caseNatSig : ∀ N: ★. NatSig ·N ➔ ∀ X: ★. X ➔ (N ➔ X) ➔ X 33 | = Λ N. λ n. Λ X. λ z. λ s. 34 | indSigma ·Label ·(λ l: Label. NatPack l ·N) ·(λ _: NatSig ·N. X) 35 | (λ l. μ' (eq l lzero) @(λ x: Bool. { eq l lzero ≃ x } ➾ NatPack l ·N ➔ X) { 36 | | tt ➔ Λ e. λ _. z 37 | | ff ➔ Λ e. μ' (eq l lsucc) @(λ x: Bool. { eq l lsucc ≃ x} ➾ NatPack l ·N ➔ X) { 38 | | tt ➔ Λ e'. λ x. s (x.2.1 -(exact l lsucc e')) 39 | | ff ➔ Λ e'. λ x. x.2.2 -[ nexact l lzero e , nexact l lsucc e' ] ·X 40 | } -β 41 | } -β) n 42 | . 43 | 44 | _ : ∀ z: Top. ∀ s: Top. {caseNatSig zeroS z s ≃ z } = Λ _. Λ _. β . 45 | _ : ∀ z: Top. ∀ s: Top. ∀ n: Top. {caseNatSig (succS n) z s ≃ s n} 46 | = Λ _. Λ _. Λ _. β . 47 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/examples/nat.ced: -------------------------------------------------------------------------------- 1 | import ../../lib/lib. 2 | 3 | import ../reuse . 4 | import nat-sig . 5 | import nat-ext ·NatSig -monoNatSig -(sigsubRefl -monoNatSig) . 6 | import ../encoding ·NatSig -monoNatSig . 7 | 8 | module nat . 9 | 10 | Nat : ★ = Ind . 11 | 12 | zero = zeroE . 13 | succ = succE . 14 | 15 | indNat : ∀ P: Nat ➔ ★. P zero ➔ (Π x: Nat. P x ➔ P (succ x)) ➔ Π n: Nat. P n 16 | = Λ P. λ z. λ s. induction ·P (Λ R. Λ c. λ ih. indSigma ·Label ·(λ l:Label. NatPack l ·R) 17 | ·(λ xs:NatSig ·R. P (in (cast -(monoNatSig c) xs))) 18 | (λ l. λ ctors. μ' (eq l lzero) @ λ b:Bool. {eq l lzero ≃ b} ➔ P (in (cast -(monoNatSig c) (mksigma l ctors))) { 19 | | tt ➔ λ e. [e = exact l lzero e] - [u = ctors.1 -e] - [u':{ctors ≃ u} = β] - ρ e - ρ u' 20 | - μ' u @ λ x:Unit. ∀ eq:{x ≃ u}. P (in (cast -(monoNatSig c) (mksigma lzero [Λ _. x, [Λ e. explode' -(δ - e) β{x}, Λ e. explode' -(e.1 -β) β{x}]]))) { 21 | | unit ➔ Λ _. z 22 | } -β 23 | | ff ➔ λ e1. [e1 = nexact l lzero e1] - μ' (eq l lsucc) @ λ b:Bool. {eq l lsucc ≃ b} ➾ P (in (cast -(monoNatSig c) (mksigma l ctors))) { 24 | | tt ➔ Λ e. [e = exact l lsucc e] - [r = ctors.2.1 -e] - ρ e - s (cast -c r) (ih r) 25 | | ff ➔ Λ e2. [e2 = nexact l lsucc e2] - [boom = ctors.2.2 -[e1, e2]] - explode boom 26 | } -β 27 | } β)). 28 | 29 | -- some functions 30 | 31 | nadd : Nat ➔ Nat ➔ Nat 32 | = fold addAlg . 33 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/extensible-signature.ced: -------------------------------------------------------------------------------- 1 | import ../lib/lib . 2 | 3 | module generic/extensible-signature (L: ★) (B: L ➔ ★ ➔ ★) {monoB : Π l: L. Monotonic ·(B l)} . 4 | 5 | import public extensible-signature.sig ·L ·B -monoB . 6 | import public extensible-signature.sub . 7 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/extensible-signature/sig.ced: -------------------------------------------------------------------------------- 1 | 2 | import ../../lib/lib. 3 | 4 | module extensible-signature/sig (A: ★) (B: A ➔ ★ ➔ ★) {monoB: Π a: A. Monotonic ·(B a)} . 5 | 6 | -- CtArgs : ★ ➔ A ➔ ★ = λ R: ★. λ a: A. B a ·R. 7 | Sig : ★ ➔ ★ = λ R: ★. Sigma ·A ·(λ a: A. B a ·R) . 8 | 9 | monoSig : Monotonic ·Sig 10 | = Λ R1. Λ R2. λ c. 11 | intrCastI 12 | (indSigma ·A ·(λ a: A. B a ·R1) 13 | ·(λ x: Sig ·R1. ι y: Sig ·R2. { y ≃ x }) 14 | (λ a. λ b. 15 | [lem: Cast ·(B a ·R1) ·(B a ·R2) 16 | = intrCastI (λ x. [cast -(monoB a c) x, β{x}])] 17 | - [mksigma a (cast -lem b), β{mksigma a b}])) 18 | . 19 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/extensible-signature/sub.ced: -------------------------------------------------------------------------------- 1 | import ../../lib/lib. 2 | import ../reuse/signature-subtyping . 3 | 4 | 5 | module generic/extensigble-signature/sub 6 | (A1: ★) (B1: A1 ➔ ★ ➔ ★) {monoB1: Π a: A1. Monotonic ·(B1 a)} 7 | (A2: ★) (B2: A2 ➔ ★ ➔ ★) {monoB2: Π a: A2. Monotonic ·(B2 a)} . 8 | 9 | import sig as F ·A1 ·B1 -monoB1 . 10 | import sig as G ·A2 ·B2 -monoB2 . 11 | 12 | -- if 13 | -- 1. the labels for F are a subtype of the labels for G 14 | -- 2. and, for every label element a and type R, the collection of constructors arguments 15 | -- at that label is a subtype of the collection at the same label (under inclusion) of G 16 | -- 17 | -- then, F is a sub-signature of G 18 | 19 | sigsub 20 | : Π c: Cast ·A1 ·A2. (Π a1: A1. ∀ R: ★. Cast ·(B1 a1 ·R) ·(B2 (elimCast -c a1) ·R)) ➔ 21 | SigSub ·F.Sig ·G.Sig 22 | = λ cA. λ cC. Λ R1. Λ R2. Λ cR. 23 | intrCastI 24 | (indSigma ·A1 ·(λ a: A1. B1 a ·R1) ·(λ x: F.Sig ·R1. ι y: G.Sig ·R2. { y ≃ x }) 25 | (λ a1. λ ctor. 26 | [lem : Cast ·(B1 a1 ·R1) ·(B1 a1 ·R2) = monoB1 a1 cR] 27 | - [ mksigma (elimCast -cA a1) (elimCast -(cC a1 ·R2) (elimCast -lem ctor)) , β{mksigma a1 ctor} ])) . 28 | 29 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/reuse.ced: -------------------------------------------------------------------------------- 1 | module generic/reuse . 2 | 3 | import public reuse/signature-subtyping . 4 | import public reuse/fix2fix . 5 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/reuse/fix2fix.ced: -------------------------------------------------------------------------------- 1 | import ../../lib/lib. 2 | import signature-subtyping . 3 | 4 | module generic/reuse/fix2fix (F: ★ ➔ ★) {monoF: Monotonic ·F} (G: ★ ➔ ★) {monoG: Monotonic ·G} {sigsub: SigSub ·F ·G}. 5 | 6 | import ../encoding as FixF ·F -monoF . 7 | import ../encoding as FixG ·G -monoG . 8 | 9 | -- the least fixpoints of sub-signatures are in a subtype relation notice that 10 | -- no details of the particular fixpoint encoding are needed (this could 11 | -- probably be formalized by making them module parameters) 12 | fix2fix : Cast ·FixF.Ind ·FixG.Ind 13 | = intrCastI 14 | (FixF.induction ·(λ x: FixF.Ind. ι y: FixG.Ind. { y ≃ x }) 15 | (Λ R. Λ c. λ ih. λ xs. 16 | [c' : Cast ·R ·FixG.Ind = intrCastI ih] 17 | - [ FixG.in (elimCast ·(F ·R) -(sigsub -c') xs) , β{ FixG.in xs } ])) 18 | . 19 | -------------------------------------------------------------------------------- /constructor-subtyping/generic/reuse/signature-subtyping.ced: -------------------------------------------------------------------------------- 1 | module generic/reuse/sigsub . 2 | 3 | import ../../lib/lib. 4 | 5 | SigSub : (★ ➔ ★) ➔ (★ ➔ ★) ➔ ★ 6 | = λ F: ★ ➔ ★. λ G: ★ ➔ ★. ∀ X: ★. ∀ Y: ★. Cast ·X ·Y ➾ Cast ·(F ·X) ·(G ·Y) . 7 | 8 | sigsubRefl : ∀ F: ★ ➔ ★. Monotonic ·F ➾ SigSub ·F ·F 9 | = Λ F. Λ mono. Λ X. Λ Y. Λ c. intrCast (elimCast -(mono c)) (λ _. β) . 10 | 11 | sigsubTrans 12 | : ∀ F: ★ ➔ ★. ∀ G: ★ ➔ ★. ∀ H: ★ ➔ ★. 13 | SigSub ·F ·G ➾ SigSub ·G ·H ➾ SigSub ·F ·H 14 | = Λ F. Λ G. Λ H. Λ s1. Λ s2. Λ X. Λ Y. Λ c. 15 | intrCast 16 | (λ x. elimCast -(s2 -c) (elimCast -(s1 -(castRefl ·X)) x)) 17 | (λ x. β) . 18 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/bool.ced: -------------------------------------------------------------------------------- 1 | module bool. 2 | 3 | data Bool : ★ = 4 | | tt : Bool 5 | | ff : Bool. 6 | 7 | and : Bool ➔ Bool ➔ Bool 8 | = λ a. λ b. μ' a { 9 | | tt ➔ μ' b { 10 | | tt ➔ tt 11 | | ff ➔ ff 12 | } 13 | | ff ➔ μ' b { 14 | | tt ➔ ff 15 | | ff ➔ ff 16 | } 17 | }. 18 | 19 | or : Bool ➔ Bool ➔ Bool 20 | = λ a. λ b. μ' a { 21 | | tt ➔ μ' b { 22 | | tt ➔ tt 23 | | ff ➔ tt 24 | } 25 | | ff ➔ μ' b { 26 | | tt ➔ tt 27 | | ff ➔ ff 28 | } 29 | }. 30 | 31 | iff : Bool ➔ Bool ➔ Bool 32 | = λ a. λ b. μ' a { 33 | | tt ➔ μ' b { 34 | | tt ➔ tt 35 | | ff ➔ ff 36 | } 37 | | ff ➔ μ' b { 38 | | tt ➔ ff 39 | | ff ➔ tt 40 | } 41 | }. 42 | 43 | negate : Bool ➔ Bool 44 | = λ a. μ' a { 45 | | tt ➔ ff 46 | | ff ➔ tt 47 | }. 48 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/cast.ced: -------------------------------------------------------------------------------- 1 | module cast. 2 | 3 | Cast ◂ ★ ➔ ★ ➔ ★ = λ A: ★. λ B: ★. ι cast: A ➔ B. {cast ≃ λ x. x}. 4 | 5 | intrCast ◂ ∀ A: ★. ∀ B: ★. Π f: A ➔ B. (Π a: A. {f a ≃ a}) ➔ Cast ·A ·B 6 | = Λ A. Λ B. λ f. λ eq. [λ x. φ (eq x) - (f x) { x } , β]. 7 | 8 | intrCastI : ∀ A: ★. ∀ B: ★. (Π x: A. ι y: B. {y ≃ x}) ➔ Cast ·A ·B 9 | = Λ A. Λ B. λ f. intrCast (λ x. (f x).1) (λ x. (f x).2) . 10 | 11 | elimCast ◂ ∀ A: ★. ∀ B: ★. Cast ·A ·B ➾ A ➔ B 12 | = Λ A. Λ B. Λ c. λ a. φ (ρ c.2 - β) - (c.1 a) { a }. 13 | 14 | cast = elimCast. 15 | 16 | castComp ◂ ∀ A: ★. ∀ B: ★. ∀ C: ★. Cast ·A ·B ➔ Cast ·B ·C ➔ Cast ·A ·C 17 | = Λ A. Λ B. Λ C. λ c1. λ c2. [λ a. elimCast -c2 (elimCast -c1 a) , β]. 18 | 19 | castId ◂ ∀ A: ★. Cast ·A ·A 20 | = Λ A. [λ a. a , β]. 21 | 22 | castTrans = castComp . 23 | castRefl = castId . 24 | 25 | Monotonic ◂ (★ ➔ ★) ➔ ★ 26 | = λ F: ★ ➔ ★. ∀ X: ★. ∀ Y: ★. Cast ·X ·Y ➔ Cast ·(F ·X) ·(F ·Y). 27 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/castDep.ced: -------------------------------------------------------------------------------- 1 | module castDep. 2 | 3 | -- Dependent cast 4 | CastDep : Π A: ★. Π B: A ➔ ★. ★ 5 | = λ A: ★. λ B: A ➔ ★. ι f: Π a: A. B a. {f ≃ λ x. x}. 6 | 7 | intrCastDep : ∀ A: ★. ∀ B: A ➔ ★. ∀ f: Π a: A. B a. (Π a: A. {f a ≃ a}) ➾ CastDep ·A ·B 8 | = Λ A. Λ B. Λ f. Λ eq. [ λ a. φ (eq a) - (f a) {a} , β]. 9 | 10 | elimCastDep : ∀ A: ★. ∀ B: A ➔ ★. CastDep ·A ·B ➾ Π a: A. B a 11 | = Λ A. Λ B. Λ c. φ c.2 - c.1 {λ x. x}. 12 | 13 | trivCastDep : ∀ A: ★. CastDep ·A ·(λ _: A. A) 14 | = Λ A. intrCastDep -(λ x. x) -(λ _. β). 15 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/label.ced: -------------------------------------------------------------------------------- 1 | import bool. 2 | import not. 3 | module label. 4 | 5 | data Label : ★ = 6 | | l0 : Label 7 | | lnext : Label ➔ Label. 8 | 9 | eq : Label ➔ Label ➔ Bool 10 | = λ a. μ rec. a { 11 | | l0 ➔ λ b. μ' b { 12 | | l0 ➔ tt 13 | | lnext l ➔ ff 14 | } 15 | | lnext u ➔ λ b. μ' b { 16 | | l0 ➔ ff 17 | | lnext v ➔ rec u v 18 | } 19 | }. 20 | 21 | eqRefl : Π a:Label. {eq a a ≃ tt} 22 | = λ a. μ ih. a { 23 | | l0 ➔ β 24 | | lnext l ➔ [h = ih l] - ρ+ h - β 25 | }. 26 | 27 | exact : Π a:Label. Π b:Label. {eq a b ≃ tt} ➔ {a ≃ b} 28 | = λ a. μ ih. a { 29 | | l0 ➔ λ b. μ' b { 30 | | l0 ➔ λ e. β 31 | | lnext l ➔ λ e. δ - e 32 | } 33 | | lnext u ➔ λ b. μ' b { 34 | | l0 ➔ λ e. δ - e 35 | | lnext v ➔ λ e. [h = ih u v e] - ρ h - β 36 | } 37 | }. 38 | 39 | nexact : Π a:Label. Π b:Label. {eq a b ≃ ff} ➔ Not·{a ≃ b} 40 | = λ a. λ b. λ e. Λ n. [k : {eq a a ≃ ff} = ρ<2> n - ρ e - β] 41 | - [r : {tt ≃ ff} = ρ ς (eqRefl a) - ρ k - β] 42 | - δ - r. 43 | 44 | lte : Label ➔ Label ➔ Bool 45 | = λ l1. 46 | μ lte. l1 { 47 | | l0 ➔ λ _. tt 48 | | lnext l1' ➔ λ l2. 49 | μ' l2 { 50 | | l0 ➔ ff 51 | | lnext l2' ➔ lte l1' l2' 52 | } 53 | } . 54 | 55 | lt : Label ➔ Label ➔ Bool 56 | = λ l1. lte (lnext l1) . 57 | 58 | lzero = l0. 59 | lsucc = lnext lzero. 60 | lpred = lnext lsucc. 61 | lratio = lnext lpred. 62 | lvar = lnext lratio. 63 | labs = lnext lvar. 64 | lapp = lnext labs. 65 | lnil = lnext lapp. 66 | lcons = lnext lnil. 67 | lbranch = lnext lcons. 68 | lbase = lnext lbranch. 69 | larr = lnext lbase. 70 | lnat = lnext larr. 71 | lnum = lnext lnat. 72 | ladd = lnext lnum. 73 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/lib.ced: -------------------------------------------------------------------------------- 1 | module lib. 2 | 3 | import public bool. 4 | import public cast. 5 | import public not. 6 | import public sigma. 7 | import public unit. 8 | import public label. 9 | import public castDep. 10 | import public top. 11 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/not.ced: -------------------------------------------------------------------------------- 1 | 2 | import top. 3 | 4 | module not. 5 | 6 | False : ★ = ∀ X: ★. X. 7 | Not : ★ ➔ ★ = λ A: ★. A ➾ False. 8 | 9 | explode : ∀ X: ★. False ➔ X = Λ X. λ f. f ·X. 10 | 11 | explode' : ∀ X:★. False ➾ Top ➔ X 12 | = Λ X. Λ f. λ t. φ (f·{f ≃ t}) - (f·X) {t}. 13 | 14 | falseIrrel : False ➾ False 15 | = Λ b. δ - b ·{λ x. λ y. x ≃ λ x. λ y. y}. 16 | 17 | not' : ∀ X: ★. Not ·X ➾ Top ➔ Not ·X 18 | = Λ X. Λ n. λ t. Λ x. explode' -(n -x) t . 19 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/sigma.ced: -------------------------------------------------------------------------------- 1 | module Sigma . 2 | 3 | cSigma ◂ Π A : ★ . (A ➔ ★) ➔ ★ = 4 | λ A : ★ . λ B : A ➔ ★ . 5 | ∀ X : ★ . (Π a : A . B a ➔ X) ➔ X . 6 | 7 | mkcsigma ◂ ∀ X : ★ . ∀ Y : X ➔ ★ . Π x : X . Y x ➔ cSigma · X · Y = 8 | Λ X . Λ Y . λ x . λ y . Λ Z . λ c . c x y . 9 | 10 | param-Sigma ◂ Π A : ★ . Π P : A ➔ ★ . cSigma · A · P ➔ ★ = 11 | λ A : ★ . λ P : A ➔ ★ . λ x : cSigma · A · P . 12 | ∀ X : ★ . ∀ Q : X ➔ ★ . ∀ pr : Π a : A . P a ➔ X . 13 | (Π a : A . Π b : P a . Q (pr a b)) ➔ Q (x · X pr). 14 | 15 | 16 | Sigma ◂ Π A : ★ . (A ➔ ★) ➔ ★ = 17 | λ A : ★ . λ PA : A ➔ ★ . 18 | ι d : cSigma · A · PA . 19 | ι _ : {d mkcsigma ≃ d} . param-Sigma · A · PA d . 20 | 21 | Pair ◂ ★ ➔ ★ ➔ ★ = λ A: ★. λ B: ★. Sigma ·A ·(λ _: A. B). 22 | 23 | mksigma ◂ ∀ X : ★ . ∀ Y : X ➔ ★ . Π x : X . Y x ➔ Sigma · X · Y = 24 | Λ X . Λ Y . λ x . λ y . [ mkcsigma · X · Y x y , [ β{ mkcsigma x y } , Λ X' . Λ Q . Λ pr . λ e . e x y ] ] . 25 | 26 | pair : ∀ X: ★. ∀ Y: ★. X ➔ Y ➔ Pair ·X ·Y 27 | = Λ X. Λ Y. λ x. λ y. mksigma x y. 28 | 29 | indSigma 30 | : ∀ A: ★. ∀ B: A ➔ ★. 31 | ∀ P: Sigma ·A ·B ➔ ★. (Π a: A. Π b: B a. P (mksigma ·A ·B a b)) ➔ 32 | Π x: Sigma ·A ·B. P x 33 | = Λ A. Λ B. Λ P. λ p. λ x. ρ ς x.2.1 - (x.2.2 ·(Sigma ·A ·B) ·P -(mksigma ·A ·B) p) . 34 | 35 | proj1 ◂ ∀ A : ★ . ∀ B : A ➔ ★ . Sigma · A · B ➔ A = Λ A . Λ B . λ s . s.1 · A (λ a . λ _ . a). 36 | 37 | proj2 ◂ ∀ A : ★. ∀ B : A ➔ ★. Π s : Sigma · A · B. B (proj1 · A · B s) = 38 | Λ A. Λ B. indSigma ·A ·B ·(λ s: Sigma ·A ·B. B (proj1 s)) (λ a. λ b. b). 39 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/top.ced: -------------------------------------------------------------------------------- 1 | module top. 2 | 3 | Top : ★ = {β ≃ β}. 4 | -------------------------------------------------------------------------------- /constructor-subtyping/lib/unit.ced: -------------------------------------------------------------------------------- 1 | module unit . 2 | 3 | data Unit: ★ 4 | = unit: Unit . 5 | -------------------------------------------------------------------------------- /efficient-mendler-codata/.cedille/options: -------------------------------------------------------------------------------- 1 | -- Cedille Options File 2 | 3 | -- List of directories to search for imported files in 4 | -- Each directory should be space-delimited and inside double quotes 5 | -- The current file's directory is automatically searched first, before import-directories 6 | -- If a filepath is relative, it is considered relative to this options file 7 | import-directories = ".". 8 | 9 | -- Cache navigation spans for performance 10 | use-cede-files = false. 11 | 12 | -- Write logs to ~/.cedille/log 13 | generate-logs = false. 14 | 15 | -- Print variables fully qualified 16 | show-qualified-vars = false. 17 | 18 | -- Print types erased 19 | erase-types = true. 20 | 21 | -- Preferred number of columns to pretty print elaborated files with 22 | pretty-print-columns = 80. 23 | 24 | -------------------------------------------------------------------------------- /efficient-mendler-codata/README.org: -------------------------------------------------------------------------------- 1 | * Efficient Lambda Encodings for Mendler-style Coinductive Types in Cedille 2 | 3 | File [[file:everything.ced][everything.ced]] imports all code for the development 4 | 5 | ** Generic derivation of coinductive datatypes 6 | 7 | Found in [[file:nu/nu.ced][nu/nu.ced]]. The generic coinductive datatype is ~Nu~, with generator 8 | ~unfoldM~, constructor ~inM~, and destructor ~outM~. 9 | 10 | The proofs found in [[file:nu/lambek.ced][nu/lambek.ced]] point to a current gap in Cedille's theory: 11 | one direction of /Lambek's lemma/ (and the codatatype reflection law) does not 12 | hold for Cedille's currently intensional equality type, suggesting the need for 13 | an /extensional/ equality type. 14 | 15 | ** Examples: programming with streams 16 | 17 | - [[file:examples/streamf.ced][examples/streamf.ced]] give the definition of the stream type as well as its 18 | destructors and generator 19 | - [[file:examples/stream.ced][examples/stream.ced]] show some examples of programming with streams using 20 | coiteration, corecursion, and course-of-values coiteration. 21 | 22 | ** Examples: proving properties of streams 23 | 24 | - [[file:examples/streamrelf.ced][examples/streamrelf.ced]] defines the type family ~StreamRel~ of generalized 25 | relations between streams 26 | - [[file:examples/streamrel.ced][examples/streamrelf.ced]] shows proofs that if the relation on elements of 27 | streams satisfies certain properties, those properties hold also for ~StreamRel~ 28 | -------------------------------------------------------------------------------- /efficient-mendler-codata/everything.ced: -------------------------------------------------------------------------------- 1 | module everything . 2 | 3 | -- utility definitions, including casts and monotone recursive types 4 | import utils. 5 | 6 | -- the generic derivation of coinductive datatypes 7 | import nu/nu. 8 | 9 | -- counter-example to one half of Lambek's lemma for the derived codata 10 | import nu/lambek. 11 | 12 | -- examples: programming with streams 13 | import examples/streamf. 14 | import examples/stream. 15 | 16 | -- examples: proofs about generalized relations for streams 17 | import examples/streamrelf. 18 | import examples/streamrel. 19 | -------------------------------------------------------------------------------- /efficient-mendler-codata/examples/streamf.ced: -------------------------------------------------------------------------------- 1 | import utils. 2 | -- import utils/unit. 3 | -- import utils/castidx ·Unit. 4 | -- import utils/sigma. 5 | 6 | module examples/streamf (A: ★). 7 | 8 | StreamF : (Unit ➔ ★) ➔ Unit ➔ ★ 9 | = λ R: Unit ➔ ★. λ u: Unit. Pair ·A ·(R u). 10 | 11 | monoStreamF : Mono ·Unit ·StreamF = 12 | intrMono -(Λ R1. Λ R2. Λ c. 13 | intrCast 14 | -(Λ i. λ p. intrPair (fst p) (elimCast -c -i (snd p))) 15 | -(Λ i. λ a. etaPair a)) . 16 | 17 | import nu/nu ·Unit ·StreamF -monoStreamF. 18 | 19 | Stream : ★ = Nu unit. 20 | StreamCoAlg : ★ ➔ ★ = λ X: ★. CoAlgM ·(λ _: Unit. Stream) ·(λ _: Unit. X). 21 | 22 | head : Stream ➔ A = λ xs. fst (outM -unit xs) . 23 | tail : Stream ➔ Stream = λ xs. snd (outM -unit xs) . 24 | 25 | unfoldStream : ∀ X: ★. StreamCoAlg ·X ➔ X ➔ Stream 26 | = Λ X. λ coa. λ x. 27 | unfoldM ·(λ _: Unit. X) 28 | (Λ R. Λ c. λ v. λ ch. Λ i. λ y. 29 | ρ (etaUnit i) - 30 | coa ·(λ _: Unit. R unit) 31 | -(intrCast -(Λ i. elimCast -c -unit) -(Λ i. λ x. β)) 32 | (Λ i. v -unit) (Λ i. ch -unit) -unit y) 33 | -unit x. 34 | -------------------------------------------------------------------------------- /efficient-mendler-codata/examples/streamrelf.ced: -------------------------------------------------------------------------------- 1 | import utils. 2 | 3 | module examples/streamrelf (A: ★) (Rel: A ➔ A ➔ ★). 4 | import streamf ·A. 5 | 6 | StreamRelF 7 | : (Pair ·Stream ·Stream ➔ ★) ➔ Pair ·Stream ·Stream ➔ ★ 8 | = λ R: Pair ·Stream ·Stream ➔ ★. λ p: Pair ·Stream ·Stream. 9 | [xs = fst p] - [ys = snd p] - 10 | Pair ·(Rel (head xs) (head ys)) ·(R (intrPair (tail xs) (tail ys))) . 11 | StreamRelF' : (Stream ➔ Stream ➔ ★) ➔ Stream ➔ Stream ➔ ★ 12 | = λ R: Stream ➔ Stream ➔ ★. λ xs: Stream. λ ys: Stream. 13 | StreamRelF ·(λ p: Pair ·Stream ·Stream. R (fst p) (snd p)) (intrPair xs ys) . 14 | 15 | monoStreamRelF 16 | : Mono ·(Pair ·Stream ·Stream) ·StreamRelF = 17 | intrMono -(Λ R1. Λ R2. Λ c. 18 | intrCast 19 | -(Λ i. λ p. 20 | [xs = fst i] - [ys = snd i] 21 | - [j : Pair ·Stream ·Stream 22 | = mkpair (tail xs) (tail ys)] 23 | - intrPair (fst p) (elimCast -c -j (snd p))) 24 | -(Λ i. λ p. etaPair p)) . 25 | 26 | import nu/nu ·(Pair ·Stream ·Stream) ·StreamRelF -monoStreamRelF. 27 | 28 | StreamRel : Stream ➔ Stream ➔ ★ 29 | = λ xs: Stream. λ ys: Stream. Nu (intrPair xs ys). 30 | 31 | headRel : ∀ xs: Stream. ∀ ys: Stream. StreamRel xs ys ➔ Rel (head xs) (head ys) 32 | = Λ xs. Λ ys. λ srel. fst (outM -(intrPair xs ys) srel). 33 | 34 | tailRel : ∀ xs: Stream. ∀ ys: Stream. StreamRel xs ys ➔ StreamRel (tail xs) (tail ys) 35 | = Λ xs. Λ ys. λ srel. snd (outM -(intrPair xs ys) srel). 36 | 37 | unfoldStreamRel 38 | : ∀ X: Stream ➔ Stream ➔ ★. 39 | (∀ R: Stream ➔ Stream ➔ ★. 40 | (∀ xs: Stream. ∀ ys: Stream. X xs ys ➔ R xs ys) ➔ 41 | ∀ xs: Stream. ∀ ys: Stream. X xs ys ➔ 42 | StreamRelF ·(λ p: Pair ·Stream ·Stream. R (fst p) (snd p)) (mkpair xs ys)) ➔ 43 | ∀ xs: Stream. ∀ ys: Stream. X xs ys ➔ StreamRel xs ys 44 | = Λ X. λ coa. Λ xs. Λ ys. λ g. 45 | unfoldM ·(λ p: Pair ·Stream ·Stream. X (fst p) (snd p)) 46 | (Λ R. Λ c. λ v. λ ch. Λ p. λ g'. 47 | coa ·(λ xs: Stream. λ ys: Stream. R (intrPair xs ys)) 48 | (Λ xs. Λ ys. ch -(intrPair xs ys)) 49 | -(fst p) -(snd p) g') 50 | -(intrPair xs ys) g . 51 | 52 | -------------------------------------------------------------------------------- /efficient-mendler-codata/nu/lambek.ced: -------------------------------------------------------------------------------- 1 | import utils. 2 | import nu. 3 | 4 | module lambek. 5 | 6 | TF : (Unit ➔ ★) ➔ (Unit ➔ ★) = λ X: Unit ➔ ★. X. 7 | 8 | monoTF : Mono ·Unit ·TF 9 | = Λ X. Λ Y. Λ c. 10 | intrCast -(Λ i. λ x. elimCast -c -i x) -(Λ i. λ _. β) . 11 | 12 | T : Unit ➔ ★ = Nu ·Unit ·TF monoTF. 13 | TCoAlgM : ★ ➔ ★ = λ X: ★. CoAlgM ·Unit ·TF monoTF ·T ·(λ _: Unit. X). 14 | 15 | tcoa : TCoAlgM ·Unit 16 | = Λ R. Λ c. λ v. λ ch. Λ i. λ x. ch -i x. 17 | 18 | tcoa' : CoAlgM ·Unit ·TF monoTF ·T ·T 19 | = Λ R. Λ c. λ v. λ ch. Λ i. λ x. elimCast -c -i (outM -monoTF -i x). 20 | 21 | t : T unit 22 | = unfoldM -monoTF ·(λ _: Unit. Unit) tcoa -unit unit . 23 | 24 | antiReflection : Π x: T unit. {reflectM t ≃ t } ➔ ∀ X: ★. X 25 | = λ x. λ eq. δ - eq . 26 | 27 | reflect : ∀ i: Unit. T i ➔ T i 28 | = unfoldM -monoTF ·T (Λ R. Λ c. λ v. λ ch. Λ i. λ x. elimCast -c -i (outM -monoTF -i x)) . 29 | 30 | antiReflection' : { reflect t ≃ t } ➔ ∀ X: ★. X 31 | = λ eq. 32 | δ 33 | - χ { λ f . f t (λ v . λ ch . outM) ≃ λ f. f unit tcoa } 34 | - eq . 35 | 36 | noLambek2 : {inM (outM t) ≃ t} ➔ ∀ X: ★. X 37 | = λ eq. Λ X. 38 | δ X 39 | - χ { λ f. f (λ g. g unit tcoa) (λ v. λ ch. λ x. x) 40 | ≃ λ f. f unit tcoa } 41 | - eq. 42 | 43 | observeLambek2 : {outM (inM (outM t)) ≃ outM t} 44 | = β . 45 | -------------------------------------------------------------------------------- /efficient-mendler-codata/nu/nu.ced: -------------------------------------------------------------------------------- 1 | import utils. 2 | 3 | module nu (I: ★) (F: (I ➔ ★) ➔ I ➔ ★) {cm: Mono ·I ·F}. 4 | 5 | CoAlgM : (I ➔ ★) ➔ (I ➔ ★) ➔ ★ 6 | = λ C: I ➔ ★. λ X: I ➔ ★. 7 | ∀ R: I ➔ ★. Cast ·I ·C ·R ➾ (∀ i: I. F ·R i ➔ R i) ➔ 8 | Π ch: (∀ i: I. X i ➔ R i). ∀ i: I. X i ➔ F ·R i. 9 | 10 | NuF : (I ➔ ★) ➔ I ➔ ★ 11 | = λ C: I ➔ ★. λ i: I. 12 | ∀ Y: I ➔ ★. (∀ X: I ➔ ★. X i ➔ CoAlgM ·C ·X ➔ Y i) ➔ Y i. 13 | 14 | Nu : I ➔ ★ = Rec ·I ·NuF. 15 | 16 | monoCoAlgM : ∀ X: I ➔ ★. Mono ·I ·(λ C: I ➔ ★. λ i: I. CoAlgM ·C ·X) = Λ X. 17 | intrMono -(Λ C1. Λ C2. Λ c. 18 | intrCast 19 | -(Λ i. λ coa. Λ R. Λ c'. coa -(castTrans -c -c')) 20 | -(Λ i. λ coa. β)) . 21 | 22 | monoNuF : Mono ·I ·NuF 23 | = intrMono -(Λ C1. Λ C2. Λ c. 24 | intrCast 25 | -(Λ i. λ co. Λ Y. λ f. 26 | co ·Y (Λ X. λ x. λ coa. 27 | f x (elimMono -(monoCoAlgM ·X) -c -i coa))) 28 | -(Λ i. λ coa. β)) . 29 | 30 | nuRoll : ∀ i: I. NuF ·Nu i ➔ Nu i = Λ i. recRoll -monoNuF -i . 31 | nuUnroll : ∀ i: I. Nu i ➔ NuF ·Nu i = Λ i. recUnroll -monoNuF -i . 32 | 33 | unfoldM : ∀ X: I ➔ ★. CoAlgM ·Nu ·X ➔ ∀ i: I. X i ➔ Nu i 34 | = Λ X. λ coa. Λ i. λ x. nuRoll -i (Λ Y. λ f. f x coa) . 35 | 36 | inM : ∀ i: I. F ·Nu i ➔ Nu i 37 | = unfoldM ·(F ·Nu) (Λ R. Λ c. λ v. λ ch. Λ i. λ x. elimMono -cm -c -i x) . 38 | 39 | outM : ∀ i: I. Nu i ➔ F ·Nu i 40 | = Λ i. λ cod. 41 | nuUnroll -i cod ·(F ·Nu) 42 | (Λ X. λ x. λ coa. 43 | coa -(castRefl ·I ·Nu) inM (unfoldM coa) -i x) . 44 | 45 | lambek1 : ∀ i: I. Π xs: F ·Nu i. {outM (inM xs) ≃ xs} 46 | = Λ i. λ xs. β . 47 | 48 | reflectM : ∀ i: I. Nu i ➔ Nu i 49 | = unfoldM ·Nu 50 | (Λ R. Λ c. λ v. λ ch. Λ i. λ x. 51 | elimMono -cm -c -i (outM -i x)). 52 | 53 | reduce : ∀ X: I ➔ ★. Π coa: CoAlgM ·Nu ·X. ∀ i: I. Π x: X i. { outM (unfoldM coa x) ≃ coa inM (unfoldM coa) x } 54 | = Λ X. λ coa. Λ i. λ x. β . 55 | -------------------------------------------------------------------------------- /efficient-mendler-codata/utils.ced: -------------------------------------------------------------------------------- 1 | module utils. 2 | 3 | import public utils/cast. 4 | import public utils/rec. 5 | import public utils/sigma. 6 | import public utils/sum. 7 | import public utils/unit. 8 | -------------------------------------------------------------------------------- /efficient-mendler-codata/utils/cast.ced: -------------------------------------------------------------------------------- 1 | module utils/cast (I: ★). 2 | 3 | Cast : (I ➔ ★) ➔ (I ➔ ★) ➔ ★ 4 | = λ A: I ➔ ★. λ B: I ➔ ★. ι f: ∀ i: I. A i ➔ B i. {f ≃ λ x. x}. 5 | 6 | intrCast 7 | : ∀ A: I ➔ ★. ∀ B: I ➔ ★. 8 | ∀ f: ∀ i: I. A i ➔ B i. (∀ i: I. Π a: A i. {f a ≃ a}) ➾ Cast ·A ·B 9 | = Λ A. Λ B. Λ f. Λ eq. [ Λ i. λ a. φ (eq -i a) - (f -i a) {| a |} , β]. 10 | 11 | elimCast : ∀ A: I ➔ ★. ∀ B: I ➔ ★. Cast ·A ·B ➾ ∀ i: I. A i ➔ B i 12 | = Λ A. Λ B. Λ c. φ c.2 - c.1 {| λ x. x |}. 13 | 14 | -- underscore for anonymous definitions 15 | _ : { intrCast ≃ λ x. x } = β . 16 | _ : { elimCast ≃ λ x. x } = β . 17 | 18 | castRefl : ∀ A: I ➔ ★. Cast ·A ·A 19 | = Λ A. intrCast -(Λ _. λ x. x) -(Λ _. λ _. β). 20 | 21 | castTrans 22 | : ∀ A: I ➔ ★. ∀ B: I ➔ ★. ∀ C: I ➔ ★. Cast ·A ·B ➾ Cast ·B ·C ➾ Cast ·A ·C 23 | = Λ A. Λ B. Λ C. Λ c1. Λ c2. 24 | intrCast -(Λ i. λ a. elimCast -c2 -i (elimCast -c1 -i a)) -(Λ _. λ _. β). 25 | 26 | _ : { castRefl ≃ λ x. x } = β . 27 | _ : { castTrans ≃ λ x. x } = β . 28 | 29 | Mono : ((I ➔ ★) ➔ I ➔ ★) ➔ ★ 30 | = λ F: (I ➔ ★) ➔ I ➔ ★. ∀ A: I ➔ ★. ∀ B: I ➔ ★. Cast ·A ·B ➾ Cast ·(F ·A) ·(F ·B). 31 | 32 | intrMono : ∀ F: (I ➔ ★) ➔ I ➔ ★. (∀ A: I ➔ ★. ∀ B: I ➔ ★. Cast ·A ·B ➾ Cast ·(F ·A) ·(F ·B)) ➾ Mono ·F 33 | = Λ F. Λ m. Λ A. Λ B. Λ c. intrCast -(elimCast -(m -c)) -(Λ i. λ a. β) . 34 | 35 | elimMono : ∀ F: (I ➔ ★) ➔ I ➔ ★. ∀ A: I ➔ ★. ∀ B: I ➔ ★. 36 | Mono ·F ➾ Cast ·A ·B ➾ ∀ i: I. F ·A i ➔ F ·B i 37 | = Λ F. Λ A. Λ B. Λ cm. Λ c. Λ i. λ f. elimCast -(cm -c) -i f. 38 | 39 | _ : { intrMono ≃ λ x. x } = β . 40 | _ : { elimMono ≃ λ x. x } = β . 41 | -------------------------------------------------------------------------------- /efficient-mendler-codata/utils/rec.ced: -------------------------------------------------------------------------------- 1 | module utils/rec (I: ★) (F: (I ➔ ★) ➔ I ➔ ★). 2 | 3 | import cast ·I. 4 | 5 | Rec : I ➔ ★ 6 | = λ i: I. ∀ X: I ➔ ★. Cast ·(F ·X) ·X ➾ X i. 7 | 8 | recFold : ∀ X: I ➔ ★. Cast ·(F ·X) ·X ➾ Cast ·Rec ·X 9 | = Λ X. Λ c. intrCast -(Λ i. λ x. x -c) -(Λ i. λ x. β). 10 | 11 | recIn : Mono ·F ➾ Cast ·(F ·Rec) ·Rec 12 | = Λ im. 13 | [f : ∀ i: I. F ·Rec i ➔ Rec i 14 | = Λ i. λ xs. Λ X. Λ c. 15 | elimCast -c -i (elimMono -im -(recFold -c) -i xs)] 16 | - intrCast -f -(Λ i. λ xs. β) . 17 | 18 | recOut : Mono ·F ➾ Cast ·Rec ·(F ·Rec) 19 | = Λ im. 20 | [f : ∀ i: I. Rec i ➔ F ·Rec i 21 | = Λ i. λ x. x ·(F ·Rec) -(im -(recIn -im))] 22 | - intrCast -f -(Λ i. λ x. β) . 23 | 24 | recRoll : Mono ·F ➾ ∀ i: I. F ·Rec i ➔ Rec i 25 | = Λ im. elimCast -(recIn -im) . 26 | 27 | recUnroll : Mono ·F ➾ ∀ i: I. Rec i ➔ F ·Rec i 28 | = Λ im. elimCast -(recOut -im). 29 | 30 | _ : {recRoll ≃ λ x. x} = β. 31 | _ : {recUnroll ≃ λ x. x} = β. 32 | -------------------------------------------------------------------------------- /efficient-mendler-codata/utils/sum.ced: -------------------------------------------------------------------------------- 1 | module Sum. 2 | 3 | cSum ◂ ★ ➔ ★ ➔ ★ = λ A : ★ . λ B : ★ . ∀ X : ★ . (A ➔ X) ➔ (B ➔ X) ➔ X . 4 | cin1 ◂ ∀ A : ★ . ∀ B : ★ . A ➔ cSum · A · B = Λ A . Λ B . λ a . Λ X . λ ca . λ cb . ca a . 5 | cin2 ◂ ∀ A : ★ . ∀ B : ★ . B ➔ cSum · A · B = Λ A . Λ B . λ b . Λ X . λ ca . λ cb . cb b . 6 | 7 | param-Sum ◂ Π A : ★ . Π B : ★ . cSum · A · B ➔ ★ = 8 | λ A : ★ . λ B : ★ . λ x : cSum · A · B . 9 | ∀ X : ★ . ∀ P : X ➔ ★ . ∀ ca : A ➔ X . ∀ cb : B ➔ X . 10 | (Π a : A . P (ca a)) ➔ (Π b : B . P (cb b)) ➔ P (x · X ca cb). 11 | 12 | Sum ◂ ★ ➔ ★ ➔ ★ = λ A : ★ . λ B : ★ . ι x : cSum · A · B . ι _ : {x cin1 cin2 ≃ x} . param-Sum · A · B x . 13 | 14 | in1 ◂ ∀ A : ★ . ∀ B : ★ . A ➔ Sum · A · B = Λ A . Λ B . λ a . [ cin1 · A · B a , [β{| cin1 a |} , Λ X . Λ P . Λ ca . Λ cb . λ pa . λ pb . pa a ]]. 15 | 16 | in2 ◂ ∀ A : ★ . ∀ B : ★ . B ➔ Sum · A · B = Λ A . Λ B . λ b . [ cin2 · A · B b , [β{| cin2 b |} , Λ X . Λ P . Λ ca . Λ cb . λ pa . λ pb . pb b ]]. 17 | 18 | ind-Sum ◂ ∀ A : ★ . ∀ B : ★ . Π x : Sum · A · B . 19 | ∀ P : Sum · A · B ➔ ★ . 20 | (Π a : A . P (in1 · A · B a)) ➔ (Π b : B . P (in2 · A · B b)) ➔ 21 | P x = 22 | Λ A . Λ B . λ x . Λ P . λ pa . λ pb . 23 | ρ ς x.2.1 - (x.2.2 · (Sum · A · B) · P -(in1 · A · B) -(in2 · A · B) pa pb) . 24 | 25 | indSum : ∀ A: ★. ∀ B: ★. ∀ P: Sum ·A ·B ➔ ★. 26 | (Π a: A. P (in1 a)) ➔ (Π b: B. P (in2 b)) ➔ Π x: Sum ·A ·B. P x 27 | = Λ A. Λ B. Λ P. λ left. λ right. λ x. ind-Sum x ·P left right. 28 | 29 | rec-Sum ◂ ∀ A : ★ . ∀ B : ★ . Π x : Sum · A · B . 30 | ∀ X : ★ . (A ➔ X) ➔ (B ➔ X) ➔ X = 31 | Λ A . Λ B . λ x . Λ X . λ pa . λ pb . 32 | x.1 · X pa pb . 33 | 34 | elimSum : ∀ A: ★. ∀ B: ★. ∀ X: ★. (A ➔ X) ➔ (B ➔ X) ➔ Sum ·A ·B ➔ X 35 | = Λ A. Λ B. Λ X. λ lf. λ rh. λ x. x.1 lf rh . 36 | 37 | eta-Sum ◂ ∀ A: ★. ∀ B: ★. Π x: Sum ·A ·B. 38 | { rec-Sum x in1 in2 ≃ x} 39 | = Λ A. Λ B. λ x. θ (ind-Sum x) (λ _. β) (λ _. β). 40 | -------------------------------------------------------------------------------- /efficient-mendler-codata/utils/unit.ced: -------------------------------------------------------------------------------- 1 | module unit. 2 | 3 | cUnit ◂ ★ = ∀ X : ★. X ➔ X. 4 | 5 | cunit ◂ cUnit = Λ X. λ x. x. 6 | 7 | param-Unit ◂ cUnit ➔ ★ 8 | = λ x : cUnit. ∀ X : ★. 9 | ∀ P : X ➔ ★. ∀ cu : X. P cu ➔ P (x · X cu). 10 | 11 | Unit ◂ ★ = ι x : cUnit. ι _ : {x cunit ≃ x}. param-Unit x. 12 | 13 | unit ◂ Unit = [ cunit , [β{| cunit |} , Λ X. Λ P. Λ cu. λ u. u ]]. 14 | 15 | indUnit ◂ ∀ P: Unit ➔ ★. P unit ➔ Π x: Unit. P x = 16 | Λ P. λ u. λ x. ρ ς x.2.1 - (x.2.2 · Unit · P -unit u). 17 | 18 | etaUnit ◂ Π x: Unit. {x ≃ unit} 19 | = indUnit ·(λ x : Unit. {x ≃ unit}) β. 20 | -------------------------------------------------------------------------------- /efficient-mendler-prime/.cedille/options: -------------------------------------------------------------------------------- 1 | import-directories = 2 | "." 3 | . 4 | -------------------------------------------------------------------------------- /efficient-mendler-prime/FixIndM.ced: -------------------------------------------------------------------------------- 1 | import Id. 2 | module FixIndM (F : ★ ➔ ★) {imap : IdMapping · F}. 3 | import FixM · F. 4 | import IdPlus. 5 | import Sigma. 6 | 7 | PrfAlgM ◂ Π X : ★. (X ➔ ★) ➔ (F · X ➔ X) ➔ ★ 8 | = λ X : ★. λ P : X ➔ ★. λ alg : F · X ➔ X. 9 | ∀ R : ★. ∀ c : Id · R · X. 10 | Π ih : Π r : R. P (elimId -c r). 11 | Π rs : F · R. P (alg (elimId -(imap -c) rs)). 12 | 13 | InductiveM ◂ FixM ➔ ★ = λ x : FixM. 14 | ∀ P : FixM ➔ ★. PrfAlgM · FixM · P inM ➔ P x. 15 | 16 | FixIndM ◂ ★ = ι x : FixM. InductiveM x. 17 | 18 | inIndM1 ◂ F · FixIndM ➔ FixM 19 | = λ xs. inM (elimId -(imap · FixIndM · FixM -(λ x. pair x.1 β)) xs). 20 | 21 | inIndM2 ◂ Π xs : F · FixIndM. InductiveM (inIndM1 xs) 22 | = λ xs. Λ P. λ c. c · FixIndM -(λ x. pair x.1 β) (λ x. x.2 c) xs. 23 | 24 | inIndM ◂ F · FixIndM ➔ FixIndM = λ xs. [ inIndM1 xs, inIndM2 xs ]. 25 | 26 | lowerPrfAlg ◂ ∀ P : FixIndM ➔ ★. 27 | PrfAlgM · FixIndM · P inIndM ➔ 28 | PrfAlgM · FixM · (IdPlusCod · FixM · FixIndM · P) inM 29 | = Λ P. λ alg. Λ R. Λ c. λ ih. λ rs. 30 | pair (inIndM (elimId -(imap -(elimIdPlusId -c ih)) rs)) 31 | (pair β (alg -(elimIdPlusId -c ih) (elimIdPlusIH -c ih) rs)). 32 | 33 | inductionM ◂ ∀ P : FixIndM ➔ ★. PrfAlgM · FixIndM · P inIndM ➔ Π x : FixIndM. P x 34 | = Λ P. λ alg. λ x. proj2 (proj2 (x.2 (lowerPrfAlg alg))). 35 | 36 | outIndM ◂ FixIndM ➔ F · FixIndM = 37 | λ x. θ inductionM (Λ R. Λ c. λ ih. λ rs. elimId -(imap -c) rs) x. 38 | 39 | lambekM1 ◂ Π xs : F · FixIndM. {outIndM (inIndM xs) ≃ xs} = λ xs. β. 40 | 41 | lambekM2 ◂ Π x : FixIndM. {inIndM (outIndM x) ≃ x} = 42 | λ x. θ inductionM (Λ R. Λ c. λ ih. λ rs. β) x. 43 | -------------------------------------------------------------------------------- /efficient-mendler-prime/FixM.ced: -------------------------------------------------------------------------------- 1 | module FixM (F : ★ ➔ ★). 2 | 3 | AlgM ◂ ★ ➔ ★ = λ A : ★. 4 | ∀ R : ★. (R ➔ A) ➔ F · R ➔ A. 5 | 6 | FixM ◂ ★ = ∀ X : ★. AlgM · X ➔ X. 7 | 8 | foldM ◂ ∀ A : ★. AlgM · A ➔ FixM ➔ A 9 | = Λ A. λ alg. λ x. x alg. 10 | 11 | inM ◂ F · FixM ➔ FixM 12 | = λ xs. Λ A. λ alg. alg (foldM alg) xs. 13 | 14 | foldMHom ◂ ∀ A : ★. Π alg : AlgM · A. Π xs : F · FixM. 15 | { foldM alg (inM xs) ≃ alg (foldM alg) xs } 16 | = Λ A. λ alg. λ rs. β. 17 | -------------------------------------------------------------------------------- /efficient-mendler-prime/Id.ced: -------------------------------------------------------------------------------- 1 | module Id. 2 | import Sigma. 3 | 4 | IdCod ◂ Π A : ★. Π B : ★. A ➔ ★ = λ A : ★. λ B : ★. λ a : A. 5 | Sigma · B · (λ b : B. { b ≃ a }). 6 | 7 | Id ◂ Π A : ★. Π B : ★. ★ = λ A : ★. λ B : ★. 8 | Π a : A. IdCod · A · B a. 9 | 10 | elimId ◂ ∀ A : ★. ∀ B : ★. Id · A · B ➾ A ➔ B = 11 | Λ A. Λ B. Λ c. λ a. 12 | φ (proj2 (c a)) - (proj1 (c a)) {|a|}. 13 | 14 | IdMapping ◂ (★ ➔ ★) ➔ ★ = λ F : ★ ➔ ★. 15 | ∀ X : ★. ∀ Y : ★. Id · X · Y ➾ Id · (F · X) · (F · Y). 16 | -------------------------------------------------------------------------------- /efficient-mendler-prime/IdPlus.ced: -------------------------------------------------------------------------------- 1 | module IdPlus. 2 | import Sigma. 3 | import Id. 4 | 5 | IdPlusCod ◂ Π A : ★. Π B : ★. Π P : B ➔ ★. A ➔ ★ 6 | = λ A : ★. λ B : ★. λ P : B ➔ ★. λ a : A. 7 | Sigma · B · (λ b : B. 8 | Sigma · { b ≃ a } · (λ q : { b ≃ a }. 9 | P (φ q - b {|a|}) 10 | )). 11 | 12 | IdPlus ◂ Π R : ★. Π A : ★. Π B : ★. Π P : B ➔ ★. Π c : Id · R · A. ★ 13 | = λ R : ★. λ A : ★. λ B : ★. λ P : B ➔ ★. λ c : Id · R · A. 14 | Π r : R. IdPlusCod · A · B · P (elimId -c r). 15 | 16 | elimIdPlusId ◂ ∀ R : ★. ∀ A : ★. ∀ B : ★. ∀ P : B ➔ ★. ∀ c : Id · R · A. 17 | Π ih : IdPlus · R · A · B · P c. Id · R · B 18 | = Λ R. Λ A. Λ B. Λ P. Λ c. λ ih. λ r. 19 | [ b = proj1 (ih r) ] - [ q = proj1 (proj2 (ih r)) ] - pair b q. 20 | 21 | elimIdPlus ◂ ∀ R : ★. ∀ A : ★. ∀ B : ★. ∀ P : B ➔ ★. ∀ c : Id · R · A. 22 | IdPlus · R · A · B · P c ➾ R ➔ B 23 | = Λ R. Λ A. Λ B. Λ P. Λ c. Λ ih. elimId -(elimIdPlusId -c ih). 24 | 25 | elimIdPlusIH ◂ ∀ R : ★. ∀ A : ★. ∀ B : ★. ∀ P : B ➔ ★. ∀ c : Id · R · A. 26 | Π ih : IdPlus · R · A · B · P c. Π r : R. P (elimIdPlus -c -ih r) 27 | = Λ R. Λ A. Λ B. Λ P. Λ c. λ ih. λ r. proj2 (proj2 (ih r)). 28 | -------------------------------------------------------------------------------- /efficient-mendler-prime/InitialM.ced: -------------------------------------------------------------------------------- 1 | import Id. 2 | module InitialM (F : ★ ➔ ★) {imap : IdMapping · F}. 3 | import FixM · F. 4 | import FixIndM · F -imap. 5 | 6 | AlgMExt ◂ Π A : ★. AlgM · A ➔ ★ = λ A : ★. λ alg : AlgM · A. 7 | ∀ R : ★. Π f : R ➔ A. Π g : R ➔ A. 8 | (Π r : R. { f r ≃ g r }) ➾ Π xs : F · R. { alg f xs ≃ alg g xs }. 9 | 10 | initialM ◂ ∀ A : ★. Π alg : AlgM · A. Π algExt : AlgMExt · A alg. 11 | Π h : FixIndM ➔ A. Π hom : Π xs : F · FixIndM. { h (inIndM xs) ≃ alg h xs }. 12 | Π x : FixIndM. { h x ≃ foldM alg x.1 } 13 | = Λ A. λ alg. λ algExt. λ h. λ hom. λ x. 14 | θ inductionM (Λ R. Λ c. λ ih. λ rs. 15 | ρ (hom (elimId -(imap -c) rs)) - 16 | algExt · R 17 | (λ r. h (elimId -c r)) 18 | (λ r. foldM alg (elimId -c r).1) 19 | -ih rs 20 | ) x. 21 | -------------------------------------------------------------------------------- /efficient-mendler-prime/README.md: -------------------------------------------------------------------------------- 1 | Efficient Mendler Prime 2 | ======================= 3 | 4 | A refactored version of the development accompanying the ITP'18 paper 5 | [Efficient Mendler-Style Lambda-Encodings in Cedille](https://doi.org/10.1007/978-3-319-94821-8_14), 6 | with the goal of minimizing the code size and bringing out the essence of the 7 | work. For someone unfamiliar with the work already, studying this smaller code base may be easier. 8 | For future developments based on the work, this can serve as a smaller dependency. 9 | 10 | Refactoring mainly involved code cleanup and getting rid of incidental complexity in the original 11 | development . The only technical difference is the introduction of [IdPlus](IdPlus.ced), which 12 | captures the ITP work's concept of predicate lifting at a slightly different level of abstraction, 13 | in order to keep the code size small. 14 | 15 | See [FixIndM](FixIndM.ced) for the least fixpoint type and its induction principle. -------------------------------------------------------------------------------- /efficient-mendler-prime/Sigma.ced: -------------------------------------------------------------------------------- 1 | module Sigma. 2 | 3 | SigmaC ◂ Π A : ★. (A ➔ ★) ➔ ★ = λ A : ★. λ B : A ➔ ★. 4 | ∀ C : ★. (Π a : A. B a ➔ C) ➔ C. 5 | pairC ◂ ∀ A : ★. ∀ B : A ➔ ★. Π a : A. B a ➔ SigmaC · A · B = 6 | Λ A. Λ B. λ a. λ b. Λ C. λ c. c a b. 7 | 8 | SigmaCInductive ◂ Π A : ★. Π B : A ➔ ★. SigmaC · A · B ➔ ★ = 9 | λ A : ★. λ B : A ➔ ★. λ s : SigmaC · A · B. 10 | ∀ P : SigmaC · A · B ➔ ★. (Π a : A. Π b : B a. P (pairC · A · B a b)) ➔ P s. 11 | Sigma ◂ Π A : ★. (A ➔ ★) ➔ ★ = λ A : ★. λ B : A ➔ ★. 12 | ι s : SigmaC · A · B. SigmaCInductive · A · B s. 13 | pair ◂ ∀ A : ★. ∀ B : A ➔ ★. Π a : A. Π b : B a. Sigma · A · B 14 | = Λ A. Λ B. λ a. λ b. [pairC · A · B a b, Λ P. λ p. p a b]. 15 | 16 | elimSigma ◂ ∀ A : ★. ∀ B : A ➔ ★. ∀ P : Sigma · A · B ➔ ★. 17 | (Π a : A. Π b : B a. P (pair · A · B a b)) ➔ Π s : Sigma · A · B. P s 18 | = Λ A. Λ B. Λ P. λ p. λ s. (s.2 · (λ sC : SigmaC · A · B. 19 | ∀ C : ★. (Π s' : Sigma · A · B. {sC ≃ s'} ➾ P s' ➔ C) ➔ C)) 20 | (λ a. λ b. Λ C. λ c. c (pair · A · B a b) -β (p a b)) 21 | · (P s) (λ s'. Λ q. λ p. ρ q - p). 22 | foldSigma ◂ ∀ A : ★. ∀ B : A ➔ ★. ∀ C : ★. 23 | (Π a : A. B a ➔ C) ➔ Sigma · A · B ➔ C 24 | = Λ A. Λ B. Λ C. elimSigma · A · B · (λ s : Sigma · A · B. C). 25 | 26 | proj1 ◂ ∀ A : ★. ∀ B : A ➔ ★. Sigma · A · B ➔ A 27 | = Λ A. Λ B. λ s. s.1 · A (λ a. λ _. a). 28 | proj2 ◂ ∀ A : ★. ∀ B : A ➔ ★. Π s : Sigma · A · B. B (proj1 · A · B s) 29 | = Λ A. Λ B. λ s. elimSigma · A · B 30 | · (λ s' : Sigma · A · B. B (proj1 · A · B s')) (λ a. λ b. b) s. 31 | -------------------------------------------------------------------------------- /efficient-mendler/.cedille/options: -------------------------------------------------------------------------------- 1 | import-directories = 2 | "MendlerInduction" 3 | "Utilities" 4 | "Examples" 5 | "Examples/Nat" 6 | "Examples/ITree" 7 | "Examples/PTree" 8 | "Examples/UTree" 9 | . 10 | 11 | 12 | use-cede-files = false. 13 | make-rkt-files = false. 14 | generate-logs = false. 15 | show-qualified-vars = false. 16 | 17 | 18 | -------------------------------------------------------------------------------- /efficient-mendler/Everything.ced: -------------------------------------------------------------------------------- 1 | -- Generic development 2 | 3 | -- Introduce "Id X Y" as a set of all functions from X to Y which erase 4 | -- to term "λ x. x" 5 | 6 | import Id. 7 | 8 | -- Introduce schemes with "identity mappings". F-identity mapping is a 9 | -- function "imap : ∀ X Y : ★. Id X Y ➔ Id (F X) (F Y)" 10 | 11 | import IdMapping. 12 | 13 | module Everything (F : ★ ➔ ★)(imap : IdMapping · F). 14 | 15 | -- Basic definitions of Mendler-style encoding which are well-defined 16 | -- for any unrestricted parameterized scheme F : ★ ➔ ★. 17 | 18 | import FixM · F. 19 | 20 | 21 | -- Given a scheme F with identity mapping "imap" we define the datatype 22 | -- "FixIndM F imap" as a subset of "FixM F" carved out by inductivity 23 | -- predicate "IsIndFixM". The subset is defined as a dependent 24 | -- intersection type of FixM and IsIndFixM 25 | 26 | import FixIndM · F imap. 27 | 28 | 29 | -- Derivation of induction principle for FixIndM in terms of proof-algebras 30 | -- parameterized by collection of constructors of FixIndM represented by 31 | -- conventional algeba "inFixIndM : F FixIndM ➔ FixIndM". 32 | 33 | import InductionM · F imap. 34 | 35 | 36 | -- Using previously derived induction principle to develop a 37 | -- constant-time destructor of FixIndM. Consequently, inFixIndM and 38 | -- outFixIndM are mutual inverses and therefore FixIndM is a least 39 | -- fixed point of F. 40 | 41 | import ConstantTimeDestructor · F imap. 42 | 43 | 44 | 45 | 46 | -- Examples 47 | 48 | -- Lambda-encoded natural numbers with induction and constant-time 49 | -- predecessor 50 | 51 | import Nat. 52 | 53 | 54 | -- Infinitary trees 55 | 56 | import ITree as ITree. 57 | 58 | 59 | -- Positive, but not strictly positive infinitary trees 60 | 61 | import PTree as PTree. 62 | 63 | 64 | -- Unbalanced tree which arises as a least fixed point of a covariant 65 | -- scheme which is not a functor. 66 | 67 | import UTree as UTree. 68 | -------------------------------------------------------------------------------- /efficient-mendler/Examples/ITree/IF.ced: -------------------------------------------------------------------------------- 1 | module ITree. 2 | 3 | import Sum. 4 | import Unit. 5 | import Sigma. 6 | import IdMapping. 7 | import Id. 8 | import Nat. 9 | import NF. 10 | 11 | IF ◂ ★ ➔ ★ = λ X : ★. Nat ➔ Sum · Unit · X. 12 | 13 | -- it is not possible to prove functorial laws for this definition of 14 | -- imap without functional extensionality 15 | ifmap ◂ ∀ X : ★. ∀ Y : ★. (X ➔ Y) ➔ (IF · X ➔ IF · Y) 16 | = Λ X. Λ Y. λ f. λ v. λ n. 17 | case · Unit · X · (Sum · Unit · Y) (v n) (λ u . in1 · Unit · Y u) (λ x. in2 · Unit · Y (f x)). 18 | 19 | 20 | -- IdMapping · IF is implemented by relying on eta law 21 | ifimap ◂ IdMapping · IF = Λ X. Λ Y. Λ c. pair · (IF · X ➔ IF · Y) · (λ f : (IF · X ➔ IF · Y) . {f ≃ id}) 22 | (λ v. λ n. elimId · (Sum · Unit · X) · (Sum · Unit · Y) -(nfimap · X · Y -c) (v n)) β. 23 | 24 | 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /efficient-mendler/Examples/ITree/ITree.ced: -------------------------------------------------------------------------------- 1 | module ITree. 2 | 3 | import Unit. 4 | import Sum. 5 | import Sigma. 6 | import Id. 7 | import Nat. 8 | import NF. 9 | import IF. 10 | 11 | import FixIndM · IF ifimap. 12 | import InductionM · IF ifimap. 13 | import ConstantTimeDestructor · IF ifimap. 14 | 15 | 16 | -- infinitary tree and its constructor 17 | ITree ◂ ★ = FixIndM. 18 | 19 | inode ◂ (Nat ➔ Sum · Unit · ITree) ➔ ITree = λ f. inFixIndM f. 20 | 21 | 22 | -- destructor of ITree 23 | destrITree ◂ ITree ➔ (Nat ➔ Sum · Unit · ITree) = outFixIndM. 24 | 25 | 26 | -- empty tree which acts as a base case for specialized "flat" induction principle 27 | empty ◂ ITree = inFixIndM (λ n. in1 · Unit · ITree unit). 28 | 29 | -- projects a tree from the disjoint sum (in case of unit returns empty tree) 30 | projTree ◂ Sum · Unit · ITree ➔ ITree = λ o. o.1 · ITree (λ _. empty) (λ t. t). 31 | 32 | -- "flat" induction for infinitary tree ITree 33 | inductionITree ◂ ∀ P : ITree ➔ ★. 34 | (Π v : IF · ITree. (Π n : Nat. P (projTree (v n))) ➔ P (inode v)) ➔ P empty ➔ Π t : ITree. P t 35 | = Λ P. λ ih. λ em. λ t. induction · P 36 | (Λ R. Λ c. λ ih2. λ gr. ih (elimId · (IF · R) · (IF · ITree) -(ifimap · R · ITree -c) gr) 37 | (λ n. indSum · Unit · R (gr n) · (λ q : Sum · Unit · R. P (projTree (elimId · (Sum · Unit · R) 38 | · (Sum · Unit · ITree) -(nfimap · R · ITree -c) q))) 39 | (λ _ . em) 40 | (λ b. ih2 b))) t. 41 | -------------------------------------------------------------------------------- /efficient-mendler/Examples/Nat/NF.ced: -------------------------------------------------------------------------------- 1 | 2 | module NF. 3 | 4 | import Unit. 5 | import Sum. 6 | import Id. 7 | import IdMapping. 8 | import SubstComp. 9 | 10 | 11 | NF ◂ ★ ➔ ★ = λ X : ★. Sum · Unit · X. 12 | 13 | 14 | -- direct implementation of identity mapping for NF 15 | nfimap ◂ IdMapping · NF = Λ X. Λ Y. Λ c. intrId · (NF · X) · (NF · Y) 16 | (λ u. subst · (NF · Y) · (NF · X) 17 | -(case · Unit · X · (NF · Y) u (in1 · Unit · Y) 18 | (λ x. in2 · Unit · Y (elimId · X · Y -c x))) u -u.2.1) 19 | (λ _. β). 20 | -------------------------------------------------------------------------------- /efficient-mendler/Examples/Nat/Nat.ced: -------------------------------------------------------------------------------- 1 | module Nat. 2 | 3 | import NF. 4 | import Unit. 5 | import Sum. 6 | import Id. 7 | import FixIndM · NF nfimap. 8 | import InductionM · NF nfimap. 9 | import ConstantTimeDestructor · NF nfimap. 10 | 11 | 12 | 13 | -- datatype for natural numbers 14 | Nat ◂ ★ = FixIndM. 15 | 16 | 17 | -- constructors of Nat 18 | zero ◂ Nat = inFixIndM (in1 · Unit · Nat unit). 19 | suc ◂ Nat ➔ Nat = λ n. inFixIndM (in2 · Unit · Nat n). 20 | 21 | 22 | -- constant-time predecessor 23 | pred ◂ Nat ➔ Nat = λ n. 24 | case · Unit · Nat · Nat (outFixIndM n) 25 | (λ _. zero) 26 | (λ m. m). 27 | 28 | 29 | -- predecessor properties hold by β-reduction 30 | predSuc ◂ Π n : Nat. {pred (suc n) ≃ n} = λ n. β. 31 | predZero ◂ {pred zero ≃ zero} = β. 32 | 33 | 34 | -- specialized "flat" induction for Nat from generic induction 35 | inductionNat ◂ ∀ P : Nat ➔ ★. (Π n : Nat. P n ➔ P (suc n)) ➔ P zero ➔ Π n : Nat. P n = 36 | Λ P. λ s. λ z. λ n. induction · P 37 | (Λ R. Λ c. λ ih. λ natfr. 38 | θ (indSum · Unit · R natfr) 39 | (λ a. ρ (etaUnit a) - z) 40 | (λ b. s (elimId · R · Nat -c b) (ih b))) 41 | n. 42 | -------------------------------------------------------------------------------- /efficient-mendler/Examples/PTree/PF.ced: -------------------------------------------------------------------------------- 1 | module PF. 2 | 3 | import Unit. 4 | import Bool. 5 | import Sum. 6 | import Sigma. 7 | import Id. 8 | import IdMapping. 9 | import NF. 10 | 11 | 12 | -- non-strictly positive scheme 13 | PF ◂ ★ ➔ ★ = λ X : ★. (X ➔ Bool) ➔ Sum · Unit · X. 14 | 15 | 16 | -- As in case of IF, the implementation of identity mapping for PF 17 | -- relies on eta law. 18 | pfimap ◂ IdMapping · PF = Λ X. Λ Y. Λ c. pair · (PF · X ➔ PF · Y) · (λ f : PF · X ➔ PF · Y. {f ≃ id}) 19 | (λ v. λ n. elimId · (Sum · Unit · X) · (Sum · Unit · Y) -(nfimap · X · Y -c) 20 | (v (λ x. n (elimId · X · Y -c x)))) β. 21 | -------------------------------------------------------------------------------- /efficient-mendler/Examples/PTree/PTree.ced: -------------------------------------------------------------------------------- 1 | module PTree. 2 | 3 | import Unit. 4 | import Bool. 5 | import Sum. 6 | import Sigma. 7 | import Id. 8 | 9 | import PF. 10 | import NF. 11 | 12 | import FixIndM · PF pfimap. 13 | import InductionM · PF pfimap. 14 | 15 | 16 | -- nonstrictly positive infinitary tree and its constructor 17 | PTree ◂ ★ = FixIndM. 18 | 19 | pnode ◂ ((PTree ➔ Bool) ➔ Sum · Unit · PTree) ➔ PTree = λ f. inFixIndM f. 20 | 21 | 22 | -- empty tree which acts as a base case for "flat" induction principle 23 | pempty ◂ PTree = inFixIndM (λ n. in1 · Unit · PTree unit). 24 | 25 | 26 | -- projects a tree from the disjoint sum (in case of unit returns empty tree) 27 | projPTree ◂ Sum · Unit · PTree ➔ PTree = λ o. o.1 · PTree (λ _. pempty) (λ t. t). 28 | 29 | 30 | -- "flat" induction for PTree 31 | inductionPTree ◂ ∀ P : PTree ➔ ★. 32 | (Π v : PF · PTree. (Π n : (PTree ➔ Bool). P (projPTree (v n))) ➔ P (pnode v)) ➔ P pempty ➔ Π t : PTree. P t 33 | = Λ P. λ ih. λ em. λ t. induction · P 34 | (Λ R. Λ c. λ ih2. λ gr. ih (elimId · (PF · R) · (PF · PTree) -(pfimap · R · PTree -c) gr) 35 | (λ n. indSum · Unit · R (gr (λ r. n (elimId · R · PTree -c r) )) · 36 | (λ q : Sum · Unit · R. P (projPTree (elimId · (Sum · Unit · R) · (Sum · Unit · PTree) -(nfimap · R · PTree -c) q))) 37 | (λ _ . em) 38 | (λ b. ih2 b))) t. 39 | -------------------------------------------------------------------------------- /efficient-mendler/Examples/UTree/UF.ced: -------------------------------------------------------------------------------- 1 | module UF. 2 | 3 | import Empty. 4 | import Unit. 5 | import Bool. 6 | import Sum. 7 | import Sigma. 8 | import Id. 9 | import IdMapping. 10 | 11 | 12 | NotEq ◂ Π X : ★. X ➔ X ➔ ★ 13 | = λ X : ★. λ x1 : X. λ x2 : X. {x1 ≃ x2} ➔ Empty. 14 | 15 | 16 | -- UF is a covariant non-functorial scheme 17 | UF ◂ ★ ➔ ★ = λ X : ★. Sum · Bool · (Sigma · X · (λ x1 : X . Sigma · X · (λ x2 : X. NotEq · X x1 x2))). 18 | 19 | 20 | -- First, we implement a function UF X ➔ UF Y from Id X Y 21 | ufimap' ◂ ∀ X : ★. ∀ Y : ★. Id · X · Y ➾ (UF · X) ➔ (UF · Y) = Λ X. Λ Y. Λ id. 22 | λ w. w.1 · (UF · Y) 23 | (λ u. in1 · Bool · (Sigma · Y · (λ x1 : Y . Sigma · Y · (λ x2 : Y. NotEq · Y x1 x2))) u ) 24 | (λ u. u.1 · (UF · Y) (λ a. λ u'. u'.1 · (UF · Y) (λ a'. λ nep. 25 | in2 · Bool · (Sigma · Y · (λ x1 : Y . Sigma · Y · (λ x2 : Y. NotEq · Y x1 x2))) 26 | (pair · Y · (λ x1 : Y . (Sigma · Y · (λ x2 : Y . (NotEq · Y x1 x2)))) (elimId · X · Y -id a) 27 | (pair · Y · (λ x2 : Y . (NotEq · Y (elimId · X · Y -id a) x2)) (elimId · X · Y -id a') (λ ep. nep ep)))))). 28 | 29 | 30 | -- Second, we show that "ufimap' -c" extensionally acts as an identity 31 | ufimapLaw' ◂ ∀ X : ★. ∀ Y : ★. ∀ c : Id · X · Y. Π z : UF · X. {ufimap' -c z ≃ z} 32 | = Λ X . Λ Y. Λ c. λ w. θ (indSum · Bool · (Sigma · X · (λ x1 : X . Sigma · X · (λ x2 : X. NotEq · X x1 x2))) w) 33 | (λ a. β ) 34 | (λ z. θ (indSigma · X · (λ x1 : X . Sigma · X · (λ x2 : X. NotEq · X x1 x2)) z) 35 | (λ a. λ b. θ (indSigma · X · (λ x2 : X . (NotEq · X a x2)) b) 36 | (λ a'. λ b' . β))). 37 | 38 | 39 | -- finally, we implmement identity mapping of UF by using the 40 | -- introduction rule of identity functions 41 | ufimap ◂ IdMapping · UF = Λ X. Λ Y. Λ c. 42 | intrId · (UF · X) · (UF · Y) (ufimap' · X · Y -c) (ufimapLaw' · X · Y -c). 43 | -------------------------------------------------------------------------------- /efficient-mendler/Examples/UTree/UTree.ced: -------------------------------------------------------------------------------- 1 | module UTree. 2 | 3 | import Unit. 4 | import Sum. 5 | import Sigma. 6 | import Id. 7 | import Bool. 8 | import UF. 9 | import FixIndM · UF ufimap. 10 | import InductionM · UF ufimap. 11 | import ConstantTimeDestructor · UF ufimap. 12 | 13 | 14 | 15 | -- unbalanced trees datatype and its constructors 16 | UTree ◂ ★ = FixIndM. 17 | 18 | uleaf ◂ Bool ➔ UTree = λ b. inFixIndM 19 | (in1 · Bool · (Sigma · UTree · (λ x1 : UTree . Sigma · UTree · (λ x2 : UTree. NotEq · UTree x1 x2))) b). 20 | 21 | unode ◂ Π t1 : UTree. Π t2 : UTree. NotEq · UTree t1 t2 ➔ UTree = λ t1. λ t2. λ neq. 22 | inFixIndM (in2 · Bool · (Sigma · UTree · (λ x1 : UTree . Sigma · UTree · (λ x2 : UTree. NotEq · UTree x1 x2))) 23 | (pair · UTree · (λ x1 : UTree . (Sigma · UTree · (λ x2 : UTree . (NotEq · UTree x1 x2)))) t1 24 | (pair · UTree · (λ x2 : UTree . (NotEq · UTree t1 x2)) t2 neq))). 25 | 26 | 27 | -- destructor of UTree 28 | destrITree ◂ UTree ➔ UF · UTree = outFixIndM. 29 | 30 | 31 | -- "flat" induction for UTree from the generic induction by "pattern-matching" on UF 32 | inductionUTree ◂ ∀ P : UTree ➔ ★. (Π t1 : UTree. Π t2 : UTree. Π neq : NotEq · UTree t1 t2. 33 | P t1 ➔ P t2 ➔ P (unode t1 t2 neq)) ➔ (Π b : Bool. P (uleaf b)) ➔ Π t : UTree. P t = 34 | Λ P. λ s. λ b. λ t. induction · P 35 | (Λ R. Λ c. λ ih. λ ufr. 36 | θ (indSum · Bool · (Sigma · R · (λ x1 : R . Sigma · R · (λ x2 : R. NotEq · R x1 x2))) ufr) 37 | (λ a. b a) 38 | (λ b. θ (indSigma · R · (λ x1 : R . Sigma · R · (λ x2 : R. NotEq · R x1 x2)) b) 39 | (λ a. λ b'. θ (indSigma · R · (λ x2 : R . (NotEq · R a x2)) b') 40 | (λ a'. λ b. (s (elimId · R · UTree -c a) (elimId · R · UTree -c a') b (ih a) (ih a')))))) 41 | t. 42 | -------------------------------------------------------------------------------- /efficient-mendler/MendlerInduction/ConstantTimeDestructor.ced: -------------------------------------------------------------------------------- 1 | 2 | import IdMapping. 3 | 4 | module ConstantTimeDestructor (F : ★ ➔ ★)(imap : IdMapping · F). 5 | 6 | import Id. 7 | 8 | import FixIndM · F imap. 9 | import InductionM · F imap. 10 | 11 | 12 | -- Computationally induction is iteration: "induction p (inFixIndM fr) ≃ p (induction p) fr" 13 | -- This equation holds by reflexivity---there is only 14 | -- constant-number of beta-reductions from left-hand side of equation 15 | -- to the right-hand side. 16 | inductionIteration ◂ ∀ Q : FixIndM ➔ ★. 17 | Π p : PrfAlgM · FixIndM · Q inFixIndM. 18 | Π fr : F · (FixIndM). 19 | {induction p (inFixIndM fr) ≃ p -idf (induction · Q p) fr} 20 | = Λ Q. λ p. λ fr. β. 21 | 22 | 23 | -- Next, we define a proof algebra for constant predicate (λ _. F · (FixIndM)) 24 | outAlgM ◂ PrfAlgM · FixIndM · (λ _: FixIndM. F · FixIndM) inFixIndM 25 | = Λ R. Λ c. λ x. λ y. elimId · (F · R) · (F · FixIndM) -(imap · R · FixIndM -c) y. 26 | 27 | 28 | -- Observe, that "outAlgM" erases to "λ x. λ y. y" 29 | outFunLemma ◂ {outAlgM ≃ (λ x. λ y. y)} = β. 30 | 31 | 32 | -- Hence, outAlgM induces a constant-time inverse of inFixIndM! 33 | outFixIndM ◂ FixIndM ➔ F · FixIndM 34 | = λ e. induction · (λ _: (FixIndM). F · FixIndM) outAlgM e. 35 | 36 | 37 | -- outFixInd (inFixIndM fr) 38 | -- == induction outAlgM (inFixIndM fr) 39 | -- == outAlgM (induction outAlgM) fr 40 | -- == (λ x. λ y. y) (induction outAlgM) fr 41 | -- == fr 42 | -- Hence outFixIndM is constant-time under call-by-name reduction 43 | -- and the proof that outFixIndM is inverse of inFixIndM holds by reflexivity! 44 | lambek1 ◂ Π v: F · FixIndM. {outFixIndM (inFixIndM v) ≃ v} = λ v. β. 45 | 46 | 47 | -- Also, inFixIndM is an inverse of outFixIndM (this direction requires 48 | -- pattern-matching on the argument) 49 | lambek2 ◂ Π v: FixIndM. 50 | {inFixIndM (outFixIndM v) ≃ v} = λ v. θ induction 51 | (Λ R. Λ c. λ ih. λ fr. β) v. 52 | 53 | -------------------------------------------------------------------------------- /efficient-mendler/MendlerInduction/FixIndM.ced: -------------------------------------------------------------------------------- 1 | 2 | 3 | import IdMapping. 4 | 5 | module FixIndM (F : ★ ➔ ★)(imap : IdMapping · F). 6 | 7 | import Id. 8 | import FixM · F. 9 | 10 | 11 | -- dependently typed analog of AlgM 12 | PrfAlgM ◂ Π X : ★. (X ➔ ★) 13 | ➔ (F · X ➔ X) ➔ ★ = λ X : ★. 14 | λ Q : X ➔ ★. λ alg : (F · X ➔ X). 15 | ∀ R : ★. ∀ c : Id · R · X. 16 | (Π r : R. Q (elimId · R · X -c r)) ➔ 17 | Π gr : F · R. Q (alg (elimId · (F · R) · (F · X) -(imap · R · X -c) gr)). 18 | 19 | 20 | -- inductivitiy predicate on FixM in terms of proof algebras 21 | IsIndFixM ◂ FixM ➔ ★ 22 | = λ x : FixM. ∀ Q : FixM ➔ ★. 23 | PrfAlgM · FixM · Q inFixM ➔ Q x. 24 | 25 | 26 | -- FixIndM is an inductive subset of FixM carved out by inductivity 27 | -- predicate IsIndFixM 28 | FixIndM ◂ ★ = ι x : FixM. IsIndFixM x. 29 | 30 | 31 | -- the constructors of FixIndM are expressed via function inFixIndM 32 | tc1 ◂ F · FixIndM ➔ FixM 33 | = λ v. inFixM 34 | (elimId · (F · FixIndM) · (F · FixM) 35 | -(imap · FixIndM · FixM 36 | -(intrId · FixIndM · FixM (λ x. x.1) (λ _. β))) v). 37 | 38 | 39 | -- every "tc1 v" is inductive 40 | tc2 ◂ Π v : F · FixIndM. 41 | IsIndFixM (tc1 v) = λ v. (Λ Q. λ q. 42 | (q · FixIndM 43 | -(intrId · FixIndM · FixM (λ x. x.1) (λ z. β)) (λ r. r.2 · Q q) v)). 44 | 45 | 46 | -- collection of constructors of FixIndM expressed as conventional F-algebra 47 | inFixIndM ◂ F · FixIndM ➔ FixIndM = λ v. [ tc1 v, tc2 v ]. 48 | -------------------------------------------------------------------------------- /efficient-mendler/MendlerInduction/FixM.ced: -------------------------------------------------------------------------------- 1 | 2 | module FixM (F : ★ ➔ ★). 3 | 4 | import Empty. 5 | 6 | 7 | -- Mendler-style algebra 8 | AlgM ◂ ★ ➔ ★ = λ A : ★. 9 | ∀ R : ★. (R ➔ A) ➔ F · R ➔ A. 10 | 11 | 12 | -- least fixed point of F 13 | FixM ◂ ★ = ∀ A : ★. AlgM · A ➔ A. 14 | 15 | 16 | -- weak initiality of FixM F 17 | foldM ◂ ∀ A : ★. AlgM · A ➔ FixM ➔ A 18 | = Λ A. λ alg. λ fix. fix · A alg. 19 | 20 | 21 | -- constructor of FixM which is well-defined for any unrestricted 22 | -- F : ★ ➔ ★! 23 | inFixM ◂ F · FixM ➔ FixM 24 | = λ fexp. Λ A. λ alg. alg · FixM (foldM · A alg) fexp. 25 | 26 | 27 | -- if alg is AlgM A then "foldM alg" is an algebra homomorphism between 28 | -- the carrier of initial algebra (FixM F) and A. 29 | foldMHom ◂ ∀ A : ★. Π alg : AlgM · A. Π fr : F · FixM. 30 | { foldM · A alg (inFixM · F fr) ≃ alg · A (foldM · A alg) fr } 31 | = Λ A. λ alg. λ fr. β. 32 | 33 | {- 34 | -- We prove that the inverse of inFixM (for unrestricted F : ★ ➔ ★) 35 | -- implies inconsistency. We start by defining the type of inverse of inFixM 36 | OutFixM ◂ ★ = ∀ F : ★ ➔ ★. FixM · F ➔ F · (FixM · F). 37 | 38 | NegF ◂ ★ ➔ ★ = λ X: ★. ∀ Y : ★. X ➔ Y. 39 | 40 | T ◂ ★ = FixM · NegF. 41 | 42 | f ◂ OutFixM ➔ ∀ Y : ★. T ➔ Y = λ outFixM. Λ Y. λ t. outFixM · NegF t · Y t. 43 | 44 | t ◂ OutFixM ➔ T = λ outFixM. f outFixM · T (inFixM · NegF (f outFixM)). 45 | 46 | -- existence of function with type OutFixM implies inconsistency 47 | unsound ◂ OutFixM ➔ Empty = λ outFixM. Λ X. f outFixM · X (t outFixM). 48 | -} 49 | -------------------------------------------------------------------------------- /efficient-mendler/MendlerInduction/Id.ced: -------------------------------------------------------------------------------- 1 | 2 | module Id. 3 | 4 | import Sigma. 5 | import SubstComp. 6 | 7 | 8 | -- identity 9 | id ◂ ∀ X : ★. X ➔ X = Λ X. λ x. x. 10 | 11 | -- set of all functions from A to B which erase to term λ x. x 12 | Id ◂ Π A : ★. Π B : ★. ★ = λ A : ★. λ B : ★. 13 | Sigma · (A ➔ B) · (λ f : A ➔ B. {f ≃ id}). 14 | 15 | 16 | -- Introduction: any function f : X ➔ Y, which extensionally is 17 | -- identity could be turned into Id X Y 18 | intrId ◂ ∀ X : ★. ∀ Y : ★. Π f : X ➔ Y. (Π z : X. {f z ≃ z}) ➔ Id · X · Y 19 | = Λ X. Λ Y. λ if. λ p. pair · (X ➔ Y) · (λ f : X ➔ Y. {f ≃ id}) 20 | (λ fx. subst · Y · X -(if fx) fx -(p fx)) β. 21 | 22 | 23 | -- Elimination: if c : Id A B and x : A then elimId -c x has type B and 24 | -- is equal to x 25 | elimId ◂ ∀ A : ★ . ∀ B : ★ . Id · A · B ➾ A ➔ B = Λ A. Λ B. Λ c. λ a. 26 | subst · B · A -(proj1 · (A ➔ B) · (λ c : A ➔ B. {c ≃ id}) c a) 27 | a 28 | -(ρ (proj2 · (A ➔ B) · (λ c : A ➔ B. {c ≃ id}) c) - β). 29 | 30 | 31 | -- simplest identity function 32 | idf ◂ ∀ A : ★. Id · A · A = Λ A. intrId · A · A (λ x. x) (λ _. β). 33 | 34 | 35 | -- composition of identities is identity 36 | composeId ◂ ∀ A : ★ . ∀ B : ★ . ∀ C : ★. Id · A · B ➾ Id · B · C ➾ Id · A · C 37 | = Λ A. Λ B. Λ C. Λ c1. Λ c2. 38 | intrId · A · C (λ a. elimId · B · C -c2 (elimId · A · B -c1 a)) (λ _. β). 39 | -------------------------------------------------------------------------------- /efficient-mendler/MendlerInduction/IdMapping.ced: -------------------------------------------------------------------------------- 1 | module IdMapping. 2 | 3 | import Id. 4 | import Sigma. 5 | import SubstComp. 6 | import Functor. 7 | 8 | 9 | -- Scheme F : ★ ➔ ★ has an identity mapping if it can lift 10 | -- any Id X Y to Id (F X) (F Y) 11 | IdMapping ◂ (★ ➔ ★) ➔ ★ = λ F : ★ ➔ ★. 12 | ∀ X : ★. ∀ Y : ★. Id · X · Y ➾ Id · (F · X) · (F · Y). 13 | 14 | 15 | -- Every functor induces an identity mapping 16 | fm2im ◂ ∀ F : ★ ➔ ★. Π imap : Fmap · F. FmapIdLaw · F imap ➔ IdMapping · F 17 | = Λ F. λ imap. λ idlaw. Λ X. Λ Y. Λ idl. 18 | intrId · (F · X) · (F · Y) (imap · X · Y (elimId · X · Y -idl)) (idlaw · X). 19 | -------------------------------------------------------------------------------- /efficient-mendler/MendlerInduction/LiftPred.ced: -------------------------------------------------------------------------------- 1 | 2 | import IdMapping. 3 | 4 | module LiftPred (F : ★ ➔ ★)(imap : IdMapping · F). 5 | 6 | import Sigma. 7 | import Product. 8 | 9 | import FixM · F. 10 | import FixIndM · F imap. 11 | 12 | 13 | WithWitness ◂ Π X : ★. Π Y : ★. 14 | (X ➔ ★) ➔ (X ➔ Y) ➔ Y ➔ ★ 15 | = λ X : ★. λ Y : ★. λ Q : X ➔ ★. 16 | λ cast : X ➔ Y. λ y : Y. 17 | Sigma · X · (λ x : X. Product · {y ≃ cast x} · (Q x)). 18 | 19 | 20 | -- conversion of predicate on FixIndM to logically 21 | -- equivalent predicate on Fix 22 | Lift ◂ (FixIndM ➔ ★) ➔ FixM ➔ ★ 23 | = λ Q : FixIndM ➔ ★. λ e : FixM. 24 | WithWitness · FixIndM · (FixM) · Q (λ x. x.1) e. 25 | 26 | 27 | LiftProp1 ◂ ∀ Q : FixIndM ➔ ★. ∀ e : FixIndM. (Lift · Q e.1) ➔ Q e 28 | = Λ Q. Λ e. λ pr. 29 | ρ (projProd1 · {e ≃ (proj1 · FixIndM · 30 | (λ x' : FixIndM. Product · {e ≃ x'.1} · (Q x')) pr)} · 31 | (Q (proj1 · FixIndM · (λ x' : FixIndM. Product · {e ≃ x'} · (Q x')) pr)) 32 | (proj2 · FixIndM · (λ x' : FixIndM. Product · {e ≃ x'} · (Q x')) pr)) - 33 | (projProd2 · {e ≃ (proj1 pr)} · 34 | (Q (proj1 · FixIndM · (λ x' : FixIndM. Product · {e ≃ x'} · (Q x')) pr)) 35 | (proj2 · FixIndM · (λ x' : FixIndM. Product · {e ≃ x'} · (Q x')) pr)). 36 | 37 | 38 | LiftProp2 ◂ 39 | ∀ Q : FixIndM ➔ ★. 40 | Π e : FixIndM . Q e ➔ (Lift · Q e.1) 41 | = Λ Q. λ e. λ pr. pair · FixIndM · 42 | (λ x' : FixIndM. 43 | Product · {e ≃ x'} · (Q x')) e (pairProd · {e ≃ e} · (Q e) β pr). 44 | 45 | 46 | LiftProp3 ◂ ∀ Q : FixIndM ➔ ★. 47 | ∀ e : FixM. Lift · Q e ➔ FixIndM 48 | = Λ Q. Λ e. λ pr. proj1 · FixIndM · 49 | (λ x' : FixIndM. Product · {e ≃ x'} · (Q x')) pr. 50 | 51 | 52 | LiftProp4 ◂ ∀ Q : FixIndM ➔ ★. ∀ e : FixM. ∀ p : Lift · Q e. 53 | {LiftProp3 · Q p ≃ e} = Λ Q. Λ e. Λ pr. 54 | ρ (projProd1 · {e ≃ (proj1 pr)} · 55 | (Q (proj1 · FixIndM · (λ x' : FixIndM. 56 | Product · {e ≃ x'} · (Q x')) pr)) (proj2 · FixIndM · 57 | (λ x' : FixIndM. Product · {e ≃ x'} · (Q x')) pr)) - β. 58 | -------------------------------------------------------------------------------- /efficient-mendler/MendlerInduction/SubstComp.ced: -------------------------------------------------------------------------------- 1 | 2 | module SubstComp. 3 | 4 | 5 | 6 | subst ◂ ∀ X : ★. ∀ Y : ★. ∀ x : X. Π y : Y. { x ≃ y } ➾ X 7 | = Λ X. Λ Y. Λ x. λ y. Λ eq. (φ eq - x {y}) . 8 | 9 | -------------------------------------------------------------------------------- /efficient-mendler/README: -------------------------------------------------------------------------------- 1 | To typecheck this development with Cedille: 2 | 3 | 1. After installing the Cedille open any *.ced file and hit 4 | "Meta-s" to typecheck it. 5 | 6 | 2. The file "Everything.ced" contains the descriptions of main results 7 | of this development (processing it may take a few moments). -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Bool.ced: -------------------------------------------------------------------------------- 1 | 2 | module Bool. 3 | 4 | Bool ◂ ★ = ∀ X : ★. X ➔ X ➔ X. 5 | 6 | tt ◂ Bool = Λ X. λ a. λ b. a. 7 | ff ◂ Bool = Λ X. λ a. λ b. b. 8 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Cast.ced: -------------------------------------------------------------------------------- 1 | import SubstComp. 2 | import Id. 3 | 4 | 5 | Cast ◂ ★ ➔ ★ ➔ ★ = 6 | λ A : ★ . λ B : ★ . 7 | Π a : A . ι b : B . {b ≃ a} . 8 | 9 | 10 | elimCast ◂ ∀ A : ★ . ∀ B : ★ . Cast · A · B ➾ Π a : A . B = 11 | Λ A . Λ B . Λ c . λ a . subst · B · A -(c a).1 a -(c a).2. 12 | 13 | intrCast ◂ ∀ X : ★. ∀ Y : ★. Π f : X ➔ Y. (Π z : X. {f z ≃ z}) ➔ Cast · X · Y 14 | = Λ X. Λ Y. λ if. λ p. λ a. [ if a , ρ (p a) - β{if a} ]. 15 | 16 | 17 | c2i ◂ ∀ X : ★. ∀ Y : ★. Cast · X · Y ➾ Id · X · Y 18 | = Λ X. Λ Y. Λ c. intrId · X · Y (elimCast · X · Y -c) (λ z. β) . 19 | 20 | 21 | i2c ◂ ∀ X : ★. ∀ Y : ★. Id · X · Y ➾ Cast · X · Y 22 | = Λ X. Λ Y. Λ c. intrCast · X · Y (elimId · X · Y -c) (λ z. β) . 23 | 24 | 25 | CastDep ◂ Π A : ★. (A ➔ ★) ➔ ★ = 26 | λ A : ★ . λ B : A ➔ ★ . 27 | Π a : A . ι b : B a . {b ≃ a}. 28 | 29 | 30 | elimCastDep ◂ ∀ A : ★ . ∀ B : A ➔ ★ . CastDep · A · B ➾ Π a : A . B a = 31 | Λ A . Λ B . Λ c . λ a . subst · (B a) · A -(c a).1 a -(c a).2. 32 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Empty.ced: -------------------------------------------------------------------------------- 1 | 2 | module Empty. 3 | 4 | Empty ◂ ★ = ∀ X : ★. X. 5 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Functor.ced: -------------------------------------------------------------------------------- 1 | module Functor. 2 | 3 | -- type of "Fmap · F" is a type of morphism lifting for functor F 4 | Fmap ◂ (★ ➔ ★) ➔ ★ = 5 | λ F : ★ ➔ ★. ∀ X : ★. ∀ Y : ★. (X ➔ Y) ➔ F · X ➔ F · Y. 6 | 7 | -- FmapIdLaw · F fmap is a specification of identity law for "fmap" 8 | -- function of "F : ★ ➔ ★" 9 | FmapIdLaw ◂ Π F : ★ ➔ ★. Fmap · F ➔ ★ 10 | = λ F : ★ ➔ ★. λ fmap : Fmap · F. 11 | ∀ X : ★. Π x : F · X. {fmap (λ x. x) x ≃ x}. 12 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Product.ced: -------------------------------------------------------------------------------- 1 | module Product. 2 | 3 | import Sigma. 4 | 5 | -- product is defined as a sigma type where the type of the second 6 | -- projection does not depend on the type of the first one. 7 | Product ◂ ★ ➔ ★ ➔ ★ = λ A : ★. λ B : ★. Sigma · A · (λ _ : A. B). 8 | 9 | pairProd ◂ ∀ A : ★. ∀ B : ★. A ➔ B ➔ Product · A · B = 10 | Λ A. Λ B. λ a. λ b. pair · A · (λ _ : A. B) a b. 11 | 12 | indProd ◂ ∀ A : ★. ∀ B : ★. Π x : Product · A · B. 13 | ∀ P : Product · A · B ➔ ★. 14 | (Π a : A. Π b : B. P (pairProd · A · B a b)) ➔ 15 | P x = Λ A. Λ B. indSigma · A · (λ _ : A. B). 16 | 17 | projProd1 ◂ ∀ A : ★. ∀ B : ★. Product · A · B ➔ A = Λ A. Λ B. proj1 · A · (λ _ : A. B). 18 | projProd2 ◂ ∀ A : ★. ∀ B : ★. Product · A · B ➔ B = Λ A. Λ B. proj2 · A · (λ _ : A. B). 19 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Sigma.ced: -------------------------------------------------------------------------------- 1 | module Sigma. 2 | 3 | cSigma ◂ Π A : ★. (A ➔ ★) ➔ ★ = λ A : ★. λ B : A ➔ ★. 4 | ∀ X : ★. (Π a : A. B a ➔ X) ➔ X. 5 | 6 | cpair ◂ ∀ X : ★. ∀ Y : X ➔ ★. Π x : X. Y x ➔ cSigma · X · Y = 7 | Λ X. Λ Y. λ x. λ y. Λ Z. λ c. c x y. 8 | 9 | 10 | param-Sigma ◂ Π A : ★. Π P : A ➔ ★. cSigma · A · P ➔ ★ = 11 | λ A : ★. λ P : A ➔ ★. λ x : cSigma · A · P. 12 | ∀ X : ★. ∀ Q : X ➔ ★. ∀ pr : Π a : A. P a ➔ X. 13 | (Π a : A. Π b : P a. Q (pr a b)) ➔ Q (x · X pr). 14 | 15 | 16 | -- Sigma A B is a dependent product 17 | Sigma ◂ Π A : ★. (A ➔ ★) ➔ ★ = λ A : ★. λ PA : A ➔ ★. 18 | ι d : cSigma · A · PA. ι _ : {d cpair ≃ d}. param-Sigma · A · PA d. 19 | 20 | 21 | -- constructor 22 | pair ◂ ∀ X : ★. ∀ Y : X ➔ ★. Π x : X. Y x ➔ Sigma · X · Y = 23 | Λ X. Λ Y. λ x. λ y. [ cpair · X · Y x y , [ β{cpair x y} , Λ X'. Λ Q. Λ pr. λ e. e x y ] ]. 24 | 25 | 26 | -- manual derivation of induction for Sigma A B from parametricity 27 | indSigma ◂ ∀ A : ★. ∀ B : A ➔ ★. Π x : Sigma · A · B. 28 | ∀ P : Sigma · A · B ➔ ★. (Π a : A. Π b : B a. P (pair · A · B a b)) ➔ P x 29 | = Λ A. Λ B. λ x. Λ P. λ p. ρ ς x.2.1 - (x.2.2 · (Sigma · A · B) · P -(pair · A · B) p). 30 | 31 | 32 | -- projections for Sigma A B 33 | proj1 ◂ ∀ A : ★. ∀ B : A ➔ ★. Sigma · A · B ➔ A 34 | = Λ A. Λ B. λ s. s.1 · A (λ a. λ _. a). 35 | proj2 ◂ ∀ A : ★. ∀ B : A ➔ ★. Π s : Sigma · A · B. B (proj1 · A · B s) 36 | = Λ A. Λ B. λ s. θ (indSigma · A · B s) (λ a. λ b. b). 37 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Sum.ced: -------------------------------------------------------------------------------- 1 | module Sum. 2 | 3 | cSum ◂ ★ ➔ ★ ➔ ★ = λ A : ★. λ B : ★. ∀ X : ★. (A ➔ X) ➔ (B ➔ X) ➔ X. 4 | 5 | cin1 ◂ ∀ A : ★. ∀ B : ★. A ➔ cSum · A · B = Λ A. Λ B. λ a. Λ X. λ ca. λ cb. ca a. 6 | cin2 ◂ ∀ A : ★. ∀ B : ★. B ➔ cSum · A · B = Λ A. Λ B. λ b. Λ X. λ ca. λ cb. cb b. 7 | 8 | param-Sum ◂ Π A : ★. Π B : ★. cSum · A · B ➔ ★ = 9 | λ A : ★. λ B : ★. λ x : cSum · A · B. 10 | ∀ X : ★. ∀ P : X ➔ ★. ∀ ca : A ➔ X. ∀ cb : B ➔ X. 11 | (Π a : A. P (ca a)) ➔ (Π b : B. P (cb b)) ➔ P (x · X ca cb). 12 | 13 | 14 | -- Sum A B represents the disjoint sum of A and B 15 | Sum ◂ ★ ➔ ★ ➔ ★ = λ A : ★. λ B : ★. 16 | ι x : cSum · A · B. ι _ : {x cin1 cin2 ≃ x}. param-Sum · A · B x. 17 | 18 | 19 | -- injections 20 | in1 ◂ ∀ A : ★. ∀ B : ★. A ➔ Sum · A · B 21 | = Λ A. Λ B. λ a. [ cin1 · A · B a, [β{cin1 a} , Λ X. Λ P. Λ ca. Λ cb. λ pa. λ pb. pa a ]]. 22 | in2 ◂ ∀ A : ★. ∀ B : ★. B ➔ Sum · A · B 23 | = Λ A. Λ B. λ b. [ cin2 · A · B b, [β{cin2 b} , Λ X. Λ P. Λ ca. Λ cb. λ pa. λ pb. pb b ]]. 24 | 25 | 26 | -- manually derived induction for Sum from the parametricity 27 | indSum ◂ ∀ A : ★. ∀ B : ★. Π x : Sum · A · B. 28 | ∀ P : Sum · A · B ➔ ★. 29 | (Π a : A. P (in1 · A · B a)) ➔ (Π b : B. P (in2 · A · B b)) ➔ 30 | P x = 31 | Λ A. Λ B. λ x. Λ P. λ pa. λ pb. 32 | ρ ς x.2.1 - (x.2.2 · (Sum · A · B) · P -(in1 · A · B) -(in2 · A · B) pa pb). 33 | 34 | elimSum ◂ ∀ A : ★. ∀ B : ★. 35 | ∀ P : Sum · A · B ➔ ★. 36 | (Π a : A. P (in1 · A · B a)) ➔ (Π b : B. P (in2 · A · B b)) ➔ 37 | Π s : Sum · A · B. P s = 38 | Λ A. Λ B. Λ P. λ p1. λ p2. λ s. 39 | indSum · A · B s · P p1 p2. 40 | 41 | -- case construct non-dependent elimination of Sum A B 42 | case ◂ ∀ A : ★. ∀ B : ★. ∀ C : ★. Sum · A · B ➔ (A ➔ C) ➔ (B ➔ C) ➔ C = 43 | Λ A. Λ B. Λ C. λ s. λ f. λ g. s.1 · C f g. 44 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Top.ced: -------------------------------------------------------------------------------- 1 | -- technical utility 2 | module Top. 3 | 4 | Top ◂ ★ = {(λ x. x) ≃ (λ x. x)}. 5 | 6 | top ◂ Top = β{λ x. x}. 7 | 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Unit.ced: -------------------------------------------------------------------------------- 1 | module Unit. 2 | 3 | cUnit ◂ ★ = ∀ X : ★. X ➔ X. 4 | cunit ◂ cUnit = Λ X. λ x. x. 5 | 6 | 7 | param-Unit ◂ cUnit ➔ ★ = 8 | λ x : cUnit. ∀ X : ★. ∀ P : X ➔ ★. ∀ cu : X. P cu ➔ P (x · X cu). 9 | 10 | 11 | -- unit datatype and its constructor 12 | Unit ◂ ★ = ι x : cUnit. ι _ : { x cunit ≃ x }. param-Unit x. 13 | unit ◂ Unit = [ cunit , [β{cunit} , Λ X. Λ P. Λ cu. λ u. u ]]. 14 | 15 | 16 | -- induction principle for Unit derived from parametricity 17 | indUnit ◂ Π x : Unit. ∀ P : Unit ➔ ★. P unit ➔ P x = 18 | λ x. Λ P. λ u. ρ ς x.2.1 - (x.2.2 · Unit · P -unit u). 19 | 20 | 21 | -- Unit has a single inhabitant "unit". 22 | etaUnit ◂ Π x : Unit. { x ≃ unit } = 23 | λ x. θ (indUnit x) β. 24 | 25 | -------------------------------------------------------------------------------- /efficient-mendler/Utilities/Utils.ced: -------------------------------------------------------------------------------- 1 | 2 | module Utils. 3 | 4 | import Top. 5 | 6 | -- technical utility 7 | rew ◂ ∀ x : Top. ∀ y : Top. ∀ z : Top. {x ≃ y} ➔ {y ≃ z} ➔ {x ≃ z} 8 | = Λ x. Λ y. Λ z. λ p1. λ p2. ρ p1 - p2. 9 | -------------------------------------------------------------------------------- /generic-reuse/.cedille/options: -------------------------------------------------------------------------------- 1 | import-directories = 2 | "Base" 3 | "Datatypes" 4 | "Examples" 5 | "GenericReuse" 6 | "IndexedMendlerInduction" 7 | . 8 | 9 | 10 | use-cede-files = false. 11 | make-rkt-files = false. 12 | generate-logs = false. 13 | show-qualified-vars = false. 14 | -------------------------------------------------------------------------------- /generic-reuse/Base/Bool.ced: -------------------------------------------------------------------------------- 1 | module Bool. 2 | 3 | data Bool : ★ = true : Bool | false : Bool. 4 | 5 | not ◂ Bool ➔ Bool = λ b. μ' b { true ➔ false | false ➔ true }. 6 | -------------------------------------------------------------------------------- /generic-reuse/Base/Empty.ced: -------------------------------------------------------------------------------- 1 | module Empty. 2 | 3 | Empty ◂ ★ = ∀ X : ★. X. 4 | -------------------------------------------------------------------------------- /generic-reuse/Base/Eq.ced: -------------------------------------------------------------------------------- 1 | module Eq. 2 | 3 | Eq ◂ Π A : ★. A ➔ A ➔ ★ = λ A : ★. λ x : A. λ y : A. {x ≃ y}. 4 | HEq ◂ Π A : ★. Π B : ★. A ➔ B ➔ ★ = λ A : ★. λ B : ★. λ x : A. λ y : B. {x ≃ y}. 5 | 6 | trans ◂ ∀ A : ★. ∀ B : ★. ∀ C : ★. ∀ x : A. ∀ y : B. ∀ z : C. {x ≃ y} ➔ {y ≃ z} ➔ {x ≃ z} 7 | = Λ A. Λ B. Λ C. Λ x. Λ y. Λ z. λ p1. λ p2. ρ p1 - p2. 8 | 9 | subst ◂ ∀ X : ★. ∀ Y : ★. ∀ x : X. Π y : Y. { x ≃ y } ➾ X 10 | = Λ X. Λ Y. Λ x. λ y. Λ eq. (φ eq - x {y}) . 11 | 12 | 13 | -------------------------------------------------------------------------------- /generic-reuse/Base/Product.ced: -------------------------------------------------------------------------------- 1 | module Product. 2 | 3 | import Sigma. 4 | 5 | Product ◂ ★ ➔ ★ ➔ ★ = λ A : ★. λ B : ★. Sigma · A · (λ _ : A. B). 6 | 7 | pairProd ◂ ∀ A : ★. ∀ B : ★. A ➔ B ➔ Product · A · B = 8 | Λ A. Λ B. λ a. λ b. pair · A · (λ _ : A. B) a b. 9 | 10 | elimProd ◂ ∀ A : ★. ∀ B : ★. ∀ P : Product · A · B ➔ ★. 11 | (Π a : A. Π b : B. P (pairProd · A · B a b)) ➔ Π s : Product · A · B. P s 12 | = Λ A. Λ B. elimSigma · A · (λ a : A. B). 13 | foldProd ◂ ∀ A : ★. ∀ B : ★. ∀ C : ★. 14 | (Π a : A. Π b : B. C) ➔ Π s : Product · A · B. C 15 | = Λ A. Λ B. Λ C. elimProd · A · B · (λ _ : Product · A · B. C). 16 | 17 | projProd1 ◂ ∀ A : ★. ∀ B : ★. Product · A · B ➔ A = Λ A. Λ B. proj1 · A · (λ _ : A. B). 18 | projProd2 ◂ ∀ A : ★. ∀ B : ★. Product · A · B ➔ B = Λ A. Λ B. proj2 · A · (λ _ : A. B). 19 | 20 | etaProduct ◂ ∀ A : ★. ∀ B : ★. Π xs : Product · A · B. 21 | { xs ≃ pairProd (projProd1 xs) (projProd2 xs) } 22 | = Λ A. Λ B. etaSigma · A · (λ _ : A. B). 23 | -------------------------------------------------------------------------------- /generic-reuse/Base/Sigma.ced: -------------------------------------------------------------------------------- 1 | module Sigma. 2 | 3 | data Sigma (A : ★) (B : A ➔ ★) : ★ = pair : Π a : A. B a ➔ Sigma. 4 | 5 | elimSigma ◂ ∀ A : ★. ∀ B : A ➔ ★. ∀ P : Sigma · A · B ➔ ★. 6 | (Π a : A. Π b : B a. P (pair a b)) ➔ Π s : Sigma · A · B. P s 7 | = Λ A. Λ B. Λ P. λ p. λ s. 8 | μ' s @ P { pair a b ➔ p a b }. 9 | foldSigma ◂ ∀ A : ★. ∀ B : A ➔ ★. ∀ C : ★. 10 | (Π a : A. B a ➔ C) ➔ Sigma · A · B ➔ C 11 | = Λ A. Λ B. Λ C. elimSigma · A · B · (λ s : Sigma · A · B. C). 12 | 13 | proj1 ◂ ∀ A : ★. ∀ B : A ➔ ★. Sigma · A · B ➔ A 14 | = Λ A. Λ B. λ s. μ' s { pair a b ➔ a }. 15 | proj2 ◂ ∀ A : ★. ∀ B : A ➔ ★. Π s : Sigma · A · B. B (proj1 · A · B s) 16 | = Λ A. Λ B. λ s. μ' s 17 | @ (λ s' : Sigma · A · B. B (proj1 s')) 18 | { pair a b ➔ b }. 19 | 20 | etaSigma ◂ ∀ A : ★. ∀ B : A ➔ ★. Π xs : Sigma · A · B. 21 | { xs ≃ pair (proj1 xs) (proj2 xs) } = 22 | Λ A. Λ B. elimSigma · A · B 23 | · (λ xs : Sigma · A · B. { xs ≃ pair (proj1 xs) (proj2 xs) }) 24 | (λ a. λ b. β). 25 | 26 | invPair1 ◂ ∀ A : ★. ∀ B : ★. ∀ a : A. ∀ a' : A. ∀ b : B. ∀ b' : B. 27 | {pair a b ≃ pair a' b'} ➔ {a ≃ a'} 28 | = Λ A. Λ B. Λ a. Λ a'. Λ b. Λ b'. λ q. 29 | χ {proj1 (pair a b) ≃ proj1 (pair a' b')} - 30 | ρ q - β. 31 | 32 | invPair2 ◂ ∀ A : ★. ∀ B : ★. ∀ a : A. ∀ a' : A. ∀ b : B. ∀ b' : B. 33 | {pair a b ≃ pair a' b'} ➔ {b ≃ b'} 34 | = Λ A. Λ B. Λ a. Λ a'. Λ b. Λ b'. λ q. 35 | χ {proj2 (pair a b) ≃ proj2 (pair a' b')} - 36 | ρ q - β. 37 | -------------------------------------------------------------------------------- /generic-reuse/Base/Unit.ced: -------------------------------------------------------------------------------- 1 | module Unit. 2 | 3 | data Unit : ★ = unit : Unit. 4 | 5 | elimUnit ◂ ∀ P : Unit ➔ ★. P unit ➔ Π u : Unit. P u 6 | = Λ P. λ p. λ u. 7 | μ' u @ P { unit ➔ p }. 8 | foldUnit ◂ ∀ C : ★. C ➔ Unit ➔ C 9 | = Λ C. elimUnit · (λ u : Unit. C). 10 | 11 | etaUnit ◂ Π u : Unit. { u ≃ unit } = 12 | elimUnit · (λ u : Unit. { u ≃ unit }) β. 13 | 14 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/All.ced: -------------------------------------------------------------------------------- 1 | module All. 2 | 3 | import List. 4 | import Product. 5 | import Sigma. 6 | import Id. 7 | import IFixIndM. 8 | import AllF. 9 | 10 | All ◂ Π A : ★. Π Q : A ➔ ★. List · A ➔ ★ = 11 | λ A : ★. λ Q : A ➔ ★. IFixIndM · (List · A) · (AllF · A · Q) (imapA · A · Q). 12 | done ◂ ∀ A : ★. ∀ Q : A ➔ ★. All · A · Q (nilL · A) 13 | = Λ A. Λ Q. iinIndM · (List · A) · (AllF · A · Q) 14 | -(imapA · A · Q) -(nilL · A) 15 | (doneF · A · Q · (All · A · Q)). 16 | next ◂ ∀ A : ★. ∀ Q : A ➔ ★. ∀ x : A. ∀ xs : List · A. Q x ➔ All · A · Q xs ➔ All · A · Q (consL · A x xs) 17 | = Λ A. Λ Q. Λ x. Λ xs. λ q. λ qs. iinIndM · (List · A) · (AllF · A · Q) 18 | -(imapA · A · Q) -(consL · A x xs) 19 | (nextF · A · Q · (All · A · Q) -x -xs q qs). 20 | 21 | elimAll ◂ ∀ A : ★. ∀ Q : A ➔ ★. ∀ P : Π xs : List · A. All · A · Q xs ➔ ★. 22 | Π pD : P (nilL · A) (done · A · Q). 23 | Π pN : ∀ x : A. ∀ xs : List · A. Π q : Q x. Π qs : All · A · Q xs. 24 | P xs qs ➔ P (consL · A x xs) (next · A · Q -x -xs q qs). 25 | ∀ xs : List · A. Π qs : All · A · Q xs. P xs qs 26 | = Λ A. Λ Q. Λ P. λ pD. λ pN. iinductionM 27 | · (List · A) · (AllF · A · Q) -(imapA · A · Q) · P 28 | (Λ R. Λ c. λ ih. elimAllF · A · Q · R 29 | · (λ xs : List · A. λ s : AllF · A · Q · R xs. P xs 30 | (iinIndM · (List · A) · (AllF · A · Q) -(imapA · A · Q) -xs 31 | (elimId · (AllF · A · Q · R xs) · (AllF · A · Q · (All · A · Q) xs) 32 | (imapA · A · Q · R · (All · A · Q) c -xs) s) 33 | )) 34 | pD 35 | (Λ x. Λ xs. λ q. λ qs. pN -x -xs q (elimId~ · (R xs) · (All · A · Q xs) -(c -xs) qs) (ih -xs qs)) 36 | ). 37 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/AllF.ced: -------------------------------------------------------------------------------- 1 | module AllF. 2 | 3 | import List. 4 | import Sigma. 5 | import Product. 6 | import Id. 7 | import IFixIndM. 8 | 9 | data AllF (A : ★) (Q : A ➔ ★) (X : List · A ➔ ★) : List · A ➔ ★ = 10 | | doneF : AllF (nilL · A) 11 | | nextF : ∀ x : A. ∀ xs : List · A. Q x ➔ X xs ➔ AllF (consL x xs). 12 | 13 | elimAllF ◂ ∀ A : ★. ∀ Q : A ➔ ★. ∀ X : List · A ➔ ★. 14 | ∀ P : Π xs : List · A. AllF · A · Q · X xs ➔ ★. 15 | Π pD : P (nilL · A) (doneF · A · Q · X). 16 | Π pN : ∀ x : A. ∀ xs : List · A. Π q : Q x. Π qs : X xs. P (consL · A x xs) (nextF · A · Q · X -x -xs q qs). 17 | ∀ xs : List · A. Π qs : AllF · A · Q · X xs. P xs qs 18 | = Λ A. Λ Q. Λ X. Λ P. λ pD. λ pN. Λ xs. λ s. 19 | μ' s @ P { doneF ➔ pD | nextF -x -xs q qs ➔ pN -x -xs q qs }. 20 | 21 | imapA ◂ ∀ A : ★. ∀ Q : A ➔ ★. IIdMapping · (List · A) · (AllF · A · Q) 22 | = Λ A. Λ Q. Λ X. Λ Y. λ c. elimAllF · A · Q · X 23 | · (λ xs : List · A. λ s : AllF · A · Q · X xs. IdCod · (AllF · A · Q · X xs) · (AllF · A · Q · Y xs) s) 24 | (pairId -(doneF · A · Q · X) (doneF · A · Q · Y) β) 25 | (Λ y. Λ xs. λ q. λ qs. 26 | pairId -(nextF -y -xs q qs) (nextF -y -xs q (elimId (c -xs) qs)) β). 27 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/Ctx.ced: -------------------------------------------------------------------------------- 1 | module Ctx. 2 | import Tp. 3 | import List. 4 | import Sigma. 5 | import Product. 6 | 7 | Ctx ◂ ★ = List · Tp. 8 | emp ◂ Ctx = nilL · Tp. 9 | ext ◂ Ctx ➔ Tp ➔ Ctx = λ G. λ A. consL · Tp A G. 10 | 11 | CtxTp ◂ ★ = Product · Ctx · Tp. 12 | pairCtxTp ◂ Ctx ➔ Tp ➔ CtxTp = pairProd · Ctx · Tp. 13 | projCtx ◂ CtxTp ➔ Ctx = projProd1 · Ctx · Tp. 14 | projTp ◂ CtxTp ➔ Tp = projProd2 · Ctx · Tp. 15 | 16 | etaCtxTp ◂ Π GA : CtxTp. { GA ≃ pairCtxTp (projCtx GA) (projTp GA) } 17 | = etaSigma · Ctx · (λ _ : Ctx. Tp). 18 | 19 | invCtxTp1 ◂ ∀ GA : CtxTp. ∀ G' : Ctx. ∀ A' : Tp. 20 | {GA ≃ pairCtxTp G' A'} ➔ {projCtx GA ≃ G'} 21 | = Λ GA. Λ G'. Λ A'. λ q. ρ q - β. 22 | 23 | projPairCod ◂ ∀ G : Ctx. ∀ A : Tp. ∀ B : Tp. Π GC : CtxTp. {GC ≃ pair G (Arr A B)} ➔ Tp 24 | = Λ G. Λ A. Λ B. elimProd · Ctx · Tp · (λ GC : CtxTp. {GC ≃ pair G (Arr A B)} ➔ Tp) 25 | (λ G'. λ C. λ q. projArrCod -A -B C (invPair2 · Ctx · Tp -G' -G -C -(Arr A B) q) 26 | ) 27 | . 28 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/Env.ced: -------------------------------------------------------------------------------- 1 | module Env. 2 | import Tp. 3 | import Term. 4 | import Ctx. 5 | import Mem. 6 | import Product. 7 | import All. 8 | 9 | Ctx2 ◂ ★ = Product · Ctx · Ctx. 10 | projCtx1 ◂ Ctx2 ➔ Ctx = projProd1 · Ctx · Ctx. 11 | projCtx2 ◂ Ctx2 ➔ Ctx = projProd2 · Ctx · Ctx. 12 | 13 | Env ◂ Ctx2 ➔ ★ = λ GD : Ctx2. 14 | All · Tp · (λ A : Tp. Term (pairCtxTp (projCtx2 GD) A)) (projCtx1 GD). 15 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/ListF.ced: -------------------------------------------------------------------------------- 1 | module ListF. 2 | 3 | import Id. 4 | import Sigma. 5 | 6 | data ListF (A : ★) (X : ★) : ★ = 7 | | nilLF : ListF 8 | | consLF : A ➔ X ➔ ListF. 9 | 10 | elimListF ◂ ∀ A : ★. ∀ X : ★. ∀ P : ListF · A · X ➔ ★. 11 | P (nilLF · A · X) ➔ (Π a : A. Π x : X. P (consLF a x)) ➔ 12 | Π s : ListF · A · X. P s 13 | = Λ A. Λ X. Λ P. λ pN. λ pC. λ s. 14 | μ' s @ P { nilLF ➔ pN | consLF a x ➔ pC a x }. 15 | foldListF ◂ ∀ A : ★. ∀ X : ★. ∀ C : ★. 16 | C ➔ (A ➔ X ➔ C) ➔ ListF · A · X ➔ C 17 | = Λ A. Λ X. Λ C. elimListF · A · X · (λ s : ListF · A · X. C). 18 | 19 | imapL ◂ ∀ A : ★. IdMapping · (ListF · A) 20 | = Λ A. Λ X. Λ Y. λ c. elimListF · A · X 21 | · (λ s : ListF · A · X. IdCod · (ListF · A · X) · (ListF · A · Y) s) 22 | (pairId -(nilLF · A · X) (nilLF · A · Y) β) 23 | (λ a. λ x. pairId -(consLF a x) (consLF a (elimId c x)) β). 24 | 25 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/MemF.ced: -------------------------------------------------------------------------------- 1 | module MemF. 2 | 3 | import List. 4 | import Sigma. 5 | import Product. 6 | import Id. 7 | import IFixIndM. 8 | 9 | data MemF (A : ★) {x : A} (X : List · A ➔ ★) : List · A ➔ ★ = 10 | | hereF : ∀ xs : List · A. MemF (consL x xs) 11 | | thereF : ∀ y : A. ∀ xs : List · A. X xs ➔ MemF (consL y xs). 12 | 13 | elimMemF ◂ ∀ A : ★. ∀ x : A. ∀ X : List · A ➔ ★. 14 | ∀ P : Π xs : List · A. MemF · A x · X xs ➔ ★. 15 | Π pH : ∀ xs : List · A. P (consL · A x xs) (hereF -x · X -xs). 16 | Π pT : ∀ y : A. ∀ xs : List · A. Π i : X xs. P (consL y xs) (thereF -x · X -y -xs i). 17 | ∀ xs : List · A. Π i : MemF · A x · X xs. P xs i 18 | = Λ A. Λ x. Λ X. Λ P. λ pH. λ pT. Λ xs. λ s. 19 | μ' s @ P { hereF -xs ➔ pH -xs | thereF -y -xs i ➔ pT -y -xs i }. 20 | 21 | imapMem ◂ ∀ A : ★. ∀ x : A. IIdMapping · (List · A) · (MemF · A x) 22 | = Λ A. Λ x. Λ X. Λ Y. λ c. elimMemF -x · X 23 | · (λ xs : List · A. λ s : MemF · A x · X xs. IdCod · (MemF · A x · X xs) · (MemF · A x · Y xs) s) 24 | (Λ xs. pairId -(hereF -x · X -xs) (hereF -x · Y -xs) β) 25 | (Λ y. Λ xs. λ i. pairId 26 | -(thereF -x · X -y -xs i) 27 | (thereF -x · Y -y -xs (elimId (c -xs) i)) 28 | β 29 | ) 30 | . 31 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/Nat.ced: -------------------------------------------------------------------------------- 1 | module Nat. 2 | 3 | import Id. 4 | import AlgM. 5 | import FixIndM. 6 | import NatF. 7 | import IFixM. 8 | import Unit. 9 | import Bool. 10 | 11 | Nat ◂ ★ = FixIndM · NatF imapN. 12 | inNat ◂ NatF · Nat ➔ Nat = inIndM · NatF -imapN. 13 | zero ◂ Nat = inIndM · NatF -imapN (zeroF · Nat). 14 | suc ◂ Nat ➔ Nat = λ n. inIndM · NatF -imapN (sucF · Nat n). 15 | 16 | elimNat ◂ ∀ P : Nat ➔ ★. P zero ➔ (Π n : Nat. P n ➔ P (suc n)) ➔ Π n : Nat. P n 17 | = Λ P. λ pZ. λ pS. inductionM · NatF -imapN · P 18 | (Λ R. Λ c. λ ih. elimNatF · R 19 | · (λ s : NatF · R. P (inIndM · NatF -imapN (elimId · (NatF · R) · (NatF · Nat) 20 | (imapN · R · Nat c) s))) 21 | pZ 22 | (λ r. pS (elimId~ · R · Nat -c r) (ih r)) 23 | ). 24 | foldNat ◂ ∀ C : ★. C ➔ (Nat ➔ C ➔ C) ➔ Nat ➔ C 25 | = Λ C. elimNat · (λ n : Nat. C). 26 | 27 | addAlgM ◂ AlgM · NatF · (Nat ➔ Nat) 28 | = Λ R. λ rec. λ s. λ m . foldNatF · R · Nat m (λ r. suc (rec r m)) s. 29 | add ◂ Nat ➔ Nat ➔ Nat = foldIndM · NatF -imapN · (Nat ➔ Nat) addAlgM. 30 | 31 | isZero ◂ Nat ➔ Bool 32 | = foldNat · Bool true (λ n. λ ih. false). 33 | isSuc ◂ Nat ➔ Bool 34 | = λ n. not (isZero n). 35 | pred ◂ Nat ➔ Nat 36 | = foldNat · Nat zero (λ n. λ ih. n). 37 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/NatF.ced: -------------------------------------------------------------------------------- 1 | module NatF. 2 | 3 | import Id. 4 | import Sigma. 5 | 6 | data NatF (X : ★) : ★ = 7 | | zeroF : NatF 8 | | sucF : X ➔ NatF. 9 | 10 | elimNatF ◂ ∀ X : ★. ∀ P : NatF · X ➔ ★. 11 | P (zeroF · X) ➔ (Π x : X. P (sucF x)) ➔ 12 | Π s : NatF · X. P s 13 | = Λ X. Λ P. λ pZ. λ pS. λ s. 14 | μ' s @ P { zeroF ➔ pZ | sucF x ➔ pS x }. 15 | foldNatF ◂ ∀ X : ★. ∀ C : ★. 16 | C ➔ (X ➔ C) ➔ NatF · X ➔ C 17 | = Λ X. Λ C. elimNatF · X · (λ s : NatF · X. C). 18 | 19 | imapN ◂ IdMapping · (NatF) 20 | = Λ X. Λ Y. λ c. elimNatF · X 21 | · (λ s : NatF · X. IdCod · (NatF · X) · (NatF · Y) s) 22 | (pairId -(zeroF · X) (zeroF · Y) β) 23 | (λ x. pairId -(sucF · X x) (sucF · Y (elimId · X · Y c x)) β). 24 | 25 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/RawF.ced: -------------------------------------------------------------------------------- 1 | module RawF. 2 | import Id. 3 | import Sigma. 4 | import Nat. 5 | import Tp. 6 | 7 | data RawF (X : ★) : ★ = 8 | | varF : Nat ➔ RawF 9 | | lamF : Tp ➔ X ➔ RawF 10 | | appF : X ➔ X ➔ RawF. 11 | 12 | elimRawF ◂ ∀ X : ★. ∀ P : RawF · X ➔ ★. 13 | (Π n : Nat. P (varF n)) ➔ 14 | (Π A : Tp. Π x : X. P (lamF A x)) ➔ 15 | (Π x1 : X. Π x2 : X. P (appF x1 x2)) ➔ 16 | Π s : RawF · X. P s 17 | = Λ X. Λ P. λ pV. λ pL. λ pA. λ s. 18 | μ' s @ P { 19 | | varF n ➔ pV n 20 | | lamF A x ➔ pL A x 21 | | appF x1 x2 ➔ pA x1 x2 22 | }. 23 | foldRawF ◂ ∀ X : ★. ∀ C : ★. 24 | (Nat ➔ C) ➔ (Tp ➔ X ➔ C) ➔ (X ➔ X ➔ C) ➔ RawF · X ➔ C 25 | = Λ X. Λ C. elimRawF · X · (λ s : RawF · X. C). 26 | 27 | imapRaw ◂ IdMapping · RawF 28 | = Λ X. Λ Y. λ c. elimRawF · X 29 | · (λ s : RawF · X. IdCod · (RawF · X) · (RawF · Y) s) 30 | (λ n. pairId -(varF · X n) (varF · Y n) β) 31 | (λ A. λ x. pairId -(lamF A x) (lamF A (elimId c x)) β) 32 | (λ x1. λ x2. pairId -(appF x1 x2) (appF (elimId c x1) (elimId c x2)) β). 33 | 34 | 35 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/Raws.ced: -------------------------------------------------------------------------------- 1 | module Raws. 2 | import Raw. 3 | import List. 4 | 5 | Raws ◂ ★ = List · Raw. 6 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/Taking.ced: -------------------------------------------------------------------------------- 1 | import Raws. 2 | import Env. 3 | import Id. 4 | import Sigma. 5 | import TermRawReuse. 6 | module Taking. 7 | 8 | Taking ◂ Ctx2 ➔ Raws ➔ ★ 9 | = λ GD : Ctx2. λ e : Raws. 10 | Sigma · (Env GD) · (λ e' : Env GD. {e' ≃ e}). 11 | 12 | envTaking ◂ Π GD : Ctx2. Π e : Env GD. Taking GD (elimId · (Env GD) · Raws (ts2rs -GD) e) 13 | = λ GD. λ e. pair · (Env GD) · (λ e' : Env GD. {e' ≃ e}) e β. 14 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/TermF.ced: -------------------------------------------------------------------------------- 1 | module TermF. 2 | import Id. 3 | import Sigma. 4 | import Nat. 5 | import Ctx. 6 | import Tp. 7 | import Mem. 8 | import Product. 9 | 10 | data TermF (X : CtxTp ➔ ★) : CtxTp ➔ ★ = 11 | | ivarF : ∀ G : Ctx. ∀ A : Tp. Mem · Tp A G ➔ TermF (pairCtxTp G A) 12 | | ilamF : ∀ G : Ctx. Π A : Tp. ∀ B : Tp. X (pairCtxTp (ext G A) B) ➔ TermF (pairCtxTp G (Arr A B)) 13 | | iappF : ∀ G : Ctx. ∀ A : Tp. ∀ B : Tp. X (pairCtxTp G (Arr A B)) ➔ X (pairCtxTp G A) ➔ TermF (pairCtxTp G B) 14 | . 15 | 16 | elimTermF ◂ ∀ X : CtxTp ➔ ★. ∀ P : Π GA : CtxTp. TermF · X GA ➔ ★. 17 | Π pV : ∀ G : Ctx. ∀ A : Tp. Π i : Mem · Tp A G. P (pairCtxTp G A) (ivarF · X -G -A i). 18 | Π pL : ∀ G : Ctx. Π A : Tp. ∀ B : Tp. Π x : X (pairCtxTp (ext G A) B). P (pairCtxTp G (Arr A B)) (ilamF -G A -B x). 19 | Π pA : ∀ G : Ctx. ∀ A : Tp. ∀ B : Tp. Π x1 : X (pairCtxTp G (Arr A B)). Π x2 : X (pairCtxTp G A). P (pairCtxTp G B) (iappF -G -A -B x1 x2). 20 | ∀ GA : CtxTp. Π s : TermF · X GA. P GA s 21 | = Λ X. Λ P. λ pV. λ pL. λ pA. Λ GA. λ s. 22 | μ' s @ P { 23 | | ivarF -G -A i ➔ pV -G -A i 24 | | ilamF -G A -B x ➔ pL -G A -B x 25 | | iappF -G -A -B x1 x2 ➔ pA -G -A -B x1 x2 26 | }. 27 | 28 | imapTerm ◂ IIdMapping · CtxTp · TermF 29 | = Λ X. Λ Y. λ c. elimTermF · X 30 | · (λ GA : CtxTp. λ s : TermF · X GA. IdCod · (TermF · X GA) · (TermF · Y GA) s) 31 | (Λ G. Λ A. λ i. pairId 32 | -(ivarF · X -G -A i) (ivarF · Y -G -A i) β) 33 | (Λ G. λ A. Λ B. λ x. pairId 34 | -(ilamF · X -G A -B x) (ilamF · Y -G A -B 35 | (elimId (c -(pairCtxTp (ext G A) B)) x)) 36 | β) 37 | (Λ G. Λ A. Λ B. λ x1. λ x2. pairId 38 | -(iappF · X -G -A -B x1 x2) (iappF · Y -G -A -B 39 | (elimId (c -(pairCtxTp G (Arr A B))) x1) 40 | (elimId (c -(pairCtxTp G A)) x2)) 41 | β) 42 | . 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/Tp.ced: -------------------------------------------------------------------------------- 1 | module Tp. 2 | 3 | import Id. 4 | import FixIndM. 5 | import TpF. 6 | import IFixM. 7 | import Unit. 8 | import Bool. 9 | 10 | Tp ◂ ★ = FixIndM · TpF imapTp. 11 | Base ◂ Tp = inIndM · TpF -imapTp (BaseF · Tp). 12 | Arr ◂ Tp ➔ Tp ➔ Tp = λ A. λ B. inIndM · TpF -imapTp (ArrF · Tp A B). 13 | 14 | elimTp ◂ ∀ P : Tp ➔ ★. P Base ➔ (Π A : Tp. P A ➔ Π B : Tp. P B ➔ P (Arr A B)) ➔ Π A : Tp. P A 15 | = Λ P. λ pB. λ pA. inductionM · TpF -imapTp · P 16 | (Λ R. Λ c. λ ih. elimTpF · R 17 | · (λ s : TpF · R. P (inIndM · TpF -imapTp (elimId · (TpF · R) · (TpF · Tp) 18 | (imapTp · R · Tp c) s))) 19 | pB 20 | (λ r1. λ r2. pA (elimId~ · R · Tp -c r1) (ih r1) (elimId~ · R · Tp -c r2) (ih r2)) 21 | ). 22 | foldTp ◂ ∀ C : ★. C ➔ (Tp ➔ C ➔ Tp ➔ C ➔ C) ➔ Tp ➔ C 23 | = Λ C. elimTp · (λ n : Tp. C). 24 | 25 | isArr ◂ Tp ➔ Bool 26 | = foldTp · Bool false (λ A. λ ihA. λ B. λ ihB. true). 27 | notArr ◂ Tp ➔ Bool = λ A. not (isArr A). 28 | 29 | projArrCod ◂ ∀ A : Tp. ∀ B : Tp. Π C : Tp. {C ≃ Arr A B} ➔ Tp 30 | = Λ A. Λ B. elimTp · (λ C : Tp. {C ≃ Arr A B} ➔ Tp) 31 | (λ q. δ - χ {notArr Base ≃ notArr (Arr A B)} - ρ q - β) 32 | (λ A'. λ ihA. λ B'. λ ihB. λ q. B') 33 | . 34 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/TpF.ced: -------------------------------------------------------------------------------- 1 | module TpF. 2 | 3 | import Id. 4 | import Sigma. 5 | 6 | data TpF (X : ★) : ★ = 7 | | BaseF : TpF 8 | | ArrF : X ➔ X ➔ TpF. 9 | 10 | elimTpF ◂ ∀ X : ★. ∀ P : TpF · X ➔ ★. 11 | P (BaseF · X) ➔ (Π x1 : X. Π x2 : X. P (ArrF x1 x2)) ➔ 12 | Π s : TpF · X. P s 13 | = Λ X. Λ P. λ pB. λ pA. λ s. 14 | μ' s @ P { BaseF ➔ pB | ArrF x1 x2 ➔ pA x1 x2 }. 15 | foldTpF ◂ ∀ X : ★. ∀ C : ★. 16 | C ➔ (X ➔ X ➔ C) ➔ TpF · X ➔ C 17 | = Λ X. Λ C. elimTpF · X · (λ s : TpF · X. C). 18 | 19 | imapTp ◂ IdMapping · TpF 20 | = Λ X. Λ Y. λ c. elimTpF · X 21 | · (λ s : TpF · X. IdCod · (TpF · X) · (TpF · Y) s) 22 | (pairId · (TpF · X) · (TpF · Y) -(BaseF · X) (BaseF · Y) β) 23 | (λ x1. λ x2. pairId -(ArrF x1 x2) (ArrF (elimId c x1) (elimId c x2)) β). 24 | 25 | 26 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/Vec.ced: -------------------------------------------------------------------------------- 1 | module Vec. 2 | 3 | import Nat. 4 | import Id. 5 | import IFixIndM. 6 | import VecF. 7 | import List. 8 | 9 | Vec ◂ ★ ➔ Nat ➔ ★ = λ A : ★. λ n : Nat. IFixIndM · Nat · (VecF · A) (imapV · A) n. 10 | nilV ◂ ∀ A : ★. Vec · A zero 11 | = Λ A. iinIndM · Nat · (VecF · A) -(imapV · A) -zero 12 | (nilVF · A · (Vec · A)). 13 | consV ◂ ∀ A : ★. ∀ n : Nat. A ➔ Vec · A n ➔ Vec · A (suc n) 14 | = Λ A. Λ n. λ a. λ xs. iinIndM · Nat · (VecF · A) -(imapV · A) -(suc n) 15 | (consVF · A · (Vec · A) -n a xs). 16 | 17 | elimVec ◂ ∀ A : ★. ∀ P : Π n : Nat. Vec · A n ➔ ★. 18 | P zero (nilV · A) ➔ 19 | (∀ n : Nat. Π a : A. Π xs : Vec · A n. P n xs ➔ P (suc n) (consV · A -n a xs)) ➔ 20 | ∀ n : Nat. Π xs : Vec · A n. P n xs 21 | = Λ A. Λ P. λ pN. λ pC. iinductionM · Nat · (VecF · A) -(imapV · A) · P 22 | (Λ R. Λ c. λ ih. elimVecF · A · R 23 | · (λ n : Nat. λ s : VecF · A · R n. P n (iinIndM · Nat · (VecF · A) -(imapV · A) -n 24 | (elimId · (VecF · A · R n) · (VecF · A · (Vec · A) n) 25 | (imapV · A · R · (Vec · A) c -n) s) 26 | )) 27 | pN 28 | (Λ n . λ a. λ r. pC -n a (elimId~ · (R n) · (Vec · A n) -(c -n) r) (ih -n r)) 29 | ). 30 | foldVec ◂ ∀ A : ★. ∀ C : Nat ➔ ★. 31 | C zero ➔ 32 | (∀ n : Nat. A ➔ Vec · A n ➔ C n ➔ C (suc n)) ➔ 33 | ∀ n : Nat. Vec · A n ➔ C n 34 | = Λ A. Λ C. elimVec · A · (λ n : Nat. λ xs : Vec · A n. C n). 35 | 36 | v2lPres ◂ ∀ A : ★. ∀ n : Nat. Π xs : Vec · A n. {n ≃ len xs} 37 | = Λ A. elimVec · A · (λ n : Nat. λ xs : Vec · A n. {n ≃ len xs}) 38 | β 39 | (Λ n. λ x. λ xs. λ ih. ρ ih - β) 40 | . 41 | -------------------------------------------------------------------------------- /generic-reuse/Datatypes/VecF.ced: -------------------------------------------------------------------------------- 1 | module VecF. 2 | 3 | import Nat. 4 | import Sigma. 5 | import Id. 6 | import IFixIndM. 7 | 8 | data VecF (A : ★) (X : Nat ➔ ★) : Nat ➔ ★ = 9 | | nilVF : VecF zero 10 | | consVF : ∀ n : Nat. A ➔ X n ➔ VecF (suc n). 11 | 12 | elimVecF ◂ ∀ A : ★. ∀ X : Nat ➔ ★. ∀ P : Π n : Nat. VecF · A · X n ➔ ★. 13 | P zero (nilVF · A · X) ➔ 14 | (∀ n : Nat. Π a : A. Π x : X n. P (suc n) (consVF -n a x)) ➔ 15 | ∀ n : Nat. Π s : VecF · A · X n. P n s 16 | = Λ A. Λ X. Λ P. λ pN. λ pC. Λ n. λ s. 17 | μ' s @ P { nilVF ➔ pN | consVF -n a x ➔ pC -n a x }. 18 | foldVecF ◂ ∀ A : ★. ∀ X : Nat ➔ ★. ∀ C : Nat ➔ ★. 19 | C zero ➔ (∀ n : Nat. A ➔ X n ➔ C (suc n)) ➔ 20 | ∀ n : Nat. VecF · A · X n ➔ C n 21 | = Λ A. Λ X. Λ C. elimVecF · A · X · (λ n : Nat. λ s : VecF · A · X n. C n). 22 | 23 | imapV ◂ ∀ A : ★. IIdMapping · Nat · (VecF · A) 24 | = Λ A. Λ X. Λ Y. λ c. elimVecF · A · X 25 | · (λ n : Nat. λ s : VecF · A · X n. IdCod · (VecF · A · X n) · (VecF · A · Y n) s) 26 | (pairId -(nilVF · A · X) (nilVF · A · Y) β) 27 | (Λ m. λ a. λ x. pairId -(consVF -m a x) (consVF -m a (elimId (c -m) x)) β). 28 | -------------------------------------------------------------------------------- /generic-reuse/EverythingList.ced: -------------------------------------------------------------------------------- 1 | import Id. 2 | import Util. 3 | import FogFun. 4 | import EnrFun. 5 | import FogFix. 6 | import EnrFix. 7 | 8 | module EverythingList. 9 | 10 | import VecListReuse. 11 | import ListVecReuse. 12 | import AllListReuse. 13 | import AppendReuse. 14 | -------------------------------------------------------------------------------- /generic-reuse/EverythingTerm.ced: -------------------------------------------------------------------------------- 1 | import Id. 2 | import Util. 3 | import FogFun. 4 | import EnrFun. 5 | import FogFix. 6 | import EnrFix. 7 | 8 | module EverythingTerm. 9 | import Lookup. 10 | import Typed. 11 | import Taking. 12 | 13 | import TermRawReuse. 14 | import RawTermReuse 15 | · Lookup invZeroTail invZeroEq invSucHead invSucTail invSucEq invSucPred 16 | · Typed invVarLookup invLamCod invLamEq invLamBod invAppDom invAppFun invAppArg 17 | . 18 | import StepReuse as StepReuse 19 | · Typed t2r termTyped r2tP' 20 | . 21 | import SubReuse as SubReuse 22 | · Typed t2r termTyped r2tP' 23 | · Taking ts2rs envTaking 24 | . 25 | 26 | -------------------------------------------------------------------------------- /generic-reuse/Examples/AllListReuse.ced: -------------------------------------------------------------------------------- 1 | module AllListReuse. 2 | import Unit. 3 | import Sigma. 4 | import Eq. 5 | import Id. 6 | import FixIndM. 7 | import IFixIndM. 8 | import FogFix. 9 | import EnrFix. 10 | import Nat. 11 | import ListF. 12 | import List. 13 | import AllF. 14 | import All. 15 | 16 | af2lf ◂ ∀ A : ★. ∀ Q : A ➔ ★. ∀ B : ★. 17 | Π c1 : ∀ x : A. Id · (Q x) · B. 18 | ∀ X : List · A ➔ ★. ∀ Y : ★. 19 | Π c2 : ∀ xs : List · A. Id · (X xs) · Y. 20 | ∀ xs : List · A. Id · (AllF · A · Q · X xs) · (ListF · B · Y) 21 | = Λ A. Λ Q. Λ B. λ c1. Λ X. Λ Y. λ c2. elimAllF · A · Q · X 22 | · (λ xs : List · A. IdCod · (AllF · A · Q · X xs) · (ListF · B · Y)) 23 | (pairId · (AllF · A · Q · X (nilL · A)) · (ListF · B · Y) -(doneF · A · Q · X) (nilLF · B · Y) β) 24 | (Λ x. Λ xs. λ q. λ qs. pairId · (AllF · A · Q · X (consL · A x xs)) · (ListF · B · Y) 25 | -(nextF · A · Q · X -x -xs q qs) (consLF · B · Y (elimId · (Q x) · B (c1 -x) q) (elimId · (X xs) · Y (c2 -xs) qs)) β). 26 | 27 | a2l ◂ ∀ A : ★. ∀ Q : A ➔ ★. ∀ B : ★. Π c : ∀ x : A. Id · (Q x) · B. 28 | ∀ xs : List · A. Id · (All · A · Q xs) · (List · B) 29 | = Λ A. Λ Q. Λ B. λ c. Λ xs. ifix2fix · (List · A) · (AllF · A · Q) · (ListF · B) 30 | (imapA · A · Q) (imapL · B) (af2lf · A · Q · B c) -xs. 31 | a2l! ◂ ∀ A : ★. ∀ Q : A ➔ ★. ∀ B : ★. Π c : ∀ x : A. Id · (Q x) · B. 32 | ∀ xs : List · A. All · A · Q xs ➔ List · B 33 | = Λ A. Λ Q. Λ B. λ c. Λ xs. elimId · (All · A · Q xs) · (List · B) (a2l · A · Q · B c -xs). 34 | 35 | -------------------------------------------------------------------------------- /generic-reuse/Examples/ListVecReuse.ced: -------------------------------------------------------------------------------- 1 | module ListVecReuse. 2 | import Unit. 3 | import Sigma. 4 | import Id. 5 | import FixIndM. 6 | import IFixIndM. 7 | import FogFix. 8 | import EnrFix. 9 | import Nat. 10 | import ListF. 11 | import List. 12 | import VecF. 13 | import Vec. 14 | import Util. 15 | 16 | lf2vf ◂ ∀ A : ★. ∀ Y : ★. ∀ X : Nat ➔ ★. 17 | Π r : Y ➔ Nat. 18 | Π c : IdDep · Y · (λ y : Y . X (r y)). 19 | IdDep · (ListF · A · Y) · (λ xs : ListF · A · Y . VecF · A · X (lenAlgM · A · Y r xs)) 20 | = Λ A. Λ Y. Λ X. λ r. λ c. elimListF · A · Y 21 | · (IdDepCod · (ListF · A · Y) · (λ xs : ListF · A · Y . VecF · A · X (lenAlgM · A · Y r xs))) 22 | (pairId · (ListF · A · Y) · (VecF · A · X zero) -(nilLF · A · Y) (nilVF · A · X) β) 23 | (λ a. λ y. pairId · (ListF · A · Y) · (VecF · A · X (lenAlgM · A r (consLF · A · Y a y))) 24 | -(consLF · A · Y a y) (consVF · A · X -(r y) a (elimIdDep · Y · (λ y : Y . X (r y)) c y)) β). 25 | 26 | l2v ◂ ∀ A : ★. IdDep · (List · A) · (λ xs : List · A. Vec · A (len · A xs)) 27 | = Λ A. fix2ifix · (ListF · A) · Nat · (VecF · A) 28 | (imapL · A) (imapV · A) (lenAlgM · A) (lf2vf · A). 29 | l2v! ◂ ∀ A : ★. Π xs : List · A. Vec · A (len · A xs) 30 | = Λ A. elimIdDep · (List · A) · (λ xs : List · A. Vec · A (len · A xs)) (l2v · A). 31 | 32 | VecP ◂ Π A : ★. Nat ➔ List · A ➔ ★ = λ A : ★. λ n : Nat. λ xs : List · A. {len xs ≃ n} ➾ Vec · A n. 33 | l2vP ◂ ∀ A : ★. ∀ n : Nat. IdDep · (List · A) · (VecP · A n) 34 | = Λ A. Λ n. subst 35 | · (List · A) · Nat · (Vec · A) -(len · A) 36 | -n (l2v · A). 37 | l2vP! ◂ ∀ A : ★. ∀ n : Nat. Π xs : List · A. VecP · A n xs 38 | = Λ A. Λ n. elimIdDep · (List · A) · (VecP · A n) (l2vP · A -n). 39 | 40 | -------------------------------------------------------------------------------- /generic-reuse/Examples/StepReuse.ced: -------------------------------------------------------------------------------- 1 | import Id. 2 | import Ctx. 3 | import Tp. 4 | import Raw. 5 | import Term. 6 | import Util. 7 | import FogFun. 8 | import EnrFun. 9 | module StepReuse 10 | (Typed : CtxTp ➔ Raw ➔ ★) 11 | (t2r : ∀ GA : CtxTp. Id · (Term GA) · Raw) 12 | (termTyped : Π GA : CtxTp. Π t : Term GA. Typed GA (elimId · (Term GA) · Raw (t2r -GA) t)) 13 | (r2tP : ∀ GA : CtxTp. IdDep · Raw · (λ t : Raw. Typed GA t ➾ Term GA)) 14 | . 15 | 16 | StepR ◂ ★ = Raw ➔ Raw. 17 | TpPres ◂ StepR ➔ ★ = λ stepR : StepR. Π t : Raw. Π GA : CtxTp. Typed GA t ➔ Typed GA (stepR t). 18 | StepT ◂ ★ = ∀ GA : CtxTp. Term GA ➔ Term GA. 19 | 20 | stepR2stepT ◂ IdDep · StepR · (λ f : StepR. TpPres f ➾ StepT) 21 | = arr2allArrP2 22 | · Raw · Raw · CtxTp 23 | · Typed · Typed · Term · Term 24 | t2r termTyped 25 | r2tP. 26 | 27 | -------------------------------------------------------------------------------- /generic-reuse/Examples/VecListReuse.ced: -------------------------------------------------------------------------------- 1 | module VecListReuse. 2 | import Unit. 3 | import Sigma. 4 | import Id. 5 | import FixIndM. 6 | import IFixIndM. 7 | import FogFix. 8 | import EnrFix. 9 | import Nat. 10 | import ListF. 11 | import List. 12 | import VecF. 13 | import Vec. 14 | import Util. 15 | 16 | vf2lf ◂ ∀ A : ★. ∀ X : Nat ➔ ★. ∀ Y : ★. 17 | Π c : ∀ n : Nat. Id · (X n) · Y. 18 | ∀ n : Nat. Id · (VecF · A · X n) · (ListF · A · Y) 19 | = Λ A. Λ X. Λ Y. λ c. elimVecF · A · X 20 | · (λ n : Nat. IdCod · (VecF · A · X n) · (ListF · A · Y)) 21 | (pairId · (VecF · A · X zero) · (ListF · A · Y) -(nilVF · A · X) (nilLF · A · Y) β) 22 | (Λ m. λ a. λ x. pairId · (VecF · A · X (suc m)) · (ListF · A · Y) 23 | -(consVF · A · X -m a x) (consLF · A · Y a (elimId · (X m) · Y (c -m) x)) β). 24 | 25 | v2l ◂ ∀ A : ★. ∀ n : Nat. Id · (Vec · A n) · (List · A) 26 | = Λ A. Λ n. ifix2fix · Nat · (VecF · A) · (ListF · A) 27 | (imapV · A) (imapL · A) (vf2lf · A) -n. 28 | v2l! ◂ ∀ A : ★. ∀ n : Nat. Vec · A n ➔ List · A 29 | = Λ A. Λ n. elimId · (Vec · A n) · (List · A) (v2l · A -n). 30 | 31 | -------------------------------------------------------------------------------- /generic-reuse/GenericReuse/FogFix.ced: -------------------------------------------------------------------------------- 1 | module FogFix. 2 | import Id. 3 | import IFixIndM. 4 | import Sigma. 5 | import FixIndM. 6 | 7 | ifix2fix ◂ ∀ I : ★. ∀ F : (I ➔ ★) ➔ (I ➔ ★). ∀ G : ★ ➔ ★. 8 | Π imapF : IIdMapping · I · F. 9 | Π imapG : IdMapping · G. 10 | Π c : ∀ X : I ➔ ★. ∀ Y : ★. (∀ i : I . Id · (X i) · Y) ➔ ∀ i : I. Id · (F · X i) · (G · Y). 11 | ∀ i : I. Id · (IFixIndM · I · F imapF i) · (FixIndM · G imapG) 12 | = Λ I. Λ F. Λ G. λ imapF. λ imapG. λ c1. iinductionM · I · F -imapF 13 | · (λ i : I. IdCod · (IFixIndM · I · F imapF i) · (FixIndM · G imapG)) 14 | (Λ R. Λ c2. λ ih. Λ i. λ rs. pairId 15 | · (IFixIndM · I · F imapF i) · (FixIndM · G imapG) 16 | -(iinIndM · I · F -imapF -i 17 | (elimId · (F · R i) · (F · (IFixIndM · I · F imapF) i) (imapF · R · (IFixIndM · I · F imapF) c2 -i) rs)) 18 | (inIndM · G -imapG 19 | (elimId · (F · R i) · (G · (FixIndM · G imapG)) 20 | (c1 · R · (FixIndM · G imapG) ih -i) rs) 21 | ) β). 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /generic-reuse/GenericReuse/FogFun.ced: -------------------------------------------------------------------------------- 1 | module FogFun. 2 | import Unit. 3 | import Id. 4 | import Util. 5 | 6 | allPi2pi ◂ ∀ I : ★. ∀ X : I ➔ ★. ∀ X' : Π i : I. X i ➔ ★. ∀ Y : ★. ∀ Y' : Y ➔ ★. 7 | Π r : Y ➔ I. 8 | Π c1 : IdDep · Y · (λ y : Y. X (r y)). 9 | Π c2 : Π y : Y. Id · (X' (r y) (elimIdDep · Y · (λ y : Y. X (r y)) c1 y)) · (Y' y). 10 | Id · (∀ i : I. Π x : X i. X' i x) · (Π y : Y. Y' y) 11 | = Λ I. Λ X. Λ X'. Λ Y. Λ Y'. λ r. λ c1. λ c2. λ f. pairId 12 | · (∀ i : I. Π x : X i. X' i x) · (Π y : Y. Y' y) -f 13 | (λ y. elimId · (X' (r y) (elimIdDep · Y · (λ y : Y. X (r y)) c1 y)) · (Y' y) 14 | (c2 y) 15 | (f -(r y) (elimIdDep · Y · (λ y : Y. X (r y)) c1 y)) 16 | ) β. 17 | 18 | allArr2arr ◂ ∀ I : ★. ∀ X : I ➔ ★. ∀ X' : I ➔ ★. ∀ Y : ★. ∀ Y' : ★. 19 | Π r : Y ➔ I. 20 | Π c1 : IdDep · Y · (λ y : Y. X (r y)). 21 | Π c2 : Π y : Y. Id · (X' (r y)) · Y'. 22 | Id · (∀ i : I. X i ➔ X' i) · (Y ➔ Y') 23 | = Λ I. Λ X. Λ X'. Λ Y. Λ Y'. 24 | allPi2pi · I · X · (λ i : I. λ x : X i. X' i) · Y · (λ y : Y. Y'). 25 | 26 | -------------------------------------------------------------------------------- /generic-reuse/IndexedMendlerInduction/AlgM.ced: -------------------------------------------------------------------------------- 1 | import Id. 2 | module AlgM (F : ★ ➔ ★). 3 | 4 | AlgM ◂ ★ ➔ ★ = λ A : ★. 5 | ∀ R : ★. (R ➔ A) ➔ F · R ➔ A. 6 | 7 | -------------------------------------------------------------------------------- /generic-reuse/IndexedMendlerInduction/FixIndM.ced: -------------------------------------------------------------------------------- 1 | import Id. 2 | module FixIndM (F : ★ ➔ ★) {imap : IdMapping · F}. 3 | import Unit. 4 | import UnitLift. 5 | import Sigma. 6 | import AlgM · F. 7 | import IFixM · Unit · (UnitF · F). 8 | import IFixIndM · Unit · (UnitF · F) -(uimap imap). 9 | 10 | PrfAlgM ◂ Π X : ★. (X ➔ ★) ➔ (F · X ➔ X) ➔ ★ 11 | = λ X : ★. λ P : X ➔ ★. λ alg : F · X ➔ X. 12 | ∀ R : ★. ∀ c : Id · R · X. 13 | Π ih : Π r : R. P (elimId c r). 14 | Π rs : F · R. P (alg (elimId (imap c) rs)). 15 | 16 | FixIndM ◂ ★ = IFixIndM unit. 17 | 18 | inIndM ◂ F · FixIndM ➔ FixIndM = iinIndM -unit. 19 | 20 | ualg ◂ ∀ A : ★. AlgM · A ➔ IAlgM · (λ u : Unit. A) 21 | = Λ A. λ alg. Λ R. λ r. Λ i. λ un. alg (r -unit) un. 22 | 23 | foldIndM ◂ ∀ C : ★. AlgM · C ➔ FixIndM ➔ C 24 | = Λ C. λ alg. λ x. ifoldIndM · (λ u : Unit. C) (ualg alg) -unit x. 25 | 26 | inductionM ◂ ∀ P : FixIndM ➔ ★. PrfAlgM · FixIndM · P inIndM ➔ Π x : FixIndM. P x 27 | = Λ P. λ alg. λ x. iinductionM 28 | · (λ u : Unit. λ ix : IFixIndM u. P (ρ ς (etaUnit u) - ix)) 29 | (Λ R. Λ ic. λ ih. Λ i. λ gr. alg · (R unit) -(ic -unit) (λ r. ih -unit r) gr) 30 | -unit x. 31 | 32 | -------------------------------------------------------------------------------- /generic-reuse/IndexedMendlerInduction/IFixIndM.ced: -------------------------------------------------------------------------------- 1 | import Id. 2 | module IFixIndM (I : ★) (F : (I ➔ ★) ➔ I ➔ ★) {imap : IIdMapping · I · F}. 3 | import Sigma. 4 | import IIdPlus · I. 5 | import IFixM · I · F. 6 | 7 | IPrfAlgM ◂ Π X : I ➔ ★. Π P : Π i : I. X i ➔ ★. Π alg : ∀ i : I. F · X i ➔ X i. ★ 8 | = λ X : I ➔ ★. λ P : Π i : I. X i ➔ ★. λ alg : ∀ i : I. F · X i ➔ X i. 9 | ∀ R : I ➔ ★. ∀ c : ∀ i : I. Id · (R i) · (X i). 10 | Π ih : ∀ i : I. Π r : R i. P i (elimId (c -i) r). 11 | ∀ i : I. Π rs : F · R i. P i (alg -i (elimId (imap c -i) rs)). 12 | 13 | IInductiveM ◂ Π i : I. IFixM i ➔ ★ = λ i : I. λ x : IFixM i. 14 | ∀ P : Π i : I. IFixM i ➔ ★. 15 | IPrfAlgM · IFixM · P iinM ➔ P i x. 16 | 17 | IFixIndM ◂ I ➔ ★ = λ i : I. ι x : IFixM i. IInductiveM i x. 18 | 19 | iidDown ◂ ∀ i : I. Id · (IFixIndM i) · (IFixM i) 20 | = Λ i. λ x. pair x.1 β. 21 | 22 | iinIndM1 ◂ ∀ i : I. F · IFixIndM i ➔ IFixM i 23 | = Λ i. λ xs. iinM -i (elimId~ -(imap iidDown -i) xs). 24 | iinIndM2 ◂ ∀ i : I. Π xs : F · IFixIndM i. IInductiveM i (iinIndM1 -i xs) 25 | = Λ i. λ xs. Λ P. λ c. c -iidDown (Λ i. λ x. x.2 c) -i xs. 26 | 27 | iinIndM ◂ ∀ i : I. F · IFixIndM i ➔ IFixIndM i 28 | = Λ i. λ xs. [ iinIndM1 -i xs, iinIndM2 -i xs ]. 29 | 30 | ilowerPrfAlg ◂ ∀ P : Π i : I. IFixIndM i ➔ ★. 31 | IPrfAlgM · IFixIndM · P iinIndM ➔ 32 | IPrfAlgM · IFixM · (IIdPlusCod · IFixM · IFixIndM · P) iinM 33 | = Λ P. λ alg. Λ R. Λ c. λ ih. Λ i. λ rs. 34 | pair (iinIndM -i (elimId~ -(imap (elimIIdPlusId -c ih) -i) rs)) 35 | (pair β (alg -(elimIIdPlusId -c ih) (elimIIdPlusIH -c ih) -i rs)). 36 | 37 | iinductionM ◂ ∀ P : Π i : I. IFixIndM i ➔ ★. 38 | IPrfAlgM · IFixIndM · P iinIndM ➔ 39 | ∀ i : I. Π x : IFixIndM i. P i x 40 | = Λ P. λ alg. Λ i. λ x. 41 | proj2 (proj2 (x.2 (ilowerPrfAlg alg))). 42 | 43 | ifoldIndM ◂ ∀ C : I ➔ ★. IAlgM · C ➔ ∀ i : I. IFixIndM i ➔ C i 44 | = Λ C. λ alg. Λ i. λ x. 45 | ifoldM alg -i x.1. 46 | -------------------------------------------------------------------------------- /generic-reuse/IndexedMendlerInduction/IFixM.ced: -------------------------------------------------------------------------------- 1 | module IFixM (I : ★) (F : (I ➔ ★) ➔ I ➔ ★). 2 | 3 | IAlgM ◂ (I ➔ ★) ➔ ★ = λ A : I ➔ ★ . 4 | ∀ R : I ➔ ★ . 5 | (∀ i : I . R i ➔ A i) ➔ 6 | ∀ i : I . F · R i ➔ A i. 7 | 8 | IFixM ◂ I ➔ ★ = λ i : I. 9 | ∀ X : (I ➔ ★). IAlgM · X ➔ X i. 10 | 11 | ifoldM ◂ ∀ A : I ➔ ★. IAlgM · A ➔ ∀ i : I. IFixM i ➔ A i 12 | = Λ A. λ alg. Λ i. λ x. x alg. 13 | 14 | iinM ◂ ∀ i : I. F · IFixM i ➔ IFixM i 15 | = Λ i. λ xs. Λ X. λ alg. alg (ifoldM alg) -i xs. 16 | -------------------------------------------------------------------------------- /generic-reuse/IndexedMendlerInduction/IIdPlus.ced: -------------------------------------------------------------------------------- 1 | module IIdPlus (I : ★). 2 | import Sigma. 3 | import Id. 4 | 5 | IIdPlusCod ◂ Π A : I ➔ ★. Π B : I ➔ ★. Π P : Π i : I. B i ➔ ★. Π i : I. A i ➔ ★ 6 | = λ A : I ➔ ★. λ B : I ➔ ★. λ P : Π i : I. B i ➔ ★. λ i : I. λ a : A i. 7 | Sigma · (B i) · (λ b : (B i). 8 | Sigma · { b ≃ a } · (λ q : { b ≃ a }. 9 | P i (φ q - b {a}) 10 | )). 11 | 12 | IIdPlus ◂ Π R : I ➔ ★. Π A : I ➔ ★. Π B : I ➔ ★. Π P : Π i : I. B i ➔ ★. 13 | Π c : ∀ i : I. Id · (R i) · (A i). ★ 14 | = λ R : I ➔ ★. λ A : I ➔ ★. λ B : I ➔ ★. 15 | λ P : Π i : I. B i ➔ ★. λ c : ∀ i : I. Id · (R i) · (A i). 16 | ∀ i : I. Π r : R i. IIdPlusCod · A · B · P i (elimId (c -i) r). 17 | 18 | elimIIdPlusId ◂ ∀ R : I ➔ ★. ∀ A : I ➔ ★. ∀ B : I ➔ ★. ∀ P : Π i : I. B i ➔ ★. 19 | ∀ c : ∀ i : I. Id · (R i) · (A i). 20 | IIdPlus · R · A · B · P c ➔ ∀ i : I. Id · (R i) · (B i) 21 | = Λ R. Λ A. Λ B. Λ P. Λ c. λ ih. Λ i. λ r. 22 | [ b = proj1 (ih -i r) ] - [ q = proj1 (proj2 (ih -i r)) ] - pair b q. 23 | 24 | elimIIdPlus ◂ ∀ R : I ➔ ★. ∀ A : I ➔ ★. ∀ B : I ➔ ★. ∀ P : Π i : I. B i ➔ ★. 25 | ∀ c : ∀ i : I. Id · (R i) · (A i). 26 | IIdPlus · R · A · B · P c ➾ ∀ i : I. R i ➔ B i 27 | = Λ R. Λ A. Λ B. Λ P. Λ c. Λ ih. Λ i. elimId~ -(elimIIdPlusId -c ih -i). 28 | 29 | elimIIdPlusIH ◂ ∀ R : I ➔ ★. ∀ A : I ➔ ★. ∀ B : I ➔ ★. ∀ P : Π i : I. B i ➔ ★. 30 | ∀ c : ∀ i : I. Id · (R i) · (A i). 31 | Π ih : IIdPlus · R · A · B · P c. 32 | ∀ i : I. Π r : R i. P i (elimIIdPlus -c -ih -i r) 33 | = Λ R. Λ A. Λ B. Λ P. Λ c. λ ih. Λ i. λ r. proj2 (proj2 (ih -i r)). 34 | -------------------------------------------------------------------------------- /generic-reuse/IndexedMendlerInduction/UnitLift.ced: -------------------------------------------------------------------------------- 1 | module UnitLift. 2 | 3 | import Unit. 4 | import Sigma. 5 | import Id. 6 | 7 | UnitF ◂ (★ ➔ ★) ➔ (Unit ➔ ★) ➔ (Unit ➔ ★) = λ F : ★ ➔ ★. λ X : Unit ➔ ★. λ u : Unit. F · (X unit). 8 | 9 | uimap ◂ ∀ F : ★ ➔ ★. IdMapping · F ➔ IIdMapping · Unit · (UnitF · F) = Λ F. λ im. Λ X. Λ Y. λ p. Λ i. λ a. im · (X unit) · (Y unit) (λ a. p -unit a ) a. 10 | -------------------------------------------------------------------------------- /idem-quotients/bool.ced: -------------------------------------------------------------------------------- 1 | module bool. 2 | 3 | data Bool : ★ = 4 | | tt : Bool 5 | | ff : Bool. 6 | 7 | true : Bool = tt. 8 | false : Bool = ff. 9 | 10 | not : Bool ➔ Bool 11 | = λ a. μ' a { 12 | | tt ➔ ff 13 | | ff ➔ tt 14 | }. 15 | 16 | and : Bool ➔ Bool ➔ Bool 17 | = λ a. λ b. μ' a { 18 | | tt ➔ μ' b { 19 | | tt ➔ tt 20 | | ff ➔ ff 21 | } 22 | | ff ➔ ff 23 | }. 24 | 25 | or : Bool ➔ Bool ➔ Bool 26 | = λ a. λ b. μ' a { 27 | | tt ➔ tt 28 | | ff ➔ μ' b { 29 | | tt ➔ tt 30 | | ff ➔ ff 31 | } 32 | }. 33 | 34 | if : ∀ A: ★. Bool ➔ A ➔ A ➔ A 35 | = Λ A. λ if. λ then. λ else. μ' if { 36 | | tt ➔ then 37 | | ff ➔ else 38 | }. 39 | -------------------------------------------------------------------------------- /idem-quotients/or.ced: -------------------------------------------------------------------------------- 1 | module or. 2 | 3 | data Or (A: ★) (B: ★) : ★ = 4 | | injl : A ➔ Or 5 | | injr : B ➔ Or. 6 | -------------------------------------------------------------------------------- /idem-quotients/pair.ced: -------------------------------------------------------------------------------- 1 | module pair. 2 | 3 | data Pair (A: ★) (B: ★) : ★ = 4 | | pair : A ➔ B ➔ Pair. 5 | 6 | fst : ∀ A: ★. ∀ B: ★. Pair·A·B ➔ A 7 | = Λ A. Λ B. λ p. μ' p { 8 | | pair a b ➔ a 9 | }. 10 | 11 | snd : ∀ A: ★. ∀ B: ★. Pair·A·B ➔ B 12 | = Λ A. Λ B. λ p. μ' p { 13 | | pair a b ➔ b 14 | }. 15 | 16 | data Sigma (A: ★) (B: A ➔ ★) : ★ = 17 | | sigma : Π a: A. B a ➔ Sigma. 18 | 19 | proj1 : ∀ A: ★. ∀ B: A ➔ ★. Sigma·A·B ➔ A 20 | = Λ A. Λ B. λ p. μ' p { 21 | | sigma a b ➔ a 22 | }. 23 | 24 | proj2 : ∀ A: ★. ∀ B: A ➔ ★. Π s: Sigma·A·B. B (proj1 s) 25 | = Λ A. Λ B. λ p. μ' p @ (λ s: Sigma·A·B. B (proj1 s)) { 26 | | sigma a b ➔ b 27 | }. 28 | -------------------------------------------------------------------------------- /idem-quotients/quotient-comb.ced: -------------------------------------------------------------------------------- 1 | import quotient-defs. 2 | import pair. 3 | import or. 4 | 5 | module quotient-comb (A: ★) (B: ★) (fa: IdemFn·A) (fb: IdemFn·B). 6 | QA : ★ = Quotient·A fa. 7 | QB : ★ = Quotient·B fb. 8 | 9 | idemfn-pair : IdemFn·(Pair·A·B) 10 | = [f: Pair·A·B ➔ Pair·A·B = λ p. μ' p { 11 | pair a b ➔ pair (fa.1 a) (fb.1 b) 12 | }] 13 | - [f, λ p. μ' p 14 | @ (λ x: Pair·A·B. {f (f x) ≃ f x}) { 15 | | pair a b ➔ 16 | ρ+ (fa.2 a) 17 | - ρ (fb.2 b) 18 | - β{pair (fa a) (fb b)} 19 | }]. 20 | 21 | quotient-pair : QA ➔ QB ➔ Quotient·(Pair·A·B) idemfn-pair 22 | = λ a. λ b. [pair a.1 b.1, ρ+ a.2 - ρ b.2 - β{pair a b}]. 23 | 24 | idemfn-or : IdemFn·(Or·A·B) 25 | = [f: Or·A·B ➔ Or·A·B = λ p. μ' p { 26 | | injl a ➔ injl (fa.1 a) 27 | | injr b ➔ injr (fb.1 b) 28 | }] 29 | - [f, λ p. μ' p 30 | @ (λ x: Or·A·B. {f (f x) ≃ f x}) { 31 | | injl a ➔ ρ+ (fa.2 a) - β{injl (fa a)} 32 | | injr b ➔ ρ+ (fb.2 b) - β{injr (fb b)} 33 | }]. 34 | 35 | quotient-or-left : QA ➔ Quotient·(Or·A·B) idemfn-or 36 | = λ a. [injl a.1, ρ+ a.2 - β{injl a}]. 37 | 38 | quotient-or-right : QB ➔ Quotient·(Or·A·B) idemfn-or 39 | = λ b. [injr b.1, ρ+ b.2 - β{injr b}]. 40 | 41 | Compatible : (A ➔ A) ➔ ★ = λ f: A ➔ A. ∀ a: A. {f (fa a) ≃ fa (f a)}. 42 | 43 | idemfn-nest : Π f: IdemFn·A. Compatible f.1 ➾ IdemFn·A 44 | = λ f. Λ c. [λ a. f.1 (fa.1 a), 45 | λ a. ρ+ (c -a) 46 | - ρ (fa.2 (f.1 a)) 47 | - ρ ς (c -a) 48 | - ρ (f.2 (fa.1 a)) 49 | - β{f (fa a)}]. 50 | 51 | quotient-nest : Π f: IdemFn·A. ∀ c: Compatible f.1. Quotient·A fa 52 | ➔ Quotient·A (idemfn-nest f -c) 53 | = λ f. Λ c. λ q. [f.1 q.1, 54 | ρ+ (c -(f.1 q.1)) 55 | - ρ (f.2 q.1) 56 | - ρ ς (c -q.1) 57 | - ρ q.2 58 | - β{f q}]. 59 | -------------------------------------------------------------------------------- /idem-quotients/quotient-defs.ced: -------------------------------------------------------------------------------- 1 | module quotient-defs. 2 | 3 | IdemFn : ★ ➔ ★ 4 | = λ A: ★. ι f: A ➔ A. Π a: A. {f (f a) ≃ f a}. 5 | 6 | Quotient : Π A: ★. IdemFn·A ➔ ★ 7 | = λ A: ★. λ f: IdemFn·A. ι a: A. {f a ≃ a}. 8 | 9 | qcoerce : ∀ A: ★. ∀ f: IdemFn·A. Quotient·A f ➔ A 10 | = Λ A. Λ f. λ q. q.1. 11 | 12 | qcoerceId : {qcoerce ≃ λ q. q} = β. 13 | 14 | qcanon : ∀ A: ★. Π f: IdemFn·A. A ➔ Quotient·A f 15 | = Λ A. λ f. λ a. [x = f.1 a] - [x, ρ (f.2 a) - β{x}]. 16 | -------------------------------------------------------------------------------- /idem-quotients/uip.ced: -------------------------------------------------------------------------------- 1 | import quotient-defs. 2 | 3 | module uip. 4 | 5 | eqRep : ∀ A: ★. Π a: A. Π b: A. {a ≃ b} ➔ {a ≃ b} 6 | = Λ A. λ a. λ b. λ eq. ρ eq - β. 7 | 8 | eqRepIdemFn : ∀ A: ★. Π a: A. Π b: A. IdemFn·{a ≃ b} 9 | = Λ A. λ a. λ b. [ eqRep a b , λ eq. β ]. 10 | 11 | Id : Π A: ★. A ➔ A ➔ ★ 12 | = λ A: ★. λ a: A. λ b: A. Quotient·{a ≃ b} (eqRepIdemFn a b). 13 | 14 | UIP : ∀ A: ★. Π a: A. Π b: A. Π p: Id·A a b. Π q: Id·A a b. Id·(Id·A a b) p q 15 | = Λ A. λ a. λ b. λ p. λ q. [ρ ς p.2 - ρ ς q.2 - β, β]. 16 | -------------------------------------------------------------------------------- /impred-ind/Church/ConvC.ced: -------------------------------------------------------------------------------- 1 | import ../Utilities/Functor. 2 | 3 | import ../Mendler/FixM. 4 | import ../Mendler/FixIndM. 5 | import FixC. 6 | import FixIndC. 7 | 8 | module ConvC. 9 | 10 | -- AlgC to AlgM 11 | ca2ma ◂ ∀ F : ★ ➔ ★. Π fmap : Fmap · F. ∀ X : ★. 12 | AlgC · F · X ➔ AlgM · F · X 13 | = Λ F. λ fmap. Λ X. λ alg. Λ R . λ f. λ fr. 14 | alg (fmap · R · X f fr). 15 | 16 | 17 | -- FixIndC to FixIndM 18 | ch2men ◂ ∀ F : ★ ➔ ★ . Π fmap : Fmap · F. Π flaw1 : Flaw1 · F fmap. 19 | (FixIndC · F fmap) ➔ (FixIndM · F fmap) 20 | = Λ F. λ fmap. λ flaw1. 21 | foldIndC · F fmap · (FixIndM · F fmap) (inFixIndM' · F fmap flaw1). 22 | 23 | -------------------------------------------------------------------------------- /impred-ind/Church/FixC.ced: -------------------------------------------------------------------------------- 1 | import ../Utilities/Functor. 2 | import ../Utilities/Unary. 3 | 4 | module FixC. 5 | 6 | -- Standard definition of Church-style algebra 7 | AlgC ◂ (★ ➔ ★) ➔ ★ ➔ ★ = 8 | λ F : ★ ➔ ★. λ X : ★. F · X ➔ X. 9 | 10 | 11 | -- Church-style algebra adjusted for the alignment with proof algebra 12 | AlgC' ◂ (★ ➔ ★) ➔ ★ ➔ ★ = 13 | λ F : ★ ➔ ★. λ X : ★. F · (Unary · X) ➔ X. 14 | 15 | 16 | -- least fixed point of F 17 | FixC ◂ (★ ➔ ★) ➔ ★ = λ F : ★ ➔ ★. 18 | ∀ X : ★. AlgC' · F · X ➔ X. 19 | 20 | 21 | -- weak initiality of FixC 22 | foldC' ◂ ∀ F : ★ ➔ ★. ∀ X : ★. AlgC' · F · X 23 | ➔ FixC · F ➔ X 24 | = Λ F. Λ X. λ alg. λ fix. fix · X alg. 25 | 26 | 27 | inC' ◂ ∀ F : ★ ➔ ★. Fmap · F ➔ AlgC' · F · (FixC · F) 28 | = Λ F. λ fmap. λ fix. Λ X. λ alg. 29 | alg (ufmap · F fmap · (FixC · F) · X (foldC' · F · X alg) fix). 30 | 31 | 32 | -- foldC' is a homomorphism 33 | HomC ◂ ∀ F : ★ ➔ ★. Π fmap : Fmap · F. ∀ X' : ★. 34 | Π f' : AlgC' · F · X'. Π v : F · (Unary · (FixC · F)). 35 | {f' (ufmap fmap (foldC' f') v) ≃ foldC' f' (inC' fmap v)} 36 | = Λ F. λ fmap. Λ X. λ f'. λ v. β. 37 | 38 | 39 | -- homomorphism for standard Church-style algebras AlgC 40 | foldC ◂ ∀ F : ★ ➔ ★. Fmap · F ➔ ∀ X : ★. AlgC · F · X 41 | ➔ FixC · F ➔ X 42 | = Λ F. λ fmap. Λ X. λ alg. λ fix. 43 | fix · X (λ z. alg (fmap · (Unary · X) · X (uproj · X) z)). 44 | 45 | -------------------------------------------------------------------------------- /impred-ind/Church/examples/NatC.ced: -------------------------------------------------------------------------------- 1 | import ../../Utilities/Sigma. 2 | import ../../Utilities/Unit. 3 | import ../../Utilities/Sum. 4 | 5 | import ../FixIndC. 6 | import ../InductionC. 7 | 8 | import NatF. 9 | 10 | module NatC. 11 | 12 | -- defining NatC as a Church-style least fixed point of signature 13 | -- functor NatF 14 | NatC ◂ ★ = FixIndC · NatF NatFmap. 15 | 16 | 17 | -- generically derived induction principle for NatC 18 | inductionGenNatC ◂ ∀ Q : NatC ➔ ★. 19 | (Π gr : NatF · (Sigma · NatC · Q). 20 | Q (inFixIndC · NatF NatFmap NatFlaw2 NatFlaw1 (NatFmap · (Sigma · NatC · Q) · NatC 21 | (proj1 · NatC · Q) gr)) ) ➔ 22 | Π e : NatC. Q e 23 | = inductionC · NatF NatFmap NatFlaw1 NatFlaw2 NatFeq. 24 | 25 | 26 | -- NatC constructors 27 | zeroC ◂ NatC 28 | = inFixIndC · NatF NatFmap NatFlaw2 NatFlaw1 (in1 · Unit · NatC unit). 29 | 30 | succC ◂ NatC ➔ NatC 31 | = λ n. inFixIndC · NatF NatFmap NatFlaw2 NatFlaw1 (in2 · Unit · NatC n). 32 | 33 | 34 | -- "flat" version of induction rule for NatC stated in terms of 35 | -- constructors zero and suc: 36 | inductionNat ◂ ∀ Q : NatC ➔ ★. 37 | Q zeroC ➔ (Π n : NatC. Q n ➔ Q (succC n)) ➔ 38 | Π x : NatC. Q x 39 | = Λ Q. λ qz. λ qs. inductionGenNatC · Q 40 | (λ ih. ind-Sum · Unit · (Sigma · NatC · Q) ih 41 | · (λ gr : NatF · (Sigma · NatC · Q). 42 | Q (inFixIndC · NatF NatFmap NatFlaw2 NatFlaw1 43 | (NatFmap · (Sigma · NatC · Q) · NatC 44 | (proj1 · NatC · Q) gr))) 45 | (λ unit' . ρ (eta-Unit unit') - qz) 46 | (λ b . qs (proj1 · NatC · Q b) (proj2 · NatC · Q b))). 47 | -------------------------------------------------------------------------------- /impred-ind/Church/examples/NatF.ced: -------------------------------------------------------------------------------- 1 | import ../../Utilities/Functor. 2 | import ../../Utilities/Sum. 3 | import ../../Utilities/Unit. 4 | 5 | module NatF. 6 | 7 | -- Signature functor for natural numbers + laws 8 | NatF ◂ ★ ➔ ★ = λ X : ★. Sum · Unit · X. 9 | 10 | NatFmap ◂ Fmap · NatF = 11 | Λ X. Λ Y. λ f. λ u. 12 | case · Unit · X · (NatF · Y) u 13 | (in1 · Unit · Y) 14 | (λ x. in2 · Unit · Y (f x)). 15 | 16 | NatFlaw1 ◂ Flaw1 · NatF NatFmap = 17 | Λ X. Λ f. λ u. Λ p. 18 | θ (ind-Sum · Unit · X u) (λ a. β) (λ b. ρ+ (p b) - β). 19 | 20 | NatFlaw2 ◂ Flaw2 · NatF NatFmap = 21 | Λ X. Λ f. Λ g. λ u. θ (ind-Sum · Unit · X u) (λ a. β) (λ b. β). 22 | 23 | NatFeq ◂ Feq · NatF NatFmap = 24 | Λ X. Λ f. Λ g. λ eq. λ x. θ (ind-Sum · Unit · X x) (λ a. β) (λ b. ρ+ (eq b) - β). 25 | 26 | -------------------------------------------------------------------------------- /impred-ind/Mendler/FixM.ced: -------------------------------------------------------------------------------- 1 | import ../Utilities/Functor. 2 | 3 | module FixM. 4 | 5 | -- Mendler-style algebra 6 | AlgM ◂ (★ ➔ ★) ➔ ★ ➔ ★ = λ F : ★ ➔ ★. λ A : ★. 7 | ∀ R : ★. (R ➔ A) ➔ F · R ➔ A. 8 | 9 | 10 | -- naturality for algebras 11 | Natural ◂ Π F : ★ ➔ ★. Fmap · F ➔ Π A : ★. AlgM · F · A ➔ ★ 12 | = λ F : ★ ➔ ★. λ fmap : Fmap · F. λ A : ★. λ alg : AlgM · F · A. 13 | ∀ R : ★. ∀ cast : R ➔ A. ∀ fr : F · R. 14 | {alg cast fr ≃ alg (λ x. x) (fmap cast fr)}. 15 | 16 | 17 | -- Mendler-style fixed point 18 | FixM ◂ (★ ➔ ★) ➔ ★ = λ F : ★ ➔ ★. 19 | ∀ A : ★. (∀ R : ★. (R ➔ A) ➔ F · R ➔ A) ➔ A. 20 | 21 | 22 | -- Weak initiality of FixM 23 | foldM ◂ ∀ F : ★ ➔ ★. ∀ A : ★. AlgM · F · A ➔ FixM · F ➔ A 24 | = Λ F. Λ A. λ alg. λ fix. fix · A alg. 25 | 26 | 27 | inM ◂ ∀ F : ★ ➔ ★. Fmap · F ➔ AlgM · F · (FixM · F) 28 | = Λ F. λ fmap. Λ R. λ c. λ v. Λ A. λ alg. 29 | alg · (FixM · F) (foldM · F · A alg) (fmap · R · (FixM · F) c v). 30 | 31 | 32 | -- does not require fmap! 33 | inM' ◂ ∀ F : ★ ➔ ★. F · (FixM · F) ➔ FixM · F 34 | = Λ F. λ fexp. Λ A. λ alg. 35 | alg · (FixM · F) (foldM · F · A alg) fexp. 36 | 37 | 38 | -- inverse of inM 39 | outM ◂ ∀ F : ★ ➔ ★. Fmap · F ➔ FixM · F ➔ F · (FixM · F) 40 | = Λ F. λ fmap. λ fix. foldM · F · (F · (FixM · F)) 41 | (Λ R. λ ih. λ fr. fmap · R · (FixM · F) (λ r. inM' · F (ih r)) fr) 42 | fix. 43 | 44 | 45 | -------------------------------------------------------------------------------- /impred-ind/Mendler/PrfAlgEqM.ced: -------------------------------------------------------------------------------- 1 | import ../Utilities/Functor. 2 | import ../Utilities/Sigma. 3 | import ../Utilities/Product. 4 | import ../Utilities/Top. 5 | 6 | import FixM. 7 | import FixIndM. 8 | import ../Utilities/PredicateLifting. 9 | 10 | module PrfAlgEqM. 11 | 12 | -- "strong" proof algebras PrfAlgM for predicate (WWId X Q) are 13 | -- logically equivalent to "weak" proof algebras PrfAlgM' 14 | str2alg' ◂ ∀ X : ★. ∀ F : ★ ➔ ★. Π fmap : Fmap · F. 15 | Π Flaw1 : Flaw1 · F fmap. 16 | Π fmapEq : Feq · F fmap. 17 | Π alg : AlgM · F · X. 18 | Natural · F fmap · X alg ➔ 19 | ∀ Q : X ➔ ★. 20 | PrfAlgM · F fmap · X · (WWId · X · Q) alg ➔ 21 | PrfAlgM' · F fmap · X · (WWId · X · Q) alg 22 | = Λ X. Λ F. λ fmap. λ flaw1. λ fmapEq. λ alg. λ wf. 23 | Λ Q. λ spa. Λ R. Λ c. Λ eq. λ ih. λ gr. 24 | (ρ (wf · R -c -gr) - 25 | ρ (fmapEq · R -β{c} -β{λ r. wsPrj1' · X · Q -(c r) (ih r)} 26 | (λ x. ρ (wsPrj1'lem · X · Q -(c x) (ih x)) - β) gr) - 27 | ρ ς (wf · R -(λ r. wsPrj1' · X · Q -(c r) (ih r)) -gr) - 28 | (spa · R (λ r. wsPrj1' · X · Q -(c r) (ih r)) 29 | -(Λ r. ρ (wsPrj1'lem · X · Q -(c r) (ih r)) - 30 | ρ (eq -r) - β) (λ r. ρ (wsPrj1'lem · X · Q -(c r) (ih r)) - (ih r)) gr)). 31 | 32 | 33 | str2str ◂ ∀ X : ★. ∀ F : ★ ➔ ★. Π fmap : Fmap · F. 34 | Π Flaw1 : Flaw1 · F fmap. 35 | Π alg : AlgM · F · X. 36 | Natural · F fmap · X alg ➔ 37 | ∀ Q : X ➔ ★. 38 | PrfAlgM · F fmap · X · Q alg ➔ 39 | PrfAlgM · F fmap · X · (WWId · X · Q) alg 40 | = Λ X. Λ F. λ fmap. λ law1. λ alg. λ wf. Λ Q. λ str. 41 | (Λ R. λ c. Λ e. λ ih. λ gr. zz · X · Q (alg · R c gr) 42 | (str · R c -e (λ r. zzob · X · Q (c r) (ih r)) gr)). 43 | -------------------------------------------------------------------------------- /impred-ind/Mendler/examples/ListF.ced: -------------------------------------------------------------------------------- 1 | import ../../Utilities/Product. 2 | import ../../Utilities/Sum. 3 | import ../../Utilities/Unit. 4 | import ../../Utilities/Functor. 5 | 6 | module ListF. 7 | 8 | -- signature functor for polymorphic lists + laws 9 | ListF ◂ ★ ➔ ★ ➔ ★ = λ A : ★. λ X : ★. Sum · Unit · (Product · A · X). 10 | 11 | ListFmap ◂ ∀ A : ★. ∀ X : ★. ∀ Y : ★. (X ➔ Y) ➔ ListF · A · X ➔ ListF · A · Y 12 | = Λ A. Λ X. Λ Y. λ f. λ lf. case · Unit · (Product · A · X) · (ListF · A · Y) lf 13 | (in1 · Unit · (Product · A · Y)) 14 | (λ pr. in2 · Unit · (Product · A · Y) (pair · A · Y (pproj1 · A · X pr) (f (pproj2 · A · X pr)))). 15 | 16 | ListFlaw1 ◂ ∀ A : ★. Flaw1 · (ListF · A) (ListFmap · A) 17 | = Λ A. Λ X. Λ f. λ u. Λ p. 18 | θ (ind-Sum · Unit · (Product · A · X) u) (λ a. β) 19 | (λ z. θ (ind-Product · A · X z) (λ a. λ b. ρ+ (p b) - β)). 20 | 21 | ListFlaw2 ◂ ∀ A : ★. Flaw2 · (ListF · A) (ListFmap · A) 22 | = Λ A. Λ X. Λ f. Λ g. λ u. 23 | θ (ind-Sum · Unit · (Product · A · X) u) (λ a. β) (λ b. β). 24 | 25 | ListFeq ◂ ∀ A : ★. Feq · (ListF · A) (ListFmap · A) 26 | = Λ A. Λ X. Λ f. Λ g. λ eq. λ x. 27 | θ (ind-Sum · Unit · (Product · A · X) x) (λ a. β) (λ b. ρ+ (eq (pproj2 · A · X b)) - β). 28 | -------------------------------------------------------------------------------- /impred-ind/Mendler/examples/ListM.ced: -------------------------------------------------------------------------------- 1 | import ../../Utilities/Product. 2 | import ../../Utilities/Sum. 3 | import ../../Utilities/Unit. 4 | 5 | import ../FixIndM. 6 | import ../InductionM. 7 | 8 | import ListF. 9 | 10 | module ListM. 11 | 12 | -- ListM datatype as a Mendler-style fixed point of signature functor ListF 13 | ListM ◂ ★ ➔ ★ = λ A : ★. FixIndM · (ListF · A) (ListFmap · A). 14 | 15 | 16 | -- generically derived induction principle for ListM 17 | inductionListGen ◂ ∀ A : ★. ∀ Q : ListM · A ➔ ★. 18 | PrfAlgM · (ListF · A) (ListFmap · A) · (ListM · A) · Q 19 | (inFixIndM · (ListF · A) (ListFmap · A) (ListFlaw1 · A)) ➔ 20 | Π e : ListM · A. Q e = Λ A. 21 | inductionM · (ListF · A) (ListFmap · A) (ListFlaw1 · A) (ListFeq · A). 22 | 23 | 24 | -- ListM constructors 25 | nil ◂ ∀ A : ★. ListM · A 26 | = Λ A. inFixIndM' · (ListF · A) (ListFmap · A) (ListFlaw1 · A) 27 | (in1 · Unit · (Product · A · (ListM · A)) unit). 28 | 29 | 30 | cons ◂ ∀ A : ★. A ➔ ListM · A ➔ ListM · A 31 | = Λ A. λ x. λ xs. 32 | inFixIndM' · (ListF · A) (ListFmap · A) (ListFlaw1 · A) 33 | (in2 · Unit · (Product · A · (ListM · A)) 34 | (pair · A · (ListM · A) x xs)). 35 | 36 | 37 | -- "flat" version of induction principle stated in terms of defined 38 | -- constructors 39 | inductionListM ◂ ∀ A : ★. ∀ Q : ListM · A ➔ ★. 40 | Q (nil · A) ➔ 41 | (Π x : A. Π xs : ListM · A. Q xs ➔ Q (cons · A x xs)) ➔ 42 | Π xs : ListM · A. Q xs 43 | = Λ A. Λ Q. λ qnil. λ qcons. 44 | (inductionListGen · A · Q (Λ R. λ cast. Λ eq. λ ih. λ fr. 45 | θ (ind-Sum · Unit · (Product · A · R) fr) 46 | (λ unit'. ρ (eta-Unit unit') - qnil) 47 | (λ z. (qcons (pproj1 · A · R z) (cast (pproj2 · A · R z)) 48 | (ih (pproj2 · A · R z)))))). 49 | 50 | -------------------------------------------------------------------------------- /impred-ind/Utilities/Functor.ced: -------------------------------------------------------------------------------- 1 | import Top. 2 | 3 | module Functor. 4 | 5 | Functor ◂ (★ ➔ ★) ➔ ★ = 6 | λ F : ★ ➔ ★. ∀ X : ★. ∀ Y : ★. (X ➔ Y) ➔ (F · X ➔ F · Y). 7 | 8 | Fmap ◂ (★ ➔ ★) ➔ ★ = 9 | λ F : ★ ➔ ★. ∀ X : ★. ∀ Y : ★. (X ➔ Y) ➔ (F · X ➔ F · Y). 10 | 11 | Flaw1 ◂ Π F : ★ ➔ ★. Functor · F ➔ ★ 12 | = λ F : ★ ➔ ★. λ fmap : Functor · F. 13 | ∀ X : ★. ∀ f : Top. Π x : F · X. 14 | ∀ _ : (Π z : X. {f z ≃ z}). {fmap f x ≃ x}. 15 | 16 | Flaw2 ◂ Π F : ★ ➔ ★. Functor · F ➔ ★ 17 | = λ F : ★ ➔ ★. λ fmap : Functor · F. 18 | ∀ X : ★. ∀ f : Top. ∀ g : Top. Π x : F · X. 19 | {fmap f (fmap g x) ≃ fmap (λ x. f (g x)) x}. 20 | 21 | FunExtEq ◂ ★ ➔ Top ➔ Top ➔ ★ 22 | = λ X : ★. λ f : Top. λ f' : Top. Π x : X. {f x ≃ f' x}. 23 | 24 | Feq ◂ Π F : ★ ➔ ★. Functor · F ➔ ★ 25 | = λ F : ★ ➔ ★ . λ fmap : Functor · F. ∀ X : ★. ∀ f : Top. ∀ f' : Top. 26 | FunExtEq · X f f' ➔ Π x : F · X. {fmap f x ≃ fmap f' x}. 27 | -------------------------------------------------------------------------------- /impred-ind/Utilities/Product.ced: -------------------------------------------------------------------------------- 1 | 2 | module Product. 3 | 4 | cProduct ◂ ★ ➔ ★ ➔ ★ 5 | = λ A : ★. λ B : ★. ∀ X : ★. (A ➔ B ➔ X) ➔ X. 6 | 7 | cpair ◂ ∀ A : ★. ∀ B : ★. A ➔ B ➔ cProduct · A · B 8 | = Λ A. Λ B. λ a. λ b. Λ X. λ ca. ca a b. 9 | 10 | param-Product ◂ Π A : ★. Π B : ★. cProduct · A · B ➔ ★ 11 | = λ A : ★. λ B : ★. λ x : cProduct · A · B. 12 | ∀ X : ★. ∀ P : X ➔ ★. ∀ pr : A ➔ B ➔ X. 13 | (Π a : A. Π b : B. P (pr a b)) ➔ P (x · X pr). 14 | 15 | Product ◂ ★ ➔ ★ ➔ ★ 16 | = λ A : ★. λ B : ★. 17 | ι x : cProduct · A · B. 18 | ι _ : {x cpair ≃ x}. param-Product · A · B x. 19 | 20 | pair ◂ ∀ A : ★. ∀ B : ★. A ➔ B ➔ Product · A · B 21 | = Λ A. Λ B. λ a. λ b. 22 | [ cpair · A · B a b 23 | , [β{cpair a b} , Λ X. Λ P. Λ pr. λ p. p a b ]]. 24 | 25 | ind-Product ◂ ∀ A : ★. ∀ B : ★. Π x : Product · A · B. 26 | ∀ P : Product · A · B ➔ ★. 27 | (Π a : A. Π b : B. P (pair · A · B a b)) ➔ P x 28 | = Λ A. Λ B. λ x. Λ P. λ p. 29 | ρ ς x.2.1 - (x.2.2 · (Product · A · B) · P -(pair · A · B) p). 30 | 31 | pproj1 ◂ ∀ A : ★. ∀ B : ★. Product · A · B ➔ A 32 | = Λ A. Λ B. λ s. s.1 · A (λ a. λ _. a). 33 | 34 | pproj2 ◂ ∀ A : ★. ∀ B : ★. Product · A · B ➔ B 35 | = Λ A. Λ B. λ s. s.1 · B (λ _. λ b. b). 36 | -------------------------------------------------------------------------------- /impred-ind/Utilities/Sigma.ced: -------------------------------------------------------------------------------- 1 | 2 | module Sigma. 3 | 4 | cSigma ◂ Π A : ★. (A ➔ ★) ➔ ★ 5 | = λ A : ★. λ B : A ➔ ★. 6 | ∀ X : ★. (Π a : A. B a ➔ X) ➔ X. 7 | 8 | mkcsigma ◂ ∀ X : ★. ∀ Y : X ➔ ★. 9 | Π x : X. Y x ➔ cSigma · X · Y 10 | = Λ X. Λ Y. λ x. λ y. Λ Z. λ c. c x y. 11 | 12 | param-Sigma ◂ Π A : ★. Π P : A ➔ ★. cSigma · A · P ➔ ★ 13 | = λ A : ★. λ P : A ➔ ★. λ x : cSigma · A · P. 14 | ∀ X : ★. ∀ Q : X ➔ ★. ∀ pr : Π a : A. P a ➔ X. 15 | (Π a : A. Π b : P a. Q (pr a b)) ➔ Q (x · X pr). 16 | 17 | Sigma ◂ Π A : ★. (A ➔ ★) ➔ ★ 18 | = λ A : ★. λ PA : A ➔ ★. 19 | ι d : cSigma · A · PA. 20 | ι _ : {d mkcsigma ≃ d}. param-Sigma · A · PA d. 21 | 22 | mkdsigma ◂ ∀ X : ★. ∀ Y : X ➔ ★. Π x : X. Y x ➔ Sigma · X · Y 23 | = Λ X. Λ Y. λ x. λ y. 24 | [ mkcsigma · X · Y x y 25 | , [ β{mkcsigma x y} , Λ X'. Λ Q. Λ pr. λ e. e x y ] ]. 26 | 27 | ind-sigma ◂ ∀ A : ★. ∀ B : A ➔ ★. Π x : Sigma · A · B. 28 | ∀ P : Sigma · A · B ➔ ★. 29 | (Π a : A. Π b : B a. P (mkdsigma · A · B a b)) ➔ P x 30 | = Λ A. Λ B. λ x. Λ P. λ p. 31 | ρ ς x.2.1 - (x.2.2 · (Sigma · A · B) · P -(mkdsigma · A · B) p). 32 | 33 | proj1 ◂ ∀ A : ★. ∀ B : A ➔ ★. Sigma · A · B ➔ A 34 | = Λ A. Λ B. λ s. s.1 · A (λ a. λ _. a). 35 | 36 | proj2 ◂ ∀ A : ★. ∀ B : A ➔ ★. 37 | Π s : Sigma · A · B. B (proj1 · A · B s) 38 | = Λ A. Λ B. λ s. θ (ind-sigma · A · B s) (λ a. λ b. b). 39 | -------------------------------------------------------------------------------- /impred-ind/Utilities/Sum.ced: -------------------------------------------------------------------------------- 1 | 2 | module Sum. 3 | 4 | cSum ◂ ★ ➔ ★ ➔ ★ 5 | = λ A : ★. λ B : ★. 6 | ∀ X : ★. (A ➔ X) ➔ (B ➔ X) ➔ X. 7 | 8 | cin1 ◂ ∀ A : ★. ∀ B : ★. A ➔ cSum · A · B 9 | = Λ A. Λ B. λ a. Λ X. λ ca. λ cb. ca a. 10 | 11 | cin2 ◂ ∀ A : ★. ∀ B : ★. B ➔ cSum · A · B 12 | = Λ A. Λ B. λ b. Λ X. λ ca. λ cb. cb b. 13 | 14 | param-Sum ◂ Π A : ★. Π B : ★. cSum · A · B ➔ ★ 15 | = λ A : ★. λ B : ★. λ x : cSum · A · B. 16 | ∀ X : ★. ∀ P : X ➔ ★. ∀ ca : A ➔ X. ∀ cb : B ➔ X. 17 | (Π a : A. P (ca a)) ➔ (Π b : B. P (cb b)) ➔ P (x · X ca cb). 18 | 19 | Sum ◂ ★ ➔ ★ ➔ ★ 20 | = λ A : ★. λ B : ★. 21 | ι x : cSum · A · B. ι _ : {x cin1 cin2 ≃ x}. param-Sum · A · B x. 22 | 23 | in1 ◂ ∀ A : ★. ∀ B : ★. A ➔ Sum · A · B 24 | = Λ A. Λ B. λ a. 25 | [ cin1 · A · B a 26 | , [β{cin1 a} , Λ X. Λ P. Λ ca. Λ cb. λ pa. λ pb. pa a ]]. 27 | 28 | in2 ◂ ∀ A : ★. ∀ B : ★. B ➔ Sum · A · B 29 | = Λ A. Λ B. λ b. 30 | [ cin2 · A · B b 31 | , [β{cin2 b} , Λ X. Λ P. Λ ca. Λ cb. λ pa. λ pb. pb b ]]. 32 | 33 | ind-Sum ◂ ∀ A : ★. ∀ B : ★. Π x : Sum · A · B. 34 | ∀ P : Sum · A · B ➔ ★. 35 | (Π a : A. P (in1 · A · B a)) ➔ (Π b : B. P (in2 · A · B b)) ➔ 36 | P x 37 | = Λ A. Λ B. λ x. Λ P. λ pa. λ pb. 38 | ρ ς x.2.1 - 39 | (x.2.2 · (Sum · A · B) · P -(in1 · A · B) -(in2 · A · B) pa pb). 40 | 41 | case ◂ ∀ A : ★. ∀ B : ★. ∀ C : ★. Sum · A · B ➔ (A ➔ C) ➔ (B ➔ C) ➔ C 42 | = Λ A. Λ B. Λ C. λ s. λ f. λ g. s.1 · C f g. 43 | -------------------------------------------------------------------------------- /impred-ind/Utilities/Top.ced: -------------------------------------------------------------------------------- 1 | 2 | module Top. 3 | 4 | Top ◂ ★ = {λ x. x ≃ λ x. x}. 5 | 6 | top ◂ Top = β{λ x. x}. 7 | -------------------------------------------------------------------------------- /impred-ind/Utilities/Unary.ced: -------------------------------------------------------------------------------- 1 | import Functor. 2 | 3 | module Unary. 4 | 5 | cUnary ◂ ★ ➔ ★ 6 | = λ A : ★. ∀ X : ★. (A ➔ X) ➔ X. 7 | 8 | cunary ◂ ∀ A : ★. A ➔ cUnary · A 9 | = Λ A. λ a. Λ X. λ ca. ca a. 10 | 11 | param-Unary ◂ Π A : ★. cUnary · A ➔ ★ 12 | = λ A : ★. λ x : cUnary · A. 13 | ∀ X : ★. ∀ P : X ➔ ★. ∀ pr : A ➔ X. 14 | (Π a : A. P (pr a)) ➔ P (x · X pr). 15 | 16 | Unary ◂ ★ ➔ ★ 17 | = λ A : ★. 18 | ι x : cUnary · A. 19 | ι _ : {x cunary ≃ x}. param-Unary · A x. 20 | 21 | unary ◂ ∀ A : ★. A ➔ Unary · A 22 | = Λ A. λ a. 23 | [ cunary · A a 24 | , [β{cunary a} , Λ X. Λ P. Λ pr. λ p. p a ]]. 25 | 26 | ind-Unary ◂ ∀ A : ★. Π x : Unary · A. 27 | ∀ P : Unary · A ➔ ★. 28 | (Π a : A. P (unary · A a)) ➔ 29 | P x 30 | = Λ A. λ x. Λ P. λ p. 31 | ρ ς x.2.1 - (x.2.2 · (Unary · A) · P -(unary · A) p). 32 | 33 | uproj ◂ ∀ A : ★. Unary · A ➔ A 34 | = Λ A. λ s. s.1 · A (λ a. a). 35 | 36 | umap ◂ ∀ A : ★. ∀ B : ★. (A ➔ B) ➔ (Unary · A) ➔ (Unary · B) 37 | = Λ A. Λ B. λ f. λ ua. unary · B (f (uproj · A ua)). 38 | 39 | UnF ◂ (★ ➔ ★) ➔ ★ ➔ ★ 40 | = λ F : ★ ➔ ★. λ X : ★. F · (Unary · X). 41 | 42 | ufmap ◂ ∀ F : ★ ➔ ★. Fmap · F ➔ Fmap · (UnF · F) 43 | = Λ F. λ fmap. Λ X. Λ Y. λ f. λ fx. 44 | fmap · (Unary · X) · (Unary · Y) 45 | (λ ux. unary · Y (f (uproj · X ux))) fx. 46 | 47 | qqq' ◂ ∀ X : ★. ∀ F : ★ ➔ ★. Π fmap : Functor · F. Flaw1 · F fmap ➔ 48 | Π v : F · (Unary · X). {(ufmap · F fmap (λ x. x) v) ≃ v} 49 | = Λ X. Λ F. λ fmap. λ law1. λ v. ρ (law1 · (Unary · X) 50 | -β{(λ ux. (unary ((λ x. x) (uproj ux))))} v 51 | -(λ z. θ (ind-Unary · X z) (λ a. β) )) - β. 52 | -------------------------------------------------------------------------------- /impred-ind/Utilities/Unit.ced: -------------------------------------------------------------------------------- 1 | 2 | module Unit. 3 | 4 | cUnit ◂ ★ = ∀ X : ★. X ➔ X. 5 | 6 | cunit ◂ cUnit = Λ X. λ x. x. 7 | 8 | param-Unit ◂ cUnit ➔ ★ 9 | = λ x : cUnit. ∀ X : ★. 10 | ∀ P : X ➔ ★. ∀ cu : X. P cu ➔ P (x · X cu). 11 | 12 | Unit ◂ ★ = ι x : cUnit. ι _ : {x cunit ≃ x}. param-Unit x. 13 | 14 | unit ◂ Unit = [ cunit , [β{cunit} , Λ X. Λ P. Λ cu. λ u. u ]]. 15 | 16 | ind-Unit ◂ Π x : Unit. ∀ P : Unit ➔ ★. P unit ➔ P x = 17 | λ x. Λ P. λ u. ρ ς x.2.1 - (x.2.2 · Unit · P -unit u). 18 | 19 | eta-Unit ◂ Π x : Unit. {x ≃ unit} 20 | = λ x. ind-Unit x · (λ x : Unit. {x ≃ unit}) β. 21 | 22 | -------------------------------------------------------------------------------- /impred-ind/Utilities/Utils.ced: -------------------------------------------------------------------------------- 1 | import Top. 2 | import Sigma. 3 | import Functor. 4 | 5 | module Utils. 6 | 7 | rew ◂ ∀ x : Top. ∀ y : Top. ∀ z : Top. {x ≃ y} ➔ {y ≃ z} ➔ {x ≃ z} 8 | = Λ x. Λ y. Λ z. λ p1. λ p2. ρ p1 - p2. 9 | 10 | mapdep ◂ ∀ F : ★ ➔ ★. Fmap · F ➔ 11 | ∀ X : ★. ∀ Y : X ➔ ★. Π f : Π x : X. Y x. 12 | F · X ➔ F · (Sigma · X · Y) = Λ F. λ fmap. Λ X. Λ Y. λ f. 13 | λ fx. fmap · X · (Sigma · X · Y) (λ x. mkdsigma · X · Y x (f x)) fx. 14 | 15 | mapdeplem ◂ ∀ F : ★ ➔ ★. Π fmap : Fmap · F. 16 | Π law2 : Flaw2 · F fmap. 17 | Π law1 : Flaw1 · F fmap. 18 | ∀ X : ★. ∀ Y : X ➔ ★. Π f : Π x : X. Y x. 19 | Π fx : F · X. {fmap proj1 (mapdep fmap f fx) ≃ fx} 20 | = Λ F. λ fmap. λ law2. λ law1. Λ X. Λ Y. λ f. λ fx. 21 | ρ (law2 · X -β{proj1} -β{(λ x. mkdsigma · X · Y x (f x))} fx) - 22 | ρ (law1 · X -β{λ x. x} fx -(λ z. β)) - β. 23 | -------------------------------------------------------------------------------- /impred-ind/Utilities/WithWitness.ced: -------------------------------------------------------------------------------- 1 | import Sigma. 2 | import SigmaImplicit. 3 | import Product. 4 | import Unary. 5 | import Top. 6 | 7 | module WithWitness. 8 | 9 | WithWitness ◂ Π X : ★. Π Y : ★. 10 | (X ➔ ★) ➔ (X ➔ Y) ➔ Y ➔ ★ 11 | = λ X : ★. λ Y : ★. λ Q : X ➔ ★. 12 | λ cast : X ➔ Y. λ y : Y. 13 | Sigma · X · (λ x : X. Product · {y ≃ cast x} · (Q x)). 14 | 15 | 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /induction-induction/encoding/alg.ced: -------------------------------------------------------------------------------- 1 | 2 | module alg (I:★) (F:(I ➔ ★) ➔ I ➔ ★). 3 | 4 | AlgM : (I ➔ ★) ➔ ★ = λ X:I ➔ ★. 5 | ∀ R:I ➔ ★. (∀ i:I. R i ➔ X i) ➔ ∀ i:I. F·R i ➔ X i. 6 | 7 | FixM : I ➔ ★ = λ i:I. ∀ X:I ➔ ★. AlgM·X ➔ X i. 8 | 9 | foldM : ∀ X:I ➔ ★. AlgM·X ➔ ∀ i:I. FixM i ➔ X i 10 | = Λ X. λ alg. Λ i. λ d. d alg. 11 | 12 | inM : ∀ i:I. F·FixM i ➔ FixM i 13 | = Λ i. λ xs. Λ X. λ alg. alg ·FixM (Λ i. foldM·X alg -i) -i xs. 14 | -------------------------------------------------------------------------------- /induction-induction/encoding/prfalg.ced: -------------------------------------------------------------------------------- 1 | 2 | import ../lib/cast. 3 | import ../lib/idata. 4 | 5 | module prfalg (I:★) (F:(I ➔ ★) ➔ I ➔ ★) {mono: Monotonic·I·F}. 6 | 7 | import alg·I·F. 8 | 9 | PrfAlgM : Π X:I ➔ ★. (Π i:I. X i ➔ ★) ➔ (Π i:I. F·X i ➔ X i) ➔ ★ 10 | = λ X:I ➔ ★. λ P:Π i:I. X i ➔ ★. λ in:Π i:I. F·X i ➔ X i. 11 | ∀ R:I ➔ ★. ∀ c:∀ i:I. Cast·(R i)·(X i). Π ih:(∀ i:I. Π r:R i. P i (cast -(c -i) r)). 12 | ∀ i:I. Π rs:F·R i. P i (in i (cast -(mono -c -i) rs)). 13 | 14 | InductiveM : Π i:I. FixM i ➔ ★ = λ i:I. λ x:FixM i. 15 | ∀ P:Π i:I. FixM i ➔ ★. PrfAlgM·FixM·P (λ i. inM -i) ➔ P i x. 16 | 17 | IndM : I ➔ ★ = λ i:I. 18 | ι x:FixM i. InductiveM i x. 19 | 20 | toFixM : ∀ i:I. Cast·(IndM i)·(FixM i) 21 | = Λ i. intrCast -(λ x. x.1) -(λ _. β). 22 | 23 | inIndM1 : ∀ i:I. F·IndM i ➔ FixM i 24 | = Λ i. λ xs. inM -i (cast -(mono·IndM·FixM -toFixM -i) xs). 25 | 26 | _ : {inIndM1 ≃ inM} = β. 27 | 28 | inIndM2 : ∀ i:I. Π xs:F·IndM i. InductiveM i (inIndM1 -i xs) 29 | = Λ i. λ xs. Λ P. λ alg. alg·IndM -toFixM (Λ i. λ d. d.2 alg) -i xs. 30 | 31 | _ : {inIndM2 ≃ inM} = β. 32 | 33 | inIndM : ∀ i:I. F·IndM i ➔ IndM i 34 | = Λ i. λ xs. [inIndM1 -i xs, inIndM2 -i xs]. 35 | -------------------------------------------------------------------------------- /induction-induction/indind2/mono.ced: -------------------------------------------------------------------------------- 1 | 2 | import ../lib/cast. 3 | 4 | module mono 5 | (F: Π X:★. (X ➔ ★) ➔ ★) 6 | (G: Π X:★. Π Y:X ➔ ★. Π alg:F·X·Y ➔ X. X ➔ ★) 7 | . 8 | 9 | MonoF : ★ = ∀ A:★. ∀ B:★. ∀ U:A ➔ ★. ∀ V:B ➔ ★. 10 | ∀ c:Cast·A·B. (∀ a:A. Cast·(U a)·(V (cast -c a))) ➾ 11 | Cast·(F·A·U)·(F·B·V). 12 | 13 | MonoG : ★ = ∀ A:★. ∀ B:★. ∀ U:A ➔ ★. ∀ V:B ➔ ★. 14 | ∀ algA:F·A·U ➔ A. ∀ algB:F·B·V ➔ B. {algA ≃ algB} ➾ 15 | ∀ c:Cast·A·B. (∀ a:A. Cast·(U a)·(V (cast -c a))) ➾ 16 | ∀ a:A. Cast·(G·A·U algA a)·(G·B·V algB (cast -c a)). 17 | -------------------------------------------------------------------------------- /induction-induction/indind2/shape.ced: -------------------------------------------------------------------------------- 1 | 2 | import ../lib/bot. 3 | import ../lib/cast. 4 | import ../lib/tpeq. 5 | import ../lib/idata. 6 | import ../lib/tuple n2. 7 | import ../encoding/prfalg. 8 | import ../encoding/ind. 9 | import mono. 10 | 11 | module shape 12 | (F: Π X:★. (X ➔ ★) ➔ ★) 13 | (G: Π X:★. Π Y:(X ➔ ★). Π alg:F·X·Y ➔ X. X ➔ ★) 14 | {mF:MonoF·F·G} 15 | {mG:MonoG·F·G} 16 | . 17 | 18 | tzβ = TupleZero. 19 | tsβ = TupleSucc. 20 | 21 | f0 : Fin n2 22 | = [zero, le_zero -n1]. 23 | f1 : Fin n2 24 | = [n1, le_succ -n0 -n1 (le_zero -n0)]. 25 | 26 | data ShapeF (R:Fin n2 ➔ ★) : Fin n2 ➔ ★ = 27 | | ShapeF_Fin : F·(R f0)·(λ _:R f0. R f1) ➔ ShapeF f0 28 | | ShapeF_Gin : 29 | ∀ H:(Fin n2 ➔ ★) ➔ Fin n2 ➔ ★. 30 | ∀ mH: Monotonic·(Fin n2)·H. 31 | [Hi : Fin n2 ➔ ★ = λ i:Fin n2. IndM·(Fin n2)·H mH i] - 32 | [Hin = inIndM·(Fin n2)·H -mH -f0] - 33 | ∀ inj: F·(Hi f0)·(λ _:Hi f0. Hi f1) ➔ (H·Hi f0). 34 | ∀ r:Hi f0. 35 | G·(Hi f0)·(λ _:Hi f0. Hi f1) 36 | (λ x. Hin (inj x)) 37 | r 38 | ➔ ShapeF f1 39 | . 40 | 41 | mShape : Monotonic·(Fin n2)·ShapeF 42 | = Λ A. Λ B. Λ c. Λ i. intrCast 43 | -(λ x. μ' x { 44 | | ShapeF_Fin xs ➔ ShapeF_Fin (cast 45 | -(mF 46 | ·(A f0) 47 | ·(B f0) 48 | ·(λ _:A f0. A f1) 49 | ·(λ _:B f0. B f1) 50 | -(c -f0) 51 | -(Λ _. c -f1)) 52 | xs) 53 | | ShapeF_Gin ·H -mH -inj -j xs ➔ 54 | [Hi : Fin n2 ➔ ★ = λ i:Fin n2. IndM·(Fin n2)·H mH i] - 55 | [Hin = inIndM·(Fin n2)·H -mH -f0] - 56 | ShapeF_Gin -mH -inj -j xs 57 | }) 58 | -(λ x. μ' x { 59 | | ShapeF_Fin _ ➔ β 60 | | ShapeF_Gin ·_ -_ -_ -_ _ ➔ β 61 | }). 62 | 63 | import ../encoding/prfalg as SA·(Fin n2)·ShapeF -mShape. 64 | 65 | Shape : Fin n2 ➔ ★ = λ n:Fin n2. SA.IndM n. 66 | inShape = SA.inIndM. 67 | 68 | -------------------------------------------------------------------------------- /induction-induction/lib/bot.ced: -------------------------------------------------------------------------------- 1 | import top. 2 | 3 | module bot. 4 | 5 | False : ★ = ∀ X:★. X. 6 | 7 | Not : ★ ➔ ★ = λ A:★. A ➾ False. 8 | 9 | pe : ∀ X:★. False ➾ Top ➔ X 10 | = Λ X. Λ f. λ t. φ (f·{f ≃ t}) - (f·X) {t}. 11 | -------------------------------------------------------------------------------- /induction-induction/lib/cast.ced: -------------------------------------------------------------------------------- 1 | module cast. 2 | 3 | Cast : ★ ➔ ★ ➔ ★ = λ A:★. λ B:★. ι f:A ➔ B. {f ≃ λ x. x}. 4 | 5 | intrCast : ∀ A:★. ∀ B:★. ∀ f: A ➔ B. (Π a: A. {f a ≃ a}) ➾ Cast·A·B 6 | = Λ A. Λ B. Λ f. Λ eq. [ λ a. φ (eq a) - (f a) {a} , β]. 7 | 8 | cast : ∀ A:★. ∀ B:★. Cast·A·B ➾ A ➔ B 9 | = Λ A. Λ B. Λ c. φ c.2 - c.1 {λ x. x}. 10 | 11 | Monotonic : Π I:★. ((I ➔ ★) ➔ I ➔ ★) ➔ ★ = λ I:★. λ F:(I ➔ ★) ➔ I ➔ ★. 12 | ∀ A:I ➔ ★. ∀ B:I ➔ ★. (∀ i:I. Cast·(A i)·(B i)) ➾ 13 | ∀ i:I. Cast·(F·A i)·(F·B i). 14 | -------------------------------------------------------------------------------- /induction-induction/lib/top.ced: -------------------------------------------------------------------------------- 1 | module top. 2 | 3 | Top : ★ = {β ≃ β}. 4 | -------------------------------------------------------------------------------- /induction-induction/lib/tpeq.ced: -------------------------------------------------------------------------------- 1 | import cast. 2 | 3 | module tpeq. 4 | 5 | TpEq : ★ ➔ ★ ➔ ★ = λ A:★. λ B:★. ι _:Cast·A·B. Cast·B·A. 6 | 7 | tpEqRefl : ∀ A:★. TpEq·A·A 8 | = Λ A. [[λ x. x, β], [λ x. x, β]]. 9 | 10 | tpEqSym : ∀ A:★. ∀ B:★. TpEq·A·B ➾ TpEq·B·A 11 | = Λ A. Λ B. Λ eq. [[λ x. cast -eq.2 x, β], [λ x. cast -eq.1 x, β]]. 12 | 13 | tpEqTrans : ∀ A:★. ∀ B:★. ∀ C:★. TpEq·A·B ➾ TpEq·B·C ➾ TpEq·A·C 14 | = Λ A. Λ B. Λ C. Λ e1. Λ e2. 15 | [[λ x. cast -e2.1 (cast -e1.1 x), β], 16 | [λ x. cast -e1.2 (cast -e2.2 x), β]]. 17 | 18 | intrTpEq : ∀ A:★. ∀ B:★. Cast·A·B ➾ Cast·B·A ➾ TpEq·A·B 19 | = Λ A. Λ B. Λ c1. Λ c2. [[λ x. cast -c1 x, β], [λ x. cast -c2 x, β]]. 20 | -------------------------------------------------------------------------------- /large-elim-sim/.cedille/options: -------------------------------------------------------------------------------- 1 | -- list of directories (separated by spaces) to import files, besides current one 2 | import-directories 3 | = "." . 4 | 5 | -- write Cedille spans to ./.cedille/file.cede 6 | use-cede-files 7 | = false. 8 | 9 | -- compile Cedille source to Racket 10 | -- currently not supported 11 | make-rkt-files 12 | = false. 13 | 14 | generate-logs 15 | = false. 16 | 17 | -- show fully-qualified variables (for debugging) 18 | show-qualified-vars 19 | = false. 20 | 21 | -- Erase erasable expressions from terms occurring in types (for debugging) 22 | erase-types = true. 23 | 24 | -------------------------------------------------------------------------------- /large-elim-sim/core.ced: -------------------------------------------------------------------------------- 1 | module stdcore. 2 | 3 | import public lib/core/bot. 4 | import public lib/core/cast. 5 | import public lib/core/castDep. 6 | import public lib/core/irrel . 7 | import public lib/core/rec. 8 | import public lib/core/top. 9 | import public lib/core/tpeq. 10 | import public lib/core/view. 11 | -------------------------------------------------------------------------------- /large-elim-sim/large-elim/concrete/universe/descr.ced: -------------------------------------------------------------------------------- 1 | module large-elim/concrete/universe/descr (C: ★) (I : C ➔ ★) . 2 | 3 | import lib . 4 | 5 | data Descr : ★ 6 | = idD : Descr 7 | | constD : Descr 8 | | pairD : Descr ➔ Descr ➔ Descr 9 | | sumD : Π c: C. (I c ➔ Descr) ➔ Descr 10 | | sigD : Π n: Nat. (Fin n ➔ Descr) ➔ Descr 11 | . 12 | 13 | pairDInj 14 | : ∀ d11: Descr. ∀ d12: Descr. ∀ d21: Descr. ∀ d22: Descr. 15 | { pairD d11 d12 ≃ pairD d21 d22 } ➾ Pair ·{ d11 ≃ d21 } ·{ d12 ≃ d22 } 16 | = Λ d11. Λ d12. Λ d21. Λ d22. Λ eq. 17 | [unpairD : Top 18 | = β{ λ x. μ' x { idD ➔ β | constD ➔ β | pairD d1 d2 ➔ sigma d1 d2 | sumD _ _ ➔ β | sigD _ _ ➔ β}}] 19 | - sigma 20 | ( ρ eq @ x.{ fst (unpairD x) ≃ fst (unpairD (pairD d21 d22))} 21 | - β) 22 | ( ρ eq @ x.{ snd (unpairD x) ≃ snd (unpairD (pairD d21 d22))} 23 | - β) 24 | . 25 | 26 | sumDInj 27 | : ∀ c1: C. ∀ f1: I c1 ➔ Descr. ∀ c2: C. ∀ f2: I c2 ➔ Descr. 28 | { sumD c1 f1 ≃ sumD c2 f2 } ➾ Pair ·{ c1 ≃ c2 } ·{ f1 ≃ f2 } 29 | = Λ c1. Λ f1. Λ c2. Λ f2. Λ eq. 30 | [unsumD : Top 31 | = β{ λ x. μ' x { idD ➔ β | constD ➔ β | pairD _ _ ➔ β | sumD c f ➔ sigma c f | sigD _ _ ➔ β}}] 32 | - sigma 33 | ( ρ eq @ x.{ fst (unsumD x) ≃ fst (unsumD (sumD c2 f2))} 34 | - β) 35 | ( ρ eq @ x.{ snd (unsumD x) ≃ snd (unsumD (sumD c2 f2))} 36 | - β) 37 | . 38 | 39 | sigDInj 40 | : ∀ n1: Nat. ∀ f1: Fin n1 ➔ Descr. ∀ n2: Nat. ∀ f2: Fin n2 ➔ Descr. 41 | { sigD n1 f1 ≃ sigD n2 f2 } ➾ Pair ·{ n1 ≃ n2 } ·{ f1 ≃ f2 } 42 | = Λ n1. Λ f1. Λ n2. Λ f2. Λ eq. 43 | [unsigD : Top 44 | = β{ λ x. μ' x { idD ➔ β | constD ➔ β | pairD _ _ ➔ β | sumD _ _ ➔ β | sigD n f ➔ sigma n f}}] 45 | - sigma 46 | ( ρ eq @ x.{ fst (unsigD x) ≃ fst (unsigD (sigD n2 f2))} 47 | - β) 48 | ( ρ eq @ x.{ snd (unsigD x) ≃ snd (unsigD (sigD n2 f2))} 49 | - β) 50 | . 51 | -------------------------------------------------------------------------------- /large-elim-sim/large-elim/concrete/universe/udata.ced: -------------------------------------------------------------------------------- 1 | import descr as descr . 2 | 3 | module large-elim/concrete/universe/udata (C: ★) (I: C ➔ ★) (e: descr.Descr ·C ·I) . 4 | 5 | import lib . 6 | import descr ·C ·I. 7 | import decodeR ·C ·I . 8 | import decode ·C ·I . 9 | 10 | Sig : ★ ➔ ★ 11 | = λ X: ★. Decode ·X e . 12 | 13 | monoSig : Mono ·Sig 14 | = Λ X1. Λ X2. Λ c. 15 | intrCastI 16 | -(indDecode ·X1 ·(λ d: Descr. λ e: Decode ·X1 d. ι b: Decode ·X2 d. { e ≃ b }) 17 | (λ r. [ rollId (cast -c r) , β{r} ]) 18 | ([ rollConst unit , β{unit} ]) 19 | (λ d1. λ e1. λ ih1. λ d2. λ e2. λ ih2. 20 | [ rollPair ·X2 -d1 -d2 21 | (sigma (φ ς ih1.2 - ih1.1 {e1}) (φ ς ih2.2 - ih2.1 {e2})) 22 | , β{sigma e1 e2} ]) 23 | (λ c. λ f. λ i. λ e. λ ih. 24 | [ rollSum ·X2 -c -f (sigma i (φ ς ih.2 - ih.1 {e})) , β{sigma i e} ]) 25 | (λ c. λ f. λ i. λ e. λ ih. 26 | [ rollSig ·X2 -c -f (sigma i (φ ς ih.2 - ih.1 {e})) , β{sigma i e} ]) 27 | e) 28 | . 29 | 30 | import encoding as encoding ·Sig -monoSig . 31 | 32 | D : ★ = encoding.D . 33 | 34 | in : Sig ·D ➔ D = encoding.inM . 35 | in' : ∀ R: ★. Cast ·R ·D ➾ Sig ·R ➔ D 36 | = encoding.inM' . 37 | out : D ➔ Sig ·D = encoding.outM . 38 | 39 | induction 40 | : ∀ P: D ➔ ★. 41 | (∀ R: ★. ∀ c: Cast ·R ·D. Π ih: Π x: R. P (elimCast -c x). 42 | Π xs: Sig ·R. P (in' -c xs)) ➔ 43 | Π x: D. P x 44 | = encoding.inductionM . 45 | 46 | lamebk1 : Π xs : Sig ·D. { out (in xs) ≃ xs } 47 | = encoding.lambek1 . 48 | 49 | lambek2 : Π x: D. { in (out x) ≃ x } 50 | = encoding.lambek2 . 51 | 52 | caseD 53 | : ∀ P: D ➔ ★. (Π xs: Sig ·D. P (in xs)) ➔ Π x: D. P x 54 | = Λ P. λ c. λ x. 55 | ρ ς (lambek2 x) - c (out x) 56 | . 57 | -------------------------------------------------------------------------------- /large-elim-sim/large-elim/concrete/zipwith/tpvec.ced: -------------------------------------------------------------------------------- 1 | import lib . 2 | 3 | module large-elim/concrete/zipwith/tpvec . 4 | 5 | -- TpVec, TVHead, TVTail, TVMap, TVNil 6 | import public large-elim/concrete/zipwith/tpvec/base . 7 | -- TVCons 8 | import public large-elim/concrete/zipwith/tpvec/cons . 9 | -- TVFold 10 | import public large-elim/concrete/zipwith/tpvec/foldr . 11 | import public large-elim/concrete/zipwith/tpvec/fold . 12 | 13 | 14 | -------------------------------------------------------------------------------- /large-elim-sim/large-elim/everything.ced: -------------------------------------------------------------------------------- 1 | module everything. 2 | 3 | import example-nary. 4 | 5 | import concrete/nary as N1. 6 | import concrete/stlc. 7 | 8 | import concrete/universe/decode. 9 | import concrete/universe/decodeR. 10 | import concrete/universe/descr. 11 | import concrete/universe/encoding. 12 | import concrete/universe/list. 13 | import concrete/universe/nat. 14 | import concrete/universe/noconfusion as NC1. 15 | import concrete/universe/noconfusion2. 16 | import concrete/universe/noconfusionR as NCR. 17 | import concrete/universe/udata as Udata. 18 | 19 | import concrete/zipwith/nvecMap. 20 | import concrete/zipwith/tpvec. 21 | 22 | import example-nary as Nary . 23 | 24 | import generic/algty. 25 | import generic/encoding as Encoding. 26 | 27 | import generic/example/nary. 28 | import generic/example/nat. 29 | import generic/example/strongind. 30 | 31 | import generic/large. 32 | -------------------------------------------------------------------------------- /large-elim-sim/large-elim/example-nary.ced: -------------------------------------------------------------------------------- 1 | module large-elim/example-nary (T: ★) . 2 | 3 | import lib . 4 | 5 | data NaryR : Nat ➔ ★ ➔ ★ 6 | = naryRZ : NaryR zero ·T 7 | | naryRS : ∀ n: Nat. ∀ Y: ★. NaryR n ·Y ➔ NaryR (succ n) ·(T ➔ Y) . 8 | 9 | extr0' : ∀ x: Nat. { x ≃ zero } ➾ ∀ N: ★. NaryR x ·N ➔ N ➔ T 10 | {- 11 | -- extr0' : ∀ x: Nat. { x ≃ zero } ➾ ∀ N: ★. NaryR x ·N ➔ N ➔ T 12 | -- extr0' -zero -eqx ·T naryRZ x = x 13 | -- extr0' -(succ n) -eqx ·(T ➔ X) (naryRS n ·X r) x = δ - eqX 14 | -} 15 | = Λ x. Λ eqx. Λ N. λ r. 16 | μ' r @λ x: Nat. λ X: ★. λ _: NaryR x ·X. { x ≃ zero } ➾ X ➔ T { 17 | | naryRZ ➔ Λ _. λ x. x 18 | | naryRS -n ·X r' ➔ Λ eqx. δ - eqx 19 | } -eqx . 20 | 21 | extr0 = extr0' -zero -β . 22 | -------------------------------------------------------------------------------- /large-elim-sim/large-elim/generic/algty.ced: -------------------------------------------------------------------------------- 1 | import core . 2 | 3 | module large-elim/generic/algty (F: ★ ➔ ★) . 4 | 5 | -- Mendler-style "type algebras" 6 | 𝒌AlgTy (D: ★) = Π R: ★. Π c: Cast ·R ·D. Π Ih: R ➔ ★. Π xs: F ·R. ★ . 7 | -- a sufficient condition for Mendler-style type algebras from which we can 8 | -- derive a simulated large elimination 9 | AlgTyCon : Π D: ★. 𝒌AlgTy ·D ➔ ★ 10 | = λ D: ★. λ A: 𝒌AlgTy ·D. 11 | ∀ R1: ★. ∀ R2: ★. ∀ c1: Cast ·R1 ·D. ∀ c2: Cast ·R2 ·D. 12 | ∀ Ih1: R1 ➔ ★. ∀ Ih2: R2 ➔ ★. 13 | (Π r1: R1. Π r2: R2. { r1 ≃ r2 } ➔ TpEq ·(Ih1 r1) ·(Ih2 r2)) ➔ 14 | Π xs1: F ·R1. Π xs2: F ·R2. { xs1 ≃ xs2 } ➔ 15 | TpEq ·(A ·R1 c1 ·Ih1 xs1) ·(A ·R2 c2 ·Ih2 xs2) . 16 | 17 | -------------------------------------------------------------------------------- /large-elim-sim/large-elim/generic/example/nat.ced: -------------------------------------------------------------------------------- 1 | import core . 2 | 3 | module large-elim/generic/example/nat . 4 | 5 | data NatF (R: ★): ★ 6 | = zeroF : NatF 7 | | succF : R ➔ NatF . 8 | 9 | succFInj : ∀ R1: ★. ∀ r1: R1. ∀ R2: ★. ∀ r2: R2. { succF r1 ≃ succF r2 } ➾ { r1 ≃ r2 } 10 | = Λ R1. Λ r1. Λ R2. Λ r2. Λ eq. 11 | [pred : Top = β{ λ n. μ' n { zeroF ➔ β | succF n' ➔ n' }}] 12 | - ρ eq @x.{ pred x ≃ pred (succF r2) } - β 13 | . 14 | 15 | monoNatF : Mono ·NatF 16 | = Λ R1. Λ R2. Λ c. 17 | intrCastI 18 | -(λ n. μ' n { 19 | | zeroF ➔ 20 | [ zeroF ·R2 , β{ zeroF }] 21 | | succF r ➔ 22 | [ succF (elimCast -c r) , β{ succF r } ] 23 | }) 24 | . 25 | 26 | import ../encoding ·NatF -monoNatF . 27 | 28 | Nat : ★ = IndM . 29 | zero : Nat = inM (zeroF ·Nat) . 30 | succ : Nat ➔ Nat = λ n. inM (succF n) . 31 | -------------------------------------------------------------------------------- /large-elim-sim/lib.ced: -------------------------------------------------------------------------------- 1 | module stdlib. 2 | 3 | import public lib.core.bot. 4 | import public lib.core.cast. 5 | import public lib.core.castDep. 6 | import public lib.core.fun. 7 | import public lib.core.rec. 8 | import public lib.core.top. 9 | import public lib.core.tpeq. 10 | import public lib.core.view. 11 | 12 | import public lib.data.bitstring. 13 | import public lib.data.bool. 14 | import public lib.data.bool-thms. 15 | import public lib.data.decidable. 16 | import public lib.data.fin. 17 | import public lib.data.list. 18 | import public lib.data.list-sort. 19 | import public lib.data.list-thms. 20 | import public lib.data.list-cv. 21 | import public lib.data.nat. 22 | import public lib.data.nat-cv. 23 | import public lib.data.nat-thms. 24 | import public lib.data.option. 25 | import public lib.data.reuse.list-vec. 26 | import public lib.data.sigma. 27 | import public lib.data.sigma-thms. 28 | import public lib.data.sum. 29 | import public lib.data.tree. 30 | import public lib.data.unit. 31 | import public lib.data.vec. 32 | import public lib.data.vec-thms. 33 | import public lib.data.wksigma. 34 | 35 | -------------------------------------------------------------------------------- /large-elim-sim/lib/categories/functor-defs.ced: -------------------------------------------------------------------------------- 1 | import ../../core. 2 | import functor. 3 | 4 | module functor-defs (F: ★ ➔ ★) (fu: Functor ·F). 5 | 6 | import rawfunctor-defs as raw ·F (cast -(f2raw ·F) fu). 7 | 8 | fmap = raw.fmap. 9 | 10 | fmapId : FmapId ·F fmap 11 | = μ' fu { 12 | | mkFunctor fmap -id -_ ➔ 13 | Λ X. Λ Y. λ c. λ pf. λ xs. ρ (id c pf xs) - β 14 | }. 15 | 16 | fmapComp : FmapComp ·F fmap 17 | = μ' fu { 18 | | mkFunctor fmap -_ -comp ➔ 19 | Λ X. Λ Y. Λ Z. λ g. λ f. λ xs. ρ (comp g f xs) - β 20 | }. 21 | 22 | fcastMap : CastMap ·F 23 | = Λ X. Λ Y. Λ c. 24 | intrCast 25 | -(λ xs. fmap c.1 xs) 26 | -(λ xs. (ρ (fmapId c.1 (λ x. ρ c.2 - β) xs) - β)). 27 | 28 | fcast 29 | : ∀ X: ★. ∀ Y: ★. Cast ·X ·Y ➾ F ·X ➔ F ·Y 30 | = Λ X. Λ Y. Λ c. (fcastMap -c).1. 31 | -------------------------------------------------------------------------------- /large-elim-sim/lib/categories/functor.ced: -------------------------------------------------------------------------------- 1 | import core . 2 | 3 | module categories.functor. 4 | 5 | Fmap : (★ ➔ ★) ➔ ★ 6 | = λ F: ★ ➔ ★. ∀ X: ★. ∀ Y: ★. (X ➔ Y) ➔ F ·X ➔ F ·Y. 7 | 8 | FmapId : Π F: ★ ➔ ★. Fmap ·F ➔ ★ 9 | = λ F: ★ ➔ ★. λ fmap: Fmap ·F. 10 | ∀ X: ★. ∀ Y: ★. Π c: X ➔ Y. (Π x: X. {c x ≃ x}) ➔ Π xs: F ·X. {fmap c xs ≃ xs}. 11 | 12 | FmapComp : Π F: ★ ➔ ★. Fmap ·F ➔ ★ 13 | = λ F: ★ ➔ ★. λ fmap: Fmap ·F. 14 | ∀ X: ★. ∀ Y: ★. ∀ Z: ★. Π f: Y ➔ Z. Π g: X ➔ Y. 15 | Π xs: F ·X. {fmap f (fmap g xs) ≃ fmap (λ x. f (g x)) xs}. 16 | 17 | data RawFunctor (F: ★ ➔ ★) : ★ 18 | = mkRawFunctor : Fmap ·F ➔ RawFunctor. 19 | 20 | data Functor (F: ★ ➔ ★) : ★ 21 | = mkFunctor : Π fmap: Fmap ·F. FmapId ·F fmap ➾ FmapComp ·F fmap ➾ Functor. 22 | 23 | _ : {mkRawFunctor ≃ mkFunctor} = β. 24 | 25 | f2raw : ∀ F: ★ ➔ ★. Cast ·(Functor ·F) ·(RawFunctor ·F) 26 | = Λ F. 27 | intrCastI 28 | -(λ fu. 29 | μ' fu { 30 | | mkFunctor fmap -fid -fcomp ➔ 31 | [ mkRawFunctor fmap , β{mkRawFunctor fmap} ] 32 | }). 33 | 34 | -------------------------------------------------------------------------------- /large-elim-sim/lib/categories/rawfunctor-defs.ced: -------------------------------------------------------------------------------- 1 | import ../../core. 2 | import functor. 3 | 4 | module rawfunctor-defs (F: ★ ➔ ★) (rfu: RawFunctor ·F). 5 | 6 | fmap : Fmap ·F = μ' rfu {mkRawFunctor fmap ➔ fmap}. 7 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/bitstring.ced: -------------------------------------------------------------------------------- 1 | import bool. 2 | import list. 3 | 4 | module bitstring. 5 | 6 | -- msb is the head 7 | BitString : ★ = List · Bool. 8 | 9 | bitStringEmpty : BitString = nil · Bool. 10 | 11 | bitStringInc : BitString ➔ BitString = 12 | λ s . 13 | μ inc . s @ λ _ : BitString . (Bool ➔ BitString ➔ BitString) ➔ BitString { 14 | nil ➔ λ k . k tt (nil · Bool) 15 | | cons b bs ➔ λ k . inc bs (λ carry . λ sum . k (and b carry) (cons (xor b carry) sum))} 16 | 17 | -- avoid a leading 0 if carry is ff. 18 | (λ carry . λ sum . μ' carry { tt ➔ cons carry sum | ff ➔ sum }). 19 | 20 | _ : { bitStringInc (cons tt (cons tt nil)) ≃ (cons tt (cons ff (cons ff nil))) } = β. 21 | _ : { bitStringInc (cons tt (cons ff nil)) ≃ (cons tt (cons tt nil)) } = β. 22 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/bool-thms.ced: -------------------------------------------------------------------------------- 1 | module bool-thms. 2 | 3 | import core . 4 | 5 | import bool. 6 | import sigma. 7 | import sum. 8 | 9 | IsTT : Bool ➔ ★ = λ b: Bool. { b ≃ tt }. 10 | IsFF : Bool ➔ ★ = λ b: Bool. { b ≃ ff }. 11 | 12 | boolEta : Π b: Bool. { ite b tt ff ≃ b } 13 | = λ b. μ' b { 14 | | tt ➔ β 15 | | ff ➔ β 16 | }. 17 | 18 | notNotId : Π b: Bool. { not (not b) ≃ b } 19 | = λ b. μ' b { tt ➔ β | ff ➔ β }. 20 | 21 | orTT : Π b : Bool . IsTT (or b tt) = 22 | λ b . μ' b { tt ➔ β | ff ➔ β }. 23 | 24 | orFF: ∀ b1: Bool. ∀ b2: Bool. IsFF (or b1 b2) ➾ Pair ·(IsFF b1) ·(IsFF b2) 25 | = Λ b1. Λ b2. Λ isFF. 26 | {pf : IsFF (or b1 b2) ➔ ι _: IsFF b1. IsFF b2 27 | = μ' b1 {tt ➔ λ eq. δ - eq | ff ➔ λ eq. [β , ρ eq - β]}} 28 | - pair (ρ (pf isFF).1 - β) (ρ (pf isFF).2 - β) . 29 | 30 | andFF: Π b1: Bool. ∀ b2: Bool. IsFF (and b1 b2) ➾ Sum ·(IsFF b1) ·(IsFF b2) 31 | = λ b1. Λ b2. μ' b1 { 32 | | ff ➔ Λ isFF. in1 β 33 | | tt ➔ Λ isFF. in2 (ρ+ isFF - β) 34 | }. 35 | 36 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/bool.ced: -------------------------------------------------------------------------------- 1 | module bool. 2 | 3 | data Bool: ★ = 4 | | tt: Bool 5 | | ff: Bool. 6 | 7 | not : Bool ➔ Bool 8 | = λ b. μ' b {tt ➔ ff | ff ➔ tt}. 9 | 10 | ite : ∀ X: ★. Bool ➔ X ➔ X ➔ X 11 | = Λ X. λ b. λ t. λ f. μ' b {tt ➔ t | ff ➔ f}. 12 | 13 | if = ite. 14 | 15 | indBool : ∀ P: Bool ➔ ★. Π b: Bool. P tt ➔ P ff ➔ P b 16 | = Λ P. λ b. λ t. λ f. μ' b { 17 | | tt ➔ t 18 | | ff ➔ f 19 | }. 20 | 21 | and : Bool ➔ Bool ➔ Bool 22 | = λ a. λ b. ite a b ff. 23 | 24 | or : Bool ➔ Bool ➔ Bool 25 | = λ a. λ b. ite a tt b. 26 | 27 | implies : Bool ➔ Bool ➔ Bool 28 | = λ a . λ b . ite a b tt. 29 | 30 | xor : Bool ➔ Bool ➔ Bool 31 | = λ a . λ b . ite a (not b) b. 32 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/decidable.ced: -------------------------------------------------------------------------------- 1 | module decidable. 2 | 3 | import ../core/bot. 4 | 5 | data Decision (A: ★): ★ = 6 | | decYes : A ➔ Decision 7 | | decNo : Not ·A ➔ Decision. 8 | 9 | DecidableProp : Π X: ★. (X ➔ ★) ➔ ★ 10 | = λ X: ★. λ P: X ➔ ★. Π x: X. Decision ·(P x). 11 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/existstm.ced: -------------------------------------------------------------------------------- 1 | import ../../core. 2 | 3 | module data/existstm. 4 | 5 | data ExistsTm (A: ★) (P: A ➔ ★): ★ 6 | = packTm : ∀ x: A. P x ➔ ExistsTm. 7 | 8 | unpackTm : ∀ A: ★. ∀ P: A ➔ ★. ExistsTm ·A ·P ➔ ∀ X: ★. (∀ x: A. P x ➔ X) ➔ X 9 | = Λ A. Λ P. λ e. Λ X. λ f. 10 | μ' e { 11 | packTm -x pf ➔ f -x pf 12 | }. 13 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/existsty.ced: -------------------------------------------------------------------------------- 1 | import ../../core. 2 | 3 | module data/existsty. 4 | 5 | data ExistsTyI (I: ★) (P: (I ➔ ★) ➔ ★): ★ 6 | = packTyI : ∀ E: I ➔ ★. P ·E ➔ ExistsTyI . 7 | 8 | data ExistsTy (P: ★ ➔ ★): ★ 9 | = packTy : ∀ E: ★. P ·E ➔ ExistsTy . 10 | 11 | unpackTyI : ∀ I: ★. ∀ P: (I ➔ ★) ➔ ★. ExistsTyI ·I ·P ➔ ∀ X: ★. (∀ E: I ➔ ★. P ·E ➔ X) ➔ X 12 | = Λ I. Λ P. λ e. Λ X. λ f. 13 | μ' e { 14 | | packTyI ·E pf ➔ f pf 15 | }. 16 | 17 | unpackTy : ∀ P: ★ ➔ ★. ExistsTy ·P ➔ ∀ X: ★. (∀ E: ★. P ·E ➔ X) ➔ X 18 | = Λ P. λ e. Λ X. λ f. 19 | μ' e { 20 | | packTy ·E pf ➔ f pf 21 | } . 22 | 23 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/list-cv.ced: -------------------------------------------------------------------------------- 1 | module list-cv. 2 | 3 | import list. 4 | import list-thms. 5 | 6 | cvFromSuffix : ∀ A: ★. ∀ L: ★. ∀ is: Is/List ·A ·L. ∀ xs: L. Π ys: List ·A. 7 | [xs' = to/List -is xs] - ListSuffix ·A ys xs' ➾ L 8 | = Λ A. Λ L. Λ is. Λ xs. λ ys. Λ suff. 9 | φ (suff.2) - (dropCV -is suff.1 xs) { ys } . 10 | 11 | nilCV : ∀ A: ★. ∀ L: ★. Is/List ·A ·L ➾ L ➾ L 12 | = Λ A. Λ L. Λ is. Λ xs. 13 | cvFromSuffix -is -xs (nil ·A) -(nilSuffix (to/List -is xs)) . 14 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/nat-cv.ced: -------------------------------------------------------------------------------- 1 | module nat-cov. 2 | 3 | import nat. 4 | import nat-thms. 5 | import bool. 6 | 7 | cvFromLte : ∀ N: ★. ∀ is: Is/Nat ·N. ∀ n: N. Π m: Nat. 8 | [n' = to/Nat -is n] - Lte m n' ➾ N 9 | = Λ N. Λ is. Λ n. λ m. Λ pf. 10 | [n' = to/Nat -is n] 11 | - [x = lteEAdd m n' pf] 12 | - [eq : {minus n x ≃ m} 13 | = ρ (ς x.2) @ z. {minus z x ≃ m} 14 | - ρ (minusAddCancel x.1 m) @ z. {z ≃ m} 15 | - β] 16 | - φ eq - (minusCV -is n x.1) {m}. 17 | 18 | _ : {cvFromLte ≃ λ x. x} = β. 19 | 20 | zeroCV : ∀ N: ★. Is/Nat ·N ➾ N ➾ N 21 | = Λ N. Λ is. Λ n. 22 | [n' = to/Nat -is n] 23 | - cvFromLte -is -n zero -β. 24 | 25 | _ : {zeroCV ≃ zero} = β. 26 | 27 | halfGenCV : ∀ N: ★. Is/Nat ·N ➾ Bool ➔ N ➔ N 28 | = Λ N. Λ is. λ b. λ n. 29 | [n' = to/Nat -is n] 30 | - cvFromLte -is -n (halfGen b n') -(lteHalf b n'). 31 | 32 | _ : {halfGenCV ≃ halfGen} = β. 33 | 34 | divCV : ∀ N: ★. Is/Nat ·N ➾ N ➔ Nat ➔ N 35 | = Λ N. Λ is. λ m. λ n. 36 | [m' = to/Nat -is m] 37 | - cvFromLte -is -m (div m' n) -(lteDiv m' n). 38 | 39 | _ : {divCV ≃ div} = β. 40 | 41 | remCV1 : ∀ N: ★. Is/Nat ·N ➾ N ➔ Nat ➔ N 42 | = Λ N. Λ is. λ m. λ n. 43 | [m' = to/Nat -is m] 44 | - cvFromLte -is -m (rem m' n) -(lteRem1 m' n). 45 | 46 | _ : {remCV1 ≃ rem} = β. 47 | 48 | remCV2 : ∀ N: ★. Is/Nat ·N ➾ Nat ➔ ∀ n: N. (ι x: Nat. {x ≃ succ n}) ➔ N 49 | = Λ N. Λ is. λ m. Λ n. λ x. 50 | [n' = to/Nat -is n] 51 | - cvFromLte -is -n (rem m x.1) -(ρ x.2 - lteRem2 m n'). 52 | 53 | _ : {remCV2 ≃ rem} = β. 54 | 55 | gcd : Nat ➔ Nat ➔ Nat 56 | = λ m. μ gcd. m { 57 | | zero ➔ λ n. n 58 | | succ m ➔ 59 | [m' = to/Nat -isType/gcd m] 60 | - [sm : ι x: Nat. {x ≃ succ m} = [ succ m' , β{succ m'} ]] 61 | - λ n. gcd (remCV2 -isType/gcd n -m sm) (succ m') 62 | }. 63 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/nat-thms.ced: -------------------------------------------------------------------------------- 1 | module data.nat-thms. 2 | 3 | import public nat-thms.simple. 4 | import public nat-thms.order. 5 | 6 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/option.ced: -------------------------------------------------------------------------------- 1 | import core . 2 | 3 | import bool. 4 | 5 | module option. 6 | 7 | data Option (A: ★): ★ = 8 | | none: Option 9 | | some: A ➔ Option. 10 | 11 | isNone: ∀ A: ★. Option ·A ➔ Bool = Λ A. λ m. μ' m {none ➔ tt | some _ ➔ ff}. 12 | 13 | option: ∀ A: ★. ∀ X: ★. Option ·A ➔ X ➔ (A ➔ X) ➔ X 14 | = Λ A. Λ X. λ m. λ x. λ f. μ' m {none ➔ x | some a ➔ f a}. 15 | 16 | someInj: ∀ A: ★. ∀ a1: A. ∀ a2: A. {some a1 ≃ some a2} ➾ {a1 ≃ a2} 17 | = Λ A. Λ a1. Λ a2. Λ eq. 18 | ρ eq @ x . { option x a1 (λ z. z) ≃ option (some a2) a2 (λ z. z) } 19 | - β. 20 | 21 | optionMap : ∀ A: ★. ∀ B: ★. (A ➔ B) ➔ Option ·A ➔ Option ·B 22 | = Λ A. Λ B. λ f. λ m. μ' m { 23 | | none ➔ none ·B 24 | | some x ➔ some (f x) 25 | }. 26 | 27 | optionBind : ∀ A: ★. ∀ B: ★. Option ·A ➔ (A ➔ Option ·B) ➔ Option ·B 28 | = Λ A. Λ B. λ m. λ f. μ' m { 29 | | none ➔ none ·B 30 | | some x ➔ f x 31 | }. 32 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/reuse/list-vec.ced: -------------------------------------------------------------------------------- 1 | module data.reuse.list-vec. 2 | 3 | import ../nat. 4 | import ../list. 5 | import ../vec. 6 | 7 | import ../../core/cast. 8 | import ../../core/castDep. 9 | 10 | vec2ListId : ∀ A: ★. ∀ n: Nat. Cast ·(Vec ·A n) ·(List ·A) 11 | = Λ A. 12 | [f : ∀ n: Nat. Vec ·A n ➔ List ·A 13 | = Λ n. λ xs. μ rec. xs { 14 | | vnil ➔ nil ·A 15 | | vcons -n x xs ➔ cons x (rec -n xs) 16 | }] 17 | - [pf : ∀ n: Nat. Π xs: Vec ·A n. {f xs ≃ xs} 18 | = Λ n. λ xs. μ ih. xs { 19 | | vnil ➔ β 20 | | vcons -n x xs ➔ 21 | ρ (ih -n xs) @ z. {cons x z ≃ vcons x xs} - β 22 | }] 23 | - Λ n. intrCast -(f -n) -(pf -n). 24 | 25 | vec2List! : ∀ A: ★. ∀ n: Nat. Vec ·A n ➔ List ·A 26 | = Λ A. Λ n. elimCast -(vec2ListId ·A -n). 27 | 28 | _ : {vec2List! ≃ λ x. x} = β. 29 | 30 | list2VecId : ∀ A: ★. CastDep ·(List ·A) ·(λ xs: List ·A. Vec ·A (length xs)) 31 | = Λ A. 32 | [f : Π xs: List ·A. Vec ·A (length xs) 33 | = λ xs. μ rec. xs { 34 | | nil ➔ vnil ·A 35 | | cons x xs ➔ 36 | [xs' = to/List -isType/rec xs] 37 | - vcons -(length xs') x (rec xs) 38 | }] 39 | - [pf : Π xs: List ·A. {f xs ≃ xs} 40 | = λ xs. μ ih. xs { 41 | | nil ➔ β 42 | | cons x xs ➔ 43 | ρ (ih xs) @ z. {cons x z ≃ cons x xs} 44 | - β 45 | }] 46 | - intrCastDep -f -pf. 47 | 48 | list2Vec! : ∀ A: ★. Π xs: List ·A. Vec ·A (length xs) 49 | = Λ A. elimCastDep -(list2VecId ·A). 50 | 51 | _ : {list2Vec! ≃ λ x. x} = β. 52 | 53 | reuse1V2L : ∀ A: ★. ∀ g: (∀ n: Nat. Π xs: Vec ·A n. Nat). Π f: (∀ n: Nat. Π xs: Vec ·A n. Vec ·A (g -n xs)). List ·A ➔ List ·A 54 | = Λ A. Λ g. λ f. λ xs. 55 | [xs' = list2Vec! xs] 56 | - [n = length xs] 57 | - vec2List! -(g -n xs') (f -n xs'). 58 | 59 | _ : { reuse1V2L ≃ λ x. x } = β . 60 | 61 | reuse1L2V : ∀ A: ★. Π g: (List ·A ➔ List ·A). ∀ n: Nat. Π xs: Vec ·A n. Vec ·A (length (g (vec2List! -n xs))) 62 | = Λ A. λ g. Λ n. λ xs. list2Vec! (g (vec2List! -n xs)). 63 | 64 | _ : { reuse1L2V ≃ λ g. g } = β . 65 | 66 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/sigma-thms.ced: -------------------------------------------------------------------------------- 1 | module data.sigma-thms. 2 | 3 | import sigma. 4 | 5 | sigmaInj1 6 | : ∀ A1: ★. ∀ B1: A1 ➔ ★. ∀ a1: A1. ∀ b1: B1 a1. 7 | ∀ A2: ★. ∀ B2: A2 ➔ ★. ∀ a2: A2. ∀ b2: B2 a2. 8 | { sigma a1 b1 ≃ sigma a2 b2 } ➾ { a1 ≃ a2 } 9 | = Λ A1. Λ B1. Λ a1. Λ b1. Λ A2. Λ B2. Λ a2. Λ b2. Λ eq. 10 | ρ eq @x.{ fst x ≃ fst (sigma a2 b2) } - β 11 | . 12 | 13 | sigmaInj2 14 | : ∀ A1: ★. ∀ B1: A1 ➔ ★. ∀ a1: A1. ∀ b1: B1 a1. 15 | ∀ A2: ★. ∀ B2: A2 ➔ ★. ∀ a2: A2. ∀ b2: B2 a2. 16 | { sigma a1 b1 ≃ sigma a2 b2 } ➾ { b1 ≃ b2 } 17 | = Λ A1. Λ B1. Λ a1. Λ b1. Λ A2. Λ B2. Λ a2. Λ b2. Λ eq. 18 | ρ eq @x.{ snd x ≃ snd (sigma a2 b2) } - β 19 | . 20 | 21 | fstCong : ∀ A1: ★. ∀ B1: A1 ➔ ★. ∀ A2: ★. ∀ B2: A2 ➔ ★. 22 | Π s1: Sigma ·A1 ·B1. Π s2: Sigma ·A2 ·B2. 23 | {s1 ≃ s2} ➾ {fst s1 ≃ fst s2} 24 | = Λ _. Λ _. Λ _. Λ _. λ s1. λ s2. Λ eq. ρ eq @ x . { fst x ≃ fst s2 } - β. 25 | 26 | sndCong : ∀ A1: ★. ∀ B1: A1 ➔ ★. ∀ A2: ★. ∀ B2: A2 ➔ ★. 27 | Π s1: Sigma ·A1 ·B1. Π s2: Sigma ·A2 ·B2. 28 | {s1 ≃ s2} ➾ {snd s1 ≃ snd s2} 29 | = Λ _. Λ _. Λ _. Λ _. λ s1. λ s2. Λ eq. ρ eq @ x . { snd x ≃ snd s2 } - β. 30 | 31 | _ : ∀ A: ★. ∀ B: A ➔ ★. Π p1: Sigma ·A ·B. Π p2: Sigma ·A ·B. {p1 ≃ p2} ➔ {snd p1 ≃ snd p2} 32 | = Λ A. Λ B. λ p1. λ p2. μ' p1 { 33 | | sigma a1 b1 ➔ μ' p2 { 34 | | sigma a2 b2 ➔ λ eq. ρ eq - β 35 | }}. 36 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/sum.ced: -------------------------------------------------------------------------------- 1 | module data.sum. 2 | 3 | data Sum (A: ★) (B: ★): ★ = 4 | | in1 : A ➔ Sum 5 | | in2 : B ➔ Sum. 6 | 7 | case : ∀ A: ★. ∀ B: ★. ∀ X: ★. Sum ·A ·B ➔ (A ➔ X) ➔ (B ➔ X) ➔ X 8 | = Λ A. Λ B. Λ X. λ s. λ l. λ r. μ' s { 9 | | in1 a ➔ l a 10 | | in2 b ➔ r b 11 | }. 12 | 13 | sumMapR : ∀ A: ★. ∀ B: ★. ∀ C: ★. (B ➔ C) ➔ Sum ·A ·B ➔ Sum ·A ·C 14 | = Λ A. Λ B. Λ C. λ f. λ s. case s (λ a. in1 a) (λ b. in2 (f b)). 15 | 16 | sumMapL : ∀ A: ★. ∀ B: ★. ∀ C: ★. (A ➔ C) ➔ Sum ·A ·B ➔ Sum ·C ·B 17 | = Λ A. Λ B. Λ C. λ f. λ s. case s (λ a. in1 (f a)) (λ b. in2 b). 18 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/tree.ced: -------------------------------------------------------------------------------- 1 | -- binary trees with data at the nodes 2 | module Tree. 3 | 4 | data Tree(A : ★) : ★ = 5 | leaf : Tree 6 | | node : A ➔ Tree ➔ Tree ➔ Tree . 7 | 8 | singletonTree : ∀ A : ★ . A ➔ Tree · A = Λ A . λ a . node a (leaf · A) (leaf · A). 9 | 10 | fmapTree : ∀ A : ★ . ∀ B : ★ . (A ➔ B) ➔ Tree · A ➔ Tree · B = 11 | Λ A . Λ B . λ f . λ t . 12 | μ fmap . t { leaf ➔ leaf · B | node a l r ➔ node (f a) (fmap l) (fmap r) }. 13 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/unit.ced: -------------------------------------------------------------------------------- 1 | module unit. 2 | 3 | data Unit: ★ = unit: Unit. 4 | 5 | etaUnit : Π u: Unit. {u ≃ unit} 6 | = λ u. μ' u { unit ➔ β }. 7 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/vec-thms.ced: -------------------------------------------------------------------------------- 1 | module vec-thms (A: ★). 2 | 3 | import nat. 4 | import nat-thms. 5 | import vec. 6 | import ../core/top. 7 | import ../core/bot. 8 | 9 | vlookupVmap : ∀ f: Top. ∀ n: Nat. Π xs: Vec ·A n. 10 | Π m: Nat. Lt m n ➾ 11 | {f (vlookup xs m) ≃ vlookup (vmap f xs) m} 12 | = Λ f. Λ n. λ xs. 13 | μ ih. xs { 14 | | vnil ➔ λ m. Λ le. 15 | [bad : Bot = botIrrel -(lteSZ m le)] 16 | - bad ·{f (vlookup vnil m) ≃ vlookup (vmap f vnil) m} 17 | | vcons -n x xs ➔ λ m. μ' m { 18 | | zero ➔ Λ _. β 19 | | succ m ➔ Λ le. 20 | {le' = lteSInv (succ m) n le} 21 | - ih -n xs m -le' 22 | } 23 | }. 24 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/w-type.ced: -------------------------------------------------------------------------------- 1 | module w-type. 2 | 3 | data W (A: ★) (B: A ➔ ★) : ★ 4 | = sup : Π a: A. (B a ➔ W) ➔ W . 5 | 6 | elimW 7 | : ∀ A: ★. ∀ B: A ➔ ★. ∀ X: W ·A ·B ➔ ★. 8 | (Π a: A. Π t: (B a ➔ W ·A ·B). X (sup a t)) ➔ Π w: W ·A ·B. X w 9 | = Λ A. Λ B. Λ X. λ e. λ w. 10 | μ' w { 11 | | sup a t ➔ e a t 12 | } . 13 | -------------------------------------------------------------------------------- /large-elim-sim/lib/data/wksigma.ced: -------------------------------------------------------------------------------- 1 | module wksigma. 2 | 3 | import ../core/top. 4 | 5 | data WkSigma (A: ★) (B: A ➔ ★) : ★ = 6 | | wkpair : Π a: A. ∀ b: B a. WkSigma. 7 | 8 | WkPair : ★ ➔ ★ ➔ ★ = λ A: ★. λ B: ★. WkSigma ·A ·(λ _: A. B). 9 | 10 | wkfst : ∀ A: ★. ∀ B: A ➔ ★. WkSigma ·A ·B ➔ A 11 | = Λ A. Λ B. λ p. μ' p { 12 | wkpair a -b ➔ a 13 | }. 14 | 15 | wksnd : ∀ A: ★. ∀ B: A ➔ ★. ∀ X: ★. Π p: WkSigma ·A ·B. (B (wkfst p) ➾ X) ➔ X 16 | = Λ A. Λ B. Λ X. λ p. μ' p { 17 | wkpair a -b ➔ λ f. f -b 18 | }. 19 | -------------------------------------------------------------------------------- /lfmtp19/README.md: -------------------------------------------------------------------------------- 1 | # Cedille version 2 | 3 | This works with the (frozen) master branch of Cedille 1.x. 4 | 5 | # Cedille Files 6 | 7 | The main file is lfmtp.ced. The others are library files. 8 | 9 | # Haskell Files 10 | 11 | The main file is Lfmtp19.ced. -------------------------------------------------------------------------------- /lfmtp19/RecAlg.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE KindSignatures #-} 2 | {-# LANGUAGE ExplicitForAll #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | module RecAlg where 5 | 6 | newtype Ca alg = MkC { unfoldC :: forall (x :: *) . alg x -> x} 7 | 8 | newtype Alg (f :: * -> *) x = 9 | MkAlg { unfoldAlg :: forall (alga :: * -> *) . 10 | (f (Ca alga)) -> 11 | (forall (z :: *) . Alg f z -> alga z) -> 12 | alga x -> 13 | x} 14 | 15 | type C f = Ca (Alg f) 16 | 17 | initAlg :: Functor f => Alg f (C f) 18 | initAlg = 19 | MkAlg (\ fd embedAlg _ -> 20 | MkC (\ a' -> unfoldAlg a' fd embedAlg (embedAlg a'))) 21 | 22 | -------------------------------------------------------------------------------- /lfmtp19/RecType2.ced: -------------------------------------------------------------------------------- 1 | module RecType2(F : (★ ➔ ★) ➔ ★ ➔ ★). 2 | 3 | import top. 4 | import cast2. 5 | 6 | RecFunctor2 ◂ ★ = 7 | ∀ X : 𝒌 . ∀ Y : 𝒌 . Cast2 · X · Y ➔ Cast2 · (F · X) · (F · Y) . 8 | 9 | Rec2 ◂ 𝒌 = λ Y : ★ . ∀ X : 𝒌 . Cast2 · (F · X) · X ➾ X · Y. 10 | 11 | recCast2 ◂ ∀ X : 𝒌 . Cast2 · (F · X) · X ➾ Cast2 · Rec2 · X = 12 | Λ X . Λ c . Λ Y . [ λ d . d · X -c , β ]. 13 | 14 | recFold2 ◂ RecFunctor2 ➾ Cast2 · (F · Rec2) · Rec2 = 15 | Λ fmap . 16 | Λ Y . [ λ x . Λ X . Λ c . 17 | cast2 · (F · X) · X -c · Y 18 | (cast2 · (F · Rec2) · (F · X) 19 | -(fmap · Rec2 · X (recCast2 · X -c)) · Y x), 20 | β ]. 21 | 22 | recUnfold2 ◂ RecFunctor2 ➾ Cast2 · Rec2 · (F · Rec2) = 23 | Λ fmap . Λ X . [ λ x . x · (F · Rec2) -(fmap · (F · Rec2) · Rec2 (recFold2 -fmap)) , β ]. 24 | 25 | 26 | -------------------------------------------------------------------------------- /lfmtp19/bool.ced: -------------------------------------------------------------------------------- 1 | module bool. 2 | 3 | data Bool: ★ = 4 | | tt: Bool 5 | | ff: Bool. 6 | 7 | not : Bool ➔ Bool 8 | = λ b. σ b {tt ➔ ff | ff ➔ tt}. 9 | 10 | ite : ∀ X: ★. Bool ➔ X ➔ X ➔ X 11 | = Λ X. λ b. λ t. λ f. σ b {tt ➔ t | ff ➔ f}. 12 | 13 | if = ite. 14 | 15 | indBool : ∀ P: Bool ➔ ★. Π b: Bool. P tt ➔ P ff ➔ P b 16 | = Λ P. λ b. λ t. λ f. σ b { 17 | | tt ➔ t 18 | | ff ➔ f 19 | }. 20 | 21 | and : Bool ➔ Bool ➔ Bool 22 | = λ a. λ b. ite a b ff. 23 | 24 | or : Bool ➔ Bool ➔ Bool 25 | = λ a. λ b. ite a tt b. 26 | 27 | implies : Bool ➔ Bool ➔ Bool 28 | = λ a . λ b . ite a b tt. 29 | 30 | xor : Bool ➔ Bool ➔ Bool 31 | = λ a . λ b . ite a (not b) b. 32 | -------------------------------------------------------------------------------- /lfmtp19/cast.ced: -------------------------------------------------------------------------------- 1 | module core.cast. 2 | 3 | Cast : ★ ➔ ★ ➔ ★ = λ A: ★. λ B: ★. ι f: A ➔ B. {f ≃ λ x. x}. 4 | 5 | intrCast : ∀ A: ★. ∀ B: ★. ∀ f: A ➔ B. (Π a: A. {f a ≃ a}) ➾ Cast ·A ·B 6 | = Λ A. Λ B. Λ f. Λ eq. [ λ a. φ (eq a) - (f a) {|a|} , β]. 7 | 8 | intrCastI : ∀ A: ★. ∀ B: ★. (Π a : A . ι b : B . { a ≃ b }) ➾ Cast ·A ·B 9 | = Λ A. Λ B. Λ f. [ λ a. [ p = f a ] - φ ς p.2 - p.1 {|a|} , β]. 10 | 11 | elimCast : ∀ A: ★. ∀ B: ★. Cast ·A ·B ➾ A ➔ B 12 | = Λ A. Λ B. Λ c. φ c.2 - c.1 {|λ x. x|}. 13 | 14 | cast = elimCast. 15 | 16 | -- Cast is a pre-order on types 17 | 18 | castRefl : ∀ A: ★. Cast ·A ·A 19 | = Λ A. intrCast -(λ x. x) -(λ _. β). 20 | 21 | castTrans : ∀ A: ★. ∀ B: ★. ∀ C: ★. Cast ·A ·B ➾ Cast ·B ·C ➾ Cast ·A ·C 22 | = Λ A. Λ B. Λ C. Λ c1. Λ c2. intrCast -(λ a. elimCast -c2 (elimCast -c1 a)) -(λ _. β). 23 | 24 | CastMap : (★ ➔ ★) ➔ ★ 25 | = λ F: ★ ➔ ★. ∀ A: ★. ∀ B: ★. Cast ·A ·B ➾ Cast ·(F ·A) ·(F ·B). 26 | 27 | castMap : ∀ F: ★ ➔ ★. ∀ A: ★. ∀ B: ★. 28 | CastMap ·F ➾ Cast ·A ·B ➾ F ·A ➔ F ·B 29 | = Λ F. Λ A. Λ B. Λ cm. Λ c. λ f. elimCast -(cm -c) f. 30 | 31 | castMapComp : ∀ F: ★ ➔ ★. ∀ G: ★ ➔ ★. 32 | CastMap ·F ➾ CastMap ·G ➾ CastMap ·(λ X: ★. F ·(G ·X)) 33 | = Λ F. Λ G. Λ cm1. Λ cm2. Λ X. Λ Y. Λ c. 34 | intrCast -(λ fs. castMap -cm1 -(cm2 -c) fs) -(λ _. β). 35 | 36 | constCastMap : ∀ X : ★ . CastMap · (λ _ : ★ . X) = 37 | Λ X . 38 | Λ A . Λ B . Λ c . castRefl · X . 39 | -------------------------------------------------------------------------------- /lfmtp19/cast2.ced: -------------------------------------------------------------------------------- 1 | module Cast2. 2 | 3 | 𝒌 = ★ ➔ ★ . 4 | 5 | Cast2 ◂ 𝒌 ➔ 𝒌 ➔ ★ = λ A : 𝒌 . λ B : 𝒌 . 6 | ∀ X : ★ . ι cast2 : A · X ➔ B · X . {cast2 ≃ λ x . x}. 7 | 8 | cast2 ◂ ∀ A : 𝒌 . ∀ B : 𝒌 . Cast2 · A · B ➾ ∀ X : ★ . A · X ➔ B · X = 9 | Λ A . Λ B . Λ c . Λ X . λ a . φ (ρ (c · X).2 - β) - ((c · X).1 a) {|a|} . 10 | 11 | caste2 ◂ ∀ A : 𝒌 . ∀ B : 𝒌 . Π f : ∀ X : ★ . A · X ➔ B · X . (∀ X : ★ . Π a : A · X . {f a ≃ a}) ➾ Cast2 · A · B = 12 | Λ A . Λ B . λ f . Λ e . Λ X . [ λ a . φ (e a) - (f a) {|a|} , β ] . 13 | 14 | castCompose2 ◂ ∀ A : 𝒌 . ∀ B : 𝒌 . ∀ C : 𝒌 . Cast2 · A · B ➔ Cast2 · B · C ➔ Cast2 · A · C = 15 | Λ A . Λ B . Λ C . λ c1 . λ ca . Λ X . [ λ a . cast2 -ca (cast2 -c1 a) , β] . 16 | 17 | castId2 ◂ ∀ A : 𝒌 . Cast2 · A · A = 18 | Λ A . Λ X . [ λ a . a , β]. 19 | -------------------------------------------------------------------------------- /lfmtp19/top.ced: -------------------------------------------------------------------------------- 1 | module core.top. 2 | 3 | Top : ★ = {β ≃ β}. 4 | -------------------------------------------------------------------------------- /lfmtp19/view.ced: -------------------------------------------------------------------------------- 1 | module core.view. 2 | 3 | import top. 4 | 5 | View : Π A: ★. Top ➔ ★ = λ A: ★. λ x: Top. ι z: A. {z ≃ x}. 6 | 7 | intrView : ∀ A: ★. Π x: Top. ∀ a: A. {a ≃ x} ➾ View ·A x 8 | = Λ A. λ x. Λ a. Λ eq. [ φ eq - a {|x|} , β{|x|} ]. 9 | 10 | elimView : ∀ A: ★. Π b: Top. View ·A b ➾ A 11 | = Λ A. λ b. Λ v. φ v.2 - v.1 {|b|}. 12 | 13 | -- internalized realizability 14 | viewFun : ∀ A: ★. ∀ B: ★. Π f: Top. (Π x: A. View ·B β{|f x|}) ➾ View ·(A ➔ B) f 15 | = Λ A. Λ B. λ f. Λ pf. 16 | intrView ·(A ➔ B) β{|f|} -(λ x. φ (pf x).2 - (pf x).1 {|f x|}) -β. 17 | 18 | viewSelf : ∀ X: ★. Π x: X. View ·X β{|x|} 19 | = Λ X. λ x. intrView β{|x|} -x -β . 20 | 21 | -- view / cast 22 | 23 | import cast . 24 | 25 | -- erases to x 26 | viewCast1 : ∀ A: ★. ∀ B: ★. Cast ·A ·B ➾ Π x: Top. View ·A x ➾ View ·B x 27 | = Λ A. Λ B. Λ c. λ x. Λ v. intrView x -(elimCast -c (elimView x -v)) -β . 28 | 29 | -- erases to the view 30 | viewCast2 : ∀ A: ★. ∀ B: ★. Cast ·A ·B ➾ ∀ x: Top. View ·A x ➔ View ·B x 31 | = Λ A. Λ B. Λ c. Λ x. λ v. ρ ς v.2 - intrView ·B β{|v|} -(elimCast -c v.1) -β . 32 | -------------------------------------------------------------------------------- /recursive-representation-of-data/.cedille/options: -------------------------------------------------------------------------------- 1 | import-directories = "." . 2 | use-cede-files = false. 3 | make-rkt-files = false. 4 | generate-logs = false. 5 | show-qualified-vars = false. 6 | erase-types = true. 7 | -------------------------------------------------------------------------------- /recursive-representation-of-data/README.org: -------------------------------------------------------------------------------- 1 | * Monotone Recursive Types and Recursive Data Representation in Cedille 2 | 3 | Under consideration for the /Journal of Mathematical Structures in Computer 4 | Science/ 5 | 6 | All code can be checked from [[file:everything.ced][everything.ced]]. 7 | 8 | ** Utilities 9 | 10 | - [[file:cast.ced][cast.ced]]: type coercions 11 | - [[file:recType.ced][recType.ced]]: monotone recursive types in Cedille 12 | - [[file:functor.ced][functor.ced]]: functors and the associated identity and composition laws 13 | - [[file:functorThms.ced][functorThms.ced]]: some useful lemmas about functors, including the relation 14 | between functorality and positivity 15 | - [[file:utils.ced][utils.ced]]: useful datatypes (dependent products, unit) and signature 16 | functors (lists) 17 | 18 | ** Main files 19 | 20 | TODO 21 | 22 | -------------------------------------------------------------------------------- /recursive-representation-of-data/cast.ced: -------------------------------------------------------------------------------- 1 | module cast. 2 | 3 | import view . 4 | 5 | Cast ◂ ★ ➔ ★ ➔ ★ = λ S: ★. λ T: ★. View ·(S ➔ T) β{| λ x. x |} . 6 | 7 | intrCast ◂ ∀ S: ★. ∀ T: ★. ∀ t: S ➔ T. (Π x: S. { t x ≃ x }) ➾ Cast ·S ·T 8 | = Λ S. Λ T. Λ t. Λ t'. 9 | extView ·S ·T β{| λ x. x |} -(λ x. intrView β{| x |} -(t x) -(t' x)) . 10 | 11 | elimCast ◂ ∀ S: ★. ∀ T: ★. Cast ·S ·T ➾ S ➔ T 12 | = Λ S. Λ T. Λ c. elimView β{| λ x. x |} -c . 13 | 14 | eqCast ◂ ∀ S: ★. ∀ T: ★. ∀ c: Cast ·S ·T. { λ x. x ≃ c } 15 | = Λ S. Λ T. Λ c. eqView -β{| λ x. x |} -c . 16 | 17 | castRefl ◂ ∀ S: ★. Cast ·S ·S 18 | = Λ S. intrCast -(λ x. x) -(λ _. β) . 19 | 20 | castTrans ◂ ∀ S: ★. ∀ T: ★. ∀ U: ★. Cast ·S ·T ➾ Cast ·T ·U ➾ Cast ·S ·U 21 | = Λ S. Λ T. Λ U. Λ c1. Λ c2. 22 | intrCast -(λ x. elimCast -c2 (elimCast -c1 x)) -(λ _. β) . 23 | 24 | castUnique ◂ ∀ S: ★. ∀ T: ★. ∀ c1: Cast ·S ·T. ∀ c2: Cast ·S ·T. { c1 ≃ c2 } 25 | = Λ S. Λ T. Λ c1. Λ c2. ρ ς (eqCast -c1) @x.{ x ≃ c2 } - eqCast -c2 . 26 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char.ced: -------------------------------------------------------------------------------- 1 | module data-char . 2 | 3 | import data-char/case-typing . 4 | import data-char/case . 5 | import data-char/iter . 6 | import data-char/primrec . 7 | import data-char/destruct . 8 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/case-typing.ced: -------------------------------------------------------------------------------- 1 | module data-char/case-typing (F: ★ ➔ ★) . 2 | 3 | AlgCase ◂ ★ ➔ ★ ➔ ★ 4 | = λ D: ★. λ X: ★. F ·D ➔ X . 5 | 6 | Case ◂ ★ ➔ ★ 7 | = λ D: ★. ∀ X: ★. AlgCase ·D ·X ➔ D ➔ X . 8 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/case.ced: -------------------------------------------------------------------------------- 1 | import data-char/iter-typing . 2 | 3 | module data-char/case 4 | (F: ★ ➔ ★) (D: ★) (inD: Alg ·F ·D). 5 | 6 | import data-char/case-typing ·F . 7 | 8 | AlgCaseHom ◂ Π X: ★. AlgCase ·D ·X ➔ (D ➔ X) ➔ ★ 9 | = λ X: ★. λ a: AlgCase ·D ·X. λ h: D ➔ X. 10 | ∀ xs: F ·D. { h (inD xs) ≃ a xs } . 11 | 12 | CaseBeta ◂ Case ·D ➔ ★ 13 | = λ case: Case ·D. 14 | ∀ X: ★. ∀ a: AlgCase ·D ·X. AlgCaseHom ·X a (case a) . 15 | 16 | CaseEta ◂ Case ·D ➔ ★ 17 | = λ case: Case ·D. 18 | ∀ X: ★. ∀ a: AlgCase ·D ·X. ∀ h: D ➔ X. AlgCaseHom ·X a h ➔ 19 | Π x: D. { h x ≃ case a x } . 20 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/destruct.ced: -------------------------------------------------------------------------------- 1 | module data-char/destruct (F: ★ ➔ ★) (D: ★) (inD : F ·D ➔ D) . 2 | 3 | Destructor ◂ ★ = D ➔ F ·D . 4 | 5 | Lambek1 ◂ Destructor ➔ ★ 6 | = λ outD: Destructor. Π xs: F ·D. { outD (inD xs) ≃ xs } . 7 | 8 | Lambek2 ◂ Destructor ➔ ★ 9 | = λ outD: Destructor. Π x: D. { inD (outD x) ≃ x } . 10 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/iter-typing.ced: -------------------------------------------------------------------------------- 1 | module data-char/iter-typing (F: ★ ➔ ★) . 2 | 3 | Alg ◂ ★ ➔ ★ 4 | = λ X: ★. F ·X ➔ X . 5 | 6 | Iter ◂ ★ ➔ ★ 7 | = λ D: ★. ∀ X: ★. Alg ·X ➔ D ➔ X . 8 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/iter.ced: -------------------------------------------------------------------------------- 1 | module data-char/iter 2 | (F: ★ ➔ ★) (fmap: ∀ X: ★. ∀ Y: ★. (X ➔ Y) ➔ F ·X ➔ F ·Y) 3 | (D: ★) (inD: F ·D ➔ D). 4 | 5 | import data-char/iter-typing ·F . 6 | 7 | AlgHom ◂ Π X: ★. Alg ·X ➔ (D ➔ X) ➔ ★ 8 | = λ X: ★. λ a: Alg ·X. λ h: D ➔ X. 9 | ∀ xs: F ·D. { h (inD xs) ≃ a (fmap h xs) } . 10 | 11 | IterBeta ◂ Iter ·D ➔ ★ 12 | = λ iter: Iter ·D. 13 | ∀ X: ★. ∀ a: Alg ·X. AlgHom ·X a (iter a) . 14 | 15 | IterEta ◂ Iter ·D ➔ ★ 16 | = λ iter: Iter ·D. 17 | ∀ X: ★. ∀ a: Alg ·X. ∀ h: D ➔ X. AlgHom ·X a h ➔ 18 | Π x: D. { h x ≃ iter a x } . 19 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/lr-typing.ced: -------------------------------------------------------------------------------- 1 | module data-char/lr-typing (F: ★ ➔ ★) . 2 | 3 | PredLR ◂ ★ ➔ ★ ➔ ★ 4 | = λ X: ★. λ Y: ★. Y ➔ Y ➔ X . 5 | 6 | AlgLR ◂ ★ ➔ ★ ➔ ★ 7 | = λ D: ★. λ X: ★. ∀ Y: ★. F ·(ι x: D. PredLR ·X ·Y) ➔ Y ➔ X . 8 | 9 | RecLR ◂ ★ ➔ ★ 10 | = λ D: ★. ∀ X: ★. AlgLR ·D ·X ➔ D ➔ AlgLR ·D ·X ➔ X . 11 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/lr.ced: -------------------------------------------------------------------------------- 1 | import cast . 2 | import mono . 3 | 4 | import data-char/iter-typing . 5 | 6 | module data-char/lr 7 | (F: ★ ➔ ★) {mono: Mono ·F} (D: ★) (inD: Alg ·F ·D) . 8 | 9 | import data-char/lr-typing ·F . 10 | 11 | AlgLRHom ◂ Π X: ★. AlgLR ·D ·X ➔ (D ➔ AlgLR ·D ·X ➔ X) ➔ ★ 12 | = λ X: ★. λ a: AlgLR ·D ·X. λ h: D ➔ AlgLR ·D ·X ➔ X. 13 | ∀ xs: F ·D. { h (inD xs) ≃ a xs } . 14 | 15 | RecLRBeta ◂ RecLR ·D ➔ ★ 16 | = λ recLR: RecLR ·D. 17 | ∀ X: ★. ∀ a: AlgLR ·D ·X. AlgLRHom ·X a (recLR a) . 18 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/primrec-typing.ced: -------------------------------------------------------------------------------- 1 | import utils . 2 | 3 | module data-char/primrec-typing (F: ★ ➔ ★) . 4 | 5 | AlgRec ◂ ★ ➔ ★ ➔ ★ 6 | = λ D: ★. λ X: ★. F ·(Pair ·D ·X) ➔ X . 7 | 8 | PrimRec ◂ ★ ➔ ★ 9 | = λ D: ★. ∀ X: ★. AlgRec ·D ·X ➔ D ➔ X . 10 | 11 | -------------------------------------------------------------------------------- /recursive-representation-of-data/data-char/primrec.ced: -------------------------------------------------------------------------------- 1 | import functor . 2 | import utils . 3 | 4 | import data-char/iter-typing . 5 | import data-char/case-typing . 6 | 7 | module data-char/primrec 8 | (F: ★ ➔ ★) (fmap: Fmap ·F) (D: ★) (inD: Alg ·F ·D). 9 | 10 | import data-char/primrec-typing ·F . 11 | 12 | AlgRecHom ◂ Π X: ★. AlgRec ·D ·X ➔ (D ➔ X) ➔ ★ 13 | = λ X: ★. λ a: AlgRec ·D ·X. λ h: D ➔ X. 14 | ∀ xs: F ·D. { h (inD xs) ≃ a (fmap (fork id h) xs) } . 15 | 16 | PrimRecBeta ◂ PrimRec ·D ➔ ★ 17 | = λ rec: PrimRec ·D. 18 | ∀ X: ★. ∀ a: AlgRec ·D ·X. AlgRecHom ·X a (rec a) . 19 | 20 | PrimRecEta ◂ PrimRec ·D ➔ ★ 21 | = λ rec: PrimRec ·D. 22 | ∀ X: ★. ∀ a: AlgRec ·D ·X. ∀ h: D ➔ X. AlgRecHom ·X a h ➔ 23 | Π x: D. { h x ≃ rec a x } . 24 | 25 | PrfAlgRec ◂ (D ➔ ★) ➔ ★ 26 | = λ P: D ➔ ★. Π xs: F ·(Sigma ·D ·P). P (inD (fmap (proj1 ·D ·P) xs)) . 27 | 28 | fromAlgCase ◂ ∀ X: ★. AlgCase ·F ·D ·X ➔ AlgRec ·D ·X 29 | = Λ X. λ a. λ xs. a (fmap ·(Pair ·D ·X) ·D (λ x. proj1 x) xs) . 30 | 31 | fromAlg ◂ ∀ X: ★. Alg ·F ·X ➔ AlgRec ·D ·X 32 | = Λ X. λ a. λ xs. a (fmap ·(Pair ·D ·X) ·X (λ x. proj2 x) xs) . 33 | -------------------------------------------------------------------------------- /recursive-representation-of-data/everything.ced: -------------------------------------------------------------------------------- 1 | module everything. 2 | 3 | -- utilies 4 | import utils. 5 | 6 | -- recursive types 7 | import cast. 8 | import mono. 9 | import recType. 10 | 11 | -- functors 12 | import functor. 13 | import functorThms. 14 | 15 | -- recursion schemes 16 | import data-char as Char . 17 | 18 | -- derivation of Scott-encoded naturals 19 | import scott/concrete/nat as SN . 20 | 21 | -- generic derivation of Scott-encoded data 22 | import scott as S. 23 | 24 | -- derivation of Parigot-encoded naturals 25 | import parigot/concrete/nat as NP. 26 | 27 | -- generic derivation of Parigot-encoded data 28 | import parigot as P. 29 | 30 | -- examples of generic Parigot encodings 31 | 32 | import parigot/examples/list-data as LP . 33 | import parigot/examples/list as LP . 34 | import parigot/examples/rosetree-data as RTP . 35 | 36 | -- Lepigre-Raffalli naturals 37 | import lepigre-raffalli/concrete/nat1 as LRN1 . 38 | import lepigre-raffalli/concrete/nat2 as LRN2 . 39 | 40 | -- generic Lepigre-Raffalli encoding 41 | import lepigre-raffalli as LR. 42 | 43 | -- monotone type schemes strictly contain functorial type schemes 44 | import signatures/itree . 45 | -------------------------------------------------------------------------------- /recursive-representation-of-data/functor.ced: -------------------------------------------------------------------------------- 1 | module functor (F : ★ ➔ ★). 2 | 3 | Fmap ◂ ★ = ∀ X: ★. ∀ Y: ★. (X ➔ Y) ➔ (F ·X ➔ F ·Y). 4 | 5 | FmapId ◂ Fmap ➔ ★ = λ fmap: Fmap. 6 | ∀ X: ★. ∀ Y: ★. Π c: X ➔ Y. (Π x: X. {c x ≃ x}) ➔ Π x: F ·X . {fmap c x ≃ x}. 7 | 8 | FmapCompose ◂ Fmap ➔ ★ = λ fmap: Fmap. 9 | ∀ X: ★. ∀ Y: ★. ∀ Z: ★. Π f: Y ➔ Z. Π g: X ➔ Y. Π x: F ·X. 10 | {fmap f (fmap g x) ≃ fmap (λ x. f (g x)) x}. 11 | -------------------------------------------------------------------------------- /recursive-representation-of-data/functorThms.ced: -------------------------------------------------------------------------------- 1 | import functor. 2 | 3 | module functorThms (F: ★ ➔ ★) (fmap: Fmap ·F) 4 | {fmapId: FmapId ·F fmap} {fmapCompose: FmapCompose ·F fmap}. 5 | 6 | import cast . 7 | import mono . 8 | 9 | monoFunctor ◂ Mono ·F 10 | = Λ X. Λ Y. λ c. 11 | intrCast 12 | -(λ d. fmap (elimCast -c) d) 13 | -(λ d. fmapId (elimCast -c) (λ x. β) d). 14 | 15 | import utils. 16 | 17 | fmapFstPair ◂ ∀ A: ★. ∀ B: ★. Π f: A ➔ B. Π xs: F ·A. 18 | {fmap fst (fmap (λ x. mkpair x (f x)) xs) ≃ xs} 19 | = Λ A. Λ B. λ f. λ xs. 20 | ρ+ (fmapCompose (fst ·A ·B) (λ x: A. mkpair x (f x)) xs) - 21 | ρ+ (fmapId (λ x: A. x) (λ x. β) xs) - 22 | β. 23 | 24 | fmapSndPair ◂ ∀ A: ★. ∀ B: ★. Π f: A ➔ B. Π xs: F ·A. 25 | {fmap snd (fmap (λ x. mkpair x (f x)) xs) ≃ fmap f xs} 26 | = Λ A. Λ B. λ f. λ xs. 27 | ρ+ (fmapCompose (snd ·A ·B) (λ x: A. mkpair x (f x)) xs) - 28 | β. 29 | -------------------------------------------------------------------------------- /recursive-representation-of-data/inftreeFunctor.ced: -------------------------------------------------------------------------------- 1 | module inftreeFunctor. 2 | 3 | import functor. 4 | import cast. 5 | import utils. 6 | 7 | import parigot/concrete/nat. 8 | 9 | InftreeF ◂ ★ ➔ ★ = λ X : ★ . Sum · Unit · (Nat ➔ X) . 10 | 11 | inftreeFmap ◂ Fmap ·InftreeF = 12 | Λ X . Λ Y . λ f . λ d . 13 | recSum d (λ u . in1 u) (λ x . in2 (λ n . f (x n))). 14 | 15 | inftreeFmapId ◂ FmapId ·InftreeF inftreeFmap = 16 | Λ X . Λ Y . λ c . λ ci . λ x . 17 | θ (indSum x) (λ a . β) 18 | (λ b . ε ●). 19 | 20 | inftreeFmapIdAbsurd ◂ FmapId ·InftreeF inftreeFmap ➔ ∀ X: ★. X 21 | = λ fid. 22 | [t1 ◂ InftreeF ·Nat = in2 (λ x. x)] 23 | - [t2 ◂ InftreeF ·Nat = inftreeFmap ·Nat ·Nat (λ n. (unrollNat n).1 zero (λ _. suc)) t1] 24 | - [pf ◂ { t2 ≃ t1 } 25 | = fid ·Nat ·Nat (λ n. (unrollNat n).1 zero (λ _. suc)) (λ n. (unrollNat n).2) t1] 26 | - δ - pf . 27 | 28 | InftreeFmapMono ◂ ∀ X : ★ . ∀ Y : ★ . Cast · X · Y ➾ Cast · (InftreeF · X) · (InftreeF · Y) = 29 | Λ X . Λ Y . Λ c . 30 | intrCast 31 | -(λ x . recSum x (λ a . in1 a) (λ b . in2 (λ n . elimCast -c (b n)))) 32 | -(λ x . θ (indSum x) (λ a . β) (λ b . β)) . 33 | 34 | 35 | InftreeFmapCompose ◂ FmapCompose · InftreeF inftreeFmap = 36 | Λ X . Λ Y . Λ Z . λ f . λ g . λ x . 37 | θ (indSum x) (λ _ . β) (λ b . β). 38 | -------------------------------------------------------------------------------- /recursive-representation-of-data/lepigre-raffalli.ced: -------------------------------------------------------------------------------- 1 | import functor. 2 | import mono . 3 | 4 | module lepigre-raffalli 5 | (F: ★ ➔ ★) {mono : Mono ·F} 6 | (fmap: Fmap ·F) {fmapId: FmapId ·F fmap} {fmapCompose: FmapCompose ·F fmap} . 7 | 8 | import public lepigre-raffalli/generic/encoding ·F -mono . 9 | import public lepigre-raffalli/generic/induction ·F fmap -fmapId -fmapCompose . 10 | import public lepigre-raffalli/generic/props ·F fmap -fmapId -fmapCompose . 11 | -------------------------------------------------------------------------------- /recursive-representation-of-data/lepigre-raffalli/concrete/nat1.ced: -------------------------------------------------------------------------------- 1 | import cast. 2 | import mono. 3 | import recType. 4 | 5 | import scott/concrete/nat as S . 6 | 7 | module lepigre-raffalli/concrete/nat1 . 8 | 9 | NatRec ◂ ★ ➔ ★ ➔ ★ ➔ ★ 10 | = λ X: ★. λ Z: ★. λ S: ★. Z ➔ S ➔ Z ➔ S ➔ X . 11 | 12 | NatZ ◂ ★ ➔ ★ 13 | = λ X: ★. ∀ Z: ★. ∀ S: ★. Z ➔ S ➔ X . 14 | 15 | NatS ◂ ★ ➔ ★ 16 | = λ X: ★. ∀ Z: ★. ∀ S: ★. NatRec ·X ·Z ·S ➔ Z ➔ S ➔ X . 17 | 18 | Nat ◂ ★ = ∀ X: ★. NatRec ·X ·(NatZ ·X) ·(NatS ·X) . 19 | 20 | recLRNat ◂ ∀ X: ★. NatZ ·X ➔ NatS ·X ➔ Nat ➔ NatZ ·X ➔ NatS ·X ➔ X 21 | = Λ X. λ z. λ s. λ n. n z s . 22 | 23 | _ ◂ { recLRNat ≃ S.caseNat } = β . 24 | 25 | zero ◂ Nat 26 | = Λ X. λ z. λ s. z ·(NatZ ·X) ·(NatS ·X) . 27 | 28 | suc ◂ Nat ➔ Nat 29 | = λ n. Λ X. λ z. λ s. 30 | s ·(NatZ ·X) ·(NatS ·X) (λ z'. λ s'. recLRNat z' s' n) . 31 | 32 | _ ◂ { zero ≃ S.zero } = β . 33 | _ ◂ { suc ≃ S.suc } = β . 34 | 35 | rollNat ◂ Cast ·(S.NatFI ·Nat) ·Nat 36 | = intrCast 37 | -(λ n. n.1 zero suc) 38 | -(λ n. n.2 ·(λ x: S.NatF ·Nat. { x zero suc ≃ x }) β (λ m. β)) . 39 | 40 | toNat ◂ Cast ·S.Nat ·Nat 41 | = recLB -rollNat . 42 | 43 | recNatZ ◂ ∀ X: ★. X ➔ NatZ ·(S.Nat ➔ X) 44 | = Λ X. λ x. Λ Z. Λ S. λ z. λ s. λ m. x . 45 | 46 | recNatS ◂ ∀ X: ★. (S.Nat ➔ X ➔ X) ➔ NatS ·(S.Nat ➔ X) 47 | = Λ X. λ f. Λ Z. Λ S. λ r. λ z. λ s. λ m. 48 | f m (r z s z s (S.pred m)) . 49 | 50 | recNat ◂ ∀ X: ★. X ➔ (S.Nat ➔ X ➔ X) ➔ S.Nat ➔ X 51 | = Λ X. λ x. λ f. λ n. 52 | recLRNat ·(S.Nat ➔ X) (recNatZ x) (recNatS f) 53 | (elimCast -toNat n) 54 | (recNatZ x) (recNatS f) (S.pred n) . 55 | 56 | recNatBeta1 57 | ◂ ∀ X: ★. ∀ x: X. ∀ f: S.Nat ➔ X ➔ X. 58 | { recNat x f S.zero ≃ x } 59 | = Λ X. Λ x. Λ f. β . 60 | 61 | recNatBeta2 62 | ◂ ∀ X: ★. ∀ x: X. ∀ f: S.Nat ➔ X ➔ X. ∀ n: S.Nat. 63 | { recNat x f (S.suc n) ≃ f n (recNat x f n) } 64 | = Λ X. Λ x. Λ f. Λ n. β . 65 | -------------------------------------------------------------------------------- /recursive-representation-of-data/lepigre-raffalli/examples/itree.ced: -------------------------------------------------------------------------------- 1 | module lepigre-raffalli/examples/itree . 2 | 3 | import signatures/itree . 4 | import scott/generic/encoding as S ·ITreeF -monoITreeF . 5 | import lepigre-raffalli/generic/encoding ·ITreeF -monoITreeF . 6 | import scott/concrete/nat . 7 | 8 | import utils . 9 | 10 | ITree ◂ ★ = S.D . 11 | 12 | leaf ◂ ITree 13 | = S.inD (in1 unit) . 14 | 15 | node ◂ (Nat ➔ ITree) ➔ ITree 16 | = λ f. S.inD (in2 f) . 17 | 18 | indITree ◂ ∀ P: ITree ➔ ★. P leaf ➔ (Π f: Nat ➔ ITree. (Π n: Nat. P (f n)) ➔ P (node f)) ➔ Π x: ITree. P x 19 | = Λ P. λ l. λ n. λ x. 20 | [a ◂ PrfAlgLR ·P 21 | = Λ Y. λ xs. λ y. 22 | indSum xs ·(λ x: ITreeF ·(ι x1: ITree. DRec ·P x1 ·Y). P (inDRec x)) 23 | (λ u. ρ (etaUnit u) - l) 24 | (λ f. n (λ n. (f n).1) (λ n. (f n).2 y y))] 25 | - indLRD ·P a x a 26 | . 27 | 28 | recITree ◂ ∀ X: ★. X ➔ ((Nat ➔ ITree) ➔ (Nat ➔ X) ➔ X) ➔ ITree ➔ X 29 | = Λ X. indITree ·(λ x: ITree. X) . 30 | 31 | recITreeBeta1 32 | ◂ ∀ X: ★. ∀ l: X. ∀ n: (Nat ➔ ITree) ➔ (Nat ➔ X) ➔ X. 33 | { recITree l n leaf ≃ l } 34 | = Λ X. Λ l. Λ n. β . 35 | 36 | recITreeBeta2 37 | ◂ ∀ X: ★. ∀ l: X. ∀ n: (Nat ➔ ITree) ➔ (Nat ➔ X) ➔ X. ∀ f: Nat ➔ ITree. 38 | { recITree l n (node f) ≃ n f (λ m. recITree l n (f m)) } 39 | = Λ X. Λ l. Λ n. Λ f. β . 40 | -------------------------------------------------------------------------------- /recursive-representation-of-data/lepigre-raffalli/examples/list.ced: -------------------------------------------------------------------------------- 1 | import utils. 2 | 3 | module scott-rec/examples/list (A: ★). 4 | 5 | import scott/encoding as S 6 | ·(ListF ·A) (ListFmap ·A) -(ListFmapId ·A) -(ListFmapCompose ·A). 7 | import scott-rec/induction as SI 8 | ·(ListF ·A) (ListFmap ·A) -(ListFmapId ·A) -(ListFmapCompose ·A). 9 | 10 | List ◂ ★ = S.S. 11 | nil ◂ List = S.in (in1 unit). 12 | cons ◂ A ➔ List ➔ List 13 | = λ hd. λ tl. S.in (in2 (mkpair hd tl)). 14 | 15 | indList ◂ ∀ Q: List ➔ ★. Q nil ➔ 16 | (Π hd: A. Π tl: List. Q tl ➔ Q (cons hd tl)) ➔ Π l: List. Q l 17 | = Λ Q. λ n. λ c. 18 | SI.induction ·Q 19 | (λ xs. 20 | θ (indSum xs) 21 | (λ u. ρ (etaUnit u) - n) 22 | (λ p. 23 | θ

(indPair p) 24 | (λ hd. λ tl. c hd (proj1 tl) (proj2 tl)))) . 25 | -------------------------------------------------------------------------------- /recursive-representation-of-data/lepigre-raffalli/generic/encoding.ced: -------------------------------------------------------------------------------- 1 | import cast . 2 | import mono . 3 | import recType . 4 | 5 | module scott-rec/generic/encoding 6 | (F: ★ ➔ ★) {mono: Mono ·F} . 7 | 8 | import scott/generic/encoding as S ·F -mono . 9 | 10 | DRec ◂ (S.D ➔ ★) ➔ S.D ➔ ★ ➔ ★ 11 | = λ P: S.D ➔ ★. λ x: S.D. λ Y: ★. Y ➔ Y ➔ P x . 12 | 13 | inDRec ◂ ∀ P: S.D ➔ ★. ∀ Y: ★. F ·(ι x: S.D. DRec ·P x ·Y) ➔ S.D 14 | = Λ P. Λ Y. λ xs. 15 | [c ◂ Cast ·(ι x: S.D. DRec ·P x ·Y) ·S.D 16 | = intrCast -(λ x. x.1) -(λ x. β)] 17 | - S.inD (elimCast -(mono c) xs) . 18 | 19 | PrfAlgLR ◂ (S.D ➔ ★) ➔ ★ 20 | = λ P: S.D ➔ ★. 21 | ∀ Y: ★. Π xs: F ·(ι x: S.D. DRec ·P x ·Y). Y ➔ P (inDRec xs) . 22 | 23 | D ◂ ★ = ι x: S.D. ∀ P: S.D ➔ ★. DRec ·P x ·(PrfAlgLR ·P) . 24 | 25 | recLRD ◂ ∀ P: S.D ➔ ★. PrfAlgLR ·P ➔ Π x: D. PrfAlgLR ·P ➔ P x.1 26 | = Λ P. λ a. λ x. x.2 a . 27 | 28 | fromD ◂ Cast ·D ·S.D 29 | = intrCast -(λ x. x.1) -(λ x. β) . 30 | 31 | instDRec ◂ ∀ P: S.D ➔ ★. Cast ·D ·(ι x: S.D. DRec ·P x ·(PrfAlgLR ·P)) 32 | = Λ P. intrCast -(λ x. [ x.1 , λ a. recLRD a x ]) -(λ x. β) . 33 | 34 | inD ◂ F ·D ➔ D 35 | = λ xs. 36 | [ S.inD (elimCast -(mono fromD) xs) 37 | , Λ P. λ a. 38 | a ·(PrfAlgLR ·P) (elimCast -(mono (instDRec ·P)) xs) ]. 39 | 40 | _ ◂ { inD ≃ S.inD } = β . 41 | 42 | rollD ◂ Cast ·(S.DFI ·D) ·D 43 | = intrCast 44 | -(λ x. x.1 inD) 45 | -(λ x. x.2 ·(λ x: S.DF ·D. { x inD ≃ x }) (λ xs. β)) . 46 | 47 | toD ◂ Cast ·S.D ·D 48 | = recLB -rollD . 49 | 50 | indLRD ◂ ∀ P: S.D ➔ ★. PrfAlgLR ·P ➔ Π x: S.D. PrfAlgLR ·P ➔ P x 51 | = Λ P. λ a. λ x. recLRD a (elimCast -toD x) . 52 | -------------------------------------------------------------------------------- /recursive-representation-of-data/lepigre-raffalli/generic/induction.ced: -------------------------------------------------------------------------------- 1 | import functor . 2 | import cast . 3 | import mono . 4 | import utils . 5 | 6 | module lepigre-raffalli/generic/induction 7 | (F: ★ ➔ ★) (fmap: Fmap ·F) 8 | {fmapId : FmapId ·F fmap} {fmapCompose: FmapCompose ·F fmap} . 9 | 10 | import functorThms ·F fmap -fmapId -fmapCompose . 11 | 12 | import scott/generic/encoding as S ·F -monoFunctor . 13 | import lepigre-raffalli/generic/encoding ·F -monoFunctor . 14 | 15 | import data-char/primrec-typing ·F . 16 | import data-char/primrec ·F fmap -fmapId -fmapCompose ·S.D S.inD . 17 | 18 | applyDRec ◂ ∀ P: S.D ➔ ★. ∀ Y: ★. Y ➔ (ι x: S.D. DRec ·P x ·Y) ➔ Sigma ·S.D ·P 19 | = Λ P. Λ Y. λ y. λ x. mksigma x.1 (x.2 y y) . 20 | 21 | fromPrfAlgRec 22 | ◂ ∀ P: S.D ➔ ★. PrfAlgRec ·P ➔ PrfAlgLR ·P 23 | = Λ P. λ a. Λ Y. λ xs. λ y. 24 | ρ ς (fmapId ·(ι x: S.D. DRec ·P x ·Y) ·S.D 25 | (λ x. proj1 (applyDRec y x)) (λ x. β) xs) 26 | @x.(P (S.inD x)) 27 | - ρ ς (fmapCompose (proj1 ·S.D ·P) (applyDRec ·P y) xs) 28 | @x.(P (S.inD x)) 29 | - a (fmap (applyDRec ·P y) xs) . 30 | 31 | indD ◂ ∀ P: S.D ➔ ★. PrfAlgRec ·P ➔ Π x: S.D. P x 32 | = Λ P. λ a. λ x. 33 | indLRD (fromPrfAlgRec a) x (fromPrfAlgRec a) . 34 | -------------------------------------------------------------------------------- /recursive-representation-of-data/mono.ced: -------------------------------------------------------------------------------- 1 | module mono . 2 | 3 | import cast . 4 | 5 | Mono ◂ (★ ➔ ★) ➔ ★ 6 | = λ F: ★ ➔ ★. ∀ X: ★. ∀ Y: ★. Cast ·X ·Y ➔ Cast ·(F ·X) ·(F ·Y) . 7 | 8 | monoComp ◂ ∀ F: ★ ➔ ★. ∀ G: ★ ➔ ★. Mono ·F ➾ Mono ·G ➾ Mono ·(λ X: ★. F ·(G ·X)) 9 | = Λ F. Λ G. Λ mF. Λ mG. Λ X. Λ Y. λ c. 10 | intrCast 11 | -(elimCast -(mF (mG c))) 12 | -λ _. β . 13 | 14 | import utils/top. 15 | import view . 16 | 17 | monoView ◂ ∀ t: Top. Mono ·(λ T: ★. View ·T t) 18 | = Λ t. Λ X. Λ Y. λ c. 19 | intrCast 20 | -(λ v. ρ (eqView -t -v) @x.(View ·Y β{| x |}) 21 | - intrView ·Y β{| v |} 22 | -(elimCast -c (elimView t -v)) -(eqView -t -v)) 23 | -(λ _. β) . 24 | -------------------------------------------------------------------------------- /recursive-representation-of-data/parigot.ced: -------------------------------------------------------------------------------- 1 | import functor. 2 | 3 | module parigot 4 | (F: ★ ➔ ★) (fmap: Fmap ·F) 5 | {fmapId : FmapId ·F fmap} {fmapCompose: FmapCompose ·F fmap}. 6 | 7 | import public parigot/generic/encoding ·F fmap -fmapId -fmapCompose . 8 | import public parigot/generic/props ·F fmap -fmapId -fmapCompose . 9 | -------------------------------------------------------------------------------- /recursive-representation-of-data/parigot/examples/list-data.ced: -------------------------------------------------------------------------------- 1 | import utils. 2 | 3 | module parigot/examples/list-data (A : ★). 4 | 5 | import signatures/list ·A . 6 | 7 | import parigot/generic/encoding as R 8 | ·ListF listFmap -listFmapId -listFmapCompose . 9 | 10 | List ◂ ★ = R.D . 11 | nil ◂ List = R.inD (in1 unit) . 12 | cons ◂ A ➔ List ➔ List 13 | = λ hd. λ tl. R.inD (in2 (mkpair hd tl)) . 14 | 15 | indList 16 | ◂ ∀ P: List ➔ ★. P nil ➔ (Π hd: A. Π tl: List. P tl ➔ P (cons hd tl)) ➔ 17 | Π xs: List. P xs 18 | = Λ P. λ n. λ c. 19 | R.indD (λ xs. 20 | [in ◂ ListF ·(Sigma ·List ·P) ➔ List 21 | = λ xs. R.inD (listFmap (proj1 ·List ·P) xs)] 22 | - indSum xs ·(λ x: ListF ·(Sigma ·List ·P). P (in x)) 23 | (λ u. ρ (etaUnit u) @y.(P (in (in1 y))) - n) 24 | (λ p. indPair p ·(λ x: Pair ·A ·(Sigma ·List ·P). P (in (in2 x))) 25 | (λ hd. λ tl. c hd (proj1 tl) (proj2 tl)))) . 26 | 27 | recList ◂ ∀ X: ★. X ➔ (A ➔ List ➔ X ➔ X) ➔ List ➔ X 28 | = Λ X. indList ·(λ x: List. X) . 29 | 30 | recListBeta1 31 | ◂ ∀ X: ★. ∀ n: X. ∀ c: A ➔ List ➔ X ➔ X. 32 | { recList n c nil ≃ n} 33 | = Λ X. Λ n. Λ c. β . 34 | 35 | recListBeta2 36 | ◂ ∀ X: ★. ∀ n: X. ∀ c: A ➔ List ➔ X ➔ X. ∀ hd: A. ∀ tl: List. 37 | { recList n c (cons hd tl) ≃ c hd tl (recList n c tl) } 38 | = Λ X. Λ n. Λ c. Λ hd. Λ tl. β . 39 | -------------------------------------------------------------------------------- /recursive-representation-of-data/parigot/examples/list.ced: -------------------------------------------------------------------------------- 1 | import utils . 2 | import functor . 3 | 4 | module parigot/examples/list . 5 | 6 | import parigot/examples/list-data . 7 | 8 | listMap ◂ Fmap ·List 9 | = Λ A. Λ B. λ f. 10 | recList ·A ·(List ·B) 11 | (nil ·B) 12 | (λ hd. λ tl. λ xs. cons (f hd) xs) . 13 | 14 | listMapId ◂ FmapId ·List listMap 15 | = Λ A. Λ B. λ c. λ ci. 16 | indList ·A ·(λ x: List ·A. { listMap c x ≃ x }) 17 | β 18 | (λ hd. λ tl. λ ih. 19 | ρ (ci hd) @x.{ cons x (listMap c tl) ≃ cons hd tl } 20 | - ρ ih @x.{ cons hd x ≃ cons hd tl } 21 | - β) . 22 | 23 | listMapCompose ◂ FmapCompose ·List listMap 24 | = Λ A. Λ B. Λ C. λ f. λ g. 25 | indList ·A 26 | ·(λ x: List ·A. { listMap f (listMap g x) ≃ listMap (λ x. f (g x)) x }) 27 | β 28 | (λ hd. λ tl. λ ih. 29 | ρ ih @x.{ cons (f (g hd)) x ≃ cons (f (g hd)) (listMap (λ x. f (g x)) tl) } 30 | - β). 31 | -------------------------------------------------------------------------------- /recursive-representation-of-data/parigot/examples/rosetree-data.ced: -------------------------------------------------------------------------------- 1 | import utils . 2 | import list-data . 3 | import list . 4 | 5 | module parigot/examples/rosetree-data (A: ★) . 6 | 7 | import signatures/tree ·A ·List listMap -listMapId -listMapCompose . 8 | 9 | import parigot/generic/encoding as R 10 | ·TreeF treeFmap -treeFmapId -treeFmapCompose . 11 | 12 | RoseTree ◂ ★ = R.D . 13 | 14 | rose ◂ A ➔ List ·RoseTree ➔ RoseTree 15 | = λ x. λ t. R.inD (mksigma x t) . 16 | 17 | rose' ◂ ∀ P: RoseTree ➔ ★. TreeF ·(Sigma ·RoseTree ·P) ➔ RoseTree 18 | = Λ P. λ xs. R.inD (treeFmap (proj1 ·RoseTree ·P) xs) . 19 | 20 | indRoseTree 21 | ◂ ∀ P: RoseTree ➔ ★. ∀ Q: List ·RoseTree ➔ ★. 22 | Q (nil ·RoseTree) ➔ 23 | (Π t: RoseTree. P t ➔ Π ts: List ·RoseTree. Q ts ➔ Q (cons t ts)) ➔ 24 | (Π x: A. Π ts: List ·RoseTree. Q ts ➔ P (rose x ts)) ➔ 25 | Π t: RoseTree. P t 26 | = Λ P. Λ Q. λ n. λ c. λ r. 27 | R.indD ·P (λ xs. 28 | indsigma xs ·(λ x: TreeF ·(Sigma ·RoseTree ·P). P (rose' x)) 29 | (λ x. λ ts. 30 | [conv ◂ List ·(Sigma ·RoseTree ·P) ➔ List ·RoseTree 31 | = listMap (proj1 ·RoseTree ·P)] 32 | - [pf ◂ Q (conv ts) 33 | = indList ·(Sigma ·RoseTree ·P) ·(λ x: List ·(Sigma ·RoseTree ·P). Q (conv x)) 34 | n (λ hd. λ tl. λ ih. c (proj1 hd) (proj2 hd) (conv tl) ih) ts] 35 | - r x (conv ts) pf)) . 36 | -------------------------------------------------------------------------------- /recursive-representation-of-data/recType.ced: -------------------------------------------------------------------------------- 1 | module recType (F : ★ ➔ ★) . 2 | 3 | import cast . 4 | import mono . 5 | 6 | Rec ◂ ★ = ∀ X: ★. Cast ·(F ·X) ·X ➾ X. 7 | 8 | recLB ◂ ∀ X: ★. Cast ·(F ·X) ·X ➾ Cast ·Rec ·X 9 | = Λ X. Λ c. intrCast -(λ x. x -c) -(λ _. β) . 10 | 11 | recGLB ◂ ∀ Y: ★. (∀ X: ★. Cast ·(F ·X) ·X ➾ Cast ·Y ·X) ➾ Cast ·Y ·Rec 12 | = Λ Y. Λ u. intrCast -(λ y. Λ X. Λ c. elimCast -(u -c) y) -λ _. β . 13 | 14 | recRoll ◂ Mono ·F ➾ Cast ·(F ·Rec) ·Rec 15 | = Λ mono. 16 | recGLB ·(F ·Rec) 17 | -(Λ X. Λ c. castTrans ·(F ·Rec) ·(F ·X) ·X -(mono (recLB -c)) -c) . 18 | 19 | recUnroll ◂ Mono ·F ➾ Cast ·Rec ·(F ·Rec) 20 | = Λ mono. recLB ·(F ·Rec) -(mono (recRoll -mono)). 21 | 22 | roll ◂ Mono ·F ➾ F ·Rec ➔ Rec 23 | = Λ m. elimCast -(recRoll -m) . 24 | 25 | unroll ◂ Mono ·F ➾ Rec ➔ F ·Rec 26 | = Λ m. elimCast -(recUnroll -m) . 27 | 28 | _ ◂ { roll ≃ λ x. x } = β. 29 | _ ◂ { unroll ≃ λ x. x } = β. 30 | recIso1 ◂ { λ a. roll (unroll a) ≃ λ a. a} = β. 31 | recIso2 ◂ { λ a. unroll (roll a) ≃ λ a. a} = β. 32 | -------------------------------------------------------------------------------- /recursive-representation-of-data/scott.ced: -------------------------------------------------------------------------------- 1 | import mono . 2 | 3 | module scott 4 | (F: ★ ➔ ★) {mono: Mono ·F} . 5 | 6 | import public scott/generic/encoding ·F -mono . 7 | import public scott/generic/props ·F -mono . 8 | -------------------------------------------------------------------------------- /recursive-representation-of-data/scott/generic/encoding.ced: -------------------------------------------------------------------------------- 1 | import mono . 2 | 3 | module scott/encoding (F: ★ ➔ ★) {mono: Mono ·F} . 4 | 5 | import view . 6 | import cast . 7 | import recType . 8 | import utils . 9 | 10 | import data-char/case-typing ·F . 11 | 12 | DF ◂ ★ ➔ ★ = λ D: ★. ∀ X: ★. AlgCase ·D ·X ➔ X . 13 | 14 | inDF ◂ ∀ D: ★. AlgCase ·D ·(DF ·D) 15 | = Λ D. λ xs. Λ X. λ a. a xs . 16 | 17 | monoDF ◂ Mono ·DF 18 | = Λ D1. Λ D2. λ c. 19 | intrCast 20 | -(λ d. Λ X. λ a. d (λ ds. a (elimCast -(mono c) ds))) 21 | -(λ x. β) . 22 | 23 | WkPrfAlg ◂ Π D: ★. (DF ·D ➔ ★) ➔ ★ 24 | = λ D: ★. λ P: DF ·D ➔ ★. 25 | Π xs: F ·D. P (inDF xs) . 26 | 27 | WkIndDF ◂ Π D: ★. DF ·D ➔ ★ 28 | = λ D: ★. λ x: DF ·D. 29 | ∀ P: DF ·D ➔ ★. WkPrfAlg ·D ·P ➔ P x . 30 | 31 | monoWkIndDF 32 | ◂ ∀ D1: ★. ∀ D2: ★. Π c: Cast ·D1 ·D2. ∀ x: DF ·D1. 33 | Cast ·(WkIndDF ·D1 x) ·(WkIndDF ·D2 (elimCast -(monoDF c) x)) 34 | = Λ D1. Λ D2. λ c. Λ x. 35 | intrCast 36 | -(λ d. Λ P. λ a. 37 | d ·(λ x: DF ·D1. P (elimCast -(monoDF c) x)) 38 | λ ds. a (elimCast -(mono c) ds)) 39 | -(λ x. β) . 40 | 41 | inWkIndDF ◂ ∀ D: ★. WkPrfAlg ·D ·(WkIndDF ·D) 42 | = Λ D. λ xs. Λ P. λ a. a xs . 43 | 44 | _ ◂ { inWkIndDF ≃ inDF } = β . 45 | 46 | DFI ◂ ★ ➔ ★ = λ D: ★. ι x: DF ·D. WkIndDF ·D x . 47 | 48 | monoDFI ◂ Mono ·DFI 49 | = Λ D1. Λ D2. λ c. 50 | intrCast 51 | -(λ x. [ elimCast -(monoDF c) x.1 52 | , elimCast -(monoWkIndDF c -x.1) x.2 ]) 53 | -(λ x. β) . 54 | 55 | D ◂ ★ = Rec ·DFI . 56 | rollD ◂ DFI ·D ➔ D = roll -monoDFI . 57 | unrollD ◂ D ➔ DFI ·D = unroll -monoDFI . 58 | 59 | inD ◂ F ·D ➔ D 60 | = λ xs. rollD [ inDF xs , inWkIndDF xs ] . 61 | 62 | _ ◂ { inD ≃ inDF } = β . 63 | 64 | LiftD ◂ (D ➔ ★) ➔ DF ·D ➔ ★ 65 | = λ P: D ➔ ★. λ x: DF ·D. 66 | ∀ v: View ·D β{| x |}. P (elimView β{| x |} -v) . 67 | 68 | import data-char/case ·F ·D inD . 69 | 70 | wkIndD ◂ ∀ P: D ➔ ★. (Π xs: F ·D. P (inD xs)) ➔ Π x: D. P x 71 | = Λ P. λ a. λ x. 72 | (unrollD x).2 ·(LiftD ·P) 73 | (λ xs. Λ v. a xs) -(selfView x) . 74 | 75 | -------------------------------------------------------------------------------- /recursive-representation-of-data/scott/generic/props.ced: -------------------------------------------------------------------------------- 1 | import cast . 2 | import mono . 3 | import recType . 4 | import utils . 5 | 6 | module scott/generic/props 7 | (F: ★ ➔ ★) {mono: Mono ·F} . 8 | 9 | import data-char/case-typing ·F . 10 | import scott/generic/encoding ·F -mono . 11 | 12 | normD ◂ Cast ·D ·(AlgCase ·D ·D ➔ D) 13 | = intrCast -(λ x. (unrollD x).1 ·D) -(λ x. β) . 14 | 15 | import data-char/case ·F ·D inD . 16 | 17 | caseD ◂ Case ·D 18 | = Λ X. λ a. λ x. (unrollD x).1 a . 19 | 20 | caseDBeta ◂ CaseBeta caseD 21 | = Λ X. Λ a. Λ xs. β . 22 | 23 | caseDEta ◂ CaseEta caseD 24 | = Λ X. Λ a. Λ h. λ hBeta. 25 | wkIndD ·(λ x: D. { h x ≃ caseD a x }) 26 | (λ xs. ρ (hBeta -xs) @x.{ x ≃ a xs } - β) . 27 | 28 | reflectD ◂ Π x: D. { caseD inD x ≃ x } 29 | = λ x. ρ ς (caseDEta ·D -inD -(id ·D) (Λ xs. β) x) @y.{ y ≃ x } - β . 30 | 31 | import data-char/destruct ·F ·D inD . 32 | 33 | outD ◂ Destructor 34 | = caseD (λ xs. xs) . 35 | 36 | lambek1D ◂ Lambek1 outD 37 | = λ xs. β . 38 | 39 | lambek2D ◂ Lambek2 outD 40 | = wkIndD ·(λ x: D. { inD (outD x) ≃ x }) (λ xs. β) . 41 | -------------------------------------------------------------------------------- /recursive-representation-of-data/signatures/itree.ced: -------------------------------------------------------------------------------- 1 | -- A monotone type scheme which is not a functor 2 | 3 | module signatures/itree . 4 | 5 | import functor . 6 | import cast . 7 | import mono . 8 | import utils . 9 | 10 | import scott/concrete/nat . 11 | 12 | ITreeF ◂ ★ ➔ ★ = λ X: ★. Sum ·Unit ·(Nat ➔ X) . 13 | 14 | itreeFmap ◂ Fmap ·ITreeF 15 | = Λ X. Λ Y. λ f. λ t. 16 | indSum t ·(λ _: ITreeF ·X. ITreeF ·Y) 17 | (λ u. in1 u) (λ x. in2 (λ n. f (x n))) . 18 | 19 | monoITreeF ◂ Mono ·ITreeF 20 | = Λ X. Λ Y. λ c. 21 | intrCast 22 | -(itreeFmap (elimCast -c)) 23 | -(λ t. indSum t ·(λ x: ITreeF ·X. { itreeFmap (elimCast -c) x ≃ x }) 24 | (λ u. β) 25 | (λ x. β)) . 26 | 27 | t1 ◂ ITreeF ·Nat 28 | = in2 (λ x. x) . 29 | 30 | t2 ◂ ITreeF ·Nat 31 | = itreeFmap (caseNat zero suc) t1 . 32 | 33 | itreeFmapIdAbsurd ◂ FmapId ·ITreeF itreeFmap ➔ ∀ X: ★. X 34 | = λ fid. Λ X. 35 | [pf ◂ { t2 ≃ t1 } 36 | = fid (caseNat zero suc) reflectNat t1] 37 | - δ - pf . 38 | -------------------------------------------------------------------------------- /recursive-representation-of-data/signatures/list.ced: -------------------------------------------------------------------------------- 1 | module signatures/list (A: ★) . 2 | 3 | import functor . 4 | import utils . 5 | 6 | ListF ◂ ★ ➔ ★ = λ L: ★. Sum ·Unit ·(Pair ·A ·L). 7 | 8 | listFmap ◂ Fmap ·ListF 9 | = Λ X. Λ Y. λ f. λ l. 10 | recSum l 11 | (λ u. in1 u) 12 | (λ p. in2 (recPair p (λ a. λ tl. mkpair a (f tl)))). 13 | 14 | listFmapId ◂ FmapId ·ListF listFmap 15 | = Λ X. Λ Y. λ c. λ ci. λ l. 16 | indSum l ·(λ x: ListF ·X. {listFmap c x ≃ x}) 17 | (λ _. β) 18 | (λ p. θ

(indPair p) (λ a. λ tl. ρ+ (ci tl) - β)). 19 | 20 | listFmapCompose ◂ FmapCompose ·ListF listFmap 21 | = Λ X. Λ Y. Λ Z. λ f. λ g. λ x. 22 | θ (indSum x) 23 | (λ _. β) 24 | (λ p. θ

(indPair p) (λ a. λ tl. β)). 25 | -------------------------------------------------------------------------------- /recursive-representation-of-data/signatures/nat.ced: -------------------------------------------------------------------------------- 1 | module signatures/nat . 2 | 3 | import functor. 4 | import utils . 5 | 6 | NatF ◂ ★ ➔ ★ = λ X: ★ . Sum ·Unit ·X. 7 | 8 | NatFmap ◂ Fmap ·NatF = Λ X. Λ Y. λ f. λ d. 9 | recSum d (λ u . in1 u) (λ x . in2 (f x)). 10 | 11 | NatFmapId ◂ FmapId ·NatF NatFmap = 12 | Λ X. Λ Y. λ c. λ ci. λ x. θ (indSum x) (λ a . β) (λ b . ρ+ (ci b) - β). 13 | 14 | NatFmapCompose ◂ FmapCompose ·NatF NatFmap = 15 | Λ X. Λ Y. Λ Z. λ f. λ g. λ x. θ (indSum x) (λ _ . β) (λ b . β). 16 | 17 | NatFmapExt ◂ FmapExt ·NatF NatFmap = 18 | Λ X. Λ Y. λ f. λ g. λ ext. λ n. θ (indSum n) (λ _. β) (λ b. ρ+ (ext b) - β). 19 | -------------------------------------------------------------------------------- /recursive-representation-of-data/signatures/tree.ced: -------------------------------------------------------------------------------- 1 | import functor . 2 | import utils . 3 | 4 | module signatures/tree 5 | (A: ★) (F: ★ ➔ ★) (fmap: Fmap ·F) 6 | {fmapId: FmapId ·F fmap} {fmapCompose: FmapCompose ·F fmap} . 7 | 8 | TreeF ◂ ★ ➔ ★ 9 | = λ T: ★. Pair ·A ·(F ·T) . 10 | 11 | treeFmap ◂ Fmap ·TreeF 12 | = Λ X. Λ Y. λ f. λ t. 13 | mksigma (proj1 t) (fmap f (proj2 t)) . 14 | 15 | treeFmapId ◂ FmapId ·TreeF treeFmap 16 | = Λ X. Λ Y. λ c. λ ci. λ t. 17 | indsigma t ·(λ x: TreeF ·X. { treeFmap c x ≃ x }) 18 | (λ x. λ xs. 19 | ρ (fmapId c ci xs) 20 | @y.{ mksigma x y ≃ mkpair x xs } 21 | - β) . 22 | 23 | treeFmapCompose ◂ FmapCompose ·TreeF treeFmap 24 | = Λ X. Λ Y. Λ Z. λ f. λ g. λ t. 25 | indsigma t ·(λ x: TreeF ·X. { treeFmap f (treeFmap g x) ≃ treeFmap (λ x. f (g x)) x }) 26 | (λ x. λ xs. 27 | ρ (fmapCompose f g xs) 28 | @y.{ mkpair x y ≃ mkpair x (fmap (λ x. f (g x)) xs) } 29 | - β). 30 | -------------------------------------------------------------------------------- /recursive-representation-of-data/utils.ced: -------------------------------------------------------------------------------- 1 | module utils. 2 | 3 | import public utils/id. 4 | import public utils/sigma. 5 | import public utils/sum. 6 | import public utils/top. 7 | import public utils/unit. 8 | import public utils/wksigma. 9 | import public utils/wrap. 10 | -------------------------------------------------------------------------------- /recursive-representation-of-data/utils/id.ced: -------------------------------------------------------------------------------- 1 | module utils/id . 2 | 3 | id : ∀ X: ★. X ➔ X 4 | = Λ X. λ x. x . 5 | -------------------------------------------------------------------------------- /recursive-representation-of-data/utils/sum.ced: -------------------------------------------------------------------------------- 1 | module Sum. 2 | 3 | cSum ◂ ★ ➔ ★ ➔ ★ = λ A : ★ . λ B : ★ . ∀ X : ★ . (A ➔ X) ➔ (B ➔ X) ➔ X . 4 | cin1 ◂ ∀ A : ★ . ∀ B : ★ . A ➔ cSum · A · B = Λ A . Λ B . λ a . Λ X . λ ca . λ cb . ca a . 5 | cin2 ◂ ∀ A : ★ . ∀ B : ★ . B ➔ cSum · A · B = Λ A . Λ B . λ b . Λ X . λ ca . λ cb . cb b . 6 | 7 | param-Sum ◂ Π A : ★ . Π B : ★ . cSum · A · B ➔ ★ = 8 | λ A : ★ . λ B : ★ . λ x : cSum · A · B . 9 | ∀ X : ★ . ∀ P : X ➔ ★ . ∀ ca : A ➔ X . ∀ cb : B ➔ X . 10 | (Π a : A . P (ca a)) ➔ (Π b : B . P (cb b)) ➔ P (x · X ca cb). 11 | 12 | Sum ◂ ★ ➔ ★ ➔ ★ = λ A : ★ . λ B : ★ . ι x : cSum · A · B . ι _ : {x cin1 cin2 ≃ x} . param-Sum · A · B x . 13 | 14 | in1 ◂ ∀ A : ★ . ∀ B : ★ . A ➔ Sum · A · B 15 | = Λ A . Λ B . λ a . [ cin1 · A · B a , [β{| cin1 a |} , Λ X . Λ P . Λ ca . Λ cb . λ pa . λ pb . pa a ]]. 16 | 17 | in2 ◂ ∀ A : ★ . ∀ B : ★ . B ➔ Sum · A · B = 18 | Λ A . Λ B . λ b . [ cin2 · A · B b , [β{| cin2 b |} , Λ X . Λ P . Λ ca . Λ cb . λ pa . λ pb . pb b ]]. 19 | 20 | indSum ◂ ∀ A : ★ . ∀ B : ★ . Π x : Sum · A · B . 21 | ∀ P : Sum · A · B ➔ ★ . 22 | (Π a : A . P (in1 · A · B a)) ➔ (Π b : B . P (in2 · A · B b)) ➔ 23 | P x = 24 | Λ A . Λ B . λ x . Λ P . λ pa . λ pb . 25 | ρ ς x.2.1 - (x.2.2 · (Sum · A · B) · P -(in1 · A · B) -(in2 · A · B) pa pb) . 26 | 27 | recSum ◂ ∀ A : ★ . ∀ B : ★ . Π x : Sum · A · B . 28 | ∀ X : ★ . (A ➔ X) ➔ (B ➔ X) ➔ X = 29 | Λ A . Λ B . λ x . Λ X . λ pa . λ pb . 30 | x.1 · X pa pb . 31 | 32 | etaSum ◂ ∀ A: ★. ∀ B: ★. Π x: Sum ·A ·B. 33 | { recSum x in1 in2 ≃ x} 34 | = Λ A. Λ B. λ x. θ (indSum x) (λ _. β) (λ _. β). 35 | -------------------------------------------------------------------------------- /recursive-representation-of-data/utils/top.ced: -------------------------------------------------------------------------------- 1 | module utils/top. 2 | 3 | Top ◂ ★ = {λ x. x ≃ λ x. x} . 4 | 5 | -------------------------------------------------------------------------------- /recursive-representation-of-data/utils/unit.ced: -------------------------------------------------------------------------------- 1 | module unit. 2 | 3 | cUnit ◂ ★ = ∀ X : ★. X ➔ X. 4 | 5 | cunit ◂ cUnit = Λ X. λ x. x. 6 | 7 | param-Unit ◂ cUnit ➔ ★ 8 | = λ x : cUnit. ∀ X : ★. 9 | ∀ P : X ➔ ★. ∀ cu : X. P cu ➔ P (x · X cu). 10 | 11 | Unit ◂ ★ = ι x : cUnit. ι _ : {x cunit ≃ x}. param-Unit x. 12 | 13 | unit ◂ Unit = [ cunit , [β{| cunit |} , Λ X. Λ P. Λ cu. λ u. u ]]. 14 | 15 | indUnit ◂ Π x : Unit. ∀ P : Unit ➔ ★. P unit ➔ P x = 16 | λ x. Λ P. λ u. ρ ς x.2.1 - (x.2.2 · Unit · P -unit u). 17 | 18 | etaUnit ◂ Π x : Unit. {x ≃ unit} 19 | = λ x. indUnit x ·(λ x: Unit. {x ≃ unit}) β. 20 | -------------------------------------------------------------------------------- /recursive-representation-of-data/utils/wrap.ced: -------------------------------------------------------------------------------- 1 | module utils/wrap . 2 | 3 | import wksigma . 4 | import top . 5 | 6 | Wrap ◂ ★ ➔ ★ = λ T: ★. WkSigma ·T ·(λ _: T. Top) . 7 | 8 | wrap ◂ ∀ T: ★. T ➔ Wrap ·T 9 | = Λ T. λ x. intrWkSigma x -β . 10 | 11 | unwrap ◂ ∀ T: ★. Wrap ·T ➔ T 12 | = Λ T. λ p. wkproj1 p . 13 | 14 | unwrapEta ◂ ∀ T: ★. ∀ x: Wrap ·T. { wrap (unwrap x) ≃ x } 15 | = Λ T. wkproj1Eta ·T ·(λ _: T. Top) . 16 | 17 | import cast . 18 | import mono . 19 | 20 | monoWrap ◂ Mono ·Wrap 21 | = Λ X. Λ Y. λ c. cast1stWkSigma ·X ·Y ·(λ _: Y. Top) c . 22 | -------------------------------------------------------------------------------- /recursive-representation-of-data/view.ced: -------------------------------------------------------------------------------- 1 | module view . 2 | 3 | import utils/top . 4 | 5 | View ◂ Π T: ★. Top ➔ ★ = λ T: ★. λ t: Top. ι x: T. { x ≃ t } . 6 | 7 | intrView ◂ ∀ T: ★. Π t1: Top. ∀ t2: T. { t2 ≃ t1 } ➾ View ·T t1 8 | = Λ T. λ t1. Λ t2. Λ t. [ φ t - t2 {| t1 |} , β{| t1 |} ] . 9 | 10 | elimView ◂ ∀ T: ★. Π t: Top. View ·T t ➾ T 11 | = Λ T. λ t. Λ v. φ v.2 - v.1 {| t |} . 12 | 13 | eqView ◂ ∀ T: ★. ∀ t: Top. ∀ v: View ·T t. { t ≃ v } 14 | = Λ T. Λ t. Λ v. ρ v.2 @x.{ t ≃ x } - β . 15 | 16 | selfView ◂ ∀ T: ★. Π t: T. View ·T β{| t |} 17 | = Λ T. λ t. intrView β{| t |} -t -β . 18 | 19 | extView ◂ ∀ S: ★. ∀ T: ★. Π t: Top. (Π x: S. View ·T β{|t x|}) ➾ View ·(S ➔ T) t 20 | = Λ S. Λ T. λ t. Λ v. 21 | intrView ·(S ➔ T) t -(λ x. elimView β{| t x |} -(v x)) -β . 22 | --------------------------------------------------------------------------------