update

compiler/core/lam_analysis.ml

@@ -97,8 +97,8 @@ let rec no_side_effects (lam : Lam.t) : bool =
     (* TODO *)
     | Praw_js_code _
     (* byte swap *)
-    | Parraysets | Parraysetu | Poffsetref _ | Praise | Plazyforce | Psetfield _
-      ->
+    | Parraysets | Parraysetu | Poffsetref _ | Praise | Passert | Plazyforce
+    | Psetfield _ ->
       false)
   | Llet (_, _, arg, body) -> no_side_effects arg && no_side_effects body
   | Lswitch (_, _) -> false

compiler/core/lam_compile.ml

@@ -1523,6 +1523,36 @@ let compile output_prefix =
       | Fld_module {name = field} ->
         compile_external_field ~dynamic_import lambda_cxt id field
       | _ -> assert false)
+    | {primitive = Passert; args = [e]; _} -> (
+      match
+        compile_lambda {lambda_cxt with continuation = NeedValue Not_tail} e
+      with
+      | {block; value = Some v} ->
+        let loc_start = prim_info.loc.loc_start in
+        let fname = loc_start.pos_fname in
+        let line = loc_start.pos_lnum in
+        let col = loc_start.pos_cnum - loc_start.pos_bol in
+
+        let else_ =
+          S.throw_stmt
+            (E.obj
+               [
+                 (Lit "RE_EXN_ID", E.str "Assertion_failure");
+                 ( Lit "_1",
+                   E.array Js_op.Immutable
+                     [
+                       E.str fname;
+                       E.int (Int32.of_int line);
+                       E.int (Int32.of_int col);
+                     ] );
+                 (Lit "Error", E.new_ (E.js_global "Error") []);
+               ])
+        in
+
+        Js_output.make
+          [S.if_ v block ~else_:[else_]]
+          ~value:E.undefined ~output_finished:False
+      | {value = None} -> assert false)
     | {primitive = Praise; args = [e]; _} -> (
       match
         compile_lambda {lambda_cxt with continuation = NeedValue Not_tail} e

compiler/core/lam_compile_primitive.ml

@@ -533,6 +533,7 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
     | _ -> assert false)
   (* only when Lapply -> expand = true*)
   | Praise -> assert false (* handled before here *)
+  | Passert -> assert false
   (* Runtime encoding relevant *)
   | Parraylength -> E.array_length (Ext_list.singleton_exn args)
   | Psetfield (i, field_info) -> (

compiler/core/lam_convert.ml

@@ -232,6 +232,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pduprecord -> prim ~primitive:Pduprecord ~args loc
   | Plazyforce -> prim ~primitive:Plazyforce ~args loc
   | Praise _ -> prim ~primitive:Praise ~args loc
+  | Passert -> prim ~primitive:Passert ~args loc
   | Pobjcomp x -> prim ~primitive:(Pobjcomp x) ~args loc
   | Pobjorder -> prim ~primitive:Pobjorder ~args loc
   | Pobjmin -> prim ~primitive:Pobjmin ~args loc

compiler/core/lam_primitive.ml

@@ -52,6 +52,7 @@ type t =
   | Pjs_object_create of External_arg_spec.obj_params
   (* Exceptions *)
   | Praise
+  | Passert
   (* object primitives *)
   | Pobjcomp of Lam_compat.comparison
   | Pobjorder
@@ -193,7 +194,7 @@ let eq_tag_info (x : Lam_tag_info.t) y = x = y
 
 let eq_primitive_approx (lhs : t) (rhs : t) =
   match lhs with
-  | Pwrap_exn | Praise
+  | Pwrap_exn | Praise | Passert
   (* generic comparison *)
   | Pobjorder | Pobjmin | Pobjmax | Pobjtag | Pobjsize
   (* bool primitives *)

compiler/core/lam_primitive.mli

@@ -46,6 +46,7 @@ type t =
     }
   | Pjs_object_create of External_arg_spec.obj_params
   | Praise
+  | Passert
   (* object primitives *)
   | Pobjcomp of Lam_compat.comparison
   | Pobjorder

compiler/core/lam_print.ml

@@ -86,6 +86,7 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Pjs_call {prim_name} -> fprintf ppf "%s[js]" prim_name
   | Pjs_object_create _ -> fprintf ppf "[js.obj]"
   | Praise -> fprintf ppf "raise"
+  | Passert -> fprintf ppf "assert"
   | Pobjcomp Ceq -> fprintf ppf "=="
   | Pobjcomp Cneq -> fprintf ppf "!="
   | Pobjcomp Clt -> fprintf ppf "<"

compiler/ml/lambda.ml

@@ -198,6 +198,7 @@ type primitive =
   | Pccall of Primitive.description
   (* Exceptions *)
   | Praise of raise_kind
+  | Passert
   (* object operations *)
   | Pobjcomp of comparison
   | Pobjorder

compiler/ml/lambda.mli

@@ -161,6 +161,7 @@ type primitive =
   | Pccall of Primitive.description
   (* Exceptions *)
   | Praise of raise_kind
+  | Passert
   (* object primitives *)
   | Pobjcomp of comparison
   | Pobjorder

compiler/ml/printlambda.ml

@@ -125,6 +125,7 @@ let primitive ppf = function
   | Plazyforce -> fprintf ppf "force"
   | Pccall p -> fprintf ppf "%s" p.prim_name
   | Praise k -> fprintf ppf "%s" (Lambda.raise_kind k)
+  | Passert -> fprintf ppf "assert"
   | Pobjcomp Ceq -> fprintf ppf "=="
   | Pobjcomp Cneq -> fprintf ppf "!="
   | Pobjcomp Clt -> fprintf ppf "<"

compiler/ml/translcore.ml

@@ -232,6 +232,7 @@ let primitives_table =
       ("%obj_get_field", Parrayrefu);
       ("%obj_set_field", Parraysetu);
       ("%raise", Praise Raise_regular);
+      ("%assert", Passert);
       (* bool primitives *)
       ("%sequand", Psequand);
       ("%sequor", Psequor);

tests/syntax_tests/data/printer/expr/assert.res

@@ -2,55 +2,55 @@ assert false
 
 assert truth
 
-let x = assert true
-let x = assert 12
-let x = assert (12: int)
-let x = assert 12
-let x = assert list{1, 2, ...x}
-let x = assert module(Foo: Bar)
-let x = assert module(Foo)
-let x = assert Rgb(1, 2, 3)
-let x = assert [a, b, c]
-let x = assert {x: 1, y: 3}
-let x = assert (1, 2, 3)
-let x = assert %extension
-let x = assert user.name
-let x = assert streets[0]
-let x = assert apply(arg1, arg2)
-let x = assert apply(. arg1, arg2)
-let x = assert -1
-let x = assert !true
-let x = assert (x => print(x))
-let x = assert (switch x {
+let x = assert(true)
+let x = assert(12)
+let x = assert((12: int))
+let x = assert(12)
+let x = assert(list{1, 2, ...x})
+let x = assert(module(Foo: Bar))
+let x = assert(module(Foo))
+let x = assert(Rgb(1, 2, 3))
+let x = assert([a, b, c])
+let x = assert({x: 1, y: 3})
+let x = assert((1, 2, 3))
+let x = assert(%extension)
+let x = assert(user.name)
+let x = assert(streets[0])
+let x = assert(apply(arg1, arg2))
+let x = assert(apply(. arg1, arg2))
+let x = assert(-1)
+let x = assert(!true)
+let x = assert(x => print(x))
+let x = assert(switch x {
   | Blue => ()
   | Yello => ()
 })
 
-let x = assert (for i in 0 to 10 {
+let x = assert(for i in 0 to 10 {
   print_int(i)
 })
 
-let x = assert (if i < 10 {
+let x = assert(if i < 10 {
   print_int(i)
 } else {
   print_int(1000)
 })
 
-let x = assert (while i < 10 {
+let x = assert(while i < 10 {
   print_int(i)
 })
 
-let x = assert (try sideEffect() catch {| Exit => ()})
+let x = assert(try sideEffect() catch {| Exit => ()})
 
-let x = assert (@attr expr)
+let x = assert(@attr expr)
 
-let x = assert (a + b)
+let x = assert(a + b)
 
-let x = @attr assert false
+let x = @attr assert(false)
 
-assert invariant["fatal"]
-assert invariants[0]
+assert(invariant["fatal"])
+assert(invariants[0])
 
-assert address["street"] = "Brusselsestraat"
+assert(address["street"] = "Brusselsestraat")
 
-assert (true ? 0 : 1)
+assert(true ? 0 : 1)

tests/syntax_tests/data/printer/expr/expected/assert.res.txt

@@ -8,15 +8,3 @@
 
   consecutive statements on a line must be separated by ';' or a newline
 
-
-  Syntax error!
-  syntax_tests/data/printer/expr/assert.res:13:18
-
-  11 │ let x = assert module(Foo)
-  12 │ let x = assert Rgb(1, 2, 3)
-  13 │ let x = assert [a, b, c]
-  14 │ let x = assert {x: 1, y: 3}
-  15 │ let x = assert (1, 2, 3)
-
-  Did you forget a `]` here?
-