extraction: simplified driver and test

parent 64dff8d3
......@@ -1650,38 +1650,15 @@ test-runstrat.opt: lib/why3/why3.cmxa lib/why3/META
test-runstrat: test-runstrat.$(OCAMLBEST)
test-ocaml-extraction: bin/why3.opt bin/why3extract.opt lib/why3/why3extract.cmxa
@echo "driver ocaml32"
@mkdir -p tests/test-extraction
@cd tests ; ../bin/why3extract.opt -D ocaml32 \
test_extraction.mlw -o test-extraction
@cd tests/test-extraction/ ; \
$(OCAMLOPT) @BIGINTINCLUDE@ -I ../../lib/why3 \
@BIGINTLIB@.cmxa why3extract.cmxa \
ref__Refint.ml test_extraction__TestExtraction.ml main.ml
@tests/test-extraction/a.out
test-ocaml-extraction: bin/why3.opt bin/why3extract.opt
@echo "driver ocaml64"
@cd tests ; ../bin/why3extract.opt -D ocaml64 \
test_extraction.mlw -o test-extraction
@cd tests/test-extraction/ ; \
$(OCAMLOPT) @BIGINTINCLUDE@ -I ../../lib/why3 \
@BIGINTLIB@.cmxa why3extract.cmxa \
ref__Refint.ml test_extraction__TestExtraction.ml main.ml
@bin/why3extract.opt -D ocaml64 -L tests \
test_extraction.TestExtraction -o tests/test-extraction/test.ml
@ocamlfind ocamlopt -package zarith -linkpkg -I tests/test-extraction/ \
tests/test-extraction/test.ml tests/test-extraction/main.ml \
-o tests/test-extraction/a.out
@tests/test-extraction/a.out
#######################################
# this should be removed in the future
#######################################
test-extraction: bin/why3.opt bin/why3extract.opt lib/why3/why3extract.cmxa
@mkdir -p tests/test-extraction-mario
@bin/why3extract.opt -D drivers/ocaml64.drv --modular --recursive \
-L tests/ test_extraction_mario.M -o tests/test-extraction-mario/
@ocamlfind ocamlopt -package zarith -linkpkg \
-I tests/test-extraction-mario/ \
tests/test-extraction-mario/test_extraction_mario__M.ml \
tests/test-extraction-mario/main.ml -o a.out
@tests/test-extraction-mario/a.out
################
# documentation
################
......
(* OCaml driver
Generic part, for both 32-bit and 64-bit architectures *)
printer "ocaml"
theory BuiltIn
syntax type int "Z.t"
syntax predicate (=) "%1 = %2"
end
import "ocaml-no-arith.drv"
(* int *)
module int.Int
syntax constant zero "Z.zero"
syntax constant one "Z.one"
syntax predicate (<) "Z.lt %1 %2"
syntax predicate (<=) "Z.leq %1 %2"
syntax predicate (>) "Z.gt %1 %2"
syntax predicate (>=) "Z.geq %1 %2"
syntax val (=) "Z.equal %1 %2"
syntax function (+) "Z.add %1 %2"
syntax function (-) "Z.sub %1 %2"
syntax function ( * ) "Z.mul %1 %2"
syntax function (-_) "Z.neg %1"
end
theory int.Abs
syntax function abs "Z.abs %1"
end
theory int.MinMax
syntax function min "Z.min %1 %2"
syntax function max "Z.max %1 %2"
end
(* TODO
theory int.Lex2
prelude "open Why3extract"
syntax predicate lt_nat "(Why3__BigInt.lt_nat %1 %2)"
syntax predicate lex "(Why3__BigInt.lex %1 %2)"
end
*)
theory int.EuclideanDivision
syntax function div "Z.ediv %1 %2"
syntax function mod "Z.erem %1 %2"
end
theory int.ComputerDivision
syntax function div "Z.div %1 %2"
syntax function mod "Z.rem %1 %2"
end
(* TODO Z.pow has type t -> int -> t, not t -> t -> t
theory int.Power
syntax function power "Z.pow %1 %2"
end
theory int.Fact
prelude "open Why3extract"
syntax function fact "(Why3__IntAux.fact %1)"
end
theory int.Fibonacci
prelude "open Why3extract"
syntax function fib "(Why3__IntAux.fib %1)"
end
*)
(* WhyML *)
module stack.Stack
syntax type t "%1 Stack.t"
syntax val create "Stack.create"
syntax val push "Stack.push"
syntax exception Empty "Stack.Empty"
syntax val pop "Stack.pop"
syntax val top "Stack.top"
syntax val safe_pop "Stack.pop"
syntax val safe_top "Stack.top"
syntax val clear "Stack.clear"
syntax val copy "Stack.copy"
syntax val is_empty "Stack.is_empty"
syntax val length "Z.of_int (Stack.length %1)"
end
module queue.Queue
syntax type t "%1 Queue.t"
syntax val create "Queue.create"
syntax val push "Queue.push"
syntax exception Empty "Queue.Empty"
syntax val pop "Queue.pop"
syntax val peek "Queue.peek"
syntax val safe_pop "Queue.pop"
syntax val safe_peek "Queue.peek"
syntax val clear "Queue.clear"
syntax val copy "Queue.copy"
syntax val is_empty "Queue.is_empty"
syntax val length "(Z.of_int (Queue.length %1))"
syntax val transfer "Queue.transfer"
end
module array.Array
syntax type array "%1 array"
syntax function ([]) "%1.(Z.to_int %2)"
(* syntax exception OutOfBounds "Why3__Array.OutOfBounds" *) (* FIXME *)
syntax val ([]) "%1.(Z.to_int %2)"
syntax val ([]<-) "%1.(Z.to_int %2) <- %3"
syntax val length "Z.of_int (Array.length %1)"
syntax val defensive_get "%1.(Z.to_int %2)"
syntax val defensive_set "%1.(Z.to_int %2) <- %3"
syntax val make "Array.make (Z.to_int %1) %2"
syntax val append "Array.append %1 %2"
syntax val sub "Array.sub %1 (Z.to_int %2) (Z.to_int %3)"
syntax val copy "Array.copy %1"
syntax val fill "Array.fill %1 (Z.to_int %2) (Z.to_int %3) %4"
syntax val blit "Array.blit %1 (Z.to_int %2) %3 (Z.to_int %4) (Z.to_int %5)"
end
module matrix.Matrix
prelude "open Why3extract"
syntax type matrix "(%1 Why3__Matrix.t)"
(* FIXME syntax function get "(Why3__Matrix.get %1 %2)" *)
syntax exception OutOfBounds "Why3__Matrix.OutOfBounds"
syntax val get "Why3__Matrix.get"
syntax val set "Why3__Matrix.set"
syntax val rows "Why3__Matrix.rows"
syntax val columns "Why3__Matrix.columns"
syntax val defensive_get "Why3__Matrix.defensive_get"
syntax val defensive_set "Why3__Matrix.defensive_set"
syntax val make "Why3__Matrix.make"
syntax val copy "Why3__Matrix.copy"
end
module mach.int.Int
syntax val ( / ) "Z.div %1 %2"
syntax val ( % ) "Z.rem %1 %2"
end
module mach.int.Int31
(* even on a 64-bit machine, it is safe to use type int for 31-bit integers *)
syntax val of_int "Why3extract.Why3__BigInt.to_int"
syntax converter of_int "%1"
syntax function to_int "(Why3extract.Why3__BigInt.of_int %1)"
syntax type int31 "int"
syntax val ( + ) "( + )"
syntax val ( - ) "( - )"
syntax val (-_) "( ~- )"
syntax val ( * ) "( * )"
syntax val ( / ) "( / )"
syntax val ( % ) "(mod)"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.UInt64
(* no OCaml library for unsigned 64-bit integers => we use BigInt *)
prelude "open Why3extract"
syntax val of_int "(fun x -> x)"
syntax converter of_int "(Why3__BigInt.of_string \"%1\")"
syntax function to_int "%1"
syntax type uint64 "Why3__BigInt.t"
syntax val ( + ) "Why3__BigInt.add"
syntax val ( - ) "Why3__BigInt.sub"
syntax val (-_) "Why3__BigInt.minus"
syntax val ( * ) "Why3__BigInt.mul"
syntax val ( / ) "Why3__BigInt.computer_div"
syntax val ( % ) "Why3__BigInt.computer_mod"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.array.Array31
syntax type array "(%1 array)"
syntax val make "Array.make"
syntax val ([]) "Array.get"
syntax val ([]<-) "Array.set"
syntax val length "Array.length"
syntax val append "Array.append"
syntax val sub "Array.sub"
syntax val copy "Array.copy"
syntax val fill "Array.fill"
syntax val blit "Array.blit"
syntax val self_blit "Array.blit"
end
module string.Char
prelude "open Why3extract"
syntax type char "Pervasives.char"
syntax val chr "Why3__BigInt.chr"
syntax val code "Why3__BigInt.code"
syntax function uppercase "Char.uppercase"
syntax function lowercase "Char.lowercase"
end
module io.StdIO
prelude "open Why3extract"
syntax val print_char "Pervasives.print_char"
syntax val print_int "Why3__BigInt.print"
syntax val print_newline "Pervasives.print_newline"
end
module random.Random
prelude "open Why3extract"
syntax val random_int "Why3__BigInt.random_int"
end
(** Arithmetic-independent OCaml driver *)
(* FIXME
theory HighOrd
syntax type func "(%1 -> %2)"
syntax type pred "(%1 -> bool)"
syntax function (@) "(%1 %2)"
end
*)
theory option.Option
syntax type option "%1 option"
syntax function None "None"
syntax function Some "Some %1"
end
(* bool *)
theory Bool
syntax type bool "bool"
syntax function True "true"
syntax function False "false"
end
theory bool.Ite
syntax function ite "(if %1 then %2 else %3)"
end
theory bool.Bool
syntax function andb "%1 && %2"
syntax function orb "%1 || %2"
syntax function xorb "%1 <> %2"
syntax function notb "not %1"
syntax function implb "not %1 || %2"
end
(* list *)
theory list.List
syntax type list "%1 list"
syntax function Nil "[]"
syntax function Cons "%1 :: %2"
syntax predicate is_nil "%1 = []"
end
theory list.Length
syntax function length "List.length %1"
end
theory list.Mem
syntax predicate mem "List.mem %1 %2"
end
theory list.Append
syntax function (++) "List.append %1 %2"
end
theory list.Reverse
syntax function reverse "List.rev %1"
end
theory list.RevAppend
syntax function rev_append "List.rev_append %1 %2"
end
theory list.Combine
syntax function combine "List.combine %1 %2"
end
(* WhyML *)
module ref.Ref
syntax type ref "%1 ref"
syntax function contents "!%1"
syntax val ref "ref %1"
syntax val (!_) "!%1"
syntax val (:=) "%1 := %2"
end
(* FIXME: once we extract ref.Refint, this module
will no longer be useful in the driver *)
module ref.Refint
syntax val incr "%1 := Z.succ (Pervasives.(!) %1)"
syntax val decr "%1 := Z.pred (Pervasives.(!) %1)"
syntax val (+=) "%1 := Z.add (Pervasives.(!) %1) %2"
syntax val (-=) "%1 := Z.sub (Pervasives.(!) %1) %2"
syntax val ( *= ) "%1 := Z.mul (Pervasives.(!) %1) %2"
end
module null.Null
syntax type t "%1"
syntax val create_null "(fun () -> Obj.magic (ref 0))"
syntax val eq_null "(==)"
syntax val create "(fun x -> x)"
syntax val get "(fun x -> x)"
end
(** OCaml driver for 64-bit architecture *)
import "ocaml-gen.drv"
printer "ocaml"
(** Machine arithmetic *)
theory BuiltIn
syntax type int "Z.t"
syntax predicate (=) "%1 = %2"
end
(*
module mach.int.Int32
syntax val of_int "Why3extract.Why3__BigInt.to_int"
syntax converter of_int "%1"
theory option.Option
syntax type option "%1 option"
syntax function None "None"
syntax function Some "Some %1"
end
syntax function to_int "(Why3extract.Why3__BigInt.of_int %1)"
syntax type int32 "int"
syntax val ( + ) "( + )"
syntax val ( - ) "( - )"
syntax val (-_) "( ~- )"
syntax val ( * ) "( * )"
syntax val ( / ) "( / )"
syntax val ( % ) "(mod)"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.UInt32
syntax val of_int "Why3extract.Why3__BigInt.to_int"
syntax converter of_int "%1"
theory Bool
syntax type bool "bool"
syntax function True "true"
syntax function False "false"
end
theory bool.Ite
syntax function ite "(if %1 then %2 else %3)"
end
theory bool.Bool
syntax function andb "%1 && %2"
syntax function orb "%1 || %2"
syntax function xorb "%1 <> %2"
syntax function notb "not %1"
syntax function implb "not %1 || %2"
end
theory list.List
syntax type list "%1 list"
syntax function Nil "[]"
syntax function Cons "%1 :: %2"
syntax predicate is_nil "%1 = []"
end
theory list.Length
syntax function length "List.length %1"
end
theory list.Mem
syntax predicate mem "List.mem %1 %2"
end
syntax function to_int "(Why3extract.Why3__BigInt.of_int %1)"
syntax constant zero_unsigned "0"
theory list.Append
syntax function (++) "List.append %1 %2"
end
theory list.Reverse
syntax function reverse "List.rev %1"
end
theory list.RevAppend
syntax function rev_append "List.rev_append %1 %2"
end
syntax type uint32 "int"
syntax val ( + ) "( + )"
syntax val ( - ) "( - )"
syntax val (-_) "( ~- )"
syntax val ( * ) "( * )"
syntax val ( / ) "( / )"
syntax val ( % ) "(mod)"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
theory list.Combine
syntax function combine "List.combine %1 %2"
end
module ref.Ref
syntax type ref "%1 ref"
syntax function contents "!%1"
syntax val ref "ref %1"
syntax val (!_) "!%1"
syntax val (:=) "%1 := %2"
end
syntax val add_with_carry "(fun x y c ->
let r = x + y + c in
(r land 0xFFFFFFFF,r lsr 32))"
module ref.Refint
syntax val incr "%1 := Z.succ (Pervasives.(!) %1)"
syntax val decr "%1 := Z.pred (Pervasives.(!) %1)"
syntax val (+=) "%1 := Z.add (Pervasives.(!) %1) %2"
syntax val (-=) "%1 := Z.sub (Pervasives.(!) %1) %2"
syntax val ( *= ) "%1 := Z.mul (Pervasives.(!) %1) %2"
end
syntax val add3 "(fun x y z ->
let r = x + y + z in
(r land 0xFFFFFFFF,r lsr 32))"
module null.Null
syntax val mul_double "(fun x y ->
let r = Int64.mul (Int64.of_int x) (Int64.of_int y) in
(Int64.to_int (Int64.logand r 0xFFFFFFFFL),Int64.to_int (Int64.shift_right_logical r 32)))"
syntax type t "%1"
syntax val create_null "(fun () -> Obj.magic (ref 0))"
syntax val eq_null "(==)"
syntax val create "(fun x -> x)"
syntax val get "(fun x -> x)"
end
*)
module int.Int
syntax constant zero "Z.zero"
syntax constant one "Z.one"
syntax predicate (<) "Z.lt %1 %2"
syntax predicate (<=) "Z.leq %1 %2"
syntax predicate (>) "Z.gt %1 %2"
syntax predicate (>=) "Z.geq %1 %2"
syntax val (=) "Z.equal %1 %2"
syntax function (+) "Z.add %1 %2"
syntax function (-) "Z.sub %1 %2"
syntax function ( * ) "Z.mul %1 %2"
syntax function (-_) "Z.neg %1"
end
theory int.Abs
syntax function abs "Z.abs %1"
end
theory int.MinMax
syntax function min "Z.min %1 %2"
syntax function max "Z.max %1 %2"
end
module int.EuclideanDivision
syntax val div "Z.ediv %1 %2"
syntax val mod "Z.erem %1 %2"
end
module int.ComputerDivision
syntax val div "Z.div %1 %2"
syntax val mod "Z.rem %1 %2"
end
module stack.Stack
syntax type t "%1 Stack.t"
syntax val create "Stack.create"
syntax val push "Stack.push"
syntax exception Empty "Stack.Empty"
syntax val pop "Stack.pop"
syntax val top "Stack.top"
syntax val safe_pop "Stack.pop"
syntax val safe_top "Stack.top"
syntax val clear "Stack.clear"
syntax val copy "Stack.copy"
syntax val is_empty "Stack.is_empty"
syntax val length "Z.of_int (Stack.length %1)"
end
module queue.Queue
syntax type t "%1 Queue.t"
syntax val create "Queue.create"
syntax val push "Queue.push"
syntax exception Empty "Queue.Empty"
syntax val pop "Queue.pop"
syntax val peek "Queue.peek"
syntax val safe_pop "Queue.pop"
syntax val safe_peek "Queue.peek"
syntax val clear "Queue.clear"
syntax val copy "Queue.copy"
syntax val is_empty "Queue.is_empty"
syntax val length "(Z.of_int (Queue.length %1))"
syntax val transfer "Queue.transfer"
end
module array.Array
syntax type array "%1 array"
syntax function ([]) "%1.(Z.to_int %2)"
(* syntax exception OutOfBounds "Why3__Array.OutOfBounds" *) (* FIXME *)
syntax val ([]) "%1.(Z.to_int %2)"
syntax val ([]<-) "%1.(Z.to_int %2) <- %3"
syntax val length "Z.of_int (Array.length %1)"
syntax val defensive_get "%1.(Z.to_int %2)"
syntax val defensive_set "%1.(Z.to_int %2) <- %3"
syntax val make "Array.make (Z.to_int %1) %2"
syntax val append "Array.append %1 %2"
syntax val sub "Array.sub %1 (Z.to_int %2) (Z.to_int %3)"
syntax val copy "Array.copy %1"
syntax val fill "Array.fill %1 (Z.to_int %2) (Z.to_int %3) %4"
syntax val blit "Array.blit %1 (Z.to_int %2) %3 (Z.to_int %4) (Z.to_int %5)"
end
module matrix.Matrix
syntax type matrix "%1 array array"
(* syntax exception OutOfBounds "Why3__Matrix.OutOfBounds" *) (* FIXME *)
syntax val get "%1.(%2).(%3)"
syntax val set "%1.(%2).(%3) <- %4"
syntax val rows "Z.of_int (Array.length %1)"
syntax val columns "Z.of_int (.Array.length %1.(0))"
syntax val defensive_get "%1.(Z.to_int %2).(Z.to_int %3)"
syntax val defensive_set "%1.(Z.to_int %2).(Z.to_int %3) <- %4"
syntax val make "Array.make_matrix (Z.to_int %1) (Z.to_int %2) %3"
syntax val copy "Array.map Array.copy %1"
end
module mach.int.Int
syntax val ( / ) "Z.div %1 %2"
syntax val ( % ) "Z.rem %1 %2"
end
module mach.int.Int63
syntax val of_int "Z.to_int %1"
......@@ -90,6 +221,25 @@ module mach.int.Int63
(* syntax val to_bv "(fun x -> x)"
syntax val of_bv "(fun x -> x)"*)
end
module string.Char
syntax type char "Pervasives.char"
syntax val chr "Char.chr (Z.to_int %1)"
syntax val code "Z.of_int (Char.code %1)"
syntax function uppercase "Char.uppercase %1"
syntax function lowercase "Char.lowercase %1"
end
module io.StdIO
syntax val print_char "Pervasives.print_char %1"
syntax val print_int "Pervasives.print_int (Z.to_int %1)"
syntax val print_newline "Pervasives.print_newline"
end
module random.Random
syntax val random_int "Z.of_int (Random.int (Z.to_int %1))"
end
module mach.int.Refint63
syntax val incr "Pervasives.incr %1"
syntax val decr "Pervasives.decr %1"
......@@ -102,107 +252,6 @@ module mach.int.MinMax63
syntax val max "Pervasives.max"
end
(*
module mach.int.Int64