start using preprocessor to remove some shim modules

src/core/CCAtomic.ml

@@ -0,0 +1,35 @@
+
+[%IFGE 4.12]
+
+include Atomic
+
+
+[%ELSE]
+
+open CCShims_.Stdlib (* for == *)
+
+type 'a t = {mutable x: 'a}
+let[@inline] make x = {x}
+let[@inline] get {x} = x
+let[@inline] set r x = r.x <- x
+let[@inline] exchange r x =
+  let y = r.x in
+  r.x <- x;
+  y
+
+let[@inline] compare_and_set r seen v =
+  if r.x == seen then (
+    r.x <- v;
+    true
+  ) else false
+
+let[@inline] fetch_and_add r x =
+  let v = r.x in
+  r.x <- x + r.x;
+  v
+
+let[@inline] incr r = r.x <- 1 + r.x
+let[@inline] decr r = r.x <- r.x - 1
+
+
+[%ENDIF]

src/core/CCFun.ml

@@ -9,7 +9,27 @@ let opaque_identity x = x
 
 include Sys
 include CCShims_.Stdlib
-include CCShimsFun_
+
+[%IFGE 4.8]
+
+include Fun
+
+[%ELSE]
+
+external id : 'a -> 'a = "%identity"
+let[@inline] flip f x y = f y x
+let[@inline] const x _ = x
+let[@inline] negate f x = not (f x)
+let[@inline] protect ~finally f =
+  try
+    let x= f() in
+    finally();
+    x
+  with e ->
+    finally();
+    raise e
+
+[%ENDIF]
 
 let compose f g x = g (f x)
 

src/core/CCFun.mli

@@ -3,9 +3,22 @@
 
 (** Basic operations on Functions *)
 
-include module type of CCShimsFun_
+[%IFGE 4.8]
+include module type of Fun
 (** @inline *)
 
+[%ELSE]
+(** This is an API imitating the new standard Fun module *)
+external id : 'a -> 'a = "%identity"
+val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c
+val const : 'a -> _ -> 'a
+val negate : ('a -> bool) -> 'a -> bool
+
+val protect : finally:(unit -> unit) -> (unit -> 'a) -> 'a
+(* this doesn't have the exact same semantics as the stdlib's finally.
+    It will not attempt to catch exceptions raised from [finally] at all. *)
+[%ENDIF]
+
 val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
 (** [compose f g x] is [g (f x)]. Composition. *)
 

src/core/cpp/cpp.ml

@@ -32,9 +32,10 @@ let eval ~major ~minor op i j =
     | Le -> (major,minor) <= (i,j)
     | Ge -> (major,minor) >= (i,j)
 
-let preproc_lines ~major ~minor (ic:in_channel) : unit =
+let preproc_lines ~file ~major ~minor (ic:in_channel) : unit =
   let pos = ref 0 in
   let fail msg = failwith (Printf.sprintf "at line %d: %s" !pos msg) in
+  let pp_pos () = Printf.printf "#%d %S\n" !pos file in
 
   let parse_line () : line =
     match input_line ic with
@@ -49,6 +50,7 @@ let preproc_lines ~major ~minor (ic:in_channel) : unit =
           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 line="[%ELSE]" then Else
         else if line="[%ENDIF]" then Endif
         else Raw line
   in
@@ -58,8 +60,10 @@ let preproc_lines ~major ~minor (ic:in_channel) : unit =
     match parse_line () with
       | Eof -> ()
       | If (op,i,j) ->
-        if eval ~major ~minor op i j
+        if eval ~major ~minor op i j then (
-        then cat_block () else skip_block ~elseok:true ()
+          pp_pos();
+          cat_block ()
+        ) else skip_block ~elseok:true ()
       | Raw s -> print_endline s; top()
       | Elseif _ | Else | Endif ->
         fail "unexpected elseif|else|endif"
@@ -82,20 +86,23 @@ let preproc_lines ~major ~minor (ic:in_channel) : unit =
       | Raw _ -> skip_block ~elseok ()
       | Endif -> top()
       | Elseif (op,i,j) ->
-        if elseok && eval ~major ~minor op i j
+        if elseok && eval ~major ~minor op i j then (
-        then cat_block ()
+          pp_pos();
-        else skip_block ~elseok ()
+          cat_block ()
+        ) else skip_block ~elseok ()
       | Else ->
-        if elseok then cat_block() else skip_block ~elseok ()
+        if elseok then (
+          pp_pos();
+          cat_block()
+        ) else skip_block ~elseok ()
   in
   top()
 
 let () =
   let file = Sys.argv.(1) in
-  C.main ~name:"cpp" (fun c ->
+  let c = C.create "main" in
-    let version = C.ocaml_config_var_exn c "version" 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 major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in
 
-    let ic = open_in_bin file in
+  let ic = open_in_bin file in
-    preproc_lines ~major ~minor ic
+  preproc_lines ~file ~major ~minor ic
-  )

src/core/dune

@@ -5,9 +5,9 @@
  (libraries dune.configurator))
 
 (rule
- (targets CCShims_.ml CCShimsList_.ml CCShimsFun_.ml CCShimsFun_.mli
+ (targets CCShims_.ml CCShimsList_.ml
    CCShimsArray_.ml CCShimsFormat_.ml CCShimsMkLet_.ml CCShimsMkLetList_.ml
-   CCShimsArrayLabels_.ml CCShimsInt_.ml CCAtomic.ml CCUnit.ml)
+   CCShimsArrayLabels_.ml CCShimsInt_.ml CCUnit.ml)
  (deps ./mkshims.exe)
  (action
   (run ./mkshims.exe)))

src/core/mkshims.ml

@@ -53,20 +53,6 @@ let shims_fun_pre_408 = "
       raise e
 
 "
-let shims_fun_mli_pre_408 = "
-  (** This is an API imitating the new standard Fun module *)
-  external id : 'a -> 'a = \"%identity\"
-  val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c
-  val const : 'a -> _ -> 'a
-  val negate : ('a -> bool) -> 'a -> bool
-
-  val protect : finally:(unit -> unit) -> (unit -> 'a) -> 'a
-  (* this doesn't have the exact same semantics as the stdlib's finally.
-      It will not attempt to catch exceptions raised from [finally] at all. *)
-"
-
-let shims_fun_post_408 = "include Fun"
-let shims_fun_mli_post_408 = "include module type of Fun"
 
 let shims_list_pre_408 = "
   include List
@@ -213,35 +199,6 @@ let to_string () = "()"
 
 let shims_unit_after_408 = "include Unit"
 
-let shims_atomic_before_412 = {|
-  open CCShims_.Stdlib (* for == *)
-
-  type 'a t = {mutable x: 'a}
-  let[@inline] make x = {x}
-  let[@inline] get {x} = x
-  let[@inline] set r x = r.x <- x
-  let[@inline] exchange r x =
-    let y = r.x in
-    r.x <- x;
-    y
-
-  let[@inline] compare_and_set r seen v =
-    if r.x == seen then (
-      r.x <- v;
-      true
-    ) else false
-
-  let[@inline] fetch_and_add r x =
-    let v = r.x in
-    r.x <- x + r.x;
-    v
-
-  let[@inline] incr r = r.x <- 1 + r.x
-  let[@inline] decr r = r.x <- r.x - 1
-  |}
-
-let shims_atomic_after_412 = {|include Atomic|}
-
 let () =
   C.main ~name:"mkshims" (fun c ->
     let version = C.ocaml_config_var_exn c "version" in
@@ -257,14 +214,10 @@ let () =
        else if (major, minor) >= (4,6) then shims_array_label_406_408
        else shims_array_label_pre_406);
     write_file "CCShimsFormat_.ml" (if (major, minor) >= (4,8) then shims_fmt_post_408 else shims_fmt_pre_408);
-    write_file "CCShimsFun_.ml" (if (major, minor) >= (4,8) then shims_fun_post_408 else shims_fun_pre_408);
-    write_file "CCShimsFun_.mli" (if (major, minor) >= (4,8) then shims_fun_mli_post_408 else shims_fun_mli_pre_408);
     write_file "CCShimsMkLet_.ml" (if (major, minor) >= (4,8) then shims_let_op_post_408 else shims_let_op_pre_408);
     write_file "CCShimsMkLetList_.ml" (if (major, minor) >= (4,8) then shims_let_op_list_post_408 else shims_let_op_list_pre_408);
     write_file "CCShimsInt_.ml"
       (if (major, minor) >= (4,8) then shims_int_post_408 else shims_int_pre_408);
-    write_file "CCAtomic.ml"
-      (if (major, minor) >= (4,12) then shims_atomic_after_412 else shims_atomic_before_412);
     write_file "CCUnit.ml"
       (if (major, minor) >= (4,8) then shims_unit_after_408 else shims_unit_before_408);
   )