Pass the "external module" info along passes

compiler/desugared/ast.ml

@@ -261,7 +261,7 @@ type modul = {
 }
 
 type program = {
-  program_module_name : (ModuleName.t * Hash.t) option;
+  program_module_name : (ModuleName.t * module_intf_id) option;
   program_ctx : decl_ctx;
   program_modules : modul ModuleName.Map.t;
   program_root : modul;

compiler/desugared/ast.mli

@@ -139,7 +139,7 @@ type modul = {
 }
 
 type program = {
-  program_module_name : (ModuleName.t * Hash.t) option;
+  program_module_name : (ModuleName.t * module_intf_id) option;
   program_ctx : decl_ctx;
   program_modules : modul ModuleName.Map.t;
       (** Contains all submodules of the program, in a flattened structure *)

compiler/desugared/from_surface.ml

@@ -1742,12 +1742,14 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
           Ident.Map.fold
             (fun _ m acc ->
               let mctx = ModuleName.Map.find m ctxt.Name_resolution.modules in
-              let sub = aux mctx in
+              let deps = aux mctx in
-              let mhash = snd (ModuleName.Map.find m program_modules) in
+              let hash = snd (ModuleName.Map.find m program_modules) in
-              ModuleName.Map.add m (mhash, sub) acc)
+              ModuleName.Map.add m
+                { deps; intf_id = { hash; is_external = mctx.is_external } }
+                acc)
             mctx.used_modules ModuleName.Map.empty
         in
-        M subs
+        subs
       in
       aux ctxt.local
     in
@@ -1772,12 +1774,12 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
     }
   in
   let program_module_name =
-    surface.Surface.Ast.program_module_name
+    surface.Surface.Ast.program_module
     |> Option.map
-       @@ fun id ->
+       @@ fun { Surface.Ast.module_name; module_external } ->
-       let mname = ModuleName.fresh id in
+       let mname = ModuleName.fresh module_name in
        let hash_placeholder = Hash.raw 0 in
-       mname, hash_placeholder
+       mname, { hash = hash_placeholder; is_external = module_external }
   in
   let desugared =
     {
@@ -1816,6 +1818,10 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
     Ast.program_module_name =
       (desugared.Ast.program_module_name
       |> Option.map
-         @@ fun (mname, _) ->
+         @@ fun (mname, intf_id) ->
-         mname, Ast.Hash.module_binding mname desugared.Ast.program_root);
+         ( mname,
+           {
+             intf_id with
+             hash = Ast.Hash.module_binding mname desugared.Ast.program_root;
+           } ));
   }

compiler/desugared/name_resolution.ml

@@ -78,6 +78,7 @@ type module_context = {
           between different enums *)
   topdefs : TopdefName.t Ident.Map.t;  (** Global definitions *)
   used_modules : ModuleName.t Ident.Map.t;
+  is_external : bool;
 }
 (** Context for name resolution, valid within a given module *)
 
@@ -770,8 +771,10 @@ let rec process_law_structure
     process_code_block
       (process_item ~visibility:(if is_meta then Public else Private))
       ctxt block
+  | Surface.Ast.ModuleDef (_, is_external) ->
+    { ctxt with local = { ctxt.local with is_external } }
   | Surface.Ast.LawInclude _ | Surface.Ast.LawText _ -> ctxt
-  | Surface.Ast.ModuleDef _ | Surface.Ast.ModuleUse _ -> ctxt
+  | Surface.Ast.ModuleUse _ -> ctxt
 
 (** {1 Scope uses pass} *)
 
@@ -979,6 +982,7 @@ let empty_module_ctxt =
     constructor_idmap = Ident.Map.empty;
     topdefs = Ident.Map.empty;
     used_modules = Ident.Map.empty;
+    is_external = false;
   }
 
 let empty_ctxt =
@@ -1007,7 +1011,13 @@ let form_context (surface, mod_uses) surface_modules : context =
           let ctxt =
             {
               ctxt with
-              local = { ctxt.local with used_modules = mod_uses; path = [m] };
+              local =
+                {
+                  ctxt.local with
+                  used_modules = mod_uses;
+                  path = [m];
+                  is_external = intf.Surface.Ast.intf_modname.module_external;
+                };
             }
           in
           let ctxt =

compiler/desugared/name_resolution.mli

@@ -83,6 +83,7 @@ type module_context = {
   topdefs : TopdefName.t Ident.Map.t;  (** Global definitions *)
   used_modules : ModuleName.t Ident.Map.t;
       (** Module aliases and the modules they point to *)
+  is_external : bool;
 }
 (** Context for name resolution, valid within a given module *)
 

compiler/driver.ml

@@ -93,7 +93,7 @@ let load_module_interfaces
             Surface.Parser_driver.load_interface ?default_module_name
               (Global.FileName f)
           in
-          let modname = ModuleName.fresh intf.intf_modname in
+          let modname = ModuleName.fresh intf.intf_modname.module_name in
           let seen = File.Map.add f None seen in
           let seen, sub_use_map =
             aux
@@ -107,9 +107,9 @@ let load_module_interfaces
       (seen, Ident.Map.empty) uses
   in
   let seen =
-    match program.Surface.Ast.program_module_name with
+    match program.Surface.Ast.program_module with
     | Some m ->
-      let file = Pos.get_file (Mark.get m) in
+      let file = Pos.get_file (Mark.get m.module_name) in
       File.Map.singleton file None
     | None -> File.Map.empty
   in
@@ -1022,7 +1022,7 @@ module Commands = struct
     let prg =
       Surface.Ast.
         {
-          program_module_name = None;
+          program_module = None;
           program_items = [];
           program_source_files = [];
           program_used_modules =
@@ -1050,7 +1050,7 @@ module Commands = struct
     in
     Format.open_hbox ();
     Format.pp_print_list ~pp_sep:Format.pp_print_space
-      (fun ppf (m, _h) ->
+      (fun ppf (m, _) ->
         let f = Pos.get_file (Mark.get (ModuleName.get_info m)) in
         let f =
           match prefix with

compiler/lcalc/to_ocaml.ml

@@ -718,14 +718,15 @@ let commands = if commands = [] then entry_scopes else commands
 
 let check_and_reexport_used_modules fmt ~hashf modules =
   List.iter
-    (fun (m, hash) ->
+    (fun (m, intf_id) ->
       Format.fprintf fmt
         "@[<hv 2>let () =@ @[<hov 2>match Runtime_ocaml.Runtime.check_module \
          %S \"%a\"@ with@]@,\
          | Ok () -> ()@,\
          @[<hv 2>| Error h -> failwith \"Hash mismatch for module %a, it may \
          need recompiling\"@]@]@,"
-        (ModuleName.to_string m) Hash.format (hashf hash) ModuleName.format m;
+        (ModuleName.to_string m) Hash.format (hashf intf_id.hash)
+        ModuleName.format m;
       Format.fprintf fmt "@[<hv 2>module %a@ = %a@]@," ModuleName.format m
         ModuleName.format m)
     modules
@@ -788,8 +789,8 @@ let format_program
   Format.pp_print_cut fmt ();
   let () =
     match p.module_name, exec_scope with
-    | Some (modname, hash), None ->
+    | Some (modname, intf_id), None ->
-      format_module_registration fmt bnd modname (hashf hash)
+      format_module_registration fmt bnd modname (hashf intf_id.hash)
     | None, Some scope_name ->
       let scope_body = Program.get_scope_body p scope_name in
       format_scope_exec p.decl_ctx fmt bnd scope_name scope_body

compiler/scalc/ast.ml

@@ -121,5 +121,5 @@ type ctx = { decl_ctx : decl_ctx; modules : VarName.t ModuleName.Map.t }
 type program = {
   ctx : ctx;
   code_items : code_item list;
-  module_name : (ModuleName.t * Hash.t) option;
+  module_name : (ModuleName.t * module_intf_id) option;
 }

compiler/scalc/from_lcalc.ml

@@ -659,7 +659,7 @@ let translate_program ~(config : translation_config) (p : 'm L.program) :
     A.program =
   let modules =
     List.fold_left
-      (fun acc (m, _hash) ->
+      (fun acc (m, _) ->
         let vname = Mark.map (( ^ ) "Module_") (ModuleName.get_info m) in
         (* The "Module_" prefix is a workaround name clashes for same-name
            structs and modules, Python in particular mixes everything in one

compiler/scopelang/ast.ml

@@ -67,7 +67,7 @@ type 'm scope_decl = {
 }
 
 type 'm program = {
-  program_module_name : (ModuleName.t * Hash.t) option;
+  program_module_name : (ModuleName.t * module_intf_id) option;
   program_ctx : decl_ctx;
   program_modules : nil scope_decl Mark.pos ScopeName.Map.t ModuleName.Map.t;
   program_scopes : 'm scope_decl Mark.pos ScopeName.Map.t;

compiler/scopelang/ast.mli

@@ -63,7 +63,7 @@ type 'm scope_decl = {
 }
 
 type 'm program = {
-  program_module_name : (ModuleName.t * Hash.t) option;
+  program_module_name : (ModuleName.t * module_intf_id) option;
   program_ctx : decl_ctx;
   program_modules : nil scope_decl Mark.pos ScopeName.Map.t ModuleName.Map.t;
   (* Using [nil] here ensure that program interfaces don't contain any

compiler/shared_ast/definitions.ml

@@ -668,9 +668,12 @@ type scope_info = {
   out_struct_fields : StructField.t ScopeVar.Map.t;
 }
 
+type module_intf_id = { hash : Hash.t; is_external : bool }
+
+type module_tree_node = { deps : module_tree; intf_id : module_intf_id }
+
+and module_tree = module_tree_node ModuleName.Map.t
 (** In practice, this is a DAG: beware of repeated names *)
-type module_tree = M of (Hash.t * module_tree) ModuleName.Map.t
-[@@caml.unboxed]
 
 type visibility = Private | Public
 
@@ -691,5 +694,5 @@ type 'e program = {
   decl_ctx : decl_ctx;
   code_items : 'e code_item_list;
   lang : Global.backend_lang;
-  module_name : (ModuleName.t * Hash.t) option;
+  module_name : (ModuleName.t * module_intf_id) option;
 }

compiler/shared_ast/interpreter.ml

@@ -1156,16 +1156,16 @@ let interpret_program_dcalc p s : (Uid.MarkedString.info * ('a, 'm) gexpr) list
 let evaluate_expr ctx lang e = evaluate_expr ctx lang (addcustom e)
 
 let load_runtime_modules ~hashf prg =
-  let load (m, mod_hash) =
+  let load (mname, intf_id) =
-    let hash = hashf mod_hash in
+    let hash = hashf intf_id.hash in
     let obj_file =
       Dynlink.adapt_filename
-        File.(Pos.get_file (Mark.get (ModuleName.get_info m)) -.- "cmo")
+        File.(Pos.get_file (Mark.get (ModuleName.get_info mname)) -.- "cmo")
     in
     (if not (Sys.file_exists obj_file) then
        Message.error
          ~pos_msg:(fun ppf -> Format.pp_print_string ppf "Module defined here")
-         ~pos:(Mark.get (ModuleName.get_info m))
+         ~pos:(Mark.get (ModuleName.get_info mname))
          "Compiled OCaml object %a@ not@ found.@ Make sure it has been \
           suitably compiled."
          File.format obj_file
@@ -1177,13 +1177,13 @@ let load_runtime_modules ~hashf prg =
            File.format obj_file Format.pp_print_text
            (Dynlink.error_message dl_err));
     match
-      Runtime.check_module (ModuleName.to_string m) (Hash.to_string hash)
+      Runtime.check_module (ModuleName.to_string mname) (Hash.to_string hash)
     with
     | Ok () -> ()
     | Error bad_hash ->
       Message.debug
         "Module hash mismatch for %a:@ @[<v>Expected: %a@,Found:    %a@]"
-        ModuleName.format m Hash.format hash
+        ModuleName.format mname Hash.format hash
         (fun ppf h ->
           try Hash.format ppf (Hash.of_string h)
           with Failure _ -> Format.pp_print_string ppf "<invalid>")
@@ -1191,16 +1191,16 @@ let load_runtime_modules ~hashf prg =
       Message.error
         "Module %a@ needs@ recompiling:@ %a@ was@ likely@ compiled@ from@ an@ \
          older@ version@ or@ with@ incompatible@ flags."
-        ModuleName.format m File.format obj_file
+        ModuleName.format mname File.format obj_file
     | exception Not_found ->
       Message.error
         "Module %a@ was loaded from file %a but did not register properly, \
          there is something wrong in its code."
-        ModuleName.format m File.format obj_file
+        ModuleName.format mname File.format obj_file
   in
   let modules_list_topo = Program.modules_to_list prg.decl_ctx.ctx_modules in
   if modules_list_topo <> [] then
     Message.debug "Loading shared modules... %a"
       (Format.pp_print_list ~pp_sep:Format.pp_print_space ModuleName.format)
-      (List.map fst modules_list_topo);
+      (List.map (fun (m, _) -> m) modules_list_topo);
   List.iter load modules_list_topo

compiler/shared_ast/program.ml

@@ -58,7 +58,7 @@ let empty_ctx =
     ctx_struct_fields = Ident.Map.empty;
     ctx_enum_constrs = Ident.Map.empty;
     ctx_scope_index = Ident.Map.empty;
-    ctx_modules = M ModuleName.Map.empty;
+    ctx_modules = ModuleName.Map.empty;
   }
 
 let get_scope_body { code_items; _ } scope =
@@ -87,11 +87,11 @@ let to_expr p main_scope =
   res
 
 let modules_to_list (mt : module_tree) =
-  let rec aux acc (M mtree) =
+  let rec aux acc mtree =
     ModuleName.Map.fold
-      (fun mname (subhash, sub) acc ->
+      (fun mname mnode acc ->
         if List.exists (fun (m, _) -> ModuleName.equal m mname) acc then acc
-        else (mname, subhash) :: aux acc sub)
+        else (mname, mnode.intf_id) :: aux acc mnode.deps)
       mtree acc
   in
   List.rev (aux [] mt)

compiler/shared_ast/program.mli

@@ -15,7 +15,6 @@
    License for the specific language governing permissions and limitations under
    the License. *)
 
-open Catala_utils
 open Definitions
 
 (** {2 Program declaration context helpers} *)
@@ -54,5 +53,6 @@ val to_expr : ((_ any, _) gexpr as 'e) program -> ScopeName.t -> 'e boxed
 
 val find_scope : ScopeName.t -> 'e code_item_list -> 'e scope_body
 
-val modules_to_list : module_tree -> (ModuleName.t * Hash.t) list
+val modules_to_list : module_tree -> (ModuleName.t * module_intf_id) list
-(** Returns a list of used modules, in topological order *)
+(** Returns a list of used modules, in topological order ; the boolean indicates
+    if the module is external *)

compiler/surface/ast.ml

@@ -318,7 +318,7 @@ and law_structure =
   | CodeBlock of code_block * source_repr * bool (* Metadata if true *)
 
 and interface = {
-  intf_modname : uident Mark.pos;
+  intf_modname : program_module;
   intf_code : code_block;
       (** Invariant: an interface shall only contain [*Decl] elements, or
           [Topdef] elements with [topdef_expr = None] *)
@@ -330,8 +330,10 @@ and module_use = {
   mod_use_alias : uident Mark.pos;
 }
 
+and program_module = { module_name : uident Mark.pos; module_external : bool }
+
 and program = {
-  program_module_name : uident Mark.pos option;
+  program_module : program_module option;
   program_items : law_structure list;
   program_source_files : (string[@opaque]) list;
   program_used_modules : module_use list;

compiler/surface/parser_driver.ml

@@ -259,18 +259,21 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
     List.fold_left
       (fun acc command ->
         let join_module_names name_opt =
-          match acc.Ast.program_module_name, name_opt with
+          match acc.Ast.program_module, name_opt with
           | opt, None | None, opt -> opt
           | Some id1, Some id2 ->
             Message.error
-              ~extra_pos:["", Mark.get id1; "", Mark.get id2]
+              ~extra_pos:
+                ["", Mark.get id1.module_name; "", Mark.get id2.module_name]
               "Multiple definitions of the module name"
         in
         match command with
-        | Ast.ModuleDef (id, _) ->
+        | Ast.ModuleDef (id, is_external) ->
           {
             acc with
-            Ast.program_module_name = join_module_names (Some id);
+            Ast.program_module =
+              join_module_names
+                (Some { module_name = id; module_external = is_external });
             Ast.program_items = command :: acc.Ast.program_items;
           }
         | Ast.ModuleUse (mod_use_name, alias) ->
@@ -288,22 +291,22 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
           @@ fun lexbuf ->
           let includ_program = parse_source lexbuf in
           let () =
-            includ_program.Ast.program_module_name
+            includ_program.Ast.program_module
             |> Option.iter
                @@ fun id ->
                Message.error
                  ~extra_pos:
                    [
                      "File include", Mark.get inc_file;
-                     "Module declaration", Mark.get id;
+                     "Module declaration", Mark.get id.Ast.module_name;
                    ]
                  "A file that declares a module cannot be used through the raw \
                   '@{<yellow>> Include@}'@ directive.@ You should use it as a \
                   module with@ '@{<yellow>> Use @{<blue>%s@}@}'@ instead."
-                 (Mark.remove id)
+                 (Mark.remove id.Ast.module_name)
           in
           {
-            Ast.program_module_name = acc.program_module_name;
+            Ast.program_module = acc.program_module;
             Ast.program_source_files =
               List.rev_append includ_program.program_source_files
                 acc.Ast.program_source_files;
@@ -316,7 +319,7 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
           }
         | Ast.LawHeading (heading, commands') ->
           let {
-            Ast.program_module_name;
+            Ast.program_module;
             Ast.program_items = commands';
             Ast.program_source_files = new_sources;
             Ast.program_used_modules = new_used_modules;
@@ -325,7 +328,7 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
             expand_includes source_file commands'
           in
           {
-            Ast.program_module_name = join_module_names program_module_name;
+            Ast.program_module = join_module_names program_module;
             Ast.program_source_files =
               List.rev_append new_sources acc.Ast.program_source_files;
             Ast.program_items =
@@ -336,7 +339,7 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
           }
         | i -> { acc with Ast.program_items = i :: acc.Ast.program_items })
       {
-        Ast.program_module_name = None;
+        Ast.program_module = None;
         Ast.program_source_files = [];
         Ast.program_items = [];
         Ast.program_used_modules = [];
@@ -346,7 +349,7 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
   in
   {
     Ast.program_lang = language;
-    Ast.program_module_name = rprg.Ast.program_module_name;
+    Ast.program_module = rprg.Ast.program_module;
     Ast.program_source_files = List.rev rprg.Ast.program_source_files;
     Ast.program_items = List.rev rprg.Ast.program_items;
     Ast.program_used_modules = List.rev rprg.Ast.program_used_modules;
@@ -396,8 +399,8 @@ let with_sedlex_source source_file f =
     f lexbuf
 
 let check_modname program source_file =
-  match program.Ast.program_module_name, source_file with
+  match program.Ast.program_module, source_file with
-  | ( Some (mname, pos),
+  | ( Some { module_name = mname, pos; _ },
       (Global.FileName file | Global.Contents (_, file) | Global.Stdin file) )
     when not File.(equal mname Filename.(remove_extension (basename file))) ->
     Message.error ~pos
@@ -413,10 +416,14 @@ let load_interface ?default_module_name source_file =
   let program = with_sedlex_source source_file parse_source in
   check_modname program source_file;
   let modname =
-    match program.Ast.program_module_name, default_module_name with
+    match program.Ast.program_module, default_module_name with
     | Some mname, _ -> mname
     | None, Some n ->
-      n, Pos.from_info (Global.input_src_file source_file) 0 0 0 0
+      {
+        module_name =
+          n, Pos.from_info (Global.input_src_file source_file) 0 0 0 0;
+        module_external = false;
+      }
     | None, None ->
       Message.error
         "%a doesn't define a module name. It should contain a '@{<cyan>> \