Uh oh!
There was an error while loading. Please reload this page.
forked from digama0/lean4lean
- Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathMain.lean
More file actions
Latest commit
162 lines (147 loc) · 6.92 KB
/
Copy pathMain.lean
File metadata and controls
162 lines (147 loc) · 6.92 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
/-
Copyright (c) 2023 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Lean4Lean.Replay
import Lake.Load.Manifest
open Lean hiding Environment Exception
open Kernel Lean4Lean.Replay
/-- Read the name of the main module from the `lake-manifest`. -/
-- This has been copied from `ImportGraph.getCurrentModule` in the
-- https://github.com/leanprover-community/import-graph repository.
defgetCurrentModule : IO Name := do
match (← Lake.Manifest.load? ⟨"lake-manifest.json"⟩) with
| none =>
-- TODO: should this be caught?
pure .anonymous
| some manifest =>
-- The package name and its default `lean_lib` usually agree only up to
-- case (`batteries`/`Batteries`, `lean4lean`/`Lean4Lean`), and not
-- necessarily just in the first letter, so the caller matches this
-- name case-insensitively rather than guessing a capitalization here.
-- Would be better to read the `.defaultTargets` from the
-- `← getRootPackage` from `Lake`, but I can't make that work with the monads involved.
return manifest.name
/-- Case-insensitively test whether `target` is `mod` itself or a namespace
prefix of it. Used only for the module root inferred from the package name in
`lake-manifest.json` (e.g. package `lean4lean` vs library `Lean4Lean`, which
differ beyond capitalizing the first letter); explicit command-line targets
keep exact matching. -/
defisModulePrefixOfCI (target mod : Name) : Bool :=
let t := target.toString.toLower
let m := mod.toString.toLower
m == t || (t ++ ".").isPrefixOf m
namespace Lean4Lean.FuelConfig
/-- Serialize `cfg` to its JSON object map, or panic — it's derived so it must be an object. -/
privatedeftoObj (cfg : FuelConfig) : Std.TreeMap.Raw String Lean.Json compare :=
match Lean.toJson cfg with
| .obj m => m
| _ => panic! "FuelConfig.toJson produced a non-object"
/-- Field names that `FuelConfig` accepts (derived from its JSON encoding). -/
privatedeffieldNames : List String :=
(toObj {}).foldr (fun k _ acc => k :: acc) []
/-- Layer a JSON object over an existing `FuelConfig`.
Unknown fields are rejected up front (the derived `FromJson` silently ignores
them, which we don't want for a config file); known fields are overlaid on top
of the base config's own JSON serialization and the merged object is fed back
through `fromJson?`, so value validation stays entirely in the derived parser. -/
privatedefofJson? (base : FuelConfig) (j : Lean.Json) : Except String FuelConfig := do
let .obj m := j | throw "config JSON must be an object"
let baseObj := toObj base
m.foldlM (init := ()) fun _ k _ => do
unless baseObj.contains k do
throw s!"unknown field '{k}' in config JSON (valid: {fieldNames})"
let merged := m.foldl (init := baseObj) (·.insert · ·)
Lean.fromJson? (.obj merged)
/-- Read + parse a config file, layering over an existing base. -/
privatedefofFile (base : FuelConfig) (path : System.FilePath) : IO FuelConfig := do
let raw ← IO.FS.readFile path
let j ← IO.ofExcept (Lean.Json.parse raw)
IO.ofExcept (ofJson? base j)
/-- Apply a single `--config:field=value` override.
Value is parsed as JSON, then routed through `fuelConfigOfJson?` — so the CLI
path and the file path share the same parser (and produce the same error
messages for e.g. non-numeric values or unknown fields). -/
privatedefapplyFlag (cfg : FuelConfig) (field value : String) :
Except String FuelConfig := do
let jval ← match Lean.Json.parse value with
| .ok j => pure j
| .error _ => throw s!"could not parse value '{value}' for --config:{field} as JSON"
ofJson? cfg (.obj (Std.TreeMap.Raw.empty.insert field jval))
|>.mapError (s!"in --config:{field}={value}: " ++ ·)
end Lean4Lean.FuelConfig
/--
Run as e.g. `lake exe lean4lean` to check everything in the current project.
or e.g. `lake exe lean4lean Mathlib.Data.Nat` to check everything with module name
starting with `Mathlib.Data.Nat`.
This will replay all the new declarations from the target file into the `Environment`
as it was at the beginning of the file, using the kernel to check them.
You can also use `lake exe lean4lean --fresh Mathlib.Data.Nat.Basic` to replay all the constants
(both imported and defined in that file) into a fresh environment,
but this can only be used on a single file.
-/
unsafedefmain (args : List String) : IO UInt32 := do
initSearchPath (← findSysroot)
let (flags, args) := args.partition fun s => s.startsWith "-"
let verbose := "-v" ∈ flags || "--verbose" ∈ flags
let fresh : Bool := "--fresh" ∈ flags
let compare : Bool := "--compare" ∈ flags
letmut fuel : Lean4Lean.FuelConfig := {}
for flag in flags do
iflet some path := flag.dropPrefix? "--config="then
fuel ← Lean4Lean.FuelConfig.ofFile fuel ⟨path.toString⟩
elseiflet some rest := flag.dropPrefix? "--config:"then
let [field, value] := rest.toString.splitOn "="
| throw <| IO.userError s!"malformed flag {flag}: expected --config:<field>=<value>"
match fuel.applyFlag field value with
| .ok f => fuel := f
| .error e => throw <| IO.userError e
let (targets, inferred) ← do
match args with
| [] => pure ([← getCurrentModule], true)
| args => do
let targets ← args.mapM fun arg => do
let mod := arg.toName
if mod.isAnonymous then
throw <| IO.userError s!"Could not resolve module: {arg}"
else
pure mod
pure (targets, false)
letmut targetModules := []
let sp ← searchPathRef.get
for target in targets do
letmut found := false
for path in (← SearchPath.findAllWithExt sp "olean") do
iflet some m := (← searchModuleNameOfFileName path sp) then
ifif inferred then isModulePrefixOfCI target m else target.isPrefixOf m then
targetModules := targetModules.insert m
found := true
if not found then
throw <| IO.userError <| match args with
| [] => s!"Could not infer main module (tried {target}). \
Use `lake exe lean4lean <target>` instead"
| _ => s!"Could not find any oleans for: {target}"
letmut n := 0
if fresh then
if targetModules.length != 1then
throw <| IO.userError s!"--fresh flag is only valid when specifying a single module:\n\
{targetModules}"
for m in targetModules do
if verbose then IO.println s!"replaying {m} with --fresh"
n := n + (← replayFromFresh m verbose compare (fuel := fuel))
else
letmut tasks := #[]
for m in targetModules do
tasks := tasks.push (m, ← IO.asTask (replayFromImports m verbose compare (fuel := fuel)))
letmut err := false
for (m, t) in tasks do
if verbose then IO.println s!"replaying {m}"
match t.get with
| .error e =>
IO.eprintln s!"lean4lean found a problem in {m}:\n{e.toString}"
err := true
| .ok n' => n := n + n'
if err thenreturn1
println! "checked {n} declarations"
return0