rustboot: Say exactly which name was unbound when reporting unbound name errors

4 files changed, 73 insertions, 52 deletions

diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml
index 238e3e5b..3d52f23a 100644
--- a/src/boot/me/effect.ml
+++ b/src/boot/me/effect.ml
@@ -273,8 +273,8 @@ let process_crate
   let root_scope = [ SCOPE_crate crate ] in
   let auth_effect name eff =
     match lookup_by_name cx [] root_scope name with
-        None -> ()
-      | Some (_, id) ->
+        RES_failed _ -> ()
+      | RES_ok (_, id) ->
           if defn_id_is_item cx id
           then htab_put item_auth id eff
           else err (Some id) "auth clause in crate refers to non-item"
diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index fa5dcc06..ed8011c3 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -228,6 +228,13 @@ let all_item_collecting_visitor
         Walk.visit_stmt_pre = visit_stmt_pre; }
 ;;
 
+let report_error (full_name:Ast.name) (unbound_name:Ast.name) =
+  if full_name = unbound_name then
+    err None "unbound name '%a'" Ast.sprintf_name full_name
+  else
+    err None "unbound name '%a' in name '%a'" Ast.sprintf_name unbound_name
+      Ast.sprintf_name full_name
+;;
 
 let lookup_type_node_by_name
     (cx:ctxt)
@@ -238,8 +245,8 @@ let lookup_type_node_by_name
               log cx "lookup_simple_type_by_name %a"
                 Ast.sprintf_name name);
   match lookup_by_name cx [] scopes name with
-      None -> err None "unknown name: %a" Ast.sprintf_name name
-    | Some (_, id) ->
+      RES_failed name' -> report_error name name'
+    | RES_ok (_, id) ->
         match htab_search cx.ctxt_all_defns id with
             Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type _;
                               Ast.decl_params = _ })
@@ -274,8 +281,8 @@ let rec lookup_type_by_name
               log cx "+++ lookup_type_by_name %a"
                 Ast.sprintf_name name);
   match lookup_by_name cx [] scopes name with
-      None -> err None "unknown name: %a" Ast.sprintf_name name
-    | Some (scopes', id) ->
+      RES_failed name' -> report_error name name'
+    | RES_ok (scopes', id) ->
         let ty, params =
           match htab_search cx.ctxt_all_defns id with
               Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type (_, t);
@@ -614,17 +621,17 @@ let lval_base_resolving_visitor
   let lookup_defn_by_ident id ident =
     log cx "looking up slot or item with ident '%s'" ident;
     match lookup cx (!scopes) (Ast.KEY_ident ident) with
-        None -> err (Some id) "unresolved identifier '%s'" ident
-      | Some (_, id) -> (log cx "resolved to node id #%d"
+        RES_failed _ -> err (Some id) "unresolved identifier '%s'" ident
+      | RES_ok (_, id) -> (log cx "resolved to node id #%d"
                            (int_of_node id); id)
   in
   let lookup_slot_by_temp id temp =
     log cx "looking up temp slot #%d" (int_of_temp temp);
     let res = lookup cx (!scopes) (Ast.KEY_temp temp) in
       match res with
-          None -> err
+          RES_failed _ -> err
             (Some id) "unresolved temp node #%d" (int_of_temp temp)
-        | Some (_, id) ->
+        | RES_ok (_, id) ->
             (log cx "resolved to node id #%d" (int_of_node id); id)
   in
   let lookup_defn_by_name_base id nb =
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index f7ad923e..56c52a3c 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -1950,7 +1950,13 @@ visitor =
 
 (* Generic lookup, used for slots, items, types, etc. *)
 
-type resolved = ((scope list * node_id) option) ;;
+type resolved =
+    RES_ok of scope list * node_id
+  | RES_failed of Ast.name
+;;
+
+let no_such_ident ident = RES_failed (Ast.NAME_base (Ast.BASE_ident ident))
+let no_such_temp temp = RES_failed (Ast.NAME_base (Ast.BASE_temp temp))
 
 let get_mod_item
     (cx:ctxt)
@@ -2000,20 +2006,20 @@ let rec project_ident_from_items
   in
 
   if not (inside || (exports_permit view ident))
-  then None
+  then no_such_ident ident
   else
     match htab_search items ident with
         Some i ->
           found cx scopes i.id
       | None ->
           match htab_search view.Ast.view_imports ident with
-              None -> None
+              None -> no_such_ident ident
             | Some name ->
                 lookup_by_name cx lchk scopes name
 
 and found cx scopes id =
   Hashtbl.replace cx.ctxt_node_referenced id ();
-  Some (scopes, id)
+  RES_ok (scopes, id)
 
 and project_name_comp_from_resolved
     (cx:ctxt)
@@ -2022,8 +2028,8 @@ and project_name_comp_from_resolved
     (ext:Ast.name_component)
     : resolved =
   match mod_res with
-      None -> None
-    | Some (scopes, id) ->
+      RES_failed _ -> mod_res
+    | RES_ok (scopes, id) ->
         let scope = (SCOPE_mod_item {id=id; node=get_item cx id}) in
         let scopes = scope :: scopes in
         let ident = get_name_comp_ident ext in
@@ -2054,27 +2060,37 @@ and lookup_by_ident
     : resolved =
 
   let check_slots scopes islots =
-    arr_search islots
-      (fun _ (sloti,ident') ->
-         if ident = ident'
-         then found cx scopes sloti.id
-         else None)
+    let rec search i =
+      if i == (Array.length islots) then
+        no_such_ident ident
+      else
+        let (sloti, ident') = islots.(i) in
+        if ident = ident'
+        then found cx scopes sloti.id
+        else search (i + 1)
+    in
+    search 0
   in
 
   let check_params scopes params =
-    arr_search params
-      (fun _ {node=(i,_); id=id} ->
-         if i = ident
-         then found cx scopes id
-         else None)
+    let rec search i =
+      if i == (Array.length params) then
+        no_such_ident ident
+      else
+        let { node = (ident', _); id = id } = params.(i) in
+        if ident = ident'
+        then found cx scopes id
+        else search (i + 1)
+    in
+    search 0
   in
 
   let passed_capture_scope = ref false in
 
   let would_capture r =
     match r with
-        None -> None
-      | Some _ ->
+        RES_failed _ -> r
+      | RES_ok _ ->
           if !passed_capture_scope
           then err None "attempted dynamic environment-capture"
           else r
@@ -2091,7 +2107,7 @@ and lookup_by_ident
                 | None ->
                     match htab_search block_items ident with
                         Some id -> found cx scopes id
-                      | None -> None
+                      | None -> no_such_ident ident
             end
 
       | SCOPE_crate crate ->
@@ -2115,21 +2131,21 @@ and lookup_by_ident
                     project_ident_from_items cx lchk
                       scopes item.id md ident true
 
-                | _ -> None
+                | _ -> no_such_ident ident
             in
               match item_match with
-                  Some _ -> item_match
-                | None ->
+                  RES_ok _ -> item_match
+                | RES_failed _ ->
                     would_capture
                       (check_params scopes item.node.Ast.decl_params)
           end
   in
   let rec search scopes =
     match scopes with
-        [] -> None
+        [] -> no_such_ident ident
       | scope::rest ->
           match check_scope scopes scope with
-              None ->
+              RES_failed _ ->
                 begin
                   let is_ty_item i =
                     match i.node.Ast.decl_item with
@@ -2157,28 +2173,26 @@ let lookup_by_temp
     (cx:ctxt)
     (scopes:scope list)
     (temp:temp_id)
-    : ((scope list * node_id) option) =
-  let passed_item_scope = ref false in
-  let check_scope scope =
-    if !passed_item_scope
-    then None
-    else
-      match scope with
-          SCOPE_block block_id ->
+    : resolved =
+  let rec search scopes' =
+    match scopes' with
+        (SCOPE_block block_id)::scopes'' ->
             let block_slots = Hashtbl.find cx.ctxt_block_slots block_id in
-              htab_search block_slots (Ast.KEY_temp temp)
-        | _ ->
-            passed_item_scope := true;
-            None
+            begin
+              match htab_search block_slots (Ast.KEY_temp temp) with
+                  Some slot -> RES_ok (scopes', slot)
+                | None -> search scopes''
+            end
+      | _ -> no_such_temp temp
   in
-    list_search_ctxt scopes check_scope
+  search scopes
 ;;
 
 let lookup
     (cx:ctxt)
     (scopes:scope list)
     (key:Ast.slot_key)
-    : ((scope list * node_id) option) =
+    : resolved =
   match key with
       Ast.KEY_temp temp -> lookup_by_temp cx scopes temp
     | Ast.KEY_ident ident -> lookup_by_ident cx [] scopes ident
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index 0579775f..4ca0caf2 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -119,7 +119,7 @@ let determine_constr_key
 
   let cid =
     match lookup_by_name cx [] scopes c.Ast.constr_name with
-        Some (_, cid) ->
+        RES_ok (_, cid) ->
           if defn_id_is_item cx cid
           then
             begin
@@ -134,7 +134,7 @@ let determine_constr_key
             end
           else
             bug () "slot used as predicate"
-      | None -> bug () "predicate not found"
+      | RES_failed _ -> bug () "predicate not found"
   in
 
   let constr_arg_of_carg carg =
@@ -153,8 +153,8 @@ let determine_constr_key
               | Ast.CARG_base (Ast.BASE_named nb) ->
                   begin
                     match lookup_by_name cx [] scopes (Ast.NAME_base nb) with
-                        None -> bug () "constraint-arg not found"
-                      | Some (_, aid) ->
+                        RES_failed _ -> bug () "constraint-arg not found"
+                      | RES_ok (_, aid) ->
                           if defn_id_is_slot cx aid
                           then
                             if type_has_state cx