From 0aeac5d81b7fa27ef048feaa351aea4be10467a9 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.org>
Date: Tue, 30 Oct 2012 01:20:01 +0100
Subject: [PATCH 2/7] Add primitives for compile time constants

---
 asmcomp/closure.ml      |    9 +++++++++
 asmcomp/cmmgen.ml       |   10 ++++++++++
 bytecomp/bytegen.ml     |    8 ++++++++
 bytecomp/lambda.ml      |    9 +++++++++
 bytecomp/lambda.mli     |    9 +++++++++
 bytecomp/printlambda.ml |    8 ++++++++
 bytecomp/translcore.ml  |    5 +++++
 byterun/sys.c           |   29 +++++++++++++++++++++++++++++
 8 files changed, 87 insertions(+)

diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml
index 114f5e6..1bca455 100644
--- a/asmcomp/closure.ml
+++ b/asmcomp/closure.ml
@@ -229,6 +229,15 @@ let simplif_prim_pure p (args, approxs) dbg =
         Pidentity -> make_const_ptr x
       | Pnot -> make_const_bool(x = 0)
       | Pisint -> make_const_bool true
+      | Pctconst c ->
+          begin
+            match c with
+            | Big_endian -> make_const_bool Arch.big_endian
+            | Word_size -> make_const_int (8*Arch.size_int)
+            | Ostype_unix -> make_const_bool (Sys.os_type = "Unix")
+            | Ostype_win32 -> make_const_bool (Sys.os_type = "Win32")
+            | Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin")
+          end
       | _ -> (Uprim(p, args, dbg), Value_unknown)
       end
   | [Value_constptr x; Value_constptr y] ->
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 0e9da63..2b9f0c9 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -1268,6 +1268,16 @@ and transl_prim_1 p arg dbg =
   (* Integer operations *)
   | Pnegint ->
       Cop(Csubi, [Cconst_int 2; transl arg])
+  | Pctconst c ->
+      let const_of_bool b = tag_int (Cconst_int (if b then 1 else 0)) in
+      begin
+        match c with
+        | Big_endian -> const_of_bool Arch.big_endian
+        | Word_size -> tag_int (Cconst_int (8*Arch.size_int))
+        | Ostype_unix -> const_of_bool (Sys.os_type = "Unix")
+        | Ostype_win32 -> const_of_bool (Sys.os_type = "Win32")
+        | Ostype_cygwin -> const_of_bool (Sys.os_type = "Cygwin")
+      end
   | Poffsetint n ->
       if no_overflow_lsl n then
         add_const (transl arg) (n lsl 1)
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index a73151a..e4fae30 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -349,6 +349,14 @@ let comp_primitive p args =
   | Parraysetu Pgenarray -> Kccall("caml_array_unsafe_set", 3)
   | Parraysetu Pfloatarray -> Kccall("caml_array_unsafe_set_float", 3)
   | Parraysetu _ -> Ksetvectitem
+  | Pctconst c ->
+     let const_name = match c with
+       | Big_endian -> "big_endian"
+       | Word_size -> "word_size"
+       | Ostype_unix -> "ostype_unix"
+       | Ostype_win32 -> "ostype_win32"
+       | Ostype_cygwin -> "ostype_cygwin" in
+     Kccall(Printf.sprintf "caml_sys_const_%s" const_name, 1)
   | Pisint -> Kisint
   | Pisout -> Kisout
   | Pbittest -> Kccall("caml_bitvect_test", 2)
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index 1239648..6a847c8 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -14,6 +14,13 @@ open Misc
 open Path
 open Asttypes
 
+type compile_time_constant =
+  | Big_endian
+  | Word_size
+  | Ostype_unix
+  | Ostype_win32
+  | Ostype_cygwin
+
 type primitive =
     Pidentity
   | Pignore
@@ -101,6 +108,8 @@ type primitive =
   | Pbigstring_set_16 of bool
   | Pbigstring_set_32 of bool
   | Pbigstring_set_64 of bool
+  (* Compile time constants *)
+  | Pctconst of compile_time_constant
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index 277e373..d2e3761 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -14,6 +14,13 @@
 
 open Asttypes
 
+type compile_time_constant =
+  | Big_endian
+  | Word_size
+  | Ostype_unix
+  | Ostype_win32
+  | Ostype_cygwin
+
 type primitive =
     Pidentity
   | Pignore
@@ -101,6 +108,8 @@ type primitive =
   | Pbigstring_set_16 of bool
   | Pbigstring_set_32 of bool
   | Pbigstring_set_64 of bool
+  (* Compile time constants *)
+  | Pctconst of compile_time_constant
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index 185d22a..e570cf1 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -154,6 +154,14 @@ let primitive ppf = function
   | Parraysetu _ -> fprintf ppf "array.unsafe_set"
   | Parrayrefs _ -> fprintf ppf "array.get"
   | Parraysets _ -> fprintf ppf "array.set"
+  | Pctconst c ->
+     let const_name = match c with
+       | Big_endian -> "big_endian"
+       | Word_size -> "word_size"
+       | Ostype_unix -> "ostype_unix"
+       | Ostype_win32 -> "ostype_win32"
+       | Ostype_cygwin -> "ostype_cygwin" in
+     fprintf ppf "sys.constant_%s" const_name
   | Pisint -> fprintf ppf "isint"
   | Pisout -> fprintf ppf "isout"
   | Pbittest -> fprintf ppf "testbit"
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index c4d22a1..256395b 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -150,6 +150,11 @@ let primitives_table = create_hashtable 57 [
   "%sequand", Psequand;
   "%sequor", Psequor;
   "%boolnot", Pnot;
+  "%big_endian", Pctconst Big_endian;
+  "%word_size", Pctconst Word_size;
+  "%ostype_unix", Pctconst Ostype_unix;
+  "%ostype_win32", Pctconst Ostype_win32;
+  "%ostype_cygwin", Pctconst Ostype_cygwin;
   "%negint", Pnegint;
   "%succint", Poffsetint 1;
   "%predint", Poffsetint(-1);
diff --git a/byterun/sys.c b/byterun/sys.c
index 574a4ec..332887b 100644
--- a/byterun/sys.c
+++ b/byterun/sys.c
@@ -334,6 +334,35 @@ CAMLprim value caml_sys_random_seed (value unit)
   return res;
 }
 
+CAMLprim value caml_sys_const_big_endian(value unit)
+{
+#ifdef ARCH_BIG_ENDIAN
+  return Val_true;
+#else
+  return Val_false;
+#endif
+}
+
+CAMLprim value caml_sys_const_word_size(value unit)
+{
+  return Val_long(8 * sizeof(value));
+}
+
+CAMLprim value caml_sys_const_ostype_unix(value unit)
+{
+  return Val_long(0 == strcmp(OCAML_OS_TYPE,"Unix"));
+}
+
+CAMLprim value caml_sys_const_ostype_win32(value unit)
+{
+  return Val_long(0 == strcmp(OCAML_OS_TYPE,"Win32"));
+}
+
+CAMLprim value caml_sys_const_ostype_cygwin(value unit)
+{
+  return Val_long(0 == strcmp(OCAML_OS_TYPE,"Cygwin"));
+}
+
 CAMLprim value caml_sys_get_config(value unit)
 {
   CAMLparam0 ();   /* unit is unused */
-- 
1.7.10.4

From 6549d74037f8ad744f261b0e8e1f15f1679c8ad3 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.org>
Date: Tue, 30 Oct 2012 01:20:11 +0100
Subject: [PATCH 4/7] Add primitives for compile time constants: library part

---
 stdlib/sys.mli |   12 ++++++++++++
 stdlib/sys.mlp |   12 +++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index 99d7824..c980e3f 100644
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -78,6 +78,18 @@ val os_type : string
 -  ["Win32"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw),
 -  ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin). *)
 
+val unix : bool
+(** True if [Sys.os_type = "Unix"].
+    @since patch included *)
+
+val win32 : bool
+(** True if [Sys.os_type = "Win32"].
+    @since patch included *)
+
+val cygwin : bool
+(** True if [Sys.os_type = "Cygwin"].
+    @since patch included *)
+
 val word_size : int
 (** Size of one word on the machine currently executing the OCaml
    program, in bits: 32 or 64. *)
diff --git a/stdlib/sys.mlp b/stdlib/sys.mlp
index 9c851d4..c54fcb8 100644
--- a/stdlib/sys.mlp
+++ b/stdlib/sys.mlp
@@ -19,9 +19,19 @@
 
 external get_config: unit -> string * int * bool = "caml_sys_get_config"
 external get_argv: unit -> string * string array = "caml_sys_get_argv"
+external big_endian : unit -> bool = "%big_endian"
+external word_size : unit -> int = "%word_size"
+external unix : unit -> bool = "%ostype_unix"
+external win32 : unit -> bool = "%ostype_win32"
+external cygwin : unit -> bool = "%ostype_cygwin"
 
 let (executable_name, argv) = get_argv()
-let (os_type, word_size, big_endian) = get_config()
+let (os_type, _, _) = get_config()
+let big_endian = big_endian ()
+let word_size = word_size ()
+let unix = unix ()
+let win32 = win32 ()
+let cygwin = cygwin ()
 let max_array_length = (1 lsl (word_size - 10)) - 1;;
 let max_string_length = word_size / 8 * max_array_length - 1;;
 
-- 
1.7.10.4