124 lines
3.4 KiB
Text
124 lines
3.4 KiB
Text
import init.lean.parser.parsec
|
||
import init.control.coroutine
|
||
universes u v w r s
|
||
|
||
set_option trace.compiler.lcnf true
|
||
-- set_option pp.implicit true
|
||
set_option pp.binder_types false
|
||
set_option pp.proofs true
|
||
|
||
def foo (n : nat) : nat :=
|
||
let x := nat.zero in
|
||
let x_1 := nat.succ x in
|
||
let x_2 := nat.succ x_1 in
|
||
let x_3 := nat.succ x_2 in
|
||
let x_4 := nat.succ x_3 in
|
||
let x_5 := nat.succ x_4 in
|
||
let x_6 := nat.succ x_5 in
|
||
let x_7 := nat.succ x in
|
||
let x_8 := nat.succ x_7 in
|
||
let y_1 := x in
|
||
let y_2 := y_1 in
|
||
y_2 + n
|
||
|
||
def cse_tst (n : nat) : nat :=
|
||
let y := nat.succ ((λ x, x) n) in
|
||
let z := nat.succ n in
|
||
y + z
|
||
|
||
def tst1 (n : nat) : nat :=
|
||
let p := (nat.succ n, n) in
|
||
let q := (p, p) in
|
||
prod.cases_on q (λ x y, prod.cases_on x (λ z w, z))
|
||
|
||
def tst2 (n : nat) : nat :=
|
||
let p := (λ x, nat.succ x, nat.zero) in
|
||
let f := λ p : (nat → nat) × nat, p.1 in
|
||
f p n
|
||
|
||
def add' : nat → nat → nat
|
||
| 0 b := nat.succ b
|
||
| (a+1) b := nat.succ (nat.succ (add' a b))
|
||
|
||
namespace lean
|
||
namespace parser
|
||
namespace monad_parsec
|
||
open parsec_t
|
||
|
||
variables {μ : Type}
|
||
variables {m : Type → Type} [monad m] [monad_parsec μ m] [inhabited μ] {α β : Type}
|
||
|
||
open parsec
|
||
|
||
def longest_match' [monad_except (message μ) m] (ps : list (m α)) : m (list α) :=
|
||
do it ← left_over,
|
||
r ← ps.mfoldr (λ p (r : result μ (list α)),
|
||
lookahead $ catch
|
||
(do
|
||
a ← p,
|
||
it ← left_over,
|
||
pure $ match r with
|
||
| result.ok as it' := if it'.offset > it.offset then r
|
||
else if it.offset > it'.offset then result.ok [a] it
|
||
else result.ok (a::as) it
|
||
| _ := result.ok [a] it)
|
||
(λ msg, pure $ match r with
|
||
| result.error msg' _ := if nat.lt msg.it.offset msg'.it.offset then r -- FIXME
|
||
else if nat.lt msg'.it.offset msg.it.offset then result.error msg tt
|
||
else result.error (merge msg msg') tt
|
||
| _ := r))
|
||
((error "longest_match: empty list" : parsec _ _) it),
|
||
lift $ λ _, r
|
||
|
||
end monad_parsec
|
||
end parser
|
||
end lean
|
||
|
||
def aux (i : nat) (h : i > 0) :=
|
||
i
|
||
|
||
def foo2 : nat :=
|
||
@false.rec (λ _, nat) sorry
|
||
|
||
set_option pp.notation false
|
||
|
||
def foo3 (n : nat) : nat :=
|
||
(λ a : nat, a + a + a) (n*n)
|
||
|
||
def boo (a : nat) (l : list nat) : list nat :=
|
||
let f := @list.cons nat in
|
||
f a (f a l)
|
||
|
||
def bla (i : nat) (h : i > 0 ∧ i ≠ 10) : nat :=
|
||
@and.rec _ _ (λ _, nat) (λ h₁ h₂, aux i h₁ + aux i h₁) h
|
||
|
||
def bla' (i : nat) (h : i > 0 ∧ i ≠ 10) : nat :=
|
||
@and.cases_on _ _ (λ _, nat) h (λ h₁ h₂, aux i h₁ + aux i h₁)
|
||
|
||
inductive vec (α : Type u) : nat → Type u
|
||
| nil {} : vec 0
|
||
| cons : Π {n}, α → vec n → vec (nat.succ n)
|
||
|
||
def vec.map {α β σ : Type u} (f : α → β → σ) : Π {n : nat}, vec α n → vec β n → vec σ n
|
||
| _ vec.nil vec.nil := vec.nil
|
||
| _ (vec.cons a as) (vec.cons b bs) := vec.cons (f a b) (vec.map as bs)
|
||
|
||
namespace coroutine
|
||
variables {α : Type u} {δ : Type v} {β γ : Type w}
|
||
|
||
def pipe2 : coroutine α δ β → coroutine δ γ β → coroutine α γ β
|
||
| (mk k₁) (mk k₂) := mk $ λ a,
|
||
match k₁ a, rfl : ∀ (n : _), n = k₁ a → _ with
|
||
| done b, h := done b
|
||
| yielded d k₁', h :=
|
||
match k₂ d with
|
||
| done b := done b
|
||
| yielded r k₂' :=
|
||
-- have direct_subcoroutine k₁' (mk k₁), { apply direct_subcoroutine.mk k₁ a d, rw h },
|
||
yielded r (pipe2 k₁' k₂')
|
||
|
||
end coroutine
|
||
|
||
set_option pp.all true
|
||
set_option pp.binder_types true
|
||
#check @lc_cast
|