Commit b7e23f63 authored by Mário Pereira's avatar Mário Pereira

Extraction: fix extraction of zero-argument functions and partial application

parent 44f44412
This diff is collapsed.
...@@ -315,8 +315,10 @@ module Print = struct ...@@ -315,8 +315,10 @@ module Print = struct
else fprintf fmt "%a" (print_expr ~paren:true info) expr; else fprintf fmt "%a" (print_expr ~paren:true info) expr;
if exprl <> [] then fprintf fmt "@ "; if exprl <> [] then fprintf fmt "@ ";
print_apply_args info fmt (exprl, pvl) print_apply_args info fmt (exprl, pvl)
| expr :: exprl, [] ->
fprintf fmt "%a" (print_expr ~paren:true info) expr;
print_apply_args info fmt (exprl, [])
| [], _ -> () | [], _ -> ()
| _, [] -> assert false
and print_apply info rs fmt pvl = and print_apply info rs fmt pvl =
let isfield = let isfield =
...@@ -360,7 +362,7 @@ module Print = struct ...@@ -360,7 +362,7 @@ module Print = struct
end end
| _, None, [] -> | _, None, [] ->
(print_lident info) fmt rs.rs_name (print_lident info) fmt rs.rs_name
| _, _, tl -> (* FIXME? when is in driver but is not a local id *) | _, _, tl ->
fprintf fmt "@[<hov 2>%a %a@]" fprintf fmt "@[<hov 2>%a %a@]"
(print_lident info) rs.rs_name (print_lident info) rs.rs_name
(print_apply_args info) (tl, rs.rs_cty.cty_args) (print_apply_args info) (tl, rs.rs_cty.cty_args)
......
...@@ -8,11 +8,11 @@ let () = assert (test_array () = 42) ...@@ -8,11 +8,11 @@ let () = assert (test_array () = 42)
let (=) = Z.equal let (=) = Z.equal
let b42 = Z.of_int 42 let b42 = Z.of_int 42
let () = assert (test_int () = b42) let () = assert (test_int () = b42)
let () = assert (test_int63 () = b42) let () = assert (test_int63 () = b42)
let () = assert (test_ref () = b42) let () = assert (test_ref () = b42)
let () = assert (test_array63 () = b42) let () = assert (test_array63 () = b42)
let () = assert (test_partial2 () = b42)
let () = main () let () = main ()
let () = Format.printf "OCaml extraction test successful@." let () = Format.printf "OCaml extraction test successful@."
......
...@@ -172,6 +172,15 @@ module TestExtraction ...@@ -172,6 +172,15 @@ module TestExtraction
let partial = test_filter_ghost_args 3 in let partial = test_filter_ghost_args 3 in
42 42
let constant test_partial2 : int =
let r = ref 0 in
let f (x: int) (ghost y) = r := !r + 21 in
let g = f 17 in
g (0:int); g (1:int); !r
let test_zero_args () : int =
test_partial2 + 0
let test_filter_ghost_args2 (x: int) (ghost y: int) (z: int) : int = let test_filter_ghost_args2 (x: int) (ghost y: int) (z: int) : int =
x + z x + z
...@@ -199,7 +208,7 @@ module TestExtraction ...@@ -199,7 +208,7 @@ module TestExtraction
let res = yxz - xzy in let res = yxz - xzy in
res res
let test_partial2 (x: int) : int = let test_partial3 (x: int) : int =
let sum : int -> int -> int = fun x y -> x + y in let sum : int -> int -> int = fun x y -> x + y in
let incr_a (a: int) = sum a in let incr_a (a: int) = sum a in
incr_a x x incr_a x x
......
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