specialize Pt_assertfalse

Author: bobzhang

bytecomp/lambda.ml

@@ -252,11 +252,12 @@ and raise_kind =
  | Raise_notrace
 
 type pointer_info = 
- | Pt_constructor of {name : string; cstrs : int * int }
+ | Pt_constructor of {name : string; const : int ; non_const : int }
  | Pt_variant of {name : string}
  | Pt_module_alias 
  | Pt_builtin_boolean 
  | Pt_shape_none 
+ | Pt_assertfalse
  | Pt_na 
 
 
@@ -366,9 +367,9 @@ type program =
  not necessary "()", it can be used as a place holder for module 
  alias etc.
 *)
-let const_unit = Const_pointer(0, Pt_constructor{name = "()"; cstrs = 1, 0})
+let const_unit = Const_pointer(0, Pt_constructor{name = "()"; const = 1; non_const = 0})
 
-let lambda_assert_false = Lconst (Const_pointer(0, Pt_constructor {name = "assert false"; cstrs = (1,0)})) 
+let lambda_assert_false = Lconst (Const_pointer(0, Pt_assertfalse)) 
 
 let lambda_module_alias = Lconst (Const_pointer(0, Pt_module_alias)) 
 

bytecomp/lambda.mli

@@ -136,11 +136,12 @@ type is_safe =
  | Unsafe
 
 type pointer_info = 
- | Pt_constructor of {name : string; cstrs : int * int} 
+ | Pt_constructor of {name : string; const : int ; non_const :  int} 
  | Pt_variant of {name : string}
  | Pt_module_alias 
  | Pt_builtin_boolean
  | Pt_shape_none 
+ | Pt_assertfalse
  | Pt_na 
 
 

bytecomp/translcore.ml

@@ -1128,7 +1128,7 @@ and transl_exp0 e =
  | Longident.Lident "None"
  when Datarepr.constructor_has_optional_shape cstr
  -> Pt_shape_none
- | _ -> (Lambda.Pt_constructor {name = cstr.cstr_name; cstrs = cstr.cstr_consts,cstr.cstr_nonconsts}) 
+ | _ -> Pt_constructor {name = cstr.cstr_name; const = cstr.cstr_consts; non_const = cstr.cstr_nonconsts} 
  ))
  | Cstr_unboxed ->
  (match ll with [v] -> v | _ -> assert false)

bytecomp/translmod.ml

@@ -233,7 +233,8 @@ let undefined_location loc =
  [Const_base(Const_string (fname, None));
  Const_base(Const_int line);
  Const_base(Const_int char)]))
-let cstrs = (3,2) 
+let cstr_const = 3 
+let cstr_non_const = 2
 let init_shape modl =
  let add_name x id =
  if !Config.bs_only then
@@ -258,9 +259,9 @@ let init_shape modl =
  let init_v =
  match Ctype.expand_head env ty with
  {desc = Tarrow(_,_,_,_)} ->
- Const_pointer (0, Pt_constructor{name = "Function"; cstrs})
+ Const_pointer (0, Pt_constructor{name = "Function"; const = cstr_const; non_const = cstr_non_const})
  | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t ->
- Const_pointer (1, Pt_constructor{name = "Lazy"; cstrs}) 
+ Const_pointer (1, Pt_constructor{name = "Lazy"; const = cstr_const; non_const = cstr_non_const}) 
  | _ -> raise Not_found in
  (add_name init_v id) :: init_shape_struct env rem
  | Sig_value(_, {val_kind=Val_prim _}) :: rem ->
@@ -278,7 +279,7 @@ let init_shape modl =
  | Sig_modtype(id, minfo) :: rem ->
  init_shape_struct (Env.add_modtype id minfo env) rem
  | Sig_class (id,_,_) :: rem ->
- (add_name (Const_pointer (2, Pt_constructor{name = "Class";cstrs})) id)
+ (add_name (Const_pointer (2, Pt_constructor{name = "Class";const = cstr_const; non_const = cstr_non_const})) id)
  :: init_shape_struct env rem
  | Sig_class_type _ :: rem ->
  init_shape_struct env rem