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

refactor(library/init/io): implement io monad using estate monad

Browse source
This commit is contained in:
Leonardo de Moura 2019-03-16 09:17:24 -07:00
parent 62284c7f39
commit 6d0ec3a8c9
42 changed files with 2727 additions and 3190 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
library/init/control/estate.lean
View file

@ -52,6 +52,11 @@ namespace estate
variables {ε σ α β : Type u}
instance [inhabited ε] : inhabited (estate ε σ α) :=
⟨λ r, match r with
| ⟨result.ok _ s, _⟩ := result.error (default ε) s
| ⟨result.error _ _, h⟩ := unreachable_error h⟩
@[inline] protected def pure (a : α) : estate ε σ α :=
λ r, match r with
| ⟨result.ok _ s, _⟩ := result.ok a s
@ -97,9 +102,9 @@ variables {ε σ α β : Type u}
| ok := ok)
| ok := ok
@[inline] def adapt_except {ε' : Type u} [has_lift_t ε' ε] (f : ε → ε') (x : estate ε σ α) : estate ε' σ α :=
@[inline] def adapt_except {ε' : Type u} [has_lift ε ε'] (x : estate ε σ α) : estate ε' σ α :=
λ r, match x r with
| result.error e s := result.error (f e) s
| result.error e s := result.error (lift e) s
| result.ok a s := result.ok a s
@[inline] protected def bind (x : estate ε σ α) (f : α → estate ε σ β) : estate ε σ β :=

131
library/init/io.lean
View file

@ -4,59 +4,51 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luke Nelson, Jared Roesch, Leonardo de Moura, Sebastian Ullrich
-/
prelude
import init.control.state init.control.except init.data.string.basic init.fix
import init.control.estate init.data.string.basic init.fix
/-- Like https://hackage.haskell.org/package/ghc-prim-0.5.2.0/docs/GHC-Prim.html#t:RealWorld.
Makes sure we never reorder `io` operations. -/
constant io.real_world : Type := unit
-- TODO: make opaque
@[irreducible, derive monad]
def io : Type → Type := state io.real_world
@[derive monad]
def eio (ε : Type) : Type → Type := estate ε io.real_world
instance {ε : Type} {α : Type} [inhabited ε] : inhabited (eio ε α) :=
infer_instance_as (inhabited (estate ε io.real_world α))
/-
In the future, we may want to give more concrete data
like in https://doc.rust-lang.org/std/io/enum.ErrorKind.html
-/
@[derive has_to_string inhabited]
def io.error := string
abbrev io : Type → Type := eio io.error
@[extern "lean_io_unsafe"]
constant unsafe_io {α : Type} [inhabited α] (fn : io α) : α := default α
constant unsafe_io {α : Type} (fn : io α) : option α := default (option α)
@[extern 4 "lean_io_timeit"]
constant timeit {α : Type} (msg : @& string) (fn : io α) : io α := fn
constant timeit {α : Type} (msg : @& string) (fn : io α) : io α := default (io α)
@[extern 4 "lean_io_allocprof"]
constant allocprof {α : Type} (msg : @& string) (fn : io α) : io α := fn
constant allocprof {α : Type} (msg : @& string) (fn : io α) : io α := default (io α)
abbrev monad_io (m : Type → Type) := has_monad_lift_t io m
-- TODO: make opaque
-- In the future, we may want to give more concrete data
-- like in https://doc.rust-lang.org/std/io/enum.ErrorKind.html
@[irreducible, derive has_to_string]
def io.error := string
section
local attribute [reducible] io.error
instance : inhabited io.error :=
⟨""⟩
end
-- The `io` primitives can also be used with [monad_except string m]
-- via this error conversion
/- The `io` primitives can also be used with [monad_except string m]
via this error conversion -/
instance : has_lift io.error string :=
⟨to_string⟩
/-- 'io with errors'. A useful default monad stack to use for operations
in the `io` namespace if there is no need for additional layers or
a more specific error type than `io.error`. -/
abbrev eio := except_t io.error io
namespace io
section
local attribute [reducible] io
def lazy_pure {α : Type} (fn : unit → α) : io α :=
λ w, (fn (), w)
end
pure (fn ())
inductive fs.mode
| read | write | read_write | append
constant fs.handle : Type := unit
namespace prim
@ -69,59 +61,39 @@ def iterate_aux {α β : Type} (f : α → io (sum α β)) : (α → io β) →
| sum.inl a := rec a
| sum.inr b := pure b
instance io_inhabited {β : Type} [inhabited β] : inhabited (io β) :=
⟨pure (default β)⟩
@[specialize] def iterate {α β : Type} [inhabited β] (a : α) (f : α → io (sum α β)) : io β :=
fix (iterate_aux f) a
instance {ε α : Type} [inhabited ε] : inhabited (except ε α) :=
⟨except.error (default ε)⟩
@[specialize] def iterate_eio {ε α β : Type} [inhabited ε] (a : α) (f : α → except_t ε io (sum α β)) : except_t ε io β :=
iterate a $ λ r, do
r ← (f r).run,
match r with
| except.ok (sum.inl r) := pure (sum.inl r)
| except.ok (sum.inr r) := pure (sum.inr (except.ok r))
| except.error e := pure (sum.inr (except.error e))
section
local attribute [reducible] io
def eio_inh {α : Type} : eio α :=
λ s, (except.error (default io.error), s)
end
@[extern 2 "lean_io_prim_put_str"]
constant put_str (s: @& string) : eio unit := eio_inh
constant put_str (s: @& string) : io unit := default (io unit)
@[extern 1 "lean_io_prim_get_line"]
constant get_line : eio string := eio_inh
constant get_line : io string := default (io string)
@[extern 4 "lean_io_prim_handle_mk"]
constant handle.mk (s : @& string) (m : mode) (bin : bool := ff) : eio handle := eio_inh
constant handle.mk (s : @& string) (m : mode) (bin : bool := ff) : io handle := default (io handle)
@[extern 2 "lean_io_prim_handle_is_eof"]
constant handle.is_eof (h : @& handle) : eio bool := eio_inh
constant handle.is_eof (h : @& handle) : io bool := default (io bool)
@[extern 2 "lean_io_prim_handle_flush"]
constant handle.flush (h : @& handle) : eio unit := eio_inh
constant handle.flush (h : @& handle) : io unit := default (io unit)
@[extern 2 "lean_io_prim_handle_close"]
constant handle.close (h : @& handle) : eio unit := eio_inh
constant handle.close (h : @& handle) : io unit := default (io unit)
-- TODO: replace `string` with byte buffer
-- constant handle.read : handle → nat → eio string
-- constant handle.write : handle → string → eio unit
@[extern 2 "lean_io_prim_handle_get_line"]
constant handle.get_line (h : @& handle) : eio string := eio_inh
constant handle.get_line (h : @& handle) : io string := default (io string)
@[inline] def lift_eio {m : Type → Type} {ε α : Type} [monad_io m] [monad_except ε m] [has_lift_t io.error ε] [monad m]
(x : eio α) : m α :=
do e : except io.error α ← monad_lift (except_t.run x), -- uses [monad_io m] instance
monad_except.lift_except e -- uses [monad_except ε m] [has_lift_t io.error ε] instances
@[inline] def lift_io {m : Type → Type} {α : Type} [monad_io m] (x : io α) : m α :=
monad_lift x
end prim
section
variables {m : Type → Type} {ε : Type} [monad_io m] [monad_except ε m] [has_lift_t io.error ε] [monad m]
variables {m : Type → Type} [monad m] [monad_io m]
private def put_str : string → m unit :=
prim.lift_eio ∘ prim.put_str
prim.lift_io ∘ prim.put_str
def print {α} [has_to_string α] (s : α) : m unit :=
put_str ∘ to_string $ s
@ -131,15 +103,15 @@ print s *> put_str "\n"
end
namespace fs
variables {m : Type → Type} {ε : Type} [monad_io m] [monad_except ε m] [has_lift_t io.error ε] [monad m]
variables {m : Type → Type} [monad m] [monad_io m]
def handle.mk (s : string) (mode : mode) (bin : bool := ff) : m handle := prim.lift_eio (prim.handle.mk s mode bin)
def handle.is_eof : handle → m bool := prim.lift_eio ∘ prim.handle.is_eof
def handle.flush : handle → m unit := prim.lift_eio ∘ prim.handle.flush
def handle.close : handle → m unit := prim.lift_eio ∘ prim.handle.flush
def handle.mk (s : string) (mode : mode) (bin : bool := ff) : m handle := prim.lift_io (prim.handle.mk s mode bin)
def handle.is_eof : handle → m bool := prim.lift_io ∘ prim.handle.is_eof
def handle.flush : handle → m unit := prim.lift_io ∘ prim.handle.flush
def handle.close : handle → m unit := prim.lift_io ∘ prim.handle.flush
-- def handle.read (h : handle) (bytes : nat) : m string := prim.lift_eio (prim.handle.read h bytes)
-- def handle.write (h : handle) (s : string) : m unit := prim.lift_eio (prim.handle.write h s)
def handle.get_line : handle → m string := prim.lift_eio ∘ prim.handle.get_line
def handle.get_line : handle → m string := prim.lift_io ∘ prim.handle.get_line
/-
def get_char (h : handle) : m char :=
@ -158,7 +130,7 @@ do b ← h.read 1,
-- h.put_str s *> h.put_str "\n"
def handle.read_to_end (h : handle) : m string :=
prim.lift_eio $ prim.iterate_eio "" $ λ r, do
prim.lift_io $ prim.iterate "" $ λ r, do
done ← h.is_eof,
if done
then pure (sum.inr r) -- stop
@ -224,18 +196,12 @@ do child ← io.proc.spawn { stdout := io.process.stdio.piped, ..args },
universe u
@[inline] def from_eio (x : eio unit) : io unit :=
x.run *> pure ()
def io.println' (x : string) : io unit :=
from_eio $ io.println x
/-- Typeclass used for presenting the output of an `#eval` command. -/
class has_eval (α : Type u) :=
(eval : α → io unit)
instance has_repr.has_eval {α : Type u} [has_repr α] : has_eval α :=
⟨λ a, io.println' (repr a)⟩
⟨λ a, io.println (repr a)⟩
instance io.has_eval {α : Type} [has_eval α] : has_eval (io α) :=
⟨λ x, do a ← x, has_eval.eval a⟩
@ -243,18 +209,3 @@ instance io.has_eval {α : Type} [has_eval α] : has_eval (io α) :=
-- special case: do not print `()`
instance io_unit.has_eval : has_eval (io unit) :=
⟨λ x, x⟩
instance eio.has_eval {ε α : Type} [has_to_string ε] [has_eval α] : has_eval (except_t ε io α) :=
⟨λ x, do
e : except ε α ← x.run,
match e with
| except.ok a := has_eval.eval a
| except.error e := io.println' ("Error: " ++ to_string e)⟩
-- special case: do not print `()`
instance eio_unit.has_eval {ε : Type} [has_to_string ε] : has_eval (except_t ε io unit) :=
⟨λ x, do
e : except ε unit ← monad_lift $ x.run,
match e with
| except.ok _ := pure ()
| except.error e := io.println' ("Error: " ++ to_string e)⟩

8
library/init/lean/frontend.lean
View file

@ -38,7 +38,7 @@ def run_frontend (filename input : string) (print_msg : message → except_t str
let opts := options.mk.set_bool `trace.as_messages tt,
let elab_st := elaborator.mk_state elab_cfg env opts,
let add_output (out : syntax) outs := if collect_outputs then out::outs else [],
io.prim.iterate_eio (p_snap, elab_st, parser_cfg, expander_cfg, ([] : list syntax)) $ λ ⟨p_snap, elab_st, parser_cfg, expander_cfg, outs⟩, do {
io.prim.iterate (p_snap, elab_st, parser_cfg, expander_cfg, ([] : list syntax)) $ λ ⟨p_snap, elab_st, parser_cfg, expander_cfg, outs⟩, do {
let pos := parser_cfg.file_map.to_position p_snap.it.offset,
r ← monad_lift $ profileit_pure "parsing" pos $ λ _, parse_command parser_cfg p_snap,
match r with
@ -46,7 +46,7 @@ def run_frontend (filename input : string) (print_msg : message → except_t str
-- fatal error (should never happen?)
print_msg msg,
msgs.to_list.mfor print_msg,
pure $ sum.inr ((add_output cmd outs).reverse, elab_st.env)
pure $ sum.inr (except.ok ((add_output cmd outs).reverse, elab_st.env))
}
| (cmd, except.ok (p_snap, msgs)) := do {
msgs.to_list.mfor print_msg,
@ -61,7 +61,7 @@ def run_frontend (filename input : string) (print_msg : message → except_t str
pos := ⟨1, 0⟩,
text := "parser cache hit rate: " ++ to_string out.cache.hit ++ "/" ++
to_string (out.cache.hit + out.cache.miss)},-/
pure $ sum.inr ((add_output cmd outs).reverse, elab_st.env)
pure $ sum.inr (except.ok ((add_output cmd outs).reverse, elab_st.env))
else
pure (sum.inl (p_snap, elab_st, elab_st.parser_cfg, elab_st.expander_cfg, add_output cmd outs))
}
@ -69,10 +69,8 @@ def run_frontend (filename input : string) (print_msg : message → except_t str
}
}
@[export lean_process_file]
def process_file (f s : string) (json : bool) : state_t environment (except_t unit io) unit := do
--let s := (s.mk_iterator.nextn 10000).prev_to_string,
let print_msg : message → except_t string io unit := λ msg,
if json then
io.println $ "{\"file_name\": \"<stdin>\", \"pos_line\": " ++ to_string msg.pos.line ++

67
src/boot/init/control/estate.cpp generated
View file

@ -24,6 +24,8 @@ obj* l_estate_has__orelse(obj*, obj*);
obj* l_estate_result_repr___boxed(obj*, obj*, obj*);
obj* l_estate_monad___closed__1;
obj* l_estate_monad___boxed(obj*, obj*);
obj* l_estate_inhabited(obj*, obj*, obj*);
obj* l_estate_inhabited___boxed(obj*, obj*, obj*);
obj* l_estate_throw(obj*, obj*, obj*);
obj* l_estate_orelse(obj*, obj*, obj*);
obj* l_estate_modify___rarg(obj*, obj*);
@ -44,13 +46,14 @@ obj* l_estate_orelse_x_27___rarg___boxed(obj*, obj*, obj*, obj*);
obj* l_estate_result_to__string___main(obj*, obj*, obj*);
obj* l_estate_orelse_x_27___boxed(obj*, obj*, obj*);
obj* l_estate_map___boxed(obj*, obj*, obj*, obj*);
obj* l_estate_adapt__except___boxed(obj*, obj*, obj*, obj*, obj*);
obj* l_estate_adapt__except___boxed(obj*, obj*, obj*, obj*);
obj* l_estate_result_repr___main___rarg(obj*, obj*, obj*);
obj* l_estate_inhabited___rarg(obj*, obj*);
obj* l_estate_result_to__string(obj*, obj*, obj*);
obj* l_estate_result_to__string___main___rarg___closed__1;
obj* l_estate_has__to__string___boxed(obj*, obj*, obj*);
obj* l_estate_monad___lambda__1___boxed(obj*, obj*, obj*, obj*, obj*);
obj* l_estate_adapt__except(obj*, obj*, obj*, obj*, obj*);
obj* l_estate_adapt__except(obj*, obj*, obj*, obj*);
obj* l_estate_get___boxed(obj*, obj*);
obj* l_estate_result_repr(obj*, obj*, obj*);
obj* l_estate_unreachable__error___boxed(obj*, obj*, obj*, obj*, obj*, obj*, obj*);
@ -381,6 +384,49 @@ lean::dec(x_2);
return x_3;
}
}
obj* l_estate_inhabited___rarg(obj* x_0, obj* x_1) {
_start:
{
obj* x_2; obj* x_4; obj* x_5;
x_2 = lean::cnstr_get(x_1, 1);
if (lean::is_exclusive(x_1)) {
lean::cnstr_release(x_1, 0);
x_4 = x_1;
} else {
lean::inc(x_2);
lean::dec(x_1);
x_4 = lean::box(0);
}
if (lean::is_scalar(x_4)) {
x_5 = lean::alloc_cnstr(1, 2, 0);
} else {
x_5 = x_4;
lean::cnstr_set_tag(x_4, 1);
}
lean::cnstr_set(x_5, 0, x_0);
lean::cnstr_set(x_5, 1, x_2);
return x_5;
}
}
obj* l_estate_inhabited(obj* x_0, obj* x_1, obj* x_2) {
_start:
{
obj* x_3;
x_3 = lean::alloc_closure(reinterpret_cast<void*>(l_estate_inhabited___rarg), 2, 0);
return x_3;
}
}
obj* l_estate_inhabited___boxed(obj* x_0, obj* x_1, obj* x_2) {
_start:
{
obj* x_3;
x_3 = l_estate_inhabited(x_0, x_1, x_2);
lean::dec(x_0);
lean::dec(x_1);
lean::dec(x_2);
return x_3;
}
}
obj* l_estate_pure___rarg(obj* x_0, obj* x_1) {
_start:
{
@ -872,25 +918,24 @@ return x_17;
}
}
}
obj* l_estate_adapt__except(obj* x_0, obj* x_1, obj* x_2, obj* x_3, obj* x_4) {
obj* l_estate_adapt__except(obj* x_0, obj* x_1, obj* x_2, obj* x_3) {
_start:
{
obj* x_5;
x_5 = lean::alloc_closure(reinterpret_cast<void*>(l_estate_adapt__except___rarg), 3, 0);
return x_5;
obj* x_4;
x_4 = lean::alloc_closure(reinterpret_cast<void*>(l_estate_adapt__except___rarg), 3, 0);
return x_4;
}
}
obj* l_estate_adapt__except___boxed(obj* x_0, obj* x_1, obj* x_2, obj* x_3, obj* x_4) {
obj* l_estate_adapt__except___boxed(obj* x_0, obj* x_1, obj* x_2, obj* x_3) {
_start:
{
obj* x_5;
x_5 = l_estate_adapt__except(x_0, x_1, x_2, x_3, x_4);
obj* x_4;
x_4 = l_estate_adapt__except(x_0, x_1, x_2, x_3);
lean::dec(x_0);
lean::dec(x_1);
lean::dec(x_2);
lean::dec(x_3);
lean::dec(x_4);
return x_5;
return x_4;
}
}
obj* l_estate_bind___rarg(obj* x_0, obj* x_1, obj* x_2) {

2023
src/boot/init/io.cpp generated
View file

File diff suppressed because it is too large Load diff

3472
src/boot/init/lean/frontend.cpp generated
View file

File diff suppressed because it is too large Load diff

18
src/library/compiler/emit_cpp.cpp
View file

@ -1143,14 +1143,20 @@ static void emit_main_fn(std::ostream & out, environment const & env, module_nam
out << " obj* n = lean::alloc_cnstr(1,2,0); lean::cnstr_set(n, 0, lean::mk_string(argv[i])); lean::cnstr_set(n, 1, in);\n";
out << " in = n;\n";
out << "}\n";
out << "obj * r = " << g_lean_main << "(in, lean::box(0));\n";
out << "obj * r = " << g_lean_main << "(in, lean::io_mk_world());\n";
} else {
out << "obj * r = " << g_lean_main << "(lean::box(0));\n";
out << "obj * r = " << g_lean_main << "(lean::io_mk_world());\n";
}
out << "int ret = lean::unbox(lean::cnstr_get(r, 0));\n";
out << "lean::dec(r);\n";
out << "return ret;\n";
out << "}\n";
out <<
"if (io_is_result_ok(r)) {\n"
" int ret = lean::unbox(io_get_result(r));\n"
" lean::dec_ref(r);\n"
" return ret;\n"
"} else {\n"
" lean::dec_ref(r);\n"
" return 1;\n"
"}\n"
"}\n";
}
void emit_cpp(std::ostream & out, environment const & env, module_name const & m, list<module_name> const & deps) {

59
src/runtime/io.cpp
View file

@ -12,24 +12,33 @@ Author: Leonardo de Moura
namespace lean {
static obj_res const REAL_WORLD = box(0);
obj_res mk_io_result(obj_arg r) {
object * res = alloc_cnstr(0, 2, 0);
cnstr_set(res, 0, r);
cnstr_set(res, 1, REAL_WORLD);
return res;
obj_res set_io_result(obj_arg r, obj_arg a) {
if (is_exclusive(r)) {
cnstr_set(r, 0, a);
return r;
} else {
dec_ref(r);
object * new_r = alloc_cnstr(0, 2, 0);
cnstr_set(new_r, 0, a);
cnstr_set(new_r, 1, REAL_WORLD);
return new_r;
}
}
static obj_res option_of_io_result(obj_arg r) {
if (io_is_result_ok(r)) {
object * o = alloc_cnstr(1, 1, 0);
cnstr_set(o, 0, io_get_result(r));
dec(r);
return o;
} else {
dec(r);
return box(0);
}
}
/* `(r : α) → (except ε α × real_world)` */
obj_res mk_ioe_result(obj_arg r) {
object * res = alloc_cnstr(1, 1, 0);
cnstr_set(res, 0, r);
return mk_io_result(res);
}
extern "C" obj_res lean_io_prim_put_str(b_obj_arg s, obj_arg /* w */) {
// TODO(Leo): this is a temporary hack for testing
std::cout << string_to_std(s);
return mk_ioe_result(box(0));
extern "C" obj_res lean_io_prim_put_str(b_obj_arg s, obj_arg r) {
std::cout << string_to_std(s); // TODO(Leo): use out handle
return set_io_result(r, box(0));
}
extern "C" obj_res lean_io_prim_get_line(obj_arg /* w */) {
@ -67,18 +76,16 @@ extern "C" obj_res lean_io_prim_handle_get_line(b_obj_arg /* h */, obj_arg /* w
lean_unreachable();
}
/* constant unsafe_io {α : Type} [inhabited α] (fn : io α) : α */
extern "C" obj_res lean_io_unsafe(obj_arg, obj_arg, obj_arg fn) {
object * r = apply_1(fn, REAL_WORLD);
object * a = cnstr_get(r, 0);
inc(a); dec(r);
return a;
/* constant unsafe_io {α : Type} (fn : io α) : option α */
extern "C" obj_res lean_io_unsafe(obj_arg, obj_arg fn) {
object * r = io_mk_world();
return option_of_io_result(apply_1(fn, r));
}
/* timeit {α : Type} (msg : @& string) (fn : io α) : io α */
extern "C" obj_res lean_io_timeit(obj_arg, b_obj_arg msg, obj_arg fn, obj_arg w) {
extern "C" obj_res lean_io_timeit(obj_arg, b_obj_arg msg, obj_arg fn, obj_arg r) {
auto start = std::chrono::steady_clock::now();
object * r = apply_1(fn, w);
r = apply_1(fn, r);
auto end = std::chrono::steady_clock::now();
auto diff = std::chrono::duration<double>(end - start);
std::ostream & out = std::cerr; // TODO(Leo): replace?
@ -92,9 +99,9 @@ extern "C" obj_res lean_io_timeit(obj_arg, b_obj_arg msg, obj_arg fn, obj_arg w)
}
/* allocprof {α : Type} (msg : string) (fn : io α) : io α */
extern "C" obj_res lean_io_allocprof(obj_arg, b_obj_arg msg, obj_arg fn, obj_arg w) {
extern "C" obj_res lean_io_allocprof(obj_arg, b_obj_arg msg, obj_arg fn, obj_arg r) {
std::ostream & out = std::cerr; // TODO(Leo): replace?
allocprof prof(out, string_cstr(msg));
return apply_1(fn, w);
return apply_1(fn, r);
}
}

12
src/runtime/object.h
View file

@ -1437,6 +1437,18 @@ object * array_push(obj_arg a, obj_arg v);
object * dbg_trace(obj_arg s, obj_arg fn);
object * dbg_sleep(uint32 ms, obj_arg fn);
// =======================================
// IO helper functions
inline obj_res io_mk_world() {
object * r = alloc_cnstr(0, 2, 0);
cnstr_set(r, 0, box(0));
cnstr_set(r, 1, box(0));
return r;
}
inline bool io_is_result_ok(b_obj_arg r) { return cnstr_tag(r) == 0; }
inline bool io_is_result_error(b_obj_arg r) { return cnstr_tag(r) == 1; }
inline b_obj_res io_get_result(b_obj_arg r) { lean_assert(io_is_result_ok(r)); return cnstr_get(r, 0); }
// =======================================
// Module initialization/finalization
void initialize_object();

2
tests/compiler/append.lean
View file

@ -1,5 +1,5 @@
def main (xs : list string) : io uint32 :=
let ys1 := list.repeat 1 1000000 in
let ys2 := list.repeat 2 1000000 in
io.println' (to_string (ys1 ++ ys2).length) *>
io.println (to_string (ys1 ++ ys2).length) *>
pure 0

16
tests/compiler/array_test.lean
View file

@ -8,17 +8,17 @@ a
def main : io uint32 :=
do
let a : array nat := array.nil,
io.println' (to_string a),
io.println' (to_string a.sz),
io.println (to_string a),
io.println (to_string a.sz),
let a := foo a,
io.println' (to_string a),
io.println (to_string a),
let a := a.map (+10),
io.println' (to_string a),
io.println' (to_string a.sz),
io.println (to_string a),
io.println (to_string a.sz),
let a1 := a.pop,
let a2 := a.push 100,
io.println' (to_string a1),
io.println' (to_string a2),
io.println (to_string a1),
io.println (to_string a2),
let a2 := a.pop,
io.println' (to_string a2),
io.println a2,
pure 0

4
tests/compiler/expr.lean
View file

@ -3,6 +3,6 @@ open lean
def main : io uint32 :=
let e := expr.app (expr.const `f []) (expr.const `a []) in
io.println' e.dbg_to_string *>
io.println' ("hash: " ++ to_string e.hash) *>
io.println e.dbg_to_string *>
io.println ("hash: " ++ to_string e.hash) *>
pure 0

2
tests/compiler/map_big.lean
View file

@ -4,5 +4,5 @@ xs.map (λ x, x :: ys)
def main : io uint32 :=
let n := 100000 in
io.println' (to_string (f2 n (list.repeat 0 n)).length) *>
io.println (to_string (f2 n (list.repeat 0 n)).length) *>
pure 0

18
tests/compiler/str.lean
View file

@ -2,20 +2,20 @@ def show_chars : nat → string → string.utf8_pos → io unit
| 0 _ _ := pure ()
| (n+1) s idx :=
unless (s.utf8_at_end idx) $
io.println' (">> " ++ to_string (s.utf8_get idx)) *>
io.println (">> " ++ to_string (s.utf8_get idx)) *>
show_chars n s (s.utf8_next idx)
def main : io uint32 :=
let s₁ := "hello α_world_β" in
let b := string.utf8_begin in
let e := s₁.utf8_byte_size in
io.println' (s₁.extract b e) *>
io.println' (s₁.extract (b+2) e) *>
io.println' (s₁.extract (b+2) (e-1)) *>
io.println' (s₁.extract (b+2) (e-2)) *>
io.println' (s₁.extract (b+7) e) *>
io.println' (s₁.extract (b+8) e) *>
io.println' (to_string e) *>
io.println' (repr " aaa ".trim) *>
io.println (s₁.extract b e) *>
io.println (s₁.extract (b+2) e) *>
io.println (s₁.extract (b+2) (e-1)) *>
io.println (s₁.extract (b+2) (e-2)) *>
io.println (s₁.extract (b+7) e) *>
io.println (s₁.extract (b+8) e) *>
io.println (to_string e) *>
io.println (repr " aaa ".trim) *>
show_chars s₁.utf8_byte_size.to_nat s₁ 0 *>
pure 0

2
tests/compiler/t1.lean
View file

@ -1,3 +1,3 @@
def main (xs : list string) : io uint32 :=
io.println' "hello world" *>
io.println "hello world" *>
pure 0

2
tests/compiler/t2.lean
View file

@ -86,7 +86,7 @@ nest_aux n f n e
def deriv (i : nat) (f : Expr) : io Expr :=
do
let d := d "x" f,
io.println' (to_string (i+1) ++ " count: " ++ (to_string $ count d)),
io.println (to_string (i+1) ++ " count: " ++ (to_string $ count d)),
pure d
def main (xs : list string) : io uint32 :=

2
tests/compiler/thunk.lean
View file

@ -6,5 +6,5 @@ def test (t : thunk nat) (n : nat) : nat :=
n.repeat (λ i r, t.get + r) 0
def main (xs : list string) : io uint32 :=
io.println' (to_string (test (compute 1) 100000)) *>
io.println (to_string (test (compute 1) 100000)) *>
pure 0

10
tests/compiler/uint_fold.lean
View file

@ -17,9 +17,9 @@ let x : uint8 := 100 in
x + x + x
def main : io uint32 :=
io.println' (to_string (f 10 20)) *>
io.println' (to_string (f 0 0)) *>
io.println' (to_string (g 3 5)) *>
io.println' (to_string (g 0 6)) *>
io.println' (to_string foo) *>
io.println (to_string (f 10 20)) *>
io.println (to_string (f 0 0)) *>
io.println (to_string (g 3 5)) *>
io.println (to_string (g 0 6)) *>
io.println (to_string foo) *>
pure 0

2
tests/playground/arith_eval_nat.lean
View file

@ -15,5 +15,5 @@ def eval : Expr → nat
| (Add l r) := eval l + eval r
def main : io uint32 :=
io.println' (to_string $ eval (mk_expr 26 1)) *>
io.println (to_string $ eval (mk_expr 26 1)) *>
pure 0

2
tests/playground/arith_eval_uint32.lean
View file

@ -18,5 +18,5 @@ def eval : Expr → uint32
| (Add l r) := eval l + eval r
def main : io uint32 :=
io.println' (to_string $ eval (mk_expr 26 1)) *>
io.println (to_string $ eval (mk_expr 26 1)) *>
pure 0

2
tests/playground/binarytrees.lean
View file

@ -19,7 +19,7 @@ def check : Tree → uint32
def minN := 4
def out (s) (n : nat) (t : uint32) := io.println' (s ++ " of depth " ++ to_string n ++ "\t check: " ++ to_string t)
def out (s) (n : nat) (t : uint32) := io.println (s ++ " of depth " ++ to_string n ++ "\t check: " ++ to_string t)
-- allocate and check lots of trees
def sumT : uint32 -> uint32 -> uint32 -> uint32

2
tests/playground/deriv.lean
View file

@ -86,7 +86,7 @@ nest_aux n f n e
def deriv (i : nat) (f : Expr) : io Expr :=
do
let d := d "x" f,
io.println' (to_string (i+1) ++ " count: " ++ (to_string $ count d)),
io.println (to_string (i+1) ++ " count: " ++ (to_string $ count d)),
pure d
def main (xs : list string) : io uint32 :=

2
tests/playground/expr_const_folding.lean
View file

@ -69,5 +69,5 @@ def main : io uint32 :=
let e := (mk_expr 23 1) in
let v₁ := eval e in
let v₂ := eval (const_folding (reassoc e)) in
io.println' (to_string v₁ ++ " " ++ to_string v₂) *>
io.println (to_string v₁ ++ " " ++ to_string v₂) *>
pure 0

2
tests/playground/fix.lean
View file

@ -4,5 +4,5 @@ def foo (rec : nat → nat → nat) : nat → nat → nat
def main (xs : list string) : io uint32 :=
let v := fix_2 foo (xs.head.to_nat) 10 in
io.println' (to_string v) *>
io.println (to_string v) *>
pure 0

2
tests/playground/fix_1.lean
View file

@ -4,5 +4,5 @@ def foo (rec : nat → nat → nat) : nat → nat → nat
def main (xs : list string) : io uint32 :=
let v := fix_1 foo (xs.head.to_nat) 10 in
io.println' (to_string v) *>
io.println (to_string v) *>
pure 0

2
tests/playground/fix_with_tuples.lean
View file

@ -4,5 +4,5 @@ def foo (rec : nat × nat → nat) : nat × nat → nat
def main (xs : list string) : io uint32 :=
let v := fix foo (xs.head.to_nat, 10) in
io.println' (to_string v) *>
io.println (to_string v) *>
pure 0

4
tests/playground/flat_parser.lean
View file

@ -325,10 +325,10 @@ many1' (str "--" *> take_until (λ c, c = '\n') *> any *> pure ())
end
@[noinline] def test_flat_p (s : string) : io unit :=
io.println' (lean.flat_parser.test_parser flat_p s)
io.println (lean.flat_parser.test_parser flat_p s)
@[noinline] def test_parsec_p (s : string) : io unit :=
io.println' (test_parsec parsec_p s)
io.println (test_parsec parsec_p s)
def prof {α : Type} (msg : string) (p : io α) : io α :=
let msg₁ := "Time for '" ++ msg ++ "':" in

4
tests/playground/gen.lean
View file

@ -1,5 +1,5 @@
def main (xs : list string) : io uint32 :=
let n := xs.head.to_nat in
io.println' "prelude\ninductive bool : Type\n| ff : bool\n| tt : bool\n\n" *>
nat.mrepeat n (λ i, io.println' ("theorem x" ++ to_string i ++ " : bool := bool.tt")) *>
io.println "prelude\ninductive bool : Type\n| ff : bool\n| tt : bool\n\n" *>
nat.mrepeat n (λ i, io.println ("theorem x" ++ to_string i ++ " : bool := bool.tt")) *>
pure 0

2
tests/playground/perf.lean
View file

@ -9,7 +9,7 @@ def rep (n : nat) : nat :=
n.repeat (λ i r, h (g i n)) 0
def act (n : nat) : io unit :=
io.println' (to_string (rep n))
io.println (to_string (rep n))
def main : io uint32 :=
act 5000 *> pure 0

2
tests/playground/rbmap.lean
View file

@ -70,5 +70,5 @@ mk_map_aux n Leaf
def main (xs : list string) : io uint32 :=
let m := mk_map xs.head.to_nat in
let v := fold (λ (k : nat) (v : bool) (r : nat), if v then r + 1 else r) m 0 in
io.println' (to_string v) *>
io.println (to_string v) *>
pure 0

2
tests/playground/rbmap.library.lean
View file

@ -10,5 +10,5 @@ mk_map_aux n (mk_rbmap nat bool (<))
def main (xs : list string) : io uint32 :=
let m := mk_map xs.head.to_nat in
let v := rbmap.fold (λ (k : nat) (v : bool) (r : nat), if v then r + 1 else r) m 0 in
io.println' (to_string v) *>
io.println (to_string v) *>
pure 0

2
tests/playground/rbmap2.lean
View file

@ -229,5 +229,5 @@ mk_map_aux n 0 (tst.mk_rbmap nat bool (<))
def main (xs : list string) : io uint32 :=
let m := mk_map xs.head.to_nat in
let v := tst.rbmap.fold (λ (k : nat) (v : bool) (r : nat), if v then r + 1 else r) m 0 in
io.println' (to_string v) *>
io.println (to_string v) *>
pure 0

2
tests/playground/rbmap3.lean
View file

@ -260,5 +260,5 @@ mk_map_aux n (mk_rbmap nat bool (<))
def main (xs : list string) : io uint32 :=
let m := mk_map xs.head.to_nat in
let v := rbmap.fold (λ (k : nat) (v : bool) (r : nat), if v then r + 1 else r) m 0 in
io.println' (to_string v) *>
io.println (to_string v) *>
pure 0

2
tests/playground/task_test.lean
View file

@ -16,5 +16,5 @@ def main (xs : list string) : io uint32 :=
let t1 := task.mk $ (λ _, f1 xs.head.to_nat) in
let t2 := task.mk $ (λ _, f2 xs.head.to_nat) in
dbg_sleep 1000 $ λ _,
io.println' (to_string t1.get ++ " " ++ to_string t2.get) *>
io.println (to_string t1.get ++ " " ++ to_string t2.get) *>
pure 0

2
tests/playground/task_test2.lean
View file

@ -8,5 +8,5 @@ def main (xs : list string) : io uint32 :=
let ys := (list.repeat 1 xs.head.to_nat) in
let ts : list (task nat) := (list.iota 10).map (λ i, task.mk $ λ _, run1 (i+1) xs.head.to_nat ys) in
let ns : list nat := ts.map task.get in
io.println' (">> " ++ to_string ns) *>
io.println (">> " ++ to_string ns) *>
pure 0

2
tests/playground/task_test3.lean
View file

@ -8,5 +8,5 @@ def main (xs : list string) : io uint32 :=
let ys := (list.repeat 1 xs.head.to_nat) in
let ts : list (task nat) := (list.iota 10).map (λ i, task.mk $ λ _, run1 (i+1) xs.head.to_nat ys) in
let ns : list nat := ts.map task.get in
io.println' (">> " ++ to_string ns) *>
io.println (">> " ++ to_string ns) *>
pure 0

2
tests/playground/task_test4.lean
View file

@ -8,5 +8,5 @@ def main (xs : list string) : io uint32 :=
let ys := (list.repeat 1 xs.head.to_nat) in
let ts : list (task nat) := (list.iota 10).map (λ i, task.mk $ λ _, run1 (i+1) xs.head.to_nat ys) in
let ns : list nat := ts.map task.get in
io.println' (">> " ++ to_string ns) *>
io.println (">> " ++ to_string ns) *>
pure 0

2
tests/playground/tst.lean
View file

@ -4,7 +4,7 @@ xs.foldl (+) 0
def perf (n : nat) : io unit :=
do v ← pure $ tst n,
io.println' ("result " ++ to_string v)
io.println ("result " ++ to_string v)
def main (xs : list string) : io uint32 :=
timeit "tst" (perf xs.head.to_nat) *>

4
tests/playground/uf1.lean
View file

@ -129,5 +129,5 @@ else do
def main (xs : list string) : io uint32 :=
let n := xs.head.to_nat in
match run (test n) with
| (except.ok v, s) := io.println' ("ok " ++ to_string v) *> pure 0
| (except.error e, s) := io.println' ("Error : " ++ e) *> pure 1
| (except.ok v, s) := io.println ("ok " ++ to_string v) *> pure 0
| (except.error e, s) := io.println ("Error : " ++ e) *> pure 1

4
tests/playground/uf1_new.lean
View file

@ -122,5 +122,5 @@ else do
def main (xs : list string) : io uint32 :=
let n := xs.head.to_nat in
match run (test n) with
| (except.ok v, s) := io.println' ("ok " ++ to_string v) *> pure 0
| (except.error e, s) := io.println' ("Error : " ++ e) *> pure 1
| (except.ok v, s) := io.println ("ok " ++ to_string v) *> pure 0
| (except.error e, s) := io.println ("Error : " ++ e) *> pure 1

4
tests/playground/unionfind1.lean
View file

@ -128,5 +128,5 @@ else do
def main (xs : list string) : io uint32 :=
let n := xs.head.to_nat in
match run (test n) with
| (except.ok v, s) := io.println' ("ok " ++ to_string v) *> pure 0
| (except.error e, s) := io.println' ("Error : " ++ e) *> pure 1
| (except.ok v, s) := io.println ("ok " ++ to_string v) *> pure 0
| (except.error e, s) := io.println ("Error : " ++ e) *> pure 1

4
tests/playground/unionfind2.lean
View file

@ -122,5 +122,5 @@ else do
def main (xs : list string) : io uint32 :=
let n := xs.head.to_nat in
match run (test n) with
| (except.ok v, s) := io.println' ("ok " ++ to_string v) *> pure 0
| (except.error e, s) := io.println' ("Error : " ++ e) *> pure 1
| (except.ok v, s) := io.println ("ok " ++ to_string v) *> pure 0
| (except.error e, s) := io.println ("Error : " ++ e) *> pure 1