Merge pull request #4421 from BuckleScript/bump

list special handling

Author: bobzhang

jscomp/core/js_dump.ml

@@ -853,9 +853,15 @@ and expression_desc cxt ~(level:int) f x : cxt  =
       pp_comment_option f (Some p.name);
     expression_desc cxt ~level f (Object objs)  
   | Caml_block(el,_,tag, (Blk_constructor p)) -> 
+    let is_cons = p.name = Literals.cons in   
     let objs =     
       let tails =   
-        Ext_list.mapi_append el (fun i e -> "_" ^ string_of_int i , e )
+        Ext_list.mapi_append el (fun i e -> 
+          (match is_cons, i with 
+          | true,  0 -> Literals.hd
+          | true,  1 -> Literals.tl 
+          | _ ->
+            "_" ^ string_of_int i) , e )
           (if !Js_config.debug then 
              ["NAME", E.str p.name]
            else []) in         
@@ -865,7 +871,8 @@ and expression_desc cxt ~(level:int) f x : cxt  =
         (L.tag,
           if !Js_config.debug then tag else {tag with comment = Some p.name}) :: tails
     in 
-    if p.num_nonconst = 1 && not !Js_config.debug then 
+    if p.num_nonconst = 1 && not !Js_config.debug 
+      && not is_cons then 
       pp_comment_option f (Some p.name);
     expression_desc cxt ~level f (Object objs)
   | Caml_block ( _, _, _, (Blk_module_export | Blk_na _ )) -> assert false

jscomp/core/js_exp_make.ml

@@ -374,6 +374,16 @@ let record_access (e : t) (name : string) (pos : int32) =
 (* The same as {!record_access} except tag*)
 let inline_record_access = record_access
 
+let variant_access (e : t)  (pos : int32) =  
+  inline_record_access e ("_" ^ Int32.to_string pos) pos
+  
+let cons_access (e : t) (pos : int32) = 
+  inline_record_access e  
+    (match pos with 
+     | 0l ->  Literals.hd 
+     | 1l ->  Literals.tl 
+     | _ ->  ("_" ^ Int32.to_string pos)) pos 
+
 let poly_var_tag_access (e : t)  = 
   match e.expression_desc with
   | Caml_block (l,_, _, _) when no_side_effect e

jscomp/core/js_exp_make.mli

@@ -194,6 +194,15 @@ val inline_record_access :
   Int32.t -> 
   t 
 
+val variant_access : 
+  t -> 
+  int32 -> 
+  t 
+
+val cons_access : 
+  t -> 
+  int32 -> 
+  t 
 
 val extension_access : 
   t ->

jscomp/core/js_of_lam_block.ml

@@ -65,10 +65,10 @@ let field (field_info : Lam_compat.field_dbg_info) e (i : int32) =
     E.extension_access e (Some name) i
   | Fld_extension -> 
     E.extension_access e  None i    
-  | Fld_variant  
-    -> 
-    E.inline_record_access e 
-      ("_" ^ Int32.to_string i) i 
+  | Fld_variant ->
+    E.variant_access e i  
+  | Fld_cons -> 
+    E.cons_access e i 
   | Fld_record_inline {name}
     -> E.inline_record_access e name i      
   | Fld_record {name}

jscomp/core/lam_compat.ml

@@ -129,6 +129,7 @@ type field_dbg_info = Lambda.field_dbg_info =
   | Fld_poly_var_content
   | Fld_extension
   | Fld_variant
+  | Fld_cons
   | Fld_array 
 
 let str_of_field_info (x : field_dbg_info) : string option =  
@@ -137,6 +138,7 @@ let str_of_field_info (x : field_dbg_info) : string option =
   | Fld_array
   | Fld_extension
   | Fld_variant
+  | Fld_cons
   | Fld_poly_var_tag 
   | Fld_poly_var_content
   | Fld_tuple 

jscomp/core/lam_compat.mli

@@ -67,6 +67,7 @@ type field_dbg_info = Lambda.field_dbg_info =
   | Fld_poly_var_content
   | Fld_extension 
   | Fld_variant
+  | Fld_cons
   | Fld_array
 
 val str_of_field_info : 

jscomp/core/lam_compile.ml

@@ -391,7 +391,13 @@ and compile_recursive_let ~all_bindings
               (match tag_info with 
               | Blk_record xs -> Fld_record_set xs.(i)
               | Blk_record_inlined xs -> Fld_record_inline_set xs.fields.(i)
-              | Blk_constructor _ -> Fld_record_inline_set ("_" ^ string_of_int i)
+              | Blk_constructor p -> 
+                let is_cons = p.name = Literals.cons in 
+                begin match is_cons,i with
+                | true, 0 -> Fld_record_inline_set Literals.hd
+                | true, 1 -> Fld_record_inline_set Literals.tl
+                | _, _ ->  Fld_record_inline_set ("_" ^ string_of_int i)
+                end
               | _ -> assert false) (E.var id)  (Int32.of_int i)                    
                 (match x with 
                  | Lvar lid  -> E.var lid

jscomp/ext/literals.ml

@@ -142,4 +142,8 @@ let ns_sep = "-"
 let exception_id = "RE_EXN_ID"
 
 let polyvar_hash = "HASH"
-let polyvar_value = "value"
+let polyvar_value = "value"
+
+let cons = "::"
+let hd = "hd"
+let tl = "tl"

jscomp/ext/literals.mli

@@ -140,4 +140,8 @@ val ns_sep : string
 val exception_id : string
 
 val polyvar_hash : string
-val polyvar_value : string
+val polyvar_value : string
+
+val cons : string
+val hd : string
+val tl : string