diff --git a/library/init/category/alternative.lean b/library/init/category/alternative.lean index 182266bee2..c34d46d9b4 100644 --- a/library/init/category/alternative.lean +++ b/library/init/category/alternative.lean @@ -8,16 +8,16 @@ import init.logic init.category.applicative universes u v class alternative (f : Type u → Type v) extends applicative f : Type (max u+1 v) := -(failure : Π {a : Type u}, f a) -(orelse : Π {a : Type u}, f a → f a → f a) +(failure : Π {α : Type u}, f α) +(orelse : Π {α : Type u}, f α → f α → f α) section -variables {f : Type u → Type v} [alternative f] {a : Type u} +variables {f : Type u → Type v} [alternative f] {α : Type u} -@[inline] def failure : f a := +@[inline] def failure : f α := alternative.failure f -@[inline] def orelse : f a → f a → f a := +@[inline] def orelse : f α → f α → f α := alternative.orelse infixr ` <|> `:2 := orelse @@ -31,7 +31,7 @@ if p then pure () else failure | tt := pure () | ff := failure -@[inline] def optional (x : f a) : f (option a) := +@[inline] def optional (x : f α) : f (option α) := some <$> x <|> pure none end diff --git a/library/init/category/applicative.lean b/library/init/category/applicative.lean index 4bf778dd52..6f15a56b76 100644 --- a/library/init/category/applicative.lean +++ b/library/init/category/applicative.lean @@ -1,38 +1,38 @@ /- Copyright (c) 2016 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Author: Leonardo de Moura +Authors: Leonardo de Moura, Sebastian Ullrich -/ prelude import init.category.functor -import init.function open function universes u v -class applicative (f : Type u → Type v) extends functor f : Type (max u+1 v):= -(pure : Π {a : Type u}, a → f a) -(seq : Π {a b : Type u}, f (a → b) → f a → f b) +class applicative (f : Type u → Type v) extends functor f := +(pure : Π {α : Type u}, α → f α) +(seq : Π {α β : Type u}, f (α → β) → f α → f β) +(seq_left : Π {α β : Type u}, f α → f β → f α := λ α β a b, seq (map (const β) a) b) +(seq_right : Π {α β : Type u}, f α → f β → f β := λ α β a b, seq (map (const α id) a) b) +(map := λ _ _ x y, seq (pure x) y) section -variables {a b : Type u} {f : Type u → Type v} [applicative f] +variables {f : Type u → Type v} [applicative f] {α β : Type u} -@[inline] def pure : a → f a := +@[inline] def pure : α → f α := applicative.pure f -@[inline] def seq_app : f (a → b) → f a → f b := +@[inline] def seq_app : f (α → β) → f α → f β := applicative.seq -infixl ` <*> `:2 := seq_app - /-- Sequence actions, discarding the first value. -/ -def seq_left (x : f a) (y : f b) : f a := -pure (λ x y, x) <*> x <*> y +@[inline] def seq_left : f α → f β → f α := +applicative.seq_left /-- Sequence actions, discarding the second value. -/ -def seq_right (x : f a) (y : f b) : f b := -pure (λ x y, y) <*> x <*> y - -infixl ` <* `:2 := seq_left -infixl ` *> `:2 := seq_right +@[inline] def seq_right : f α → f β → f β := +applicative.seq_right +infixl ` <*> `:2 := seq_app +infixl ` <* `:2 := seq_left +infixl ` *> `:2 := seq_right end diff --git a/library/init/category/functor.lean b/library/init/category/functor.lean index 292c2e1f22..7e4d925e73 100644 --- a/library/init/category/functor.lean +++ b/library/init/category/functor.lean @@ -1,16 +1,23 @@ /- Copyright (c) Luke Nelson and Jared Roesch. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Luke Nelson and Jared Roesch +Authors: Luke Nelson, Jared Roesch, Sebastian Ullrich -/ prelude -import init.core +import init.core init.function +open function universes u v class functor (f : Type u → Type v) : Type (max u+1 v) := -(map : Π {a b : Type u}, (a → b) → f a → f b) +(map : Π {α β : Type u}, (α → β) → f α → f β) +(map_const : Π {α : Type u} (β : Type u), α → f β → f α := λ α β, map ∘ const β) -@[inline] def fmap {f : Type u → Type v} [functor f] {a b : Type u} : (a → b) → f a → f b := +@[inline] def fmap {f : Type u → Type v} [functor f] {α β : Type u} : (α → β) → f α → f β := functor.map +@[inline] def fmap_const {f : Type u → Type v} [functor f] {α : Type u} : Π (β : Type u), α → f β → f α := +functor.map_const + infixr ` <$> `:100 := fmap +infixr ` <$ `:100 := fmap_const +infixr ` $> `:100 := λ α a b, fmap_const α b a diff --git a/library/init/category/monad.lean b/library/init/category/monad.lean index 462a1d1e86..7de9980012 100644 --- a/library/init/category/monad.lean +++ b/library/init/category/monad.lean @@ -1,38 +1,32 @@ /- Copyright (c) Luke Nelson and Jared Roesch. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Luke Nelson and Jared Roesch +Authors: Leonardo de Moura, Luke Nelson, Jared Roesch, Sebastian Ullrich -/ prelude import init.category.applicative universes u v class pre_monad (m : Type u → Type v) := -(bind : Π {a b : Type u}, m a → (a → m b) → m b) +(bind : Π {α β : Type u}, m α → (α → m β) → m β) -@[inline] def bind {m : Type u → Type v} [pre_monad m] {a b : Type u} : m a → (a → m b) → m b := +@[inline] def bind {m : Type u → Type v} [pre_monad m] {α β : Type u} : m α → (α → m β) → m β := pre_monad.bind -@[inline] def pre_monad.and_then {a b : Type u} {m : Type u → Type v} [pre_monad m] (x : m a) (y : m b) : m b := +@[inline] def pre_monad.and_then {α β : Type u} {m : Type u → Type v} [pre_monad m] (x : m α) (y : m β) : m β := do x, y -class monad (m : Type u → Type v) extends functor m, pre_monad m : Type (max u+1 v) := -(ret : Π {a : Type u}, a → m a) - -@[inline] def return {m : Type u → Type v} [monad m] {a : Type u} : a → m a := -monad.ret m - -def fapp {m : Type u → Type v} [monad m] {a b : Type u} (f : m (a → b)) (a : m a) : m b := -do g ← f, - b ← a, - return (g b) - -@[inline] instance monad_is_applicative (m : Type u → Type v) [monad m] : applicative m := -⟨@fmap _ _, @return _ _, @fapp _ _⟩ - infixl ` >>= `:2 := bind infixl ` >> `:2 := pre_monad.and_then +class monad (m : Type u → Type v) extends applicative m, pre_monad m : Type (max u+1 v) := +(seq := λ α β f x, bind f $ λ f, bind x $ λ x, pure (f x)) +-- implied by `seq`, but a bit simpler +(map := λ α β f x, bind x $ λ x, pure (f x)) + +def return {m : Type u → Type v} [monad m] {α : Type u} : α → m α := +pure + /- Identical to pre_monad.and_then, but it is not inlined. -/ -def pre_monad.seq {a b : Type u} {m : Type u → Type v} [pre_monad m] (x : m a) (y : m b) : m b := +def pre_monad.seq {α β : Type u} {m : Type u → Type v} [pre_monad m] (x : m α) (y : m β) : m β := do x, y diff --git a/library/init/category/state.lean b/library/init/category/state.lean index a5edf84a37..42cb19c533 100644 --- a/library/init/category/state.lean +++ b/library/init/category/state.lean @@ -12,9 +12,6 @@ def state (σ : Type) (α : Type) : Type := section variables {σ : Type} {α β : Type} -@[inline] def state_fmap (f : α → β) (a : state σ α) : state σ β := -λ s, match (a s) with (a', s') := (f a', s') end - @[inline] def state_return (a : α) : state σ α := λ s, (a, s) @@ -22,9 +19,7 @@ variables {σ : Type} {α β : Type} λ s, match (a s) with (a', s') := b a' s' end instance (σ : Type) : monad (state σ) := -{ map := @state_fmap σ, - ret := @state_return σ, - bind := @state_bind σ } +{pure := @state_return σ, bind := @state_bind σ} end namespace state @@ -44,11 +39,6 @@ section variable [monad m] variables {α β : Type} - def state_t_fmap (f : α → β) (act : state_t σ m α) : state_t σ m β := - λ s, show m (β × σ), from - do (a, new_s) ← act s, - return (f a, new_s) - def state_t_return (a : α) : state_t σ m α := λ s, show m (α × σ), from return (a, s) @@ -60,9 +50,7 @@ section end instance (σ : Type) (m : Type → Type) [monad m] : monad (state_t σ m) := -{ map := @state_t_fmap σ m _, - ret := @state_t_return σ m _, - bind := @state_t_bind σ m _} +{pure := @state_t_return σ m _, bind := @state_t_bind σ m _} section variable {σ : Type} @@ -79,9 +67,7 @@ section end instance (σ : Type) (m : Type → Type) [alternative m] [monad m] : alternative (state_t σ m) := -{ map := @state_t_fmap σ m _, - pure := @state_t_return σ m _, - seq := @fapp _ _, +{ state_t.monad σ m with failure := @state_t_failure σ m _ _, orelse := @state_t_orelse σ m _ _ } diff --git a/library/init/data/list/basic.lean b/library/init/data/list/basic.lean index ae31e28fde..bc71f65781 100644 --- a/library/init/data/list/basic.lean +++ b/library/init/data/list/basic.lean @@ -229,4 +229,4 @@ join (map b a) end list instance : monad list := -{map := @list.map, ret := @list.ret, bind := @list.bind} +{map := @list.map, pure := @list.ret, bind := @list.bind} diff --git a/library/init/data/list/instances.lean b/library/init/data/list/instances.lean index 769fb46368..1ae4565e3e 100644 --- a/library/init/data/list/instances.lean +++ b/library/init/data/list/instances.lean @@ -11,7 +11,9 @@ open list universes u v instance : alternative list := -⟨@map, @list.ret, @fapp _ _, @nil, @list.append⟩ +{ list.monad with + failure := @nil, + orelse := @list.append } instance {α : Type u} [decidable_eq α] : decidable_eq (list α) := by tactic.mk_dec_eq_instance diff --git a/library/init/data/option/basic.lean b/library/init/data/option/basic.lean index d041fa268f..aa98a6cb1e 100644 --- a/library/init/data/option/basic.lean +++ b/library/init/data/option/basic.lean @@ -53,16 +53,12 @@ instance {α : Type u} [d : decidable_eq α] : decidable_eq (option α) | (is_false n) := is_false (λ h, option.no_confusion h (λ e, absurd e n)) end -@[inline] def option_fmap {α : Type u} {β : Type v} (f : α → β) : option α → option β -| none := none -| (some a) := some (f a) - @[inline] def option_bind {α : Type u} {β : Type v} : option α → (α → option β) → option β | none b := none | (some a) b := b a instance : monad option := -{map := @option_fmap, ret := @some, bind := @option_bind} +{pure := @some, bind := @option_bind} def option_orelse {α : Type u} : option α → option α → option α | (some a) o := some a @@ -70,19 +66,13 @@ def option_orelse {α : Type u} : option α → option α → option α | none none := none instance : alternative option := -alternative.mk @option_fmap @some (@fapp _ _) @none @option_orelse +{ option.monad with + failure := @none, + orelse := @option_orelse } def option_t (m : Type u → Type v) [monad m] (α : Type u) : Type v := m (option α) -@[inline] def option_t_fmap {m : Type u → Type v} [monad m] {α β : Type u} (f : α → β) (e : option_t m α) : option_t m β := -show m (option β), from -do o ← e, - match o with - | none := return none - | (some a) := return (some (f a)) - end - @[inline] def option_t_bind {m : Type u → Type v} [monad m] {α β : Type u} (a : option_t m α) (b : α → option_t m β) : option_t m β := show m (option β), from @@ -97,7 +87,7 @@ show m (option α), from return (some a) instance {m : Type u → Type v} [monad m] : monad (option_t m) := -{map := @option_t_fmap m _, ret := @option_t_return m _, bind := @option_t_bind m _} +{pure := @option_t_return m _, bind := @option_t_bind m _} def option_t_orelse {m : Type u → Type v} [monad m] {α : Type u} (a : option_t m α) (b : option_t m α) : option_t m α := show m (option α), from @@ -112,11 +102,9 @@ show m (option α), from return none instance {m : Type u → Type v} [monad m] : alternative (option_t m) := -{map := @option_t_fmap m _, - pure := @option_t_return m _, - seq := @fapp (option_t m) (@option_t.monad m _), - failure := @option_t_fail m _, - orelse := @option_t_orelse m _} +{ option_t.monad with + failure := @option_t_fail m _, + orelse := @option_t_orelse m _ } def option_t.lift {m : Type u → Type v} [monad m] {α : Type u} (a : m α) : option_t m α := (some <$> a : m (option α)) diff --git a/library/init/data/set.lean b/library/init/data/set.lean index ad968cdd77..f4fd527986 100644 --- a/library/init/data/set.lean +++ b/library/init/data/set.lean @@ -74,6 +74,6 @@ def image (f : α → β) (s : set α) : set β := {b | ∃ a, a ∈ s ∧ f a = b} instance : functor set := -⟨@set.image⟩ +{map := @set.image} end set diff --git a/library/init/meta/converter.lean b/library/init/meta/converter.lean index 79cfd15b6e..7b15d87617 100644 --- a/library/init/meta/converter.lean +++ b/library/init/meta/converter.lean @@ -69,13 +69,11 @@ protected meta def bind {α β : Type} (c₁ : conv α) (c₂ : α → conv β) meta instance : monad conv := { map := @conv.map, - ret := @conv.pure, + pure := @conv.pure, bind := @conv.bind } meta instance : alternative conv := -{ map := @conv.map, - pure := @conv.pure, - seq := @conv.seq, +{ conv.monad with failure := @conv.fail, orelse := @conv.orelse } diff --git a/library/init/meta/exceptional.lean b/library/init/meta/exceptional.lean index 70364d4c02..f3db6d8085 100644 --- a/library/init/meta/exceptional.lean +++ b/library/init/meta/exceptional.lean @@ -37,11 +37,6 @@ protected meta def to_option : exceptional α → option α | (success a) := some a | (exception .α _) := none -@[inline] protected meta def fmap (f : α → β) (e : exceptional α) : exceptional β := -exceptional.cases_on e - (λ a, success (f a)) - (λ f, exception β f) - @[inline] protected meta def bind (e₁ : exceptional α) (e₂ : α → exceptional β) : exceptional β := exceptional.cases_on e₁ (λ a, e₂ a) @@ -55,4 +50,4 @@ exception α (λ u, f) end exceptional meta instance : monad exceptional := -{map := @exceptional.fmap, ret := @exceptional.return, bind := @exceptional.bind} +{pure := @exceptional.return, bind := @exceptional.bind} diff --git a/library/init/meta/interaction_monad.lean b/library/init/meta/interaction_monad.lean index e2f53e8e39..06c3c2e137 100644 --- a/library/init/meta/interaction_monad.lean +++ b/library/init/meta/interaction_monad.lean @@ -63,7 +63,7 @@ meta def interaction_monad_orelse {α : Type u} (t₁ t₂ : m α) : m α := interaction_monad_bind t₁ (λ a, t₂) meta instance interaction_monad.monad : monad m := -{map := @interaction_monad_fmap, ret := @interaction_monad_return, bind := @interaction_monad_bind} +{map := @interaction_monad_fmap, pure := @interaction_monad_return, bind := @interaction_monad_bind} meta def interaction_monad.mk_exception {α : Type u} {β : Type v} [has_to_format β] (msg : β) (ref : option expr) (s : state) : result state α := exception (some (λ _, to_fmt msg)) none s diff --git a/library/init/meta/lean/parser.lean b/library/init/meta/lean/parser.lean index b0640d47f8..47e25699cb 100644 --- a/library/init/meta/lean/parser.lean +++ b/library/init/meta/lean/parser.lean @@ -47,7 +47,9 @@ result.cases_on (p₁ s) exception) meta instance : alternative parser := -⟨@interaction_monad_fmap parser_state, (λ α a s, success a s), (@fapp _ _), @interaction_monad.failed parser_state, @parser_orelse⟩ +{ interaction_monad.monad with + failure := @interaction_monad.failed _, + orelse := @parser_orelse } -- TODO: move diff --git a/library/init/meta/smt/smt_tactic.lean b/library/init/meta/smt/smt_tactic.lean index 4eaa29d78b..0b9aacdaa6 100644 --- a/library/init/meta/smt/smt_tactic.lean +++ b/library/init/meta/smt/smt_tactic.lean @@ -82,11 +82,9 @@ meta instance : monad_fail smt_tactic := { smt_tactic.monad with fail := λ α s, (tactic.fail (to_fmt s) : smt_tactic α) } meta instance : alternative smt_tactic := -{failure := λ α, @tactic.failed α, - orelse := @smt_tactic_orelse, - pure := @return _ _, - seq := @fapp _ _, - map := @fmap _ _} +{ smt_tactic.monad with + failure := λ α, @tactic.failed α, + orelse := @smt_tactic_orelse } namespace smt_tactic open tactic (transparency) diff --git a/library/init/meta/tactic.lean b/library/init/meta/tactic.lean index b20ad83e2d..f051dd3066 100644 --- a/library/init/meta/tactic.lean +++ b/library/init/meta/tactic.lean @@ -51,7 +51,9 @@ infixl ` >>=[tactic] `:2 := interaction_monad_bind infixl ` >>[tactic] `:2 := interaction_monad_seq meta instance : alternative tactic := -⟨@interaction_monad_fmap tactic_state, (λ α a s, success a s), (@fapp _ _), @interaction_monad.failed tactic_state, @interaction_monad_orelse tactic_state⟩ +{ interaction_monad.monad with + failure := @interaction_monad.failed _, + orelse := @interaction_monad_orelse _ } meta def {u₁ u₂} tactic.up {α : Type u₂} (t : tactic α) : tactic (ulift.{u₁} α) := λ s, match t s with diff --git a/library/init/meta/task.lean b/library/init/meta/task.lean index 8d34056a19..43c9331dd9 100644 --- a/library/init/meta/task.lean +++ b/library/init/meta/task.lean @@ -14,7 +14,7 @@ protected meta def {u v} bind {α : Type u} {β : Type v} (t : task α) (f : α task.flatten (task.map f t) meta instance : monad task := -{ map := @task.map, bind := @task.bind, ret := @task.pure } +{ map := @task.map, bind := @task.bind, pure := @task.pure } @[inline] meta def {u} delay {α : Type u} (f : unit → α) : task α := diff --git a/library/init/meta/vm.lean b/library/init/meta/vm.lean index 32041bf555..cb1b02f085 100644 --- a/library/init/meta/vm.lean +++ b/library/init/meta/vm.lean @@ -77,7 +77,7 @@ meta constant vm_core.ret {α : Type} : α → vm_core α meta constant vm_core.bind {α β : Type} : vm_core α → (α → vm_core β) → vm_core β meta instance : monad vm_core := -{map := @vm_core.map, ret := @vm_core.ret, bind := @vm_core.bind} +{map := @vm_core.map, pure := @vm_core.ret, bind := @vm_core.bind} @[reducible] meta def vm (α : Type) : Type := option_t vm_core α diff --git a/library/init/native/result.lean b/library/init/native/result.lean index aa79273e64..bc867ac8e3 100644 --- a/library/init/native/result.lean +++ b/library/init/native/result.lean @@ -5,11 +5,7 @@ Authors: Jared Roesch -/ prelude -import init.category.applicative -import init.category.functor import init.category.monad -import init.logic -import init.function namespace native @@ -21,24 +17,12 @@ def unwrap_or {E T : Type} : result E T → T → T | (result.err _) default := default | (result.ok t) _ := t -def result.map : Π {E : Type} {T : Type} {U : Type}, (T → U) → result E T → result E U -| E T U f (result.err e) := result.err e -| E T U f (result.ok t) := result.ok (f t) - def result.and_then {E T U : Type} : result E T → (T → result E U) → result E U | (result.err e) _ := result.err e | (result.ok t) f := f t -instance result_functor (E : Type) : functor (result E) := functor.mk (@result.map E) - -def result.seq {E T U : Type} : result E (T → U) → result E T → result E U -| f t := result.and_then f (fun f', result.and_then t (fun t', result.ok (f' t'))) - -instance result_applicative (E : Type) : applicative (result E) := - applicative.mk (@result.map E) (@result.ok E) (@result.seq E) - instance result_monad (E : Type) : monad (result E) := -{map := @result.map E, ret := @result.ok E, bind := @result.and_then E} +{pure := @result.ok E, bind := @result.and_then E} inductive resultT (M : Type → Type) (E : Type) (A : Type) : Type | run : M (result E A) → resultT @@ -46,9 +30,6 @@ inductive resultT (M : Type → Type) (E : Type) (A : Type) : Type section resultT variable {M : Type → Type} - def resultT.map [functor : functor M] {E : Type} {A B : Type} : (A → B) → resultT M E A → resultT M E B - | f (resultT.run action) := resultT.run (@functor.map M functor _ _ (result.map f) action) - def resultT.pure [monad : monad M] {E A : Type} (x : A) : resultT M E A := resultT.run $ return (result.ok x) @@ -56,17 +37,13 @@ section resultT | (resultT.run action) f := resultT.run (do res_a ← action, -- a little ugly with this match - (match res_a with - | native.result.err e := return (native.result.err e) - | native.result.ok a := let (resultT.run actionB) := f a in actionB - end : M (result E B))) + match res_a with + | result.err e := return (result.err e) + | result.ok a := let (resultT.run actionB) := f a in actionB + end) - instance resultT_functor [f : functor M] (E : Type) : functor (resultT M E) := - functor.mk (@resultT.map M f E) - - -- Should we unify functor and monad like haskell? - instance resultT_monad [f : functor M] [m : monad M] (E : Type) : monad (resultT M E) := - {map := @resultT.map M f E, ret := @resultT.pure M m E, bind := @resultT.and_then M m E} + instance resultT_monad [m : monad M] (E : Type) : monad (resultT M E) := + {pure := @resultT.pure M m E, bind := @resultT.and_then M m E} end resultT end native diff --git a/library/system/io.lean b/library/system/io.lean index 230ff7759b..6d5f67226c 100644 --- a/library/system/io.lean +++ b/library/system/io.lean @@ -12,7 +12,7 @@ constant io.put_str : string → io unit constant io.get_line : io string instance : monad io := -{ ret := @io.return, +{ pure := @io.return, bind := @io.bind, map := @io.map } diff --git a/library/tools/super/prover_state.lean b/library/tools/super/prover_state.lean index 4febeb776f..c67894510e 100644 --- a/library/tools/super/prover_state.lean +++ b/library/tools/super/prover_state.lean @@ -154,7 +154,7 @@ meta def orelse (A : Type) (p1 p2 : prover A) : prover A := take state, p1 state <|> p2 state meta instance : alternative prover := -{ monad_is_applicative prover with +{ prover.monad with failure := λα, fail "failed", orelse := orelse } diff --git a/src/library/compiler/erase_irrelevant.cpp b/src/library/compiler/erase_irrelevant.cpp index a97543b8c7..49d8c104f6 100644 --- a/src/library/compiler/erase_irrelevant.cpp +++ b/src/library/compiler/erase_irrelevant.cpp @@ -365,12 +365,12 @@ class erase_irrelevant_fn : public compiler_step_visitor { } } - expr visit_monad_return(expr const & e, buffer const & args) { + expr visit_applicative_pure(expr const & e, buffer const & args) { if (args.size() == 4 && is_builtin_state_monad(args[1])) { /* IO monad return return v := fun s, (v, s) - Remark: we do not return the state explicility. + Remark: we do not return the state explicitly. */ expr u = mk_neutral_expr(); expr s = mk_var(0); @@ -420,8 +420,8 @@ class erase_irrelevant_fn : public compiler_step_visitor { return visit_subtype_rec(args); } else if (n == get_monad_bind_name() || n == get_pre_monad_bind_name()) { return visit_monad_bind(e, args); - } else if (n == get_monad_ret_name()) { - return visit_monad_return(e, args); + } else if (n == get_applicative_pure_name()) { + return visit_applicative_pure(e, args); } else if (is_cases_on_recursor(env(), n)) { return visit_cases_on(fn, args); } else if (inductive::is_elim_rule(env(), n)) { diff --git a/src/library/constants.cpp b/src/library/constants.cpp index d918283fc8..f04e501764 100644 --- a/src/library/constants.cpp +++ b/src/library/constants.cpp @@ -16,6 +16,7 @@ name const * g_and_elim_left = nullptr; name const * g_and_elim_right = nullptr; name const * g_and_intro = nullptr; name const * g_andthen = nullptr; +name const * g_applicative_pure = nullptr; name const * g_auto_param = nullptr; name const * g_bit0 = nullptr; name const * g_bit1 = nullptr; @@ -176,7 +177,6 @@ name const * g_match_failed = nullptr; name const * g_mod = nullptr; name const * g_monad = nullptr; name const * g_monad_bind = nullptr; -name const * g_monad_ret = nullptr; name const * g_monad_fail = nullptr; name const * g_monoid = nullptr; name const * g_mul = nullptr; @@ -391,6 +391,7 @@ void initialize_constants() { g_and_elim_right = new name{"and", "elim_right"}; g_and_intro = new name{"and", "intro"}; g_andthen = new name{"andthen"}; + g_applicative_pure = new name{"applicative", "pure"}; g_auto_param = new name{"auto_param"}; g_bit0 = new name{"bit0"}; g_bit1 = new name{"bit1"}; @@ -551,7 +552,6 @@ void initialize_constants() { g_mod = new name{"mod"}; g_monad = new name{"monad"}; g_monad_bind = new name{"monad", "bind"}; - g_monad_ret = new name{"monad", "ret"}; g_monad_fail = new name{"monad_fail"}; g_monoid = new name{"monoid"}; g_mul = new name{"mul"}; @@ -767,6 +767,7 @@ void finalize_constants() { delete g_and_elim_right; delete g_and_intro; delete g_andthen; + delete g_applicative_pure; delete g_auto_param; delete g_bit0; delete g_bit1; @@ -927,7 +928,6 @@ void finalize_constants() { delete g_mod; delete g_monad; delete g_monad_bind; - delete g_monad_ret; delete g_monad_fail; delete g_monoid; delete g_mul; @@ -1142,6 +1142,7 @@ name const & get_and_elim_left_name() { return *g_and_elim_left; } name const & get_and_elim_right_name() { return *g_and_elim_right; } name const & get_and_intro_name() { return *g_and_intro; } name const & get_andthen_name() { return *g_andthen; } +name const & get_applicative_pure_name() { return *g_applicative_pure; } name const & get_auto_param_name() { return *g_auto_param; } name const & get_bit0_name() { return *g_bit0; } name const & get_bit1_name() { return *g_bit1; } @@ -1302,7 +1303,6 @@ name const & get_match_failed_name() { return *g_match_failed; } name const & get_mod_name() { return *g_mod; } name const & get_monad_name() { return *g_monad; } name const & get_monad_bind_name() { return *g_monad_bind; } -name const & get_monad_ret_name() { return *g_monad_ret; } name const & get_monad_fail_name() { return *g_monad_fail; } name const & get_monoid_name() { return *g_monoid; } name const & get_mul_name() { return *g_mul; } diff --git a/src/library/constants.h b/src/library/constants.h index 8a5fea3e28..9686747dc4 100644 --- a/src/library/constants.h +++ b/src/library/constants.h @@ -18,6 +18,7 @@ name const & get_and_elim_left_name(); name const & get_and_elim_right_name(); name const & get_and_intro_name(); name const & get_andthen_name(); +name const & get_applicative_pure_name(); name const & get_auto_param_name(); name const & get_bit0_name(); name const & get_bit1_name(); @@ -178,7 +179,6 @@ name const & get_match_failed_name(); name const & get_mod_name(); name const & get_monad_name(); name const & get_monad_bind_name(); -name const & get_monad_ret_name(); name const & get_monad_fail_name(); name const & get_monoid_name(); name const & get_mul_name(); diff --git a/src/library/constants.txt b/src/library/constants.txt index 886b7ef7a2..ce39a6b84c 100644 --- a/src/library/constants.txt +++ b/src/library/constants.txt @@ -11,6 +11,7 @@ and.elim_left and.elim_right and.intro andthen +applicative.pure auto_param bit0 bit1 @@ -171,7 +172,6 @@ match_failed mod monad monad.bind -monad.ret monad_fail monoid mul diff --git a/tests/lean/run/check_constants.lean b/tests/lean/run/check_constants.lean index c93fd59ce9..15397175cb 100644 --- a/tests/lean/run/check_constants.lean +++ b/tests/lean/run/check_constants.lean @@ -16,6 +16,7 @@ run_cmd script_check_id `and.elim_left run_cmd script_check_id `and.elim_right run_cmd script_check_id `and.intro run_cmd script_check_id `andthen +run_cmd script_check_id `applicative.pure run_cmd script_check_id `auto_param run_cmd script_check_id `bit0 run_cmd script_check_id `bit1 @@ -176,7 +177,6 @@ run_cmd script_check_id `match_failed run_cmd script_check_id `mod run_cmd script_check_id `monad run_cmd script_check_id `monad.bind -run_cmd script_check_id `monad.ret run_cmd script_check_id `monad_fail run_cmd script_check_id `monoid run_cmd script_check_id `mul diff --git a/tests/lean/run/isabelle.lean b/tests/lean/run/isabelle.lean index 7a6125d692..3d5f25966b 100644 --- a/tests/lean/run/isabelle.lean +++ b/tests/lean/run/isabelle.lean @@ -23,9 +23,6 @@ meta instance {α : Type} : has_coe (tactic α) (lazy_tactic α) := protected meta def return {α} (a : α) : lazy_tactic α := λ s, lazy_list.singleton (a, s) -protected meta def map {α β} (f : α → β) : lazy_tactic α → lazy_tactic β -| t s := (t s)^.for (λ ⟨a, new_s⟩, (f a, new_s)) - protected meta def bind {α β} : lazy_tactic α → (α → lazy_tactic β) → lazy_tactic β := λ t₁ t₂ s, join (for (t₁ s) (λ ⟨a, new_s⟩, t₂ a new_s)) @@ -36,17 +33,13 @@ protected meta def failure {α} : lazy_tactic α := λ s, nil meta instance : monad lazy_tactic := -{ ret := @lazy_tactic.return, - bind := @lazy_tactic.bind, - map := @lazy_tactic.map } +{ pure := @lazy_tactic.return, + bind := @lazy_tactic.bind } meta instance : alternative lazy_tactic := -{ map := @lazy_tactic.map, - pure := @lazy_tactic.return, - seq := @fapp _ _, +{ lazy_tactic.monad with failure := @lazy_tactic.failure, - orelse := @lazy_tactic.orelse -} + orelse := @lazy_tactic.orelse } meta def choose {α} (xs : list α) : lazy_tactic α := λ s, of_list $ xs^.for (λ a, (a, s)) diff --git a/tests/lean/type_error_at_eval_expr.lean.expected.out b/tests/lean/type_error_at_eval_expr.lean.expected.out index 1cc3d25a56..5f17e591af 100644 --- a/tests/lean/type_error_at_eval_expr.lean.expected.out +++ b/tests/lean/type_error_at_eval_expr.lean.expected.out @@ -1,6 +1,6 @@ type_error_at_eval_expr.lean:3:0: error: eval_expr failed due to type error nested exception message: -type mismatch at definition '_eval_expr.16.423', has type +type mismatch at definition '_eval_expr.16.436', has type list ℕ but is expected to have type ℕ