mirror of
https://github.com/CatalaLang/catala.git
synced 2024-11-08 07:51:43 +03:00
Replace module hashes for external modules
NOTE: This is a temporary solution A future approach could be to have Catala generate a module loader (with the proper hash), relieving the user implementation from having to do the registration.
This commit is contained in:
parent
f04e889173
commit
db87409125
@ -106,3 +106,5 @@ let of_string s =
|
||||
(fun catala_version flags_hash contents ->
|
||||
{ catala_version; flags_hash = Flags.of_t flags_hash; contents })
|
||||
with Scanf.Scan_failure _ -> failwith "Hash.of_string"
|
||||
|
||||
let external_placeholder = "*external*"
|
||||
|
@ -71,3 +71,11 @@ val format : Format.formatter -> full -> unit
|
||||
|
||||
val of_string : string -> full
|
||||
(** @raise Failure *)
|
||||
|
||||
val external_placeholder : string
|
||||
(** It's inconvenient to need hash updates on external modules. This string is
|
||||
uses as a hash instead for those cases.
|
||||
|
||||
NOTE: This is a temporary solution A future approach could be to have Catala
|
||||
generate a module loader (with the proper hash), relieving the user
|
||||
implementation from having to do the registration. *)
|
||||
|
@ -725,8 +725,12 @@ let check_and_reexport_used_modules fmt ~hashf modules =
|
||||
| Ok () -> ()@,\
|
||||
@[<hv 2>| Error h -> failwith \"Hash mismatch for module %a, it may \
|
||||
need recompiling\"@]@]@,"
|
||||
(ModuleName.to_string m) Hash.format (hashf intf_id.hash)
|
||||
ModuleName.format m;
|
||||
(ModuleName.to_string m)
|
||||
(fun ppf h ->
|
||||
if intf_id.is_external then
|
||||
Format.pp_print_string ppf Hash.external_placeholder
|
||||
else Hash.format ppf h)
|
||||
(hashf intf_id.hash) ModuleName.format m;
|
||||
Format.fprintf fmt "@[<hv 2>module %a@ = %a@]@," ModuleName.format m
|
||||
ModuleName.format m)
|
||||
modules
|
||||
@ -735,7 +739,8 @@ let format_module_registration
|
||||
fmt
|
||||
(bnd : ('m Ast.expr Var.t * _) String.Map.t)
|
||||
modname
|
||||
hash =
|
||||
hash
|
||||
is_external =
|
||||
Format.pp_open_vbox fmt 2;
|
||||
Format.pp_print_string fmt "let () =";
|
||||
Format.pp_print_space fmt ();
|
||||
@ -758,7 +763,11 @@ let format_module_registration
|
||||
Format.pp_print_char fmt ' ';
|
||||
Format.pp_print_string fmt "]";
|
||||
Format.pp_print_space fmt ();
|
||||
Format.fprintf fmt "\"%a\"" Hash.format hash;
|
||||
Format.fprintf fmt "\"%a\""
|
||||
(fun ppf h ->
|
||||
if is_external then Format.pp_print_string ppf Hash.external_placeholder
|
||||
else Hash.format ppf h)
|
||||
hash;
|
||||
Format.pp_close_box fmt ();
|
||||
Format.pp_close_box fmt ();
|
||||
Format.pp_print_newline fmt ()
|
||||
@ -791,6 +800,7 @@ let format_program
|
||||
match p.module_name, exec_scope with
|
||||
| Some (modname, intf_id), None ->
|
||||
format_module_registration fmt bnd modname (hashf intf_id.hash)
|
||||
intf_id.is_external
|
||||
| None, Some scope_name ->
|
||||
let scope_body = Program.get_scope_body p scope_name in
|
||||
format_scope_exec p.decl_ctx fmt bnd scope_name scope_body
|
||||
|
@ -1158,6 +1158,10 @@ let evaluate_expr ctx lang e = evaluate_expr ctx lang (addcustom e)
|
||||
let load_runtime_modules ~hashf prg =
|
||||
let load (mname, intf_id) =
|
||||
let hash = hashf intf_id.hash in
|
||||
let expect_hash =
|
||||
if intf_id.is_external then Hash.external_placeholder
|
||||
else Hash.to_string hash
|
||||
in
|
||||
let obj_file =
|
||||
Dynlink.adapt_filename
|
||||
File.(Pos.get_file (Mark.get (ModuleName.get_info mname)) -.- "cmo")
|
||||
@ -1176,9 +1180,7 @@ let load_runtime_modules ~hashf prg =
|
||||
"While loading compiled module from %a:@;<1 2>@[<hov>%a@]"
|
||||
File.format obj_file Format.pp_print_text
|
||||
(Dynlink.error_message dl_err));
|
||||
match
|
||||
Runtime.check_module (ModuleName.to_string mname) (Hash.to_string hash)
|
||||
with
|
||||
match Runtime.check_module (ModuleName.to_string mname) expect_hash with
|
||||
| Ok () -> ()
|
||||
| Error bad_hash ->
|
||||
Message.debug
|
||||
@ -1186,7 +1188,10 @@ let load_runtime_modules ~hashf prg =
|
||||
ModuleName.format mname Hash.format hash
|
||||
(fun ppf h ->
|
||||
try Hash.format ppf (Hash.of_string h)
|
||||
with Failure _ -> Format.pp_print_string ppf "<invalid>")
|
||||
with Failure _ ->
|
||||
if h = Hash.external_placeholder then
|
||||
Format.fprintf ppf "@{<cyan>%s@}" Hash.external_placeholder
|
||||
else Format.fprintf ppf "@{<red><invalid>@}")
|
||||
bad_hash;
|
||||
Message.error
|
||||
"Module %a@ needs@ recompiling:@ %a@ was@ likely@ compiled@ from@ an@ \
|
||||
|
@ -31,10 +31,10 @@ catala implementation and compile to OCaml (removing the `external` directive):
|
||||
```
|
||||
|
||||
```shell-session
|
||||
$ clerk build _build/.../Prorata_external.ml
|
||||
$ clerk build _build/.../prorata_external.ml
|
||||
```
|
||||
|
||||
(beware the `_build/`, and the capitalisation of the module name)
|
||||
(beware the `_build/`, it is required here)
|
||||
|
||||
|
||||
## Write the OCaml implementation
|
||||
@ -44,9 +44,11 @@ capitalisation to match). Edit to replace the dummy implementation by your code.
|
||||
Refer to `runtimes/ocaml/runtime.mli` for what is available (especially the
|
||||
`Oper` module to manipulate the types).
|
||||
|
||||
Keep the `register_module` at the end as is, it's needed for the toplevel to use
|
||||
the value (you would get `Failure("Could not resolve reference to Xxx")` during
|
||||
evaluation).
|
||||
Keep the `register_module` at the end, but replace the hash (which should be of
|
||||
the form `"CM0|XXXXXXXX|XXXXXXXX|XXXXXXXX"`) by the string `"*external*"`. This
|
||||
section is needed for the Catala interpreter to find the declared values --- the
|
||||
error `Failure("Could not resolve reference to Xxx")` during evaluation is a
|
||||
symptom that it is missing.
|
||||
|
||||
## Compile and test
|
||||
|
||||
|
@ -37,4 +37,4 @@ let () =
|
||||
Runtime_ocaml.Runtime.register_module "Prorata_external"
|
||||
[ "prorata", Obj.repr prorata_;
|
||||
"prorata2", Obj.repr prorata2_ ]
|
||||
"todo-module-hash"
|
||||
"*external*"
|
||||
|
Loading…
Reference in New Issue
Block a user