From f9afca3fd798278827ba3a55fcdf1b542e608b46 Mon Sep 17 00:00:00 2001 From: butterunderflow Date: Fri, 23 Aug 2024 21:41:23 +0800 Subject: [PATCH 1/2] parsing and typing for assert expression --- lib/clos/lift.ml | 1 + lib/lam/compile.ml | 2 ++ lib/lam/tree.ml | 1 + lib/syntax/lexer.mll | 1 + lib/syntax/parser.mly | 2 ++ lib/syntax/parsetree.ml | 1 + lib/typing/check.ml | 6 ++++++ lib/typing/render.ml | 4 ++++ lib/typing/typedtree.ml | 4 +++- tests/regular/parse_test.ml | 36 ++++++++++++++++++++++++++++++++++++ 10 files changed, 57 insertions(+), 1 deletion(-) diff --git a/lib/clos/lift.ml b/lib/clos/lift.ml index b4ace56..38e9e85 100644 --- a/lib/clos/lift.ml +++ b/lib/clos/lift.ml @@ -87,6 +87,7 @@ let rec lift ?(hint = "temp") (e : L.expr) (vars : string list) : | L.EField (e, name) -> let e', fns = lift e vars ~hint in (C.EField (e', name), fns) + | L.EAssert _ -> failwith "todo" and lift_letrec binds vars = let xs = List.map fst binds in diff --git a/lib/lam/compile.ml b/lib/lam/compile.ml index 330da41..d3f86c9 100644 --- a/lib/lam/compile.ml +++ b/lib/lam/compile.ml @@ -24,6 +24,7 @@ let rec compile_expr (e : T.expr) = | T.EFieldCons (_, _, id, _) -> L.ECons id | T.ECmp (op, e1, e2, _) -> L.ECmp (op, compile_expr e1, compile_expr e2) | T.ESeq (e0, e1, _) -> L.ESeq (compile_expr e0, compile_expr e1) + | T.EAssert (e, _) -> L.EAssert (compile_expr e) and compile_lam (x, e, _) = ([ x ], compile_expr e, ref []) @@ -141,6 +142,7 @@ let rec fva_expr e vars = let fvs_in_binds = fva_letrec binds vars in capture fvs_in_binds xs @ capture (fva_expr e (xs @ vars)) xs | L.EField (e, _) -> fva_expr e vars + | L.EAssert e -> fva_expr e vars and fva_lambda x e vars = let vars = x @ vars in diff --git a/lib/lam/tree.ml b/lib/lam/tree.ml index cd908df..8517769 100644 --- a/lib/lam/tree.ml +++ b/lib/lam/tree.ml @@ -21,6 +21,7 @@ type expr = | EField of expr * string | ECmp of T.cmp_op * expr * expr | ESeq of expr * expr + | EAssert of expr and pattern = | PVar of string diff --git a/lib/syntax/lexer.mll b/lib/syntax/lexer.mll index 181b8d6..248c0ae 100644 --- a/lib/syntax/lexer.mll +++ b/lib/syntax/lexer.mll @@ -59,6 +59,7 @@ rule token = parse | "functor" { FUNCTOR } | "fun" { FUN } | "of" { OF } + | "assert" { ASSERT } | "->" { ARROW } | "=" { EQ } | "<>" { NEQ } diff --git a/lib/syntax/parser.mly b/lib/syntax/parser.mly index b395a25..5f85338 100644 --- a/lib/syntax/parser.mly +++ b/lib/syntax/parser.mly @@ -53,6 +53,7 @@ let mk_type_ref fon t_args = %token LBRACE %token RBRACE %token SEMI +%token ASSERT %nonassoc LET TYPE %nonassoc over_TOP @@ -248,6 +249,7 @@ expr: } | e=bin_expr { e } | e=expr COLON te=type_expr { make_node (EAnn (e, te)) $startpos $endpos } + | ASSERT e=expr %prec over_TOP { make_node (EAssert e) $startpos $endpos } ; bin_expr: diff --git a/lib/syntax/parsetree.ml b/lib/syntax/parsetree.ml index 54ef50d..7199e75 100644 --- a/lib/syntax/parsetree.ml +++ b/lib/syntax/parsetree.ml @@ -60,6 +60,7 @@ and expr_desc = | EFieldCons of mod_expr * string | ECmp of cmp_op * expr * expr | ESeq of expr * expr + | EAssert of expr and pattern = | PVal of constant diff --git a/lib/typing/check.ml b/lib/typing/check.ml index fe3455b..3cbce54 100644 --- a/lib/typing/check.ml +++ b/lib/typing/check.ml @@ -50,6 +50,7 @@ let rec check_expr (e : T.expr) (env : Env.t) : expr = | T.EFieldCons (p, c) -> check_field_cons p c env | T.ECmp (op, e0, e1) -> check_cmp op e0 e1 env | T.ESeq (e0, e1) -> check_seq e0 e1 env + | T.EAssert e -> check_assert e env with | err -> Report.wrap_and_reraise err e.start_loc e.end_loc env @@ -66,6 +67,11 @@ and check_var x env = let t = P.inst bind in EVar (x, t) +and check_assert e env = + let e_typed = check_expr e env in + U.unify I.bool_ty (get_ty e_typed); + EAssert (e_typed, I.unit_ty) + (* pattern will create bindings under context's type *) and check_pattern p te env : pattern * (string * I.ty) list = let check_PCons_aux (cons_ty : I.ty) (p (* payload pattern *) : T.pattern) diff --git a/lib/typing/render.ml b/lib/typing/render.ml index e818c79..692f9df 100644 --- a/lib/typing/render.ml +++ b/lib/typing/render.ml @@ -149,6 +149,10 @@ module MakePP (Config : PPConfig) = struct Fmt.fprintf fmt " ;@\n"; pp_expr fmt e1; Fmt.fprintf fmt "@]" + | EAssert (e, _te) -> + Fmt.fprintf fmt "@[assert "; + pp_expr fmt e; + Fmt.fprintf fmt "@]" and pp_lam fmt (x, e, _te) = Fmt.fprintf fmt "@[fun %s -> @\n" x; diff --git a/lib/typing/typedtree.ml b/lib/typing/typedtree.ml index 45d84af..5b606a0 100644 --- a/lib/typing/typedtree.ml +++ b/lib/typing/typedtree.ml @@ -27,6 +27,7 @@ type expr = * ty | ECmp of T.cmp_op * expr * expr * ty | ESeq of expr * expr * ty + | EAssert of expr * ty and lambda_typed = string * expr * ty @@ -76,7 +77,8 @@ let get_ty = function | ECons (_, _, ty) | EFieldCons (_, _, _, ty) | ECmp (_, _, _, ty) - | ESeq (_, _, ty) -> + | ESeq (_, _, ty) + | EAssert (_, ty) -> ty let rec get_mod_ty (me : mod_expr) = diff --git a/tests/regular/parse_test.ml b/tests/regular/parse_test.ml index 203fbb8..65b5546 100644 --- a/tests/regular/parse_test.ml +++ b/tests/regular/parse_test.ml @@ -657,6 +657,21 @@ let%expect_test "Test: expression parsing" = (start_loc ((pos_fname "") (pos_lnum 1) (pos_bol 0) (pos_cnum 0))) (end_loc ((pos_fname "") (pos_lnum 1) (pos_bol 0) (pos_cnum 7))) (attrs ())) + |}]; + + print_parsed {| + (assert false) + |}; + [%expect {| + ((desc + (EAssert + ((desc (EConst (CBool false))) + (start_loc ((pos_fname "") (pos_lnum 2) (pos_bol 1) (pos_cnum 25))) + (end_loc ((pos_fname "") (pos_lnum 2) (pos_bol 1) (pos_cnum 30))) + (attrs ())))) + (start_loc ((pos_fname "") (pos_lnum 2) (pos_bol 1) (pos_cnum 18))) + (end_loc ((pos_fname "") (pos_lnum 2) (pos_bol 1) (pos_cnum 30))) + (attrs ())) |}] let%expect_test "Test: pattern parsing" = @@ -1280,6 +1295,27 @@ let result = print_int (sum 4) ((Mul ((TTuple ((TCons additive ()) (TCons additive ()))))) (Div ((TTuple ((TCons additive ()) (TCons additive ()))))))) (TDAdt atom () ((Var ((TCons string ())))))))) + |}]; + print_parsed_program {| + let x = assert false + let y = 1 + |}; + [%expect {| + ((TopLet x + ((desc + (EAssert + ((desc (EConst (CBool false))) + (start_loc ((pos_fname "") (pos_lnum 2) (pos_bol 1) (pos_cnum 40))) + (end_loc ((pos_fname "") (pos_lnum 2) (pos_bol 1) (pos_cnum 45))) + (attrs ())))) + (start_loc ((pos_fname "") (pos_lnum 2) (pos_bol 1) (pos_cnum 33))) + (end_loc ((pos_fname "") (pos_lnum 2) (pos_bol 1) (pos_cnum 45))) + (attrs ()))) + (TopLet y + ((desc (EConst (CInt 1))) + (start_loc ((pos_fname "") (pos_lnum 3) (pos_bol 46) (pos_cnum 78))) + (end_loc ((pos_fname "") (pos_lnum 3) (pos_bol 46) (pos_cnum 79))) + (attrs ())))) |}] let%expect_test "Test: path parsing" = From 1116379c96cd9bc7fe9bac0d855142bbe288557c Mon Sep 17 00:00:00 2001 From: butterunderflow Date: Fri, 23 Aug 2024 23:03:05 +0800 Subject: [PATCH 2/2] translate assert expression & wrap main body with a try-catch --- lib/back/closure_translator.ml | 33 +++++++++-- lib/clos/closure.ml | 1 + lib/clos/lift.ml | 4 +- runtime/include/fun_rt_core.hpp | 2 + runtime/src/fun_rt_core.cpp | 9 +++ tests/cram/test_dirs/assert.t/run.t | 58 +++++++++++++++++++ tests/cram/test_dirs/assert.t/test_assert.fun | 7 +++ tests/cram/test_dirs/equality.t/run.t | 14 ++++- tests/cram/test_dirs/external.t/run.t | 28 +++++++-- tests/cram/test_dirs/hello.t/run.t | 14 ++++- tests/cram/test_dirs/interval_functor.t/run.t | 14 ++++- tests/cram/test_dirs/literal.t/run.t | 14 ++++- tests/cram/test_dirs/match.t/run.t | 14 ++++- tests/cram/test_dirs/simple.t/run.t | 14 ++++- tests/cram/test_dirs/simple_functor.t/run.t | 14 ++++- tests/cram/test_dirs/wildcard.t/run.t | 14 ++++- tests/regular/lift_test.ml | 10 ++++ tests/regular/lower_test.ml | 6 +- tests/regular/parse_test.ml | 9 ++- tests/regular/typing_test.ml | 9 +++ 20 files changed, 247 insertions(+), 41 deletions(-) create mode 100644 tests/cram/test_dirs/assert.t/run.t create mode 100644 tests/cram/test_dirs/assert.t/test_assert.fun diff --git a/lib/back/closure_translator.ml b/lib/back/closure_translator.ml index f157dba..97ed582 100644 --- a/lib/back/closure_translator.ml +++ b/lib/back/closure_translator.ml @@ -52,6 +52,8 @@ let ff_is_equal_aux = C.VARIABLE "ff_is_equal_aux" let ff_is_zero = C.VARIABLE "ff_is_zero" +let ff_assert = C.VARIABLE "ff_assert" + let ff_is_not_equal = C.VARIABLE "ff_is_not_equal" let ff_get_mem = C.VARIABLE "ff_get_member" @@ -72,9 +74,11 @@ let ff_match_constr = C.VARIABLE "ff_match_constr" let ff_match_tuple = C.VARIABLE "ff_match_tuple" -let header = {| -#include"fun_rt.hpp" -#include +let header = + {| +#include "fun_rt.hpp" +#include +#include |} @@ -332,6 +336,14 @@ and trans_expr ctx e = let _e0_v, e0_stmts = trans_expr ctx e0 in let e1_v, e1_stmts = trans_expr ctx e1 in (e1_v, e0_stmts @ e1_stmts) + | EAssert e0 -> + let e0_v, e0_stmts = trans_expr ctx e0 in + let is_true_v = create_decl "is_true" ctx in + let assert_stmt = + make_assign (VARIABLE is_true_v) + (CALL (ff_assert, [ VARIABLE e0_v ])) + in + (is_true_v, e0_stmts @ [ assert_stmt ]) | EStruct _ -> ("todo", []) and trans_const (c : S.constant) = @@ -515,11 +527,20 @@ let translate (main, (fns : func list)) = Cprint1.print buf fn_defs; let prog = Buffer.contents buf in let driver = - Printf.sprintf {| + Printf.sprintf + {| int main() { - %s(nullptr); + try + { + %s(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %%s", error.what()); + } } -|} main_name +|} + main_name in header ^ prog ^ driver diff --git a/lib/clos/closure.ml b/lib/clos/closure.ml index 5f6d8c1..07bdc84 100644 --- a/lib/clos/closure.ml +++ b/lib/clos/closure.ml @@ -24,6 +24,7 @@ type expr = | EField of expr * string | ECmp of T.cmp_op * expr * expr | ESeq of expr * expr + | EAssert of expr and pattern = L.pattern diff --git a/lib/clos/lift.ml b/lib/clos/lift.ml index 38e9e85..ba67c9f 100644 --- a/lib/clos/lift.ml +++ b/lib/clos/lift.ml @@ -87,7 +87,9 @@ let rec lift ?(hint = "temp") (e : L.expr) (vars : string list) : | L.EField (e, name) -> let e', fns = lift e vars ~hint in (C.EField (e', name), fns) - | L.EAssert _ -> failwith "todo" + | L.EAssert e -> + let e', fns = lift e vars ~hint in + (C.EAssert e', fns) and lift_letrec binds vars = let xs = List.map fst binds in diff --git a/runtime/include/fun_rt_core.hpp b/runtime/include/fun_rt_core.hpp index 85d93c6..df7cb46 100644 --- a/runtime/include/fun_rt_core.hpp +++ b/runtime/include/fun_rt_core.hpp @@ -185,4 +185,6 @@ ff_obj_t ff_is_not_equal(ff_obj_t x, ff_obj_t y); bool ff_is_zero(ff_obj_t x); +ff_obj_t ff_assert(ff_obj_t x); + #endif diff --git a/runtime/src/fun_rt_core.cpp b/runtime/src/fun_rt_core.cpp index 85d96c0..14ea378 100644 --- a/runtime/src/fun_rt_core.cpp +++ b/runtime/src/fun_rt_core.cpp @@ -5,6 +5,7 @@ #include #include #include +#include #include #include #include @@ -200,3 +201,11 @@ bool ff_is_zero(ff_obj_t x) { auto val = ff_get_int(x); return val == 0; } + +ff_obj_t ff_assert(ff_obj_t x) { + auto val = ff_get_int(x); + if (val != 0) { + throw std::runtime_error("Assertion failed!"); + } + return ff_make_int(0); +} diff --git a/tests/cram/test_dirs/assert.t/run.t b/tests/cram/test_dirs/assert.t/run.t new file mode 100644 index 0000000..b210711 --- /dev/null +++ b/tests/cram/test_dirs/assert.t/run.t @@ -0,0 +1,58 @@ + + + $ ff test_assert.fun -o test_assert.cpp + + $ cat test_assert.cpp + + #include "fun_rt.hpp" + #include + #include + + ff_obj_t main_1__fn(ff_fvs_t fvs_1); + + ff_obj_t main_1__fn(ff_fvs_t fvs_1) + { + ff_obj_t mod_12; + ff_obj_t x_11; + ff_obj_t is_true_10; + ff_obj_t temp_9; + ff_obj_t x_8; + ff_obj_t temp_7; + ff_obj_t app_res_6; + ff_obj_t x_5; + ff_obj_t is_true_4; + ff_obj_t temp_3; + ff_obj_t println_str_2; + println_str_2 = ff_builtin_println_str; + temp_3 = ff_make_int(1); + is_true_4 = ff_assert(temp_3); + x_5 = is_true_4; + temp_7 = ff_make_str("A true asserted!"); + app_res_6 = ff_apply_generic(println_str_2, temp_7); + x_8 = app_res_6; + temp_9 = ff_make_int(0); + is_true_10 = ff_assert(temp_9); + x_11 = is_true_10; + mod_12 = ff_make_mod_obj(4, {"println_str", "x", "x", "x"}, + {println_str_2, x_5, x_8, x_11}); + return mod_12; + } + + + int main() + { + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } + } + + $ $FF test_assert.fun + + $ ./test_assert.fun.out + Runtime error: Assertion failed! + diff --git a/tests/cram/test_dirs/assert.t/test_assert.fun b/tests/cram/test_dirs/assert.t/test_assert.fun new file mode 100644 index 0000000..5d01e03 --- /dev/null +++ b/tests/cram/test_dirs/assert.t/test_assert.fun @@ -0,0 +1,7 @@ +external println_str : string -> unit = "ff_builtin_println_str" + +let x = assert true + +let x = println_str "A true asserted!" + +let x = assert false diff --git a/tests/cram/test_dirs/equality.t/run.t b/tests/cram/test_dirs/equality.t/run.t index 357997a..03210ef 100644 --- a/tests/cram/test_dirs/equality.t/run.t +++ b/tests/cram/test_dirs/equality.t/run.t @@ -2,8 +2,9 @@ $ cat test_equality.fun.cpp - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); @@ -84,7 +85,14 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } $ ./test_equality.fun.out diff --git a/tests/cram/test_dirs/external.t/run.t b/tests/cram/test_dirs/external.t/run.t index 8247acc..34e87df 100644 --- a/tests/cram/test_dirs/external.t/run.t +++ b/tests/cram/test_dirs/external.t/run.t @@ -1,8 +1,9 @@ $ ff test_external.fun --stdout - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); @@ -18,7 +19,14 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } @@ -26,8 +34,9 @@ $ cat test_add_external.fun.cpp - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); @@ -60,7 +69,14 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } $ ./test_add_external.fun.out diff --git a/tests/cram/test_dirs/hello.t/run.t b/tests/cram/test_dirs/hello.t/run.t index a1f9167..0a6c017 100644 --- a/tests/cram/test_dirs/hello.t/run.t +++ b/tests/cram/test_dirs/hello.t/run.t @@ -7,8 +7,9 @@ $ cat hello.fun.cpp - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); @@ -33,5 +34,12 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } diff --git a/tests/cram/test_dirs/interval_functor.t/run.t b/tests/cram/test_dirs/interval_functor.t/run.t index 96f91a2..685661d 100644 --- a/tests/cram/test_dirs/interval_functor.t/run.t +++ b/tests/cram/test_dirs/interval_functor.t/run.t @@ -2,8 +2,9 @@ $ cat test_interval.cpp - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); ff_obj_t print_int_interval_14__fn(ff_fvs_t fvs_4, ff_obj_t interval_3); @@ -555,7 +556,14 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } $ $FF test_interval.fun diff --git a/tests/cram/test_dirs/literal.t/run.t b/tests/cram/test_dirs/literal.t/run.t index 1606633..0c37b9c 100644 --- a/tests/cram/test_dirs/literal.t/run.t +++ b/tests/cram/test_dirs/literal.t/run.t @@ -3,8 +3,9 @@ $ cat test_literal.fun.cpp - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); @@ -34,6 +35,13 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } diff --git a/tests/cram/test_dirs/match.t/run.t b/tests/cram/test_dirs/match.t/run.t index 468b79e..4117759 100644 --- a/tests/cram/test_dirs/match.t/run.t +++ b/tests/cram/test_dirs/match.t/run.t @@ -4,8 +4,9 @@ $ cat test_match.fun.cpp - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); ff_obj_t f_2__fn(ff_fvs_t fvs_3, ff_obj_t x_2); @@ -151,7 +152,14 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } $ ./test_match.fun.out diff --git a/tests/cram/test_dirs/simple.t/run.t b/tests/cram/test_dirs/simple.t/run.t index d16a290..ae0a2fd 100644 --- a/tests/cram/test_dirs/simple.t/run.t +++ b/tests/cram/test_dirs/simple.t/run.t @@ -12,8 +12,9 @@ $ ff simple.fun $ ff simple.fun --stdout - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); ff_obj_t m_4__fn(ff_fvs_t fvs_3, ff_obj_t x_2); @@ -76,7 +77,14 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } $ ff simple.fun -o simple1.out --debug diff --git a/tests/cram/test_dirs/simple_functor.t/run.t b/tests/cram/test_dirs/simple_functor.t/run.t index 38357be..0f5d315 100644 --- a/tests/cram/test_dirs/simple_functor.t/run.t +++ b/tests/cram/test_dirs/simple_functor.t/run.t @@ -11,8 +11,9 @@ $ cat test_increment_functor.fun.cpp - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); ff_obj_t Increment_2__fn(ff_fvs_t fvs_3, ff_obj_t M_2); @@ -124,5 +125,12 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } diff --git a/tests/cram/test_dirs/wildcard.t/run.t b/tests/cram/test_dirs/wildcard.t/run.t index 0c53aff..ff4b206 100644 --- a/tests/cram/test_dirs/wildcard.t/run.t +++ b/tests/cram/test_dirs/wildcard.t/run.t @@ -3,8 +3,9 @@ $ cat test_wildcard.fun.cpp - #include"fun_rt.hpp" - #include + #include "fun_rt.hpp" + #include + #include ff_obj_t main_1__fn(ff_fvs_t fvs_1); @@ -33,7 +34,14 @@ int main() { - main_1__fn(nullptr); + try + { + main_1__fn(nullptr); + } + catch (const std::runtime_error& error) + { + printf("Runtime error: %s", error.what()); + } } $ ./test_wildcard.fun.out diff --git a/tests/regular/lift_test.ml b/tests/regular/lift_test.ml index a88e53f..8c63f62 100644 --- a/tests/regular/lift_test.ml +++ b/tests/regular/lift_test.ml @@ -122,4 +122,14 @@ let z = fun z -> x = y (sum/2 (sum) (x) (EIf (ECmp Eq (EVar x) (EConst (CInt 0))) (EConst (CInt 1)) (EConst (CInt 2)))) + |}]; + print_lifted {| +let x = assert true + |}; + [%expect + {| + Main function name: + main/1 + Global C functions: + (main/1 () () (EModObject ((FSimple x (EAssert (EConst (CBool true))))))) |}] diff --git a/tests/regular/lower_test.ml b/tests/regular/lower_test.ml index 6b351b2..6c96d40 100644 --- a/tests/regular/lower_test.ml +++ b/tests/regular/lower_test.ml @@ -288,4 +288,8 @@ let z = x = y ((even ((x) (EApp (EVar odd) ((EConst (CInt 1)))) (odd))) (odd ((x) (EApp (EVar even) ((EConst (CInt 1)))) (even)))) (EVar even))))) - |}] + |}]; + print_lowered {| + let x = assert true + |}; + [%expect {| (EModObject ((FSimple x (EAssert (EConst (CBool true)))))) |}] diff --git a/tests/regular/parse_test.ml b/tests/regular/parse_test.ml index 65b5546..eb7677c 100644 --- a/tests/regular/parse_test.ml +++ b/tests/regular/parse_test.ml @@ -662,7 +662,8 @@ let%expect_test "Test: expression parsing" = print_parsed {| (assert false) |}; - [%expect {| + [%expect + {| ((desc (EAssert ((desc (EConst (CBool false))) @@ -1296,11 +1297,13 @@ let result = print_int (sum 4) (Div ((TTuple ((TCons additive ()) (TCons additive ()))))))) (TDAdt atom () ((Var ((TCons string ())))))))) |}]; - print_parsed_program {| + print_parsed_program + {| let x = assert false let y = 1 |}; - [%expect {| + [%expect + {| ((TopLet x ((desc (EAssert diff --git a/tests/regular/typing_test.ml b/tests/regular/typing_test.ml index b7214b5..f1f0b63 100644 --- a/tests/regular/typing_test.ml +++ b/tests/regular/typing_test.ml @@ -1244,6 +1244,15 @@ let x = Closure ("x", Nil) ((TCons (0 string) ()) (TCons (0 list) ((TVar (Link (TCons (0 int) ())))))))) (TVar (Link (TCons (0 t) ())))))) + |}]; + + print_typed {| +let x = assert true +|}; + [%expect + {| + ((TopLet x + (EAssert (EConst (CBool true) (TCons (0 bool) ())) (TCons (0 unit) ())))) |}] let%expect_test "Error reporting test" =