refactoring

compiler/src/pretyping.ml

@@ -337,12 +337,25 @@ end  = struct
     let stack, bot = env.e_bindings in
     { env with e_bindings = (L.unloc ns, empty_gb) :: stack, bot }
 
-  let merge_bindings ns =
-    Map.foldi (fun n -> Map.add (qualify ns n))
+  let merge_bindings on_duplicate ns =
+    Map.foldi (fun n v dst ->
+        let n = qualify ns n in
+        begin match Map.find n dst with
+        | exception Not_found -> ()
+        | (k, _) -> on_duplicate n (fst v) k end;
+        Map.add n v dst)
+
+  let warn_duplicate_var name v v' =
+    warning DuplicateVar (L.i_loc0 v.P.v_dloc)
+      "the variable %s is already declared at %a"
+      name L.pp_loc v'.P.v_dloc
+
+  let err_duplicate_fun name v fd =
+    rs_tyerror ~loc:v.P.f_loc (DuplicateFun(name, fd.P.f_loc))
 
   let merge_bindings (ns, src) dst =
-    { gb_vars = merge_bindings ns src.gb_vars dst.gb_vars
-    ; gb_funs = merge_bindings ns src.gb_funs dst.gb_funs
+    { gb_vars = merge_bindings warn_duplicate_var ns src.gb_vars dst.gb_vars
+    ; gb_funs = merge_bindings err_duplicate_fun ns src.gb_funs dst.gb_funs
     }
 
   let exit_namespace env =
@@ -410,31 +423,32 @@ end  = struct
 
   let dependencies env =
     Map.fold ( @ ) env.e_loader.loaded []
-
+
+  let find (proj: 'asm global_bindings -> (A.symbol, 'a) Map.t) (x: A.symbol) (env: 'asm env) : 'a option =
+    let stack, bot = env.e_bindings in
+    let rec loop x =
+      function
+      | [] -> None
+      | (_, top) :: stack ->
+         match Map.find x (proj top) with
+         | exception Not_found -> loop x stack
+         | v -> Some v
+    in match loop x stack with
+       | None -> Map.Exceptionless.find x (proj bot)
+       | r -> r
+
   (* Local variables *)
 
   module Vars = struct
 
     let find (x : A.symbol) (env : 'asm env) =
-      let stack, bot = env.e_bindings in
-      let rec loop x =
-        function
-        | [] -> None
-        | (_, { gb_vars ; _ }) :: stack ->
-           match Map.find x gb_vars with
-           | exception Not_found -> loop x stack
-           | v -> Some v
-      in match loop x stack with
-         | None -> Map.Exceptionless.find x bot.gb_vars
-         | r -> r
-
-    let warn_double_decl v map = 
-      try 
-        let v', _ = Map.find v.P.v_name map in
-        warning DuplicateVar (L.i_loc0 v.v_dloc) 
-          "the variable %s is already declared at %a"
-          v.v_name L.pp_loc v'.P.v_dloc 
-      with Not_found -> ()
+      find (fun b -> b.gb_vars) x env
+
+  let warn_double_decl v map =
+    let name = v.P.v_name in
+    match Map.find name map with
+    | exception Not_found -> ()
+    | v', _ -> warn_duplicate_var name v v'
 
     let push_core (env : 'asm env) (name: P.Name.t) (v : P.pvar) (s : E.v_scope) =
       let doit m =
@@ -484,18 +498,7 @@ end  = struct
 
   module Funs = struct
     let find (x : A.symbol) (env : 'asm env) =
-      let stack, bot = env.e_bindings in
-      let rec loop x =
-        function
-        | [] -> None
-        | (_, { gb_funs ; _ }) :: stack ->
-           match Map.find x gb_funs with
-           | exception Not_found -> loop x stack
-           | v -> Some v
-      in match loop x stack with
-         | None -> Map.Exceptionless.find x bot.gb_funs
-         | r -> r
-
+      find (fun b -> b.gb_funs) x env
 
     let push env (v : (unit, 'asm) P.pfunc) rty =
       let name = v.P.f_name.P.fn_name in
@@ -513,7 +516,7 @@ end  = struct
       in
       { env with e_bindings; e_decls = P.MIfun v :: env.e_decls }
       | Some (fd,_) ->
-        rs_tyerror ~loc:v.P.f_loc (DuplicateFun(name, fd.P.f_loc))
+         err_duplicate_fun name v fd
 
   end
 
@@ -2145,17 +2148,16 @@ let tt_global pd (env : 'asm Env.env) _loc (gd: S.pglobal) : 'asm Env.env =
 
   Env.Vars.push_global env (x,d)
 
-(* -------------------------------------------------------------------- *)
 (* -------------------------------------------------------------------- *)
 let rec tt_item arch_info (env : 'asm Env.env) pt : 'asm Env.env =
   match L.unloc pt with
   | S.PParam  pp -> tt_param  arch_info.pd env (L.loc pt) pp
   | S.PFundef pf -> tt_fundef arch_info env (L.loc pt) pf
   | S.PGlobal pg -> tt_global arch_info.pd env (L.loc pt) pg
   | S.Pexec   pf ->
-     Env.Exec.push (L.loc pt) (fst (tt_fun env pf.pex_name)).P.f_name pf.pex_mem env
+    Env.Exec.push (L.loc pt) (fst (tt_fun env pf.pex_name)).P.f_name pf.pex_mem env
   | S.Prequire (from, fs) ->
-     List.fold_left (tt_file_loc arch_info from) env fs
+    List.fold_left (tt_file_loc arch_info from) env fs
   | S.PNamespace (ns, items) ->
      let env = Env.enter_namespace env ns in
      let env = List.fold_left (tt_item arch_info) env items in

compiler/tests/fail/namespaces/common/duplicate.jazz

@@ -0,0 +1,2 @@
+namespace A { fn f() {} }
+namespace A { fn f() {} }