catala depends fixes

- automatically include the directories of listed files
- work for files that don't define modules
This commit is contained in:
Louis Gesbert 2024-03-13 17:51:12 +01:00
parent 21a429bfcf
commit 99004ab1d9
3 changed files with 28 additions and 11 deletions

View File

@ -26,14 +26,19 @@ let modname_of_file f =
(* Fixme: make this more robust *) (* Fixme: make this more robust *)
String.capitalize_ascii Filename.(basename (remove_extension f)) String.capitalize_ascii Filename.(basename (remove_extension f))
let load_module_interfaces options includes program = let load_module_interfaces
options
includes
?(more_includes = [])
?(allow_notmodules = false)
program =
(* Recurse into program modules, looking up files in [using] and loading (* Recurse into program modules, looking up files in [using] and loading
them *) them *)
if program.Surface.Ast.program_used_modules <> [] then if program.Surface.Ast.program_used_modules <> [] then
Message.emit_debug "Loading module interfaces..."; Message.emit_debug "Loading module interfaces...";
let includes = let includes =
includes List.map options.Cli.path_rewrite includes @ more_includes
|> List.map (fun d -> File.Tree.build (options.Cli.path_rewrite d)) |> List.map File.Tree.build
|> List.fold_left File.Tree.union File.Tree.empty |> List.fold_left File.Tree.union File.Tree.empty
in in
let err_req_pos chain = let err_req_pos chain =
@ -80,7 +85,13 @@ let load_module_interfaces options includes program =
(err_req_pos (Mark.get use.Surface.Ast.mod_use_name :: req_chain)) (err_req_pos (Mark.get use.Surface.Ast.mod_use_name :: req_chain))
"Circular module dependency" "Circular module dependency"
| None -> | None ->
let intf = Surface.Parser_driver.load_interface (Cli.FileName f) in let default_module_name =
if allow_notmodules then Some (modname_of_file f) else None
in
let intf =
Surface.Parser_driver.load_interface ?default_module_name
(Cli.FileName f)
in
let modname = ModuleName.fresh intf.intf_modname in let modname = ModuleName.fresh intf.intf_modname in
let seen = File.Map.add f None seen in let seen = File.Map.add f None seen in
let seen, sub_use_map = let seen, sub_use_map =
@ -990,8 +1001,9 @@ module Commands = struct
$ Cli.Flags.check_invariants) $ Cli.Flags.check_invariants)
let depends options includes prefix extension extra_files = let depends options includes prefix extension extra_files =
let prg =
let file = Cli.input_src_file options.Cli.input_src in let file = Cli.input_src_file options.Cli.input_src in
let more_includes = List.map Filename.dirname (file :: extra_files) in
let prg =
Surface.Ast. Surface.Ast.
{ {
program_module_name = None; program_module_name = None;
@ -1009,7 +1021,10 @@ module Commands = struct
program_lang = Cli.file_lang file; program_lang = Cli.file_lang file;
} }
in in
let mod_uses, modules = load_module_interfaces options includes prg in let mod_uses, modules =
load_module_interfaces options includes ~more_includes
~allow_notmodules:true prg
in
let d_ctx = let d_ctx =
Desugared.Name_resolution.form_context (prg, mod_uses) modules Desugared.Name_resolution.form_context (prg, mod_uses) modules
in in

View File

@ -412,13 +412,14 @@ let check_modname program source_file =
File.((dirname file / mname) ^ Filename.extension file) File.((dirname file / mname) ^ Filename.extension file)
| _ -> () | _ -> ()
let load_interface source_file = let load_interface ?default_module_name source_file =
let program = with_sedlex_source source_file parse_source in let program = with_sedlex_source source_file parse_source in
check_modname program source_file; check_modname program source_file;
let modname = let modname =
match program.Ast.program_module_name with match program.Ast.program_module_name, default_module_name with
| Some mname -> mname | Some mname, _ -> mname
| None -> | None, Some n -> n, Pos.from_info (Cli.input_src_file source_file) 0 0 0 0
| None, None ->
Message.raise_error Message.raise_error
"%a doesn't define a module name. It should contain a '@{<cyan>> \ "%a doesn't define a module name. It should contain a '@{<cyan>> \
Module %s@}' directive." Module %s@}' directive."

View File

@ -24,7 +24,8 @@ val lines :
(** Raw file parser that doesn't interpret any includes and returns the flat law (** Raw file parser that doesn't interpret any includes and returns the flat law
structure as is *) structure as is *)
val load_interface : Cli.input_src -> Ast.interface val load_interface :
?default_module_name:string -> Cli.input_src -> Ast.interface
(** Reads only declarations in metadata in the supplied input file, and only (** Reads only declarations in metadata in the supplied input file, and only
keeps type information. The list of submodules is initialised with names keeps type information. The list of submodules is initialised with names
only and empty contents. *) only and empty contents. *)