Improve handling of module name definitions

and add some sanity-checks for consistency of used modules w.r.t. actually
loaded modules.

compiler/dcalc/from_scopelang.ml

@@ -1257,5 +1257,6 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program =
   {
     code_items = Bindlib.unbox items;
     decl_ctx = ctx.decl_ctx;
+    module_name = prgm.Scopelang.Ast.program_module_name;
     lang = prgm.program_lang;
   }

compiler/desugared/ast.ml

@@ -229,6 +229,7 @@ type scope = {
 }
 
 type program = {
+  program_module_name : ModuleName.t option;
   program_scopes : scope ScopeName.Map.t;
   program_topdefs : (expr option * typ) TopdefName.Map.t;
   program_ctx : decl_ctx;

compiler/desugared/ast.mli

@@ -113,6 +113,7 @@ type scope = {
 }
 
 type program = {
+  program_module_name : ModuleName.t option;
   program_scopes : scope ScopeName.Map.t;
   program_topdefs : (expr option * typ) TopdefName.Map.t;
   program_ctx : decl_ctx;

compiler/desugared/from_surface.ml

@@ -1469,6 +1469,8 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
       in
       {
         Ast.program_lang = surface.program_lang;
+        Ast.program_module_name =
+          Option.map ModuleName.of_string surface.Surface.Ast.program_module_name;
         Ast.program_ctx =
           {
             (* After name resolution, type definitions (structs and enums) are
@@ -1524,8 +1526,8 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
         (fun prgm child -> process_structure prgm child)
         prgm children
     | S.CodeBlock (block, _, _) -> process_code_block ctxt prgm block
-    | S.LawInclude _ | S.LawText _ -> prgm
+    | S.LawInclude _ | S.LawText _
-    | S.ModuleDef _ | S.ModuleUse _ -> prgm
+    | S.ModuleUse _ | S.ModuleDef _ -> prgm
   in
   let desugared =
     List.fold_left

compiler/desugared/linting.ml

@@ -103,6 +103,7 @@ let detect_unused_struct_fields (p : program) : unit =
   (* TODO: this analysis should be finer grained: a false negative is if the
      field is used to define itself, for passing data around but that never gets
      really used or defined. *)
+  if p.program_module_name <> None then () else (* Disabled on modules *)
   let struct_fields_used =
     Ast.fold_exprs
       ~f:(fun struct_fields_used e ->
@@ -167,6 +168,7 @@ let detect_unused_struct_fields (p : program) : unit =
     p.program_ctx.ctx_structs
 
 let detect_unused_enum_constructors (p : program) : unit =
+  if p.program_module_name <> None then () else (* Disabled on modules *)
   let enum_constructors_used =
     Ast.fold_exprs
       ~f:(fun enum_constructors_used e ->

compiler/driver.ml

@@ -42,16 +42,60 @@ let get_lang options file =
          @{<yellow>%s@}, and @{<bold>--language@} was not specified"
         filename)
 
-let load_module_interfaces options link_modules =
+let load_module_interfaces options program files =
-  List.map
+  let module MS = ModuleName.Set in
-    (fun f ->
+  let to_set intf_list =
+    MS.of_list
+      (List.map (fun (mname, _) -> ModuleName.of_string mname)
+         intf_list)
+  in
+  let used_modules =
+    to_set program.Surface.Ast.program_modules
+  in
+  let load_file f =
     let lang = get_lang options (FileName f) in
-      let modname, intf =
+    let (mname, intf), using =
       Surface.Parser_driver.load_interface (FileName f) lang
     in
-      (* maybe warn here if [modname_of_file f <> modname] ? *)
+    (ModuleName.of_string mname, intf), using
-      modname, intf)
+  in
-    link_modules
+  let module_interfaces = List.map load_file files in
+  let rec check (required, acc) interfaces =
+    let required, acc, remaining =
+      List.fold_left (fun (required, acc, skipped) ((modname, intf), using as modl) ->
+          if MS.mem modname required then
+            let required =
+              List.fold_left (fun req m -> MS.add (ModuleName.of_string m) req) required using
+            in
+            required, (((modname :> string Mark.pos), intf) :: acc), skipped
+          else
+            required, acc, (modl :: skipped))
+        (required, acc, [])
+        interfaces
+    in
+    if List.length remaining < List.length interfaces then
+      (* Loop until fixpoint *)
+      check (required, acc) remaining
+    else
+      required, acc, remaining
+  in
+  let required, loaded, unused = check (used_modules, []) module_interfaces in
+  let missing =
+    MS.diff required (MS.of_list (List.map (fun (m,_) -> ModuleName.of_string m) loaded)) in
+  if not (MS.is_empty missing) || unused <> [] then
+    Message.raise_multispanned_error
+      (List.map (fun m ->
+           Some (Format.asprintf "Required module not found: %a"
+                   ModuleName.format m),
+           ModuleName.pos m)
+          (ModuleName.Set.elements missing) @
+       List.map (fun ((m, _), _) ->
+           Some (Format.asprintf "No use was found for this module: %a"
+                   ModuleName.format m),
+           ModuleName.pos m)
+         unused)
+      "Modules used from the program don't match the command-line";
+  loaded
 
 module Passes = struct
   (* Each pass takes only its cli options, then calls upon its dependent passes
@@ -68,10 +112,8 @@ module Passes = struct
       Surface.Parser_driver.parse_top_level_file options.input_file language
     in
     let prg = Surface.Fill_positions.fill_pos_with_legislative_info prg in
-    let prg =
+    let program_modules = load_module_interfaces options prg link_modules in
-      { prg with program_modules = load_module_interfaces options link_modules }
+    { prg with program_modules }, language
-    in
-    prg, language
 
   let desugared options ~link_modules :
       Desugared.Ast.program * Desugared.Name_resolution.context =
@@ -695,13 +737,7 @@ module Commands = struct
     Message.emit_debug "Compiling program into OCaml...";
     Message.emit_debug "Writing to %s..."
       (Option.value ~default:"stdout" output_file);
-    let modname =
+    Lcalc.To_ocaml.format_program fmt prg type_ordering
-      (* TODO: module directive *)
-      match options.Cli.input_file with
-      | FileName n -> Some (modname_of_file n)
-      | _ -> None
-    in
-    Lcalc.To_ocaml.format_program fmt ?register_module:modname prg type_ordering
 
   let ocaml_cmd =
     Cmd.v

compiler/lcalc/closure_conversion.ml

@@ -356,7 +356,9 @@ let transform_closures_program (p : 'm program) : 'm program Bindlib.box =
   in
   Bindlib.box_apply
     (fun new_code_items ->
-      { code_items = new_code_items; decl_ctx = new_decl_ctx; lang = p.lang })
+      { code_items = new_code_items; decl_ctx = new_decl_ctx;
+        module_name = p.module_name;
+        lang = p.lang; })
     new_code_items
 
 (** {1 Hoisting closures}*)

compiler/lcalc/compile_without_exceptions.ml

@@ -769,4 +769,4 @@ let translate_program (prgm : typed D.program) : untyped A.program =
   (* program is closed here. *)
   let code_items = Bindlib.unbox code_items in
 
-  Program.untype { decl_ctx; code_items; lang = prgm.lang }
+  Program.untype { prgm with decl_ctx; code_items }

compiler/lcalc/to_ocaml.ml

@@ -647,7 +647,7 @@ let format_module_registration
   Format.pp_print_string fmt "let () =";
   Format.pp_print_space fmt ();
   Format.pp_open_hvbox fmt 2;
-  Format.fprintf fmt "Runtime_ocaml.Runtime.register_module %S" modname;
+  Format.fprintf fmt "Runtime_ocaml.Runtime.register_module \"%a\"" ModuleName.format modname;
   Format.pp_print_space fmt ();
   Format.pp_open_vbox fmt 2;
   Format.pp_print_string fmt "[ ";
@@ -664,7 +664,8 @@ let format_module_registration
   Format.pp_print_space fmt ();
   Format.pp_print_string fmt "\"todo-module-hash\"";
   Format.pp_close_box fmt ();
-  Format.pp_close_box fmt ()
+  Format.pp_close_box fmt ();
+  Format.pp_print_newline fmt ()
 
 let header =
   {ocaml|
@@ -678,7 +679,6 @@ open Runtime_ocaml.Runtime
 
 let format_program
     (fmt : Format.formatter)
-    ?register_module
     ?exec_scope
     (p : 'm Ast.program)
     (type_ordering : Scopelang.Dependency.TVertex.t list) : unit =
@@ -686,7 +686,7 @@ let format_program
   format_ctx type_ordering fmt p.decl_ctx;
   let bnd = format_code_items p.decl_ctx fmt p.code_items in
   Format.pp_print_newline fmt ();
-  match register_module, exec_scope with
+  match p.module_name, exec_scope with
   | Some modname, None -> format_module_registration fmt bnd modname
   | None, Some scope_name ->
     let scope_body = Program.get_scope_body p scope_name in

compiler/lcalc/to_ocaml.mli

@@ -38,7 +38,6 @@ val format_var : Format.formatter -> 'm Var.t -> unit
 
 val format_program :
   Format.formatter ->
-  ?register_module:string ->
   ?exec_scope:ScopeName.t ->
   'm Ast.program ->
   Scopelang.Dependency.TVertex.t list ->
@@ -46,7 +45,5 @@ val format_program :
 (** Usage [format_program fmt p type_dependencies_ordering]. Either one of these
     may be set:
 
-    - [register_module] will register the module for dynamic loading under the
-      given name
     - [exec_scope] will mark the named scope as "main" and execute it at the end
       of the program. It must have no inputs. *)

compiler/plugins/api_web.ml

@@ -457,7 +457,7 @@ let run
     Message.emit_debug "Compiling program into OCaml...";
     Message.emit_debug "Writing to %s..."
       (Option.value ~default:"stdout" output_file);
-    Lcalc.To_ocaml.format_program fmt ?register_module:modname prg type_ordering
+    Lcalc.To_ocaml.format_program fmt prg type_ordering
   in
   let jsoo_output_file, with_formatter =
     Driver.Commands.get_output_format options ~ext:"_api_web.ml" output

compiler/plugins/modules.ml

@@ -40,7 +40,7 @@ let action_flag =
                silent. Assertions will be checked, though." );
       ]
 
-let gen_ocaml options link_modules optimize check_invariants modname main =
+let gen_ocaml options link_modules optimize check_invariants main =
   let prg, ctx, type_ordering =
     Driver.Passes.lcalc options ~link_modules ~optimize ~check_invariants
       ~avoid_exceptions:false ~closure_conversion:false
@@ -51,7 +51,7 @@ let gen_ocaml options link_modules optimize check_invariants modname main =
   in
   with_output
   @@ fun ppf ->
-  Lcalc.To_ocaml.format_program ppf ?register_module:modname ?exec_scope prg
+  Lcalc.To_ocaml.format_program ppf ?exec_scope prg
     type_ordering;
   Option.get filename
 
@@ -131,7 +131,7 @@ let compile options link_modules optimize check_invariants =
   in
   let basename = String.uncapitalize_ascii modname in
   let ml_file =
-    gen_ocaml options link_modules optimize check_invariants (Some modname) None
+    gen_ocaml options link_modules optimize check_invariants None
   in
   let flags = ["-I"; Lazy.force runtime_dir] in
   let shared_out = File.((ml_file /../ basename) ^ ".cmxs") in
@@ -148,7 +148,7 @@ let compile options link_modules optimize check_invariants =
 
 let link options link_modules optimize check_invariants output ex_scope_opt =
   let ml_file =
-    gen_ocaml options link_modules optimize check_invariants None ex_scope_opt
+    gen_ocaml options link_modules optimize check_invariants ex_scope_opt
   in
   (* NOTE: assuming native target at the moment *)
   let cmd = "ocamlopt" in

compiler/scopelang/ast.ml

@@ -51,6 +51,7 @@ type 'm scope_decl = {
 }
 
 type 'm program = {
+  program_module_name : ModuleName.t option;
   program_scopes : 'm scope_decl Mark.pos ScopeName.Map.t;
   program_topdefs : ('m expr * typ) TopdefName.Map.t;
   program_modules : nil program ModuleName.Map.t;

compiler/scopelang/ast.mli

@@ -44,6 +44,7 @@ type 'm scope_decl = {
 }
 
 type 'm program = {
+  program_module_name : ModuleName.t option;
   program_scopes : 'm scope_decl Mark.pos ScopeName.Map.t;
   program_topdefs : ('m expr * typ) TopdefName.Map.t;
   program_modules : nil program ModuleName.Map.t;

compiler/scopelang/from_desugared.ml

@@ -821,6 +821,7 @@ let translate_program
       (fun modname m_desugared ->
         let ctx = ModuleName.Map.find modname ctx.modules in
         {
+          Ast.program_module_name = Some modname;
           Ast.program_topdefs = TopdefName.Map.empty;
           program_scopes =
             ScopeName.Map.map
@@ -852,6 +853,7 @@ let translate_program
       desugared.D.program_scopes
   in
   {
+    Ast.program_module_name = desugared.D.program_module_name;
     Ast.program_topdefs;
     Ast.program_scopes;
     Ast.program_ctx;

compiler/shared_ast/definitions.ml

@@ -670,4 +670,5 @@ type 'e program = {
   decl_ctx : decl_ctx;
   code_items : 'e code_item_list;
   lang : Cli.backend_lang;
+  module_name : ModuleName.t option;
 }

compiler/shared_ast/interpreter.ml

@@ -944,7 +944,9 @@ let load_runtime_modules prg =
   match ModuleName.Map.keys prg.decl_ctx.ctx_modules with
   | [] -> ()
   | modules ->
-    Message.emit_debug "Loading shared modules...";
+    Message.emit_debug "Loading shared modules... %a"
+      (fun ppf -> ModuleName.Map.format_keys ppf)
+      prg.decl_ctx.ctx_modules;
     List.iter
       (fun m ->
          let srcfile = Pos.get_file (ModuleName.pos m) in

compiler/shared_ast/program.ml

@@ -17,9 +17,9 @@
 
 open Definitions
 
-let map_exprs ~f ~varf { code_items; decl_ctx; lang } =
+let map_exprs ~f ~varf { code_items; decl_ctx; lang; module_name } =
   Bindlib.box_apply
-    (fun code_items -> { code_items; decl_ctx; lang })
+    (fun code_items -> { code_items; decl_ctx; lang; module_name })
     (Scope.map_exprs ~f ~varf code_items)
 
 let fold_left_exprs ~f ~init { code_items; _ } =

compiler/shared_ast/typing.ml

@@ -1042,6 +1042,7 @@ let program ~leave_unresolved prg =
   in
   {
     A.lang = prg.lang;
+    A.module_name = prg.A.module_name;
     A.code_items = Bindlib.unbox code_items;
     decl_ctx =
       {

compiler/surface/ast.ml

@@ -317,9 +317,11 @@ and interface = uident Mark.pos * code_block
     elements with [topdef_expr = None] *)
 
 and program = {
+  program_module_name : uident Mark.pos option;
   program_items : law_structure list;
   program_source_files : (string[@opaque]) list;
   program_modules : interface list;
+  (** Modules being used by the program *)
   program_lang : Cli.backend_lang; [@opaque]
 }
 

compiler/surface/parser_driver.ml

@@ -251,9 +251,10 @@ let rec parse_source_file
   (match input with Some input -> close_in input | None -> ());
   let program = expand_includes source_file_name commands language in
   {
+    program_module_name = program.Ast.program_module_name;
     program_items = program.Ast.program_items;
     program_source_files = source_file_name :: program.Ast.program_source_files;
-    program_modules = [];
+    program_modules = program.program_modules;
     program_lang = language;
   }
 
@@ -263,24 +264,45 @@ and expand_includes
     (source_file : string)
     (commands : Ast.law_structure list)
     (language : Cli.backend_lang) : Ast.program =
+  let rprg =
     List.fold_left
       (fun acc command ->
          match command with
-      | Ast.LawInclude (Ast.CatalaFile sub_source) ->
+         | Ast.ModuleDef id ->
+           (match acc.Ast.program_module_name with
+            | None -> { acc with Ast.program_module_name = Some id }
+            | Some id2 ->
+              Message.raise_multispanned_error
+                [None, Mark.get id; None, Mark.get id2]
+                "Multiple definitions of the module name")
+         | Ast.ModuleUse (id, _alias) ->
+           { acc with
+             Ast.program_modules = (id, []) :: acc.Ast.program_modules;
+             Ast.program_items = command :: acc.Ast.program_items }
+         | Ast.LawInclude (Ast.CatalaFile inc_file) ->
            let source_dir = Filename.dirname source_file in
-        let sub_source = File.(source_dir / Mark.remove sub_source) in
+           let sub_source = File.(source_dir / Mark.remove inc_file) in
            let includ_program = parse_source_file (FileName sub_source) language in
+           let () =
+             includ_program.Ast.program_module_name |> Option.iter @@ fun id ->
+             Message.raise_multispanned_error
+               [ Some "File include", Mark.get inc_file;
+                 Some "Module declaration", Mark.get id ]
+               "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 %a@}' instead." Uid.Module.format (Uid.Module.of_string id)
+           in
            {
+             Ast.program_module_name = None;
              Ast.program_source_files =
-            acc.Ast.program_source_files @ includ_program.program_source_files;
+               List.rev_append includ_program.program_source_files acc.Ast.program_source_files;
              Ast.program_items =
-            acc.Ast.program_items @ includ_program.program_items;
+               List.rev_append includ_program.program_items acc.Ast.program_items;
              Ast.program_modules =
-            acc.Ast.program_modules @ includ_program.program_modules;
+               List.rev_append includ_program.program_modules acc.Ast.program_modules;
           Ast.program_lang = language;
            }
          | Ast.LawHeading (heading, commands') ->
            let {
+             Ast.program_module_name;
              Ast.program_items = commands';
              Ast.program_source_files = new_sources;
              Ast.program_modules = new_modules;
@@ -289,36 +311,42 @@ and expand_includes
              expand_includes source_file commands' language
            in
            {
-          Ast.program_source_files = acc.Ast.program_source_files @ new_sources;
+             Ast.program_module_name;
+             Ast.program_source_files = List.rev_append new_sources acc.Ast.program_source_files;
              Ast.program_items =
-            acc.Ast.program_items @ [Ast.LawHeading (heading, commands')];
+               Ast.LawHeading (heading, commands') :: acc.Ast.program_items;
-          Ast.program_modules = acc.Ast.program_modules @ new_modules;
+             Ast.program_modules = List.rev_append new_modules acc.Ast.program_modules;
           Ast.program_lang = language;
            }
-      | i -> { acc with Ast.program_items = acc.Ast.program_items @ [i] })
+         | i -> { acc with Ast.program_items = i :: acc.Ast.program_items })
       {
+        Ast.program_module_name = None;
         Ast.program_source_files = [];
         Ast.program_items = [];
         Ast.program_modules = [];
         Ast.program_lang = language;
       }
       commands
+  in
+  {
+    Ast.program_lang = language;
+    Ast.program_module_name = rprg.Ast.program_module_name;
+    Ast.program_source_files = List.rev rprg.Ast.program_source_files;
+    Ast.program_items = List.rev rprg.Ast.program_items;
+    Ast.program_modules = List.rev rprg.Ast.program_modules;
+  }
+
 
 (** {2 Handling interfaces} *)
 
 let get_interface program =
-  let rec filter (modname, acc) = function
+  let rec filter (req, acc) = function
-    | Ast.LawInclude _ | Ast.LawText _ | Ast.ModuleUse _ -> modname, acc
+    | Ast.LawInclude _ | Ast.LawText _ | Ast.ModuleDef _ ->
-    | Ast.ModuleDef ((_, pos2) as mdef) -> (
+      req, acc
-      match modname with
+    | Ast.LawHeading (_, str) -> List.fold_left filter (req, acc) str
-      | None -> Some mdef, acc
+    | Ast.ModuleUse (m, _) -> (m::req), acc
-      | Some (_, pos1) ->
-        Message.raise_multispanned_error
-          [None, pos1; None, pos2]
-          "Multiple definitions of the module name")
-    | Ast.LawHeading (_, str) -> List.fold_left filter (modname, acc) str
     | Ast.CodeBlock (code, _, true) ->
-      let acc =
+      req,
       List.fold_left
         (fun acc -> function
            | Ast.ScopeUse _, _ -> acc
@@ -327,20 +355,19 @@ let get_interface program =
            | Ast.Topdef def, m ->
              (Ast.Topdef { def with topdef_expr = None }, m) :: acc)
         acc code
-      in
-      modname, acc
     | Ast.CodeBlock (_, _, false) ->
       (* Non-metadata blocks are ignored *)
-      modname, acc
+      req, acc
   in
-  List.fold_left filter (None, []) program.Ast.program_items
+  List.fold_left filter ([], []) program.Ast.program_items
 
 (** {1 API} *)
 
 let load_interface source_file language =
-  let modname, intf = parse_source_file source_file language |> get_interface in
+  let program = parse_source_file source_file language in
-  match modname with
+  let modname =
-  | Some m -> m, intf
+    match program.Ast.program_module_name with
+    | Some mname -> mname
     | None ->
       Message.raise_error
         "%s doesn't define a module name. It should contain a '@{<cyan>> Module \
@@ -352,6 +379,9 @@ let load_interface source_file language =
          | FileName s ->
            String.capitalize_ascii Filename.(basename (remove_extension s))
          | Contents _ -> "Module_name")
+  in
+  let used_modules, intf = get_interface program in
+  (modname, intf), used_modules
 
 let parse_top_level_file
     (source_file : Cli.input_file)

compiler/surface/parser_driver.mli

@@ -23,10 +23,9 @@ val lines : File.t -> Cli.backend_lang -> (string * Lexer_common.line_token) Seq
 (** Raw file parser that doesn't interpret any includes and returns the flat law
     structure as is *)
 
-val load_interface : Cli.input_file -> Cli.backend_lang -> Ast.interface
+val load_interface : Cli.input_file -> Cli.backend_lang -> Ast.interface * string Mark.pos list
 (** Reads only declarations in metadata in the supplied input file, and only
-    keeps type information ; returns the declared module name as well *)
+    keeps type information ; returns the modules used as well *)
 
 val parse_top_level_file : Cli.input_file -> Cli.backend_lang -> Ast.program
-(** Parses a catala file (handling file includes) and returns a program. Modules
+(** Parses a catala file (handling file includes) and returns a program. Interfaces of the used modules are returned empty, use [load_interface] to fill them. *)
-    in the program are returned empty, use [load_interface] to fill them. *)

tests/test_modules/good/output/mod_def.ml

@@ -50,3 +50,8 @@ let s (s_in: S_in.t) : S.t =
 
 let half_ : integer -> decimal =
   fun (x_: integer) -> o_div_int_int x_ (integer_of_string "2")
+let () =
+  Runtime_ocaml.Runtime.register_module "Mod_def"
+    [ "S", Obj.repr s;
+      "half", Obj.repr half_ ]
+    "todo-module-hash"

tests/test_name_resolution/good/let_in2.catala_en

@@ -66,8 +66,4 @@ let s (s_in: S_in.t) : S.t =
         start_line=5; start_column=18; end_line=5; end_column=19;
         law_headings=["Article"]})) in
   {S.a = a_}
-let () =
-  Runtime_ocaml.Runtime.register_module "Let_in2"
-    [ "S", Obj.repr s ]
-    "todo-module-hash"
 ```

tests/test_scope/good/191_fix_record_name_confusion.catala_en

@@ -60,9 +60,4 @@ let scope_b (scope_b_in: ScopeB_in.t) : ScopeB.t =
         start_line=8; start_column=10; end_line=8; end_column=11;
         law_headings=["Article"]})) in
   {ScopeB.a = a_}
-let () =
-  Runtime_ocaml.Runtime.register_module "191_fix_record_name_confusion"
-    [ "ScopeA", Obj.repr scope_a;
-      "ScopeB", Obj.repr scope_b ]
-    "todo-module-hash"
 ```