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

feat: allow users to use binders when setting default value for parent fields

Browse source
This commit is contained in:
Leonardo de Moura 2020-12-23 08:12:29 -08:00
parent 7e76446d9d
commit 7720b843bb
2 changed files with 22 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -300,12 +300,16 @@ private partial def withFields
match view.value? with
| none => throwError! "field '{view.name}' has been declared in parent structure"
| some valStx => do
if !view.binders.getArgs.isEmpty || view.type?.isSome then
throwErrorAt! view.ref "omit field '{view.name}' type to set default value"
let fvarType ← inferType info.fvar
let value ← Term.elabTermEnsuringType valStx fvarType
let infos := infos.push { info with value? := value }
withFields views (i+1) infos k
if let some type := view.type? then
throwErrorAt! type "omit field '{view.name}' type to set default value"
else
let mut valStx := valStx
if view.binders.getArgs.size > 0 then
valStx ← `(fun $(view.binders.getArgs)* => $valStx:term)
let fvarType ← inferType info.fvar
let value ← Term.elabTermEnsuringType valStx fvarType
let infos := infos.push { info with value? := value }
withFields views (i+1) infos k
| StructFieldKind.subobject => unreachable!
else
k infos

22
tests/lean/run/struct3.lean
View file

@ -1,14 +1,16 @@
universes u v
class Bind2 (m : Type u → Type v) :=
(bind : ∀ {α β : Type u}, m α → (α → m β) → m β)
class Bind2 (m : Type u → Type v) where
bind : ∀ {α β : Type u}, m α → (α → m β) → m β
set_option pp.all true
class Monad2 (m : Type u → Type v) extends Applicative m, Bind2 m : Type (max (u+1) v) where
map := fun f x => Bind2.bind x (pure ∘ f)
seq := fun f x => Bind2.bind f fun y => Functor.map y x
seqLeft := fun x y => Bind2.bind x fun a => Bind2.bind y fun _ => pure a
seqRight := @fun β x y => Bind2.bind x fun _ => y -- Recall that `@` disables implicit lambda support
class Monad2 (m : Type u → Type v) extends Applicative m, Bind2 m : Type (max (u+1) v) :=
(map := fun f x => Bind2.bind x (pure ∘ f))
(seq := fun f x => Bind2.bind f fun y => Functor.map y x)
(seqLeft := fun x y => Bind2.bind x fun a => Bind2.bind y fun _ => pure a)
(seqRight := @fun β x y => Bind2.bind x fun _ => y) -- Recall that `@` disables implicit lambda support
class Monad3 (m : Type u → Type v) extends Applicative m, Bind2 m : Type (max (u+1) v) where
map (f x) := Bind2.bind x (pure ∘ f)
seq (f x) := Bind2.bind f fun y => Functor.map y x
seqLeft (x y) := Bind2.bind x fun a => Bind2.bind y fun _ => pure a
seqRight (x y) := Bind2.bind x fun _ => y