Revert "standarize constructor names"

The convention "constructor leading with type's name" can't be enforced

This reverts commit fcb26c8.

lib/back/closure_translator.ml

@@ -122,8 +122,8 @@ let get_all_member_names (mems : object_field list) =
   mems
   |> List.map (fun mem ->
          match mem with
-         | Field_simple (x, _) -> [ x ]
-         | Field_letrec (_, binds) -> fst (List.split binds))
+         | FSimple (x, _) -> [ x ]
+         | FLetRec (_, binds) -> fst (List.split binds))
   |> List.flatten
 
 let rec trans_main_expr buf (_e : expr) =
@@ -141,11 +141,11 @@ int main()
 
 and trans_expr ctx e =
   match e with
-  | Exp_var x -> (List.assoc x ctx.dict, [])
-  | Exp_external ff_name ->
+  | EVar x -> (List.assoc x ctx.dict, [])
+  | EExt ff_name ->
       ( ff_name (* assume we can access an ff object by its external name*),
         [] )
-  | Exp_let (x, e0, e1) ->
+  | ELet (x, e0, e1) ->
       let e0_v, e0_stmts = trans_expr ctx e0 in
       let result_stmt = e0_stmts in
       let x, ctx = create_var ~need_decl:true x ctx in
@@ -155,10 +155,10 @@ and trans_expr ctx e =
       let e1_v, e1_stmts = trans_expr ctx e1 in
       let result_stmt = result_stmt @ e1_stmts in
       (e1_v, result_stmt)
-  | Exp_const c ->
+  | EConst c ->
       let ret_v = create_decl "temp" ctx in
       (ret_v, [ make_assign (VARIABLE ret_v) (trans_const c) ])
-  | Exp_tuple es ->
+  | ETuple es ->
       let es_v, stmts_list = List.split (List.map (trans_expr ctx) es) in
       let stmts = List.flatten stmts_list in
       let tu = create_decl "tu" ctx in
@@ -180,7 +180,7 @@ and trans_expr ctx e =
           ]
       in
       (tu, stmts)
-  | Exp_if (e0, e1, e2) ->
+  | EIf (e0, e1, e2) ->
       let ifel_v = create_decl "ifel_res" ctx in
       let e0_v, e0_stmts = trans_expr ctx e0 in
       let e1_v, e1_stmts = trans_expr ctx e1 in
@@ -198,7 +198,7 @@ and trans_expr ctx e =
                     (e2_stmts
                     @ [ make_assign (VARIABLE ifel_v) (VARIABLE e2_v) ]) ));
           ] )
-  | Exp_app (e0, e1s) ->
+  | EApp (e0, e1s) ->
       let app_v = create_decl "app_res" ctx in
       let e0_v, e0_stmts = trans_expr ctx e0 in
       let e1_vs, e1_stmts = List.(split (map (trans_expr ctx) e1s)) in
@@ -211,21 +211,21 @@ and trans_expr ctx e =
                  ( ff_apply,
                    VARIABLE e0_v :: List.map (fun x -> C.VARIABLE x) e1_vs ));
           ] )
-  | Exp_constr i ->
+  | ECons i ->
       let constr_v = create_decl (Printf.sprintf "constr%d" i) ctx in
       ( constr_v,
         [
           make_assign (VARIABLE constr_v)
             (CALL (ff_constr_np, [ CONSTANT (CONST_INT (string_of_int i)) ]));
         ] )
-  | Exp_payload_constr i ->
+  | EConsWith i ->
       let constr_v = create_decl (Printf.sprintf "constr%d" i) ctx in
       ( constr_v,
         [
           make_assign (VARIABLE constr_v)
             (CALL (ff_constr_p, [ CONSTANT (CONST_INT (string_of_int i)) ]));
         ] )
-  | Exp_field (e, name) ->
+  | EField (e, name) ->
       let field = create_decl "field" ctx in
       let e_v, e_stmts = trans_expr ctx e in
       ( field,
@@ -235,7 +235,7 @@ and trans_expr ctx e =
               (CALL
                  (ff_get_mem, [ VARIABLE e_v; CONSTANT (CONST_STRING name) ]));
           ] )
-  | Exp_closure (fvs, cfunc) ->
+  | EClosure (fvs, cfunc) ->
       let clos_v = create_decl "clos" ctx in
       let fvs_c = List.map (fun fv -> List.assoc fv ctx.dict) fvs in
       let cfn_name = to_c_ident_fn cfunc in
@@ -250,23 +250,23 @@ and trans_expr ctx e =
                    CAST (ff_erased_fptr_typename, VARIABLE cfn_name);
                  ] ));
         ] )
-  | Exp_letrec ((fvs, binds), body) ->
+  | ELetRec ((fvs, binds), body) ->
       let _binds_c, letrec_init, ctx = trans_letrec fvs binds ctx in
       let body_c, body_stmts = trans_expr ctx body in
       (body_c, letrec_init @ body_stmts)
-  | Exp_mod_obj members ->
+  | EModObject members ->
       let stmts, mems_c, ctx =
         List.fold_left
           (fun (stmts_acc, mems_c_acc, ctx) mem ->
             match mem with
-            | Field_simple (x, e) ->
+            | FSimple (x, e) ->
                 let e_c, e_stmts = trans_expr ctx e in
                 let x_c, ctx = create_var ~need_decl:true x ctx in
                 ( stmts_acc @ e_stmts
                   @ [ make_assign (VARIABLE x_c) (VARIABLE e_c) ],
                   mems_c_acc @ [ x_c ],
                   ctx )
-            | Field_letrec (fvs, binds) ->
+            | FLetRec (fvs, binds) ->
                 let binds_c, bind_stmts, ctx = trans_letrec fvs binds ctx in
                 (stmts_acc @ bind_stmts, mems_c_acc @ binds_c, ctx))
           ([], [], ctx) members
@@ -288,7 +288,7 @@ and trans_expr ctx e =
                      make_compound (List.map (fun x -> C.VARIABLE x) mems_c);
                    ] ));
           ] )
-  | Exp_switch (e, bs) ->
+  | ESwitch (e, bs) ->
       (* match x with | Cons[1](y, z, w) -> e 
        *
          =>
@@ -313,7 +313,7 @@ and trans_expr ctx e =
           C.DOWHILE
             (C.CONSTANT (C.CONST_INT "0"), make_stmt_seq (e_stmts @ branches));
         ] )
-  | Exp_cmp (op, e0, e1) ->
+  | ECmp (op, e0, e1) ->
       let is_eq_v = create_decl "is_eq" ctx in
       let e0_v, e0_stmts = trans_expr ctx e0 in
       let e1_v, e1_stmts = trans_expr ctx e1 in
@@ -328,28 +328,26 @@ and trans_expr ctx e =
             make_assign (VARIABLE is_eq_v)
               (CALL (eq_fn, [ VARIABLE e0_v; VARIABLE e1_v ]));
           ] )
-  | Exp_seq (e0, e1) ->
+  | ESeq (e0, e1) ->
       let _e0_v, e0_stmts = trans_expr ctx e0 in
       let e1_v, e1_stmts = trans_expr ctx e1 in
       (e1_v, e0_stmts @ e1_stmts)
-  | Exp_struct _ -> ("todo", [])
+  | EStruct _ -> ("todo", [])
 
 and trans_const (c : S.constant) =
   match c with
-  | Const_bool b ->
+  | CBool b ->
       C.CALL (ff_make_bool, [ CONSTANT (CONST_INT (if b then "1" else "0")) ])
-  | Const_int i ->
-      C.CALL (ff_make_int, [ CONSTANT (CONST_INT (string_of_int i)) ])
-  | Const_string s ->
+  | CInt i -> C.CALL (ff_make_int, [ CONSTANT (CONST_INT (string_of_int i)) ])
+  | CString s ->
       C.CALL
         ( ff_make_str,
           [
             CONSTANT
               (CONST_STRING
                  (Scanf.unescaped (String.sub s 1 (String.length s - 2))));
           ] )
-  | Const_unit ->
-      C.CALL (ff_make_int, [ CONSTANT (CONST_INT (string_of_int 0)) ])
+  | CUnit -> C.CALL (ff_make_int, [ CONSTANT (CONST_INT (string_of_int 0)) ])
 
 and trans_switch res cond p e ctx =
   let match_seq, ctx = analyze_match_sequence cond p ctx in
@@ -368,16 +366,16 @@ and trans_switch res cond p e ctx =
 and analyze_match_sequence (cond_var : string) (p : pattern) ctx :
     match_operation list * context =
   match p with
-  | Pat_var x ->
+  | PVar x ->
       let x, ctx = create_var ~need_decl:true x ctx in
       ([ Bind C.(BINARY (ASSIGN, VARIABLE x, VARIABLE cond_var)) ], ctx)
-  | Pat_val c ->
+  | PVal c ->
       ( [
           CheckPat
             (C.CALL (ff_is_equal_aux, [ VARIABLE cond_var; trans_const c ]));
         ],
         ctx )
-  | Pat_constr (id, None) ->
+  | PCons (id, None) ->
       ( [
           CheckPat
             (C.CALL
@@ -387,7 +385,7 @@ and analyze_match_sequence (cond_var : string) (p : pattern) ctx :
                  ] ));
         ],
         ctx )
-  | Pat_constr (id, Some p) ->
+  | PCons (id, Some p) ->
       let pat_var = create_decl "pat_var" ctx in
       let check =
         CheckPat
@@ -401,7 +399,7 @@ and analyze_match_sequence (cond_var : string) (p : pattern) ctx :
       in
       let match_seq, ctx = analyze_match_sequence pat_var p ctx in
       (check :: match_seq, ctx)
-  | Pat_tuple ps ->
+  | PTuple ps ->
       let pat_vars =
         List.mapi
           (fun index _ -> create_decl (Printf.sprintf "tu_%dth" index) ctx)

lib/clos/closure.ml

@@ -5,31 +5,31 @@ module L = Lam.Tree
 type constant = T.constant [@@deriving sexp]
 
 type expr =
-  | Exp_tuple of expr list
-  | Exp_mod_obj of object_field list
+  | ETuple of expr list
+  | EModObject of object_field list
       (** 1. An object can cast to another when possible ;
           2. Field of an object is visible in the scope following its declaration. *)
-  | Exp_struct of (string * expr) list
-  | Exp_var of string
-  | Exp_external of string
-  | Exp_constr of int
-  | Exp_payload_constr of int
-  | Exp_const of constant
-  | Exp_app of expr * expr list
-  | Exp_switch of expr * branch list
-  | Exp_let of string * expr * expr
-  | Exp_if of expr * expr * expr
-  | Exp_closure of closure
-  | Exp_letrec of closure_rec * expr
-  | Exp_field of expr * string
-  | Exp_cmp of T.cmp_op * expr * expr
-  | Exp_seq of expr * expr
+  | EStruct of (string * expr) list
+  | EVar of string
+  | EExt of string
+  | ECons of int
+  | EConsWith of int
+  | EConst of constant
+  | EApp of expr * expr list
+  | ESwitch of expr * branch list
+  | ELet of string * expr * expr
+  | EIf of expr * expr * expr
+  | EClosure of closure
+  | ELetRec of closure_rec * expr
+  | EField of expr * string
+  | ECmp of T.cmp_op * expr * expr
+  | ESeq of expr * expr
 
 and pattern = L.pattern
 
 and object_field =
-  | Field_simple of string * expr
-  | Field_letrec of closure_rec
+  | FSimple of string * expr
+  | FLetRec of closure_rec
 
 and closure = string list * Ident.ident
 

lib/clos/lift.ml

@@ -4,27 +4,27 @@ module L = Lam.Tree
 let rec lift ?(hint = "temp") (e : L.expr) (vars : string list) :
     C.expr * C.func list =
   match e with
-  | L.Exp_tuple es ->
+  | L.ETuple es ->
       es
       |> List.map (fun e -> lift e vars ~hint)
       |> List.split
-      |> fun (es, fns) -> (C.Exp_tuple es, List.flatten fns)
-  | L.Exp_mod_obj mems ->
+      |> fun (es, fns) -> (C.ETuple es, List.flatten fns)
+  | L.EModObject mems ->
       let _, mems, fns =
         List.fold_left
           (fun (vars, mem_acc, fn_acc) mem ->
             match mem with
-            | L.Field_simple (x, e) ->
+            | L.FSimple (x, e) ->
                 let e, fns = lift ~hint:x e vars in
-                (x :: vars, C.Field_simple (x, e) :: mem_acc, fns @ fn_acc)
-            | L.Field_letrec binds ->
+                (x :: vars, C.FSimple (x, e) :: mem_acc, fns @ fn_acc)
+            | L.FLetRec binds ->
                 let xs, _ = List.split binds in
                 let binds, fns = lift_letrec binds vars in
-                (xs @ vars, C.Field_letrec binds :: mem_acc, fns @ fn_acc))
+                (xs @ vars, C.FLetRec binds :: mem_acc, fns @ fn_acc))
           (vars, [], []) mems
       in
-      (C.Exp_mod_obj (List.rev mems), fns)
-  | L.Exp_struct mems ->
+      (C.EModObject (List.rev mems), fns)
+  | L.EStruct mems ->
       let mems, fns =
         List.fold_left
           (fun (acc_mems, acc_fns) (name, e) ->
@@ -33,28 +33,28 @@ let rec lift ?(hint = "temp") (e : L.expr) (vars : string list) :
           ([], []) mems
       in
       let mems = List.rev mems in
-      (C.Exp_struct mems, fns)
-  | L.Exp_var x ->
+      (C.EStruct mems, fns)
+  | L.EVar x ->
       assert (List.mem x vars);
-      (C.Exp_var x, [])
-  | L.Exp_external x -> (C.Exp_external x, [])
-  | L.Exp_constr i -> (C.Exp_constr i, [])
-  | L.Exp_payload_constr i -> (C.Exp_payload_constr i, [])
-  | L.Exp_const c -> (C.Exp_const c, [])
-  | L.Exp_app (e0, e1s) ->
+      (C.EVar x, [])
+  | L.EExt x -> (C.EExt x, [])
+  | L.ECons i -> (C.ECons i, [])
+  | L.EConsWith i -> (C.EConsWith i, [])
+  | L.EConst c -> (C.EConst c, [])
+  | L.EApp (e0, e1s) ->
       let e0, fns0 = lift e0 vars in
       let e1s, fns1 = List.(split (map (fun e1 -> lift e1 vars) e1s)) in
       let fns1 = List.flatten fns1 in
-      (C.Exp_app (e0, e1s), fns0 @ fns1)
-  | L.Exp_cmp (op, e0, e1) ->
+      (C.EApp (e0, e1s), fns0 @ fns1)
+  | L.ECmp (op, e0, e1) ->
       let e0, fns0 = lift e0 vars in
       let e1, fns1 = lift e1 vars in
-      (C.Exp_cmp (op, e0, e1), fns0 @ fns1)
-  | L.Exp_seq (e0, e1) ->
+      (C.ECmp (op, e0, e1), fns0 @ fns1)
+  | L.ESeq (e0, e1) ->
       let e0, fns0 = lift e0 vars in
       let e1, fns1 = lift e1 vars in
-      (C.Exp_seq (e0, e1), fns0 @ fns1)
-  | L.Exp_switch (e0, bs) ->
+      (C.ESeq (e0, e1), fns0 @ fns1)
+  | L.ESwitch (e0, bs) ->
       let e0, fns0 = lift e0 vars in
       let es, fns1 =
         bs
@@ -64,29 +64,29 @@ let rec lift ?(hint = "temp") (e : L.expr) (vars : string list) :
         |> fun (e, fns) -> (e, List.flatten fns)
       in
       let ps, _ = List.split bs in
-      (C.Exp_switch (e0, List.combine ps es), fns0 @ fns1)
-  | L.Exp_let (x, e0, e1) ->
+      (C.ESwitch (e0, List.combine ps es), fns0 @ fns1)
+  | L.ELet (x, e0, e1) ->
       let e0, fns0 = lift ~hint:x e0 vars in
       let e1, fns1 = lift e1 (x :: vars) ~hint in
-      (C.Exp_let (x, e0, e1), fns0 @ fns1)
-  | L.Exp_if (e0, e1, e2) ->
+      (C.ELet (x, e0, e1), fns0 @ fns1)
+  | L.EIf (e0, e1, e2) ->
       let e0, fns0 = lift ~hint e0 vars in
       let e1, fns1 = lift ~hint e1 vars in
       let e2, fns2 = lift ~hint e2 vars in
-      (C.Exp_if (e0, e1, e2), fns0 @ fns1 @ fns2)
-  | L.Exp_lam (xs, e, fvs) ->
+      (C.EIf (e0, e1, e2), fns0 @ fns1 @ fns2)
+  | L.ELam (xs, e, fvs) ->
       let fn_id = Ident.create ~hint in
       let e', fns = lift e (xs @ vars) ~hint in
       let new_fn = (fn_id, !fvs, xs, e') in
-      (C.Exp_closure (!fvs, fn_id), new_fn :: fns)
-  | L.Exp_letrec (binds, e) ->
+      (C.EClosure (!fvs, fn_id), new_fn :: fns)
+  | L.ELetRec (binds, e) ->
       let xs, _ = List.split binds in
       let cls, fns = lift_letrec binds vars in
       let e, fns' = lift e (xs @ vars) ~hint in
-      (C.Exp_letrec (cls, e), fns' @ fns)
-  | L.Exp_field (e, name) ->
+      (C.ELetRec (cls, e), fns' @ fns)
+  | L.EField (e, name) ->
       let e', fns = lift e vars ~hint in
-      (C.Exp_field (e', name), fns)
+      (C.EField (e', name), fns)
 
 and lift_letrec binds vars =
   let xs = List.map fst binds in