Commit 682f1410 authored by Mário Pereira's avatar Mário Pereira

Code extraction

Preparing for the GT demo
parent da763318
...@@ -65,7 +65,7 @@ end ...@@ -65,7 +65,7 @@ end
*) *)
module mach.int.Int63 module mach.int.Int63
syntax val of_int "%1" syntax val of_int "Z.to_int %1"
syntax converter of_int "%1" syntax converter of_int "%1"
syntax function to_int "Z.of_int %1" syntax function to_int "Z.of_int %1"
......
...@@ -87,7 +87,7 @@ module Print = struct ...@@ -87,7 +87,7 @@ module Print = struct
fprintf fmt "%s" s fprintf fmt "%s" s
let print_qident ~sanitizer info fmt id = let print_qident ~sanitizer info fmt id =
try (* if info.flat then raise Not_found; *) try
let lp, t, q = let lp, t, q =
try Pmodule.restore_path id try Pmodule.restore_path id
with Not_found -> Theory.restore_path id in with Not_found -> Theory.restore_path id in
...@@ -111,8 +111,8 @@ module Print = struct ...@@ -111,8 +111,8 @@ module Print = struct
let print_lident = print_qident ~sanitizer:Strings.uncapitalize let print_lident = print_qident ~sanitizer:Strings.uncapitalize
let print_uident = print_qident ~sanitizer:Strings.capitalize let print_uident = print_qident ~sanitizer:Strings.capitalize
let print_tv fmt tv = let print_tv info fmt tv =
fprintf fmt "'%s" (id_unique aprinter tv.tv_name) fprintf fmt "'%a" (print_lident info) tv.tv_name
let protect_on b s = let protect_on b s =
if b then "(" ^^ s ^^ ")" else s if b then "(" ^^ s ^^ ")" else s
...@@ -133,7 +133,7 @@ module Print = struct ...@@ -133,7 +133,7 @@ module Print = struct
let rec print_ty ?(paren=false) info fmt = function let rec print_ty ?(paren=false) info fmt = function
| Tvar tv -> | Tvar tv ->
print_tv fmt tv print_tv info fmt tv
| Ttuple [] -> | Ttuple [] ->
fprintf fmt "unit" fprintf fmt "unit"
| Ttuple tl -> | Ttuple tl ->
...@@ -161,11 +161,11 @@ module Print = struct ...@@ -161,11 +161,11 @@ module Print = struct
let print_vsty info fmt (v, ty, _) = let print_vsty info fmt (v, ty, _) =
fprintf fmt "%a:@ %a" print_ident v (print_ty ~paren:false info) ty fprintf fmt "%a:@ %a" print_ident v (print_ty ~paren:false info) ty
let print_tv_arg = print_tv let print_tv_arg info = print_tv info
let print_tv_args fmt = function let print_tv_args info fmt = function
| [] -> () | [] -> ()
| [tv] -> fprintf fmt "%a@ " print_tv_arg tv | [tv] -> fprintf fmt "%a@ " (print_tv_arg info) tv
| tvl -> fprintf fmt "(%a)@ " (print_list comma print_tv_arg) tvl | tvl -> fprintf fmt "(%a)@ " (print_list comma (print_tv_arg info)) tvl
let print_vs_arg info fmt vs = let print_vs_arg info fmt vs =
fprintf fmt "@[(%a)@]" (print_vsty info) vs fprintf fmt "@[(%a)@]" (print_vsty info) vs
...@@ -446,7 +446,7 @@ module Print = struct ...@@ -446,7 +446,7 @@ module Print = struct
fprintf fmt " =@ %a" (print_ty ~paren:false info) ty fprintf fmt " =@ %a" (print_ty ~paren:false info) ty
in in
fprintf fmt "@[<hov 2>%s %a%a%a@]" 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 (print_lident info) its.its_name print_def its.its_def
let print_decl info fmt = function let print_decl info fmt = function
......
...@@ -290,9 +290,11 @@ let visit mm id = ...@@ -290,9 +290,11 @@ let visit mm id =
else toextract := id :: !toextract else toextract := id :: !toextract
let flat_extraction target = match Opt.get target with let flat_extraction target = match Opt.get target with
| File _ -> () | File fname ->
(* let format = !opt_parser in let format = !opt_parser in
read_mlw_file ?format env fname *) 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) -> | Module (path, m) ->
let mm = Mstr.empty in let mm = Mstr.empty in
let m = find_module_path mm path m in let m = find_module_path mm path m in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment