From b3c4c1426a54d3dfbfae9ab4e54d18875d01885e Mon Sep 17 00:00:00 2001
From: Patrick Walton <pcwalton@mimiga.net>
Date: Wed, 27 Oct 2010 11:28:26 -0700
Subject: rustboot: Emit an error message instead of asserting on a type-param
 mismatch in tag constructors in patterns

---
 src/boot/me/resolve.ml |  4 ++--
 src/boot/me/semant.ml  | 12 ++++++++----
 2 files changed, 10 insertions(+), 6 deletions(-)

(limited to 'src')

diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index be76bd30..fa5dcc06 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -768,12 +768,12 @@ let pattern_resolving_visitor
       end
   in
 
-  let resolve_arm { node = arm; id = _ } =
+  let resolve_arm { node = arm; id = id } =
     match fst arm with
         Ast.PAT_tag (lval, pats) ->
           let lval_nm = lval_to_name lval in
           let lval_id = lval_base_id lval in
-          let tag_ctor_id = (lval_item cx lval).id in
+          let tag_ctor_id = (lval_item ~node_id:id cx lval).id in
             if defn_id_is_item cx tag_ctor_id
 
             (* FIXME (issue #76): we should actually check here that the
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index e77f9754..1eb88ab1 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -1406,7 +1406,7 @@ let exports_permit (view:Ast.mod_view) (ident:Ast.ident) : bool =
 ;;
 
 (* NB: this will fail if lval is not an item. *)
-let rec lval_item (cx:ctxt) (lval:Ast.lval) : Ast.mod_item =
+let rec lval_item ?node_id:node_id (cx:ctxt) (lval:Ast.lval) : Ast.mod_item =
   match lval with
       Ast.LVAL_base _ ->
         let defn_id = lval_base_defn_id cx lval in
@@ -1429,9 +1429,13 @@ let rec lval_item (cx:ctxt) (lval:Ast.lval) : Ast.mod_item =
                 in
                   match htab_search items i with
                     | Some sub when exports_permit view i ->
-                        assert
-                          ((Array.length sub.node.Ast.decl_params) =
-                              (Array.length args));
+                        if Array.length sub.node.Ast.decl_params !=
+                            (Array.length args) then
+                          err node_id
+                            "%a has %d type-params but %d given"
+                            Ast.sprintf_mod_item ("", sub)
+                            (Array.length sub.node.Ast.decl_params)
+                            (Array.length args);
                         check_concrete base_item.node.Ast.decl_params sub
                     | _ -> err (Some (lval_base_id lval))
                         "unknown module item '%s'" i
-- 
cgit v1.2.3