Fix lookup of built modules in Catala

build_system/clerk_driver.ml

@@ -481,7 +481,7 @@ let static_base_rules =
       ~description:["<catala>"; "inline-tests"; "⇐"; !input];
 
     Nj.rule "inline-reset"
-      ~command:[!clerk_exe; "runtest"; !clerk_flags; !input; !modules_use; "--reset"]
+      ~command:[!clerk_exe; "runtest"; !clerk_flags; "--catala-opts=--build-dir=" ^ !builddir; !input; !modules_use; "--reset"]
       ~description:["<catala>"; "inline-reset"; "⇐"; !input]
   ]
 

compiler/catala_utils/uid.ml

@@ -88,11 +88,21 @@ module Gen (S : Style) () = Make (MarkedString) (S) ()
 (* - Modules, paths and qualified idents - *)
 
 module Module = struct
-  include String
+  module Ordering = struct
+    type t = string Mark.pos
 
-  let to_string m = m
-  let format ppf m = Format.fprintf ppf "@{<blue>%s@}" m
+    let equal = Mark.equal String.equal
+    let compare = Mark.compare String.compare
+    let format ppf m = Format.fprintf ppf "@{<blue>%s@}" (Mark.remove m)
+  end
+  include Ordering
+
+  let to_string m = Mark.remove m
   let of_string m = m
+  let pos m = Mark.get m
+
+  module Set = Set.Make(Ordering)
+  module Map = Map.Make(Ordering)
 end
 (* TODO: should probably be turned into an uid once we implement module import
    directives; that will incur an additional resolution work on all paths though
@@ -107,9 +117,9 @@ module Path = struct
       (fun ppf m -> Format.fprintf ppf "%a@{<cyan>.@}" Module.format m)
       ppf p
 
-  let to_string p = String.concat "." p
-  let equal = List.equal String.equal
-  let compare = List.compare String.compare
+  let to_string p = String.concat "." (List.map Module.to_string p)
+  let equal = List.equal Module.equal
+  let compare = List.compare Module.compare
 end
 
 module QualifiedMarkedString = struct

compiler/catala_utils/uid.mli

@@ -70,13 +70,15 @@ module Gen (S : Style) () : Id with type info = MarkedString.info
 (** {2 Handling of Uids with additional path information} *)
 
 module Module : sig
-  type t = private string (* TODO: this will become an uid at some point *)
+  type t = private string Mark.pos
+  (* TODO: this will become an uid at some point *)
 
   val to_string : t -> string
   val format : Format.formatter -> t -> unit
+  val pos: t -> Pos.t
   val equal : t -> t -> bool
   val compare : t -> t -> int
-  val of_string : string -> t
+  val of_string : string * Pos.t -> t
 
   module Set : Set.S with type elt = t
   module Map : Map.S with type key = t

compiler/desugared/from_surface.ml

@@ -168,11 +168,11 @@ let rec disambiguate_constructor
     with EnumName.Map.Not_found _ ->
       Message.raise_spanned_error pos "Enum %s does not contain case %s"
         (Mark.remove enum) (Mark.remove constructor))
-  | (modname, mpos) :: path -> (
+  | modname :: path -> (
     let modname = ModuleName.of_string modname in
     match ModuleName.Map.find_opt modname ctxt.modules with
     | None ->
-      Message.raise_spanned_error mpos "Module \"%a\" not found"
+      Message.raise_spanned_error (ModuleName.pos modname) "Module \"%a\" not found"
         ModuleName.format modname
     | Some ctxt ->
       let constructor =
@@ -415,11 +415,11 @@ let rec translate_expr
       let rec get_str ctxt = function
         | [] -> None
         | [c] -> Some (Name_resolution.get_struct ctxt c)
-        | (modname, mpos) :: path -> (
+        | modname :: path -> (
           let modname = ModuleName.of_string modname in
           match ModuleName.Map.find_opt modname ctxt.modules with
           | None ->
-            Message.raise_spanned_error mpos "Module \"%a\" not found"
+            Message.raise_spanned_error (ModuleName.pos modname) "Module \"%a\" not found"
               ModuleName.format modname
           | Some ctxt -> get_str ctxt path)
       in
@@ -1529,7 +1529,7 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
   in
   let desugared =
     List.fold_left
-      (fun acc ((id, _pos), intf) ->
+      (fun acc (id, intf) ->
         let id = ModuleName.of_string id in
         let modul = ModuleName.Map.find id acc.Ast.program_modules in
         let modul =

compiler/desugared/name_resolution.ml

@@ -254,11 +254,11 @@ let get_scope ctxt id =
 let rec module_ctx ctxt path =
   match path with
   | [] -> ctxt
-  | (modname, mpos) :: path -> (
+  | modname :: path -> (
     let modname = ModuleName.of_string modname in
     match ModuleName.Map.find_opt modname ctxt.modules with
     | None ->
-      Message.raise_spanned_error mpos "Module \"%a\" not found"
+      Message.raise_spanned_error (ModuleName.pos modname) "Module \"%a\" not found"
         ModuleName.format modname
     | Some ctxt -> module_ctx ctxt path)
 
@@ -338,11 +338,11 @@ let rec process_base_typ
           "Unknown type @{<yellow>\"%s\"@}, not a struct or enum previously \
            declared"
           ident)
-    | Surface.Ast.Named ((modul, mpos) :: path, id) -> (
+    | Surface.Ast.Named (modul :: path, id) -> (
       let modul = ModuleName.of_string modul in
       match ModuleName.Map.find_opt modul ctxt.modules with
       | None ->
-        Message.raise_spanned_error mpos
+        Message.raise_spanned_error (ModuleName.pos modul)
           "This refers to module %a, which was not found" ModuleName.format
           modul
       | Some mod_ctxt ->
@@ -956,7 +956,7 @@ let empty_ctxt =
   }
 
 let import_module modules (name, intf) =
-  let mname = ModuleName.of_string (Mark.remove name) in
+  let mname = ModuleName.of_string name in
   let ctxt = { empty_ctxt with modules; path = [mname] } in
   let ctxt = List.fold_left process_name_item ctxt intf in
   let ctxt = List.fold_left process_decl_item ctxt intf in

compiler/driver.ml

@@ -580,7 +580,7 @@ module Commands = struct
     let prg, ctx, _ =
       Passes.dcalc options ~link_modules ~optimize ~check_invariants
     in
-    Interpreter.load_runtime_modules link_modules;
+    Interpreter.load_runtime_modules prg;
     print_interpretation_results options Interpreter.interpret_program_dcalc prg
       (get_scope_uid ctx ex_scope)
 

compiler/plugins/explain.ml

@@ -1386,11 +1386,11 @@ let options =
     $ base_src_url)
 
 let run link_modules optimize ex_scope explain_options global_options =
-  Interpreter.load_runtime_modules link_modules;
   let prg, ctx, _ =
     Driver.Passes.dcalc global_options ~link_modules ~optimize
       ~check_invariants:false
   in
+  Interpreter.load_runtime_modules prg;
   let scope = Driver.Commands.get_scope_uid ctx ex_scope in
   (* let result_expr, env = interpret_program prg scope in *)
   let g, base_vars, env = program_to_graph explain_options prg scope in

compiler/plugins/lazy_interp.ml

@@ -258,10 +258,10 @@ let interpret_program (prg : ('dcalc, 'm) gexpr program) (scope : ScopeName.t) :
 (* -- Plugin registration -- *)
 
 let run link_modules optimize check_invariants ex_scope options =
-  Interpreter.load_runtime_modules link_modules;
   let prg, ctx, _ =
     Driver.Passes.dcalc options ~link_modules ~optimize ~check_invariants
   in
+  Interpreter.load_runtime_modules prg;
   let scope = Driver.Commands.get_scope_uid ctx ex_scope in
   let result_expr, _env = interpret_program prg scope in
   let fmt = Format.std_formatter in

compiler/shared_ast/interpreter.ml

@@ -940,17 +940,26 @@ let interpret_program_dcalc p s : (Uid.MarkedString.info * ('a, 'm) gexpr) list
    reflect that. *)
 let evaluate_expr ctx lang e = delcustom (evaluate_expr ctx lang (addcustom e))
 
-let load_runtime_modules = function
+let load_runtime_modules prg =
+  match ModuleName.Map.keys prg.decl_ctx.ctx_modules with
   | [] -> ()
   | modules ->
     Message.emit_debug "Loading shared modules...";
     List.iter
-      Dynlink.(
-        fun m ->
-          try loadfile (adapt_filename File.(match Cli.globals.build_dir with None -> m -.- "cmo" | Some d -> d / m -.- "cmo"))
-          with Dynlink.Error dl_err ->
-            Message.raise_error
-              "Could not load module %s, has it been suitably compiled?@;\
-               <1 2>@[<hov>%a@]" m Format.pp_print_text
-              (Dynlink.error_message dl_err))
+      (fun m ->
+         let srcfile = Pos.get_file (ModuleName.pos m) in
+         let obj_file =
+           File.(srcfile /../ ModuleName.to_string m ^ ".cmo")
+           |> Dynlink.adapt_filename
+         in
+         let obj_file = match Cli.globals.build_dir with
+           | None -> obj_file
+           | Some d -> File.(d / obj_file)
+         in
+         try Dynlink.loadfile obj_file
+         with Dynlink.Error dl_err ->
+           Message.raise_error
+             "Could not load module %a, has it been suitably compiled?@;\
+              <1 2>@[<hov>%a@]" ModuleName.format m Format.pp_print_text
+             (Dynlink.error_message dl_err))
       modules

compiler/shared_ast/interpreter.mli

@@ -72,6 +72,6 @@ val interpret_program_lcalc :
     providing for each argument a thunked empty default. Returns a list of all
     the computed values for the scope variables of the executed scope. *)
 
-val load_runtime_modules : string list -> unit
-(** Dynlink the given runtime modules, in order to make them callable by the
-    interpreter. If Cli.globals.build_dir is specified, the runtime module names are assumed to be relative and looked up there. *)
+val load_runtime_modules : _ program -> unit
+(** Dynlink the runtime modules required by the given program, in order to make them callable by the
+    interpreter. If Cli.globals.build_dir is specified, the runtime module names (as obtained by looking up the positions in the program's module bindings) are assumed to be relative and looked up there. *)

tests/test_modules/good/mod_use.catala_en

@@ -22,10 +22,8 @@ scope T2:
   assertion o4 = 5.0
 ```
 
-The following test is disabled at the moment because it requires prior compilation of the module. This will be fixed with the new Clerk version that handles dependencies transparently.
-
-```disabled catala-test-inline
-$ catala interpret -s T2 --disable_warnings --use mod_def.catala_en
+```catala-test-inline
+$ catala interpret -s T2
 [RESULT] Computation successful! Results:
 [RESULT] o1 = No ()
 [RESULT] o2 = Maybe ()