PoC: generic infix operators

Author: cometkim

compiler/core/lam_convert.ml

@@ -232,6 +232,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pduprecord -> prim ~primitive:Pduprecord ~args loc
   | Plazyforce -> prim ~primitive:Plazyforce ~args loc
   | Praise _ -> prim ~primitive:Praise ~args loc
+  | Pinfix _ -> assert false
   | Pobjcomp x -> prim ~primitive:(Pobjcomp x) ~args loc
   | Pobjorder -> prim ~primitive:Pobjorder ~args loc
   | Pobjmin -> prim ~primitive:Pobjmin ~args loc
@@ -475,6 +476,16 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
     | Lprim (Pimport, args, loc) ->
       let args = Ext_list.map args (convert_aux ~dynamic_import:true) in
       lam_prim ~primitive:Pimport ~args loc
+    | Lprim (Pinfix (Inf_custom (mod_, op)), args, loc) ->
+      let fn = Lam.var (Ident.create_persistent op) in
+      let args = Ext_list.map args (convert_aux ~dynamic_import) in
+      let ap_info : Lam.ap_info =
+        {ap_loc = loc; ap_status = App_na; ap_inlined = Lambda.Default_inline}
+      in
+      Lam.apply fn args ap_info
+    | Lprim (Pinfix Inf_invariant, args, loc) ->
+      (* TODO : invariant *)
+      assert false
     | Lprim (primitive, args, loc) ->
       let args = Ext_list.map args (convert_aux ~dynamic_import) in
       lam_prim ~primitive ~args loc

compiler/ml/lambda.ml

@@ -175,6 +175,8 @@ type immediate_or_pointer = Immediate | Pointer
 
 type is_safe = Safe | Unsafe
 
+type infix_info = Inf_custom of string * string | Inf_invariant
+
 type primitive =
   | Pidentity
   | Pignore
@@ -198,6 +200,8 @@ type primitive =
   | Pccall of Primitive.description
   (* Exceptions *)
   | Praise of raise_kind
+  (* Infix *)
+  | Pinfix of infix_info
   (* object operations *)
   | Pobjcomp of comparison
   | Pobjorder

compiler/ml/lambda.mli

@@ -138,6 +138,8 @@ type pointer_info =
   | Pt_shape_none
   | Pt_assertfalse
 
+type infix_info = Inf_custom of string * string | Inf_invariant
+
 type primitive =
   | Pidentity
   | Pignore
@@ -161,6 +163,8 @@ type primitive =
   | Pccall of Primitive.description
   (* Exceptions *)
   | Praise of raise_kind
+  (* Infix *)
+  | Pinfix of infix_info
   (* object primitives *)
   | Pobjcomp of comparison
   | Pobjorder

compiler/ml/printlambda.ml

@@ -125,6 +125,8 @@ let primitive ppf = function
   | Plazyforce -> fprintf ppf "force"
   | Pccall p -> fprintf ppf "%s" p.prim_name
   | Praise k -> fprintf ppf "%s" (Lambda.raise_kind k)
+  | Pinfix (Inf_custom (mod_, op)) -> fprintf ppf "%s.%s" mod_ op
+  | Pinfix Inf_invariant -> fprintf ppf "invariant"
   | Pobjcomp Ceq -> fprintf ppf "=="
   | Pobjcomp Cneq -> fprintf ppf "!="
   | Pobjcomp Clt -> fprintf ppf "<"