Rework resolution of module elements

This changes the `decl_ctx` to be toplevel only, with flattened references to
uids for most elements. The module hierarchy, which is still useful in a few
places, is kept separately.

Module names are also changed to UIDs early on, and support for module aliases
has been added (needs testing).

This resolves some issues with lookup, and should be much more robust, as well
as more convenient for most lookups.

The `decl_ctx` was also extended for string ident lookups, which avoids having
to keep the desugared resolution structure available throughout the compilation
chain.

build_system/clerk_driver.ml

@@ -545,6 +545,14 @@ let[@ocamlformat "disable"] static_base_rules =
         "fi";
       ]
       ~description:["<test>"; !output];
+  (* Note: this last rule looks horrible, but the processing is pretty simple:
+     in the rules above, we output the returning code of diffing individual
+     tests to a [<testfile>@test] file, then the rules for directories just
+     concat these files. What this last rule does is then just count the number
+     of `0` and the total number of characters in the file, and print a readable
+     message. Instead of this disgusting shell code embedded in the ninja file,
+     this could be a specialised subcommand of clerk, e.g. `clerk
+     test-diagnostic <results-file@test>` *)
   ]
 
 let gen_build_statements
@@ -641,7 +649,7 @@ let gen_build_statements
                        (if Filename.is_relative d then !Var.builddir / d else d);
                      ])
                    include_dirs
-              @ (List.map (fun m -> m ^".cmx") modules) );
+              @ List.map (fun m -> m ^ ".cmx") modules );
           ]
   in
   let expose_module =
@@ -694,6 +702,7 @@ let gen_build_statements
                 diff; it should actually be an output for the cases when we
                 reset but that shouldn't cause trouble. *)
              Nj.build "post-test" ~inputs:[reference; test_out]
+               ~implicit_in:["always"]
                ~outputs:[reference ^ "@post"]
           :: acc)
         [] item.legacy_tests
@@ -720,7 +729,8 @@ let gen_build_statements
             ~outputs:[inc (srcv ^ "@test")]
             ~inputs:[srcv; inc (srcv ^ "@out")]
             ~implicit_in:
-              (List.map
+              ("always" ::
+               List.map
                  (fun test -> legacy_test_reference test ^ "@post")
                  item.legacy_tests);
           results;
@@ -801,7 +811,8 @@ let gen_ninja_file catala_exe catala_flags build_dir include_dirs dir =
   @+ List.to_seq (base_bindings catala_exe catala_flags build_dir include_dirs)
   @+ Seq.return (Nj.Comment "\n- Base rules - #\n")
   @+ List.to_seq static_base_rules
-  @+ Seq.return (Nj.Comment "- Project-specific build statements - #")
+  @+ Seq.return (Nj.build "phony" ~outputs:["always"])
+  @+ Seq.return (Nj.Comment "\n- Project-specific build statements - #")
   @+ build_statements include_dirs dir
   @+ Seq.return (Nj.build "phony" ~outputs:["test"] ~inputs:[".@test"])
 

compiler/catala_utils/map.ml

@@ -36,6 +36,7 @@ module type S = sig
   val keys : 'a t -> key list
   val values : 'a t -> 'a list
   val of_list : (key * 'a) list -> 'a t
+  val disjoint_union : 'a t -> 'a t -> 'a t
 
   val format_keys :
     ?pp_sep:(Format.formatter -> unit -> unit) ->
@@ -87,6 +88,12 @@ module Make (Ord : OrderedType) : S with type key = Ord.t = struct
   let keys t = fold (fun k _ acc -> k :: acc) t [] |> List.rev
   let values t = fold (fun _ v acc -> v :: acc) t [] |> List.rev
   let of_list l = List.fold_left (fun m (k, v) -> add k v m) empty l
+  let disjoint_union t1 t2 =
+    union (fun k _ _ ->
+        Format.kasprintf failwith
+          "Maps are not disjoint: conflict on key %a"
+          Ord.format k)
+      t1 t2
 
   let format_keys ?pp_sep ppf t =
     Format.pp_print_list ?pp_sep Ord.format ppf (keys t)

compiler/catala_utils/uid.ml

@@ -32,6 +32,7 @@ module type Id = sig
   val compare : t -> t -> int
   val equal : t -> t -> bool
   val format : Format.formatter -> t -> unit
+  val to_string : t -> string
   val hash : t -> int
 
   module Set : Set.S with type elt = t
@@ -68,6 +69,8 @@ module Make (X : Info) (S : Style) () : Id with type info = X.info = struct
   let get_info (uid : t) : X.info = uid.info
   let hash (x : t) : int = x.id
 
+  let to_string t = X.to_string t.info
+
   module Set = Set.Make (Ordering)
   module Map = Map.Make (Ordering)
 end
@@ -87,27 +90,12 @@ module Gen (S : Style) () = Make (MarkedString) (S) ()
 
 (* - Modules, paths and qualified idents - *)
 
-module Module = struct
-  module Ordering = struct
-    type t = string Mark.pos
-
-    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
-   ([module Module = Gen ()]) *)
+module Module =
+  Gen
+    (struct
+      let style = Ocolor_types.(Fg (C4 blue))
+    end)
+    ()
 
 module Path = struct
   type t = Module.t list

compiler/catala_utils/uid.mli

@@ -47,6 +47,7 @@ module type Id = sig
   val compare : t -> t -> int
   val equal : t -> t -> bool
   val format : Format.formatter -> t -> unit
+  val to_string : t -> string
   val hash : t -> int
 
   module Set : Set.S with type elt = t
@@ -62,27 +63,14 @@ end
 (** This is the generative functor that ensures that two modules resulting from
     two different calls to [Make] will be viewed as different types [t] by the
     OCaml typechecker. Prevents mixing up different sorts of identifiers. *)
-module Make (X : Info) (S : Style) () : Id with type info = X.info
+module Make (X : Info) (_ : Style) () : Id with type info = X.info
 
 (** Shortcut for creating a kind of uids over marked strings *)
-module Gen (S : Style) () : Id with type info = MarkedString.info
+module Gen (_ : Style) () : Id with type info = MarkedString.info
 
 (** {2 Handling of Uids with additional path information} *)
 
-module Module : sig
-  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 * Pos.t -> t
-
-  module Set : Set.S with type elt = t
-  module Map : Map.S with type key = t
-end
+module Module : Id with type info = MarkedString.info
 
 module Path : sig
   type t = Module.t list
@@ -94,7 +82,7 @@ module Path : sig
 end
 
 (** Same as [Gen] but also registers path information *)
-module Gen_qualified (S : Style) () : sig
+module Gen_qualified (_ : Style) () : sig
   include Id with type info = Path.t * MarkedString.info
 
   val fresh : Path.t -> MarkedString.info -> t

compiler/catala_web_interpreter.ml

@@ -23,10 +23,10 @@ let () =
              ~input_src:(Contents (contents, "-inline-"))
              ~language:(Some language) ~debug:false ~color:Never ~trace ()
          in
-         let prg, ctx, _type_order =
+         let prg, _type_order =
            Passes.dcalc options ~includes:[] ~optimize:false
              ~check_invariants:false ~typed:Shared_ast.Expr.typed
          in
          Shared_ast.Interpreter.interpret_program_dcalc prg
-           (Commands.get_scope_uid ctx scope)
+           (Commands.get_scope_uid prg.decl_ctx scope)
     end)