release js_of_ocaml 5.0

.github/workflows/build.yml

@@ -38,7 +38,7 @@ jobs:
             ocaml-compiler: 4.14.x
             skip-effects: true
             skip-test: false
-            skip-doc: false
+            skip-doc: true
           - os: macos-latest
             ocaml-compiler: 4.14.x
             skip-effects: true
@@ -53,7 +53,7 @@ jobs:
             ocaml-compiler: 5.0.x
             skip-effects: false
             skip-test: false
-            skip-doc: true
+            skip-doc: false
           - os: macos-latest
             ocaml-compiler: 5.0.x
             skip-effects: true

CHANGES.md

@@ -1,4 +1,4 @@
-# dev (202?-??) - ??
+# 5.0.0 (2022-12-20) - Lille
 ## Features/Changes
 * Compiler: add support for effect handlers (--enable=effects)
 * Compiler: small refactoring in code generation
@@ -8,7 +8,6 @@
 * Toplevel: recover more names when generating code during toplevel evaluation
 * Runtime: wrapping exception or not is now controled in the runtime.
 
-
 ## Bug fixes
 * Runime: Gc.finalise_last should not be eliminated
 * Tyxml: reactive dom needed a fix after #1268 (#1353)

VERSION

@@ -1 +1 @@
-4.1.0
+5.0.0

compiler/tests-jsoo/lib-effects/transaction.ml

@@ -37,32 +37,6 @@ module Txn : TXN = struct
 
   type _ Effect.t += Update : 'a t * 'a -> unit Effect.t
 
-  let _atomically f =
-    let comp =
-      match_with
-        f
-        ()
-        { retc = (fun x _ -> x)
-        ; exnc =
-            (fun e rb ->
-              rb ();
-              raise e)
-        ; effc =
-            (fun (type a) (e : a Effect.t) ->
-              match e with
-              | Update (r, v) ->
-                  Some
-                    (fun (k : (a, _) continuation) rb ->
-                      let old_v = !r in
-                      r := v;
-                      continue k () (fun () ->
-                          r := old_v;
-                          rb ()))
-              | _ -> None)
-        }
-    in
-    comp (fun () -> ())
-
   let atomically f =
     let comp =
       match_with
@@ -71,23 +45,17 @@ module Txn : TXN = struct
         { retc = (fun x _ -> x)
         ; exnc =
             (fun e rb ->
-              print_endline "before raise";
               rb ();
-              print_endline "raise";
               raise e)
         ; effc =
             (fun (type a) (e : a Effect.t) ->
               match e with
               | Update (r, v) ->
-                  print_endline "udpate";
                   Some
                     (fun (k : (a, _) continuation) rb ->
-                      print_endline "save";
-
                       let old_v = !r in
                       r := v;
                       continue k () (fun () ->
-                          print_endline "restore";
                           r := old_v;
                           rb ()))
               | _ -> None)
@@ -125,17 +93,8 @@ let%expect_test _ =
              printf "T0: %d\n" !r
          | e -> printf "inner exception: %s\n" (Printexc.to_string e))
    with e -> printf "outer exception: %s\n" (Printexc.to_string e));
-  [%expect
-    {|
+  [%expect {|
     T0: 10
-    udpate
-    save
-    udpate
-    save
     T1: Before abort 21
-    before raise
-    restore
-    restore
-    raise
     T0: T1 aborted with 21
     T0: 10 |}]

lib/lwt/lwt_jsonp.ml

@@ -38,10 +38,13 @@ let raw_call name uri error_cb user_cb =
     Js.Opt.iter script##.parentNode (fun parent -> Dom.removeChild parent script)
   in
   let executed = ref false in
-  Js.Unsafe.set Dom_html.window (Js.string name) (fun x ->
-      executed := true;
-      finalize ();
-      user_cb x);
+  Js.Unsafe.set
+    Dom_html.window
+    (Js.string name)
+    (Js.wrap_callback (fun x ->
+         executed := true;
+         finalize ();
+         user_cb x));
   script##.src := Js.string uri;
   script##._type := Js.string "text/javascript";
   script##.async := Js._true;

lib/tyxml/tyxml_js.ml

@@ -219,10 +219,13 @@ module Xml = struct
                 a
             in
             retain (node :> Dom.node Js.t) ~keepme
-        | Event h -> Js.Unsafe.set node n (fun ev -> Js.bool (h ev))
-        | MouseEvent h -> Js.Unsafe.set node n (fun ev -> Js.bool (h ev))
-        | KeyboardEvent h -> Js.Unsafe.set node n (fun ev -> Js.bool (h ev))
-        | TouchEvent h -> Js.Unsafe.set node n (fun ev -> Js.bool (h ev)))
+        | Event h -> Js.Unsafe.set node n (Js.wrap_callback (fun ev -> Js.bool (h ev)))
+        | MouseEvent h ->
+            Js.Unsafe.set node n (Js.wrap_callback (fun ev -> Js.bool (h ev)))
+        | KeyboardEvent h ->
+            Js.Unsafe.set node n (Js.wrap_callback (fun ev -> Js.bool (h ev)))
+        | TouchEvent h ->
+            Js.Unsafe.set node n (Js.wrap_callback (fun ev -> Js.bool (h ev))))
       l
 
   let leaf ?(a = []) name =

toplevel/examples/lwt_toplevel/examples.ml

@@ -159,3 +159,73 @@ let _ = pong 111 87 2 3
 let _ = pong 28 57 5 3
 
 let _ = start ()
+
+(** Effect handler *)
+
+module Txn : sig
+  type 'a t
+
+  val atomically : (unit -> unit) -> unit
+
+  val ref : 'a -> 'a t
+
+  val ( ! ) : 'a t -> 'a
+
+  val ( := ) : 'a t -> 'a -> unit
+end = struct
+  open Effect
+  open Effect.Deep
+
+  type 'a t = 'a ref
+
+  type _ Effect.t += Update : 'a t * 'a -> unit Effect.t
+
+  let atomically f =
+    let comp =
+      match_with
+        f
+        ()
+        { retc = (fun x _ -> x)
+        ; exnc =
+            (fun e rb ->
+              rb ();
+              raise e)
+        ; effc =
+            (fun (type a) (e : a Effect.t) ->
+              match e with
+              | Update (r, v) ->
+                  Some
+                    (fun (k : (a, _) continuation) rb ->
+                      let old_v = !r in
+                      r := v;
+                      continue k () (fun () ->
+                          r := old_v;
+                          rb ()))
+              | _ -> None)
+        }
+    in
+    comp (fun () -> ())
+
+  let ref = ref
+
+  let ( ! ) = ( ! )
+
+  let ( := ) r v = perform (Update (r, v))
+end
+
+let example () =
+  let open Txn in
+  let exception Res of int in
+  let r = ref 10 in
+  Printf.printf "T0: %d\n" !r;
+  try
+    atomically (fun () ->
+        r := 20;
+        r := 21;
+        Printf.printf "T1: Before abort %d\n" !r;
+        raise (Res !r) |> ignore;
+        Printf.printf "T1: After abort %d\n" !r;
+        r := 30)
+  with Res v ->
+    Printf.printf "T0: T1 aborted with %d\n" v;
+    Printf.printf "T0: %d\n" !r