From db87409125dcfc39e7cebf0c81a6aa3ff87b81f6 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Mon, 27 May 2024 11:45:45 +0200 Subject: [PATCH] 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. --- compiler/catala_utils/hash.ml | 2 ++ compiler/catala_utils/hash.mli | 8 ++++++++ compiler/lcalc/to_ocaml.ml | 18 ++++++++++++++---- compiler/shared_ast/interpreter.ml | 13 +++++++++---- doc/devel/externals.md | 12 +++++++----- tests/modules/good/prorata_external.ml | 2 +- 6 files changed, 41 insertions(+), 14 deletions(-) diff --git a/compiler/catala_utils/hash.ml b/compiler/catala_utils/hash.ml index 7af724c8..4854ffab 100644 --- a/compiler/catala_utils/hash.ml +++ b/compiler/catala_utils/hash.ml @@ -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*" diff --git a/compiler/catala_utils/hash.mli b/compiler/catala_utils/hash.mli index 89435c04..b70ba2f1 100644 --- a/compiler/catala_utils/hash.mli +++ b/compiler/catala_utils/hash.mli @@ -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. *) diff --git a/compiler/lcalc/to_ocaml.ml b/compiler/lcalc/to_ocaml.ml index 2535dde0..e1c65611 100644 --- a/compiler/lcalc/to_ocaml.ml +++ b/compiler/lcalc/to_ocaml.ml @@ -725,8 +725,12 @@ let check_and_reexport_used_modules fmt ~hashf modules = | Ok () -> ()@,\ @[| 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 "@[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 diff --git a/compiler/shared_ast/interpreter.ml b/compiler/shared_ast/interpreter.ml index 4b4d328d..88837758 100644 --- a/compiler/shared_ast/interpreter.ml +++ b/compiler/shared_ast/interpreter.ml @@ -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>@[%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 "") + with Failure _ -> + if h = Hash.external_placeholder then + Format.fprintf ppf "@{%s@}" Hash.external_placeholder + else Format.fprintf ppf "@{@}") bad_hash; Message.error "Module %a@ needs@ recompiling:@ %a@ was@ likely@ compiled@ from@ an@ \ diff --git a/doc/devel/externals.md b/doc/devel/externals.md index 6d837c09..28c7cfbe 100644 --- a/doc/devel/externals.md +++ b/doc/devel/externals.md @@ -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 diff --git a/tests/modules/good/prorata_external.ml b/tests/modules/good/prorata_external.ml index 528e1f16..97c8be44 100644 --- a/tests/modules/good/prorata_external.ml +++ b/tests/modules/good/prorata_external.ml @@ -37,4 +37,4 @@ let () = Runtime_ocaml.Runtime.register_module "Prorata_external" [ "prorata", Obj.repr prorata_; "prorata2", Obj.repr prorata2_ ] - "todo-module-hash" + "*external*"