From 5a07e98c5d8f61ff5d1efd28c36337a30d6e86d6 Mon Sep 17 00:00:00 2001 From: Roy Frostig Date: Thu, 1 Jul 2010 00:09:11 -0700 Subject: [PATCH] Fix two bugs in tag patterns: 1. Look up the tag constructor function item using lval_item, not lval_to_referent; 2. Correct the form of the name used to query the tag or iso ty_tag when obtaining the corresponding type tuple. --- src/boot/me/resolve.ml | 2 +- src/boot/me/semant.ml | 18 +++++++++--------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml index 1f563c76c63..cafb69b171e 100644 --- a/src/boot/me/resolve.ml +++ b/src/boot/me/resolve.ml @@ -930,7 +930,7 @@ let pattern_resolving_visitor 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_to_referent cx lval_id in + let tag_ctor_id = (lval_item cx lval).id in if referent_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 5160429ef50..95a5c792019 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -416,15 +416,15 @@ let fn_output_ty (fn_ty:Ast.ty) : Ast.ty = (* name of tag constructor function -> name for indexing in the ty_tag *) let rec tag_ctor_name_to_tag_name (name:Ast.name) : Ast.name = match name with - Ast.NAME_base nb -> - begin - match nb with - Ast.BASE_ident _ -> name - | Ast.BASE_app (id, _) -> Ast.NAME_base (Ast.BASE_ident id) - | _ -> - bug () "tag_or_iso_ty_tup_by_name with non-tag-ctor name" - end - | Ast.NAME_ext (inner_name, _) -> tag_ctor_name_to_tag_name inner_name + Ast.NAME_base (Ast.BASE_ident _) -> name + | Ast.NAME_base (Ast.BASE_app (id, _)) -> + Ast.NAME_base (Ast.BASE_ident id) + + | Ast.NAME_ext (_, Ast.COMP_ident id) + | Ast.NAME_ext (_, Ast.COMP_app (id, _)) -> + Ast.NAME_base (Ast.BASE_ident id) + + | _ -> bug () "tag_or_iso_ty_tup_by_name with non-tag-ctor name" ;; let tag_or_iso_ty_tup_by_name (ty:Ast.ty) (name:Ast.name) : Ast.ty_tup =