From f09eabd7c0fce7c20a0124749c841cbf5b550c52 Mon Sep 17 00:00:00 2001
From: Jonathan Protzenko
Date: Thu, 2 Feb 2023 23:49:23 -0800
Subject: All of the generated code is syntactically correct

---
 compiler/Extract.ml     |  9 +++++----
 compiler/ExtractBase.ml | 18 ++++++++++++++----
 2 files changed, 19 insertions(+), 8 deletions(-)

(limited to 'compiler')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index e1b2b23f..24f8d141 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -476,10 +476,8 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
   in
   let fun_name (fname : fun_name) (num_loops : int) (loop_id : LoopId.id option)
       (num_rgs : int) (rg : region_group_info option) (filter_info : bool * int)
-      (missing_body: bool)
       : string =
     let fname = fun_name_to_snake_case fname in
-    let fname = if !backend = Lean && missing_body then "opaque_defs." ^ fname else fname in
     (* Compute the suffix *)
     let suffix = default_fun_suffix num_loops loop_id num_rgs rg filter_info in
     (* Concatenate *)
@@ -1581,7 +1579,10 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
       (* Open a box for the function call *)
       F.pp_open_hovbox fmt ctx.indent_incr;
       (* Print the function name *)
-      let fun_name = ctx_get_function fun_id ctx in
+      let fun_name = Option.value
+        ~default:(ctx_get_function fun_id ctx)
+        (ctx_maybe_get (DeclaredId fun_id) ctx)
+      in
       F.pp_print_string fmt fun_name;
       (* Print the type parameters *)
       List.iter
@@ -2612,7 +2613,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter)
         F.pp_print_string fmt "=";
         F.pp_print_space fmt ();
         let success = ctx_get_variant (Assumed Result) result_return_id ctx in
-        F.pp_print_string fmt (success ^ " ())")
+        F.pp_print_string fmt ("." ^ success ^ " ())")
     );
     (* Close the box for the test *)
     F.pp_close_box fmt ();
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 98a29daf..4c4a9959 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -168,7 +168,6 @@ type formatter = {
     int ->
     region_group_info option ->
     bool * int ->
-    bool ->
     string;
       (** Compute the name of a regular (non-assumed) function.
 
@@ -188,7 +187,6 @@ type formatter = {
               The number of extracted backward functions if not necessarily
               equal to the number of region groups, because we may have
               filtered some of them.
-          - whether there is a body or not (indicates assumed function)
           TODO: use the fun id for the assumed functions.
        *)
   decreases_clause_name :
@@ -296,6 +294,7 @@ type formatter = {
 type id =
   | GlobalId of A.GlobalDeclId.id
   | FunId of fun_id
+  | DeclaredId of fun_id
   | DecreasesClauseId of (A.fun_id * LoopId.id option)
       (** The definition which provides the decreases/termination clause.
           We insert calls to this clause to prove/reason about termination:
@@ -472,6 +471,7 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | GlobalId gid ->
       let name = (A.GlobalDeclId.Map.find gid global_decls).name in
       "global name: " ^ Print.global_name_to_string name
+  | DeclaredId fid
   | FunId fid -> (
       match fid with
       | FromLlbc (fid, lp_id, rg_id) ->
@@ -584,8 +584,11 @@ let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx =
   let names_map = names_map_add id_to_string id name ctx.names_map in
   { ctx with names_map }
 
+let ctx_maybe_get (id : id) (ctx : extraction_ctx) : string option =
+  IdMap.find_opt id ctx.names_map.id_to_name
+
 let ctx_get (id : id) (ctx : extraction_ctx) : string =
-  match IdMap.find_opt id ctx.names_map.id_to_name with
+  match ctx_maybe_get id ctx with
   | Some s -> s
   | None ->
       log#serror ("Could not find: " ^ id_to_string id ctx);
@@ -776,7 +779,14 @@ let ctx_add_fun_decl (trans_group : bool * pure_fun_translation)
   in
   let name =
     ctx.fmt.fun_name def.basename def.num_loops def.loop_id num_rgs rg_info
-      (keep_fwd, num_backs) (def.body = None)
+      (keep_fwd, num_backs)
+  in
+  let ctx = if def.body = None && !Config.backend = Lean then
+    ctx_add
+      (DeclaredId (FromLlbc (A.Regular def_id, def.loop_id, def.back_id)))
+      ("opaque_defs." ^ name) ctx
+  else
+    ctx
   in
   ctx_add
     (FunId (FromLlbc (A.Regular def_id, def.loop_id, def.back_id)))
-- 
cgit v1.2.3