Merge pull request #15 from gretay-js/use_effects_in_cmmgen

Propagate builtin from Primitive to Cextcall

backend/cmm_helpers.ml

@@ -2532,6 +2532,20 @@ let bigstring_set size unsafe arg1 arg2 arg3 dbg =
             check_bound unsafe size dbg (bigstring_length ba dbg)
               idx (unaligned_set size ba_data idx newval dbg))))))
 
+
+(* [cextcall] is called from [Cmmgen.transl_ccall] *)
+let cextcall (prim : Primitive.description) args dbg ret =
+  let name = Primitive.native_name prim in
+  let default = Cop(Cextcall { name; ret;
+                               builtin = prim.prim_c_builtin;
+                               effects = Arbitrary_effects;
+                               coeffects = Has_coeffects;
+                               alloc = prim.prim_alloc;
+                               label_after = None},
+                    args, dbg)
+  in
+  default
+
 (* Symbols *)
 
 let cdefine_symbol (symb, (global: Cmmgen_state.is_global)) =

backend/cmm_helpers.mli

@@ -570,6 +570,12 @@ val send :
   Lambda.meth_kind -> expression -> expression -> expression list ->
   Debuginfo.t -> expression
 
+(** [cextcall prim args dbg type_of_result] returns Cextcall operation
+    that corresponds to [prim]. If [prim] is a C builtin supported on the
+    target, returns [Cmm.operation] variant for [prim]'s intrinsics. *)
+val cextcall : Primitive.description -> expression list -> Debuginfo.t ->
+  machtype -> expression
+
 (** Generic Cmm fragments *)
 
 (** Generate generic functions *)

backend/cmmgen.ml

@@ -775,14 +775,8 @@ and transl_ccall env prim args dbg =
     | Untagged_int -> (typ_int, (fun i -> tag_int i dbg))
   in
   let args = transl_args prim.prim_native_repr_args args in
-  wrap_result
-    (Cop(Cextcall { name = Primitive.native_name prim;
-                    builtin = false;
-                    effects = Arbitrary_effects;
-                    coeffects = Has_coeffects;
-                    ret = typ_res; alloc = prim.prim_alloc;
-                    label_after = None },
-     args, dbg))
+  let op = cextcall prim args dbg typ_res in
+  wrap_result op
 
 and transl_prim_1 env p arg dbg =
   match p with