From 682f1410efc376b9ecccd6e2f002be5e0da6a089 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?M=C3=A1rio=20Pereira?= <mpereira@lri.fr>
Date: Fri, 3 Mar 2017 14:03:04 +0100
Subject: [PATCH] Code extraction

Preparing for the GT demo
---
 drivers/ocaml64.drv      |  2 +-
 src/mlw/ocaml_printer.ml | 18 +++++++++---------
 src/tools/why3extract.ml |  8 +++++---
 3 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/drivers/ocaml64.drv b/drivers/ocaml64.drv
index 6a4d5acd6..bf475ee09 100644
--- a/drivers/ocaml64.drv
+++ b/drivers/ocaml64.drv
@@ -65,7 +65,7 @@ end
 *)
 
 module mach.int.Int63
-  syntax val of_int "%1"
+  syntax val of_int "Z.to_int %1"
   syntax converter of_int "%1"
 
   syntax function to_int "Z.of_int %1"
diff --git a/src/mlw/ocaml_printer.ml b/src/mlw/ocaml_printer.ml
index 194482474..1036bf05d 100644
--- a/src/mlw/ocaml_printer.ml
+++ b/src/mlw/ocaml_printer.ml
@@ -87,7 +87,7 @@ module Print = struct
     fprintf fmt "%s" s
 
   let print_qident ~sanitizer info fmt id =
-    try (* if info.flat then raise Not_found; *)
+    try
       let lp, t, q =
         try Pmodule.restore_path id
         with Not_found -> Theory.restore_path id in
@@ -111,8 +111,8 @@ module Print = struct
   let print_lident = print_qident ~sanitizer:Strings.uncapitalize
   let print_uident = print_qident ~sanitizer:Strings.capitalize
 
-  let print_tv fmt tv =
-    fprintf fmt "'%s" (id_unique aprinter tv.tv_name)
+  let print_tv info fmt tv =
+    fprintf fmt "'%a" (print_lident info) tv.tv_name
 
   let protect_on b s =
     if b then "(" ^^ s ^^ ")" else s
@@ -133,7 +133,7 @@ module Print = struct
 
   let rec print_ty ?(paren=false) info fmt = function
     | Tvar tv ->
-      print_tv fmt tv
+      print_tv info fmt tv
     | Ttuple [] ->
       fprintf fmt "unit"
     | Ttuple tl ->
@@ -161,11 +161,11 @@ module Print = struct
   let print_vsty info fmt (v, ty, _) =
     fprintf fmt "%a:@ %a" print_ident v (print_ty ~paren:false info) ty
 
-  let print_tv_arg = print_tv
-  let print_tv_args fmt = function
+  let print_tv_arg info = print_tv info
+  let print_tv_args info fmt = function
     | []   -> ()
-    | [tv] -> fprintf fmt "%a@ " print_tv_arg tv
-    | tvl  -> fprintf fmt "(%a)@ " (print_list comma print_tv_arg) tvl
+    | [tv] -> fprintf fmt "%a@ " (print_tv_arg info) tv
+    | tvl  -> fprintf fmt "(%a)@ " (print_list comma (print_tv_arg info)) tvl
 
   let print_vs_arg info fmt vs =
     fprintf fmt "@[(%a)@]" (print_vsty info) vs
@@ -446,7 +446,7 @@ module Print = struct
         fprintf fmt " =@ %a" (print_ty ~paren:false info) ty
     in
     fprintf fmt "@[<hov 2>%s %a%a%a@]"
-      (if fst then "type" else "and") print_tv_args its.its_args
+      (if fst then "type" else "and") (print_tv_args info) its.its_args
       (print_lident info) its.its_name print_def its.its_def
 
   let print_decl info fmt = function
diff --git a/src/tools/why3extract.ml b/src/tools/why3extract.ml
index e28147d6e..246a436bc 100644
--- a/src/tools/why3extract.ml
+++ b/src/tools/why3extract.ml
@@ -290,9 +290,11 @@ let visit mm id =
   else toextract := id :: !toextract
 
 let flat_extraction target = match Opt.get target with
-  | File _ -> ()
-  (*  let format = !opt_parser in
-      read_mlw_file ?format env fname *)
+  | File fname ->
+    let format = !opt_parser in
+    let mm = read_mlw_file ?format env fname in
+    let do_m _ m = do_extract_module ~fname m in
+    Mstr.iter do_m mm
   | Module (path, m) ->
     let mm = Mstr.empty in
     let m = find_module_path mm path m in
-- 
GitLab