max/lean4-htt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 2

refactor: remove Lean.RBMap usages (#9260)

Browse source 
This PR removes uses of `Lean.RBMap` in Lean itself.

Furthermore some massaging of the import graph is done in order to avoid
having `Std.Data.TreeMap.AdditionalOperations` (which is quite
expensive) be the critical path for a large chunk of Lean. In particular
we can build `Lean.Meta.Simp` and `Lean.Meta.Grind` without it thanks to
these changes.

We did previously not conduct this change as `Std.TreeMap` was not
outperforming `Lean.RBMap` yet, however this has changed with the new
code generator.
This commit is contained in:
Henrik Böving 2025-07-21 16:04:45 +02:00 • committed by GitHub
parent 23e88b4e1d
commit 09de5cd70e
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
134 changed files with 883 additions and 1033 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/Lean/Attributes.lean
View file

@ -144,7 +144,7 @@ def registerTagAttribute (name : Name) (descr : String)
addImportedFn := fun _ _ => pure {}
addEntryFn := fun (s : NameSet) n => s.insert n
exportEntriesFn := fun es =>
let r : Array Name := es.fold (fun a e => a.push e) #[]
let r : Array Name := es.foldl (fun a e => a.push e) #[]
r.qsort Name.quickLt
statsFn := fun s => "tag attribute" ++ Format.line ++ "number of local entries: " ++ format s.size
asyncMode := asyncMode
@ -219,7 +219,7 @@ def registerParametricAttribute (impl : ParametricAttributeImpl α) : IO (Parame
addImportedFn := fun s => impl.afterImport s *> pure {}
addEntryFn := fun (s : NameMap α) (p : Name × α) => s.insert p.1 p.2
exportEntriesFn := fun m =>
let r : Array (Name × α) := m.fold (fun a n p => a.push (n, p)) #[]
let r : Array (Name × α) := m.foldl (fun a n p => a.push (n, p)) #[]
r.qsort (fun a b => Name.quickLt a.1 b.1)
statsFn := fun s => "parametric attribute" ++ Format.line ++ "number of local entries: " ++ format s.size
}
@ -276,7 +276,7 @@ def registerEnumAttributes (attrDescrs : List (Name × String × α))
addImportedFn := fun _ _ => pure {}
addEntryFn := fun (s : NameMap α) (p : Name × α) => s.insert p.1 p.2
exportEntriesFn := fun m =>
let r : Array (Name × α) := m.fold (fun a n p => a.push (n, p)) #[]
let r : Array (Name × α) := m.foldl (fun a n p => a.push (n, p)) #[]
r.qsort (fun a b => Name.quickLt a.1 b.1)
statsFn := fun s => "enumeration attribute extension" ++ Format.line ++ "number of local entries: " ++ format s.size
-- We assume (and check below) that, if used asynchronously, enum attributes are set only in the

28
src/Lean/Compiler/IR/Basic.lean
View file

@ -383,17 +383,17 @@ def mkDummyExternDecl (f : FunId) (xs : Array Param) (ty : IRType) : Decl :=
Decl.fdecl f xs ty FnBody.unreachable {}
/-- Set of variable and join point names -/
abbrev IndexSet := RBTree Index compare
abbrev IndexSet := Std.TreeSet Index
def mkIndexSet (idx : Index) : IndexSet :=
RBTree.empty.insert idx
Std.TreeSet.empty.insert idx
inductive LocalContextEntry where
| param : IRType → LocalContextEntry
| localVar : IRType → Expr → LocalContextEntry
| joinPoint : Array Param → FnBody → LocalContextEntry
abbrev LocalContext := RBMap Index LocalContextEntry compare
abbrev LocalContext := Std.TreeMap Index LocalContextEntry
def LocalContext.addLocal (ctx : LocalContext) (x : VarId) (t : IRType) (v : Expr) : LocalContext :=
ctx.insert x.idx (LocalContextEntry.localVar t v)
@ -408,48 +408,48 @@ def LocalContext.addParams (ctx : LocalContext) (ps : Array Param) : LocalContex
ps.foldl LocalContext.addParam ctx
def LocalContext.isJP (ctx : LocalContext) (idx : Index) : Bool :=
match ctx.find? idx with
match ctx.get? idx with
| some (LocalContextEntry.joinPoint _ _) => true
| _ => false
def LocalContext.getJPBody (ctx : LocalContext) (j : JoinPointId) : Option FnBody :=
match ctx.find? j.idx with
match ctx.get? j.idx with
| some (LocalContextEntry.joinPoint _ b) => some b
| _ => none
def LocalContext.getJPParams (ctx : LocalContext) (j : JoinPointId) : Option (Array Param) :=
match ctx.find? j.idx with
match ctx.get? j.idx with
| some (LocalContextEntry.joinPoint ys _) => some ys
| _ => none
def LocalContext.isParam (ctx : LocalContext) (idx : Index) : Bool :=
match ctx.find? idx with
match ctx.get? idx with
| some (LocalContextEntry.param _) => true
| _ => false
def LocalContext.isLocalVar (ctx : LocalContext) (idx : Index) : Bool :=
match ctx.find? idx with
match ctx.get? idx with
| some (LocalContextEntry.localVar _ _) => true
| _ => false
def LocalContext.contains (ctx : LocalContext) (idx : Index) : Bool :=
RBMap.contains ctx idx
Std.TreeMap.contains ctx idx
def LocalContext.eraseJoinPointDecl (ctx : LocalContext) (j : JoinPointId) : LocalContext :=
ctx.erase j.idx
def LocalContext.getType (ctx : LocalContext) (x : VarId) : Option IRType :=
match ctx.find? x.idx with
match ctx.get? x.idx with
| some (LocalContextEntry.param t) => some t
| some (LocalContextEntry.localVar t _) => some t
| _ => none
def LocalContext.getValue (ctx : LocalContext) (x : VarId) : Option Expr :=
match ctx.find? x.idx with
match ctx.get? x.idx with
| some (LocalContextEntry.localVar _ v) => some v
| _ => none
abbrev IndexRenaming := RBMap Index Index compare
abbrev IndexRenaming := Std.TreeMap Index Index
class AlphaEqv (α : Type) where
aeqv : IndexRenaming → α → α → Bool
@ -457,7 +457,7 @@ class AlphaEqv (α : Type) where
export AlphaEqv (aeqv)
def VarId.alphaEqv (ρ : IndexRenaming) (v₁ v₂ : VarId) : Bool :=
match ρ.find? v₁.idx with
match ρ.get? v₁.idx with
| some v => v == v₂.idx
| none => v₁ == v₂
@ -540,7 +540,7 @@ def FnBody.beq (b₁ b₂ : FnBody) : Bool :=
instance : BEq FnBody := ⟨FnBody.beq⟩
abbrev VarIdSet := RBTree VarId (fun x y => compare x.idx y.idx)
abbrev VarIdSet := Std.TreeSet VarId (fun x y => compare x.idx y.idx)
def mkIf (x : VarId) (t e : FnBody) : FnBody :=
FnBody.case `Bool x IRType.uint8 #[

8
src/Lean/Compiler/IR/LiveVars.lean
View file

@ -80,10 +80,10 @@ def FnBody.hasLiveVar (b : FnBody) (ctx : LocalContext) (x : VarId) : Bool :=
(IsLive.visitFnBody x.idx b).run' ctx
abbrev LiveVarSet := VarIdSet
abbrev JPLiveVarMap := RBMap JoinPointId LiveVarSet (fun j₁ j₂ => compare j₁.idx j₂.idx)
abbrev JPLiveVarMap := Std.TreeMap JoinPointId LiveVarSet (fun j₁ j₂ => compare j₁.idx j₂.idx)
def mkLiveVarSet (x : VarId) : LiveVarSet :=
RBTree.empty.insert x
Std.TreeSet.empty.insert x
namespace LiveVars
@ -103,10 +103,10 @@ private def collectArgs (as : Array Arg) : Collector :=
collectArray as collectArg
private def accumulate (s' : LiveVarSet) : Collector :=
fun s => s'.fold (fun s x => s.insert x) s
fun s => s'.foldl (fun s x => s.insert x) s
private def collectJP (m : JPLiveVarMap) (j : JoinPointId) : Collector :=
match m.find? j with
match m.get? j with
| some xs => accumulate xs
| none => skip -- unreachable for well-formed code

2
src/Lean/Compiler/IR/NormIds.lean
View file

@ -39,7 +39,7 @@ namespace NormalizeIds
abbrev M := ReaderT IndexRenaming Id
def normIndex (x : Index) : M Index := fun m =>
match m.find? x with
match m.get? x with
| some y => y
| none => x

12
src/Lean/Compiler/IR/RC.lean
View file

@ -21,7 +21,7 @@ structure VarInfo where
consume : Bool -- true if the variable RC must be "consumed"
deriving Inhabited
abbrev VarMap := RBMap VarId VarInfo (fun x y => compare x.idx y.idx)
abbrev VarMap := Std.TreeMap VarId VarInfo (fun x y => compare x.idx y.idx)
structure Context where
env : Environment
@ -36,7 +36,7 @@ def getDecl (ctx : Context) (fid : FunId) : Decl :=
| none => unreachable!
def getVarInfo (ctx : Context) (x : VarId) : VarInfo :=
match ctx.varMap.find? x with
match ctx.varMap.get? x with
| some info => info
| none => unreachable!
@ -46,7 +46,7 @@ def getJPParams (ctx : Context) (j : JoinPointId) : Array Param :=
| none => unreachable!
def getJPLiveVars (ctx : Context) (j : JoinPointId) : LiveVarSet :=
match ctx.jpLiveVarMap.find? j with
match ctx.jpLiveVarMap.get? j with
| some s => s
| none => {}
@ -68,12 +68,12 @@ private def updateRefUsingCtorInfo (ctx : Context) (x : VarId) (c : CtorInfo) :
else
let m := ctx.varMap
{ ctx with
varMap := match m.find? x with
varMap := match m.get? x with
| some info => m.insert x { info with type := c.type }
| none => m }
private def addDecForAlt (ctx : Context) (caseLiveVars altLiveVars : LiveVarSet) (b : FnBody) : FnBody :=
caseLiveVars.fold (init := b) fun b x =>
caseLiveVars.foldl (init := b) fun b x =>
if !altLiveVars.contains x && mustConsume ctx x then addDec ctx x b else b
/-- `isFirstOcc xs x i = true` if `xs[i]` is the first occurrence of `xs[i]` in `xs` -/
@ -155,7 +155,7 @@ private def isPersistent : Expr → Bool
/-- We do not need to consume the projection of a variable that is not consumed -/
private def consumeExpr (m : VarMap) : Expr → Bool
| Expr.proj _ x => match m.find? x with
| Expr.proj _ x => match m.get? x with
| some info => info.consume
| none => true
| _ => true

2
src/Lean/Compiler/LCNF/AlphaEqv.lean
View file

@ -17,7 +17,7 @@ namespace AlphaEqv
abbrev EqvM := ReaderM (FVarIdMap FVarId)
def eqvFVar (fvarId₁ fvarId₂ : FVarId) : EqvM Bool := do
let fvarId₂ := (← read).find? fvarId₂ |>.getD fvarId₂
let fvarId₂ := (← read).get? fvarId₂ |>.getD fvarId₂
return fvarId₁ == fvarId₂
def eqvType (e₁ e₂ : Expr) : EqvM Bool := do

4
src/Lean/Compiler/LCNF/FixedParams.lean
View file

@ -78,7 +78,7 @@ abbrev abort : FixParamM α := do
throw ()
def evalFVar (fvarId : FVarId) : FixParamM AbsValue := do
let some val := (← read).assignment.find? fvarId | return .top
let some val := (← read).assignment.get? fvarId | return .top
return val
def evalArg (arg : Arg) : FixParamM AbsValue := do
@ -109,7 +109,7 @@ partial def isEquivalentFunDecl? (decl : FunDecl) : FixParamM (Option Nat) := do
if args.size != decl.params.size then return none
let .return retFVarId := k | return none
if retFVarId != fvarId then return none
let some (.val funIdx) := (← read).assignment.find? funFvarId | return none
let some (.val funIdx) := (← read).assignment.get? funFvarId | return none
for h : i in [:decl.params.size] do
let param := decl.params[i]
-- TODO: Eliminate this dynamic bounds check.

8
src/Lean/Compiler/LCNF/JoinPoints.lean
View file

@ -467,7 +467,7 @@ abbrev ReduceAnalysisM := ReaderT AnalysisCtx StateRefT AnalysisState ScopeM
abbrev ReduceActionM := ReaderT AnalysisState CompilerM
def isInJpScope (jp : FVarId) (var : FVarId) : ReduceAnalysisM Bool := do
return (← read).jpScopes.find! jp |>.contains var
return (← read).jpScopes.get! jp |>.contains var
open ScopeM
@ -542,7 +542,7 @@ where
cs.alts.forM visitor
| .jmp fn args =>
let decl ← getFunDecl fn
if let some knownArgs := (← get).jpJmpArgs.find? fn then
if let some knownArgs := (← get).jpJmpArgs.get? fn then
let mut newArgs := knownArgs
for (param, arg) in decl.params.zip args do
if let some knownVal := newArgs[param.fvarId]? then
@ -562,7 +562,7 @@ where
goReduce (code : Code) : ReduceActionM Code := do
match code with
| .jp decl k =>
if let some reducibleArgs := (← read).jpJmpArgs.find? decl.fvarId then
if let some reducibleArgs := (← read).jpJmpArgs.get? decl.fvarId then
let filter param := do
let erasable := reducibleArgs.contains param.fvarId
if erasable then
@ -582,7 +582,7 @@ where
else
return Code.updateFun! code decl (← goReduce k)
| .jmp fn args =>
let reducibleArgs := (← read).jpJmpArgs.find! fn
let reducibleArgs := (← read).jpJmpArgs.get! fn
let decl ← getFunDecl fn
let newParams := decl.params.zip args
|>.filter (!reducibleArgs.contains ·.fst.fvarId)

2
src/Lean/Compiler/LCNF/ReduceJpArity.lean
View file

@ -51,7 +51,7 @@ partial def reduce (code : Code) : ReduceM Code := do
return code.updateAlts! alts
| .return .. | .unreach .. => return code
| .jmp fvarId args =>
if let some mask := (← read).find? fvarId then
if let some mask := (← read).get? fvarId then
let mut argsNew := #[]
for keep in mask, arg in args do
if keep then

6
src/Lean/Compiler/LCNF/Renaming.lean
View file

@ -13,7 +13,7 @@ A mapping from free variable id to binder name.
abbrev Renaming := FVarIdMap Name
def Param.applyRenaming (param : Param) (r : Renaming) : CompilerM Param := do
if let some binderName := r.find? param.fvarId then
if let some binderName := r.get? param.fvarId then
let param := { param with binderName }
modifyLCtx fun lctx => lctx.addParam param
return param
@ -21,7 +21,7 @@ def Param.applyRenaming (param : Param) (r : Renaming) : CompilerM Param := do
return param
def LetDecl.applyRenaming (decl : LetDecl) (r : Renaming) : CompilerM LetDecl := do
if let some binderName := r.find? decl.fvarId then
if let some binderName := r.get? decl.fvarId then
let decl := { decl with binderName }
modifyLCtx fun lctx => lctx.addLetDecl decl
return decl
@ -30,7 +30,7 @@ def LetDecl.applyRenaming (decl : LetDecl) (r : Renaming) : CompilerM LetDecl :=
mutual
partial def FunDecl.applyRenaming (decl : FunDecl) (r : Renaming) : CompilerM FunDecl := do
if let some binderName := r.find? decl.fvarId then
if let some binderName := r.get? decl.fvarId then
let decl := { decl with binderName }
modifyLCtx fun lctx => lctx.addFunDecl decl
decl.updateValue (← decl.value.applyRenaming r)

2
src/Lean/Compiler/LCNF/Simp/DiscrM.lean
View file

@ -60,7 +60,7 @@ def findCtor? (fvarId : FVarId) : DiscrM (Option CtorInfo) := do
let some (.ctorInfo val) := (← getEnv).find? declName | return none
return some <| .ctor val args
| some _ => return none
| none => return (← read).discrCtorMap.find? fvarId
| none => return (← read).discrCtorMap.get? fvarId
def findCtorName? (fvarId : FVarId) : DiscrM (Option Name) := do
let some ctorInfo ← findCtor? fvarId | return none

8
src/Lean/Compiler/LCNF/Simp/JpCases.lean
View file

@ -80,7 +80,7 @@ where
| .alt ctorName ps k => withDiscrCtor c.discr ctorName ps <| go k
| .return .. | .unreach .. => return ()
| .jmp fvarId args =>
if let some info := (← get).find? fvarId then
if let some info := (← get).get? fvarId then
let .fvar argFVarId := args[info.paramIdx]! | return ()
let some ctorName ← findCtorName? argFVarId | return ()
modify fun map => map.insert fvarId <| { info with ctorNames := info.ctorNames.insert ctorName }
@ -231,7 +231,7 @@ where
return code
visitJp? (decl : FunDecl) (k : Code) : ReaderT JpCasesInfoMap (StateRefT Ctor2JpCasesAlt DiscrM) (Option Code) := do
let some info := (← read).find? decl.fvarId | return none
let some info := (← read).get? decl.fvarId | return none
if info.ctorNames.isEmpty then return none
-- This join point satisfies `isJpCases?` and there are jumps with constructors in `info` to it.
let (decls, cases) := extractJpCases decl.value
@ -272,8 +272,8 @@ where
return LCNF.attachCodeDecls jpAltDecls code
visitJmp? (fvarId : FVarId) (args : Array Arg) : ReaderT JpCasesInfoMap (StateRefT Ctor2JpCasesAlt DiscrM) (Option Code) := do
let some ctorJpAltMap := (← get).find? fvarId | return none
let some info := (← read).find? fvarId | return none
let some ctorJpAltMap := (← get).get? fvarId | return none
let some info := (← read).get? fvarId | return none
let .fvar argFVarId := args[info.paramIdx]! | return none
let some ctorInfo ← findCtor? argFVarId | return none
let some jpAlt := ctorJpAltMap.find? ctorInfo.getName | return none

2
src/Lean/Compiler/LCNF/ToExpr.lean
View file

@ -13,7 +13,7 @@ namespace ToExpr
private abbrev LevelMap := FVarIdMap Nat
private def _root_.Lean.FVarId.toExpr (offset : Nat) (m : LevelMap) (fvarId : FVarId) : Expr :=
match m.find? fvarId with
match m.get? fvarId with
| some level => .bvar (offset - level - 1)
| none => .fvar fvarId

6
src/Lean/Compiler/LCNF/ToLCNF.lean
View file

@ -66,7 +66,7 @@ partial def bindCases (jpDecl : FunDecl) (cases : Cases) : CompilerM Code := do
let (alts, s) ← visitAlts cases.alts |>.run {}
let resultType ← mkCasesResultType alts
let result := .cases { cases with alts, resultType }
let result := s.fold (init := result) fun result _ altJp => .jp altJp result
let result := s.foldl (init := result) fun result _ altJp => .jp altJp result
return .jp jpDecl result
where
visitAlts (alts : Array Alt) : BindCasesM (Array Alt) :=
@ -99,7 +99,7 @@ where
if binderName.getPrefix == `_alt then
if let some funDecl ← findFun? f then
eraseLetDecl decl
if let some altJp := (← get).find? f then
if let some altJp := (← get).get? f then
/- We already have an auxiliary join point for `f`, then, we just use it. -/
return .jmp altJp.fvarId args
else
@ -130,7 +130,7 @@ where
return .jmp altJp.fvarId args
| _ => pure ()
let k ← go k
if let some altJp := (← get).find? decl.fvarId then
if let some altJp := (← get).get? decl.fvarId then
-- The new join point depends on this variable. Thus, we must insert it here
modify fun s => s.erase decl.fvarId
return .let decl (.jp altJp k)

35
src/Lean/Data/Json/Basic.lean
View file

@ -8,8 +8,8 @@ prelude
import Init.Data.Range
import Init.Data.OfScientific
import Init.Data.Hashable
import Lean.Data.RBMap
import Init.Data.ToString.Macro
import Std.Data.TreeMap.Raw.Basic
namespace Lean
@ -175,10 +175,7 @@ inductive Json where
| num (n : JsonNumber)
| str (s : String)
| arr (elems : Array Json)
-- uses RBNode instead of RBMap because RBMap is a def
-- and thus currently cannot be used to define a type that
-- is recursive in one of its parameters
| obj (kvPairs : RBNode String (fun _ => Json))
| obj (kvPairs : Std.TreeMap.Raw String Json)
deriving Inhabited
namespace Json
@ -193,10 +190,10 @@ private partial def beq' : Json → Json → Bool
a == b
| obj a, obj b =>
let _ : BEq Json := ⟨beq'⟩
let szA := a.fold (init := 0) (fun a _ _ => a + 1)
let szB := b.fold (init := 0) (fun a _ _ => a + 1)
let szA := a.foldl (init := 0) (fun a _ _ => a + 1)
let szB := b.foldl (init := 0) (fun a _ _ => a + 1)
szA == szB && a.all fun field fa =>
match b.find compare field with
match b.get? field with
| none => false
| some fb => fa == fb
| _, _ => false
@ -212,18 +209,13 @@ private partial def hash' : Json → UInt64
| arr elems =>
mixHash 23 <| elems.foldl (init := 7) fun r a => mixHash r (hash' a)
| obj kvPairs =>
mixHash 29 <| kvPairs.fold (init := 7) fun r k v => mixHash r <| mixHash (hash k) (hash' v)
mixHash 29 <| kvPairs.foldl (init := 7) fun r k v => mixHash r <| mixHash (hash k) (hash' v)
instance : Hashable Json where
hash := hash'
-- HACK(Marc): temporary ugliness until we can use RBMap for JSON objects
def mkObj (o : List (String × Json)) : Json :=
obj <| Id.run do
let mut kvPairs := RBNode.leaf
for ⟨k, v⟩ in o do
kvPairs := kvPairs.insert compare k v
kvPairs
obj <| Std.TreeMap.Raw.ofList o
instance : Coe Nat Json := ⟨fun n => Json.num n⟩
instance : Coe Int Json := ⟨fun n => Json.num n⟩
@ -235,7 +227,7 @@ def isNull : Json -> Bool
| null => true
| _ => false
def getObj? : Json → Except String (RBNode String (fun _ => Json))
def getObj? : Json → Except String (Std.TreeMap.Raw String Json compare)
| obj kvs => return kvs
| _ => throw "object expected"
@ -265,7 +257,7 @@ def getNum? : Json → Except String JsonNumber
def getObjVal? : Json → String → Except String Json
| obj kvs, k =>
match kvs.find compare k with
match kvs.get? k with
| some v => return v
| none => throw s!"property not found: {k}"
| _ , _ => throw "object expected"
@ -281,24 +273,23 @@ def getObjValD (j : Json) (k : String) : Json :=
(j.getObjVal? k).toOption.getD null
def setObjVal! : Json → String → Json → Json
| obj kvs, k, v => obj <| kvs.insert compare k v
| obj kvs, k, v => obj <| kvs.insert k v
| _ , _, _ => panic! "Json.setObjVal!: not an object: {j}"
open Lean.RBNode in
/-- Assuming both inputs `o₁, o₂` are json objects, will compute `{...o₁, ...o₂}`.
If `o₁` is not a json object, `o₂` will be returned.
-/
def mergeObj : Json → Json → Json
| obj kvs₁, obj kvs₂ =>
obj <| fold (insert compare) kvs₁ kvs₂
obj <| kvs₂.foldl Std.TreeMap.Raw.insert kvs₁
| _, j₂ => j₂
inductive Structured where
| arr (elems : Array Json)
| obj (kvPairs : RBNode String (fun _ => Json))
| obj (kvPairs : Std.TreeMap.Raw String Json compare)
instance : Coe (Array Json) Structured := ⟨Structured.arr⟩
instance : Coe (RBNode String (fun _ => Json)) Structured := ⟨Structured.obj⟩
instance : Coe (Std.TreeMap.Raw String Json) Structured := ⟨Structured.obj⟩
end Json
end Lean

266
src/Lean/Data/Json/FromToJson.lean
View file

@ -5,267 +5,5 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Marc Huisinga
-/
prelude
import Lean.Data.Json.Basic
import Lean.Data.Json.Printer
namespace Lean
universe u
class FromJson (α : Type u) where
fromJson? : Json → Except String α
export FromJson (fromJson?)
class ToJson (α : Type u) where
toJson : α → Json
export ToJson (toJson)
instance : FromJson Json := ⟨Except.ok⟩
instance : ToJson Json := ⟨id⟩
instance : FromJson JsonNumber := ⟨Json.getNum?⟩
instance : ToJson JsonNumber := ⟨Json.num⟩
instance : FromJson Empty where
fromJson? j := throw (s!"type Empty has no constructor to match JSON value '{j}'. \
This occurs when deserializing a value for type Empty, \
e.g. at type Option Empty with code for the 'some' constructor.")
instance : ToJson Empty := ⟨nofun⟩
-- looks like id, but there are coercions happening
instance : FromJson Bool := ⟨Json.getBool?⟩
instance : ToJson Bool := ⟨fun b => b⟩
instance : FromJson Nat := ⟨Json.getNat?⟩
instance : ToJson Nat := ⟨fun n => n⟩
instance : FromJson Int := ⟨Json.getInt?⟩
instance : ToJson Int := ⟨fun n => Json.num n⟩
instance : FromJson String := ⟨Json.getStr?⟩
instance : ToJson String := ⟨fun s => s⟩
instance : FromJson System.FilePath := ⟨fun j => System.FilePath.mk <$> Json.getStr? j⟩
instance : ToJson System.FilePath := ⟨fun p => p.toString⟩
protected def _root_.Array.fromJson? [FromJson α] : Json → Except String (Array α)
| Json.arr a => a.mapM fromJson?
| j => throw s!"expected JSON array, got '{j}'"
instance [FromJson α] : FromJson (Array α) where
fromJson? := Array.fromJson?
protected def _root_.Array.toJson [ToJson α] (a : Array α) : Json :=
Json.arr (a.map toJson)
instance [ToJson α] : ToJson (Array α) where
toJson := Array.toJson
protected def _root_.List.fromJson? [FromJson α] (j : Json) : Except String (List α) :=
(fromJson? j (α := Array α)).map Array.toList
instance [FromJson α] : FromJson (List α) where
fromJson? := List.fromJson?
protected def _root_.List.toJson [ToJson α] (a : List α) : Json :=
toJson a.toArray
instance [ToJson α] : ToJson (List α) where
toJson := List.toJson
protected def _root_.Option.fromJson? [FromJson α] : Json → Except String (Option α)
| Json.null => Except.ok none
| j => some <$> fromJson? j
instance [FromJson α] : FromJson (Option α) where
fromJson? := Option.fromJson?
protected def _root_.Option.toJson [ToJson α] : Option α → Json
| none => Json.null
| some a => toJson a
instance [ToJson α] : ToJson (Option α) where
toJson := Option.toJson
protected def _root_.Prod.fromJson? {α : Type u} {β : Type v} [FromJson α] [FromJson β] : Json → Except String (α × β)
| Json.arr #[ja, jb] => do
let ⟨a⟩ : ULift.{v} α := ← (fromJson? ja).map ULift.up
let ⟨b⟩ : ULift.{u} β := ← (fromJson? jb).map ULift.up
return (a, b)
| j => throw s!"expected pair, got '{j}'"
instance {α : Type u} {β : Type v} [FromJson α] [FromJson β] : FromJson (α × β) where
fromJson? := Prod.fromJson?
protected def _root_.Prod.toJson [ToJson α] [ToJson β] : α × β → Json
| (a, b) => Json.arr #[toJson a, toJson b]
instance [ToJson α] [ToJson β] : ToJson (α × β) where
toJson := Prod.toJson
protected def Name.fromJson? (j : Json) : Except String Name := do
let s ← j.getStr?
if s == "[anonymous]" then
return Name.anonymous
else
let n := s.toName
if n.isAnonymous then throw s!"expected a `Name`, got '{j}'"
return n
instance : FromJson Name where
fromJson? := Name.fromJson?
instance : ToJson Name where
toJson n := toString n
protected def NameMap.fromJson? [FromJson α] : Json → Except String (NameMap α)
| .obj obj => obj.foldM (init := {}) fun m k v => do
if k == "[anonymous]" then
return m.insert .anonymous (← fromJson? v)
else
let n := k.toName
if n.isAnonymous then
throw s!"expected a `Name`, got '{k}'"
else
return m.insert n (← fromJson? v)
| j => throw s!"expected a `NameMap`, got '{j}'"
instance [FromJson α] : FromJson (NameMap α) where
fromJson? := NameMap.fromJson?
protected def NameMap.toJson [ToJson α] (m : NameMap α) : Json :=
Json.obj <| m.fold (fun n k v => n.insert compare k.toString (toJson v)) .leaf
instance [ToJson α] : ToJson (NameMap α) where
toJson := NameMap.toJson
/-- Note that `USize`s and `UInt64`s are stored as strings because JavaScript
cannot represent 64-bit numbers. -/
def bignumFromJson? (j : Json) : Except String Nat := do
let s ← j.getStr?
let some v := Syntax.decodeNatLitVal? s -- TODO maybe this should be in Std
| throw s!"expected a string-encoded number, got '{j}'"
return v
def bignumToJson (n : Nat) : Json :=
toString n
protected def _root_.USize.fromJson? (j : Json) : Except String USize := do
let n ← bignumFromJson? j
if n ≥ USize.size then
throw "value '{j}' is too large for `USize`"
return USize.ofNat n
instance : FromJson USize where
fromJson? := USize.fromJson?
instance : ToJson USize where
toJson v := bignumToJson (USize.toNat v)
protected def _root_.UInt64.fromJson? (j : Json) : Except String UInt64 := do
let n ← bignumFromJson? j
if n ≥ UInt64.size then
throw "value '{j}' is too large for `UInt64`"
return UInt64.ofNat n
instance : FromJson UInt64 where
fromJson? := UInt64.fromJson?
instance : ToJson UInt64 where
toJson v := bignumToJson (UInt64.toNat v)
protected def _root_.Float.toJson (x : Float) : Json :=
match JsonNumber.fromFloat? x with
| Sum.inl e => Json.str e
| Sum.inr n => Json.num n
instance : ToJson Float where
toJson := Float.toJson
protected def _root_.Float.fromJson? : Json → Except String Float
| (Json.str "Infinity") => Except.ok (1.0 / 0.0)
| (Json.str "-Infinity") => Except.ok (-1.0 / 0.0)
| (Json.str "NaN") => Except.ok (0.0 / 0.0)
| (Json.num jn) => Except.ok jn.toFloat
| _ => Except.error "Expected a number or a string 'Infinity', '-Infinity', 'NaN'."
instance : FromJson Float where
fromJson? := Float.fromJson?
protected def RBMap.toJson [ToJson α] (m : RBMap String α cmp) : Json :=
Json.obj <| RBNode.map (fun _ => toJson) <| m.val
instance [ToJson α] : ToJson (RBMap String α cmp) where
toJson := RBMap.toJson
protected def RBMap.fromJson? [FromJson α] (j : Json) : Except String (RBMap String α cmp) := do
let o ← j.getObj?
o.foldM (fun x k v => x.insert k <$> fromJson? v) ∅
instance {cmp} [FromJson α] : FromJson (RBMap String α cmp) where
fromJson? := RBMap.fromJson?
namespace Json
protected def Structured.fromJson? : Json → Except String Structured
| .arr a => return Structured.arr a
| .obj o => return Structured.obj o
| j => throw s!"expected structured object, got '{j}'"
instance : FromJson Structured where
fromJson? := Structured.fromJson?
protected def Structured.toJson : Structured → Json
| .arr a => .arr a
| .obj o => .obj o
instance : ToJson Structured where
toJson := Structured.toJson
def toStructured? [ToJson α] (v : α) : Except String Structured :=
fromJson? (toJson v)
def getObjValAs? (j : Json) (α : Type u) [FromJson α] (k : String) : Except String α :=
fromJson? <| j.getObjValD k
def setObjValAs! (j : Json) {α : Type u} [ToJson α] (k : String) (v : α) : Json :=
j.setObjVal! k <| toJson v
def opt [ToJson α] (k : String) : Option α → List (String × Json)
| none => []
| some o => [⟨k, toJson o⟩]
/-- Parses a JSON-encoded `structure` or `inductive` constructor. Used mostly by `deriving FromJson`. -/
def parseTagged
(json : Json)
(tag : String)
(nFields : Nat)
(fieldNames? : Option (Array Name)) : Except String (Array Json) :=
if nFields == 0 then
match getStr? json with
| Except.ok s => if s == tag then Except.ok #[] else throw s!"incorrect tag: {s} ≟ {tag}"
| Except.error err => Except.error err
else
match getObjVal? json tag with
| Except.ok payload =>
match fieldNames? with
| some fieldNames =>
do
let mut fields := #[]
for fieldName in fieldNames do
fields := fields.push (←getObjVal? payload fieldName.getString!)
Except.ok fields
| none =>
if nFields == 1 then
Except.ok #[payload]
else
match getArr? payload with
| Except.ok fields =>
if fields.size == nFields then
Except.ok fields
else
Except.error s!"incorrect number of fields: {fields.size} ≟ {nFields}"
| Except.error err => Except.error err
| Except.error err => Except.error err
end Json
end Lean
import Lean.Data.Json.FromToJson.Basic
import Lean.Data.Json.FromToJson.Extra

258
src/Lean/Data/Json/FromToJson/Basic.lean Normal file
View file

@ -0,0 +1,258 @@
/-
Copyright (c) 2019 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Marc Huisinga
-/
prelude
import Lean.Data.Json.Basic
import Lean.Data.Json.Printer
namespace Lean
universe u
class FromJson (α : Type u) where
fromJson? : Json → Except String α
export FromJson (fromJson?)
class ToJson (α : Type u) where
toJson : α → Json
export ToJson (toJson)
instance : FromJson Json := ⟨Except.ok⟩
instance : ToJson Json := ⟨id⟩
instance : FromJson JsonNumber := ⟨Json.getNum?⟩
instance : ToJson JsonNumber := ⟨Json.num⟩
instance : FromJson Empty where
fromJson? j := throw (s!"type Empty has no constructor to match JSON value '{j}'. \
This occurs when deserializing a value for type Empty, \
e.g. at type Option Empty with code for the 'some' constructor.")
instance : ToJson Empty := ⟨nofun⟩
-- looks like id, but there are coercions happening
instance : FromJson Bool := ⟨Json.getBool?⟩
instance : ToJson Bool := ⟨fun b => b⟩
instance : FromJson Nat := ⟨Json.getNat?⟩
instance : ToJson Nat := ⟨fun n => n⟩
instance : FromJson Int := ⟨Json.getInt?⟩
instance : ToJson Int := ⟨fun n => Json.num n⟩
instance : FromJson String := ⟨Json.getStr?⟩
instance : ToJson String := ⟨fun s => s⟩
instance : FromJson System.FilePath := ⟨fun j => System.FilePath.mk <$> Json.getStr? j⟩
instance : ToJson System.FilePath := ⟨fun p => p.toString⟩
protected def _root_.Array.fromJson? [FromJson α] : Json → Except String (Array α)
| Json.arr a => a.mapM fromJson?
| j => throw s!"expected JSON array, got '{j}'"
instance [FromJson α] : FromJson (Array α) where
fromJson? := Array.fromJson?
protected def _root_.Array.toJson [ToJson α] (a : Array α) : Json :=
Json.arr (a.map toJson)
instance [ToJson α] : ToJson (Array α) where
toJson := Array.toJson
protected def _root_.List.fromJson? [FromJson α] (j : Json) : Except String (List α) :=
(fromJson? j (α := Array α)).map Array.toList
instance [FromJson α] : FromJson (List α) where
fromJson? := List.fromJson?
protected def _root_.List.toJson [ToJson α] (a : List α) : Json :=
toJson a.toArray
instance [ToJson α] : ToJson (List α) where
toJson := List.toJson
protected def _root_.Option.fromJson? [FromJson α] : Json → Except String (Option α)
| Json.null => Except.ok none
| j => some <$> fromJson? j
instance [FromJson α] : FromJson (Option α) where
fromJson? := Option.fromJson?
protected def _root_.Option.toJson [ToJson α] : Option α → Json
| none => Json.null
| some a => toJson a
instance [ToJson α] : ToJson (Option α) where
toJson := Option.toJson
protected def _root_.Prod.fromJson? {α : Type u} {β : Type v} [FromJson α] [FromJson β] : Json → Except String (α × β)
| Json.arr #[ja, jb] => do
let ⟨a⟩ : ULift.{v} α := ← (fromJson? ja).map ULift.up
let ⟨b⟩ : ULift.{u} β := ← (fromJson? jb).map ULift.up
return (a, b)
| j => throw s!"expected pair, got '{j}'"
instance {α : Type u} {β : Type v} [FromJson α] [FromJson β] : FromJson (α × β) where
fromJson? := Prod.fromJson?
protected def _root_.Prod.toJson [ToJson α] [ToJson β] : α × β → Json
| (a, b) => Json.arr #[toJson a, toJson b]
instance [ToJson α] [ToJson β] : ToJson (α × β) where
toJson := Prod.toJson
protected def Name.fromJson? (j : Json) : Except String Name := do
let s ← j.getStr?
if s == "[anonymous]" then
return Name.anonymous
else
let n := s.toName
if n.isAnonymous then throw s!"expected a `Name`, got '{j}'"
return n
instance : FromJson Name where
fromJson? := Name.fromJson?
instance : ToJson Name where
toJson n := toString n
protected def NameMap.fromJson? [FromJson α] : Json → Except String (NameMap α)
| .obj obj => obj.foldlM (init := {}) fun m k v => do
if k == "[anonymous]" then
return m.insert .anonymous (← fromJson? v)
else
let n := k.toName
if n.isAnonymous then
throw s!"expected a `Name`, got '{k}'"
else
return m.insert n (← fromJson? v)
| j => throw s!"expected a `NameMap`, got '{j}'"
instance [FromJson α] : FromJson (NameMap α) where
fromJson? := NameMap.fromJson?
protected def NameMap.toJson [ToJson α] (m : NameMap α) : Json :=
Json.obj <| m.foldl (fun n k v => n.insert k.toString (toJson v)) ∅
instance [ToJson α] : ToJson (NameMap α) where
toJson := NameMap.toJson
/-- Note that `USize`s and `UInt64`s are stored as strings because JavaScript
cannot represent 64-bit numbers. -/
def bignumFromJson? (j : Json) : Except String Nat := do
let s ← j.getStr?
let some v := Syntax.decodeNatLitVal? s -- TODO maybe this should be in Std
| throw s!"expected a string-encoded number, got '{j}'"
return v
def bignumToJson (n : Nat) : Json :=
toString n
protected def _root_.USize.fromJson? (j : Json) : Except String USize := do
let n ← bignumFromJson? j
if n ≥ USize.size then
throw "value '{j}' is too large for `USize`"
return USize.ofNat n
instance : FromJson USize where
fromJson? := USize.fromJson?
instance : ToJson USize where
toJson v := bignumToJson (USize.toNat v)
protected def _root_.UInt64.fromJson? (j : Json) : Except String UInt64 := do
let n ← bignumFromJson? j
if n ≥ UInt64.size then
throw "value '{j}' is too large for `UInt64`"
return UInt64.ofNat n
instance : FromJson UInt64 where
fromJson? := UInt64.fromJson?
instance : ToJson UInt64 where
toJson v := bignumToJson (UInt64.toNat v)
protected def _root_.Float.toJson (x : Float) : Json :=
match JsonNumber.fromFloat? x with
| Sum.inl e => Json.str e
| Sum.inr n => Json.num n
instance : ToJson Float where
toJson := Float.toJson
protected def _root_.Float.fromJson? : Json → Except String Float
| (Json.str "Infinity") => Except.ok (1.0 / 0.0)
| (Json.str "-Infinity") => Except.ok (-1.0 / 0.0)
| (Json.str "NaN") => Except.ok (0.0 / 0.0)
| (Json.num jn) => Except.ok jn.toFloat
| _ => Except.error "Expected a number or a string 'Infinity', '-Infinity', 'NaN'."
instance : FromJson Float where
fromJson? := Float.fromJson?
namespace Json
protected def Structured.fromJson? : Json → Except String Structured
| .arr a => return Structured.arr a
| .obj o => return Structured.obj o
| j => throw s!"expected structured object, got '{j}'"
instance : FromJson Structured where
fromJson? := Structured.fromJson?
protected def Structured.toJson : Structured → Json
| .arr a => .arr a
| .obj o => .obj o
instance : ToJson Structured where
toJson := Structured.toJson
def toStructured? [ToJson α] (v : α) : Except String Structured :=
fromJson? (toJson v)
def getObjValAs? (j : Json) (α : Type u) [FromJson α] (k : String) : Except String α :=
fromJson? <| j.getObjValD k
def setObjValAs! (j : Json) {α : Type u} [ToJson α] (k : String) (v : α) : Json :=
j.setObjVal! k <| toJson v
def opt [ToJson α] (k : String) : Option α → List (String × Json)
| none => []
| some o => [⟨k, toJson o⟩]
/-- Parses a JSON-encoded `structure` or `inductive` constructor. Used mostly by `deriving FromJson`. -/
def parseTagged
(json : Json)
(tag : String)
(nFields : Nat)
(fieldNames? : Option (Array Name)) : Except String (Array Json) :=
if nFields == 0 then
match getStr? json with
| Except.ok s => if s == tag then Except.ok #[] else throw s!"incorrect tag: {s} ≟ {tag}"
| Except.error err => Except.error err
else
match getObjVal? json tag with
| Except.ok payload =>
match fieldNames? with
| some fieldNames =>
do
let mut fields := #[]
for fieldName in fieldNames do
fields := fields.push (←getObjVal? payload fieldName.getString!)
Except.ok fields
| none =>
if nFields == 1 then
Except.ok #[payload]
else
match getArr? payload with
| Except.ok fields =>
if fields.size == nFields then
Except.ok fields
else
Except.error s!"incorrect number of fields: {fields.size} ≟ {nFields}"
| Except.error err => Except.error err
| Except.error err => Except.error err
end Json
end Lean

35
src/Lean/Data/Json/FromToJson/Extra.lean Normal file
View file

@ -0,0 +1,35 @@
/-
Copyright (c) 2019 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Marc Huisinga
-/
prelude
import Lean.Data.Json.FromToJson.Basic
import Std.Data.TreeMap.AdditionalOperations
/-
This module exists to cut the dependency on `Std.Data.TreeMap.AdditionalOperations` from a large
chunk of the meta framework.
-/
namespace Lean
private def TreeMap.toJson [ToJson α] (map : Std.TreeMap String α compare) : Json :=
let json := Std.TreeMap.map (fun _ => Lean.toJson) <| map
-- TODO(henrik): remove this after Q4
Json.obj <| Std.TreeMap.Raw.mk <| Std.DTreeMap.Raw.mk json.inner.inner
private def TreeMap.fromJson? {cmp} [FromJson α] (j : Json) :
Except String (Std.TreeMap String α cmp) := do
let o ← j.getObj?
o.foldlM (fun x k v => x.insert k <$> Lean.fromJson? v) ∅
instance [ToJson α] : ToJson (Std.TreeMap String α compare) where
toJson := TreeMap.toJson
instance {cmp} [FromJson α] : FromJson (Std.TreeMap String α cmp) where
fromJson? := TreeMap.fromJson?
end Lean

12
src/Lean/Data/Json/Parser.lean
View file

@ -6,7 +6,6 @@ Authors: Gabriel Ebner, Marc Huisinga
-/
prelude
import Lean.Data.Json.Basic
import Lean.Data.RBMap
import Std.Internal.Parsec
open Std.Internal.Parsec
@ -211,7 +210,8 @@ mutual
else
fail "unexpected character in array"
partial def objectCore (kvs : RBNode String (fun _ => Json)) : Parser (RBNode String (fun _ => Json)) := do
partial def objectCore (kvs : Std.TreeMap.Raw String Json) :
Parser (Std.TreeMap.Raw String Json) := do
lookahead (fun c => c == '"') "\""; skip;
let k ← str; ws
lookahead (fun c => c == ':') ":"; skip; ws
@ -219,10 +219,10 @@ mutual
let c ← any
if c == '}' then
ws
return kvs.insert compare k v
return kvs.insert k v
else if c == ',' then
ws
objectCore (kvs.insert compare k v)
objectCore (kvs.insert k v)
else
fail "unexpected character in object"
@ -242,9 +242,9 @@ mutual
let c ← peek!
if c == '}' then
skip; ws
return Json.obj (RBNode.leaf)
return Json.obj ∅
else
let kvs ← objectCore RBNode.leaf
let kvs ← objectCore ∅
return Json.obj kvs
else if c == '\"' then
skip

4
src/Lean/Data/Json/Printer.lean
View file

@ -96,7 +96,7 @@ partial def render : Json → Format
| obj kvs =>
let renderKV : String → Json → Format := fun k v =>
Format.group (renderString k ++ ":" ++ Format.line ++ render v);
let kvs := Format.joinSep (kvs.fold (fun acc k j => renderKV k j :: acc) []) ("," ++ Format.line);
let kvs := Format.joinSep (kvs.foldl (fun acc k j => renderKV k j :: acc) []) ("," ++ Format.line);
Format.bracket "{" kvs "}"
end
@ -124,7 +124,7 @@ where go (acc : String) : List Json.CompressWorkItem → String
| num s => go (acc ++ s.toString) is
| str s => go (renderString s acc) is
| arr elems => go (acc ++ "[") ((elems.map arrayElem).toListAppend (arrayEnd :: is))
| obj kvs => go (acc ++ "{") (kvs.fold (init := []) (fun acc k j => objectField k j :: acc) ++ [objectEnd] ++ is)
| obj kvs => go (acc ++ "{") (kvs.foldl (init := []) (fun acc k j => objectField k j :: acc) ++ [objectEnd] ++ is)
| arrayElem j :: arrayEnd :: is => go acc (json j :: arrayEnd :: is)
| arrayElem j :: is => go acc (json j :: comma :: is)
| arrayEnd :: is => go (acc ++ "]") is

1
src/Lean/Data/Json/Stream.lean
View file

@ -8,7 +8,6 @@ prelude
import Init.System.IO
import Lean.Data.Json.Parser
import Lean.Data.Json.Printer
import Lean.Data.Json.FromToJson
namespace IO.FS.Stream

4
src/Lean/Data/JsonRpc.lean
View file

@ -6,8 +6,8 @@ Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Init.System.IO
import Lean.Data.RBTree
import Lean.Data.Json
import Lean.Data.Json.Stream
import Lean.Data.Json.FromToJson.Basic
/-! Implementation of JSON-RPC 2.0 (https://www.jsonrpc.org/specification)
for use in the LSP server. -/

4
src/Lean/Data/KVMap.lean
View file

@ -59,8 +59,8 @@ instance : Coe Syntax DataValue := ⟨.ofSyntax⟩
/--
A key-value map. We use it to represent user-selected options and `Expr.mdata`.
Remark: we do not use `RBMap` here because we need to manipulate `KVMap` objects in
C++ and `RBMap` is implemented in Lean. So, we use just a `List` until we can
Remark: we do not use a Lean `Std.TreeMap` here because we need to manipulate `KVMap` objects in
C++ and `Std.TreeMap` is implemented in Lean. So, we use just a `List` until we can
generate C++ code from Lean code.
-/
structure KVMap where

34
src/Lean/Data/Lsp/Basic.lean
View file

@ -6,6 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Lean.Data.Json
import Lean.Data.Lsp.BasicAux
/-! Defines most of the 'Basic Structures' in the LSP specification
(https://microsoft.github.io/language-server-protocol/specifications/specification-current/),
@ -18,31 +19,6 @@ namespace Lsp
open Json
abbrev DocumentUri := String
/-- We adopt the convention that zero-based UTF-16 positions as sent by LSP clients
are represented by `Lsp.Position` while internally we mostly use `String.Pos` UTF-8
offsets. For diagnostics, one-based `Lean.Position`s are used internally.
`character` is accepted liberally: actual character := min(line length, character) -/
structure Position where
line : Nat
character : Nat
deriving Inhabited, BEq, Ord, Hashable, ToJson, FromJson, Repr
instance : ToString Position := ⟨fun p =>
"(" ++ toString p.line ++ ", " ++ toString p.character ++ ")"⟩
instance : LT Position := ltOfOrd
instance : LE Position := leOfOrd
structure Range where
start : Position
«end» : Position
deriving Inhabited, BEq, Hashable, ToJson, FromJson, Ord, Repr
instance : LT Range := ltOfOrd
instance : LE Range := leOfOrd
/-- A `Location` is a `DocumentUri` and a `Range`. -/
structure Location where
uri : DocumentUri
@ -249,7 +225,7 @@ instance : FromJson DocumentChange where
[reference](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#workspaceEdit) -/
structure WorkspaceEdit where
/-- Changes to existing resources. -/
changes? : Option (RBMap DocumentUri TextEditBatch compare) := none
changes? : Option (Std.TreeMap DocumentUri TextEditBatch) := none
/-- Depending on the client capability
`workspace.workspaceEdit.resourceOperations` document changes are either
an array of `TextDocumentEdit`s to express changes to n different text
@ -270,7 +246,7 @@ structure WorkspaceEdit where
Whether clients honor this property depends on the client capability
`workspace.changeAnnotationSupport`. -/
changeAnnotations? : Option (RBMap String ChangeAnnotation compare) := none
changeAnnotations? : Option (Std.TreeMap String ChangeAnnotation) := none
deriving ToJson, FromJson
namespace WorkspaceEdit
@ -282,7 +258,7 @@ instance : Append WorkspaceEdit where
changes? :=
match x.changes?, y.changes? with
| v, none | none, v => v
| some x, some y => x.mergeBy (fun _ v₁ v₂ => v₁ ++ v₂) y
| some x, some y => x.mergeWith (fun _ v₁ v₂ => v₁ ++ v₂) y
documentChanges? :=
match x.documentChanges?, y.documentChanges? with
| v, none | none, v => v
@ -290,7 +266,7 @@ instance : Append WorkspaceEdit where
changeAnnotations? :=
match x.changeAnnotations?, y.changeAnnotations? with
| v, none | none, v => v
| some x, some y => x.mergeBy (fun _ _v₁ v₂ => v₂) y
| some x, some y => x.mergeWith (fun _ _v₁ v₂ => v₂) y
}
def ofTextDocumentEdit (e : TextDocumentEdit) : WorkspaceEdit :=

48
src/Lean/Data/Lsp/BasicAux.lean Normal file
View file

@ -0,0 +1,48 @@
/-
Copyright (c) 2020 Marc Huisinga. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Lean.Data.Json.FromToJson.Basic
/-
This module exists to cut the dependency on `Std.Data.TreeMap.AdditionalOperations` from a large
chunk of the meta framework.
-/
namespace Lean
namespace Lsp
open Json
abbrev DocumentUri := String
/-- We adopt the convention that zero-based UTF-16 positions as sent by LSP clients
are represented by `Lsp.Position` while internally we mostly use `String.Pos` UTF-8
offsets. For diagnostics, one-based `Lean.Position`s are used internally.
`character` is accepted liberally: actual character := min(line length, character) -/
structure Position where
line : Nat
character : Nat
deriving Inhabited, BEq, Ord, Hashable, ToJson, FromJson, Repr
instance : ToString Position := ⟨fun p =>
"(" ++ toString p.line ++ ", " ++ toString p.character ++ ")"⟩
instance : LT Position := ltOfOrd
instance : LE Position := leOfOrd
structure Range where
start : Position
«end» : Position
deriving Inhabited, BEq, Hashable, ToJson, FromJson, Ord, Repr
instance : LT Range := ltOfOrd
instance : LE Range := leOfOrd
end Lsp
end Lean

1
src/Lean/Data/Lsp/Client.lean
View file

@ -6,7 +6,6 @@ Authors: Joscha Mennicken
-/
prelude
import Lean.Data.Lsp.Basic
import Lean.Data.Json
namespace Lean
namespace Lsp

1
src/Lean/Data/Lsp/CodeActions.lean
View file

@ -5,7 +5,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: E.W.Ayers
-/
prelude
import Lean.Data.Json
import Lean.Data.Lsp.Basic
import Lean.Data.Lsp.Diagnostics

1
src/Lean/Data/Lsp/Diagnostics.lean
View file

@ -5,7 +5,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Lean.Data.Json
import Lean.Data.Lsp.Basic
import Lean.Data.Lsp.Utf16

1
src/Lean/Data/Lsp/InitShutdown.lean
View file

@ -7,7 +7,6 @@ Authors: Marc Huisinga, Wojciech Nawrocki
prelude
import Lean.Data.Lsp.Capabilities
import Lean.Data.Lsp.Workspace
import Lean.Data.Json
/-! Functionality to do with initializing and shutting down
the server ("General Messages" section of LSP spec). -/

3
src/Lean/Data/Lsp/Internal.lean
View file

@ -8,7 +8,6 @@ prelude
import Lean.Expr
import Lean.Data.Lsp.Basic
import Lean.Data.JsonRpc
import Std.Data.TreeMap
set_option linter.missingDocs true -- keep it documented
@ -196,7 +195,7 @@ instance : ToJson ModuleRefs where
instance : FromJson ModuleRefs where
fromJson? j := do
let node ← j.getObj?
node.foldM (init := ∅) fun m k v =>
node.foldlM (init := ∅) fun m k v =>
return m.insert (← RefIdent.fromJson? (← Json.parse k)) (← fromJson? v)
/--

2
src/Lean/Data/Lsp/Ipc.lean
View file

@ -6,7 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Init.System.IO
import Lean.Data.Json
import Lean.Data.Json.Basic
import Lean.Data.Lsp.Communication
import Lean.Data.Lsp.Diagnostics
import Lean.Data.Lsp.Extra

2
src/Lean/Data/Lsp/LanguageFeatures.lean
View file

@ -5,7 +5,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Wojciech Nawrocki
-/
prelude
import Lean.Data.Json
import Lean.Data.Json.FromToJson.Basic
import Lean.Data.Lsp.Basic
namespace Lean

2
src/Lean/Data/Lsp/TextSync.lean
View file

@ -5,7 +5,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Lean.Data.Json
import Lean.Data.Json.FromToJson.Basic
import Lean.Data.Lsp.Basic
/-! Section "Text Document Synchronization" of the LSP spec. -/

2
src/Lean/Data/Lsp/Utf16.lean
View file

@ -6,7 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Init.Data.String
import Lean.Data.Lsp.Basic
import Lean.Data.Lsp.BasicAux
import Lean.Data.Position
import Lean.DeclarationRange

2
src/Lean/Data/Lsp/Window.lean
View file

@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Marc Huisinga
-/
prelude
import Lean.Data.Json
import Lean.Data.Json.FromToJson.Basic
open Lean

2
src/Lean/Data/Lsp/Workspace.lean
View file

@ -6,7 +6,7 @@ Authors: Wojciech Nawrocki
-/
prelude
import Lean.Data.Lsp.Basic
import Lean.Data.Json
import Lean.Data.Json.FromToJson.Basic
namespace Lean
namespace Lsp

103
src/Lean/Data/NameMap.lean
View file

@ -4,104 +4,5 @@ Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Std.Data.HashSet.Basic
import Lean.Data.RBMap
import Lean.Data.RBTree
import Lean.Data.SSet
import Lean.Data.Name
namespace Lean
def NameMap (α : Type) := RBMap Name α Name.quickCmp
@[inline] def mkNameMap (α : Type) : NameMap α := mkRBMap Name α Name.quickCmp
namespace NameMap
variable {α : Type}
instance [Repr α] : Repr (NameMap α) := inferInstanceAs (Repr (RBMap Name α Name.quickCmp))
instance (α : Type) : EmptyCollection (NameMap α) := ⟨mkNameMap α⟩
instance (α : Type) : Inhabited (NameMap α) where
default := {}
def insert (m : NameMap α) (n : Name) (a : α) := RBMap.insert m n a
def contains (m : NameMap α) (n : Name) : Bool := RBMap.contains m n
def find? (m : NameMap α) (n : Name) : Option α := RBMap.find? m n
instance : ForIn m (NameMap α) (Name × α) :=
inferInstanceAs (ForIn _ (RBMap ..) ..)
/-- `filter f m` returns the `NameMap` consisting of all
"`key`/`val`"-pairs in `m` where `f key val` returns `true`. -/
def filter (f : Name → α → Bool) (m : NameMap α) : NameMap α := RBMap.filter f m
/-- `filterMap f m` filters an `NameMap` and simultaneously modifies the filtered values.
It takes a function `f : Name → α → Option β` and applies `f name` to the value with key `name`.
The resulting entries with non-`none` value are collected to form the output `NameMap`. -/
def filterMap (f : Name → α → Option β) (m : NameMap α) : NameMap β := RBMap.filterMap f m
end NameMap
def NameSet := RBTree Name Name.quickCmp
namespace NameSet
def empty : NameSet := mkRBTree Name Name.quickCmp
instance : EmptyCollection NameSet := ⟨empty⟩
instance : Inhabited NameSet := ⟨empty⟩
def insert (s : NameSet) (n : Name) : NameSet := RBTree.insert s n
def contains (s : NameSet) (n : Name) : Bool := RBMap.contains s n
instance : ForIn m NameSet Name :=
inferInstanceAs (ForIn _ (RBTree ..) ..)
/-- The union of two `NameSet`s. -/
def append (s t : NameSet) : NameSet :=
s.mergeBy (fun _ _ _ => .unit) t
instance : Append NameSet where
append := NameSet.append
/-- `filter f s` returns the `NameSet` consisting of all `x` in `s` where `f x` returns `true`. -/
def filter (f : Name → Bool) (s : NameSet) : NameSet := RBTree.filter f s
end NameSet
def NameSSet := SSet Name
namespace NameSSet
abbrev empty : NameSSet := SSet.empty
instance : EmptyCollection NameSSet := ⟨empty⟩
instance : Inhabited NameSSet := ⟨empty⟩
abbrev insert (s : NameSSet) (n : Name) : NameSSet := SSet.insert s n
abbrev contains (s : NameSSet) (n : Name) : Bool := SSet.contains s n
end NameSSet
def NameHashSet := Std.HashSet Name
namespace NameHashSet
@[inline] def empty : NameHashSet := (∅ : Std.HashSet Name)
instance : EmptyCollection NameHashSet := ⟨empty⟩
instance : Inhabited NameHashSet := ⟨{}⟩
def insert (s : NameHashSet) (n : Name) := Std.HashSet.insert s n
def contains (s : NameHashSet) (n : Name) : Bool := Std.HashSet.contains s n
/-- `filter f s` returns the `NameHashSet` consisting of all `x` in `s` where `f x` returns `true`. -/
def filter (f : Name → Bool) (s : NameHashSet) : NameHashSet := Std.HashSet.filter f s
end NameHashSet
def MacroScopesView.isPrefixOf (v₁ v₂ : MacroScopesView) : Bool :=
v₁.name.isPrefixOf v₂.name &&
v₁.scopes == v₂.scopes &&
v₁.mainModule == v₂.mainModule &&
v₁.imported == v₂.imported
def MacroScopesView.isSuffixOf (v₁ v₂ : MacroScopesView) : Bool :=
v₁.name.isSuffixOf v₂.name &&
v₁.scopes == v₂.scopes &&
v₁.mainModule == v₂.mainModule &&
v₁.imported == v₂.imported
end Lean
import Lean.Data.NameMap.Basic
import Lean.Data.NameMap.AdditionalOperations

20
src/Lean/Data/NameMap/AdditionalOperations.lean Normal file
View file

@ -0,0 +1,20 @@
/-
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Lean.Data.NameMap.Basic
import Std.Data.TreeSet.AdditionalOperations
namespace Lean
namespace NameMap
/-- `filterMap f m` filters an `NameMap` and simultaneously modifies the filtered values.
It takes a function `f : Name → α → Option β` and applies `f name` to the value with key `name`.
The resulting entries with non-`none` value are collected to form the output `NameMap`. -/
def filterMap (f : Name → α → Option β) (m : NameMap α) : NameMap β := Std.TreeMap.filterMap f m
end NameMap
end Lean

105
src/Lean/Data/NameMap/Basic.lean Normal file
View file

@ -0,0 +1,105 @@
/-
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Std.Data.HashSet.Basic
import Std.Data.TreeSet.Basic
import Lean.Data.SSet
import Lean.Data.Name
namespace Lean
def NameMap (α : Type) := Std.TreeMap Name α Name.quickCmp
@[inline] def mkNameMap (α : Type) : NameMap α := Std.TreeMap.empty
namespace NameMap
variable {α : Type}
instance [Repr α] : Repr (NameMap α) := inferInstanceAs (Repr (Std.TreeMap _ _ _))
instance (α : Type) : EmptyCollection (NameMap α) := ⟨mkNameMap α⟩
instance (α : Type) : Inhabited (NameMap α) where
default := {}
def insert (m : NameMap α) (n : Name) (a : α) := Std.TreeMap.insert m n a
def contains (m : NameMap α) (n : Name) : Bool := Std.TreeMap.contains m n
def find? (m : NameMap α) (n : Name) : Option α := Std.TreeMap.get? m n
instance : ForIn m (NameMap α) (Name × α) :=
inferInstanceAs (ForIn _ (Std.TreeMap _ _ _) ..)
/-- `filter f m` returns the `NameMap` consisting of all
"`key`/`val`"-pairs in `m` where `f key val` returns `true`. -/
def filter (f : Name → α → Bool) (m : NameMap α) : NameMap α := Std.TreeMap.filter f m
end NameMap
def NameSet := Std.TreeSet Name Name.quickCmp
namespace NameSet
def empty : NameSet := Std.TreeSet.empty
instance : EmptyCollection NameSet := ⟨empty⟩
instance : Inhabited NameSet := ⟨empty⟩
def insert (s : NameSet) (n : Name) : NameSet := Std.TreeSet.insert s n
def contains (s : NameSet) (n : Name) : Bool := Std.TreeSet.contains s n
instance : ForIn m NameSet Name :=
inferInstanceAs (ForIn _ (Std.TreeSet _ _) ..)
/-- The union of two `NameSet`s. -/
def append (s t : NameSet) : NameSet :=
s.merge t
instance : Append NameSet where
append := NameSet.append
/-- `filter f s` returns the `NameSet` consisting of all `x` in `s` where `f x` returns `true`. -/
def filter (f : Name → Bool) (s : NameSet) : NameSet := Std.TreeSet.filter f s
def ofList (l : List Name) : NameSet := Std.TreeSet.ofList l _
def ofArray (l : Array Name) : NameSet := Std.TreeSet.ofArray l _
end NameSet
def NameSSet := SSet Name
namespace NameSSet
abbrev empty : NameSSet := SSet.empty
instance : EmptyCollection NameSSet := ⟨empty⟩
instance : Inhabited NameSSet := ⟨empty⟩
abbrev insert (s : NameSSet) (n : Name) : NameSSet := SSet.insert s n
abbrev contains (s : NameSSet) (n : Name) : Bool := SSet.contains s n
end NameSSet
def NameHashSet := Std.HashSet Name
namespace NameHashSet
@[inline] def empty : NameHashSet := (∅ : Std.HashSet Name)
instance : EmptyCollection NameHashSet := ⟨empty⟩
instance : Inhabited NameHashSet := ⟨{}⟩
def insert (s : NameHashSet) (n : Name) := Std.HashSet.insert s n
def contains (s : NameHashSet) (n : Name) : Bool := Std.HashSet.contains s n
/-- `filter f s` returns the `NameHashSet` consisting of all `x` in `s` where `f x` returns `true`. -/
def filter (f : Name → Bool) (s : NameHashSet) : NameHashSet := Std.HashSet.filter f s
end NameHashSet
def MacroScopesView.isPrefixOf (v₁ v₂ : MacroScopesView) : Bool :=
v₁.name.isPrefixOf v₂.name &&
v₁.scopes == v₂.scopes &&
v₁.mainModule == v₂.mainModule &&
v₁.imported == v₂.imported
def MacroScopesView.isSuffixOf (v₁ v₂ : MacroScopesView) : Bool :=
v₁.name.isSuffixOf v₂.name &&
v₁.scopes == v₂.scopes &&
v₁.mainModule == v₂.mainModule &&
v₁.imported == v₂.imported
end Lean

4
src/Lean/Data/Options.lean
View file

@ -6,7 +6,7 @@ Authors: Sebastian Ullrich and Leonardo de Moura
prelude
import Lean.ImportingFlag
import Lean.Data.KVMap
import Lean.Data.NameMap
import Lean.Data.NameMap.Basic
namespace Lean
@ -46,7 +46,7 @@ def getOptionDecls : IO OptionDecls := optionDeclsRef.get
@[export lean_get_option_decls_array]
def getOptionDeclsArray : IO (Array (Name × OptionDecl)) := do
let decls ← getOptionDecls
pure $ decls.fold
return decls.foldl
(fun (r : Array (Name × OptionDecl)) k v => r.push (k, v))
#[]

2
src/Lean/Data/Position.lean
View file

@ -5,7 +5,7 @@ Authors: Leonardo de Moura, Sebastian Ullrich
-/
prelude
import Lean.Data.Format
import Lean.Data.Json
import Lean.Data.Json.FromToJson.Basic
import Lean.ToExpr
namespace Lean

50
src/Lean/Data/PrefixTree.lean
View file

@ -4,85 +4,85 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Data.RBMap
import Std.Data.TreeMap.Raw.Basic
namespace Lean
/- Similar to trie, but for arbitrary keys -/
inductive PrefixTreeNode (α : Type u) (β : Type v) where
| Node : Option β → RBNode α (fun _ => PrefixTreeNode α β) → PrefixTreeNode α β
inductive PrefixTreeNode (α : Type u) (β : Type v) (cmp : α → α → Ordering) where
| Node : Option β → Std.TreeMap.Raw α (PrefixTreeNode α β cmp) cmp → PrefixTreeNode α β cmp
instance : Inhabited (PrefixTreeNode α β) where
default := PrefixTreeNode.Node none RBNode.leaf
instance : Inhabited (PrefixTreeNode α β cmp) where
default := PrefixTreeNode.Node none ∅
namespace PrefixTreeNode
def empty : PrefixTreeNode α β :=
PrefixTreeNode.Node none RBNode.leaf
def empty : PrefixTreeNode α β cmp :=
PrefixTreeNode.Node none ∅
@[specialize]
partial def insert (t : PrefixTreeNode α β) (cmp : α → α → Ordering) (k : List α) (val : β) : PrefixTreeNode α β :=
let rec insertEmpty (k : List α) : PrefixTreeNode α β :=
partial def insert (cmp : α → α → Ordering) (t : PrefixTreeNode α β cmp) (k : List α) (val : β) : PrefixTreeNode α β cmp :=
let rec insertEmpty (k : List α) : PrefixTreeNode α β cmp :=
match k with
| [] => PrefixTreeNode.Node (some val) RBNode.leaf
| [] => PrefixTreeNode.Node (some val) ∅
| k :: ks =>
let t := insertEmpty ks
PrefixTreeNode.Node none (RBNode.singleton k t)
PrefixTreeNode.Node none {(k, t)}
let rec loop
| PrefixTreeNode.Node _ m, [] =>
PrefixTreeNode.Node (some val) m -- overrides old value
| PrefixTreeNode.Node v m, k :: ks =>
let t := match RBNode.find cmp m k with
let t := match m.get? k with
| none => insertEmpty ks
| some t => loop t ks
PrefixTreeNode.Node v (RBNode.insert cmp m k t)
PrefixTreeNode.Node v (m.insert k t)
loop t k
@[specialize]
partial def find? (t : PrefixTreeNode α β) (cmp : α → α → Ordering) (k : List α) : Option β :=
partial def find? (cmp : α → α → Ordering) (t : PrefixTreeNode α β cmp) (k : List α) : Option β :=
let rec loop
| PrefixTreeNode.Node val _, [] => val
| PrefixTreeNode.Node _ m, k :: ks =>
match RBNode.find cmp m k with
match m.get? k with
| none => none
| some t => loop t ks
loop t k
/-- Returns the the value of the longest key in `t` that is a prefix of `k`, if any. -/
@[specialize]
partial def findLongestPrefix? (t : PrefixTreeNode α β) (cmp : α → α → Ordering) (k : List α) : Option β :=
partial def findLongestPrefix? (cmp : α → α → Ordering) (t : PrefixTreeNode α β cmp) (k : List α) : Option β :=
let rec loop acc?
| PrefixTreeNode.Node val _, [] => val <|> acc?
| PrefixTreeNode.Node val m, k :: ks =>
match RBNode.find cmp m k with
match m.get? k with
| none => val
| some t => loop (val <|> acc?) t ks
loop none t k
@[specialize]
partial def foldMatchingM [Monad m] (t : PrefixTreeNode α β) (cmp : α → α → Ordering) (k : List α) (init : σ) (f : β → σ → m σ) : m σ :=
let rec fold : PrefixTreeNode α β → σ → m σ
partial def foldMatchingM [Monad m] (cmp : α → α → Ordering) (t : PrefixTreeNode α β cmp) (k : List α) (init : σ) (f : β → σ → m σ) : m σ :=
let rec fold : PrefixTreeNode α β cmp → σ → m σ
| PrefixTreeNode.Node b? n, d => do
let d ← match b? with
| none => pure d
| some b => f b d
n.foldM (init := d) fun d _ t => fold t d
let rec find : List α → PrefixTreeNode α β → σ → m σ
n.foldlM (init := d) fun d _ t => fold t d
let rec find : List α → PrefixTreeNode α β cmp → σ → m σ
| [], t, d => fold t d
| k::ks, PrefixTreeNode.Node _ m, d =>
match RBNode.find cmp m k with
match m.get? k with
| none => pure init
| some t => find ks t d
find k t init
inductive WellFormed (cmp : α → α → Ordering) : PrefixTreeNode α β → Prop where
inductive WellFormed (cmp : α → α → Ordering) : PrefixTreeNode α β cmp → Prop where
| emptyWff : WellFormed cmp empty
| insertWff : WellFormed cmp t → WellFormed cmp (insert t cmp k val)
| insertWff : WellFormed cmp t → WellFormed cmp (insert cmp t k val)
end PrefixTreeNode
def PrefixTree (α : Type u) (β : Type v) (cmp : α → α → Ordering) : Type (max u v) :=
{ t : PrefixTreeNode α β // t.WellFormed cmp }
{ t : PrefixTreeNode α β cmp // t.WellFormed cmp }
open PrefixTreeNode

2
src/Lean/Data/Trie.lean
View file

@ -17,7 +17,7 @@ namespace Data
Tries have typically many nodes with small degree, where a linear scan
through the (compact) `ByteArray` is faster than using binary search or
search trees like `RBTree`.
search trees like `Std.TreeMap`.
Moreover, many nodes have degree 1, which justifies the special case `Node1`
constructor.

6
src/Lean/Data/Xml/Basic.lean
View file

@ -4,14 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
Author: Dany Fabian
-/
prelude
import Lean.Data.RBMap
import Init.Data.ToString.Macro
import Std.Data.TreeMap.Basic
namespace Lean
namespace Xml
def Attributes := RBMap String String compare
instance : ToString Attributes := ⟨λ as => as.fold (λ s n v => s ++ s!" {n}=\"{v}\"") ""⟩
def Attributes := Std.TreeMap String String
instance : ToString Attributes := ⟨λ as => as.foldl (λ s n v => s ++ s!" {n}=\"{v}\"") ""⟩
mutual
inductive Element

2
src/Lean/Data/Xml/Parser.lean
View file

@ -411,7 +411,7 @@ protected def elementPrefix : Parser (Array Content → Element) := do
let name ← Name
let attributes ← many (attempt <| S *> Attribute)
optional S *> pure ()
return Element.Element name (RBMap.fromList attributes.toList compare)
return Element.Element name (Std.TreeMap.ofList attributes.toList compare)
/-- https://www.w3.org/TR/xml/#NT-EmptyElemTag -/
def EmptyElemTag (elem : Array Content → Element) : Parser Element := do

2
src/Lean/Elab/App.lean
View file

@ -1379,7 +1379,7 @@ private def resolveLValAux (e : Expr) (eType : Expr) (lval : LVal) : TermElabM L
let fullName := Name.mkStr structName fieldName
for localDecl in (← getLCtx) do
if localDecl.isAuxDecl then
if let some localDeclFullName := (← getLCtx).auxDeclToFullName.find? localDecl.fvarId then
if let some localDeclFullName := (← getLCtx).auxDeclToFullName.get? localDecl.fvarId then
if fullName == (privateToUserName? localDeclFullName).getD localDeclFullName then
/- LVal notation is being used to make a "local" recursive call. -/
return LValResolution.localRec structName fullName localDecl.toExpr

2
src/Lean/Elab/DeclNameGen.lean
View file

@ -215,7 +215,7 @@ def mkBaseNameWithSuffix (pre : String) (type : Expr) : MetaM Name := do
let name := pre ++ name
let project := (← getMainModule).getRoot
-- Collect the modules for each constant that appeared.
let modules ← st.consts.foldM (init := Array.mkEmpty st.consts.size) fun mods name => return mods.push (← findModuleOf? name)
let modules ← st.consts.foldlM (init := Array.mkEmpty st.consts.size) fun mods name => return mods.push (← findModuleOf? name)
-- We can avoid adding the suffix if the instance refers to module-local names.
let isModuleLocal := modules.any Option.isNone
-- We can also avoid adding the full module suffix if the instance refers to "project"-local names.

2
src/Lean/Elab/Deriving/FromToJson.lean
View file

@ -7,7 +7,7 @@ prelude
import Lean.Meta.Transform
import Lean.Elab.Deriving.Basic
import Lean.Elab.Deriving.Util
import Lean.Data.Json.FromToJson
import Lean.Data.Json.FromToJson.Basic
namespace Lean.Elab.Deriving.FromToJson
open Lean.Elab.Command

4
src/Lean/Elab/Deriving/Inhabited.lean
View file

@ -10,7 +10,7 @@ import Lean.Elab.Deriving.Basic
namespace Lean.Elab
open Command Meta Parser Term
private abbrev IndexSet := RBTree Nat compare
private abbrev IndexSet := Std.TreeSet Nat
private abbrev LocalInst2Index := FVarIdMap Nat
private def implicitBinderF := Parser.Term.implicitBinder
@ -51,7 +51,7 @@ where
let visit {ω} : StateRefT IndexSet (ST ω) Unit :=
e.forEachWhere Expr.isFVar fun e =>
let fvarId := e.fvarId!
match localInst2Index.find? fvarId with
match localInst2Index.get? fvarId with
| some idx => modify (·.insert idx)
| none => pure ()
runST (fun _ => visit |>.run usedInstIdxs) |>.2

8
src/Lean/Elab/Do.lean
View file

@ -239,7 +239,7 @@ def Code.getRef? : Code → Option Syntax
| .matchExpr ref .. => ref
| .jmp ref .. => ref
abbrev VarSet := RBMap Name Syntax Name.cmp
abbrev VarSet := Std.TreeMap Name Syntax Name.cmp
/-- A code block, and the collection of variables updated by it. -/
structure CodeBlock where
@ -247,7 +247,7 @@ structure CodeBlock where
uvars : VarSet := {} -- set of variables updated by `code`
private def varSetToArray (s : VarSet) : Array Var :=
s.fold (fun xs _ x => xs.push x) #[]
s.foldl (fun xs _ x => xs.push x) #[]
private def varsToMessageData (vars : Array Var) : MessageData :=
MessageData.joinSep (vars.toList.map fun n => MessageData.ofName (n.getId.simpMacroScopes)) " "
@ -540,7 +540,7 @@ partial def extendUpdatedVars (c : CodeBlock) (ws : VarSet) : TermElabM CodeBloc
pure { c with uvars := ws }
private def union (s₁ s₂ : VarSet) : VarSet :=
s₁.fold (·.insert ·) s₂
s₁.foldl (·.insert ·) s₂
/--
Given two code blocks `c₁` and `c₂`, make sure they have the same set of updated variables.
@ -1578,7 +1578,7 @@ mutual
-- semantic no-op that replaces the `uvars`' position information (which all point inside the loop)
-- with that of the respective mutable declarations outside the loop, which allows the language
-- server to identify them as conceptually identical variables
let uvars := uvars.map fun v => ctx.mutableVars.findD v.getId v
let uvars := uvars.map fun v => ctx.mutableVars.getD v.getId v
let uvarsTuple ← liftMacroM do mkTuple uvars
if hasReturn forInBodyCodeBlock.code then
let forInBody ← liftMacroM <| destructTuple uvars (← `(r)) forInBody

2
src/Lean/Elab/InfoTree/Types.lean
View file

@ -9,7 +9,7 @@ import Lean.Data.DeclarationRange
import Lean.Data.OpenDecl
import Lean.MetavarContext
import Lean.Environment
import Lean.Data.Json
import Lean.Data.Json.Basic
import Lean.Server.Rpc.Basic
import Lean.Widget.Types

24
src/Lean/Elab/MutualDef.lean
View file

@ -788,7 +788,7 @@ private def modifyUsedFVars (f : UsedFVarsMap → UsedFVarsMap) : M Unit := modi
-- merge s₂ into s₁
private def merge (s₁ s₂ : FVarIdSet) : M FVarIdSet :=
s₂.foldM (init := s₁) fun s₁ k => do
s₂.foldlM (init := s₁) fun s₁ k => do
if s₁.contains k then
return s₁
else
@ -797,14 +797,14 @@ private def merge (s₁ s₂ : FVarIdSet) : M FVarIdSet :=
private def updateUsedVarsOf (fvarId : FVarId) : M Unit := do
let usedFVarsMap ← getUsedFVarsMap
match usedFVarsMap.find? fvarId with
match usedFVarsMap.get? fvarId with
| none => return ()
| some fvarIds =>
let fvarIdsNew ← fvarIds.foldM (init := fvarIds) fun fvarIdsNew fvarId' => do
let fvarIdsNew ← fvarIds.foldlM (init := fvarIds) fun fvarIdsNew fvarId' => do
if fvarId == fvarId' then
return fvarIdsNew
else
match usedFVarsMap.find? fvarId' with
match usedFVarsMap.get? fvarId' with
| none => return fvarIdsNew
/- We are being sloppy here `otherFVarIds` may contain free variables that are
not in the context of the let-rec associated with fvarId.
@ -837,8 +837,8 @@ private def mkFreeVarMap [Monad m] [MonadMCtx m]
let mut freeVarMap := {}
for toLift in letRecsToLift do
let lctx := toLift.lctx
let fvarIdsSet := usedFVarsMap.find? toLift.fvarId |>.get!
let fvarIds := fvarIdsSet.fold (init := #[]) fun fvarIds fvarId =>
let fvarIdsSet := usedFVarsMap.get? toLift.fvarId |>.get!
let fvarIds := fvarIdsSet.foldl (init := #[]) fun fvarIds fvarId =>
if lctx.contains fvarId && !recFVarIds.contains fvarId then
fvarIds.push fvarId
else
@ -863,7 +863,7 @@ private def preprocess (e : Expr) : TermElabM Expr := do
/-- Push free variables in `s` to `toProcess` if they are not already there. -/
private def pushNewVars (toProcess : Array FVarId) (s : CollectFVars.State) : Array FVarId :=
s.fvarSet.fold (init := toProcess) fun toProcess fvarId =>
s.fvarSet.foldl (init := toProcess) fun toProcess fvarId =>
if toProcess.contains fvarId then toProcess else toProcess.push fvarId
private def pushLocalDecl (toProcess : Array FVarId) (fvarId : FVarId) (userName : Name) (type : Expr) (bi : BinderInfo) (kind : LocalDeclKind)
@ -943,7 +943,7 @@ private def mkLetRecClosureFor (toLift : LetRecToLift) (freeVars : Array FVarId)
let s ← mkClosureFor freeVars <| xs.map fun x => lctx.get! x.fvarId!
/- Apply original type binder info and user-facing names to local declarations. -/
let typeLocalDecls := s.localDecls.map fun localDecl =>
if let some (userName, bi) := userNameBinderInfoMap.find? localDecl.fvarId then
if let some (userName, bi) := userNameBinderInfoMap.get? localDecl.fvarId then
localDecl.setBinderInfo bi |>.setUserName userName
else
localDecl
@ -973,7 +973,7 @@ private def mkLetRecClosures (sectionVars : Array Expr) (mainFVarIds : Array FVa
-- We have to recompute the `freeVarMap` in this case. This overhead should not be an issue in practice.
freeVarMap ← mkFreeVarMap sectionVars mainFVarIds recFVarIds letRecsToLift
let toLift := letRecsToLift[i]!
result := result.push (← mkLetRecClosureFor toLift (freeVarMap.find? toLift.fvarId).get!)
result := result.push (← mkLetRecClosureFor toLift (freeVarMap.get? toLift.fvarId).get!)
return result.toList
/-- Mapping from FVarId of mutually recursive functions being defined to "closure" expression. -/
@ -998,13 +998,13 @@ def isApplicable (r : Replacement) (e : Expr) : Bool :=
.done
def Replacement.apply (r : Replacement) (e : Expr) : Expr :=
-- Remark: if `r` is not a singlenton, then declaration is using `mutual` or `let rec`,
-- Remark: if `r` is not a singleton, then declaration is using `mutual` or `let rec`,
-- and there is a big chance `isApplicable r e` is true.
if r.isSingleton && !isApplicable r e then
if r.size == 1 && !isApplicable r e then
e
else
e.replace fun e => match e with
| .fvar fvarId => match r.find? fvarId with
| .fvar fvarId => match r.get? fvarId with
| some c => some c
| _ => none
| _ => none

2
src/Lean/Elab/PatternVar.lean
View file

@ -85,7 +85,7 @@ where
.ofFormatWithInfos {
fmt := "'" ++ .tag 0 (format n) ++ "'",
infos :=
.fromList [(0, .ofTermInfo {
.ofList [(0, .ofTermInfo {
lctx := .empty,
expr := .const n params,
stx := .ident .none (toString n).toSubstring n [.decl n []],

2
src/Lean/Elab/Print.lean
View file

@ -145,7 +145,7 @@ private partial def printStructure (id : Name) (levelParams : List Name) (numPar
let fi ← getFieldOrigin source field
let proj := fi.projFn
let modifier := if isPrivateName proj then "private " else ""
let ftype ← inferType (fieldMap.find! field)
let ftype ← inferType (fieldMap.get! field)
let value ←
if let some stx := autoParams.find? field then
let stx : TSyntax ``Parser.Tactic.tacticSeq := ⟨stx⟩

8
src/Lean/Elab/StructInst.lean
View file

@ -843,7 +843,7 @@ private def synthOptParamFields : StructInstM Unit := do
for pendingField in pendingFields do
if (← isFieldNotSolved? pendingField.fieldName).isNone then
unsolvedFields := unsolvedFields.insert pendingField.fieldName
let e := (← get).fieldMap.find! pendingField.fieldName
let e := (← get).fieldMap.get! pendingField.fieldName
requiredErrors := requiredErrors.push m!"\
Field `{pendingField.fieldName}` must be explicitly provided; its synthesized value is{indentExpr e}"
let requiredErrorsMsg := MessageData.joinSep (requiredErrors.map (m!"\n\n" ++ ·)).toList ""
@ -854,7 +854,7 @@ private def synthOptParamFields : StructInstM Unit := do
let missing := missingFields |>.map (s!"`{·.fieldName}`") |>.toList
let missingFieldsValues ← missingFields.mapM fun field => do
if unsolvedFields.contains field.fieldName then
pure <| (field.fieldName, some <| (← get).fieldMap.find! field.fieldName)
pure <| (field.fieldName, some <| (← get).fieldMap.get! field.fieldName)
else pure (field.fieldName, none)
let missingFieldsHint ← mkMissingFieldsHint missingFieldsValues (← read).view.ref
let msg := m!"Fields missing: {", ".intercalate missing}{assignErrorsMsg}{requiredErrorsMsg}{missingFieldsHint}"
@ -926,7 +926,7 @@ where
let flatCtorName := mkFlatCtorOfStructCtorName ctor.name
let cinfo ← getConstInfo flatCtorName
let ctorVal ← instantiateValueLevelParams cinfo us
let fieldArgs := parentFields.map fieldMap.find!
let fieldArgs := parentFields.map (fieldMap.get! ·)
-- Normalize the expressions since there might be some projections.
let params ← params.mapM normalizeExpr
let e' := (ctorVal.beta params).beta fieldArgs
@ -1016,7 +1016,7 @@ private def processField (loop : StructInstM α) (field : ExpandedField) (fieldT
else
throw ex
loop
if let some fvarId' := (← get).liftedFVarRemap.find? fvarId then
if let some fvarId' := (← get).liftedFVarRemap.get? fvarId then
processProjAux fvarId'
else if (← getLCtx).contains fvarId then
processProjAux fvarId

4
src/Lean/Elab/Structure.lean
View file

@ -450,7 +450,7 @@ private def hasFieldName (fieldName : Name) : StructElabM Bool :=
private def findFieldInfoByFVarId? (fvarId : FVarId) : StructElabM (Option StructFieldInfo) := do
let s ← get
return s.fvarIdFieldIdx.find? fvarId |>.map fun idx => s.fields[idx]!
return s.fvarIdFieldIdx.get? fvarId |>.map fun idx => s.fields[idx]!
/--
Inserts a field info into the current state.
@ -1242,7 +1242,7 @@ private def resolveFieldDefaults (structName : Name) : StructElabM Unit := do
if fieldInfo.default?.isSome then
replaceFieldInfo { fieldInfo with resolvedDefault? := fieldInfo.default? }
else if !fieldInfo.inheritedDefaults.isEmpty then
let inheritedDefaults := fieldInfo.inheritedDefaults.insertionSort fun d1 d2 => resOrderMap.find! d1.1 < resOrderMap.find! d2.1
let inheritedDefaults := fieldInfo.inheritedDefaults.insertionSort fun d1 d2 => resOrderMap.get! d1.1 < resOrderMap.get! d2.1
trace[Elab.structure] "inherited defaults for '{fieldInfo.name}' are {repr inheritedDefaults}"
replaceFieldInfo { fieldInfo with
inheritedDefaults

2
src/Lean/Elab/Tactic/BVDecide/Frontend/BVDecide.lean
View file

@ -37,7 +37,7 @@ expression - pair values.
def reconstructCounterExample (var2Cnf : Std.HashMap BVBit Nat) (assignment : Array (Bool × Nat))
(aigSize : Nat) (atomsAssignment : Std.HashMap Nat (Nat × Expr × Bool)) :
Array (Expr × BVExpr.PackedBitVec) := Id.run do
let mut sparseMap : Std.HashMap Nat (RBMap Nat Bool Ord.compare) := {}
let mut sparseMap : Std.HashMap Nat (Std.TreeMap Nat Bool) := {}
let filter bvBit _ :=
let (_, _, synthetic) := atomsAssignment[bvBit.var]!
!synthetic

8
src/Lean/Elab/Tactic/Doc.lean
View file

@ -82,7 +82,7 @@ private def showParserName (n : Name) : MetaM MessageData := do
pure <| .ofFormatWithInfos {
fmt := "'" ++ .tag 0 tok ++ "'",
infos :=
.fromList [(0, .ofTermInfo {
.ofList [(0, .ofTermInfo {
lctx := .empty,
expr := .const n params,
stx := .ident .none (toString n).toSubstring n [.decl n []],
@ -102,7 +102,7 @@ Displays all available tactic tags, with documentation.
let mut mapping : NameMap NameSet := {}
for arr in all do
for (tac, tag) in arr do
mapping := mapping.insert tag (mapping.findD tag {} |>.insert tac)
mapping := mapping.insert tag (mapping.getD tag {} |>.insert tac)
let showDocs : Option String → MessageData
| none => .nil
@ -152,7 +152,7 @@ def allTacticDocs : MetaM (Array TacticDoc) := do
let mut tacTags : NameMap NameSet := {}
for arr in all do
for (tac, tag) in arr do
tacTags := tacTags.insert tac (tacTags.findD tac {} |>.insert tag)
tacTags := tacTags.insert tac (tacTags.getD tac {} |>.insert tag)
let mut docs := #[]
@ -171,7 +171,7 @@ def allTacticDocs : MetaM (Array TacticDoc) := do
docs := docs.push {
internalName := tac,
userName := userName,
tags := tacTags.findD tac {},
tags := tacTags.getD tac {},
docString := ← findDocString? env tac,
extensionDocs := getTacticExtensions env tac
}

4
src/Lean/Elab/Term.lean
View file

@ -815,7 +815,7 @@ where
/-- Append the argument name (if available) to the message.
Remark: if the argument name contains macro scopes we do not append it. -/
addArgName (msg : MessageData) (extra : String := "") : TermElabM MessageData := do
match (← get).mvarArgNames.find? mvarErrorInfo.mvarId with
match (← get).mvarArgNames.get? mvarErrorInfo.mvarId with
| none => return msg
| some argName => return if argName.hasMacroScopes then msg else msg ++ extra ++ m!" '{argName}'"
@ -1269,7 +1269,7 @@ private def postponeElabTermCore (stx : Syntax) (expectedType? : Option Expr) :
return mvar
def getSyntheticMVarDecl? (mvarId : MVarId) : TermElabM (Option SyntheticMVarDecl) :=
return (← get).syntheticMVars.find? mvarId
return (← get).syntheticMVars.get? mvarId
register_builtin_option debug.byAsSorry : Bool := {
defValue := false

45
src/Lean/Expr.lean
View file

@ -10,6 +10,7 @@ import Lean.Data.KVMap
import Lean.Data.SMap
import Lean.Level
import Std.Data.HashSet.Basic
import Std.Data.TreeSet.Basic
namespace Lean
@ -214,17 +215,23 @@ instance : Repr FVarId where
/--
A set of unique free variable identifiers.
This is a persistent data structure implemented using red-black trees. -/
def FVarIdSet := RBTree FVarId (Name.quickCmp ·.name ·.name)
This is a persistent data structure implemented using `Std.TreeSet`. -/
def FVarIdSet := Std.TreeSet FVarId (Name.quickCmp ·.name ·.name)
deriving Inhabited, EmptyCollection
instance : ForIn m FVarIdSet FVarId := inferInstanceAs (ForIn _ (RBTree ..) ..)
instance : ForIn m FVarIdSet FVarId := inferInstanceAs (ForIn _ (Std.TreeSet _ _) ..)
def FVarIdSet.insert (s : FVarIdSet) (fvarId : FVarId) : FVarIdSet :=
RBTree.insert s fvarId
Std.TreeSet.insert s fvarId
def FVarIdSet.union (vs₁ vs₂ : FVarIdSet) : FVarIdSet :=
vs₁.fold (init := vs₂) (·.insert ·)
vs₁.foldl (init := vs₂) (·.insert ·)
def FVarIdSet.ofList (l : List FVarId) : FVarIdSet :=
Std.TreeSet.ofList l _
def FVarIdSet.ofArray (l : Array FVarId) : FVarIdSet :=
Std.TreeSet.ofArray l _
/--
A set of unique free variable identifiers implemented using hashtables.
@ -235,13 +242,13 @@ def FVarIdHashSet := Std.HashSet FVarId
/--
A mapping from free variable identifiers to values of type `α`.
This is a persistent data structure implemented using red-black trees. -/
def FVarIdMap (α : Type) := RBMap FVarId α (Name.quickCmp ·.name ·.name)
This is a persistent data structure implemented using `Std.TreeMap`. -/
def FVarIdMap (α : Type) := Std.TreeMap FVarId α (Name.quickCmp ·.name ·.name)
def FVarIdMap.insert (s : FVarIdMap α) (fvarId : FVarId) (a : α) : FVarIdMap α :=
RBMap.insert s fvarId a
Std.TreeMap.insert s fvarId a
instance : EmptyCollection (FVarIdMap α) := inferInstanceAs (EmptyCollection (RBMap ..))
instance : EmptyCollection (FVarIdMap α) := inferInstanceAs (EmptyCollection (Std.TreeMap _ _ _))
instance : Inhabited (FVarIdMap α) where
default := {}
@ -254,22 +261,28 @@ structure MVarId where
instance : Repr MVarId where
reprPrec n p := reprPrec n.name p
def MVarIdSet := RBTree MVarId (Name.quickCmp ·.name ·.name)
def MVarIdSet := Std.TreeSet MVarId (Name.quickCmp ·.name ·.name)
deriving Inhabited, EmptyCollection
def MVarIdSet.insert (s : MVarIdSet) (mvarId : MVarId) : MVarIdSet :=
RBTree.insert s mvarId
Std.TreeSet.insert s mvarId
instance : ForIn m MVarIdSet MVarId := inferInstanceAs (ForIn _ (RBTree ..) ..)
def MVarIdSet.ofList (l : List MVarId) : MVarIdSet :=
Std.TreeSet.ofList l _
def MVarIdMap (α : Type) := RBMap MVarId α (Name.quickCmp ·.name ·.name)
def MVarIdSet.ofArray (l : Array MVarId) : MVarIdSet :=
Std.TreeSet.ofArray l _
instance : ForIn m MVarIdSet MVarId := inferInstanceAs (ForIn _ (Std.TreeSet _ _) ..)
def MVarIdMap (α : Type) := Std.TreeMap MVarId α (Name.quickCmp ·.name ·.name)
def MVarIdMap.insert (s : MVarIdMap α) (mvarId : MVarId) (a : α) : MVarIdMap α :=
RBMap.insert s mvarId a
Std.TreeMap.insert s mvarId a
instance : EmptyCollection (MVarIdMap α) := inferInstanceAs (EmptyCollection (RBMap ..))
instance : EmptyCollection (MVarIdMap α) := inferInstanceAs (EmptyCollection (Std.TreeMap _ _ _))
instance : ForIn m (MVarIdMap α) (MVarId × α) := inferInstanceAs (ForIn _ (RBMap ..) ..)
instance : ForIn m (MVarIdMap α) (MVarId × α) := inferInstanceAs (ForIn _ (Std.TreeMap _ _ _) ..)
instance : Inhabited (MVarIdMap α) where
default := {}

11
src/Lean/Level.lean
View file

@ -11,6 +11,7 @@ import Lean.Hygiene
import Lean.Data.Name
import Lean.Data.Format
import Init.Data.Option.Coe
import Std.Data.TreeSet.Basic
def Nat.imax (n m : Nat) : Nat :=
if m = 0 then 0 else Nat.max n m
@ -70,16 +71,16 @@ abbrev LMVarId := LevelMVarId
instance : Repr LMVarId where
reprPrec n p := reprPrec n.name p
def LMVarIdSet := RBTree LMVarId (Name.quickCmp ·.name ·.name)
def LMVarIdSet := Std.TreeSet LMVarId (Name.quickCmp ·.name ·.name)
deriving Inhabited, EmptyCollection
instance : ForIn m LMVarIdSet LMVarId := inferInstanceAs (ForIn _ (RBTree ..) ..)
instance : ForIn m LMVarIdSet LMVarId := inferInstanceAs (ForIn _ (Std.TreeSet _ _) ..)
def LMVarIdMap (α : Type) := RBMap LMVarId α (Name.quickCmp ·.name ·.name)
def LMVarIdMap (α : Type) := Std.TreeMap LMVarId α (Name.quickCmp ·.name ·.name)
instance : EmptyCollection (LMVarIdMap α) := inferInstanceAs (EmptyCollection (RBMap ..))
instance : EmptyCollection (LMVarIdMap α) := inferInstanceAs (EmptyCollection (Std.TreeMap _ _ _))
instance : ForIn m (LMVarIdMap α) (LMVarId × α) := inferInstanceAs (ForIn _ (RBMap ..) ..)
instance : ForIn m (LMVarIdMap α) (LMVarId × α) := inferInstanceAs (ForIn _ (Std.TreeMap _ _ _) ..)
instance : Inhabited (LMVarIdMap α) where
default := {}

6
src/Lean/Linter/Basic.lean
View file

@ -22,8 +22,8 @@ def LinterSets := NameMap (Array Name)
`entry.2` contains the names of the set's linter options.
-/
def insertLinterSetEntry (map : LinterSets) (setName : Name) (options : NameSet) : LinterSets :=
options.fold (init := map) fun map linterName =>
map.insert linterName ((map.findD linterName #[]).push setName)
options.foldl (init := map) fun map linterName =>
map.insert linterName ((map.getD linterName #[]).push setName)
builtin_initialize linterSetsExt : SimplePersistentEnvExtension (Name × NameSet) LinterSets ← Lean.registerSimplePersistentEnvExtension {
addImportedFn := mkStateFromImportedEntries (Function.uncurry <| insertLinterSetEntry ·) {}
@ -52,7 +52,7 @@ def _root_.Lean.Options.toLinterOptions [Monad m] [MonadEnv m] (o : Options) : m
/-- Return the set of linter sets that this option is contained in. -/
def LinterOptions.getSet (o : LinterOptions) (opt : Lean.Option α) : Array Name :=
o.linterSets.findD opt.name #[]
o.linterSets.getD opt.name #[]
def getLinterOptions [Monad m] [MonadOptions m] [MonadEnv m] : m LinterOptions := do
(← getOptions).toLinterOptions

9
src/Lean/Log.lean
View file

@ -11,6 +11,7 @@ import Lean.DocString.Links
-- This import is necessary to ensure that any users of the `logNamedError` macros have access to
-- all declared explanations:
import Lean.ErrorExplanations
import Lean.Data.Json.Basic
namespace Lean
@ -91,10 +92,10 @@ private def MessageData.appendDescriptionWidgetIfNamed (msg : MessageData) : Mes
let inst := {
id := ``errorDescriptionWidget
javascriptHash := errorDescriptionWidget.javascriptHash
props := return json% {
code: $(toString errorName),
explanationUrl: $url
}
props := return Json.mkObj [
("code", toString errorName),
("explanationUrl", url)
]
}
-- Note: we do not generate corresponding message data for the widget because it pollutes
-- console output

2
src/Lean/Message.lean
View file

@ -570,7 +570,7 @@ def add (msg : Message) (log : MessageLog) : MessageLog :=
protected def append (l₁ l₂ : MessageLog) : MessageLog where
reported := l₁.reported ++ l₂.reported
unreported := l₁.unreported ++ l₂.unreported
loggedKinds := l₁.loggedKinds.union l₂.loggedKinds
loggedKinds := l₁.loggedKinds.merge l₂.loggedKinds
instance : Append MessageLog :=
⟨MessageLog.append⟩

2
src/Lean/Meta/Instances.lean
View file

@ -286,7 +286,7 @@ structure DefaultInstanceEntry where
instanceName : Name
priority : Nat
abbrev PrioritySet := RBTree Nat (fun x y => compare y x)
abbrev PrioritySet := Std.TreeSet Nat (fun x y => compare y x)
structure DefaultInstances where
defaultInstances : NameMap (List (Name × Nat)) := {}

4
src/Lean/Meta/Match/MVarRenaming.lean
View file

@ -16,7 +16,7 @@ def MVarRenaming.isEmpty (s : MVarRenaming) : Bool :=
s.map.isEmpty
def MVarRenaming.find? (s : MVarRenaming) (mvarId : MVarId) : Option MVarId :=
s.map.find? mvarId
s.map.get? mvarId
def MVarRenaming.find! (s : MVarRenaming) (mvarId : MVarId) : MVarId :=
(s.find? mvarId).get!
@ -28,7 +28,7 @@ def MVarRenaming.apply (s : MVarRenaming) (e : Expr) : Expr :=
if !e.hasMVar then e
else if s.map.isEmpty then e
else e.replace fun e => match e with
| Expr.mvar mvarId => match s.map.find? mvarId with
| Expr.mvar mvarId => match s.map.get? mvarId with
| none => e
| some newMVarId => mkMVar newMVarId
| _ => none

6
src/Lean/Meta/Match/MatchEqs.lean
View file

@ -574,7 +574,7 @@ where
for i in 6...args.size do
let arg := argsNew[i]!
if arg.isFVar then
match (← read).find? arg.fvarId! with
match (← read).get? arg.fvarId! with
| some (altNew, _, _) =>
argsNew := argsNew.set! i altNew
trace[Meta.Match.matchEqs] "arg: {arg} : {← inferType arg}, altNew: {altNew} : {← inferType altNew}"
@ -635,7 +635,7 @@ where
if isAlt[i] then
-- `convertTemplate` will correct occurrences of the alternative
let alt := args[6+i]! -- Recall that `Eq.ndrec` has 6 arguments
let some (_, numParams, argMask) := m.find? alt.fvarId! | unreachable!
let some (_, numParams, argMask) := m.get? alt.fvarId! | unreachable!
-- We add a new entry to `m` to make sure `convertTemplate` will correct the occurrences of the alternative
m := m.insert minorArgsNew[i]!.fvarId! (minorArgsNew[i]!, numParams, argMask)
unless minorBodyNew.isLambda do
@ -659,7 +659,7 @@ where
return .done (← convertCastEqRec e)
else
let Expr.fvar fvarId .. := e.getAppFn | return .continue
let some (altNew, numParams, argMask) := (← read).find? fvarId | return .continue
let some (altNew, numParams, argMask) := (← read).get? fvarId | return .continue
trace[Meta.Match.matchEqs] ">> argMask: {argMask}, e: {e}, {altNew}"
let mut newArgs := #[]
let argMask := trimFalseTrail argMask

3
src/Lean/Meta/Tactic/Grind/Arith/CommRing/Types.lean
View file

@ -6,7 +6,6 @@ Authors: Leonardo de Moura
prelude
import Init.Grind.Ring.OfSemiring
import Lean.Data.PersistentArray
import Lean.Data.RBTree
import Lean.Meta.Tactic.Grind.ExprPtr
import Lean.Meta.Tactic.Grind.Arith.Util
import Lean.Meta.Tactic.Grind.Arith.CommRing.Poly
@ -45,7 +44,7 @@ protected def EqCnstr.compare (c₁ c₂ : EqCnstr) : Ordering :=
(compare c₁.p.degree c₂.p.degree) |>.then
(compare c₁.id c₂.id)
abbrev Queue : Type := RBTree EqCnstr EqCnstr.compare
abbrev Queue : Type := Std.TreeSet EqCnstr EqCnstr.compare
/--
A polynomial equipped with a chain of rewrite steps that justifies its equality to the original input.

2
src/Lean/Meta/Tactic/Grind/Arith/CommRing/Util.lean
View file

@ -204,7 +204,7 @@ def isQueueEmpty : RingM Bool :=
return (← getRing).queue.isEmpty
def getNext? : RingM (Option EqCnstr) := do
let some c := (← getRing).queue.min | return none
let some c := (← getRing).queue.min? | return none
modifyRing fun s => { s with queue := s.queue.erase c }
incSteps
return some c

2
src/Lean/Meta/Tactic/Grind/Arith/Cutsat/Search.lean
View file

@ -488,7 +488,7 @@ def resolveConflict (h : UnsatProof) : SearchM Unit := do
trace[grind.debug.cutsat.search.backtrack] "resolved diseq split: {← c'.pp}"
c'.assert
| .cooper pred hs decVars' =>
let decVars' := decVars.union decVars'
let decVars' := decVars.merge decVars'
let n := pred.numCases
let hs := hs.push (c.fvarId, h)
trace[grind.debug.cutsat.search.backtrack] "cooper #{hs.size + 1}, {← pred.pp}, {hs.map fun p => p.1.name}"

2
src/Lean/Meta/Tactic/Grind/Arith/Cutsat/Types.lean
View file

@ -232,7 +232,7 @@ instance : Inhabited CooperSplitPred where
instance : Inhabited CooperSplit where
default := { pred := default, k := 0, h := .dec default }
abbrev VarSet := RBTree Var compare
abbrev VarSet := Std.TreeSet Var
/-- State of the cutsat procedure. -/
structure State where

2
src/Lean/Meta/Tactic/Grind/Arith/Linear/Types.lean
View file

@ -77,7 +77,7 @@ instance : Inhabited DiseqCnstr where
instance : Inhabited EqCnstr where
default := { p := .nil, h := .core default default .zero .zero }
abbrev VarSet := RBTree Var compare
abbrev VarSet := Std.TreeSet Var
/--
State for each algebraic structure by this module.

2
src/Lean/Meta/Tactic/Grind/Cases.lean
View file

@ -23,7 +23,7 @@ structure CasesEntry where
The goal is to reduce noise in the tactic generated by `grind?`
-/
private def builtinEagerCases : NameSet :=
RBTree.ofList [``And, ``Exists, ``True, ``False, ``Unit, ``Empty]
.ofList [``And, ``Exists, ``True, ``False, ``Unit, ``Empty]
/--
Returns `true` if `declName` is the name of inductive type/predicate that

6
src/Lean/Meta/Tactic/Grind/EMatchTheorem.lean
View file

@ -784,21 +784,21 @@ private def checkCoverage (thmProof : Expr) (numParams : Nat) (bvarsFound : Std.
assert! numParams == xs.size
let patternVars := bvarsFound.toList.map fun bidx => xs[numParams - bidx - 1]!.fvarId!
-- `xs` as a `FVarIdSet`.
let thmVars : FVarIdSet := RBTree.ofList <| xs.toList.map (·.fvarId!)
let thmVars := FVarIdSet.ofList <| xs.toList.map (·.fvarId!)
-- Collect free variables occurring in `e`, and insert the ones that are in `thmVars` into `fvarsFound`
let update (fvarsFound : FVarIdSet) (e : Expr) : FVarIdSet :=
(collectFVars {} e).fvarIds.foldl (init := fvarsFound) fun s fvarId =>
if thmVars.contains fvarId then s.insert fvarId else s
-- Theorem variables found so far. We initialize with the variables occurring in patterns
-- Remark: fvarsFound is a subset of thmVars
let mut fvarsFound : FVarIdSet := RBTree.ofList patternVars
let mut fvarsFound := FVarIdSet.ofList patternVars
for patternVar in patternVars do
let type ← patternVar.getType
fvarsFound := update fvarsFound type
if fvarsFound.size == numParams then return .ok
-- Now, we keep traversing remaining variables and collecting
-- `processed` contains the variables we have already processed.
let mut processed : FVarIdSet := RBTree.ofList patternVars
let mut processed := FVarIdSet.ofList patternVars
let mut modified := false
repeat
modified := false

4
src/Lean/Meta/Tactic/Grind/Proof.lean
View file

@ -68,7 +68,7 @@ Recall that this expression must exist since it is the root itself in the
worst case.
-/
private def findCommon (lhs rhs : Expr) : GoalM Expr := do
let mut visited : RBMap Nat Expr compare := {}
let mut visited : Std.TreeMap Nat Expr := {}
let mut it := lhs
-- Mark elements found following the path from `lhs` to the root.
repeat
@ -80,7 +80,7 @@ private def findCommon (lhs rhs : Expr) : GoalM Expr := do
it := rhs
repeat
let n ← getENode it
if let some common := visited.find? n.idx then
if let some common := visited.get? n.idx then
return common
let some target := n.target? | unreachable! --
it := target

2
src/Lean/Meta/Tactic/Grind/Types.lean
View file

@ -6,7 +6,7 @@ Authors: Leonardo de Moura
prelude
import Init.Grind.Tactics
import Init.Data.Queue
import Std.Data.TreeSet
import Std.Data.TreeSet.Basic
import Lean.HeadIndex
import Lean.Meta.Basic
import Lean.Meta.CongrTheorems

2
src/Lean/Meta/Tactic/Simp/Types.lean
View file

@ -848,7 +848,7 @@ ones that allow zeta-delta reducing fvars not in `zetaDeltaSet` (e.g. `withInfer
This also means that `usedZetaDelta` set might be reporting fvars in `zetaDeltaSet` that weren't "used".
-/
private def updateUsedSimpsWithZetaDeltaCore (s : UsedSimps) (zetaDeltaSet : FVarIdSet) (usedZetaDelta : FVarIdSet) : UsedSimps :=
zetaDeltaSet.fold (init := s) fun s fvarId =>
zetaDeltaSet.foldl (init := s) fun s fvarId =>
if usedZetaDelta.contains fvarId then
s.insert <| .fvar fvarId
else

2
src/Lean/MetavarContext.lean
View file

@ -606,7 +606,7 @@ def instantiateLCtxMVars [Monad m] [MonadMCtx m] (lctx : LocalContext) : m Local
match ldecl with
| .cdecl _ fvarId userName type _ .auxDecl =>
let type ← instantiateMVars type
let .some fullName := auxDeclToFullName.find? fvarId
let .some fullName := auxDeclToFullName.get? fvarId
| panic! s!"Invalid auxiliary declaration found in local context: \
{userName} does not have an associated full name."
return lctx.mkAuxDecl fvarId userName type fullName

22
src/Lean/Parser/Basic.lean
View file

@ -1581,21 +1581,21 @@ def eoi : Parser := {
}
/-- A multimap indexed by tokens. Used for indexing parsers by their leading token. -/
def TokenMap (α : Type) := RBMap Name (List α) Name.quickCmp
def TokenMap (α : Type) := Std.TreeMap Name (List α) Name.quickCmp
namespace TokenMap
def insert (map : TokenMap α) (k : Name) (v : α) : TokenMap α :=
match map.find? k with
| none => RBMap.insert map k [v]
| some vs => RBMap.insert map k (v::vs)
match map.get? k with
| none => Std.TreeMap.insert map k [v]
| some vs => Std.TreeMap.insert map k (v::vs)
instance : Inhabited (TokenMap α) where
default := RBMap.empty
default := Std.TreeMap.empty
instance : EmptyCollection (TokenMap α) := ⟨RBMap.empty⟩
instance : EmptyCollection (TokenMap α) := ⟨Std.TreeMap.empty⟩
instance : ForIn m (TokenMap α) (Name × List α) := inferInstanceAs (ForIn _ (RBMap ..) _)
instance : ForIn m (TokenMap α) (Name × List α) := inferInstanceAs (ForIn _ (Std.TreeMap _ _ _) _)
end TokenMap
@ -1680,7 +1680,7 @@ abbrev ParserCategories := PersistentHashMap Name ParserCategory
def indexed {α : Type} (map : TokenMap α) (c : ParserContext) (s : ParserState) (behavior : LeadingIdentBehavior) : ParserState × List α :=
let (s, stx) := peekToken c s
let find (n : Name) : ParserState × List α :=
match map.find? n with
match map.get? n with
| some as => (s, as)
| _ => (s, [])
match stx with
@ -1689,16 +1689,16 @@ def indexed {α : Type} (map : TokenMap α) (c : ParserContext) (s : ParserState
match behavior with
| .default => find identKind
| .symbol =>
match map.find? val with
match map.get? val with
| some as => (s, as)
| none => find identKind
| .both =>
match map.find? val with
match map.get? val with
| some as =>
if val == identKind then
(s, as) -- avoid running the same parsers twice
else
match map.find? identKind with
match map.get? identKind with
| some as' => (s, as ++ as')
| _ => (s, as)
| none => find identKind

2
src/Lean/Parser/Extension.lean
View file

@ -218,7 +218,7 @@ builtin_initialize parserAlias2kindRef : IO.Ref (NameMap SyntaxNodeKind) ← IO.
builtin_initialize parserAliases2infoRef : IO.Ref (NameMap ParserAliasInfo) ← IO.mkRef {}
def getParserAliasInfo (aliasName : Name) : IO ParserAliasInfo := do
return (← parserAliases2infoRef.get).findD aliasName {}
return (← parserAliases2infoRef.get).getD aliasName {}
-- Later, we define macro `register_parser_alias` which registers a parser, formatter and parenthesizer
def registerAlias (aliasName declName : Name) (p : ParserAliasValue) (kind? : Option SyntaxNodeKind := none) (info : ParserAliasInfo := {}) : IO Unit := do

12
src/Lean/Parser/Tactic/Doc.lean
View file

@ -36,7 +36,7 @@ builtin_initialize tacticAlternativeExt
addImportedFn := fun _ => pure {},
addEntryFn := fun as (src, tgt) => as.insert src tgt,
exportEntriesFn := fun es =>
es.fold (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
es.foldl (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
}
/--
@ -114,7 +114,7 @@ builtin_initialize knownTacticTagExt
addImportedFn := fun _ => pure {},
addEntryFn := fun as (src, tgt) => as.insert src tgt,
exportEntriesFn := fun es =>
es.fold (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
es.foldl (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
}
/--
@ -149,7 +149,7 @@ def allTagsWithInfo [Monad m] [MonadEnv m] : m (List (Name × String × Option S
for arr in knownTacticTagExt.toEnvExtension.getState env |>.importedEntries do
for (tag, info) in arr do
found := found.insert tag info
let arr := found.fold (init := #[]) (fun arr k v => arr.push (k, v))
let arr := found.foldl (init := #[]) (fun arr k v => arr.push (k, v))
pure (arr.qsort (·.1.toString < ·.1.toString) |>.toList)
/--
@ -167,7 +167,7 @@ builtin_initialize tacticTagExt
registerPersistentEnvExtension {
mkInitial := pure {},
addImportedFn := fun _ => pure {},
addEntryFn := fun tags (decl, newTag) => tags.insert decl (tags.findD decl {} |>.insert newTag)
addEntryFn := fun tags (decl, newTag) => tags.insert decl (tags.getD decl {} |>.insert newTag)
exportEntriesFn := fun tags => Id.run do
let mut exported := #[]
for (decl, dTags) in tags do
@ -234,9 +234,9 @@ builtin_initialize tacticDocExtExt
registerPersistentEnvExtension {
mkInitial := pure {},
addImportedFn := fun _ => pure {},
addEntryFn := fun es (x, ext) => es.insert x (es.findD x #[] |>.push ext),
addEntryFn := fun es (x, ext) => es.insert x (es.getD x #[] |>.push ext),
exportEntriesFn := fun es =>
es.fold (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
es.foldl (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
}
/-- Gets the extensions declared for the documentation for the given canonical tactic name -/

4
src/Lean/Parser/Term/Doc.lean
View file

@ -31,9 +31,9 @@ builtin_initialize recommendedSpellingByNameExt
registerPersistentEnvExtension {
mkInitial := pure {},
addImportedFn := fun _ => pure {},
addEntryFn := fun es (rec, xs) => xs.foldl (init := es) fun es x => es.insert x (es.findD x #[] |>.push rec),
addEntryFn := fun es (rec, xs) => xs.foldl (init := es) fun es x => es.insert x (es.getD x #[] |>.push rec),
exportEntriesFn := fun es =>
es.fold (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
es.foldl (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
}
/-- Recommended spellings for notations, stored in such a way that it is easy to generate a table

4
src/Lean/PrettyPrinter/Delaborator/Basic.lean
View file

@ -165,7 +165,7 @@ def getExprKind : DelabM Name := do
def getOptionsAtCurrPos : DelabM Options := do
let ctx ← read
let mut opts ← getOptions
if let some opts' := ctx.optionsPerPos.find? (← getPos) then
if let some opts' := ctx.optionsPerPos.get? (← getPos) then
for (k, v) in opts' do
opts := opts.insert k v
return opts
@ -187,7 +187,7 @@ def withOptionAtCurrPos (k : Name) (v : DataValue) (x : DelabM α) : DelabM α :
let pos ← getPos
withReader
(fun ctx =>
let opts' := ctx.optionsPerPos.find? pos |>.getD {} |>.insert k v
let opts' := ctx.optionsPerPos.get? pos |>.getD {} |>.insert k v
{ ctx with optionsPerPos := ctx.optionsPerPos.insert pos opts' })
x

4
src/Lean/PrettyPrinter/Delaborator/Builtins.lean
View file

@ -136,7 +136,7 @@ def withMDataOptions [Inhabited α] (x : DelabM α) : DelabM α := do
let pos ← getPos
for (k, v) in m do
if (`pp).isPrefixOf k then
let opts := posOpts.find? pos |>.getD {}
let opts := posOpts.get? pos |>.getD {}
posOpts := posOpts.insert pos (opts.insert k v)
withReader ({ · with optionsPerPos := posOpts }) $ withMDataExpr x
| _ => x
@ -588,7 +588,7 @@ private partial def collectStructFields
unless ← getPPOption getPPStructureInstancesDefaults do
if let some defFn := getEffectiveDefaultFnForField? (← getEnv) structName fieldName then
-- Use `withNewMCtxDepth` to prevent delaborator from solving metavariables.
if let some (_, defValue) ← withNewMCtxDepth <| instantiateStructDefaultValueFn? defFn levels params (pure ∘ fieldValues.find?) then
if let some (_, defValue) ← withNewMCtxDepth <| instantiateStructDefaultValueFn? defFn levels params (pure ∘ fieldValues.get?) then
if ← withReducible <| withNewMCtxDepth <| isDefEq defValue (← getExpr) then
-- Default value matches, skip the field.
return (i + 1, fieldValues, fields)

7
src/Lean/PrettyPrinter/Delaborator/SubExpr.lean
View file

@ -6,7 +6,6 @@ Authors: Sebastian Ullrich, Daniel Selsam, Wojciech Nawrocki
prelude
import Lean.Meta.Basic
import Lean.SubExpr
import Lean.Data.RBMap
/-!
# Subexpr utilities for delaborator.
@ -16,15 +15,15 @@ in sync with the `Nat` "position" values that refer to them.
namespace Lean.PrettyPrinter.Delaborator
abbrev OptionsPerPos := RBMap SubExpr.Pos Options compare
abbrev OptionsPerPos := Std.TreeMap SubExpr.Pos Options
def OptionsPerPos.insertAt (optionsPerPos : OptionsPerPos) (pos : SubExpr.Pos) (name : Name) (value : DataValue) : OptionsPerPos :=
let opts := optionsPerPos.find? pos |>.getD {}
let opts := optionsPerPos.get? pos |>.getD {}
optionsPerPos.insert pos <| opts.insert name value
/-- Merges two collections of options, where the second overrides the first. -/
def OptionsPerPos.merge : OptionsPerPos → OptionsPerPos → OptionsPerPos :=
RBMap.mergeBy (fun _ => KVMap.mergeBy (fun _ _ dv => dv))
Std.TreeMap.mergeWith (fun _ => KVMap.mergeBy (fun _ _ dv => dv))
namespace SubExpr

3
src/Lean/PrettyPrinter/Delaborator/TopDownAnalyze.lean
View file

@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Daniel Selsam
-/
prelude
import Lean.Data.RBMap
import Lean.Meta.SynthInstance
import Lean.Meta.CtorRecognizer
import Lean.Util.FindMVar
@ -328,7 +327,7 @@ def checkKnowsType : AnalyzeM Unit := do
throw $ Exception.internal analyzeFailureId
def annotateBoolAt (n : Name) (pos : Pos) : AnalyzeM Unit := do
let opts := (← get).annotations.findD pos {} |>.setBool n true
let opts := (← get).annotations.getD pos {} |>.setBool n true
trace[pp.analyze.annotate] "{pos} {n}"
modify fun s => { s with annotations := s.annotations.insert pos opts }

2
src/Lean/ReducibilityAttrs.lean
View file

@ -28,7 +28,7 @@ builtin_initialize reducibilityCoreExt : PersistentEnvExtension (Name × Reducib
addImportedFn := fun _ _ => pure {}
addEntryFn := fun (s : NameMap ReducibilityStatus) (p : Name × ReducibilityStatus) => s.insert p.1 p.2
exportEntriesFn := fun m =>
let r : Array (Name × ReducibilityStatus) := m.fold (fun a n p => a.push (n, p)) #[]
let r : Array (Name × ReducibilityStatus) := m.foldl (fun a n p => a.push (n, p)) #[]
r.qsort (fun a b => Name.quickLt a.1 b.1)
statsFn := fun s => "reducibility attribute core extension" ++ Format.line ++ "number of local entries: " ++ format s.size
asyncMode := .async

2
src/Lean/ResolveName.lean
View file

@ -502,7 +502,7 @@ def resolveLocalName [Monad m] [MonadResolveName m] [MonadEnv m] [MonadLCtx m] (
let localDecl ← localDecl?
if localDecl.isAuxDecl then
guard (!skipAuxDecl)
if let some fullDeclName := auxDeclToFullName.find? localDecl.fvarId then
if let some fullDeclName := auxDeclToFullName.get? localDecl.fvarId then
matchAuxRecDecl? localDecl fullDeclName givenNameView
else
matchLocalDecl? localDecl givenName

2
src/Lean/Server/CodeActions/Attr.lean
View file

@ -90,7 +90,7 @@ def CommandCodeActions.insert (self : CommandCodeActions)
{ self with onAnyCmd := self.onAnyCmd.push action }
else
{ self with onCmd := tacticKinds.foldl (init := self.onCmd) fun m a =>
m.insert a ((m.findD a #[]).push action) }
m.insert a ((m.getD a #[]).push action) }
builtin_initialize builtinCmdCodeActions : IO.Ref CommandCodeActions ← IO.mkRef {}

8
src/Lean/Server/Completion/CompletionCollectors.lean
View file

@ -314,7 +314,7 @@ section DotCompletionUtils
strip the private prefix from deep in the name, letting us reject most names without
having to scan the full name first.
-/
private def NameSetModPrivate := RBTree Name cmpModPrivate
private def NameSetModPrivate := Std.TreeSet Name cmpModPrivate
/--
Given a type, try to extract relevant type names for dot notation field completion.
@ -427,7 +427,7 @@ def dotCompletion
let nameSet ← try
getDotCompletionTypeNameSet (← instantiateMVars (← inferType info.expr))
catch _ =>
pure RBTree.empty
pure Std.TreeSet.empty
if nameSet.isEmpty then
return
@ -462,7 +462,7 @@ def dotIdCompletion
let nameSet ← try
getDotCompletionTypeNameSet resultTypeFn
catch _ =>
pure RBTree.empty
pure Std.TreeSet.empty
forEligibleDeclsWithCancellationM fun declName c => do
let unnormedTypeName := declName.getPrefix
@ -545,7 +545,7 @@ def optionCompletion
: IO (Array CompletionItem) :=
ctx.runMetaM {} do
-- HACK(WN): unfold the type so ForIn works
let (decls : RBMap _ _ _) ← getOptionDecls
let (decls : Std.TreeMap _ _ _) ← getOptionDecls
let opts ← getOptions
-- `stx` is from `"set_option " >> ident`
return trailingDotCompletion decls stx[1] caps ctx fun name decl textEdit? => {

29
src/Lean/Server/FileWorker.lean
View file

@ -8,11 +8,10 @@ prelude
import Init.System.IO
import Std.Sync.Channel
import Lean.Data.RBMap
import Lean.Environment
import Lean.Data.Lsp
import Lean.Data.Json.FromToJson
import Lean.Data.Json.FromToJson.Basic
import Lean.LoadDynlib
import Lean.Language.Lean
@ -85,7 +84,7 @@ structure WorkerContext where
Diagnostics that are included in every single `textDocument/publishDiagnostics` notification.
-/
stickyDiagnosticsRef : IO.Ref (Array InteractiveDiagnostic)
partialHandlersRef : IO.Ref (RBMap String PartialHandlerInfo compare)
partialHandlersRef : IO.Ref (Std.TreeMap String PartialHandlerInfo)
pendingServerRequestsRef : IO.Ref (Std.TreeMap RequestID (IO.Promise (ServerRequestResponse Json)))
hLog : FS.Stream
initParams : InitializeParams
@ -100,14 +99,14 @@ structure WorkerContext where
def WorkerContext.modifyGetPartialHandler (ctx : WorkerContext) (method : String)
(f : PartialHandlerInfo → α × PartialHandlerInfo) : BaseIO α :=
ctx.partialHandlersRef.modifyGet fun partialHandlers => Id.run do
let h := partialHandlers.find! method
let h := partialHandlers.get! method
let (r, h) := f h
(r, partialHandlers.insert method h)
def WorkerContext.modifyPartialHandler (ctx : WorkerContext) (method : String)
(f : PartialHandlerInfo → PartialHandlerInfo) : BaseIO Unit :=
ctx.partialHandlersRef.modify fun partialHandlers => Id.run do
let some h := partialHandlers.find? method
let some h := partialHandlers.get? method
| return partialHandlers
partialHandlers.insert method <| f h
@ -341,7 +340,7 @@ structure PendingRequest where
cancelTk : RequestCancellationToken
-- Pending requests are tracked so they can be canceled
abbrev PendingRequestMap := RBMap RequestID PendingRequest compare
abbrev PendingRequestMap := Std.TreeMap RequestID PendingRequest
structure AvailableImportsCache where
availableImports : ImportCompletion.AvailableImports
@ -355,7 +354,7 @@ structure WorkerState where
pendingRequests : PendingRequestMap
/-- A map of RPC session IDs. We allow asynchronous elab tasks and request handlers
to modify sessions. A single `Ref` ensures atomic transactions. -/
rpcSessions : RBMap UInt64 (IO.Ref RpcSession) compare
rpcSessions : Std.TreeMap UInt64 (IO.Ref RpcSession)
abbrev WorkerM := ReaderT WorkerContext <| StateRefT WorkerState IO
@ -443,7 +442,7 @@ section Initialization
let pendingServerRequestsRef ← IO.mkRef ∅
let chanOut ← mkLspOutputChannel maxDocVersionRef
let timestamp ← IO.monoMsNow
let partialHandlersRef ← IO.mkRef <| RBMap.fromArray (cmp := compare) <|
let partialHandlersRef ← IO.mkRef <| Std.TreeMap.ofArray (cmp := compare) <|
(← partialLspRequestHandlerMethods).map fun (method, refreshMethod, _) =>
(method, {
refreshMethod
@ -480,8 +479,8 @@ section Initialization
return (ctx, {
doc := { doc with reporter }
reporterCancelTk
pendingRequests := RBMap.empty
rpcSessions := RBMap.empty
pendingRequests := Std.TreeMap.empty
rpcSessions := Std.TreeMap.empty
importCachingTask? := none
})
where
@ -599,7 +598,7 @@ section NotificationHandling
def handleCancelRequest (p : CancelParams) : WorkerM Unit := do
let st ← get
let some r := st.pendingRequests.find? p.id
let some r := st.pendingRequests.get? p.id
| return
r.cancelTk.cancelByCancelRequest
set <| { st with pendingRequests := st.pendingRequests.erase p.id }
@ -629,7 +628,7 @@ section NotificationHandling
def handleRpcRelease (p : Lsp.RpcReleaseParams) : WorkerM Unit := do
-- NOTE(WN): when the worker restarts e.g. due to changed imports, we may receive `rpc/release`
-- for the previous RPC session. This is fine, just ignore.
if let some seshRef := (← get).rpcSessions.find? p.sessionId then
if let some seshRef := (← get).rpcSessions.get? p.sessionId then
let monoMsNow ← IO.monoMsNow
let discardRefs : StateM RpcObjectStore Unit := do
for ref in p.refs do
@ -640,7 +639,7 @@ def handleRpcRelease (p : Lsp.RpcReleaseParams) : WorkerM Unit := do
{ st with objects }
def handleRpcKeepAlive (p : Lsp.RpcKeepAliveParams) : WorkerM Unit := do
match (← get).rpcSessions.find? p.sessionId with
match (← get).rpcSessions.get? p.sessionId with
| none => return
| some seshRef =>
seshRef.modify (·.keptAlive (← IO.monoMsNow))
@ -763,7 +762,7 @@ section MessageHandling
let params ← RequestM.parseRequestParams Lsp.RpcCallParams params
if params.method != `Lean.Widget.getInteractiveDiagnostics then
return none
let some seshRef := st.rpcSessions.find? params.sessionId
let some seshRef := st.rpcSessions.get? params.sessionId
| throw RequestError.rpcNeedsReconnect
let params ← RequestM.parseRequestParams Widget.GetInteractiveDiagnosticsParams params.params
let resp ← handleGetInteractiveDiagnosticsRequest ctx params
@ -914,7 +913,7 @@ section MainLoop
throwServerError s!"Failed responding to request {id}: {e}"
pure <| acc.erase id
else pure acc
let pendingRequests ← st.pendingRequests.foldM (fun acc id r => filterFinishedTasks acc id r.requestTask) st.pendingRequests
let pendingRequests ← st.pendingRequests.foldlM (fun acc id r => filterFinishedTasks acc id r.requestTask) st.pendingRequests
st := { st with pendingRequests }
-- Opportunistically (i.e. when we wake up on messages) check if any RPC session has expired.

6
src/Lean/Server/FileWorker/SemanticHighlighting.lean
View file

@ -25,8 +25,8 @@ def noHighlightKinds : Array SyntaxNodeKind := #[
-- TODO: make extensible, or don't
/-- Keywords for which a specific semantic token is provided. -/
def keywordSemanticTokenMap : RBMap String SemanticTokenType compare :=
RBMap.empty
def keywordSemanticTokenMap : Std.TreeMap String SemanticTokenType :=
Std.TreeMap.empty
|>.insert "sorry" .leanSorryLike
|>.insert "admit" .leanSorryLike
|>.insert "stop" .leanSorryLike
@ -114,7 +114,7 @@ partial def collectSyntaxBasedSemanticTokens : (stx : Syntax) → Array LeanSema
let isHashKeyword := val.length > 1 && val.front == '#' && isIdFirst (val.get ⟨1⟩)
if ! isRegularKeyword && ! isHashKeyword then
return tokens
return tokens.push ⟨stx, keywordSemanticTokenMap.findD val .keyword⟩
return tokens.push ⟨stx, keywordSemanticTokenMap.getD val .keyword⟩
/-- Collects all semantic tokens from the given `Elab.InfoTree`. -/
def collectInfoBasedSemanticTokens (i : Elab.InfoTree) : Array LeanSemanticToken :=

2
src/Lean/Server/GoTo.lean
View file

@ -5,7 +5,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Lars König, Wojciech Nawrocki
-/
prelude
import Lean.Data.Json.FromToJson
import Lean.Data.Json.FromToJson.Basic
import Lean.Util.Path
import Lean.Server.Utils

1
src/Lean/Server/References.lean
View file

@ -8,7 +8,6 @@ prelude
import Lean.Data.Lsp.Internal
import Lean.Data.Lsp.Extra
import Lean.Server.Utils
import Std.Data.TreeMap
import Lean.Elab.Import
import Std.Data.TreeSet.Basic

4
src/Lean/Server/Requests.lean
View file

@ -7,7 +7,7 @@ Authors: Wojciech Nawrocki, Marc Huisinga
prelude
import Lean.DeclarationRange
import Lean.Data.Json
import Lean.Data.Json.Basic
import Lean.Data.Lsp
import Lean.Elab.Command
@ -192,7 +192,7 @@ abbrev ServerRequestEmitter := (method : String) → (param : Json)
→ BaseIO (ServerTask (ServerRequestResponse Json))
structure RequestContext where
rpcSessions : RBMap UInt64 (IO.Ref FileWorker.RpcSession) compare
rpcSessions : Std.TreeMap UInt64 (IO.Ref FileWorker.RpcSession)
doc : FileWorker.EditableDocument
hLog : IO.FS.Stream
initParams : Lsp.InitializeParams

2
src/Lean/Server/Rpc/Basic.lean
View file

@ -6,7 +6,7 @@ Authors: Wojciech Nawrocki
-/
prelude
import Init.Dynamic
import Lean.Data.Json
import Lean.Data.Json.FromToJson.Basic
/-! Allows LSP clients to make Remote Procedure Calls to the server.

2
src/Lean/Server/Rpc/RequestHandling.lean
View file

@ -73,7 +73,7 @@ def wrapRpcProcedure (method : Name) paramType respType
wrapper seshId j := do
let rc ← read
let some seshRef := rc.rpcSessions.find? seshId
let some seshRef := rc.rpcSessions.get? seshId
| throwThe RequestError { code := JsonRpc.ErrorCode.rpcNeedsReconnect
message := s!"Outdated RPC session" }

31
src/Lean/Server/Watchdog.lean
View file

@ -7,12 +7,9 @@ Authors: Marc Huisinga, Wojciech Nawrocki
prelude
import Init.System.IO
import Std.Sync.Mutex
import Std.Data.TreeMap
import Init.Data.ByteArray
import Lean.Data.RBMap
import Lean.Data.FuzzyMatching
import Lean.Data.Json
import Lean.Data.Lsp
import Lean.Server.Utils
import Lean.Server.Requests
@ -260,7 +257,7 @@ end FileWorker
section ServerM
abbrev FileWorkerMap := Std.TreeMap DocumentUri FileWorker
abbrev ImportMap := RBMap DocumentUri (RBTree DocumentUri compare) compare
abbrev ImportMap := Std.TreeMap DocumentUri (Std.TreeSet DocumentUri)
/-- Global import data for all open files managed by this watchdog. -/
structure ImportData where
@ -270,15 +267,15 @@ section ServerM
importedBy : ImportMap
/-- Updates `d` with the new set of `imports` for the file `uri`. -/
def ImportData.update (d : ImportData) (uri : DocumentUri) (imports : RBTree DocumentUri compare)
def ImportData.update (d : ImportData) (uri : DocumentUri) (imports : Std.TreeSet DocumentUri)
: ImportData := Id.run do
let oldImports := d.imports.findD uri ∅
let removedImports := oldImports.diff imports
let addedImports := imports.diff oldImports
let oldImports := d.imports.getD uri ∅
let removedImports := oldImports.eraseMany imports
let addedImports := imports.eraseMany oldImports
let mut importedBy := d.importedBy
for removedImport in removedImports do
let importedByRemovedImport' := importedBy.find! removedImport |>.erase uri
let importedByRemovedImport' := importedBy.get! removedImport |>.erase uri
if importedByRemovedImport'.isEmpty then
importedBy := importedBy.erase removedImport
else
@ -286,7 +283,7 @@ section ServerM
for addedImport in addedImports do
importedBy :=
importedBy.findD addedImport ∅
importedBy.getD addedImport ∅
|>.insert uri
|> importedBy.insert addedImport
@ -308,7 +305,7 @@ section ServerM
sourceUri : DocumentUri
localID : RequestID
abbrev PendingServerRequestMap := RBMap RequestID RequestIDTranslation compare
abbrev PendingServerRequestMap := Std.TreeMap RequestID RequestIDTranslation
structure ServerRequestData where
pendingServerRequests : PendingServerRequestMap
@ -330,7 +327,7 @@ section ServerM
(data : ServerRequestData)
(globalID : RequestID)
: Option RequestIDTranslation × ServerRequestData :=
let translation? := data.pendingServerRequests.find? globalID
let translation? := data.pendingServerRequests.get? globalID
let data := { data with pendingServerRequests := data.pendingServerRequests.erase globalID }
(translation?, data)
@ -1101,7 +1098,7 @@ def handlePrepareRename (p : PrepareRenameParams) : ReaderT ReferenceRequestCont
def handleRename (p : RenameParams) : ReaderT ReferenceRequestContext IO Lsp.WorkspaceEdit := do
if (String.toName p.newName).isAnonymous then
throwServerError s!"Can't rename: `{p.newName}` is not an identifier"
let mut refs : Std.HashMap DocumentUri (RBMap Lsp.Position Lsp.Position compare) := ∅
let mut refs : Std.HashMap DocumentUri (Std.TreeMap Lsp.Position Lsp.Position) := ∅
for { uri, range } in (← handleReference { p with context.includeDeclaration := true }) do
refs := refs.insert uri <| (refs.getD uri ∅).insert range.start range.end
-- We have to filter the list of changes to put the ranges in order and
@ -1161,7 +1158,7 @@ section NotificationHandling
let s ← read
let fileWorkers ← s.fileWorkersRef.get
let importData ← s.importData.get
let dependents := importData.importedBy.findD p.textDocument.uri ∅
let dependents := importData.importedBy.getD p.textDocument.uri ∅
for ⟨uri, _⟩ in fileWorkers do
if ! dependents.contains uri then
@ -1178,7 +1175,7 @@ section NotificationHandling
if ! leanChanges.isEmpty then
let importData ← (← read).importData.get
for (c, _) in leanChanges do
let dependents := importData.importedBy.findD c.uri ∅
let dependents := importData.importedBy.getD c.uri ∅
for dependent in dependents do
notifyAboutStaleDependency dependent c.uri
if ! ileanChanges.isEmpty then
@ -1595,10 +1592,10 @@ def initAndRunWatchdog (args : List String) (i o e : FS.Stream) : IO Unit := do
startLoadingReferences referenceData
let fileWorkersRef ← IO.mkRef (Std.TreeMap.empty : FileWorkerMap)
let serverRequestData ← IO.mkRef {
pendingServerRequests := RBMap.empty
pendingServerRequests := Std.TreeMap.empty
freshServerRequestID := 0
}
let importData ← IO.mkRef ⟨RBMap.empty, RBMap.empty⟩
let importData ← IO.mkRef ⟨Std.TreeMap.empty, Std.TreeMap.empty⟩
let requestData ← RequestDataMutex.new
let i ← maybeTee "wdIn.txt" false i
let o ← maybeTee "wdOut.txt" true o

3
src/Lean/Setup.lean
View file

@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mac Malone
-/
prelude
import Lean.Data.Json
import Lean.Data.Json.Parser
import Lean.Data.Json.FromToJson.Basic
import Lean.Util.LeanOptions
/-!

5
src/Lean/SubExpr.lean
View file

@ -5,8 +5,7 @@ Authors: Sebastian Ullrich, Daniel Selsam, Wojciech Nawrocki, E.W.Ayers
-/
prelude
import Lean.Meta.Basic
import Lean.Data.Json
import Lean.Data.RBMap
import Lean.Data.Json.Basic
import Init.Control.Option
namespace Lean
@ -171,7 +170,7 @@ def mkRoot (e : Expr) : SubExpr := ⟨e, Pos.root⟩
def isRoot (s : SubExpr) : Bool := s.pos.isRoot
/-- Map from subexpr positions to values. -/
abbrev PosMap (α : Type u) := RBMap Pos α compare
abbrev PosMap (α : Type u) := Std.TreeMap Pos α
def bindingBody! : SubExpr → SubExpr
| ⟨.forallE _ _ b _, p⟩ => ⟨b, p.pushBindingBody⟩

Some files were not shown because too many files have changed in this diff Show more