├── lean-toolchain ├── Proost ├── Util │ ├── AppSep.lean │ ├── Matches.lean │ ├── Attach.lean │ ├── Misc.lean │ └── Queue.lean ├── Parser.lean ├── Elab.lean ├── Kernel.lean ├── Kernel │ ├── Inductive.lean │ ├── Axioms.lean │ ├── Command.lean │ ├── Axioms │ │ ├── Logic.lean │ │ ├── Exists.lean │ │ ├── Nat.lean │ │ └── Eq.lean │ ├── Whnf.lean │ ├── Error.lean │ ├── ReduceRec.lean │ ├── Term.lean │ ├── Level.lean │ ├── TypeChecker.lean │ └── Core.lean ├── Options.lean ├── TODO ├── Parser │ ├── Syntax.lean │ └── ParseToRaw.lean ├── Elab │ ├── Raw.lean │ └── ToCore.lean └── Legacy-TODO │ └── Nbe.lean ├── tests ├── noAnn.mdln ├── foo.mdln ├── ObsEq_tests.mdln ├── classical.mdln ├── nat.mdln ├── make_test_add.py ├── eq.mdln ├── connectives.mdln ├── test_1000.mdln └── test_2500.mdln ├── proostLean.code-workspace ├── .gitignore ├── Proost.lean ├── GenParentsStructsCoes.lean ├── README.md ├── lakefile.lean ├── Tests.lean └── Main.lean /lean-toolchain: -------------------------------------------------------------------------------- 1 | leanprover/lean4:v4.0.0 -------------------------------------------------------------------------------- /Proost/Util/AppSep.lean: -------------------------------------------------------------------------------- 1 | infixl:min "£" => (· $ ·) -------------------------------------------------------------------------------- /Proost/Parser.lean: -------------------------------------------------------------------------------- 1 | import Proost.Parser.ParseToRaw -------------------------------------------------------------------------------- /tests/noAnn.mdln: -------------------------------------------------------------------------------- 1 | def foo : Nat -> Nat := fun n => n -------------------------------------------------------------------------------- /Proost/Elab.lean: -------------------------------------------------------------------------------- 1 | import Proost.Elab.Raw 2 | import Proost.Elab.ToCore 3 | -------------------------------------------------------------------------------- /tests/foo.mdln: -------------------------------------------------------------------------------- 1 | def foo.{u,v} := Sort v 2 | 3 | def bar.{u} : Sort (u+1) := foo.{0,u} -------------------------------------------------------------------------------- /Proost/Kernel.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Term 2 | import Proost.Kernel.TypeChecker 3 | import Proost.Kernel.Axioms -------------------------------------------------------------------------------- /proostLean.code-workspace: -------------------------------------------------------------------------------- 1 | { 2 | "folders": [ 3 | { 4 | "path": "." 5 | } 6 | ], 7 | "settings": {} 8 | } -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /build 2 | /lean_packages/* 3 | !/lean_packages/manifest.json 4 | perf.data* 5 | __pycache__ 6 | /.lake 7 | lake-manifest.json -------------------------------------------------------------------------------- /Proost.lean: -------------------------------------------------------------------------------- 1 | import Proost.Util.Queue 2 | import Proost.Kernel 3 | import Proost.Parser 4 | import Proost.Elab 5 | import Proost.Options 6 | -------------------------------------------------------------------------------- /Proost/Kernel/Inductive.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Core 2 | 3 | def check_ctor (n : Name) (params : Array Term) (indices : Array Term) (ctorType : Term) : TCEnv Unit := do 4 | sorry 5 | 6 | 7 | -------------------------------------------------------------------------------- /Proost/Options.lean: -------------------------------------------------------------------------------- 1 | structure CallOptions where 2 | debug : List String 3 | --todo add_more options (example : naive reduction vs nbe) 4 | 5 | instance : Inhabited CallOptions where 6 | default := {debug := []} -------------------------------------------------------------------------------- /tests/ObsEq_tests.mdln: -------------------------------------------------------------------------------- 1 | def foo : Eq.{1} Nat zero zero := tt 2 | 3 | def id.{u} (A : Sort u) (x : A) := A 4 | 5 | def id_nat : Nat -> Nat := fun n => n 6 | 7 | def foo2 (n : Nat) : Eq.{1} Nat n n -> Eq.{1} Nat (succ n) (succ n) := 8 | id.{0} (Eq.{1} Nat n n) -------------------------------------------------------------------------------- /Proost/Util/Matches.lean: -------------------------------------------------------------------------------- 1 | syntax term ".matches" ("|" term)+ : term 2 | 3 | macro_rules 4 | | `($te:term .matches | $pat) => 5 | `(if let $pat := $te then true else false) 6 | | `($te:term .matches | $pat $[| $rest]*) => 7 | `(if let $pat := $te then true else $te .matches $[| $rest]*) 8 | -------------------------------------------------------------------------------- /tests/classical.mdln: -------------------------------------------------------------------------------- 1 | def Excluded_middle: Type := (P: Prop) -> Or P (Not P) 2 | 3 | def Double_negation_elimination: Prop := (P : Prop) -> ((Not (Not P)) -> P) 4 | 5 | def Implication_as_or: Prop := (P : Prop) -> (Q : Prop) -> (P -> Q) -> Or (Not P) Q 6 | 7 | def Peirce: Prop := (P : Prop) -> (Q : Prop) -> ((P -> Q) -> P) -> P 8 | -------------------------------------------------------------------------------- /Proost/TODO: -------------------------------------------------------------------------------- 1 | soon-soon 2 | - test, a lot 3 | - profile, optimise 4 | 5 | Soon-ish: 6 | - switch to locally nameless representation in the kernel 7 | - finally finish CCobs somewhere ? 8 | - general inductive types construction 9 | 10 | 11 | Long run : 12 | - pattern-matching + exhaustiveness-check + termination-check 13 | - elaboration 14 | -------------------------------------------------------------------------------- /Proost/Kernel/Axioms.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Axioms.Eq 2 | import Proost.Kernel.Axioms.Logic 3 | import Proost.Kernel.Axioms.Nat 4 | import Std.Data.HashMap 5 | open Std 6 | 7 | def axioms : List Declaration := 8 | [ eq_axioms, 9 | logic_axioms, 10 | nat_axioms 11 | ] |>.join 12 | 13 | def with_initialize_env_axioms : TCEnv α → TCEnv α := 14 | with_add_axioms axioms -------------------------------------------------------------------------------- /GenParentsStructsCoes.lean: -------------------------------------------------------------------------------- 1 | import Lean 2 | 3 | open Lean Meta Elab Term Command 4 | 5 | deriving instance Repr for RecursorRule 6 | 7 | elab "rules" n:ident : term => do 8 | let some (.inductInfo r) ← getConst? n.getId | unreachable! 9 | dbg_trace repr r.isRec 10 | throwAbortTerm 11 | 12 | elab "#rules" n:ident : command => do 13 | let stx ← `(example : True := rules $n) 14 | elabCommand stx 15 | 16 | #rules Eq -------------------------------------------------------------------------------- /tests/nat.mdln: -------------------------------------------------------------------------------- 1 | def iszero := Nat_rec.{1} (fun n: Nat => Prop) True (fun n: Nat, p: Prop => False) 2 | 3 | def add := fun x: Nat => Nat_rec.{1} 4 | (fun a : Nat => Nat) x (fun a n: Nat => succ n) 5 | 6 | def hmm : Eq.{1} Prop (iszero zero) True := refl.{1} Prop True 7 | 8 | def two := succ (succ zero) 9 | 10 | def four := succ (succ (succ (succ zero))) 11 | 12 | def foo : Eq.{1} Nat (add two two) four := refl.{1} Nat four -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Proost 2 | 3 | A reimplementation of the Proost proof-assistant written in Lean 4 4 | 5 | The goal of this project is mainly to both get more familiar with writing functional code in Lean, as well as allowing me to experiment on features that could then be implemented in Proost. 6 | 7 | In it's objective of being as efficient as possible, Proost's implementation has become quite tedious to work with. Implementing things here first allows me to experiment at a faster pace than on the Rust repo. 8 | 9 | -------------------------------------------------------------------------------- /Proost/Util/Attach.lean: -------------------------------------------------------------------------------- 1 | import Std 2 | open Std 3 | 4 | class PMap (T : Type _ → Type _) [∀ α, Membership α (T α)] where 5 | pmap {p : α → Prop} : (∀ a, p a → β) → ∀ l : T α, (∀ a : α, a ∈ l → p a) → T β 6 | 7 | attribute [simp] PMap.pmap 8 | 9 | /--TODO remove to make use of the general attach-/ 10 | def Option.attach {α : Type u_1} (l : Option α) : Option { x // x ∈ l } := 11 | pmap Subtype.mk l fun _ => id 12 | 13 | @[reducible] 14 | def attach [∀ α, Membership α (T α)] [PMap T] {α : Type u_1} (l : T α) : T { x // x ∈ l } := 15 | PMap.pmap Subtype.mk l fun _ => id 16 | 17 | instance : PMap List where 18 | pmap := List.pmap 19 | 20 | instance : PMap Option where 21 | pmap := Option.pmap 22 | -------------------------------------------------------------------------------- /lakefile.lean: -------------------------------------------------------------------------------- 1 | import Lake 2 | open Lake DSL 3 | 4 | package proost 5 | 6 | lean_lib Proost 7 | 8 | @[default_target] 9 | lean_exe proost where 10 | root := `Main 11 | supportInterpreter := true --needed to run the parser 12 | moreLeanArgs := #[ 13 | "-DautoImplicit=false"] 14 | 15 | lean_exe debug where 16 | root := `Main 17 | buildType := .debug 18 | supportInterpreter := true 19 | moreLeanArgs := #[ 20 | "-DautoImplicit=false"] 21 | moreLeancArgs := #["-pg","-O0","-g"] 22 | 23 | 24 | require std from git "https://github.com/leanprover/std4" @ "28459f72f3190b0f540b49ab769745819eeb1c5e" 25 | 26 | require Cli from git "https://github.com/mhuisi/lean4-cli" @ "21dac2e9cc7e3cf7da5800814787b833e680b2fd" 27 | -------------------------------------------------------------------------------- /Tests.lean: -------------------------------------------------------------------------------- 1 | def IotaArr (size : Nat) := Id.run do 2 | let mut arr := Array.mkEmpty size 3 | for i in [0:size] do 4 | arr := arr.push i 5 | arr 6 | 7 | def main : IO Unit := 8 | let arr := IotaArr 100000000 9 | IO.println s!"Hello, {arr[10000]!}!" 10 | 11 | --#eval main 12 | 13 | 14 | /-syntax "open_all" ident : command 15 | 16 | #check elabCommand 17 | 18 | def foo (i : TSyntax `ident) : TSyntax `Lean.Parser.Command.openDecl := 19 | i.getName 20 | 21 | elab "open_all" i:ident : command => do 22 | let env ← getEnv 23 | let name := i.getId 24 | if isStructure env name then 25 | let parents := getParentStructures env name 26 | for parent in parents do 27 | let stx ← `(open $parent) 28 | elabCommand stx 29 | let stx ← `(open $i) 30 | elabCommand stx-/ -------------------------------------------------------------------------------- /tests/make_test_add.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -* 2 | 3 | import os 4 | 5 | dir_path = os.path.dirname(os.path.realpath(__file__)) 6 | 7 | add_def = "def add := fun x: Nat => Nat_rec.{1} (fun a : Nat => Nat) x (fun a n: Nat => Succ n)\n\n" 8 | 9 | def unary(n) : 10 | res = "Zero" 11 | for i in range(n): 12 | res = f"Succ ({res})" 13 | return res 14 | 15 | def def_n(n) : 16 | return f"def n{str(n)} := {unary(n)}\n\n" 17 | 18 | def preuve_eq_double_n(n) : 19 | return f"def p{str(n)} : Eq.{{1}} Nat n{str(2*n)} (add n{str(n)} n{str(n)}) := Refl.{{1}} Nat n{str(2*n)}\n\n" 20 | 21 | def make_file_at_root(n, root) : 22 | file = f"{root}/test_{str(n)}.mdln" 23 | f = open(file, "w") 24 | f.write(add_def) 25 | f.write(def_n(n)) 26 | f.write(def_n(2*n)) 27 | f.write(preuve_eq_double_n(n)) 28 | f.close() 29 | 30 | def make_file(n) : 31 | make_file_at_root(n,dir_path) -------------------------------------------------------------------------------- /tests/eq.mdln: -------------------------------------------------------------------------------- 1 | def ap.{u,v} (A : Type u) (B : Sort v) (f : A -> B ) (x y : A) (e : Eq.{u} A x y): Eq.{v} B (f x) (f y) := 2 | transp.{u} A x (fun t => Eq.{v} B (f x) (f t)) (refl.{v} B (f x)) y e 3 | 4 | def transport.{u,v} (A:Sort u) (P:A -> Sort v) (x y:A) (p: Eq.{u} A x y) (h: P x) : P y := 5 | Eq_rec.{u,v} A x (fun y:A,p:Eq.{u} A x y => P y) h y p 6 | 7 | def transport_id.{u} (A: Sort u) (x: A) := transport.{u, u} A (fun x: A => A) x x (Refl.{u} A x) x 8 | 9 | def cast.{u} (A B : Sort u) (e: Eq.{u+1} (Sort u) A B) (a: A) : B := 10 | transport.{u+1,u} (Sort u) (fun A:Sort u => A) A B e a 11 | 12 | def symm.{u} (A: Sort u) (x y: A) (e: Eq.{u} A x y): Eq.{u} A y x := 13 | Eq_rec.{u, 0} A x (fun y: A, e: Eq.{u} A x y => Eq.{u} A y x) (Refl.{u} A x) y e 14 | 15 | def trans.{u} (A: Sort u) (x y z: A) (e1 : Eq.{u} A x y) (e2: Eq.{u} A y z): Eq.{u} A x z := 16 | Eq_rec.{u, 0} A y (fun x:A, e:Eq.{u} A y x => Eq.{u} A x z) e2 x (symm.{u} A x y e1) 17 | 18 | -------------------------------------------------------------------------------- /Proost/Util/Misc.lean: -------------------------------------------------------------------------------- 1 | --import Std.Data.Option.Basic 2 | 3 | @[specialize] 4 | def List.allM₂ {m : Type → Type u} [Monad m] {α : Type v} {β : Type w} (f : α → β → m Bool) : List α → List β → m Bool 5 | | [],[] => pure true 6 | | a::as,b::bs => do 7 | match (← f a b) with 8 | | true => allM₂ f as bs 9 | | false => pure false 10 | | _,_ => pure false 11 | 12 | --def Option.attach {α : Type _} (l : Option α) : Option { x // x ∈ l } := 13 | -- pmap Subtype.mk l fun _ => id 14 | 15 | def todo! {A : Type _} [Inhabited A] : A := panic! "todo" 16 | 17 | syntax "return" term : term 18 | macro_rules 19 | | `(term| "return" $t:term) => `(term | do return $t) 20 | 21 | def uncurry {A B C}: (A → B → C) → (A × B) → C := 22 | λ f => λ ⟨a,b⟩ => f a b 23 | 24 | def List.toString₂ [ToString α] (pre sep post : String) : List α → String 25 | | [] => s!"{pre}{post}" 26 | | [x] => s!"{pre}{x}{post}" 27 | | x::xs => xs.foldl (s!"{·}{sep} {·}") (s!"{pre}{x}") |> (· ++ post) 28 | 29 | def Array.toString₂ [ToString α] (pre sep post : String) : Array α → String := 30 | List.toString₂ pre sep post ∘ Array.toList 31 | 32 | 33 | -------------------------------------------------------------------------------- /Proost/Kernel/Command.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.TypeChecker 2 | import Proost.Kernel.Core 3 | 4 | 5 | def evalCommand (c : Command) : TCEnv ConstContext := do 6 | match c with 7 | | .def s n_of_univ ty te => do 8 | let typ : Term ← 9 | if let some ty := ty then 10 | te.check ty 11 | pure ty 12 | else te.infer 13 | let decl : DefinitionVal := ⟨⟨s,typ,n_of_univ⟩,te⟩ 14 | add_trace "cmd" s!"adding decl {s} to the env" 15 | return (← read).const_ctx.insert s (.defnDecl decl) 16 | | .axiom s n_of_univ ty => do 17 | ty.is_type 18 | return (← read).const_ctx.insert s (.axiomDecl ⟨s,ty,n_of_univ⟩) 19 | | .check t => do 20 | let ty ← t.infer 21 | add_trace "print" s!"{t} : {ty}" 22 | return (← read).const_ctx 23 | | .eval t => 24 | let t ← t.whnf 25 | add_trace "print" s!"Evaluated term : {t}" 26 | return (← read).const_ctx 27 | 28 | def evalCommands (cs : Commands) : TCEnv ConstContext := do 29 | List.foldlM 30 | (λ u c => do 31 | add_trace "cmd" s!"evaluating command {c} in env {repr u.toArray}" 32 | evalCommand c {const_ctx := u} ) 33 | (← read).const_ctx 34 | cs -------------------------------------------------------------------------------- /Proost/Kernel/Axioms/Logic.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Core 2 | 3 | open Term 4 | 5 | def true_ := const "True" #[] 6 | def false_ := const "False" #[] 7 | 8 | def true : InductiveVal := 9 | { name := "True" 10 | type := prop 11 | numParams := 0 12 | numIndices := 0 13 | all := ["True"] 14 | ctors := ["tt"] 15 | isRec := false 16 | isReflexive := false 17 | isNested := false 18 | } 19 | 20 | def tt : ConstructorVal := 21 | { name := "tt" 22 | type := const "True" #[] 23 | induct := "True" 24 | cidx := 0 25 | numParams := 0 26 | numFields := 0 27 | } 28 | 29 | def false : InductiveVal := 30 | { name := "False" 31 | type := prop 32 | numParams := 0 33 | numIndices := 0 34 | all := ["false"] 35 | ctors := [] 36 | isRec := Bool.false 37 | isReflexive := Bool.false 38 | isNested := Bool.false 39 | } 40 | 41 | def false_rec : RecursorVal := 42 | { name := "False_rec" 43 | type := 44 | prod (sort $ .var 0) 45 | $ prod (const "False" #[]) 46 | $ var 2 47 | all := ["False"] 48 | numParams := 0 49 | numIndices := 0 50 | numMotives := 1 51 | k := .true 52 | numMinors := 0 53 | rules := [] 54 | } 55 | 56 | def logic_axioms : List Declaration := 57 | [true,tt,false,false_rec] 58 | -------------------------------------------------------------------------------- /Proost/Parser/Syntax.lean: -------------------------------------------------------------------------------- 1 | declare_syntax_cat proost_level 2 | 3 | syntax num : proost_level 4 | syntax ident : proost_level 5 | syntax proost_level "+" num : proost_level 6 | syntax "max" proost_level (proost_level)+ : proost_level 7 | syntax "imax" proost_level (proost_level)+ : proost_level 8 | syntax "(" proost_level ")" : proost_level 9 | 10 | 11 | declare_syntax_cat proost_constant 12 | syntax ident (".{" (proost_level),+ "}")? : proost_constant 13 | 14 | declare_syntax_cat proost 15 | syntax:11 proost_constant : proost 16 | syntax:11 "(" proost ")" : proost 17 | syntax:11 "(" proost ":" proost ")" : proost 18 | syntax:11 "fun" (ident* (":" proost)?),* "=>" proost : proost 19 | syntax:11 "(" ident* ":" proost ")" "->" proost : proost 20 | syntax:10 proost:10 "->" proost:9 : proost 21 | syntax:10 proost:10 proost:11 : proost 22 | syntax:11 "Prop" : proost 23 | syntax:11 "Type" (proost_level)? : proost 24 | syntax:11 "Sort" (proost_level)? : proost 25 | 26 | declare_syntax_cat proost_command 27 | syntax "def" ident (".{" (ident),+ "}")? ("("ident+ ":" proost")")* (":" proost)? ":=" proost : proost_command 28 | syntax "axiom" ident (".{" (ident),+ "}")? ":" proost : proost_command 29 | syntax "eval" proost : proost_command 30 | syntax "check" proost : proost_command 31 | 32 | declare_syntax_cat proost_commands 33 | syntax proost_command* : proost_commands 34 | -------------------------------------------------------------------------------- /tests/connectives.mdln: -------------------------------------------------------------------------------- 1 | def And (A B: Prop): Prop := (C: Prop) -> (A -> B -> C) -> C 2 | 3 | def and_intro (A B: Prop): A -> B -> And A B := 4 | fun a: A, b: B, C: Prop, f: A -> B -> C => f a b 5 | 6 | def and_elim_l (A B: Prop): And A B -> A := 7 | fun f: And A B => f A (fun a: A, b: B => a) 8 | 9 | def and_elim_r (A B: Prop) : And A B -> B := 10 | fun f: And A B => f B (fun a: A, b: B => b) 11 | 12 | def and_comm (A B: Prop): (And A B) -> (And B A) := 13 | fun f: (And A B), C: Prop, bac: (B -> A -> C) => f C (fun a:A, b:B => bac b a) 14 | 15 | def Or (A B: Prop): Prop := (C: Prop) -> (A -> C) -> (B -> C) -> C 16 | 17 | def or_intro_l (A B: Prop): A -> Or A B := 18 | fun a: A, C: Prop, fAC: A -> C, fBC: B -> C => fAC a 19 | 20 | def or_intro_r (A B: Prop): B -> Or A B := 21 | fun b: B, C: Prop, fAC: A -> C, fBC: B -> C => fBC b 22 | 23 | def or_comm (A B: Prop): (Or A B) -> Or B A := 24 | (fun orAB: (Or A B), C: Prop, fBC: B -> C, fAC: A -> C => 25 | orAB C fAC fBC) 26 | 27 | def False : Prop := (P : Prop) -> P 28 | 29 | def Not (P: Prop) : Prop := P -> False 30 | 31 | def Iff (P Q: Prop): Prop := And (P -> Q) (Q -> P) 32 | 33 | def iff_intro (P Q: Prop) (PQ: P -> Q) (QP: Q -> P) : Iff P Q := 34 | and_intro (P -> Q) (Q -> P) PQ QP 35 | 36 | def contrapose (A B: Prop): (A -> B) -> (Not B -> Not A) := 37 | fun f: A -> B, nB: (Not B), a: A => nB (f a) 38 | 39 | eval And False False 40 | -------------------------------------------------------------------------------- /Proost/Kernel/Axioms/Exists.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Core 2 | 3 | open Term 4 | 5 | def exists_ := const "Exists" #[] 6 | def fst_ := const "fst" #[] 7 | def snd_ := const "snd" #[] 8 | 9 | def «exists» : AxiomVal := 10 | { name := "Exists" 11 | type := 12 | prod prop 13 | $ prod (prod (var 1) prop) 14 | $ prop 15 | } 16 | 17 | def exists_intro : AxiomVal := 18 | { name := "Exists_intro" 19 | type := 20 | -- (A : Prop) -> (B :A -> Prop) -> (x : A) -> (y : B x) -> Exists A B 21 | prod prop 22 | $ prod (prod (var 1) prop) 23 | $ prod (var 2) 24 | $ prod (app (var 2) (var 1)) 25 | $ mkAppN (const "Exists" #[]) #[var 4, var 3] 26 | } 27 | 28 | -- We favor a negative presentation of the existential since it's easier to define 29 | -- reduction over equality/cast that way 30 | def fst: AxiomVal := 31 | { name := "fst" 32 | type := 33 | -- (A : Prop) -> (B :A -> Prop) -> Exists A B -> A 34 | prod prop 35 | $ prod (prod (var 1) prop) 36 | $ prod (mkAppN (const "Exists" #[]) #[var 2, var 1]) 37 | $ var (3) 38 | } 39 | 40 | def snd: AxiomVal := 41 | { name := "snd" 42 | type := 43 | -- (A : Prop) -> (B :A -> Prop) -> Exists A B -> A 44 | prod prop 45 | $ prod (prod (var 1) prop) 46 | $ prod (mkAppN (const "Exists" #[]) #[var 2, var 1]) 47 | $ app (var 2) (mkAppN (const "fst" #[]) #[var 3, var 2, var 1]) 48 | } -------------------------------------------------------------------------------- /Proost/Kernel/Whnf.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Level 2 | import Proost.Kernel.Core 3 | import Proost.Kernel.Term 4 | import Proost.Kernel.Axioms 5 | import Proost.Kernel.ReduceRec 6 | import Std.Data.HashMap 7 | import Proost.Util.Misc 8 | 9 | open Std 10 | namespace Term 11 | 12 | def with_add_var_to_context (t : Option Term) : TCEnv α → TCEnv α:= 13 | withReader λ con => {con with var_ctx := con.var_ctx|>.push t |>.map (.map $ Term.shift 1 0) } 14 | 15 | def noAnn : Term → Term 16 | | ann t _ => t 17 | | t => t 18 | 19 | def reduce_decl : Term → TCEnv Term 20 | | t@(const s arr) => do 21 | let res := (← read).const_ctx.find? s 22 | if let some $ .defnDecl d := res then 23 | return d.term |>.substitute_univ arr 24 | else 25 | return t 26 | | t => pure t 27 | 28 | @[export proost_whnf] 29 | partial def whnf (t : Term) : TCEnv Term := do 30 | let t ← reduce_decl t 31 | let mut ⟨hd,args⟩ := t.getAppFnArgs 32 | if !args.isEmpty then 33 | let hd₂ ← hd.whnf 34 | let (t₁,t₂) := hd₂.getAppFnArgs 35 | hd := t₁ 36 | args := t₂.append args 37 | let finish := λ () => pure $ mkAppN hd args 38 | match hd with 39 | | abs _ body => 40 | let mut t := body.substitute args[0]! 1 41 | for arg in args[1:] do 42 | t := app t arg 43 | Term.whnf t 44 | | const _ _ => 45 | matchConstAux hd finish fun cinfo lvls => 46 | match cinfo with 47 | | .recursorDecl rec => reduceRec rec lvls args finish Term.whnf 48 | | .inductDecl i => reduceEqCast i.name t 49 | | _ => finish () 50 | | _ => finish () 51 | else 52 | pure t 53 | -------------------------------------------------------------------------------- /Proost/Util/Queue.lean: -------------------------------------------------------------------------------- 1 | inductive Queue (α : Type) := 2 | | nil 3 | | unit : α → Queue α 4 | | two : α → α → Queue α 5 | | more : α → Queue α → α → Queue α 6 | deriving Inhabited, DecidableEq, Repr 7 | 8 | open Queue 9 | 10 | namespace Queue 11 | 12 | instance [Repr α] : ToString $ Queue α := ⟨fun x => reprStr x⟩ 13 | 14 | def length : Queue α → Nat 15 | | nil => 0 16 | | unit _ => 1 17 | | two .. => 2 18 | | more _ m _ => 2+ m.length 19 | 20 | 21 | def head : Queue α → Option α 22 | | nil => none 23 | | unit a => a 24 | | two _ b => b 25 | | more _ _ b => b 26 | 27 | def pop : Queue α → Option (Queue α × α) 28 | | nil => none 29 | | unit a => pure (nil,a) 30 | | two a b => (unit a, b) 31 | | more a q₁ b => do 32 | let (q₂, e) ← pop q₁ 33 | (more a q₂ e,b) 34 | 35 | def push (a : α) : Queue α → Queue α 36 | | nil => unit a 37 | | unit b => two a b 38 | | two b₁ b₂ => more a (unit b₁) b₂ 39 | | more b₁ middle b₂ => more a (push b₁ middle) b₂ 40 | 41 | def push_all (q : Queue α) (arr : Array α) : Queue α := Id.run do 42 | let mut res := q 43 | for i in arr do 44 | res := res.push i 45 | res 46 | 47 | 48 | def ofList : List α → Queue α 49 | | [] => nil 50 | | h::t => push h (ofList t) 51 | 52 | instance : Coe (List α) (Queue α) where 53 | coe := ofList 54 | 55 | def position [DecidableEq α] (x : α) : Queue α → Option Nat 56 | | nil => none 57 | | unit a => if x = a then some 0 else none 58 | | two a b => 59 | if x = a then some 0 else 60 | if x = b then some 1 else 61 | none 62 | | more a middle b => do 63 | if x = a then 64 | some 0 65 | else 66 | if let some res := position x middle then 67 | pure $ res + 1 68 | else 69 | if x = b then 70 | some $ 1 + middle.length 71 | else 72 | none 73 | 74 | end Queue -------------------------------------------------------------------------------- /Main.lean: -------------------------------------------------------------------------------- 1 | import Proost 2 | import Cli 3 | open Cli 4 | 5 | open Lean 6 | 7 | def type_check_file (file : String) (opts : Array String := #[]): IO Unit := do 8 | let code ← timeit "Reading file:" $ IO.FS.readFile ⟨file⟩ 9 | initSearchPath (← Lean.findSysroot) ["build/lib"] 10 | --println! "parsing {file}" 11 | let raw ← timeit "Parsing :" $ parse code 12 | --println! "parsing succeeded !\n Commands produced:\n {raw}" 13 | --println! "elaborating" 14 | let core ← timeit "Elaborating:" $ IO.ofExcept $ raw.toCore 15 | println! "elaboration succeeded !\n Term produced:\n {core}" 16 | timeit "Type-checking :" $ do 17 | let ctx : TCContext := {debug := opts} 18 | let eval_commands := 19 | (with_initialize_env_axioms <| evalCommands core) 20 | ctx 21 | if let .error e := eval_commands then 22 | throw $ IO.Error.userError $ ToString.toString e 23 | else println! s!"Successfully type-checked {file}." 24 | 25 | #eval show IO _ from do 26 | let code ← IO.FS.readFile ⟨"tests/foo.mdln"⟩ 27 | let raw ← parse code 28 | let core ← IO.ofExcept $ raw.toCore 29 | println! core 30 | 31 | def runProostCmd (p : Parsed) : IO UInt32 := do 32 | let args := p.positionalArg! "inputs" |>.as! (Array String) 33 | let flags := Id.run do 34 | let some flags := p.flag? "verbose" | #[] 35 | flags.as! (Array String) 36 | for file in args do 37 | println! s!"checking {file}" 38 | type_check_file file flags 39 | return 0 40 | 41 | def proostCmd : Cmd := `[Cli| 42 | proostCmd VIA runProostCmd; ["0.0.1"] 43 | "TODO Description" 44 | 45 | FLAGS: 46 | v, verbose : Array String; "Add verbose flags" ++ 47 | "flags : all, tc, cmd, print, nbe" 48 | 49 | ARGS: 50 | inputs : Array String; "files to compile" 51 | 52 | -- The EXTENSIONS section denotes features that 53 | -- were added as an external extension to the library. 54 | -- `./Cli/Extensions.lean` provides some commonly useful examples. 55 | EXTENSIONS: 56 | author "arthur-adjedj"; 57 | defaultValues! #[("inputs","#[]")] 58 | ] 59 | 60 | 61 | 62 | 63 | def main (args : List String) : IO UInt32 := do 64 | proostCmd.validate args 65 | -------------------------------------------------------------------------------- /Proost/Kernel/Error.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Term 2 | 3 | inductive Trace := 4 | | Left 5 | | Right 6 | 7 | class Traceable (A) where 8 | apply : A → Array Trace → A 9 | 10 | class TraceableError (A) where 11 | trace_error : A → Trace → A 12 | 13 | inductive TCKind : Type := 14 | | unboundDeBruijnIndex : Nat → List Term → TCKind 15 | | unknownConstant : Name → TCKind 16 | | notASort : Term → TCKind 17 | | notDefEq : Term → Term → TCKind 18 | | wrongArgumentType : Term → Term → TypedTerm → TCKind 19 | --| notAFunction : Value → Value → TCError 20 | -- meant for NBE, which is currently dead 21 | | notAFunction₂ : TypedTerm → Term → TCKind 22 | | unTypedVariable : Nat → VarContext → TCKind 23 | | cannotInfer : Term → TCKind 24 | | wrongNumberOfUniverse : Name → Nat → Nat → TCKind 25 | | alreadyDefined : Name → TCKind 26 | deriving Repr 27 | 28 | instance : ToString TCKind where 29 | toString 30 | | .unboundDeBruijnIndex n con => s!"unbound De Bruijn index {n} in context {con}" 31 | | .unknownConstant c => s!"unknown constant {c}" 32 | | .notASort t => s!"expected a sort, found {t}" 33 | | .notDefEq t₁ t₂ => s!"{t₁} \nand \n{t₂} \nare not definitionally equal" 34 | | .wrongArgumentType f exp (t,ty)=> s!"function {f} expects an argument of type {exp}, received argument {t} of type {ty}" 35 | | .cannotInfer t => s!"cannot infer type of term {t}" 36 | | .alreadyDefined s => s!"{s} is already defined" 37 | | .wrongNumberOfUniverse s n k => s!"wrong number of universes given, {s} expect {n} universes, received {k}" 38 | | .unTypedVariable v ctx => s!"unable to infer the type of variable {v} in context {ctx}" 39 | --| .notAFunction f x => s!"{f} is not a function but was given an argument {x}" 40 | | .notAFunction₂ (f,ty) x => s!"{f} : {ty} is not a function but was given an argument {x}" 41 | 42 | 43 | structure WithTrace (A) where 44 | kind : A 45 | trace : Array Trace 46 | 47 | instance [ToString A] : ToString (WithTrace A) where 48 | toString a := toString a.kind 49 | 50 | abbrev TCError := WithTrace TCKind 51 | 52 | 53 | instance : Coe A (WithTrace A) where 54 | -- Note : Array size initialized at 0, might be better to make it bigger ? 55 | coe := λ k => ⟨k,Array.empty⟩ 56 | 57 | abbrev Result := Except TCError 58 | 59 | instance : TraceableError (Result A) where 60 | trace_error a tr := 61 | a.mapError (λ err => {err with trace := err.trace.push tr}) 62 | -------------------------------------------------------------------------------- /Proost/Kernel/ReduceRec.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Core 2 | import Proost.Kernel.Term 3 | 4 | --The following code is copied from Lean 4 repository, 5 | --because I seriously don't feel like doing recursor reduction myself :) 6 | 7 | private def getFirstCtor (d : Name) : TCEnv (Option Name) := do 8 | let some (.inductDecl { ctors := ctor::_, ..}) ← get_const_decl? d | pure none 9 | return some ctor 10 | 11 | private def mkNullaryCtor (type : Term) (nparams : Nat) : TCEnv (Option Term) := do 12 | match type.getAppFn with 13 | | .const d lvls => 14 | let (some ctor) ← getFirstCtor d | pure none 15 | return mkAppN (.const ctor lvls) (type.getAppArgs.shrink nparams) 16 | | _ => 17 | return none 18 | 19 | 20 | private def getRecRuleFor (recVal : RecursorVal) (major : Term) : Option RecursorRule := 21 | match major.getAppFn with 22 | | .const fn _ => recVal.rules.find? fun r => r.ctor == fn 23 | | _ => none 24 | 25 | private def toCtorWhenK (recVal : RecursorVal) (major : Term) : TCEnv Term := do 26 | let majorType ← infer major 27 | let majorType ← whnf majorType 28 | let majorTypeI := majorType.getAppFn 29 | if !majorTypeI.isConstOf recVal.getInduct then 30 | return major 31 | else do 32 | let (some newCtorApp) ← mkNullaryCtor majorType recVal.numParams | pure major 33 | let newType ← infer newCtorApp 34 | if ← conversion majorType newType then 35 | return newCtorApp 36 | else 37 | return major 38 | 39 | /-- Auxiliary function for reducing recursor applications. -/ 40 | def reduceRec (recVal : RecursorVal) (recLvls : Array Level) (recArgs : Array Term) (failK : Unit → TCEnv α) (successK : Term → TCEnv α) : TCEnv α := 41 | let majorIdx := recVal.getMajorIdx 42 | if h : majorIdx < recArgs.size then do 43 | let major := recArgs.get ⟨majorIdx, h⟩ 44 | let mut major ← whnf major 45 | if recVal.k then 46 | major ← toCtorWhenK recVal major 47 | --major ← toCtorWhenStructure recVal.getInduct major 48 | match getRecRuleFor recVal major with 49 | | some rule => 50 | let majorArgs := major.getAppArgs 51 | if recLvls.size != recVal.levelParamsNum then 52 | failK () 53 | else 54 | let rhs := rule.rhs.substitute_univ recLvls 55 | -- Apply parameters, motives and minor premises from recursor application. 56 | let rhs := mkAppRange rhs 0 (recVal.numParams+recVal.numMotives+recVal.numMinors) recArgs 57 | /- The number of parameters in the constructor is not necessarily 58 | equal to the number of parameters in the recursor when we have 59 | nested inductive types. -/ 60 | let nparams := majorArgs.size - rule.nfields 61 | let rhs := mkAppRange rhs nparams majorArgs.size majorArgs 62 | let rhs := mkAppRange rhs (majorIdx + 1) recArgs.size recArgs 63 | successK rhs 64 | | none => failK () 65 | else 66 | failK () 67 | -------------------------------------------------------------------------------- /Proost/Kernel/Axioms/Nat.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Core 2 | 3 | open Term 4 | 5 | @[match_pattern] 6 | def nat_ := const "Nat" #[] 7 | @[match_pattern] 8 | def zero_ := const "zero" #[] 9 | @[match_pattern] 10 | def succ_ := const "succ" #[] 11 | 12 | @[match_pattern] 13 | def nat_rec_ (l : Level) := const "Nat_rec" #[l] 14 | 15 | def nat : InductiveVal := 16 | { name := "Nat" 17 | type := type 0 18 | numParams := 0 19 | numIndices := 0 20 | all := ["Nat"] 21 | ctors := ["zero","succ"] 22 | isRec := true 23 | isReflexive := false 24 | isNested := False 25 | } 26 | 27 | 28 | def zero : ConstructorVal := 29 | { name := "zero" 30 | type := nat_ 31 | induct := "Nat" 32 | cidx := 0 33 | numParams := 0 34 | numFields := 0 35 | } 36 | 37 | def succ : ConstructorVal := 38 | { name := "succ" 39 | type := prod nat_ nat_ 40 | induct := "Nat" 41 | cidx := 1 42 | numParams := 0 43 | numFields := 1 44 | } 45 | -- ∀ _, 1 zero → (∀ _, 3 1 → 3 (succ 2)) → ∀ _, 4 1 46 | --Nat_rec : (P : Nat → Sort u) -> P 0 -> ((n : Nat) -> P n -> P (succ n)) -> () 47 | def nat_rec : RecursorVal := 48 | { name := "Nat_rec" 49 | type := 50 | prod (prod nat_ (sort $ .var 0)) 51 | $ prod (app (var 1) (const "zero" #[])) 52 | $ prod (prod nat_ (prod (app (var 3) (var 1)) (app (var 4) (app succ_ (var 2))))) 53 | $ prod nat_ 54 | $ app (var 4) (var 1) 55 | all := ["Nat"] 56 | numParams := 0 57 | numIndices := 0 58 | numMotives := 1 59 | numMinors := 2 60 | k := false 61 | rules := [{ 62 | ctor := "zero" 63 | nfields := 0 64 | rhs := 65 | --λ motive zero succ n => zero 66 | .abs none 67 | $ .abs none 68 | $ .abs none 69 | $ var 2 70 | },{ 71 | ctor := "succ" 72 | nfields := 1 73 | rhs := 74 | --λ motive p_zero p_succ n => p_succ n (Nat_rec.{u} motive p_zero p_succ n) 75 | .abs none 76 | $ .abs none 77 | $ .abs none 78 | $ .abs none 79 | $ (var 2) (var 1) (nat_rec_ (.var 0) (var 4) (var 3) (var 2) (var 1)) 80 | } 81 | ] 82 | } 83 | 84 | /-def reduce_nat_rec : Value → Option Value 85 | | .neutral (.ax nat_rec) l::[P,P_zero,P_succ,n] => 86 | match n with 87 | | .neutral (.ax zero) [] => some P_zero 88 | | .neutral (.ax succ) [n] => -/ 89 | partial def reduce_nat_rec (t: Term) : TCEnv (Option Term) := do 90 | let no := pure none 91 | let ⟨hd,arr⟩:= t.getAppFnArgs 92 | let hd@(nat_rec_ _) ← whnf hd | no 93 | let some n := arr[3]? | no 94 | match ← whnf n with 95 | | zero_ => pure arr[1]! 96 | | .app s k => 97 | let .const "succ" _ ← whnf s | no 98 | let p_succ := arr[2]! 99 | let new_rec_args := arr.modify 3 (λ _ => k) 100 | return some $ p_succ k (mkAppN hd new_rec_args) 101 | | _ => no 102 | 103 | 104 | def nat_axioms : List Declaration := 105 | [nat,zero,succ,nat_rec] 106 | -------------------------------------------------------------------------------- /Proost/Elab/Raw.lean: -------------------------------------------------------------------------------- 1 | import Proost.Util.Misc 2 | 3 | inductive RawLevel : Type := 4 | | num : Nat → RawLevel 5 | | var : String → RawLevel 6 | | plus : RawLevel → Nat → RawLevel 7 | | max : RawLevel → RawLevel → RawLevel 8 | | imax : RawLevel → RawLevel → RawLevel 9 | deriving Repr 10 | 11 | def RawLevel.toString : RawLevel → String 12 | | num n => s!"{n}" 13 | | var i => s!"{i}" 14 | | plus l n => s!"{l.toString} + {n}" 15 | | max l1 l2 => s!"max ({l1.toString}) ({l2.toString})" 16 | | imax l1 l2 => s!"imax ({l1.toString}) ({l2.toString})" 17 | 18 | instance : ToString RawLevel := ⟨RawLevel.toString⟩ 19 | 20 | inductive RawTerm : Type := 21 | | prop 22 | | type : Option RawLevel → RawTerm 23 | | sort : Option RawLevel → RawTerm 24 | -- either a var or a const, this will get determined when translating to the core syntax 25 | | varconst : String → Array RawLevel → RawTerm 26 | | lam : String → Option RawTerm → RawTerm → RawTerm 27 | | pi : String → RawTerm → RawTerm → RawTerm 28 | | app : RawTerm → RawTerm → RawTerm 29 | | let : String → Option RawTerm → RawTerm → RawTerm → RawTerm 30 | | ann : RawTerm → RawTerm → RawTerm 31 | deriving Repr, Inhabited 32 | 33 | def RawTerm.toString : RawTerm → String 34 | | prop | sort none => "Prop" 35 | | type none => "Type" 36 | | type (some l) => s!"Type {l}" 37 | | sort (some l) => s!"Sort {l}" 38 | | varconst s #[] => s 39 | | varconst s arr => s ++ Array.toString₂ ".{" "," "}" arr 40 | | lam x none body => s!"λ {x} => {body.toString} " 41 | | lam x (some ty) body => s!"λ {x} : {ty.toString} => {body.toString}" 42 | | pi "_" ty body => s!"{ty.toString} → {body.toString}" 43 | | pi x ty body => s!"({x} : {ty.toString}) → {body.toString}" 44 | | app t1 t2 => s!"({t1.toString}) ({t2.toString})" 45 | | «let» x none t body => s!"let {x} := {t.toString} in {body.toString}" 46 | | «let» x (some ty) t body => s!"let {x}: {ty.toString} := {t.toString} in {body.toString}" 47 | | ann t ty => s!"({t.toString} : {ty.toString})" 48 | 49 | instance : ToString RawTerm := ⟨RawTerm.toString⟩ 50 | 51 | inductive RawCommand : Type := 52 | | def : String → Array String → List (Array String × RawTerm) → Option RawTerm → RawTerm → RawCommand 53 | | axiom : String → Array String → RawTerm → RawCommand 54 | | check : RawTerm → RawCommand 55 | | eval : RawTerm → RawCommand 56 | deriving Repr 57 | 58 | instance : ToString RawCommand where 59 | toString 60 | | .def s _ _todo none t => s!"def {s} := {t}" 61 | | .def s _ _todo (some ty) t => s!"def {s} : {ty} := {t}" 62 | | .axiom s _ ty => s!"axiom {s} : {ty}" 63 | | .check t => s!"check {t}" 64 | | .eval t => s!"eval {t}" 65 | 66 | abbrev RawCommands := List RawCommand 67 | 68 | inductive RawError : Type := 69 | | duplicateUniverseVar : String → RawError 70 | | unboundLevelVar : String → RawError 71 | deriving Repr 72 | 73 | instance : ToString RawError where 74 | toString 75 | | .duplicateUniverseVar s => s!"Error : duplicate universe variable {s}" 76 | | .unboundLevelVar s => s!"Error : unbound universe variable {s}" 77 | -------------------------------------------------------------------------------- /Proost/Kernel/Term.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Level 2 | import Std.Data.HashMap 3 | import Proost.Util.Misc 4 | import Proost.Util.Attach 5 | 6 | open Std 7 | 8 | abbrev Name := String 9 | 10 | inductive Term : Type := 11 | | var : Nat → Term 12 | | sort : Level → Term 13 | | app : Term → Term → Term 14 | | abs : Option Term → Term → Term 15 | | prod : Term → Term → Term 16 | | const : Name → Array Level → Term 17 | | ann : Term → Term → Term 18 | deriving Repr, Inhabited, BEq 19 | 20 | abbrev VarContext := Array $ Option Term 21 | abbrev TypedTerm := Term × Term 22 | 23 | open Term 24 | 25 | def mkAppN : Term → Array Term → Term := fun hd arr => 26 | arr.foldl app hd 27 | 28 | partial def mkAppRangeAux (n : Nat) (args : Array Term) (i : Nat) (e : Term) : Term := 29 | if i < n then mkAppRangeAux n args (i+1) (app e (args.get! i)) else e 30 | 31 | /-- `mkAppRange f i j #[a_1, ..., a_i, ..., a_j, ... ]` ==> the expression `f a_i ... a_{j-1}` -/ 32 | def mkAppRange (f : Term) (i j : Nat) (args : Array Term) : Term := 33 | mkAppRangeAux j args i f 34 | 35 | namespace Term 36 | 37 | def getAppFn : Term → Term 38 | | .app f _ => f.getAppFn 39 | | t => t 40 | 41 | def getAppArgs : Term → Array Term 42 | | .app f arg => f.getAppArgs.push arg 43 | | _ => #[] 44 | 45 | def getAppFnArgs : Term → Term × Array Term 46 | | .app f arg => 47 | let ⟨f,args⟩ := f.getAppFnArgs 48 | ⟨f,args.push arg⟩ 49 | | t => ⟨t,#[]⟩ 50 | 51 | def n_of_univ : Term → Nat 52 | | .var _ => 0 53 | | .abs t₁ t₂ => 54 | let t₁_univ := match t₁ with | some t => t.n_of_univ | none => 0 55 | max t₁_univ t₂.n_of_univ 56 | | .app t₁ t₂ 57 | | .ann t₁ t₂ 58 | | .prod t₁ t₂ => max t₁.n_of_univ t₂.n_of_univ 59 | | .const _ arr => arr.foldl (fun acc l => max acc l.n_of_univ) 0 60 | | .sort l => l.n_of_univ 61 | 62 | def prop : Term := .sort 0 63 | def type (l : Level) : Term := .sort l.succ 64 | 65 | def toString : Term → String 66 | | .var i => s!"{i}" 67 | | .sort l => s!"Sort {l}" 68 | | .app t1 t2 => s!"({t1.toString}) ({t2.toString})" 69 | | .abs (some t1) t2 => s!"λ {t1.toString} => {t2.toString}" 70 | | .abs _ t2 => s!"λ _ => {t2.toString}" 71 | | .prod t1 t2 => s!"Π ({t1.toString}). {t2.toString}" 72 | | .const s #[] => s 73 | | .const s arr => s ++ Array.toString₂ ".{" "," "}" arr 74 | | .ann t ty => s!"({t.toString} : {ty.toString})" 75 | 76 | instance : ToString Term := ⟨Term.toString⟩ 77 | 78 | def substitute_univ (lvl : Array Level) : Term → Term 79 | | sort l => sort $ l.substitute lvl 80 | | var n => var n 81 | | app t₁ t₂ => app (t₁.substitute_univ lvl) (t₂.substitute_univ lvl) 82 | | abs ty body => abs (ty.attach |>.map (λ ⟨e,_⟩ => substitute_univ lvl e)) (body.substitute_univ lvl) 83 | | prod a b => prod (a.substitute_univ lvl) (b.substitute_univ lvl) 84 | | ann t ty => ann (t.substitute_univ lvl) (ty.substitute_univ lvl) 85 | | const s arr => const s $ arr.map (Level.substitute · lvl) 86 | 87 | def shift (offset depth : Nat) : Term → Term 88 | | var n => 89 | let n := if n >= depth then n+offset else n 90 | var n 91 | | app t₁ t₂ => app (t₁.shift offset depth) (t₂.shift offset depth) 92 | | abs ty body => 93 | let ty := ty.attach.map (λ ⟨e,_⟩ => shift offset depth e) 94 | let body := body.shift offset depth.succ 95 | abs ty body 96 | | prod ty body => 97 | let ty := ty.shift offset depth 98 | let body := body.shift offset depth.succ 99 | prod ty body 100 | | ann t ty => ann (t.shift offset depth) (ty.shift offset depth) 101 | | const s l => const s l 102 | | sort l => sort l 103 | 104 | def substitute (self sub : Term) (depth : Nat) : Term := match self with 105 | | var n => match compare n depth with 106 | | .eq => sub.shift depth.pred 1 107 | | .gt => var (n-1) 108 | | .lt => var n 109 | | app t₁ t₂ => app (t₁.substitute sub depth) (t₂.substitute sub depth) 110 | | abs ty body => 111 | let ty := ty.attach.map (λ ⟨e,_⟩ => substitute e sub depth) 112 | let body := body.substitute sub depth.succ 113 | abs ty body 114 | | prod ty body => 115 | let ty := ty.substitute sub depth 116 | let body := body.substitute sub depth.succ 117 | prod ty body 118 | | ann t ty => ann (t.substitute sub depth) (ty.substitute sub depth) 119 | | const s l => const s l 120 | | sort l => sort l 121 | 122 | 123 | def isConstOf : Term → Name → Bool 124 | | const n .., m => n == m 125 | | _, _ => false 126 | -------------------------------------------------------------------------------- /Proost/Elab/ToCore.lean: -------------------------------------------------------------------------------- 1 | import Proost.Elab.Raw 2 | import Proost.Kernel.Level 3 | import Proost.Kernel.Core 4 | import Proost.Kernel.Command 5 | import Proost.Util.AppSep 6 | import Proost.Util.Queue 7 | import Proost.Util.Misc 8 | import Proost.Util.Attach 9 | 10 | import Std.Data.HashMap 11 | 12 | open Std (HashMap) 13 | open PMap 14 | open RawError 15 | 16 | abbrev RawLevelEnv := ReaderT (HashMap String Nat) $ Except $ WithTrace RawError 17 | 18 | def RawLevel.toCore (l : RawLevel) : RawLevelEnv Level := do 19 | match l with 20 | | var s => 21 | let index := (← read) 22 | let some n := index.find? s | throw ↑(unboundLevelVar s) 23 | return .var n 24 | | num n => pure $ OfNat.ofNat n 25 | | plus l n => pure $ .plus (← toCore l) n 26 | | max l₁ l₂ => pure $ .max (← toCore l₁) (← toCore l₂) 27 | | imax l₁ l₂ => pure $ .imax (← toCore l₁) (← toCore l₂) 28 | 29 | structure RawTermCtx where 30 | univs : HashMap String Nat 31 | vars : Queue String 32 | deriving Inhabited 33 | 34 | abbrev RawTermEnv := ReaderT RawTermCtx $ Except $ WithTrace RawError 35 | 36 | instance : MonadLiftT RawLevelEnv RawTermEnv where 37 | monadLift {α} (a : RawLevelEnv α) := do 38 | fun h => liftExcept (a h.univs) 39 | 40 | def RawTerm.toCore (t : RawTerm) : RawTermEnv Term := do 41 | --dbg_trace "elaborating :\n {repr t} \nin env: \n {repr (← get)}" 42 | match t with 43 | | prop | sort none => 44 | return .sort 0 45 | | type none => 46 | return .sort 1 47 | | type (some l) => 48 | let l ← liftExcept $ l.toCore (← read).univs 49 | return .sort (l+1) 50 | | sort (some l) => 51 | let l ← liftExcept $ l.toCore (← read).univs 52 | return .sort l 53 | | ann t ty => 54 | return .ann (← t.toCore) (← ty.toCore) 55 | | app f x => 56 | return .app (← f.toCore) (← x.toCore) 57 | | pi x t ty => 58 | let t ← t.toCore 59 | let ty ← withReader 60 | (λ ctx => {ctx with vars := ctx.vars.push x}) 61 | ty.toCore 62 | return .prod t ty 63 | | lam x ty t => 64 | let ty ← ty.attach |>.mapM (λ ⟨e,_⟩ => RawTerm.toCore e) 65 | let t ← withReader 66 | (λ ctx => {ctx with vars := ctx.vars.push x}) 67 | t.toCore 68 | return .abs ty t 69 | | varconst s #[] => 70 | let some posx := (← read).vars.position s | return .const s #[] 71 | --dbg_trace s!"looking for DB var of {s} in {(← read).vars}, found {posx}" 72 | return .var posx.succ 73 | | varconst s arr => 74 | let arr ← Array.mapM (liftM ∘ RawLevel.toCore) arr 75 | return .const s arr 76 | | «let» x ty t body => 77 | let ty ← ty.attach |>.mapM (λ ⟨e,_⟩ => RawTerm.toCore e) 78 | let t ← t.toCore 79 | let body ← withReader 80 | (λ ctx => {ctx with vars := ctx.vars.push x}) 81 | body.toCore 82 | return .app (.abs ty body) t 83 | 84 | abbrev RawCommandEnv := Except $ WithTrace RawError 85 | 86 | def map_univs (arr : Array String) : Except RawError (HashMap String Nat) := do 87 | let mut map := HashMap.empty 88 | for h in [0:arr.size] do 89 | if let some _ := map.find? arr[h]! then 90 | throw $ .duplicateUniverseVar arr[h]! 91 | else 92 | map := HashMap.insert map arr[h]! h 93 | return map 94 | 95 | 96 | def RawCommand.toCore (t : RawCommand) : RawCommandEnv Command := do 97 | match t with 98 | | .def s l args ty t => 99 | let hm ← match map_univs l with 100 | | .ok hm => pure hm 101 | | .error e => throw ↑e 102 | let (t,ty) := args.foldl 103 | (λ (t,ty) (idents,ity) => 104 | idents.foldr 105 | (λ x (t,ty) => 106 | (RawTerm.lam x (some ity) t, 107 | Option.map (RawTerm.pi x ity ·) ty)) 108 | (t,ty) 109 | ) (t,ty) 110 | 111 | let ty ← Option.mapM (RawTerm.toCore · ⟨hm,default⟩ ) ty 112 | let t ← RawTerm.toCore t ⟨hm,default⟩ 113 | return .def s hm.size ty t 114 | 115 | | .axiom s l ty => 116 | let hm ← match map_univs l with 117 | | .ok hm => pure hm 118 | | .error e => throw ↑e 119 | let ty ← RawTerm.toCore ty ⟨hm,default⟩ 120 | return .axiom s hm.size ty 121 | 122 | | .eval t => 123 | let t ← RawTerm.toCore t default 124 | return .eval t 125 | 126 | | .check t => 127 | let t ← RawTerm.toCore t default 128 | return .check t 129 | 130 | def RawCommands.toCore (t : RawCommands) : RawCommandEnv Commands := 131 | t.mapM RawCommand.toCore 132 | -------------------------------------------------------------------------------- /Proost/Legacy-TODO/Nbe.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Core 2 | import Proost.Kernel.Term 3 | import Proost.Kernel.Axioms 4 | 5 | /- 6 | structure AppClosure (Values : Type): Type where 7 | term : Term 8 | closure : List Values 9 | deriving BEq,Repr 10 | 11 | inductive Neutral : Type := 12 | | var : Nat → Neutral 13 | | fvar : Nat → Neutral 14 | | ax : Axiom → Array Level → Neutral 15 | deriving BEq, Repr 16 | 17 | inductive Value : Type := 18 | | neutral : Neutral → List Value → Value 19 | | sort : Level → Value 20 | | abs : Option Value → AppClosure Value → Value 21 | | prod : Value → AppClosure Value → Value 22 | deriving Inhabited, BEq, Repr 23 | 24 | instance : ToString Value := ⟨reprStr⟩ 25 | 26 | def Value.var (n : Nat) : Value := .neutral (.var n) [] -/ 27 | 28 | 29 | def Int.toNat' : Int → Option Nat 30 | | ofNat n => some n 31 | | negSucc _ => none 32 | 33 | 34 | mutual 35 | 36 | partial def AppClosure.app (closure : AppClosure Value) (arg : Value) : TCEnv Value := 37 | closure.term.eval (arg::closure.closure) 38 | 39 | partial def Term.eval (closure : List Value := []) (x : Term): TCEnv Value := do 40 | add_trace "nbe" s!"Evaluating \n {x}\n in closure \n {closure}" 41 | let res ← match x with 42 | | .ann t _ => t.eval closure 43 | | .sort l => return .sort l 44 | | .app fn arg => do 45 | let fn ← fn.eval closure 46 | let arg ← arg.eval closure 47 | match fn with 48 | | .abs _ closure => closure.app arg 49 | | .neutral ne arr => pure (.neutral ne $ arg::arr) 50 | | _ => throw $ .notAFunction fn arg 51 | | .abs ty body => do 52 | let ty ← 53 | if let some ty := ty.map $ (·.eval closure) 54 | then 55 | let ty ← ty 56 | pure $ some ty 57 | else pure none 58 | let body := AppClosure.mk body closure 59 | return .abs ty body 60 | | .prod ty body => do 61 | let ty ← ty.eval closure 62 | let body := AppClosure.mk body closure 63 | return .prod ty body 64 | | .var x => do 65 | if let some pos := closure.get? (x-1) then 66 | return pos 67 | add_trace "nbe" s!"Unbound index {x} with closure {closure}" 68 | return .neutral (.fvar x) [] 69 | | .const s arr => do 70 | let res := (← read).const_ctx.find? s 71 | match res with 72 | | some (.ax a) => pure $ .neutral (.ax a arr) [] 73 | | some (.de d) => d.term |>.substitute_univ arr |>.eval closure 74 | | none => throw $ .unknownConstant s 75 | add_trace "nbe" s!" {x}\nevaluates to\n {res}" 76 | return res 77 | end 78 | 79 | 80 | 81 | partial def read_back (size : Nat) (x : Value): TCEnv Term := do 82 | add_trace "nbe" s!"Reading back \n {x}\nsize: {size}" 83 | let res ← match x with 84 | | .sort l => pure $ .sort l 85 | | .neutral ne spine => 86 | let ne : Term := match ne with 87 | | .ax a arr => .const a.name arr 88 | | .var x => .var (x+1) 89 | | .fvar x => .var x --FIX IS PROB HERE 90 | List.foldrM (λ x acc => do return .app acc $ (← read_back size x)) 91 | ne spine 92 | | .abs ty closure => do 93 | let ty ← ty.mapM (read_back size) 94 | let body ← closure.app (.var size) >>= read_back (size+1) 95 | pure $ .abs ty body 96 | | .prod ty closure => do 97 | let ty ← read_back size ty 98 | let body ← closure.app (.var size) >>= read_back (size+1) 99 | pure $ .prod ty body 100 | add_trace "nbe" s!"{x}\n reads back to\n {res}" 101 | return res 102 | 103 | def Term.whnf₂ (t : Term): TCEnv Term := do 104 | let v ← t.eval [] 105 | read_back 0 v 106 | 107 | --#eval {debug := ["nbe"]} |> do 108 | -- let And : Term := 109 | -- .abs (some .prop) $ 110 | -- .abs (some .prop) $ 111 | -- .prod .prop $ 112 | -- .prod (.prod (.var 3) $ .prod (.var 3) $ .var 3) $ 113 | -- .var 2 114 | -- let And_ty : Term := .prod .prop 115 | -- $ .prod .prop 116 | -- $ .prop 117 | -- 118 | -- let And_intro : Term := 119 | -- .abs (some .prop) $ 120 | -- .abs (some .prop) $ 121 | -- .abs (some $ .var 2) $ 122 | -- .abs (some $ .var 2) $ 123 | -- .abs (some .prop) $ 124 | -- .abs (some $ .prod (.var 5) $ .prod (.var 5) $ .var 3) $ 125 | -- .app (.app (.var 1) (.var 4)) (.var 3) 126 | -- let And_intro_ty : Term := 127 | -- .prod .prop $ 128 | -- .prod .prop $ 129 | -- .prod (.var 2) $ 130 | -- .prod (.var 2) $ 131 | -- .app (.app And (.var 4)) (.var 3) 132 | -- 133 | -- let And_decl : Decl := ⟨And_ty,0,And⟩ 134 | -- (with_add_def "And" And_decl $ 135 | -- (Term.app And (.var 4)) |>.whnf default) 136 | -- -------------------------------------------------------------------------------- /Proost/Kernel/Level.lean: -------------------------------------------------------------------------------- 1 | import Proost.Util.AppSep 2 | 3 | inductive Level : Type := 4 | | zero : Level 5 | | plus : Level → Nat → Level 6 | | max : Level → Level → Level 7 | | imax : Level → Level → Level 8 | | var : Nat → Level 9 | deriving Repr, DecidableEq, Inhabited 10 | 11 | @[match_pattern] 12 | instance : OfNat Level 0 := ⟨.zero⟩ 13 | 14 | instance : OfNat Level n := ⟨.plus .zero n⟩ 15 | 16 | @[match_pattern,default_instance] 17 | instance : HAdd Level Nat Level := ⟨Level.plus⟩ 18 | 19 | def Level.succ : Level → Level := (· + 1) 20 | 21 | def Level.toNum? : Level → Option Nat 22 | | 0 => some 0 23 | | l + n => l.toNum?.map (· + n) 24 | | max l₁ l₂ => do pure $ Nat.max (← l₁.toNum?) (← l₂.toNum?) 25 | | imax l₁ l₂ => 26 | if let some 0 := l₂.toNum? then some 0 27 | else do pure $ Nat.max (← l₁.toNum?) (← l₂.toNum?) 28 | | var .. => none 29 | 30 | def Level.toString (l : Level): String := 31 | match l with 32 | | 0 => "0" 33 | | l + n => l.toString ++ s!" + {n}" 34 | | var i => "u" ++ ToString.toString i 35 | | max l1 l2 => "max (" ++ l1.toString ++ ") (" ++ l2.toString ++")" 36 | | imax l1 l2 => "imax (" ++ l1.toString ++ ") (" ++ l2.toString ++")" 37 | 38 | instance : ToString Level := ⟨Level.toString⟩ 39 | 40 | inductive State : Type := 41 | | true 42 | | false 43 | | stuck : Nat → State 44 | deriving Inhabited, Repr 45 | 46 | def State.isTrue : State → Bool 47 | | .true => .true 48 | | _ => .false 49 | 50 | namespace Level 51 | 52 | partial def normalize (self: Level) : Level := match self with 53 | | imax u v => 54 | if u = v then u else 55 | match normalize v with 56 | | 0 => 0 57 | | plus _ (_+1) => normalize (u.max v) 58 | | imax _ vw => normalize $ max (u.imax vw) v 59 | | max vv vw => normalize $ max (u.imax vv) $ u.imax vw 60 | | _ => self 61 | | max u v => 62 | if u = v then u else 63 | match u,v with 64 | | 0, _ => v 65 | | _,0 => u 66 | | uu + n₁, vv + n₂ => 67 | let n := min n₁ n₂ 68 | ((uu + (n₁-n)).max (vv + (n₂-n))).plus n 69 | | _,_ => self 70 | | l + 0 => normalize l 71 | | l₁ + n₁ => 72 | if let l₂ + n₂ := normalize l₁ then 73 | l₂ + (n₁+n₂) 74 | else self 75 | | _ => self 76 | 77 | def n_of_univ : Level → Nat 78 | | 0 => 0 79 | | l + _ => l.n_of_univ 80 | | max l₁ l₂ 81 | | imax l₁ l₂ => Max.max l₁.n_of_univ l₂.n_of_univ 82 | | var k => k+1 83 | 84 | def substitute_single (l : Level) (n : Nat) (u : Level): Level := match l with 85 | | 0 => 0 86 | | l + n₂ => plus £ l.substitute_single n u £ n₂ 87 | | max l₁ l₂ => l₁.substitute_single n u |>.max $ l₂.substitute_single n u 88 | | imax l₁ l₂ => l₁.substitute_single n u |>.imax $ l₂.substitute_single n u 89 | | var k => if k=n then u else l 90 | 91 | def substitute (l : Level) (univs : Array Level): Level := match l with 92 | | 0 => 0 93 | | l + n => plus £ l.substitute univs £ n 94 | | max l₁ l₂ => l₁.substitute univs |>.max $ l₂.substitute univs 95 | | imax l₁ l₂ => l₁.substitute univs |>.imax $ l₂.substitute univs 96 | | var k => Id.run do 97 | let some l := univs[k]? | panic! s!"unexpected level variable {k}, univ list is {univs}" 98 | l 99 | 100 | partial def geq_no_subst (lhs rhs : Level) (n : Int) : State := Id.run do 101 | let lhs := normalize lhs 102 | let rhs := normalize rhs 103 | if let 0 := lhs then if n >= 0 then 104 | return .true 105 | if lhs=rhs && n>=0 then 106 | return .true 107 | if let lhs + k := lhs then 108 | return lhs.geq_no_subst rhs (n-k) 109 | if let rhs + k := rhs then 110 | return lhs.geq_no_subst rhs (n+k) 111 | 112 | --max split cases 113 | if let .max l₁ l₂ := rhs then 114 | if (lhs.geq_no_subst l₁ n |>.isTrue) || (lhs.geq_no_subst l₂ n |>.isTrue) then 115 | return .true 116 | if let .max l₁ l₂ := lhs then 117 | if (l₁.geq_no_subst rhs n |>.isTrue) && (l₂.geq_no_subst rhs n |>.isTrue) then 118 | return .true 119 | 120 | -- stuck cases where imaxes couldn't reduce 121 | if let .imax _ $ .var i := lhs then 122 | return .stuck i 123 | if let .imax _ $ .var i := rhs then 124 | return .stuck i 125 | 126 | return .false 127 | 128 | partial def geq (lhs rhs : Level) (n : Int) : Bool := 129 | match lhs.geq_no_subst rhs n with 130 | | .true => true 131 | | .false => false 132 | | .stuck i => 133 | (lhs.substitute_single i 0 |>.geq (rhs.substitute_single i zero) n) && 134 | (lhs.substitute_single i (.var i + 1) |>.geq (rhs.substitute_single i (.var i + 1)) n) 135 | 136 | def is_eq (lhs rhs : Level) : Bool := lhs.geq rhs 0 && rhs.geq lhs 0 137 | 138 | instance : BEq Level := ⟨is_eq⟩ 139 | 140 | end Level 141 | 142 | 143 | -------------------------------------------------------------------------------- /Proost/Parser/ParseToRaw.lean: -------------------------------------------------------------------------------- 1 | import Proost.Parser.Syntax 2 | import Proost.Elab.Raw 3 | import Proost.Util.Misc 4 | import Lean 5 | 6 | open Lean Elab Meta Term 7 | 8 | partial def elabLevel (stx : TSyntax `proost_level) : Except String RawLevel := do 9 | match stx with 10 | 11 | | `(proost_level| ($l)) => elabLevel l 12 | 13 | | `(proost_level| $n:num) => return .num n.getNat 14 | 15 | | `(proost_level| $x:ident) => return .var x.getId.toString 16 | 17 | | `(proost_level| $l + 0) => elabLevel l 18 | 19 | | `(proost_level| $l + $n) => 20 | let l ← elabLevel l 21 | return .plus l n.getNat 22 | 23 | |`(proost_level| max $l₁ $l₂) => 24 | let l₁ ← elabLevel l₁ 25 | let l₂ ← elabLevel l₂ 26 | return .max l₁ l₂ 27 | 28 | |`(proost_level| imax $l₁ $l₂) => 29 | let l₁ ← elabLevel l₁ 30 | let l₂ ← elabLevel l₂ 31 | return .imax l₁ l₂ 32 | 33 | | _ => throw s!"unknown level syntax: {stx}" 34 | 35 | partial def elabProost (stx : TSyntax `proost) : Except String RawTerm := do 36 | match stx with 37 | 38 | | `(proost| Prop) => return .prop 39 | 40 | | `(proost| Type) => return .type none 41 | 42 | | `(proost| Sort) => return .sort none 43 | 44 | | `(proost| Type $l) => return .type (← elabLevel l) 45 | 46 | | `(proost| Sort $l) => return .sort (← elabLevel l) 47 | 48 | | `(proost| ($t)) => elabProost t 49 | 50 | | `(proost| $x:ident $[.{ $l:proost_level ,* }]? ) => 51 | let arr ← 52 | if let some stx := l then 53 | Array.mapM elabLevel stx 54 | else pure Array.empty 55 | return .varconst x.getId.toString arr 56 | 57 | | `(proost| ($t : $ty)) => do 58 | let t ← elabProost t 59 | let ty ← elabProost ty 60 | return .ann t ty 61 | 62 | | `(proost| $t $arg) => do 63 | let t ← elabProost t 64 | let arg ← elabProost arg 65 | return .app t arg 66 | 67 | | `(proost| fun $x:ident $[: $A:proost]? => $B) => do 68 | let A ← A.mapM elabProost 69 | let B ← elabProost B 70 | return .lam x.getId.toString A B 71 | 72 | | `(proost| fun $[$y * $[: $A]?],* => $B) => do 73 | let A ← A.mapM (Option.mapM elabProost) 74 | let mut res ← elabProost B 75 | for i in [1:y.size+1] do 76 | let cur := y.size-i 77 | let ty := A[cur]! 78 | for j in [1:y[cur]!.size+1] do 79 | let sub := y[cur]!.size - j 80 | let x := y[cur]![sub]!.getId.toString 81 | res ← pure $ .lam x ty res 82 | return res 83 | 84 | | `(proost| $A -> $B) => do 85 | let A ← elabProost A 86 | let B ← elabProost B 87 | return .pi "_" A B 88 | 89 | | `(proost| ($x:ident : $A ) -> $B ) => do 90 | let A ← elabProost A 91 | let B ← elabProost B 92 | return .pi x.getId.toString A B 93 | 94 | | `(proost| ($y * : $A ) -> $B) => do 95 | let A ← elabProost A 96 | let B ← elabProost B 97 | y.foldrM (λ x t => return .pi x.getId.toString A t) B 98 | 99 | | _ => throw s!"unknown term syntax: {stx}" 100 | 101 | partial def elabCommand (stx : TSyntax `proost_command) : Except String RawCommand := do 102 | match stx with 103 | | `(proost_command| def $s $[.{ $l:ident ,* }]? $[($args * : $args_ty)]* $[: $ty]? := $t) => 104 | let l := Id.run do 105 | let some l := l | #[] 106 | l.getElems.map (·.getId.toString) 107 | let mut res_args := [] 108 | for i in [:args.size] do 109 | let ty ← elabProost args_ty[i]! 110 | res_args := (args[i]!.map (·.getId.toString),ty)::res_args 111 | let ty ← ty.mapM elabProost 112 | let t ← elabProost t 113 | -- parse arguments 114 | return .def s.getId.toString l res_args ty t 115 | 116 | | `(proost_command| axiom $s $[.{ $l:ident ,* }]? : $ty ) => 117 | let l := Id.run do 118 | let some l := l | #[] 119 | l.getElems.map (·.getId.toString) 120 | let ty ← elabProost ty 121 | return .axiom s.getId.toString l ty 122 | 123 | | `(proost_command| check $t) => 124 | let t ← elabProost t 125 | return .check t 126 | 127 | | `(proost_command| eval $t) => 128 | let t ← elabProost t 129 | return .eval t 130 | 131 | | _ => throw s!"unknown command: {stx}" 132 | 133 | 134 | partial def elabCommands (stx : TSyntax `proost_commands) : Except String RawCommands := do 135 | match stx with 136 | | `(proost_commands| $[$cl]* ) => 137 | let cl := cl 138 | cl.mapM elabCommand |>.map Array.toList 139 | | _ => throw s!"unknown commands syntax: {stx}" 140 | 141 | 142 | def parse (s: String): IO RawCommands := do 143 | let env ← importModules [{ module := `Proost.Parser.ParseToRaw }] {} 144 | IO.ofExcept do elabCommands ⟨← Parser.runParserCategory env `proost_commands s⟩ 145 | -------------------------------------------------------------------------------- /Proost/Kernel/TypeChecker.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Level 2 | import Proost.Kernel.Term 3 | import Proost.Kernel.Whnf 4 | 5 | --import Proost.Kernel.Nbe 6 | import Proost.Util.Misc 7 | 8 | open TCKind 9 | 10 | set_option autoImplicit false 11 | open GetType 12 | 13 | def Term.is_prop_type :Term → TCEnv Bool 14 | | .var i => do 15 | let ty ← get_type i 16 | let ty ← ty.whnf 17 | return ty == Term.prop 18 | | .prod t₁ t₂ => 19 | with_add_var_to_context (some t₁) $ do 20 | t₂.is_prop_type 21 | | .const s arr => do 22 | let ty ← get_type (s,arr) 23 | let ty ← ty.whnf 24 | return ty == Term.prop 25 | | _ => return false 26 | 27 | 28 | inductive relevance := 29 | | relevant 30 | | irrelevant 31 | deriving DecidableEq 32 | 33 | def Term.relevance :Term → TCEnv relevance 34 | | .abs t body => 35 | with_add_var_to_context t $ do 36 | body.relevance 37 | | .var i => do 38 | let ty ← get_type i 39 | let is_prop ← ty.is_prop_type 40 | return if is_prop then .irrelevant else .relevant 41 | | .ann t _ => t.relevance -- ty.is_prop_type ? 42 | | .app f _ => f.relevance 43 | | _ => return .relevant 44 | 45 | 46 | --assumption : `lhs` and `rhs` are well-typed and of the same type 47 | @[export conversion] 48 | partial def Term.conversion (lhs rhs : Term) : TCEnv Bool := do 49 | --dbg_trace s!"checking \n{lhs} = {rhs}\n" 50 | let lhs := lhs.noAnn 51 | let rhs := rhs.noAnn 52 | if lhs == rhs then 53 | return true 54 | let relevance ← lhs.relevance 55 | if relevance == .irrelevant then 56 | return true 57 | let lhs ← lhs.whnf 58 | let rhs ← rhs.whnf 59 | 60 | if lhs == rhs then 61 | return true 62 | --dbg_trace s!"matching \n{lhs} , {rhs}\n" 63 | match lhs,rhs with 64 | | sort l₁, sort l₂ => return l₁.is_eq l₂ 65 | | var i, var j => return i == j 66 | | abs _ t₁, abs _ t₂ => conversion t₁ t₂ 67 | | prod t₁ u₁, prod t₂ u₂ 68 | | app t₁ u₁, app t₂ u₂ => andM (conversion t₁ t₂) ( conversion u₁ u₂) 69 | | const s₁ _, const s₂ _ => return s₁ == s₂ 70 | | _,_ => pure false 71 | 72 | namespace Term 73 | @[export isDefEq] 74 | def isDefEq (lhs rhs : Term) : TCEnv Unit := 75 | unless ← conversion lhs rhs do 76 | throw ↑(notDefEq lhs rhs) 77 | 78 | 79 | def imax (lhs rhs : Term) : TCEnv Term := do 80 | match lhs,rhs with 81 | | sort l₁, sort l₂ => return sort $ l₁.imax l₂ |>.normalize 82 | | sort _,_ => throw ↑(notASort rhs) 83 | | _,_ => throw ↑(notASort lhs) 84 | 85 | mutual 86 | @[export infer] 87 | def infer (t : Term): TCEnv Term := do 88 | add_trace "tc" s!"trying to infer the type of \n{t}\n in var_env {(← read).var_ctx}\n" 89 | let res ← match t with 90 | | ann t ty => do 91 | check t ty 92 | return ty 93 | | sort l => pure $ sort l.succ 94 | | var n => get_type n 95 | | prod t u => do 96 | let univ_t ← (← t.infer).whnf 97 | with_add_var_to_context (some t) $ do 98 | let univ_u ← (← u.infer).whnf 99 | univ_t.imax univ_u 100 | | t@(abs none _) => throw ↑(cannotInfer t) 101 | | abs (some t) u => do 102 | let univ_t ← t.infer 103 | if let sort _ := univ_t then 104 | with_add_var_to_context (some t) $ do 105 | return t.prod $ ← u.infer 106 | else throw ↑(notASort univ_t) 107 | 108 | | app t u => do 109 | let type_t ← (← t.infer).whnf 110 | add_trace "tc" s!"{t} has type {type_t}" 111 | if let prod arg_type cls := type_t then 112 | check u arg_type 113 | pure $ cls.substitute u 1 114 | else throw ↑(notAFunction₂ (t,type_t) u) 115 | | const s arr => get_type (s,arr) 116 | add_trace "tc" s!"inferred \n{t} \n: {res}\n" 117 | return res 118 | 119 | 120 | 121 | def check (t ty : Term): TCEnv Unit := do 122 | add_trace "tc" s!"checking \n{t}\n : {ty}\n in var_env {(← read).var_ctx}\n" 123 | match t,ty with 124 | | .abs none body, .prod a b => do 125 | with_add_var_to_context (some a) $ 126 | check body b 127 | | .abs (some ty) body, .prod a b => do 128 | isDefEq a ty 129 | with_add_var_to_context (some a) $ 130 | check body b 131 | | .app t u, ty => do 132 | let type_t ← infer t 133 | let .prod a b := type_t | throw ↑(notAFunction₂ (t,type_t) u) 134 | check u a 135 | let b := b.substitute u 1 136 | isDefEq b ty 137 | | .const s arr,ty => do isDefEq ty $ ← get_type (s,arr) 138 | | .ann t ty, tty => do 139 | check t ty 140 | isDefEq ty tty 141 | | .sort l₁, .sort l₂ => 142 | unless l₁+1 == l₂ do 143 | throw ↑(notDefEq (.sort (l₁+1)) (.sort l₂)) 144 | | .var n, ty => do 145 | isDefEq ty $ ← get_type n 146 | | t,ty => do 147 | let tty ← infer t 148 | isDefEq ty tty 149 | end 150 | 151 | def is_sort (t :Term): TCEnv Unit := do 152 | let .sort _ := t | throw ↑(notASort t) 153 | return 154 | 155 | def is_type (t : Term): TCEnv Unit := do 156 | let ty ← infer t 157 | is_sort ty 158 | 159 | end Term 160 | 161 | --#eval {debug := ["nbe"]} |> do 162 | -- let And : Term := 163 | -- .abs (some .prop) $ 164 | -- .abs (some .prop) $ 165 | -- .prod .prop $ 166 | -- .prod (.prod (.var 3) $ .prod (.var 3) $ .var 3) $ 167 | -- .var 2 168 | -- let And_ty : Term := .prod .prop 169 | -- $ .prod .prop 170 | -- $ .prop 171 | -- 172 | -- let And_intro : Term := 173 | -- .abs (some .prop) $ 174 | -- .abs (some .prop) $ 175 | -- .abs (some $ .var 2) $ 176 | -- .abs (some $ .var 2) $ 177 | -- .abs (some .prop) $ 178 | -- .abs (some $ .prod (.var 5) $ .prod (.var 5) $ .var 3) $ 179 | -- .app (.app (.var 1) (.var 4)) (.var 3) 180 | -- let And_intro_ty : Term := 181 | -- .prod .prop $ 182 | -- .prod .prop $ 183 | -- .prod (.var 2) $ 184 | -- .prod (.var 2) $ 185 | -- .app (.app And (.var 4)) (.var 3) 186 | -- 187 | -- let And_decl : Decl := ⟨And_ty,0,And⟩ 188 | -- with_add_def "And" And_decl $ 189 | -- Term.app (Term.app (.const "And" #[]) (.var 4)) (.var 3) |>.is_def_eq 190 | -- (.prod .prop $ 191 | -- .prod (.prod (.var 5) $ .prod (.var 5) $ .var 3) $ 192 | -- .var 2) 193 | -- -------------------------------------------------------------------------------- /Proost/Kernel/Axioms/Eq.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Core 2 | import Proost.Kernel.Axioms.Logic 3 | import Proost.Kernel.Axioms.Nat 4 | import Proost.Kernel.Axioms.Exists 5 | import Proost.Kernel.Term 6 | 7 | open Term 8 | @[match_pattern] 9 | def eq_ (l : Level) := const "Eq" #[l] 10 | def refl_ (l : Level) := const "Refl" #[l] 11 | @[match_pattern] 12 | def cast__ (l : Level) := const "cast" #[l] 13 | 14 | def sort_u := sort $ .var 0 15 | 16 | def eq : InductiveVal := 17 | { name := "Eq" 18 | type := prod sort_u $ prod (var 1) $ prod (var 2) prop 19 | all := ["Eq"] 20 | numParams := 2 21 | numIndices := 1 22 | ctors := ["refl"] 23 | isRec := false 24 | isReflexive := false 25 | isNested := false 26 | } 27 | 28 | def refl : ConstructorVal := 29 | { name := "refl" 30 | induct := "Eq" 31 | type := 32 | -- (A : Sort u) -> (x : A) -> Eq.{u} A x x 33 | prod sort_u $ prod (var 1) $ const "Eq" #[.var 0] (var 2) (var 1) (var 1) 34 | cidx := 1 35 | numParams := 2 36 | numFields := 1 37 | } 38 | 39 | def cast_ : AxiomVal := 40 | { 41 | name := "cast" 42 | type := 43 | -- (A B : Sort u) -> Eq.{u+1} (Sort u) A B -> A -> B 44 | prod sort_u 45 | $ prod sort_u 46 | $ prod (const "Eq" #[.succ $ .var 0] (.sort (.var 0)) (var 2) (var 1)) 47 | $ prod (var 3) 48 | $ var 3 49 | } 50 | 51 | def transport : AxiomVal := 52 | { 53 | name := "transp" 54 | type := 55 | -- (A : Type u) -> (t : A) -> (B : A -> Prop) -> B t -> (t' : A) → Eq.{u+1} A t t' -> B t' 56 | prod (type $ .var 0) 57 | $ prod (var 1) 58 | $ prod (prod (var 2) prop) 59 | $ prod ((var 1) (var 3)) 60 | $ prod (var 4) 61 | $ prod (eq_ (.succ $ .succ $ .var 0) (var 5) (var 4) (var 1)) 62 | $ (var 4) (var 2) 63 | } 64 | 65 | def eq_axioms : List Declaration := 66 | [eq,refl,cast_,transport] 67 | 68 | --def eq_rec : AxiomVal := 69 | -- { name := "Eq_rec" 70 | -- type := 71 | -- let sort_u := sort (.var 0) 72 | -- let sort_v := sort (.var 1) 73 | -- -- {α : Sort u_2} → {a : α} → {motive : (a_1 : α) → a = a_1 → Sort u_1} 74 | -- -- → motive a (_ : a = a) → {a_1 : α} → (t : a = a_1) → motive a_1 t 75 | -- prod sort_u 76 | -- $ prod (var 1) 77 | -- $ prod ( 78 | -- prod (var 2) 79 | -- $ prod (eq_ (.var 1) (var 3) (var 2) (var 1)) 80 | -- $ sort_v 81 | -- ) 82 | -- $ prod ( 83 | -- (var 1) (var 2) (refl_ (.var 1) (var 3) (var 2) (var 2)) 84 | -- ) 85 | -- $ prod (var 4) 86 | -- $ prod (eq_ (.var 1) (var 5) (var 4) (var 1)) 87 | -- $ mkAppN (var 4) #[var 2, var 1] 88 | -- } 89 | 90 | 91 | def reduce_eq_prod (d₁ d₂ b₁ b₂ : Term) : TCEnv (Option Term) := do 92 | let s₁@(sort l₁) ← infer d₁ | unreachable! 93 | let s₂@(sort l₂) ← infer b₁ | unreachable! 94 | let rhs := 95 | --(a' : d₂) -> b₁ (cast d₂ d₁ e a')) = b2 a' 96 | prod d₂ 97 | $ eq_ (l₂+1) s₂ (b₁ (cast__ l₁ d₂ d₁ (var 2) (var 1))) (b₂ (var 1)) 98 | return some$ exists_ (eq_ (l₁+1) s₁ d₂ d₁) (abs none rhs) 99 | 100 | --returns true if the heads are definitely different 101 | def hd_different : Term → Term → TCEnv Bool 102 | | const s₁ _, const s₂ _ => pure $ s₁ = s₂ 103 | | prod A _, prod B _ => conversion A B 104 | | sort _, sort _ => pure false 105 | | _,_ => pure true 106 | 107 | def reduce_eq_type (A B : Term): TCEnv (Option Term) := do 108 | if ← conversion A B then 109 | return true_ 110 | let A ← whnf A 111 | let B ← whnf B 112 | if ← hd_different A B then 113 | return false_ 114 | match A, B with 115 | | prod d₁ b₁, prod d₂ b₂ => reduce_eq_prod d₁ d₂ b₁ b₂ 116 | | _,_ => pure none 117 | 118 | def reduce_eq_prop (A B : Term): TCEnv (Option Term) := 119 | --Eq Prop A B => (A -> B ∧ B -> A) 120 | let res := exists_ (prod A B) (abs A (prod B A)) 121 | return some res 122 | 123 | def reduce_eq_sort (l : Level) : Term → Term → TCEnv (Option Term) := 124 | if l.is_eq 0 then 125 | reduce_eq_prop 126 | else 127 | reduce_eq_type 128 | 129 | 130 | /-- Reduces `Eq.{1} Nat self rhs` by checking the whnf of self and rhs as such: 131 | match (self,rhs) with 132 | | 0,0 => True 133 | | S k, S n => Eq.{1} Nat k n 134 | | 0, S _ | S _, 0 => False-/ 135 | def reduce_eq_nat (t₁ t₂ : Term): TCEnv (Option Term) := do 136 | let no := pure none 137 | let t₁ ← whnf t₁ 138 | let t₂ ← whnf t₂ 139 | match t₁,t₂ with 140 | | zero_,zero_ => pure true_ 141 | | .app hd₁ arg₁, .app hd₂ arg₂ => 142 | let .const "succ" _succ_ ← whnf hd₁ | no 143 | let .const "succ" _succ_ ← whnf hd₂ | no 144 | whnf (eq_ 1 nat_ arg₁ arg₂) 145 | | zero_, app hd₁ _ | app hd₁ _,zero_ => 146 | let .const "succ" _succ_ ← whnf hd₁ | no 147 | pure false_ 148 | | _,_ => pure none 149 | 150 | def reduce_eq_fun (A B t₁ t₂ : Term): TCEnv (Option Term) := do 151 | let sort l ← infer B | unreachable! 152 | let x := var 1 153 | let new_eq := eq_ l (B.substitute x 1) (app (t₁.shift 1 0) x) (app (t₂.shift 1 0) x) 154 | return prod A new_eq 155 | 156 | def reduce_eq (t: Term) : TCEnv (Option Term) := do 157 | let no := pure none 158 | let ⟨hd,arr⟩:= t.getAppFnArgs 159 | let (eq_ l) ← whnf hd | no 160 | let some type := arr[0]? | no 161 | let some t₁ := arr[1]? | no 162 | let some t₂ := arr[2]? | no 163 | --equality over Prop terms always reduces to True 164 | if l.is_eq 0 then 165 | return some true_ 166 | let type ← whnf type 167 | let res ← 168 | match type with 169 | | sort l => reduce_eq_sort l t₁ t₂ 170 | | const "Nat" _ => reduce_eq_nat t₁ t₂ 171 | | prod A B => reduce_eq_fun A B t₁ t₂ 172 | | _ => pure none 173 | if let some t := res then 174 | return mkAppN t arr[3:] 175 | else pure none 176 | 177 | def red_cast_nat (e n : Term) : TCEnv (Option Term) := do 178 | let no := pure none 179 | match ← whnf n with 180 | | zero_ => pure zero_ 181 | | app s k => 182 | let .const "succ" _ ← whnf s | no 183 | pure $ succ_ (cast__ 1 nat_ nat_ e k) 184 | | _ => no 185 | 186 | def red_cast_prod (A A' B B' e f : Term) : TCEnv (Option Term) := do 187 | let s₁@(sort l₁) ← infer A | unreachable! 188 | let s₂@(sort l₂) ← infer A' | unreachable! 189 | let lhs_exists := (eq_ (l₁+1) s₁ A' A) 190 | --(e : A' = A) -> (a' : d₂) -> b₁ (cast d₂ d₁ e a')) = b2 a' 191 | let rhs_exists := 192 | prod lhs_exists 193 | $ prod A' 194 | $ eq_ (l₂+1) s₂ (B (cast__ l₁ A' A (var 2) (var 1))) (B' (var 1)) 195 | let a' := var 1 196 | let a := cast__ (l₁+1) s₁ A' A (fst_ lhs_exists rhs_exists e) a' 197 | let res := 198 | abs A' (cast__ (l₂+1) s₂ (B a) (B' a') (snd_ lhs_exists rhs_exists e a') (f a)) 199 | pure res 200 | 201 | def reduce_cast (t: Term) : TCEnv (Option Term) := do 202 | let no := pure none 203 | let ⟨hd,arr⟩:= t.getAppFnArgs 204 | let (cast__ _) ← whnf hd | no 205 | let some ty_origin := arr[0]? | no 206 | let some ty_target := arr[1]? | no 207 | let some e := arr[2]? | no 208 | let some a := arr[3]? | no 209 | let ty_origin ← whnf ty_origin 210 | let ty_target ← whnf ty_target 211 | let res ← 212 | match ty_origin,ty_target with 213 | | nat_,nat_ => red_cast_nat e a 214 | | sort _, sort _ => pure a 215 | | prod d₁ b₁, prod d₂ b₂ => red_cast_prod d₁ d₂ b₁ b₂ e a 216 | | _,_ => pure none 217 | if let some t := res then 218 | return mkAppN t arr[4:] 219 | else pure none 220 | 221 | --def eq_axioms : List AxiomVal := 222 | -- [eq,refl,eq_rec] 223 | -- 224 | -- 225 | --partial def reduce_eq_rec (t: Term) : TCEnv (Option Term) := do 226 | -- let no := pure none 227 | -- let ⟨hd,arr⟩:= t.getAppFnArgs 228 | -- let (.const "Eq_rec" _) ← whnf hd | no 229 | -- let some _eq := arr[5]? | no 230 | -- try 231 | -- let () ← isDefEq arr[2]! arr[4]! 232 | -- return some (arr[3]!) 233 | -- catch e => throw e 234 | -- 235 | -- 236 | 237 | def reduceEqCast (n : Name) (t : Term) : TCEnv Term := do 238 | if n = "Eq" then 239 | let some t ← reduce_eq t | pure t 240 | pure t 241 | else if n = "cast" then 242 | let some t ← reduce_cast t | pure t 243 | pure t 244 | else pure t -------------------------------------------------------------------------------- /Proost/Kernel/Core.lean: -------------------------------------------------------------------------------- 1 | import Proost.Kernel.Level 2 | import Std.Data.HashMap 3 | import Proost.Util.Misc 4 | import Proost.Kernel.Term 5 | import Proost.Kernel.Error 6 | 7 | open Std 8 | 9 | structure ConstantVal where 10 | name : Name 11 | type : Term 12 | levelParamsNum : Nat := type.n_of_univ 13 | deriving Repr, Inhabited 14 | 15 | abbrev AxiomVal := ConstantVal 16 | 17 | structure DefinitionVal extends ConstantVal where 18 | term : Term 19 | deriving Repr 20 | 21 | 22 | structure ConstructorVal extends ConstantVal where 23 | /-- Inductive type this constructor is a member of -/ 24 | induct : Name 25 | /-- Constructor index (i.e., Position in the inductive declaration) -/ 26 | cidx : Nat 27 | /-- Number of parameters in inductive datatype. -/ 28 | numParams : Nat 29 | /-- Number of fields (i.e., arity - nparams) -/ 30 | numFields : Nat 31 | deriving Inhabited 32 | 33 | 34 | structure InductiveVal extends ConstantVal where 35 | /-- Number of parameters. A parameter is an argument to the defined type that is fixed over constructors. 36 | An example of this is the `α : Type` argument in the vector constructors 37 | `nil : Vector α 0` and `cons : α → Vector α n → Vector α (n+1)`. 38 | 39 | The intuition is that the inductive type must exhibit _parametric polymorphism_ over the inductive 40 | parameter, as opposed to _ad-hoc polymorphism_. 41 | -/ 42 | numParams : Nat 43 | /-- Number of indices. An index is an argument that varies over constructors. 44 | 45 | An example of this is the `n : Nat` argument in the vector constructor `cons : α → Vector α n → Vector α (n+1)`. 46 | -/ 47 | numIndices : Nat 48 | /-- List of all (including this one) inductive datatypes in the mutual declaration containing this one -/ 49 | all : List Name 50 | /-- List of the names of the constructors for this inductive datatype. -/ 51 | ctors : List Name 52 | /-- `true` when recursive (that is, the inductive type appears as an argument in a constructor). -/ 53 | isRec : Bool 54 | /-- An inductive type is called reflexive if it has at least one constructor that takes as an argument a function returning the 55 | same type we are defining.-/ 56 | isReflexive : Bool 57 | /-- An inductive definition `T` is nested when there is a constructor with an argument `x : F T`, 58 | where `F : Type → Type` is some suitably behaved (ie strictly positive) function (Eg `Array T`, `List T`, `T × T`, ...). -/ 59 | isNested : Bool 60 | deriving Inhabited 61 | 62 | /-- Information for reducing a recursor -/ 63 | structure RecursorRule where 64 | /-- Reduction rule for this Constructor -/ 65 | ctor : Name 66 | /-- Number of fields (i.e., without counting inductive datatype parameters) -/ 67 | nfields : Nat 68 | /-- Right hand side of the reduction rule -/ 69 | rhs : Term 70 | deriving Inhabited 71 | 72 | 73 | structure RecursorVal extends ConstantVal where 74 | /-- List of all inductive datatypes in the mutual declaration that generated this recursor -/ 75 | all : List Name 76 | /-- Number of parameters -/ 77 | numParams : Nat 78 | /-- Number of indices -/ 79 | numIndices : Nat 80 | /-- Number of motives -/ 81 | numMotives : Nat 82 | /-- Number of minor premises -/ 83 | numMinors : Nat 84 | /-- A reduction for each Constructor -/ 85 | rules : List RecursorRule 86 | /-- Supports singleton elimination ? -/ 87 | k : Bool 88 | deriving Inhabited 89 | 90 | namespace RecursorVal 91 | 92 | def getMajorIdx (v : RecursorVal) : Nat := 93 | v.numParams + v.numMotives + v.numMinors + v.numIndices 94 | 95 | def getFirstIndexIdx (v : RecursorVal) : Nat := 96 | v.numParams + v.numMotives + v.numMinors 97 | 98 | def getFirstMinorIdx (v : RecursorVal) : Nat := 99 | v.numParams + v.numMotives 100 | 101 | def getInduct (v : RecursorVal) : Name := 102 | v.all.head! 103 | 104 | end RecursorVal 105 | 106 | 107 | inductive Declaration where 108 | | axiomDecl (val : AxiomVal) 109 | | defnDecl (val : DefinitionVal) 110 | | ctorDecl (val : ConstructorVal) 111 | | inductDecl (var : InductiveVal) 112 | | recursorDecl (val : RecursorVal) 113 | deriving Inhabited 114 | 115 | namespace Declaration 116 | 117 | def toConstantVal : Declaration → ConstantVal 118 | | axiomDecl d => d 119 | | defnDecl {toConstantVal := d, ..} => d 120 | | inductDecl {toConstantVal := d, ..} => d 121 | | ctorDecl {toConstantVal := d, ..} => d 122 | | recursorDecl {toConstantVal := d, ..} => d 123 | 124 | def name : Declaration → Name := 125 | ConstantVal.name ∘ Declaration.toConstantVal 126 | 127 | def type : Declaration → Term := 128 | ConstantVal.type ∘ Declaration.toConstantVal 129 | 130 | def levelParamsNum : Declaration → Nat := 131 | ConstantVal.levelParamsNum ∘ Declaration.toConstantVal 132 | 133 | instance : Repr Declaration where 134 | reprPrec d := Repr.reprPrec d.name 135 | 136 | instance : Coe AxiomVal Declaration := ⟨axiomDecl⟩ 137 | instance : Coe DefinitionVal Declaration := ⟨defnDecl⟩ 138 | instance : Coe InductiveVal Declaration := ⟨inductDecl⟩ 139 | instance : Coe ConstructorVal Declaration := ⟨ctorDecl⟩ 140 | instance : Coe RecursorVal Declaration := ⟨recursorDecl⟩ 141 | 142 | end Declaration 143 | 144 | abbrev ConstContext := HashMap Name Declaration 145 | 146 | structure TCContext where 147 | const_ctx : ConstContext := default 148 | var_ctx : VarContext := default 149 | debug : Array String := #[] 150 | deriving Inhabited 151 | 152 | abbrev TCEnv := ReaderT TCContext Result 153 | 154 | open TCKind 155 | 156 | def add_trace (ty : String) (tr : String): TCEnv Unit := do 157 | if (← read).debug.any (λ d => d = ty || d = "all") then 158 | dbg_trace tr 159 | 160 | def with_add_const (name : Name) (c : Declaration) (u : TCEnv α) : TCEnv α := do 161 | add_trace "cmd" s!"adding const {name} to the env" 162 | if let some _ := (← read).const_ctx.find? name then 163 | throw ↑(alreadyDefined name) 164 | withReader (λ con => {con with const_ctx := con.const_ctx.insert name c}) 165 | u 166 | 167 | def with_add_decl (d: Declaration) : TCEnv α → TCEnv α := 168 | with_add_const d.name d 169 | 170 | def with_add_def (d: DefinitionVal) : TCEnv α → TCEnv α := 171 | with_add_const d.name d 172 | 173 | def with_add_axiom (a : AxiomVal) : TCEnv α → TCEnv α := 174 | with_add_const a.name a 175 | 176 | def with_add_axioms (a : List Declaration) : TCEnv α → TCEnv α := 177 | a.foldl (fun u ax => with_add_decl ax u) 178 | 179 | -- Overwrites the MonadExceptOf to print the errors 180 | -- TODO have better error management 181 | instance (priority := high) : MonadExceptOf TCError TCEnv where 182 | throw err := do 183 | dbg_trace s!"{err}" 184 | throw err 185 | tryCatch := tryCatch 186 | 187 | def withadd_var_to_context_no_shift (t : Option Term) : TCEnv α →TCEnv α := 188 | withReader λ con => {con with var_ctx := con.var_ctx.push t} 189 | 190 | class GetType (A: Type) where 191 | get_type : A → TCEnv Term 192 | 193 | def get_const_decl? (s : Name) : TCEnv (Option Declaration) := do 194 | return (← read).const_ctx.find? s 195 | 196 | def get_const_type (s : Name) (arr : Array Level): TCEnv Term := do 197 | let res := (← read).const_ctx.find? s 198 | let some c := res | throw $ ↑(unknownConstant s) 199 | if c.levelParamsNum != arr.size then 200 | throw ↑(wrongNumberOfUniverse s c.levelParamsNum arr.size) 201 | return c.type.substitute_univ arr 202 | 203 | instance : GetType $ String × Array Level := ⟨uncurry get_const_type⟩ 204 | 205 | def get_var_type (n:Nat) : TCEnv Term := do 206 | let ctx := (← read).var_ctx 207 | let some optty := ctx.get? (ctx.size - n) | panic! s!"unknown free var {n}" 208 | let some ty := optty | throw ↑(unTypedVariable n ctx) 209 | pure ty 210 | instance : GetType $ Nat := ⟨get_var_type⟩ 211 | 212 | @[inline] def matchConstAux {α} (e : Term) (failK : Unit → TCEnv α) (k : Declaration → Array Level → TCEnv α) : TCEnv α := 213 | match e with 214 | | .const name lvls => do 215 | let (some cinfo) ← get_const_decl? name | failK () 216 | k cinfo lvls 217 | | _ => failK () 218 | 219 | 220 | inductive Command : Type := 221 | | def : Name → Nat → Option Term → Term → Command 222 | | axiom : Name → Nat → Term → Command 223 | | check : Term → Command 224 | | eval : Term → Command 225 | deriving Repr 226 | 227 | instance : ToString Command where 228 | toString 229 | | .def s _ none t => s!"def {s} := {t}" 230 | | .def s _ (some ty) t => s!"def {s} : {ty} := {t}" 231 | | .axiom s _ ty => s!"axiom {s} : {ty}" 232 | | .check t => s!"check {t}" 233 | | .eval t => s!"eval {t}" 234 | 235 | abbrev Commands := List Command 236 | 237 | @[extern "whnf"] opaque whnf : Term → TCEnv Term 238 | @[extern "infer"] opaque infer : Term → TCEnv Term 239 | @[extern "conversion"] opaque conversion : Term → Term → TCEnv Bool 240 | @[extern "isDefEq"] opaque isDefEq : Term → Term → TCEnv Unit 241 | 242 | instance : CoeFun Term (λ _ => Term → Term) where 243 | coe := Term.app 244 | -------------------------------------------------------------------------------- /tests/test_1000.mdln: -------------------------------------------------------------------------------- 1 | def add := fun x: Nat => Nat_rec.{1} (fun a : Nat => Nat) x (fun a n: Nat => Succ n) 2 | 3 | def n1000 := Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Zero)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 4 | 5 | def n2000 := Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Zero)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 6 | 7 | def p1000 : Eq.{1} Nat n2000 (add n1000 n1000) := Refl.{1} Nat n2000 8 | 9 | -------------------------------------------------------------------------------- /tests/test_2500.mdln: -------------------------------------------------------------------------------- 1 | def add := fun x: Nat => Nat_rec.{1} (fun a : Nat => Nat) x (fun a n: Nat => Succ n) 2 | 3 | def n2500 := Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Zero)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 4 | 5 | def n5000 := Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Zero)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 6 | 7 | def p2500 : Eq.{1} Nat n5000 (add n2500 n2500) := Refl.{1} Nat n5000 8 | 9 | --------------------------------------------------------------------------------