Add detection for cyclic imports.

src/boot/me/effect.ml

@@ -320,7 +320,7 @@ let process_crate
   in
   let root_scope = [ SCOPE_crate crate ] in
   let auth_effect name eff =
-    match lookup_by_name cx root_scope name with
+    match lookup_by_name cx [] root_scope name with
         None -> ()
       | Some (_, id) ->
           if referent_is_item cx id

src/boot/me/resolve.ml

@@ -233,7 +233,7 @@ let lookup_type_node_by_name
   iflog cx (fun _ ->
               log cx "lookup_simple_type_by_name %a"
                 Ast.sprintf_name name);
-  match lookup_by_name cx scopes name with
+  match lookup_by_name cx [] scopes name with
       None -> err None "unknown name: %a" Ast.sprintf_name name
     | Some (_, id) ->
         match htab_search cx.ctxt_all_defns id with
@@ -390,7 +390,7 @@ and lookup_type_by_name
   iflog cx (fun _ ->
               log cx "+++ lookup_type_by_name %a"
                 Ast.sprintf_name name);
-  match lookup_by_name cx scopes name with
+  match lookup_by_name cx [] scopes name with
       None -> err None "unknown name: %a" Ast.sprintf_name name
     | Some (scopes', id) ->
         let ty, params =
@@ -746,7 +746,7 @@ let lval_base_resolving_visitor
           | _ -> false
       in
         if lval_is_name lv && lval_is_item cx lv
-        then ignore (lookup_by_name cx (!scopes) (lval_to_name lv))
+        then ignore (lookup_by_name cx [] (!scopes) (lval_to_name lv))
     in
 
       lookup_lval lv;

src/boot/me/semant.ml

@@ -1539,8 +1539,11 @@ let get_name_base_ident
         bug () "get_name_base_ident on BASE_temp"
 ;;
 
+type loop_check = (node_id * Ast.ident) list;;
+
 let rec project_ident_from_items
     (cx:ctxt)
+    (lchk:loop_check)
     (scopes:scope list)
     ((view:Ast.mod_view),(items:Ast.mod_items))
     (ident:Ast.ident)
@@ -1555,7 +1558,7 @@ let rec project_ident_from_items
       | None ->
           match htab_search view.Ast.view_imports ident with
               None -> None
-            | Some name -> lookup_by_name cx scopes name
+            | Some name -> lookup_by_name cx lchk scopes name
 
 and found cx scopes id =
   Hashtbl.replace cx.ctxt_node_referenced id ();
@@ -1563,6 +1566,7 @@ and found cx scopes id =
 
 and project_name_comp_from_resolved
     (cx:ctxt)
+    (lchk:loop_check)
     (mod_res:resolved)
     (ext:Ast.name_component)
     : resolved =
@@ -1574,10 +1578,11 @@ and project_name_comp_from_resolved
         let ident = get_name_comp_ident ext in
         let md = get_mod_item cx id in
           Hashtbl.replace cx.ctxt_node_referenced id ();
-          project_ident_from_items cx scopes md ident false
+          project_ident_from_items cx lchk scopes md ident false
 
 and lookup_by_name
     (cx:ctxt)
+    (lchk:loop_check)
     (scopes:scope list)
     (name:Ast.name)
     : resolved =
@@ -1585,17 +1590,24 @@ and lookup_by_name
   match name with
       Ast.NAME_base nb ->
         let ident = get_name_base_ident nb in
-          lookup_by_ident cx scopes ident
+          lookup_by_ident cx lchk scopes ident
     | Ast.NAME_ext (name, ext) ->
-        let base_res = lookup_by_name cx scopes name in
+        let base_res = lookup_by_name cx lchk scopes name in
-          project_name_comp_from_resolved cx base_res ext
+          project_name_comp_from_resolved cx lchk base_res ext
 
 and lookup_by_ident
     (cx:ctxt)
+    (lchk:loop_check)
     (scopes:scope list)
     (ident:Ast.ident)
     : resolved =
 
+  let passing id =
+    if List.mem (id, ident) lchk
+    then err (Some id) "cyclic import for ident %s" ident
+    else (id, ident)::lchk
+  in
+
   let check_slots scopes islots =
     arr_search islots
       (fun _ (sloti,ident') ->
@@ -1639,7 +1651,7 @@ and lookup_by_ident
 
       | SCOPE_crate crate ->
           project_ident_from_items
-            cx scopes crate.node.Ast.crate_items ident true
+            cx (passing crate.id) scopes crate.node.Ast.crate_items ident true
 
       | SCOPE_obj_fn fn ->
           would_capture (check_slots scopes fn.node.Ast.fn_input_slots)
@@ -1659,7 +1671,8 @@ and lookup_by_ident
                     end
 
                 | Ast.MOD_ITEM_mod md ->
-                    project_ident_from_items cx scopes md ident true
+                    project_ident_from_items cx (passing item.id)
+                      scopes md ident true
 
                 | _ -> None
             in
@@ -1727,7 +1740,7 @@ let lookup
     : ((scope list * node_id) option) =
   match key with
       Ast.KEY_temp temp -> lookup_by_temp cx scopes temp
-    | Ast.KEY_ident ident -> lookup_by_ident cx scopes ident
+    | Ast.KEY_ident ident -> lookup_by_ident cx [] scopes ident
 ;;
 
 

src/boot/me/typestate.ml

@@ -28,7 +28,7 @@ let determine_constr_key
     : constr_key =
 
   let cid =
-    match lookup_by_name cx scopes c.Ast.constr_name with
+    match lookup_by_name cx [] scopes c.Ast.constr_name with
         Some (_, cid) ->
           if referent_is_item cx cid
           then
@@ -62,7 +62,7 @@ let determine_constr_key
               | Ast.CARG_ext (pth, _) -> node_base_of pth
               | Ast.CARG_base (Ast.BASE_named nb) ->
                   begin
-                    match lookup_by_name cx scopes (Ast.NAME_base nb) with
+                    match lookup_by_name cx [] scopes (Ast.NAME_base nb) with
                         None -> bug () "constraint-arg not found"
                       | Some (_, aid) ->
                           if referent_is_slot cx aid