Skip to content

Commit

Permalink
replace custom lean4 toolchain dependency with Lean4Lean fork
Browse files Browse the repository at this point in the history
  • Loading branch information
rish987 committed Mar 20, 2024
1 parent 5ac682b commit ec73a99
Show file tree
Hide file tree
Showing 8 changed files with 177 additions and 48 deletions.
1 change: 0 additions & 1 deletion .envrc
@@ -1 +0,0 @@
export LEAN_GITHASH=6fce8f7d5cd18a4419bca7fd51780c71c9b1cc5a
5 changes: 1 addition & 4 deletions .github/workflows/ci.yml
Expand Up @@ -32,11 +32,8 @@ jobs:
- run: opam install lambdapi
- uses: Julian/setup-lean@v1

- name: set override
run: lake update && elan override set rish987/lean4:lean2dk-v1

- name: build
run: lake --version && LEAN_GITHASH=6fce8f7d5cd18a4419bca7fd51780c71c9b1cc5a lake build
run: lake build

- name: Test translation
run: eval $(opam env) && lake --version && lake run trans fixtures/Test.lean
2 changes: 1 addition & 1 deletion Dedukti/Trans.lean
Expand Up @@ -244,7 +244,7 @@ mutual
| some _ => pure ()
| none =>
match (← read).env.constants.find? const with
| some cinfo => if !cinfo.name.isImplementationDetail && !cinfo.name.isCStage then
| some cinfo => if !cinfo.name.isImplementationDetail /- && !cinfo.name.isCStage -/ then -- FIXME
transConst cinfo
| none => tthrow s!"could not find constant \"{const}\" for translation, verify that it exists in the Lean input"

Expand Down
37 changes: 1 addition & 36 deletions Dedukti/Util.lean
Expand Up @@ -5,6 +5,7 @@ def charSubs := [
-- ("»", "-_"),
-- ("«", "_-"),
(":", "_cln_"),
-- TODO any other weird chars?
]

def fixLeanNameStr (name : String) : String := charSubs.foldl (init := name) fun acc (orig, sub) => acc.replace orig sub
Expand All @@ -16,39 +17,3 @@ def fixLeanName' : Name → Name

def fixLeanName (n : Name) : Name :=
fixLeanName' n |>.toStringWithSep "_" false

partial def Lean.Name.isCStage : Name → Bool
| .str p s => s.startsWith "_cstage" || p.isCStage
| .num p _ => p.isCStage
| .anonymous => false

def ignoredConstant : Name → Bool
| n => !n.isImplementationDetail && !n.isCStage

namespace Deps
structure Context where
env : Environment

structure State where
map : HashMap Name ConstantInfo := {}
abbrev DepsM := ReaderT Context <| StateRefT State IO

@[inline] def DepsM.run (x : DepsM α) (ctx : Context) (s : State := {}) : MetaM (α × State) :=
x ctx |>.run s

@[inline] def DepsM.toIO (x : DepsM α) (ctxCore : Lean.Core.Context) (sCore : Lean.Core.State) (ctx : Context) (s : State := {}) : IO (α × State) := do
let ((a, s), _, _) ← (x.run ctx s).toIO ctxCore sCore
pure (a, s)

partial def namedConstDeps (name : Name) : DepsM Unit := do
match ((← get).map.find? name) with
| .none =>
let some const := (← read).env.find? name | throw $ IO.userError s!"could not find constant \"{name}\" for translation, verify that it exists in the Lean input"
modify fun s => { s with map := s.map.insert name const }
let deps := const.getUsedConstantsAsSet
for dep in deps do
if !dep.isImplementationDetail && !dep.isCStage then
namedConstDeps dep
| .some _ => pure default
end Deps

11 changes: 6 additions & 5 deletions Main.lean
@@ -1,8 +1,9 @@
import Dedukti.Trans
import Mathlib
import Dedukti.Print
import Cli
import Lean.Replay
import Lean4Lean.Replay
import Lean4Lean.Commands
import Dedukti.Util

open Dedukti
Expand Down Expand Up @@ -47,7 +48,7 @@ def getCheckableConstants (env : Lean.Environment) (consts : Lean.NameSet) (prin
let mut skipConsts : Lean.NameSet := default
-- constants that should throw an error if encountered on account of having previously failed to typecheck
let mut errConsts : Lean.NameSet := default
let mut modEnv := (← Lean.mkEmptyEnvironment).setProofIrrelevance false
let mut modEnv ← Lean.mkEmptyEnvironment
for const in consts do
try
if not $ skipConsts.contains const then
Expand All @@ -62,13 +63,13 @@ def getCheckableConstants (env : Lean.Environment) (consts : Lean.NameSet) (prin
for skipConst in skippedConsts do
map := map.erase skipConst

modEnv ← modEnv.replay map
modEnv ← Lean4Lean.replay {newConstants := map} modEnv
skipConsts := skipConsts.union mapConsts -- TC success, so want to skip in future runs (already in environment)
onlyConstsToTrans := onlyConstsToTrans.insert const
catch
| e =>
if printErr then
IO.eprintln s!"Error typechecking constant '{const}': {e.toString}"
IO.eprintln s!"Error typechecking constant `{const}`: {e.toString}"
errConsts := errConsts.insert const

pure onlyConstsToTrans
Expand Down Expand Up @@ -103,7 +104,7 @@ def runTransCmd (p : Parsed) : IO UInt32 := do
let onlyConstsInit := onlyConstsArr.foldl (init := default) fun acc const =>
if !const.isImplementationDetail && !const.isCStage then acc.insert const else acc

let onlyConsts ← getCheckableConstants env onlyConstsInit (printErr := true)
let onlyConsts ← Lean4Lean.checkConstants env onlyConstsInit (printErr := true)

let ignoredConsts := onlyConstsInit.diff onlyConsts
if ignoredConsts.size > 0 then
Expand Down
157 changes: 156 additions & 1 deletion fixtures/Mathlib.lean
@@ -1 +1,156 @@
import Mathlib
import Lean4Lean.Commands

-- #print ProbabilityTheory.cond_eq_inv_mul_cond_mul
-- set_option pp.all true in
-- #print Classical.em
theorem myEm : ∀ (p : Prop), Or p (Not p) :=
fun (p : Prop) =>
let U : PropProp := fun (x : Prop) => Or (@Eq.{1} Prop x True) p;
let V : PropProp := fun (x : Prop) => Or (@Eq.{1} Prop x False) p;
@letFun.{0, 0} (@Exists.{1} Prop fun (x : Prop) => U x)
(fun (exU : @Exists.{1} Prop fun (x : Prop) => U x) => Or p (Not p))
(@Exists.intro.{1} Prop (fun (x : Prop) => U x) True (@Or.inl (@Eq.{1} Prop True True) p (@rfl.{1} Prop True)))
fun (exU : @Exists.{1} Prop fun (x : Prop) => U x) =>
@letFun.{0, 0} (@Exists.{1} Prop fun (x : Prop) => V x)
(fun (exV : @Exists.{1} Prop fun (x : Prop) => V x) => Or p (Not p))
(@Exists.intro.{1} Prop (fun (x : Prop) => V x) False
(@Or.inl (@Eq.{1} Prop False False) p (@rfl.{1} Prop False)))
fun (exV : @Exists.{1} Prop fun (x : Prop) => V x) =>
let u : Prop := @Classical.choose.{1} Prop (fun (x : Prop) => U x) exU;
let v : Prop := @Classical.choose.{1} Prop (fun (x : Prop) => V x) exV;
@letFun.{0, 0} (U u) (fun (u_def : U u) => Or p (Not p))
(@Classical.choose_spec.{1} Prop (fun (x : Prop) => U x) exU) fun (u_def : U u) =>
@letFun.{0, 0} (V v) (fun (v_def : V v) => Or p (Not p))
(@Classical.choose_spec.{1} Prop (fun (x : Prop) => V x) exV) fun (v_def : V v) =>
@letFun.{0, 0} (Or (@Ne.{1} Prop u v) p) (fun (not_uv_or_p : Or (@Ne.{1} Prop u v) p) => Or p (Not p))
(Classical.em.match_1 p u v (fun (u_def : U u) (v_def : V v) => Or (@Ne.{1} Prop u v) p) u_def v_def
(fun (h : p) (x : V v) => @Or.inr (@Ne.{1} Prop u v) p h)
(fun (x : U u) (h : p) => @Or.inr (@Ne.{1} Prop u v) p h)
fun (hut : @Eq.{1} Prop u True) (hvf : @Eq.{1} Prop v False) =>
@letFun.{0, 0} (@Ne.{1} Prop u v) (fun (hne : @Ne.{1} Prop u v) => Or (@Ne.{1} Prop u v) p)
(@of_eq_true (@Ne.{1} Prop u v)
(@Eq.trans.{1} Prop (@Ne.{1} Prop u v) (@Ne.{1} Prop True False) True
(@congr.{1, 1} Prop Prop (@Ne.{1} Prop u) (@Ne.{1} Prop True) v False
(@congrArg.{1, 1} Prop (PropProp) u True (@Ne.{1} Prop) hut) hvf)
(@Eq.trans.{1} Prop (Not (@Eq.{1} Prop True False)) (Not False) True
(@congrArg.{1, 1} Prop Prop (@Eq.{1} Prop True False) False Not
(@Eq.trans.{1} Prop (@Eq.{1} Prop True False) (Iff True False) False
sorry
(@Eq.trans.{1} Prop (Iff True False) (Not True) False (iff_false True) not_true_eq_false)))
not_false_eq_true)))
fun (hne : @Ne.{1} Prop u v) => @Or.inl (@Ne.{1} Prop u v) p hne)
fun (not_uv_or_p : Or (@Ne.{1} Prop u v) p) =>
@letFun.{0, 0} (p → @Eq.{1} Prop u v) (fun (p_implies_uv : p → @Eq.{1} Prop u v) => Or p (Not p))
(fun (hp : p) =>
@letFun.{0, 0} (@Eq.{1} (PropProp) U V) (fun (hpred : @Eq.{1} (PropProp) U V) => @Eq.{1} Prop u v)
(@funext.{1, 1} Prop (fun (x : Prop) => Prop) U V fun (x : Prop) =>
@letFun.{0, 0} (Or (@Eq.{1} Prop x True) p → Or (@Eq.{1} Prop x False) p)
(fun (hl : Or (@Eq.{1} Prop x True) p → Or (@Eq.{1} Prop x False) p) =>
@Eq.{1} Prop (Or (@Eq.{1} Prop x True) p) (Or (@Eq.{1} Prop x False) p))
(fun (x_1 : Or (@Eq.{1} Prop x True) p) => @Or.inr (@Eq.{1} Prop x False) p hp)
fun (hl : Or (@Eq.{1} Prop x True) p → Or (@Eq.{1} Prop x False) p) =>
@letFun.{0, 0} (Or (@Eq.{1} Prop x False) p → Or (@Eq.{1} Prop x True) p)
(fun (hr : Or (@Eq.{1} Prop x False) p → Or (@Eq.{1} Prop x True) p) =>
@Eq.{1} Prop (Or (@Eq.{1} Prop x True) p) (Or (@Eq.{1} Prop x False) p))
(fun (x_1 : Or (@Eq.{1} Prop x False) p) => @Or.inr (@Eq.{1} Prop x True) p hp)
fun (hr : Or (@Eq.{1} Prop x False) p → Or (@Eq.{1} Prop x True) p) =>
@letFun.{0, 0} (@Eq.{1} Prop (Or (@Eq.{1} Prop x True) p) (Or (@Eq.{1} Prop x False) p))
(fun (this : @Eq.{1} Prop (Or (@Eq.{1} Prop x True) p) (Or (@Eq.{1} Prop x False) p)) =>
@Eq.{1} Prop (Or (@Eq.{1} Prop x True) p) (Or (@Eq.{1} Prop x False) p))
(@propext (Or (@Eq.{1} Prop x True) p) (Or (@Eq.{1} Prop x False) p)
(@Iff.intro (Or (@Eq.{1} Prop x True) p) (Or (@Eq.{1} Prop x False) p) hl hr))
fun (this : @Eq.{1} Prop (Or (@Eq.{1} Prop x True) p) (Or (@Eq.{1} Prop x False) p)) => this)
fun (hpred : @Eq.{1} (PropProp) U V) =>
@letFun.{0, 0}
(∀ (exU : @Exists.{1} Prop fun (x : Prop) => U x) (exV : @Exists.{1} Prop fun (x : Prop) => V x),
@Eq.{1} Prop (@Classical.choose.{1} Prop U exU) (@Classical.choose.{1} Prop V exV))
(fun
(h₀ :
∀ (exU : @Exists.{1} Prop fun (x : Prop) => U x)
(exV : @Exists.{1} Prop fun (x : Prop) => V x),
@Eq.{1} Prop (@Classical.choose.{1} Prop U exU) (@Classical.choose.{1} Prop V exV)) =>
@Eq.{1} Prop u v)
(@Eq.mpr.{0}
(∀ (exU : @Exists.{1} Prop fun (x : Prop) => U x) (exV : @Exists.{1} Prop fun (x : Prop) => V x),
@Eq.{1} Prop (@Classical.choose.{1} Prop U exU) (@Classical.choose.{1} Prop V exV))
(∀ (exU exV : @Exists.{1} Prop fun (x : Prop) => V x),
@Eq.{1} Prop (@Classical.choose.{1} Prop V exU) (@Classical.choose.{1} Prop V exV))
(@id.{0}
(@Eq.{1} Prop
(∀ (exU : @Exists.{1} Prop fun (x : Prop) => U x)
(exV : @Exists.{1} Prop fun (x : Prop) => V x),
@Eq.{1} Prop (@Classical.choose.{1} Prop U exU) (@Classical.choose.{1} Prop V exV))
(∀ (exU exV : @Exists.{1} Prop fun (x : Prop) => V x),
@Eq.{1} Prop (@Classical.choose.{1} Prop V exU) (@Classical.choose.{1} Prop V exV)))
(@congrArg.{1, 1} (PropProp) Prop U V
(fun (_a : PropProp) =>
∀ (exU : @Exists.{1} Prop fun (x : Prop) => _a x)
(exV : @Exists.{1} Prop fun (x : Prop) => V x),
@Eq.{1} Prop (@Classical.choose.{1} Prop _a exU) (@Classical.choose.{1} Prop V exV))
hpred))
fun (exU exV : @Exists.{1} Prop fun (x : Prop) => V x) =>
@Eq.refl.{1} Prop (@Classical.choose.{1} Prop V exU))
fun
(h₀ :
∀ (exU : @Exists.{1} Prop fun (x : Prop) => U x) (exV : @Exists.{1} Prop fun (x : Prop) => V x),
@Eq.{1} Prop (@Classical.choose.{1} Prop U exU) (@Classical.choose.{1} Prop V exV)) =>
@letFun.{0, 0} (@Eq.{1} Prop u v) (fun (this : @Eq.{1} Prop u v) => @Eq.{1} Prop u v) (h₀ exU exV)
fun (this : @Eq.{1} Prop u v) => this)
fun (p_implies_uv : p → @Eq.{1} Prop u v) =>
Classical.em.match_2 p u v (fun (not_uv_or_p : Or (@Ne.{1} Prop u v) p) => Or p (Not p)) not_uv_or_p
(fun (hne : @Ne.{1} Prop u v) => @Or.inr p (Not p) (@mt p (@Eq.{1} Prop u v) p_implies_uv hne))
fun (h : p) => @Or.inl p (Not p) h

set_option l4l.check true

-- TODO where to introduce this axiom into the environment?
axiom prfIrrel (P : Prop) (p q : P) : p = q

axiom P : Prop
axiom p : P
axiom q : P
axiom p' : P
axiom q' : P

inductive Test : P → Type
| mk : (p : P) → Test p
inductive Test' : P → P → Type
| mk : (p q : P) → Test' p q

-- general form, to replace term t of type T containing proof subterm p at location l that calls `isDefEqProofIrrel p q` returning true
-- @Eq.mpr T[q@l] T (congrArg (fun x => T[x@l]) (prfIrrel P q p)) t

def PITest1 : Test q := Test.mk p
def PITest1' : Test q :=
@Eq.mpr (Test q) (Test p) (congrArg (fun x => Test x) (prfIrrel P q p)) (Test.mk p)
#check_l4l PITest1'

-- set_option l4l.patch_prfirrel in
-- set_option l4l.prfirrel off in
theorem PITest11 : Test' q q' := Test'.mk p p'

-- set_option l4l.prfirrel off in
def PITest11' : Test' q q' :=
@Eq.mpr (Test' q q') (Test' p p')
(congr (f₁ := fun x => Test' q x) (f₂ := fun x => Test' p x)
(congr (f₁ := fun x => Test' x) (f₂ := fun x => Test' x) rfl (prfIrrel P q p))
(prfIrrel P q' p'))
(Test'.mk p p')
#check_l4l PITest11'

-- assert equality of PITest11 and PITest11'

-- set_option l4l.pp_prfirrel on in
-- #print PITest11
-- ^ should delaborate to: [Test'.mk p p' : Test' [p/q (PI)] [p'/q' (PI)]]

def PITest2 : ∀ (_ q : P), Test q := fun p _ => Test.mk p
def PITest2' : ∀ (_ q : P), Test q :=
fun p q => @Eq.mpr (Test q) (Test p) (congrArg (fun x => Test x) (prfIrrel P q p)) (Test.mk p)







9 changes: 9 additions & 0 deletions lake-manifest.json
Expand Up @@ -63,6 +63,15 @@
"manifestFile": "lake-manifest.json",
"inputRev": "v4.7.0-rc2",
"inherited": false,
"configFile": "lakefile.lean"},
{"url": "https://github.com/rish987/Lean4Lean",
"type": "git",
"subDir": null,
"rev": "6234ec6c97a483d1f246d0127cb83a2f6076d303",
"name": "lean4lean",
"manifestFile": "lake-manifest.json",
"inputRev": "lean2dk",
"inherited": false,
"configFile": "lakefile.lean"}],
"name": "Lean2Dk",
"lakeDir": ".lake"}
3 changes: 3 additions & 0 deletions lakefile.lean
Expand Up @@ -17,6 +17,9 @@ require mathlib from git
require Cli from git
"https://github.com/leanprover/lean4-cli" @ "main"

require lean4lean from git
"https://github.com/rish987/Lean4Lean" @ "lean2dk"

def runCmd' (cmd : String) : ScriptM $ IO.Process.Output := do
let cmd := cmd.splitOn " "
if h : cmd ≠ [] then
Expand Down

0 comments on commit ec73a99

Please sign in to comment.