wip: use mucppo

src/cbor/dune

@@ -3,5 +3,5 @@
  (libraries containers)
  (preprocess
   (action
-   (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
+   (run %{project_root}/src/core/cpp/mucppo.exe %{input-file})))
  (public_name containers.cbor))

src/core/CCList.ml

@@ -47,7 +47,7 @@ let mguard c =
 (** max depth for direct recursion *)
 let direct_depth_default_ = 1000
 
-[@@@iflt 4.14]
+#if OCAML_VERSION < (4,14,0)
 
 let tail_map f l =
   (* Unwind the list of tuples, reconstructing the full list front-to-back.
@@ -114,7 +114,7 @@ let append l1 l2 =
   in
   direct 1000 l1 l2
 
-[@@@eliflt 5.1]
+#elif OCAML_VERSION < (5,1,0)
 
 let[@tail_mod_cons] rec map f l =
   match l with
@@ -128,11 +128,11 @@ let[@tail_mod_cons] rec append l1 l2 =
   | [] -> l2
   | x :: tl1 -> x :: append tl1 l2
 
-[@@@else_]
+#else
 
 (* TRMC functions on >= 5.1, no need to bring our own *)
 
-[@@@endif]
+#endif
 
 (* Wrapper around [append] to optimize for the case of short [l1],
    and for the case of [l2 = []] (saves the whole copy of [l1]!) *)
@@ -157,7 +157,7 @@ let cons_when b x l =
   else
     l
 
-[@@@iflt 4.14]
+#if OCAML_VERSION < (4,14,0)
 
 let direct_depth_filter_ = 10_000
 
@@ -176,7 +176,7 @@ let filter p l =
   in
   direct direct_depth_filter_ p l
 
-[@@@eliflt 5.1]
+#elif OCAML_VERSION < (5,1,0)
 
 let[@tail_mod_cons] rec filter f l =
   match l with
@@ -188,10 +188,10 @@ let[@tail_mod_cons] rec filter f l =
     else
       filter f tl
 
-[@@@else_]
+#else
 (* stdlib's filter uses TRMC after 5.1 *)
 
-[@@@endif]
+#endif
 
 let fold_right f l acc =
   let rec direct i f l acc =

src/core/cpp/cpp.ml

@@ -1,142 +0,0 @@
-module C = Configurator.V1
-
-type op =
-  | Le
-  | Ge
-  | Gt
-  | Lt
-
-type line =
-  | If of op * int * int
-  | Elseif of op * int * int
-  | Else
-  | Endif
-  | Raw of string
-  | Eof
-
-let prefix ~pre s =
-  let len = String.length pre in
-  if len > String.length s then
-    false
-  else (
-    let rec check i =
-      if i = len then
-        true
-      else if String.unsafe_get s i <> String.unsafe_get pre i then
-        false
-      else
-        check (i + 1)
-    in
-    check 0
-  )
-
-let eval ~major ~minor op i j =
-  match op with
-  | Le -> (major, minor) <= (i, j)
-  | Lt -> (major, minor) < (i, j)
-  | Ge -> (major, minor) >= (i, j)
-  | Gt -> (major, minor) > (i, j)
-
-let preproc_lines ~file ~major ~minor (ic : in_channel) : unit =
-  let pos = ref 0 in
-  let fail msg =
-    failwith (Printf.sprintf "at line %d in '%s': %s" !pos file msg)
-  in
-  let pp_pos () = Printf.printf "#%d %S\n" !pos file in
-
-  let parse_line () : line =
-    match input_line ic with
-    | exception End_of_file -> Eof
-    | line ->
-      let line' = String.trim line in
-      incr pos;
-      if line' <> "" && line'.[0] = '[' then
-        if prefix line' ~pre:"[@@@ifle" then
-          Scanf.sscanf line' "[@@@ifle %d.%d]" (fun x y -> If (Le, x, y))
-        else if prefix line' ~pre:"[@@@iflt" then
-          Scanf.sscanf line' "[@@@iflt %d.%d]" (fun x y -> If (Lt, x, y))
-        else if prefix line' ~pre:"[@@@ifge" then
-          Scanf.sscanf line' "[@@@ifge %d.%d]" (fun x y -> If (Ge, x, y))
-        else if prefix line' ~pre:"[@@@ifgt" then
-          Scanf.sscanf line' "[@@@ifgt %d.%d]" (fun x y -> If (Gt, x, y))
-        else if prefix line' ~pre:"[@@@elifle" then
-          Scanf.sscanf line' "[@@@elifle %d.%d]" (fun x y -> Elseif (Le, x, y))
-        else if prefix line' ~pre:"[@@@elifge" then
-          Scanf.sscanf line' "[@@@elifge %d.%d]" (fun x y -> Elseif (Ge, x, y))
-        else if prefix line' ~pre:"[@@@eliflt" then
-          Scanf.sscanf line' "[@@@eliflt %d.%d]" (fun x y -> Elseif (Lt, x, y))
-        else if prefix line' ~pre:"[@@@elifge" then
-          Scanf.sscanf line' "[@@@elifge %d.%d]" (fun x y -> Elseif (Ge, x, y))
-        else if line' = "[@@@else_]" then
-          Else
-        else if line' = "[@@@endif]" then
-          Endif
-        else
-          Raw line
-      else
-        Raw line
-  in
-
-  (* entry point *)
-  let rec top () =
-    match parse_line () with
-    | Eof -> ()
-    | If (op, i, j) ->
-      if eval ~major ~minor op i j then (
-        pp_pos ();
-        cat_block ()
-      ) else
-        skip_block ~elseok:true ()
-    | Raw s ->
-      print_endline s;
-      top ()
-    | Elseif _ | Else | Endif -> fail "unexpected elseif|else|endif"
-  (* current block is the valid one *)
-  and cat_block () =
-    match parse_line () with
-    | Eof -> fail "unexpected EOF"
-    | If _ -> fail "nested if not supported"
-    | Raw s ->
-      print_endline s;
-      cat_block ()
-    | Endif ->
-      pp_pos ();
-      top ()
-    | Elseif _ | Else -> skip_block ~elseok:false ()
-  (* skip current block.
-     @param elseok if true, we should evaluate "elseif" *)
-  and skip_block ~elseok () =
-    match parse_line () with
-    | Eof -> fail "unexpected EOF"
-    | If _ -> fail "nested if not supported"
-    | Raw _ -> skip_block ~elseok ()
-    | Endif ->
-      pp_pos ();
-      top ()
-    | Elseif (op, i, j) ->
-      if elseok && eval ~major ~minor op i j then (
-        pp_pos ();
-        cat_block ()
-      ) else
-        skip_block ~elseok ()
-    | Else ->
-      if elseok then (
-        pp_pos ();
-        cat_block ()
-      ) else
-        skip_block ~elseok ()
-  in
-  top ()
-
-let () =
-  let t0 = Unix.gettimeofday () in
-  let file = Sys.argv.(1) in
-  let c = C.create "main" in
-  let version = C.ocaml_config_var_exn c "version" in
-  let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in
-
-  let ic = open_in file in
-  preproc_lines ~file ~major ~minor ic;
-
-  Printf.printf "(* file preprocessed in %.3fs *)\n" (Unix.gettimeofday () -. t0);
-  ()

src/core/cpp/dune

@@ -1,8 +1,7 @@
-; our little preprocessor
+; https://github.com/Leonidas-from-XIV/mucppo, cause it slaps
 
 (executable
- (name cpp)
+ (name mucppo)
  (flags :standard -warn-error -a+8)
  (modes
-  (best exe))
+  (best exe)))
- (libraries dune.configurator))

src/core/cpp/mucppo.ml

@@ -0,0 +1,188 @@
+(* mucppo Copyright 2023-2024 Marek Kubica <marek@tarides.com>
+ * Released under CC0 license, freely available to all.
+ *
+ * Simple, no dependency cppo replacement to be embedded into builds.
+ *
+ * Contains a bare subset of cppo features to eliminate it as a dependency.
+ * For more info check the project page at
+ * https://github.com/Leonidas-from-XIV/mucppo
+ *)
+
+let version_triple major minor patch = major, minor, patch
+let current_version = Scanf.sscanf Sys.ocaml_version "%u.%u.%u" version_triple
+let greater_or_equal (v : int * int * int) = current_version >= v
+
+module PrintingState : sig
+  type t
+
+  val empty : t
+  val is_empty : t -> bool
+  val flip_top : t -> t
+  val latest_was_triggered : t -> bool
+  val pop : t -> t
+  val push : bool -> t -> t
+  val should_print : t -> bool
+end = struct
+  type state = {
+    state: bool;
+    was_true: bool;
+  }
+
+  type t = state list
+
+  let empty = [ { state = true; was_true = false } ]
+  let is_empty (x : t) = x = empty
+
+  let flip_top = function
+    | [] -> failwith "Output stack empty, invalid state"
+    | x :: xs -> { state = not x.state; was_true = true } :: xs
+
+  let latest_was_triggered l = (List.hd l).was_true
+  let pop = List.tl
+  let push state l = { state; was_true = state } :: l
+
+  let should_print =
+    List.fold_left (fun acc { state; was_true = _ } -> state && acc) true
+end
+
+module Variables = struct
+  module Map = Map.Make (String)
+
+  let is_defined name = Map.mem name
+  let define name = Map.add name ()
+  let undefine name = Map.remove name
+  let empty = Map.empty
+end
+
+(* for OCaml 4.02 *)
+let string_equal = ( = )
+
+let starts_with ~prefix s =
+  let len = String.length prefix in
+  String.length s >= len && string_equal (String.sub s 0 len) prefix
+
+let is_if_statement = starts_with ~prefix:"#if"
+let is_elif_defined_statement = starts_with ~prefix:"#elif defined"
+let is_include_statement = starts_with ~prefix:"#include"
+let is_define_statement = starts_with ~prefix:"#define"
+let is_undef_statement = starts_with ~prefix:"#undef"
+let is_ifdef = starts_with ~prefix:"#ifdef"
+let filename_of_include s = Scanf.sscanf s "#include %S" (fun x -> x)
+let variable_of_define s = Scanf.sscanf s "#define %s" (fun x -> x)
+let variable_of_undef s = Scanf.sscanf s "#undef %s" (fun x -> x)
+let variable_of_ifdef s = Scanf.sscanf s "#ifdef %s" (fun x -> x)
+let variable_of_elif_defined s = Scanf.sscanf s "#elif defined %s" (fun x -> x)
+
+let is_ocaml_version s =
+  (* Sscanf.sscanf_opt exists but only since 5.0 *)
+  match Scanf.sscanf s "#if OCAML_VERSION >= (%u, %u, %u)" version_triple with
+  | v -> Some v
+  | exception _ -> None
+
+module State = struct
+  type t = {
+    (* print state *)
+    ps: PrintingState.t;
+    vars: unit Variables.Map.t;
+  }
+
+  let conditional_triggered s = { s with ps = PrintingState.flip_top s.ps }
+  let end_conditional s = { s with ps = PrintingState.pop s.ps }
+  let triggered_before s = PrintingState.latest_was_triggered s.ps
+  let start_conditional v s = { s with ps = PrintingState.push v s.ps }
+  let should_output { ps; vars = _ } = PrintingState.should_print ps
+
+  let don't_print s =
+    match should_output s with
+    | false -> s
+    | true -> { s with ps = PrintingState.flip_top s.ps }
+
+  let finished { ps; vars = _ } = PrintingState.is_empty ps
+  let empty = { ps = PrintingState.empty; vars = Variables.empty }
+  let define v s = { s with vars = Variables.define v s.vars }
+  let undefine v s = { s with vars = Variables.undefine v s.vars }
+  let is_defined v { ps = _; vars } = Variables.is_defined v vars
+end
+
+let output_endline oc s =
+  output_string oc s;
+  output_char oc '\n'
+
+let rec loop ic oc ~lineno ~filename st =
+  match input_line ic with
+  | line ->
+    let next = loop ic oc ~lineno:(succ lineno) ~filename in
+    (match String.trim line with
+    | "#else" ->
+      (match State.triggered_before st with
+      | true -> next (State.don't_print st)
+      | false -> next (State.conditional_triggered st))
+    | "#endif" -> next (State.end_conditional st)
+    | trimmed_line when is_define_statement trimmed_line ->
+      let var = variable_of_define trimmed_line in
+      let st = State.define var st in
+      next st
+    | trimmed_line when is_undef_statement trimmed_line ->
+      let var = variable_of_undef trimmed_line in
+      let st = State.undefine var st in
+      next st
+    | trimmed_line when is_include_statement trimmed_line ->
+      let filename = filename_of_include trimmed_line in
+      let included_ic = open_in filename in
+      loop included_ic oc ~lineno:1 ~filename st;
+      next st
+    | trimmed_line when is_ifdef trimmed_line ->
+      let var = variable_of_ifdef trimmed_line in
+      let is_defined = State.is_defined var st in
+      let st = State.start_conditional is_defined st in
+      next st
+    | trimmed_line when is_if_statement trimmed_line ->
+      (match is_ocaml_version line with
+      | None ->
+        failwith
+          (Printf.sprintf "Parsing #if in file %s line %d failed, exiting"
+             filename lineno)
+      | Some (major, minor, patch) ->
+        next
+          (State.start_conditional (greater_or_equal (major, minor, patch)) st))
+    | trimmed_line when is_elif_defined_statement trimmed_line ->
+      (match State.triggered_before st with
+      | true -> next (State.don't_print st)
+      | false ->
+        let var = variable_of_elif_defined trimmed_line in
+        (match State.is_defined var st with
+        | true -> next (State.conditional_triggered st)
+        | false -> next st))
+    | _trimmed_line ->
+      if State.should_output st then output_endline oc line;
+      next st)
+  | exception End_of_file ->
+    if not (State.finished st) then
+      failwith "Output stack messed up, missing #endif?"
+
+let () =
+  let output_file = ref None in
+  let input_file = ref None in
+  let speclist =
+    [
+      ( "-o",
+        Arg.String (fun filename -> output_file := Some filename),
+        "Set output file name" );
+    ]
+  in
+  let anonymous filename = input_file := Some filename in
+  let usage = "mucppo -o <output> <file>" in
+  Arg.parse speclist anonymous usage;
+  let ic, filename =
+    match !input_file with
+    | Some filename -> open_in filename, filename
+    | None -> stdin, "<stdin>"
+  in
+  let oc =
+    match !output_file with
+    | Some filename -> open_out filename
+    | None -> stdout
+  in
+  loop ic oc ~lineno:1 ~filename State.empty;
+  close_in ic;
+  close_out oc

src/core/dune

@@ -4,7 +4,7 @@
  (wrapped false)
  (preprocess
   (action
-   (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
+   (run %{project_root}/src/core/cpp/mucppo.exe %{input-file})))
  (flags :standard -nolabels -open CCMonomorphic)
  (libraries either containers.monomorphic))
 

src/monomorphic/dune

@@ -3,6 +3,6 @@
  (public_name containers.monomorphic)
  (preprocess
   (action
-   (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
+   (run %{project_root}/src/core/cpp/mucppo.exe %{input-file})))
  (modules CCMonomorphic)
  (wrapped false))

src/pvec/containers_pvec.mli

@@ -10,15 +10,15 @@
 
 type 'a iter = ('a -> unit) -> unit
 
-[@@@ifge 5.0]
+#if OCAML_VERSION >= (5,0,0)
 
 type !'a t
 
-[@@@else_]
+#else
 
 type 'a t
 
-[@@@endif]
+#endif
 
 val empty : 'a t
 (** Empty vector. *)

src/pvec/dune

@@ -3,5 +3,5 @@
  (public_name containers.pvec)
  (preprocess
   (action
-   (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
+   (run %{project_root}/src/core/cpp/mucppo.exe %{input-file})))
  (synopsis "Persistent vector for OCaml"))

src/testlib/dune

@@ -3,5 +3,5 @@
  (synopsis "Test library for containers")
  (preprocess
   (action
-   (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
+   (run %{project_root}/src/core/cpp/mucppo.exe %{input-file})))
  (libraries containers qcheck-core unix))

tests/cbor/dune

@@ -3,7 +3,7 @@
  (modules t_appendix_a)
  (preprocess
   (action
-   (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
+   (run %{project_root}/src/core/cpp/mucppo.exe %{input-file})))
  (libraries yojson containers containers.cbor))
 
 (rule

tests/core/dune

@@ -6,7 +6,7 @@
  (package containers)
  (preprocess
   (action
-   (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
+   (run %{project_root}/src/core/cpp/mucppo.exe %{input-file})))
  (libraries
   containers
   containers.bencode

tests/core/t_list.ml

@@ -124,7 +124,8 @@ eq
    fold_flat_map (fun acc x -> acc + x, [ pf "%d" x; pf "a%d" x ]) 0 [ 1; 2; 3 ])
 ;;
 
-[@@@ifge 4.12]
+#if OCAML_VERSION >= (4,12,0)
+
 t @@ fun () ->
 let r = Atomic.make 0 in
 let f x =
@@ -140,7 +141,7 @@ assert_equal
 true
 ;;
 
-[@@@endif]
+#endif
 
 q
   Q.(list int)