OxCaml playground

Author: mshinwell

.devcontainer/Dockerfile

@@ -0,0 +1,33 @@
+FROM mcr.microsoft.com/devcontainers/universal
+
+RUN cd /root && \
+        curl -L -o autoconf.tar.gz https://ftp.gnu.org/gnu/autoconf/autoconf-2.71.tar.gz && \
+        tar fxz autoconf.tar.gz && \
+        cd autoconf-2.71 && \
+        ./configure --prefix=/usr && \
+        make && \
+        make install && \
+        cd .. && \
+        rm -rf autoconf-2.71 autoconf.tar.gz
+
+ARG USERNAME=codespace
+ARG USER_UID=1000
+ARG USER_GID=$USER_UID
+
+RUN curl -L -o /usr/bin/opam https://github.com/ocaml/opam/releases/download/2.3.0/opam-2.3.0-i686-linux && \
+        chmod +x /usr/bin/opam && \
+        apt-get update && \
+        apt-get install -y imagemagick && \
+        apt-get clean && \
+        rm -rf /var/lib/apt/lists/*
+
+USER ${USERNAME}
+
+RUN opam init -a --disable-sandboxing --yes && \
+        opam switch create 5.2.0+flambda2 --yes \
+        --repos "with-extensions=git+https://github.com/janestreet/opam-repository.git#with-extensions,default" && \
+        eval $(opam env --switch 5.2.0+flambda2) && \
+        opam install --yes ocamlformat merlin ocaml-lsp-server utop && \
+        opam install --yes parallel core_unix
+
+USER root

.devcontainer/devcontainer.json

@@ -0,0 +1,15 @@
+{
+        "build": {
+                "dockerfile": "Dockerfile"
+        },
+        "name": "OxCaml Playground",
+        "customizations": {
+                "vscode": {
+                        "extensions": [
+                                "ocamllabs.ocaml-platform",
+                                "ms-vscode.cpptools",
+                                "eamodio.gitlens"
+                        ]
+                }
+        }
+}

README.md

@@ -0,0 +1,19 @@
+# A playground for OxCaml
+
+**(Disclaimer: currently in alpha)**
+
+To make a playground, press the green "Code" button, then select "+" next to "Codespaces".  A new Codespace will open.  It currently takes maybe 20 or 30 minutes to initialize; please be patient.  We'll work on improving this startup time shortly.
+You can click the link in the status popup in the bottom-right of the window to see current progress (although there are no spinners).
+
+Once initialized you should have a full OPAM environment with the OxCaml compiler and dune on the path.  VSCode will have the OCaml Platform plugin together with the LSP server and merlin, the editor assistant.
+
+## Building your first OxCaml project
+
+```shell
+$ cd parallel-example/filter
+$ dune build filter.exe
+$ ../_build/default/filter/filter.exe
+$ mogrify -format jpg filtered-ox.pgm
+```
+
+Then you can open `filtered-ox.pgm` directly from the sidebar on the left.  Behold the *filtered ox*.

parallel-example/capsules.ml

@@ -0,0 +1,57 @@
+open! Base
+module Capsule = Portable.Capsule.Expert
+
+[@@@disable_unused_warnings]
+
+let fork_join parallel =
+  let ref = Capsule.Data.create (fun () -> ref 0) in
+  Parallel.fork_join2
+    parallel
+    (fun _ -> (ref : _ @ uncontended))
+    (fun _ -> (ref : _ @ uncontended))
+;;
+
+let increment ~(access : 'k Capsule.Access.t) ref =
+  let ref = Capsule.Data.unwrap ~access ref in
+  ref := !ref + 1
+;;
+
+let increment ~(password : 'k Capsule.Password.t) ref =
+  Capsule.access ~password ~f:(fun access ->
+    let ref = Capsule.Data.unwrap ~access ref in
+    ref := !ref + 1)
+;;
+
+let () =
+  let (Capsule.Key.P (key : _ Capsule.Key.t)) = Capsule.create () in
+  ()
+;;
+
+let parallel_key parallel =
+  let (P key) = Capsule.create () in
+  let ref = Capsule.Data.create (fun () -> ref 0) in
+  Parallel.fork_join2
+    parallel
+    (fun _ ->
+      Capsule.Key.with_password key ~f:(fun password -> increment ~password ref)
+      |> (ignore : _ -> _))
+    (fun _ -> ())
+;;
+
+let merge_fresh () =
+  let (P key) = Capsule.create () in
+  let ref = Capsule.Data.create (fun () -> ref 0) in
+  let access = Capsule.Key.destroy key in
+  let ref = Capsule.Data.unwrap ~access ref in
+  ref := !ref + 1
+;;
+
+let parallel_mutexes parallel =
+  let (P key) = Capsule.create () in
+  let mutex = Capsule.Mutex.create key in
+  let ref = Capsule.Data.create (fun () -> ref 0) in
+  Parallel.fork_join2
+    parallel
+    (fun _ -> Capsule.Mutex.with_lock mutex ~f:(fun password -> increment ~password ref))
+    (fun _ -> Capsule.Mutex.with_lock mutex ~f:(fun password -> increment ~password ref))
+;;

parallel-example/dune

@@ -0,0 +1,6 @@
+(library
+ (name parallel_example)
+ (public_name parallel_example)
+ (libraries base parallel parallel_scheduler_work_stealing portable stdio)
+ (preprocess
+  (pps ppx_jane)))

parallel-example/dune-project

@@ -0,0 +1,4 @@
+(lang dune 3.19)
+
+(package
+ (name parallel_example))

parallel-example/filter/camel.pgm

@@ -0,0 +1,8 @@
+(executables
+ (modes byte exe)
+ (names filter)
+ (libraries core_unix.command_unix core parallel
+   parallel.scheduler.work_stealing portable core_unix.time_stamp_counter)
+ (preprocess
+  (pps ppx_jane)))
+

parallel-example/filter/dune

@@ -0,0 +1,57 @@
+open! Core
+module Capsule = Portable.Capsule.Expert
+module Parallel_array = Parallel.Arrays.Array
+
+let blur_at image ~x ~y =
+  let width = Image.width image in
+  let height = Image.height image in
+  let acc = ref 0. in
+  for i = -4 to 4 do
+    for j = -4 to 4 do
+      let x = Int.clamp_exn (x + i) ~min:0 ~max:(width - 1) in
+      let y = Int.clamp_exn (y + j) ~min:0 ~max:(height - 1) in
+      acc := !acc +. Image.get image ~x ~y
+    done
+  done;
+  !acc /. 81.
+;;
+
+let filter ~scheduler ~key image =
+  let monitor = Parallel.Monitor.create_root () in
+  Parallel_scheduler_work_stealing.schedule scheduler ~monitor ~f:(fun parallel ->
+    let width = Image.width (Capsule.Data.project image) in
+    let height = Image.height (Capsule.Data.project image) in
+    let data =
+      Parallel_array.init parallel (width * height) ~f:(fun i ->
+        let x = i % width in
+        let y = i / width in
+        (Capsule.Key.access_shared key ~f:(fun access ->
+           { aliased = blur_at (Capsule.Data.unwrap_shared image ~access) ~x ~y }))
+          .aliased)
+    in
+    Image.of_array (Parallel_array.to_array data) ~width ~height)
+;;
+
+let command =
+  Command.basic
+    ~summary:"filter an image"
+    [%map_open.Command
+      let file = anon (maybe_with_default "ox.pgm" ("FILE" %: string))
+      and domains = flag "domains" (optional int) ~doc:"INT number of domains" in
+      fun () ->
+        let scheduler =
+          (Parallel_scheduler_work_stealing.create [@alert "-experimental"]) ?domains ()
+        in
+        let (P key) = Capsule.create () in
+        let image = Capsule.Data.create (fun () -> Image.load file) in
+        let start = Time_stamp_counter.now () in
+        let result = filter ~scheduler ~key image in
+        let finish = Time_stamp_counter.now () in
+        printf
+          "Completed in %dms.\n"
+          (Time_stamp_counter.Span.to_int_exn (Time_stamp_counter.diff finish start)
+           / 1_000_000);
+        Image.save result ("filtered-" ^ Filename.basename file)]
+;;
+
+let () = Command_unix.run command

parallel-example/filter/filter.ml

@@ -0,0 +1,65 @@
+open! Base
+module In = Stdlib.In_channel
+module Out = Stdlib.Out_channel
+module Scanf = Stdlib.Scanf.Scanning
+
+type t =
+  { width : int
+  ; height : int
+  ; data : float array
+  }
+
+let save { width; height; data } file =
+  Out.with_open_text file (fun out ->
+    let header = Stdlib.Printf.sprintf "P2\n%d %d\n255\n" width height in
+    let data =
+      Array.(fold_right [@mode shared]) data ~init:[] ~f:(fun x acc ->
+        (x
+         |> Float.clamp_exn ~min:0.0 ~max:1.0
+         |> Float.( * ) 255.0
+         |> Float.round_nearest
+         |> Float.to_int
+         |> Int.to_string)
+        :: acc)
+      |> List.chunks_of ~length:width
+      |> List.map ~f:(String.concat ~sep:" ")
+      |> String.concat ~sep:"\n"
+    in
+    Out.output_string out header;
+    Out.output_string out data;
+    Out.output_string out "\n")
+;;
+
+let load file =
+  In.with_open_text file (fun in_ ->
+    let in_ = Scanf.from_channel in_ in
+    let width, height, max =
+      Stdlib.Scanf.bscanf in_ "P2\n%d %d\n%d\n" (fun width height max ->
+        width, height, max)
+    in
+    let max = Float.of_int max in
+    let data =
+      Array.init (width * height) ~f:(fun _ ->
+        Stdlib.Scanf.bscanf in_ " %f " (fun f -> f /. max))
+    in
+    Scanf.close_in in_;
+    { width; height; data })
+;;
+
+let of_array data ~width ~height =
+  if Array.length data <> width * height then invalid_arg "mismatched array size";
+  { width; height; data }
+;;
+
+let width { width; _ } = width
+let height { height; _ } = height
+
+let get { data; width; _ } ~x ~y =
+  let idx = x + (y * width) in
+  (Array.get [@mode shared]) data idx
+;;
+
+let set { data; width; _ } ~x ~y p =
+  let idx = x + (y * width) in
+  Array.set data idx p
+;;