mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-19 16:28:12 +03:00
Improve handling of module name definitions
and add some sanity-checks for consistency of used modules w.r.t. actually loaded modules.
This commit is contained in:
parent
22c69938b6
commit
f162f6e9bd
@ -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;
|
||||
}
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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 ->
|
||||
|
@ -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 =
|
||||
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
|
||||
|
@ -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}*)
|
||||
|
@ -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 }
|
||||
|
@ -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
|
||||
|
@ -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. *)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
}
|
||||
|
@ -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
|
||||
|
@ -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; _ } =
|
||||
|
@ -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 =
|
||||
{
|
||||
|
@ -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]
|
||||
}
|
||||
|
||||
|
@ -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 '@{<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 =
|
||||
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 '@{<cyan>> 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 '@{<cyan>> 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)
|
||||
|
@ -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. *)
|
||||
|
@ -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"
|
||||
|
@ -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"
|
||||
```
|
||||
|
@ -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"
|
||||
```
|
||||
|
Loading…
Reference in New Issue
Block a user