From f162f6e9bd7fb60624858cb9f9b2107032fdb1a7 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Tue, 19 Sep 2023 11:44:18 +0200 Subject: [PATCH] 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 | 1 + compiler/desugared/ast.ml | 1 + compiler/desugared/ast.mli | 1 + compiler/desugared/from_surface.ml | 6 +- compiler/desugared/linting.ml | 2 + compiler/driver.ml | 78 ++++++-- compiler/lcalc/closure_conversion.ml | 4 +- compiler/lcalc/compile_without_exceptions.ml | 2 +- compiler/lcalc/to_ocaml.ml | 8 +- compiler/lcalc/to_ocaml.mli | 3 - compiler/plugins/api_web.ml | 2 +- compiler/plugins/modules.ml | 8 +- compiler/scopelang/ast.ml | 1 + compiler/scopelang/ast.mli | 1 + compiler/scopelang/from_desugared.ml | 2 + compiler/shared_ast/definitions.ml | 1 + compiler/shared_ast/interpreter.ml | 4 +- compiler/shared_ast/program.ml | 4 +- compiler/shared_ast/typing.ml | 1 + compiler/surface/ast.ml | 2 + compiler/surface/parser_driver.ml | 180 ++++++++++-------- compiler/surface/parser_driver.mli | 7 +- tests/test_modules/good/output/mod_def.ml | 5 + .../good/let_in2.catala_en | 4 - .../191_fix_record_name_confusion.catala_en | 5 - 25 files changed, 205 insertions(+), 128 deletions(-) diff --git a/compiler/dcalc/from_scopelang.ml b/compiler/dcalc/from_scopelang.ml index 4e5c2a91..2a3074a9 100644 --- a/compiler/dcalc/from_scopelang.ml +++ b/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; } diff --git a/compiler/desugared/ast.ml b/compiler/desugared/ast.ml index 23b92fbe..768cae64 100644 --- a/compiler/desugared/ast.ml +++ b/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; diff --git a/compiler/desugared/ast.mli b/compiler/desugared/ast.mli index 47ccd8c9..f4f919bc 100644 --- a/compiler/desugared/ast.mli +++ b/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; diff --git a/compiler/desugared/from_surface.ml b/compiler/desugared/from_surface.ml index c16a7938..41c694e3 100644 --- a/compiler/desugared/from_surface.ml +++ b/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.ModuleDef _ | S.ModuleUse _ -> prgm + | S.LawInclude _ | S.LawText _ + | S.ModuleUse _ | S.ModuleDef _ -> prgm in let desugared = List.fold_left diff --git a/compiler/desugared/linting.ml b/compiler/desugared/linting.ml index 420cc6c6..5afb9671 100644 --- a/compiler/desugared/linting.ml +++ b/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 -> diff --git a/compiler/driver.ml b/compiler/driver.ml index c2b3b1e1..77dcd418 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -42,16 +42,60 @@ let get_lang options file = @{%s@}, and @{--language@} was not specified" filename) -let load_module_interfaces options link_modules = - List.map - (fun f -> - let lang = get_lang options (FileName f) in - let modname, intf = - Surface.Parser_driver.load_interface (FileName f) lang - in - (* maybe warn here if [modname_of_file f <> modname] ? *) - modname, intf) - link_modules +let load_module_interfaces options program files = + let module MS = ModuleName.Set in + 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 (mname, intf), using = + Surface.Parser_driver.load_interface (FileName f) lang + in + (ModuleName.of_string mname, intf), using + in + 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 = - { prg with program_modules = load_module_interfaces options link_modules } - in - prg, language + let program_modules = load_module_interfaces options prg link_modules in + { prg with program_modules }, 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 = - (* 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 + Lcalc.To_ocaml.format_program fmt prg type_ordering let ocaml_cmd = Cmd.v diff --git a/compiler/lcalc/closure_conversion.ml b/compiler/lcalc/closure_conversion.ml index 066f2b1a..53e9f005 100644 --- a/compiler/lcalc/closure_conversion.ml +++ b/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}*) diff --git a/compiler/lcalc/compile_without_exceptions.ml b/compiler/lcalc/compile_without_exceptions.ml index 7bcceccc..10946e65 100644 --- a/compiler/lcalc/compile_without_exceptions.ml +++ b/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 } diff --git a/compiler/lcalc/to_ocaml.ml b/compiler/lcalc/to_ocaml.ml index eb58948d..b2352aff 100644 --- a/compiler/lcalc/to_ocaml.ml +++ b/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 diff --git a/compiler/lcalc/to_ocaml.mli b/compiler/lcalc/to_ocaml.mli index 618813ed..52819b71 100644 --- a/compiler/lcalc/to_ocaml.mli +++ b/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. *) diff --git a/compiler/plugins/api_web.ml b/compiler/plugins/api_web.ml index 3bc195ee..8c4261bf 100644 --- a/compiler/plugins/api_web.ml +++ b/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 diff --git a/compiler/plugins/modules.ml b/compiler/plugins/modules.ml index 5bd166df..e1e203cc 100644 --- a/compiler/plugins/modules.ml +++ b/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 diff --git a/compiler/scopelang/ast.ml b/compiler/scopelang/ast.ml index c9a8c5c2..d62cad75 100644 --- a/compiler/scopelang/ast.ml +++ b/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; diff --git a/compiler/scopelang/ast.mli b/compiler/scopelang/ast.mli index cba64b46..a73c5dc5 100644 --- a/compiler/scopelang/ast.mli +++ b/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; diff --git a/compiler/scopelang/from_desugared.ml b/compiler/scopelang/from_desugared.ml index 1d4fad26..722261f7 100644 --- a/compiler/scopelang/from_desugared.ml +++ b/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; diff --git a/compiler/shared_ast/definitions.ml b/compiler/shared_ast/definitions.ml index 5a4c514c..af4251ed 100644 --- a/compiler/shared_ast/definitions.ml +++ b/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; } diff --git a/compiler/shared_ast/interpreter.ml b/compiler/shared_ast/interpreter.ml index a37f7e13..3d40bd26 100644 --- a/compiler/shared_ast/interpreter.ml +++ b/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 diff --git a/compiler/shared_ast/program.ml b/compiler/shared_ast/program.ml index 0f1d0ecc..c69b62f4 100644 --- a/compiler/shared_ast/program.ml +++ b/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; _ } = diff --git a/compiler/shared_ast/typing.ml b/compiler/shared_ast/typing.ml index 0ede62df..ab821589 100644 --- a/compiler/shared_ast/typing.ml +++ b/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 = { diff --git a/compiler/surface/ast.ml b/compiler/surface/ast.ml index 387c3ad2..f62521b8 100644 --- a/compiler/surface/ast.ml +++ b/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] } diff --git a/compiler/surface/parser_driver.ml b/compiler/surface/parser_driver.ml index 6c3a45ae..213eaba1 100644 --- a/compiler/surface/parser_driver.ml +++ b/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,95 +264,124 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) (language : Cli.backend_lang) : Ast.program = - List.fold_left - (fun acc command -> - match command with - | Ast.LawInclude (Ast.CatalaFile sub_source) -> - let source_dir = Filename.dirname source_file in - let sub_source = File.(source_dir / Mark.remove sub_source) in - let includ_program = parse_source_file (FileName sub_source) language in - { - Ast.program_source_files = - acc.Ast.program_source_files @ includ_program.program_source_files; - Ast.program_items = - acc.Ast.program_items @ includ_program.program_items; - Ast.program_modules = - acc.Ast.program_modules @ includ_program.program_modules; + let rprg = + List.fold_left + (fun acc command -> + match command with + | 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 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 '@{> Include@}' directive. You should use it as a module with '@{> Use %a@}' instead." Uid.Module.format (Uid.Module.of_string id) + in + { + Ast.program_module_name = None; + Ast.program_source_files = + List.rev_append includ_program.program_source_files acc.Ast.program_source_files; + Ast.program_items = + List.rev_append includ_program.program_items acc.Ast.program_items; + Ast.program_modules = + List.rev_append includ_program.program_modules acc.Ast.program_modules; Ast.program_lang = language; - } - | Ast.LawHeading (heading, commands') -> - let { - Ast.program_items = commands'; - Ast.program_source_files = new_sources; - Ast.program_modules = new_modules; + } + | Ast.LawHeading (heading, commands') -> + let { + Ast.program_module_name; + Ast.program_items = commands'; + Ast.program_source_files = new_sources; + Ast.program_modules = new_modules; Ast.program_lang = _; - } = - expand_includes source_file commands' language - in - { - Ast.program_source_files = acc.Ast.program_source_files @ new_sources; - Ast.program_items = - acc.Ast.program_items @ [Ast.LawHeading (heading, commands')]; - Ast.program_modules = acc.Ast.program_modules @ new_modules; + } = + expand_includes source_file commands' language + in + { + Ast.program_module_name; + Ast.program_source_files = List.rev_append new_sources acc.Ast.program_source_files; + Ast.program_items = + Ast.LawHeading (heading, commands') :: acc.Ast.program_items; + 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] }) - { - Ast.program_source_files = []; - Ast.program_items = []; - Ast.program_modules = []; - Ast.program_lang = language; - } - commands + } + | 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 - | Ast.LawInclude _ | Ast.LawText _ | Ast.ModuleUse _ -> modname, acc - | Ast.ModuleDef ((_, pos2) as mdef) -> ( - match modname with - | None -> Some mdef, 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 + let rec filter (req, acc) = function + | Ast.LawInclude _ | Ast.LawText _ | Ast.ModuleDef _ -> + req, acc + | Ast.LawHeading (_, str) -> List.fold_left filter (req, acc) str + | Ast.ModuleUse (m, _) -> (m::req), acc | Ast.CodeBlock (code, _, true) -> - let acc = - List.fold_left - (fun acc -> function - | Ast.ScopeUse _, _ -> acc - | ((Ast.ScopeDecl _ | StructDecl _ | EnumDecl _), _) as e -> - e :: acc - | Ast.Topdef def, m -> - (Ast.Topdef { def with topdef_expr = None }, m) :: acc) - acc code - in - modname, acc + req, + List.fold_left + (fun acc -> function + | Ast.ScopeUse _, _ -> acc + | ((Ast.ScopeDecl _ | StructDecl _ | EnumDecl _), _) as e -> + e :: acc + | Ast.Topdef def, m -> + (Ast.Topdef { def with topdef_expr = None }, m) :: acc) + acc code | 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 - match modname with - | Some m -> m, intf - | None -> - Message.raise_error - "%s doesn't define a module name. It should contain a '@{> Module \ - %s@}' directive." - (match source_file with - | FileName s -> "File " ^ s - | Contents _ -> "Source input") - (match source_file with - | FileName s -> - String.capitalize_ascii Filename.(basename (remove_extension s)) - | Contents _ -> "Module_name") + let program = parse_source_file source_file language in + let modname = + 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 '@{> Module \ + %s@}' directive." + (match source_file with + | FileName s -> "File " ^ s + | Contents _ -> "Source input") + (match source_file with + | 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) diff --git a/compiler/surface/parser_driver.mli b/compiler/surface/parser_driver.mli index 014b7d5f..0098565f 100644 --- a/compiler/surface/parser_driver.mli +++ b/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 - in the program are returned empty, use [load_interface] to fill them. *) +(** 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. *) diff --git a/tests/test_modules/good/output/mod_def.ml b/tests/test_modules/good/output/mod_def.ml index a31a196e..96e8de31 100644 --- a/tests/test_modules/good/output/mod_def.ml +++ b/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" diff --git a/tests/test_name_resolution/good/let_in2.catala_en b/tests/test_name_resolution/good/let_in2.catala_en index d2814dbf..1fb2dafb 100644 --- a/tests/test_name_resolution/good/let_in2.catala_en +++ b/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" ``` diff --git a/tests/test_scope/good/191_fix_record_name_confusion.catala_en b/tests/test_scope/good/191_fix_record_name_confusion.catala_en index 55059e01..30982c62 100644 --- a/tests/test_scope/good/191_fix_record_name_confusion.catala_en +++ b/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" ```