clean up with better names

Author: bobzhang

bytecomp/lambda.ml

@@ -29,15 +29,15 @@ type loc_kind =
   | Loc_POS
 
 type tag_info = 
-  | Constructor of string
-  | Tuple
-  | Array
-  | Variant of string 
-  | Record of string array (* when its empty means we dont get such information *)
-  | Module of string list option
-  | NA
+  | Blk_constructor of string * int (* Number of non-const constructors*)
+  | Blk_tuple
+  | Blk_array
+  | Blk_variant of string 
+  | Blk_record of string array (* when its empty means we dont get such information *)
+  | Blk_module of string list option
+  | Blk_na
 
-let default_tag_info : tag_info = NA
+let default_tag_info : tag_info = Blk_na
 
 type field_dbg_info = 
   | Fld_na
@@ -188,11 +188,12 @@ and raise_kind =
   | Raise_notrace
 
 type pointer_info = 
-  | NullConstructor of string
-  | NullVariant of string 
-  | NAPointer 
+  | Pt_constructor of string
+  | Pt_variant of string 
+  | Pt_module_alias
+  | Pt_na
 
-let default_pointer_info = NAPointer
+let default_pointer_info = Pt_na
 
 type structured_constant =
     Const_base of constant
@@ -586,7 +587,7 @@ let lam_of_loc kind loc =
       loc_start.Lexing.pos_cnum + cnum in
   match kind with
   | Loc_POS ->
-    Lconst (Const_block (0, default_tag_info, [
+    Lconst (Const_block (0, Blk_tuple, [
           Const_immstring file;
           Const_base (Const_int lnum);
           Const_base (Const_int cnum);

bytecomp/lambda.mli

@@ -31,13 +31,13 @@ type loc_kind =
 
 
 type tag_info = 
-  | Constructor of string
-  | Tuple
-  | Array
-  | Variant of string 
-  | Record of string array
-  | Module of string list option
-  | NA
+  | Blk_constructor of string * int (* Number of non-const constructors*)
+  | Blk_tuple
+  | Blk_array
+  | Blk_variant of string 
+  | Blk_record of string array
+  | Blk_module of string list option
+  | Blk_na
 
 val default_tag_info : tag_info
 
@@ -51,9 +51,10 @@ type set_field_dbg_info =
   | Fld_record_set of string 
 
 type pointer_info = 
-  | NullConstructor of string
-  | NullVariant of string 
-  | NAPointer 
+  | Pt_constructor of string
+  | Pt_variant of string 
+  | Pt_module_alias
+  | Pt_na 
 
 val default_pointer_info : pointer_info
 

bytecomp/translclass.ml

@@ -48,9 +48,9 @@ let lfield v i = Lprim(Pfield (i, Fld_na), [Lvar v])
 let transl_label l = share (Const_immstring l)
 
 let transl_meth_list lst =
-  if lst = [] then Lconst (Const_pointer (0, Lambda.NAPointer)) else
+  if lst = [] then Lconst (Const_pointer (0, Lambda.Pt_na)) else
   share (Const_block
-            (0, Lambda.NA, List.map (fun lab -> Const_immstring lab) lst))
+            (0, Lambda.Blk_na, List.map (fun lab -> Const_immstring lab) lst))
 
 let set_inst_var obj id expr =
   let kind = if Typeopt.maybe_pointer expr then Paddrarray else Pintarray in
@@ -236,7 +236,7 @@ let output_methods tbl methods lam =
       lsequence (mkappl(oo_prim "set_method", [Lvar tbl; lab; code])) lam
   | _ ->
       lsequence (mkappl(oo_prim "set_methods",
-                        [Lvar tbl; Lprim(Pmakeblock(0, Lambda.Array, Immutable), methods)]))
+                        [Lvar tbl; Lprim(Pmakeblock(0, Lambda.Blk_array, Immutable), methods)]))
         lam
 
 let rec ignore_cstrs cl =
@@ -358,7 +358,7 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl =
           (inh_init,
            Llet (Strict, inh,
                  mkappl(oo_prim "inherits", narrow_args @
-                        [lpath; Lconst(Const_pointer ((if top then 1 else 0), Lambda.NAPointer))]),
+                        [lpath; Lconst(Const_pointer ((if top then 1 else 0), Lambda.Pt_na))]),
                  Llet(StrictOpt, obj_init, lfield inh 0, cl_init)))
       | _ ->
           let core cl_init =
@@ -503,7 +503,7 @@ let rec builtin_meths self env env2 body =
     | Lprim(Parrayrefu _, [Lvar s; Lvar n]) when List.mem s self ->
         "var", [Lvar n]
     | Lprim(Pfield (n,_), [Lvar e]) when Ident.same e env ->
-        "env", [Lvar env2; Lconst(Const_pointer (n, Lambda.NAPointer))]
+        "env", [Lvar env2; Lconst(Const_pointer (n, Lambda.Pt_na))]
     | Lsend(Self, met, Lvar s, [], _) when List.mem s self ->
         "meth", [met]
     | _ -> raise Not_found
@@ -574,7 +574,7 @@ module M = struct
     | "send_env"   -> SendEnv
     | "send_meth"  -> SendMeth
     | _ -> assert false
-    in Lconst(Const_pointer(Obj.magic tag, Lambda.NAPointer)) :: args
+    in Lconst(Const_pointer(Obj.magic tag, Lambda.Pt_na)) :: args
 end
 open M
 

bytecomp/translcore.ml

@@ -746,7 +746,7 @@ and transl_exp0 e =
                Matching.for_trywith (Lvar id) (transl_cases_try pat_expr_list))
   | Texp_tuple el ->
       let ll = transl_list el in
-      let tag_info = Lambda.Tuple in 
+      let tag_info = Lambda.Blk_tuple in 
       begin try
         Lconst(Const_block(0, tag_info, List.map extract_constant ll))
       with Not_constant ->
@@ -756,9 +756,9 @@ and transl_exp0 e =
       let ll = transl_list args in
       begin match cstr.cstr_tag with
         Cstr_constant n ->
-          Lconst(Const_pointer (n, Lambda.NullConstructor cstr.cstr_name))
+          Lconst(Const_pointer (n, Lambda.Pt_constructor cstr.cstr_name))
       | Cstr_block n ->
-          let tag_info = (Lambda.Constructor cstr.cstr_name) in
+          let tag_info = (Lambda.Blk_constructor (cstr.cstr_name, cstr.cstr_nonconsts)) in
           begin try
             Lconst(Const_block(n,tag_info, List.map extract_constant ll))
           with Not_constant ->
@@ -774,10 +774,10 @@ and transl_exp0 e =
   | Texp_variant(l, arg) ->
       let tag = Btype.hash_variant l in
       begin match arg with
-        None -> Lconst(Const_pointer (tag, Lambda.NullVariant l))
+        None -> Lconst(Const_pointer (tag, Lambda.Pt_variant l))
       | Some arg ->
           let lam = transl_exp arg in
-          let tag_info = Lambda.Variant l in
+          let tag_info = Lambda.Blk_variant l in
           try
             Lconst(Const_block(0, tag_info, [Const_base(Const_int tag);
                                    extract_constant lam]))
@@ -811,7 +811,7 @@ and transl_exp0 e =
         let master =
           match kind with
           | Paddrarray | Pintarray ->
-              Lconst(Const_block(0, Lambda.Array, cl)) (* ATTENTION: ? [|1;2;3;4|]*)
+              Lconst(Const_block(0, Lambda.Blk_array, cl)) (* ATTENTION: ? [|1;2;3;4|]*)
           | Pfloatarray ->
               Lconst(Const_float_array(List.map extract_float cl))
           | Pgenarray ->
@@ -1116,12 +1116,12 @@ and transl_record all_labels repres lbl_expr_list opt_init_expr =
         if mut = Mutable then raise Not_constant;
         let cl = List.map extract_constant ll in
         match repres with
-          Record_regular -> Lconst(Const_block(0, Lambda.Record all_labels_info, cl))
+          Record_regular -> Lconst(Const_block(0, Lambda.Blk_record all_labels_info, cl))
         | Record_float ->
             Lconst(Const_float_array(List.map extract_float cl))
       with Not_constant ->
         match repres with
-          Record_regular -> Lprim(Pmakeblock(0, Lambda.Record all_labels_info, mut), ll)
+          Record_regular -> Lprim(Pmakeblock(0, Lambda.Blk_record all_labels_info, mut), ll)
         | Record_float -> Lprim(Pmakearray Pfloatarray, ll) in
     begin match opt_init_expr with
       None -> lam

bytecomp/translmod.ml

@@ -203,7 +203,7 @@ let init_shape modl =
       Mty_ident _ ->
         raise Not_found
     | Mty_alias _ ->
-        Const_block (1, Lambda.default_tag_info, [Const_pointer (0, Lambda.default_pointer_info)])
+        Const_block (1, Lambda.default_tag_info, [Const_pointer (0, Lambda.Pt_module_alias)])
     | Mty_signature sg ->
         Const_block(0,  Lambda.default_tag_info, [Const_block(0, Lambda.default_tag_info, init_shape_struct env sg)])
     | Mty_functor(id, arg, res) ->
@@ -379,7 +379,7 @@ and transl_structure fields cc rootpath = function
         Tcoerce_none ->
           let fields =  List.rev fields in
           let field_names = List.map (fun id -> id.Ident.name) fields in
-          Lprim(Pmakeblock(0, Lambda.Module (Some field_names) , Immutable),
+          Lprim(Pmakeblock(0, Lambda.Blk_module (Some field_names) , Immutable),
                 List.fold_right (fun id acc -> begin
                       (if is_top rootpath then 
                          export_identifiers :=  id :: !export_identifiers);
@@ -408,7 +408,7 @@ and transl_structure fields cc rootpath = function
                  end)
               pos_cc_list ([], [])in 
           let lam =
-            (Lprim(Pmakeblock(0, Module (Some names), Immutable),
+            (Lprim(Pmakeblock(0, Blk_module (Some names), Immutable),
                    result))
           and id_pos_list =
             List.filter (fun (id,_,_) -> not (IdentSet.mem id ids)) id_pos_list

stdlib/target_camlheader

@@ -0,0 +1 @@
+#!/Users/hongbozhang/.opam/4.02.3+local-git-master/bin/ocamlrun

stdlib/target_camlheaderd

@@ -0,0 +1 @@
+#!/Users/hongbozhang/.opam/4.02.3+local-git-master/bin/ocamlrund