Bind pattern slots with ?, drop parens from 0-ary tag constructors, translate 0-ary constructors as constants. Rustc loses ~300kb.

9 files changed, 85 insertions, 38 deletions

diff --git a/src/boot/be/il.ml b/src/boot/be/il.ml
index 2a5b643a..0e13b4c0 100644
--- a/src/boot/be/il.ml
+++ b/src/boot/be/il.ml
@@ -128,7 +128,9 @@ let mem_off (mem:mem) (off:Asm.expr64) : mem =
         Abs e -> Abs (addto e)
       | RegIn (r, None) -> RegIn (r, Some off)
       | RegIn (r, Some e) -> RegIn (r, Some (addto e))
-      | Spill _ -> bug () "Adding offset to spill slot"
+      | Spill _ ->
+          bug () "Adding offset %s to spill slot"
+            (Asm.string_of_expr64 off)
 ;;
 
 let mem_off_imm (mem:mem) (imm:int64) : mem =
diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml
index c747713b..4173eb53 100644
--- a/src/boot/fe/item.ml
+++ b/src/boot/fe/item.ml
@@ -255,12 +255,11 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
           bump ps;
           let rec parse_pat ps  =
             match peek ps with
-                IDENT _ ->
+                QUES ->
                   let apos = lexpos ps in
-                  let name = Pexp.parse_name ps in
-                  let bpos = lexpos ps in
-
-                    if peek ps != LPAREN then
+                    bump ps;
+                    let name = Pexp.parse_name ps in
+                    let bpos = lexpos ps in
                       begin
                         match name with
                             Ast.NAME_base (Ast.BASE_ident ident) ->
@@ -273,11 +272,19 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
                                                  ident))
                           |_ -> raise (unexpected ps)
                       end
-                    else
-                      let lv = name_to_lval apos bpos name in
-                      let parse_pat ps = either_get_left (parse_pat ps) in
-                        Left
-                          (Ast.PAT_tag (lv, paren_comma_list parse_pat ps))
+
+              | IDENT _ ->
+                  let apos = lexpos ps in
+                  let name = Pexp.parse_name ps in
+                  let bpos = lexpos ps in
+                  let lv = name_to_lval apos bpos name in
+                  let parse_pat ps = either_get_left (parse_pat ps) in
+                  let args =
+                    match peek ps with
+                        LPAREN -> paren_comma_list parse_pat ps
+                      | _ -> [| |]
+                  in
+                    Left (Ast.PAT_tag (lv, args))
 
               | LIT_INT _
               | LIT_UINT _
@@ -874,9 +881,16 @@ and parse_tag_item
           incr j;
           ((span ps apos bpos s), "_" ^ string_of_int (!j))
       in
-      let res = match peek ps with
-              LPAREN -> paren_comma_list parse_ctor_slot ps
-        | _ -> raise (err "tag variant missing argument list" ps)
+      let res =
+        match peek ps with
+            LPAREN ->
+              let slots = paren_comma_list parse_ctor_slot ps in
+                if Array.length slots = 0
+                then
+                  raise (err ("empty argument list to tag constructor") ps)
+                else slots
+
+          | _ -> [| |]
       in
         expect ps SEMI;
         res
diff --git a/src/boot/fe/lexer.mll b/src/boot/fe/lexer.mll
index 58b27ec1..763b50c9 100644
--- a/src/boot/fe/lexer.mll
+++ b/src/boot/fe/lexer.mll
@@ -244,6 +244,7 @@ rule token = parse
 | ','                          { COMMA      }
 | ';'                          { SEMI       }
 | ':'                          { COLON      }
+| '?'                          { QUES       }
 | "<-"                         { LARROW     }
 | "<|"                         { SEND       }
 | "->"                         { RARROW     }
diff --git a/src/boot/fe/token.ml b/src/boot/fe/token.ml
index e6f8cd4b..85dd2a13 100644
--- a/src/boot/fe/token.ml
+++ b/src/boot/fe/token.ml
@@ -33,6 +33,7 @@ type token =
   | COMMA
   | SEMI
   | COLON
+  | QUES
   | RARROW
   | SEND
   | LARROW
@@ -187,6 +188,7 @@ let rec string_of_tok t =
     | COMMA      -> ","
     | SEMI       -> ";"
     | COLON      -> ":"
+    | QUES       -> "?"
     | RARROW     -> "->"
     | SEND       -> "<|"
     | LARROW     -> "<-"
diff --git a/src/boot/me/layout.ml b/src/boot/me/layout.ml
index 65d44d5a..0b994145 100644
--- a/src/boot/me/layout.ml
+++ b/src/boot/me/layout.ml
@@ -296,7 +296,7 @@ let layout_visitor
             layout_header i.id
               (header_slot_ids f.Ast.fn_input_slots)
 
-        | Ast.MOD_ITEM_tag (hdr, _, _) ->
+        | Ast.MOD_ITEM_tag (hdr, _, _) when Array.length hdr <> 0 ->
             enter_frame i.id;
             layout_header i.id
               (header_slot_ids hdr)
@@ -319,8 +319,9 @@ let layout_visitor
     begin
       match i.node.Ast.decl_item with
           Ast.MOD_ITEM_fn _
-        | Ast.MOD_ITEM_tag _
         | Ast.MOD_ITEM_obj _ -> leave_frame ()
+        | Ast.MOD_ITEM_tag (hdr, _, _) when Array.length hdr <> 0 ->
+            leave_frame()
         | _ -> ()
     end
   in
diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index cb40dfc9..b5d7d65f 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -722,7 +722,9 @@ let pattern_resolving_visitor
      * asking for its arity, it doesn't matter that the possibly parametric
      * tag type has its parameters unbound here. *)
     let tag_ty =
-      fn_output_ty (Hashtbl.find cx.ctxt_all_item_types tag_ctor_id)
+      match Hashtbl.find cx.ctxt_all_item_types tag_ctor_id with
+          Ast.TY_tag t -> Ast.TY_tag t
+        | ft -> fn_output_ty ft
     in
       begin
         match tag_ty with
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 0d350bc5..fd7d2709 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -1483,23 +1483,29 @@ let ty_of_mod_item (item:Ast.mod_item) : Ast.ty =
           (Ast.TY_fn (tsig, taux))
 
     | Ast.MOD_ITEM_tag (hdr, tid, _) ->
-        let taux = { Ast.fn_effect = Ast.PURE;
-                     Ast.fn_is_iter = false }
-        in
-        let inputs = Array.map (fun (s, _) -> s.node) hdr in
         let args =
           Array.map
             (fun p -> Ast.TY_param (snd p.node))
             item.node.Ast.decl_params
         in
-        let tsig = { Ast.sig_input_slots = inputs;
-                     Ast.sig_input_constrs = [| |];
-                     Ast.sig_output_slot =
-            local_slot
-              (Ast.TY_tag { Ast.tag_id = tid;
-                            Ast.tag_args = args } ) }
+        let ttag =
+          { Ast.tag_id = tid;
+            Ast.tag_args = args }
         in
-          (Ast.TY_fn (tsig, taux))
+          if Array.length hdr = 0
+          then Ast.TY_tag ttag
+          else
+            let taux = { Ast.fn_effect = Ast.PURE;
+                         Ast.fn_is_iter = false }
+            in
+            let inputs = Array.map (fun (s, _) -> s.node) hdr in
+            let tsig = { Ast.sig_input_slots = inputs;
+                         Ast.sig_input_constrs = [| |];
+                         Ast.sig_output_slot =
+                local_slot
+                  (Ast.TY_tag ttag ) }
+            in
+              (Ast.TY_fn (tsig, taux))
 ;;
 
 (* Scopes and the visitor that builds them. *)
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index e1b96243..ba0c4771 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -1054,10 +1054,14 @@ let trans_visitor
       : (Ast.ty * const) =
     assert (lval_base_is_item cx lv);
     let item = lval_item cx lv in
-      check_concrete item.node.Ast.decl_params ();
       match item.node.Ast.decl_item with
           Ast.MOD_ITEM_const (_, Some e) -> trans_const_expr e
 
+        | Ast.MOD_ITEM_tag (hdr, _, i) when Array.length hdr = 0 ->
+            (lval_ty cx lv,
+             CONST_frag (Asm.WORD (word_ty_mach,
+                                   Asm.IMM (Int64.of_int i))))
+
         | _ -> bug ()
             "trans_const_lval called on unsupported item lval '%a'"
               Ast.sprintf_lval lv
@@ -1069,9 +1073,8 @@ let trans_visitor
     match trans_const_lval lv with
 
         (ty, CONST_val v) ->
-          let f tm =
-            (Il.Reg (force_to_reg (imm_of_ty v tm)), ty)
-          in
+          let r tm = Il.Reg (force_to_reg (imm_of_ty v tm)) in
+          let f tm = (r tm, ty) in
             begin
               match ty with
                   Ast.TY_mach tm -> f tm
@@ -1080,6 +1083,7 @@ let trans_visitor
                 | Ast.TY_bool -> f TY_u8
                 | Ast.TY_char -> f TY_u32
                 | Ast.TY_nil -> (nil_ptr, ty)
+
                 | _ -> bug ()
                     "trans_lval_item on %a: unexpected type %a"
                       Ast.sprintf_lval lv Ast.sprintf_ty ty
@@ -1087,11 +1091,14 @@ let trans_visitor
 
       | (ty, CONST_frag f) ->
           let item = lval_item cx lv in
-            (crate_rel_to_ptr
-               (trans_crate_rel_data_operand
-                  (DATA_const item.id)
-                  (fun _ -> f))
-               (referent_type cx ty), ty)
+          let ptr =
+            crate_rel_to_ptr
+              (trans_crate_rel_data_operand
+                 (DATA_const item.id)
+                 (fun _ -> f))
+              (referent_type cx ty)
+          in
+            (deref ptr, ty)
 
   and trans_lval_full
       (initializing:bool)
@@ -5430,7 +5437,7 @@ let trans_visitor
             "Trans.required_rust_fn on unexpected form of require library"
   in
 
-  let trans_tag
+  let trans_tag_fn
       (n:Ast.ident)
       (tagid:node_id)
       (tag:(Ast.header_slots * opaque_id * int))
@@ -5473,6 +5480,16 @@ let trans_visitor
       trans_frame_exit tagid true;
   in
 
+  let trans_tag
+      (n:Ast.ident)
+      (tagid:node_id)
+      (tag:(Ast.header_slots * opaque_id * int))
+      : unit =
+    let (header_tup, _, _) = tag in
+      if Array.length header_tup <> 0
+      then trans_tag_fn n tagid tag
+  in
+
   let enter_file_for id =
     if Hashtbl.mem cx.ctxt_item_files id
     then Stack.push id curr_file
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index 2b613cba..2e275537 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -711,6 +711,8 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
             match constr_ty with
                 Ast.TY_fn (ty_sig, _) ->
                   Array.map get_slot_ty ty_sig.Ast.sig_input_slots
+              | Ast.TY_tag _ ->
+                  [||]
               | _ -> type_error "constructor function" constr_ty
           in
           Common.arr_iter2 check_pat arg_tys arg_pats