[extraction] two drivers for OCaml, namely ocaml32 and ocaml64

support for 31/32/63/64-bit integers in extracted code
parent 45e16b14
...@@ -181,6 +181,8 @@ pvsbin/ ...@@ -181,6 +181,8 @@ pvsbin/
/tests/test-pgm-jcf/ /tests/test-pgm-jcf/
/tests/test-claude/ /tests/test-claude/
/tests/test-and/ /tests/test-and/
/tests/test-extraction/*
!/tests/test-extraction/main.ml
# /examples/ # /examples/
/examples/in_progress/course/ /examples/in_progress/course/
......
...@@ -167,13 +167,13 @@ $(LIBDEP): $(LIBGENERATED) ...@@ -167,13 +167,13 @@ $(LIBDEP): $(LIBGENERATED)
ifeq (@enable_zarith@,yes) ifeq (@enable_zarith@,yes)
lib/ocaml/why3__BigInt.ml: config.status lib/ocaml/bigInt_zarith.ml lib/ocaml/why3__BigInt.ml: config.status lib/ocaml/why3__BigInt_zarith.ml
cp lib/ocaml/bigInt_zarith.ml lib/ocaml/why3__BigInt.ml cp lib/ocaml/why3__BigInt_zarith.ml $@
else else
lib/ocaml/why3__BigInt.ml: config.status src/util/bigInt.ml lib/ocaml/why3__BigInt.ml: config.status lib/ocaml/why3__BigInt_num.ml
cp lib/ocaml/bigInt_num.ml lib/ocaml/why3__BigInt.ml cp lib/ocaml/why3__BigInt_num.ml $@
endif endif
...@@ -1199,7 +1199,7 @@ clean:: ...@@ -1199,7 +1199,7 @@ clean::
# Ocaml realizations # Ocaml realizations
####################### #######################
OCAMLLIBS_FILES = why3__BigInt why3__Prelude why3__Map OCAMLLIBS_FILES = why3__BigInt why3__IntAux why3__Array why3__Map
OCAMLLIBS_MODULES := $(addprefix lib/ocaml/, $(OCAMLLIBS_FILES)) OCAMLLIBS_MODULES := $(addprefix lib/ocaml/, $(OCAMLLIBS_FILES))
...@@ -1364,10 +1364,11 @@ bench:: bin/why3.@OCAMLBEST@ bin/why3config.@OCAMLBEST@ plugins $(TOOLS) ...@@ -1364,10 +1364,11 @@ bench:: bin/why3.@OCAMLBEST@ bin/why3config.@OCAMLBEST@ plugins $(TOOLS)
$(MAKE) test-api-mlw-tree.@OCAMLBEST@ $(MAKE) test-api-mlw-tree.@OCAMLBEST@
$(MAKE) test-api-mlw.@OCAMLBEST@ $(MAKE) test-api-mlw.@OCAMLBEST@
$(MAKE) test-session.@OCAMLBEST@ $(MAKE) test-session.@OCAMLBEST@
$(MAKE) test-ocaml-extraction
# desactivé car requiert findlib # desactivé car requiert findlib
# if test -d examples/runstrat ; then \ # if test -d examples/runstrat ; then \
# $(MAKE) test-runstrat.@OCAMLBEST@ ; fi # $(MAKE) test-runstrat.@OCAMLBEST@ ; fi
sh bench/bench "bin/why3.@OCAMLBEST@" bash bench/bench "bin/why3.@OCAMLBEST@"
@if test "@enable_coq_tactic@" = "yes"; then \ @if test "@enable_coq_tactic@" = "yes"; then \
echo "=== checking the Coq tactic ==="; \ echo "=== checking the Coq tactic ==="; \
$(MAKE) test-coq-tactic.@OCAMLBEST@; fi $(MAKE) test-coq-tactic.@OCAMLBEST@; fi
...@@ -1485,6 +1486,25 @@ test-runstrat.opt: lib/why3/why3.cmxa lib/why3/META ...@@ -1485,6 +1486,25 @@ test-runstrat.opt: lib/why3/why3.cmxa lib/why3/META
test-runstrat: test-runstrat.$(OCAMLBEST) test-runstrat: test-runstrat.$(OCAMLBEST)
test-ocaml-extraction: bin/why3.opt lib/why3/why3extract.cmxa
@echo "driver ocaml32"
@mkdir -p tests/test-extraction
@cd tests ; ../bin/why3.opt -E 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
@echo "driver ocaml64"
@cd tests ; ../bin/why3.opt -E 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
@tests/test-extraction/a.out
################ ################
# documentation # documentation
################ ################
......
#!/bin/sh #!/bin/bash
# auto bench for why # auto bench for why
...@@ -40,7 +40,7 @@ bads () { ...@@ -40,7 +40,7 @@ bads () {
drivers () { drivers () {
for f in $1/*.drv; do for f in $1/*.drv; do
if [ $f = "drivers/ocaml.drv" ]; then continue; fi if [[ $f == drivers/ocaml*.drv ]]; then continue; fi
echo -n " $f... " echo -n " $f... "
# running Why # running Why
if ! echo "theory Test goal G : 1=2 end" | $pgm -F why --driver $f - > /dev/null 2>&1; then if ! echo "theory Test goal G : 1=2 end" | $pgm -F why --driver $f - > /dev/null 2>&1; then
...@@ -96,8 +96,8 @@ extract_and_run () { ...@@ -96,8 +96,8 @@ extract_and_run () {
fi fi
else else
echo "compilation failed!" echo "compilation failed!"
echo make -C $1 echo make -C $1
make -C $1 make -C $1
exit 1 exit 1
fi fi
else else
...@@ -119,7 +119,6 @@ list_stuff () { ...@@ -119,7 +119,6 @@ list_stuff () {
fi fi
} }
echo "=== Checking theories ===" echo "=== Checking theories ==="
goods theories goods theories
echo "" echo ""
......
(* OCaml driver
Generic part, for both 32-bit and 64-bit architectures *)
printer "ocaml" printer "ocaml"
theory BuiltIn theory BuiltIn
...@@ -84,11 +87,11 @@ theory int.Power ...@@ -84,11 +87,11 @@ theory int.Power
end end
theory int.Fact theory int.Fact
syntax function fact "(Why3__BigInt.fact %1)" syntax function fact "(Why3__IntAux.fact %1)"
end end
theory int.Fibonacci theory int.Fibonacci
syntax function fib "(Why3__BigInt.fib %1)" syntax function fib "(Why3__IntAux.fib %1)"
end end
(* TODO number.Gcd *) (* TODO number.Gcd *)
...@@ -147,87 +150,61 @@ module ref.Ref ...@@ -147,87 +150,61 @@ module ref.Ref
end end
module array.Array module array.Array
syntax type array "(%1 Why3__BigInt.Array.t)" syntax type array "(%1 Why3__Array.t)"
syntax function ([]) "(Why3__BigInt.Array.get %1 %2)"
syntax val ([]) "Why3__BigInt.Array.get" syntax function ([]) "(Why3__Array.get %1 %2)"
syntax val ([]<-) "Why3__BigInt.Array.set"
syntax val length "Why3__BigInt.Array.length" syntax exception OutOfBounds "Why3__Array.OutOfBounds"
syntax exception OutOfBounds "Why3__BigInt.Array.OutOfBounds"
syntax val defensive_get "Why3__BigInt.Array.defensive_get" syntax val ([]) "Why3__Array.get"
syntax val defensive_set "Why3__BigInt.Array.defensive_set" syntax val ([]<-) "Why3__Array.set"
syntax val make "Why3__BigInt.Array.make" syntax val length "Why3__Array.length"
syntax val append "Why3__BigInt.Array.append" syntax val defensive_get "Why3__Array.defensive_get"
syntax val sub "Why3__BigInt.Array.sub" syntax val defensive_set "Why3__Array.defensive_set"
syntax val copy "Why3__BigInt.Array.copy" syntax val make "Why3__Array.make"
syntax val fill "Why3__BigInt.Array.fill" syntax val append "Why3__Array.append"
syntax val blit "Why3__BigInt.Array.blit" syntax val sub "Why3__Array.sub"
syntax val copy "Why3__Array.copy"
syntax val fill "Why3__Array.fill"
syntax val blit "Why3__Array.blit"
end end
module mach.int.Int31 module mach.int.Int31
(* even on a 64-bit machine, it is safe to use type int for 31-bit integers *) (* even on a 64-bit machine, it is safe to use type int for 31-bit integers *)
syntax val of_int "Why3__BigInt.to_int"
syntax converter of_int "%1"
syntax function to_int "(Why3__BigInt.of_int %1)"
syntax type int31 "int" syntax type int31 "int"
syntax constant min_int31 "(- 0x4000_0000)"
syntax constant max_int31 "0x3fff_ffff"
syntax val of_int "(fun x -> int_of_string (Num.string_of_num x))"
(* FIXME: use a realization instead? *)
syntax val ( + ) "( + )" syntax val ( + ) "( + )"
syntax val ( - ) "( - )" syntax val ( - ) "( - )"
syntax val (-_) "( ~- )" syntax val (-_) "( ~- )"
syntax val ( * ) "( * )" syntax val ( * ) "( * )"
syntax val ( / ) "( / )" syntax val ( / ) "( / )"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)" syntax val (<=) "(<=)"
syntax val (<) "(<)" syntax val (<) "(<)"
syntax val (>=) "(>=)" syntax val (>=) "(>=)"
syntax val (>) "(>)" syntax val (>) "(>)"
end end
module mach.int.Int32 module mach.int.UInt64
syntax type int32 "Int32.t" (* no OCaml library for unsigned 64-bit integers => we use BigInt *)
syntax constant min_int32 "Int32.min_int" syntax val of_int "%1"
syntax constant max_int32 "Int32.max_int" syntax converter of_int "(Why3__BigInt.of_string \"%1\")"
syntax val of_int "(fun x -> Int32.of_string (Num.string_of_num x))"
(* FIXME: use a realization instead? *)
syntax val (+) "Int32.add"
syntax val (-) "Int32.sub"
syntax val (-_) "Int32.neg"
syntax val ( * ) "Int32.mul"
syntax val (/) "Int32.div"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.Int63 syntax function to_int "%1"
(* only safe on a 64-bit machine *)
prelude "let () = assert (Sys.word_size = 64)"
syntax type int63 "int"
syntax constant min_int63 "(- 0x4000_0000_0000_0000)"
syntax constant max_int63 "0x3fff_ffff_ffff_ffff"
syntax val of_int "(fun x -> int_of_string (Num.string_of_num x))"
(* FIXME: use a realization instead? *)
syntax val ( + ) "( + )"
syntax val ( - ) "( - )"
syntax val (-_) "( ~- )"
syntax val ( * ) "( * )"
syntax val ( / ) "( / )"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.Int64 syntax type uint64 "Why3__BigInt.t"
syntax type int64 "Int64.t" syntax val ( + ) "Why3__BigInt.add"
syntax constant min_int64 "Int64.min_int" syntax val ( - ) "Why3__BigInt.sub"
syntax constant max_int64 "Int64.max_int" syntax val (-_) "Why3__BigInt.minus"
syntax val of_int "(fun x -> Int64.of_string (Num.string_of_num x))" syntax val ( * ) "Why3__BigInt.mul"
(* FIXME: use a realization instead? *) syntax val ( / ) "Why3__BigInt.computer_div"
syntax val (+) "Int64.add" syntax val eq "(=)"
syntax val (-) "Int64.sub" syntax val ne "(<>)"
syntax val (-_) "Int64.neg"
syntax val ( * ) "Int64.mul"
syntax val (/) "Int64.div"
syntax val (<=) "(<=)" syntax val (<=) "(<=)"
syntax val (<) "(<)" syntax val (<) "(<)"
syntax val (>=) "(>=)" syntax val (>=) "(>=)"
...@@ -235,7 +212,8 @@ module mach.int.Int64 ...@@ -235,7 +212,8 @@ module mach.int.Int64
end end
module mach.array.Array31 module mach.array.Array31
syntax type array "array" syntax type array "(%1 array)"
syntax val make "Array.make" syntax val make "Array.make"
syntax val ([]) "Array.get" syntax val ([]) "Array.get"
syntax val ([]<-) "Array.set" syntax val ([]<-) "Array.set"
...@@ -249,6 +227,5 @@ module mach.array.Array31 ...@@ -249,6 +227,5 @@ module mach.array.Array31
end end
(* TODO (* TODO
- OutOfBounds, defensive_get, defensive_set in mach.array.in Array31
- mach.array.Array32 -> Bigarray sur 32-bit / Array sur 64-bit ? - mach.array.Array32 -> Bigarray sur 32-bit / Array sur 64-bit ?
*) *)
(* OCaml driver for 32-bit architecture *)
import "ocaml-gen.drv"
module mach.int.Int32
syntax val of_int "Why3__BigInt.to_int32"
syntax converter of_int "%1l"
syntax function to_int "(Why3__BigInt.of_int32 %1)"
syntax type int32 "Int32.t"
syntax val (+) "Int32.add"
syntax val (-) "Int32.sub"
syntax val (-_) "Int32.neg"
syntax val ( * ) "Int32.mul"
syntax val (/) "Int32.div"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.UInt32
syntax val of_int "Why3__BigInt.to_int64"
syntax converter of_int "%1L"
syntax function to_int "(Why3__BigInt.of_int64 %1)"
syntax type uint32 "Int64.t"
syntax val (+) "Int64.add"
syntax val (-) "Int64.sub"
syntax val (-_) "Int64.neg"
syntax val ( * ) "Int64.mul"
syntax val (/) "Int64.div"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.Int63
syntax val of_int "Why3__BigInt.to_int64"
syntax converter of_int "%1L"
syntax function to_int "(Why3__BigInt.of_int64 %1)"
syntax type int63 "Int64.t"
syntax val (+) "Int64.add"
syntax val (-) "Int64.sub"
syntax val (-_) "Int64.neg"
syntax val ( * ) "Int64.mul"
syntax val (/) "Int64.div"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.Int64
syntax val of_int "Why3__BigInt.to_int64"
syntax converter of_int "%1L"
syntax function to_int "(Why3__BigInt.of_int64 %1)"
syntax type int64 "Int64.t"
syntax val (+) "Int64.add"
syntax val (-) "Int64.sub"
syntax val (-_) "Int64.neg"
syntax val ( * ) "Int64.mul"
syntax val (/) "Int64.div"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
(* OCaml driver for 64-bit architecture *)
import "ocaml-gen.drv"
module mach.int.Int32
syntax val of_int "Why3__BigInt.to_int"
syntax converter of_int "%1"
syntax function to_int "(Why3__BigInt.of_int %1)"
syntax type int32 "int"
syntax val ( + ) "( + )"
syntax val ( - ) "( - )"
syntax val (-_) "( ~- )"
syntax val ( * ) "( * )"
syntax val ( / ) "( / )"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.UInt32
syntax val of_int "Why3__BigInt.to_int"
syntax converter of_int "%1"
syntax function to_int "(Why3__BigInt.of_int %1)"
syntax type uint32 "int"
syntax val ( + ) "( + )"
syntax val ( - ) "( - )"
syntax val (-_) "( ~- )"
syntax val ( * ) "( * )"
syntax val ( / ) "( / )"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.Int63
syntax val of_int "Why3__BigInt.to_int"
syntax converter of_int "%1"
syntax function to_int "(Why3__BigInt.of_int %1)"
syntax type int63 "int"
syntax val ( + ) "( + )"
syntax val ( - ) "( - )"
syntax val (-_) "( ~- )"
syntax val ( * ) "( * )"
syntax val ( / ) "( / )"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
module mach.int.Int64
syntax val of_int "Why3__BigInt.to_int64"
syntax converter of_int "%1L"
syntax function to_int "(Why3__BigInt.of_int64 %1)"
syntax type int64 "Int64.t"
syntax val (+) "Int64.add"
syntax val (-) "Int64.sub"
syntax val (-_) "Int64.neg"
syntax val ( * ) "Int64.mul"
syntax val (/) "Int64.div"
syntax val eq "(=)"
syntax val ne "(<>)"
syntax val (<=) "(<=)"
syntax val (<) "(<)"
syntax val (>=) "(>=)"
syntax val (>) "(>)"
end
...@@ -30,7 +30,7 @@ $(MAIN).opt: $(CMX) $(MAIN).cmx ...@@ -30,7 +30,7 @@ $(MAIN).opt: $(CMX) $(MAIN).cmx
$(MAIN).cmx: $(CMX) $(MAIN).cmx: $(CMX)
$(ML): ../sudoku.mlw $(ML): ../sudoku.mlw
../../bin/why3 -E ocaml ../sudoku.mlw -o . ../../bin/why3 -E ocaml32 ../sudoku.mlw -o .
%.cmx: %.ml %.cmx: %.ml
$(OCAMLOPT) $(WHY3) -annot -c $< $(OCAMLOPT) $(WHY3) -annot -c $<
......
open Why3__BigInt
type 'a t = 'a array
let get a i = a.(to_int i)
let set a i v = a.(to_int i) <- v
let length a = of_int (Array.length a)
exception OutOfBounds
let check_bounds a i = if i < 0 || i >= Array.length a then raise OutOfBounds
let defensive_get a i = let i = to_int i in check_bounds a i; a.(i)
let defensive_set a i v = let i = to_int i in check_bounds a i; a.(i) <- v
let make n v = Array.make (to_int n) v
let append = Array.append
let sub a ofs len = Array.sub a (to_int ofs) (to_int len)
let copy = Array.copy
let fill a ofs len v = Array.fill a (to_int ofs) (to_int len) v
let blit a1 ofs1 a2 ofs2 len =
Array.blit a1 (to_int ofs1) a2 (to_int ofs2) (to_int len)
...@@ -16,7 +16,6 @@ let compare = compare_big_int ...@@ -16,7 +16,6 @@ let compare = compare_big_int
let zero = zero_big_int let zero = zero_big_int
let one = unit_big_int let one = unit_big_int
let of_int = big_int_of_int
let succ = succ_big_int let succ = succ_big_int
let pred = pred_big_int let pred = pred_big_int
...@@ -67,48 +66,17 @@ let pow_int_pos = power_int_positive_int ...@@ -67,48 +66,17 @@ let pow_int_pos = power_int_positive_int
let to_string = string_of_big_int let to_string = string_of_big_int
let of_string = big_int_of_string let of_string = big_int_of_string
let to_int = int_of_big_int let to_int = int_of_big_int
let of_int = big_int_of_int
let to_int32 = int32_of_big_int
let of_int32 = big_int_of_int32
(* the code below is to be used in OCaml extracted code (see ocaml.drv) *) let to_int64 = int64_of_big_int
let of_int64 = big_int_of_int64
let power x y = let power x y =
try power_big_int_positive_big_int x y try power_big_int_positive_big_int x y
with Invalid_argument _ -> zero with Invalid_argument _ -> zero
let rec fact n = if le n one then one else mul n (fact (pred n))
let fib n =
let n = to_int n in
if n = 0 then zero else if n = 1 then one else
let a = Array.make (n + 1) zero in
a.(1) <- one; for i = 2 to n do a.(i) <- add a.(i-2) a.(i-1) done; a.(n)
let rec for_loop_to x1 x2 body =
if le x1 x2 then begin
body x1;
for_loop_to (succ x1) x2 body
end
let rec for_loop_downto x1 x2 body =
if ge x1 x2 then begin
body x1;
for_loop_downto (pred x1) x2 body
end
module Array = struct
type 'a t = 'a array
let get a i = a.(to_int i)
let set a i v = a.(to_int i) <- v
let length a = of_int (Array.length a)
exception OutOfBounds
let check_bounds a i = if i < 0 || i >= Array.length a then raise OutOfBounds
let defensive_get a i = let i = to_int i in check_bounds a i; a.(i)
let defensive_set a i v = let i = to_int i in check_bounds a i; a.(i) <- v
let make n v = Array.make (to_int n) v
let append = Array.append
let sub a ofs len = Array.sub a (to_int ofs) (to_int len)
let copy = Array.copy
let fill a ofs len v = Array.fill a (to_int ofs) (to_int len) v
let blit a1 ofs1 a2 ofs2 len =
Array.blit a1 (to_int ofs1) a2 (to_int ofs2) (to_int len)
end
...@@ -6,7 +6,6 @@ let compare = compare_big_int ...@@ -6,7 +6,6 @@ let compare = compare_big_int
let zero = zero_big_int let zero = zero_big_int
let one = unit_big_int let one = unit_big_int
let of_int = big_int_of_int
let succ = succ_big_int let succ = succ_big_int
let pred = pred_big_int let pred = pred_big_int
...@@ -57,46 +56,15 @@ let pow_int_pos = power_int_positive_int ...@@ -57,46 +56,15 @@ let pow_int_pos = power_int_positive_int
let to_string = string_of_big_int let to_string = string_of_big_int
let of_string = big_int_of_string let of_string = big_int_of_string
let to_int = int_of_big_int let to_int = int_of_big_int
let of_int = big_int_of_int
let to_int32 = int32_of_big_int
let of_int32 = big_int_of_int32
(* the code below is to be used in OCaml extracted code (see ocaml.drv) *) let to_int64 = int64_of_big_int
let of_int64 = big_int_of_int64
let power x y = try power_big x y with Invalid_argument _ -> zero let power x y = try power_big x y with Invalid_argument _ -> zero
let rec fact n = if le n one then one else mul n (fact (pred n))
let fib n =
let n = to_int n in
if n = 0 then zero else if n = 1 then one else
let a = Array.make (n + 1) zero in
a.(1) <- one; for i = 2 to n do a.(i) <- add a.(i-2) a.(i-1) done; a.(n)
let rec for_loop_to x1 x2 body =
if le x1 x2 then begin
body x1;
for_loop_to (succ x1) x2 body
end
let rec for_loop_downto x1 x2 body =
if ge x1 x2 then begin
body x1;
for_loop_downto (pred x1) x2 body
end
module Array = struct
type 'a t = 'a array
let get a i = a.(to_int i)
let set a i v = a.(to_int i) <- v
let length a = of_int (Array.length a)
exception OutOfBounds
let check_bounds a i = if i < 0 || i >= Array.length a then raise OutOfBounds
let defensive_get a i = let i = to_int i in check_bounds a i; a.(i)
let defensive_set a i v = let i = to_int i in check_bounds a i; a.(i) <- v
let make n v = Array.make (to_int n) v
let append = Array.append
let sub a ofs len = Array.sub a (to_int ofs) (to_int len)
let copy = Array.copy
let fill a ofs len v = Array.fill a (to_int ofs) (to_int len) v
let blit a1 ofs1 a2 ofs2 len =
Array.blit a1 (to_int ofs1) a2 (to_int ofs2) (to_int len)
end
open Why3__BigInt
let rec fact n = if le n one then one else mul n (fact (pred n))
let fib n =
let n = to_int n in
if n = 0 then zero else if n = 1 then one else
let a = Array.make (n + 1) zero in
a.(1) <- one; for i = 2 to n do a.(i) <- add a.(i-2) a.(i-1) done; a.(n)
let rec for_loop_to x1 x2 body =
if le x1 x2 then begin
body x1;
for_loop_to (succ x1) x2 body
end
let rec for_loop_downto x1 x2 body =
if ge x1 x2 then begin
body x1;
for_loop_downto (pred x1) x2 body
end
...@@ -29,7 +29,7 @@ ...@@ -29,7 +29,7 @@
'("(\\*\\([^*)]\\([^*]\\|\\*[^)]\\)*\\)?\\*)" . font-lock-comment-face) '("(\\*\\([^*)]\\([^*]\\|\\*[^)]\\)*\\)?\\*)" . font-lock-comment-face)
; '("{}\\|{[^|]\\([^}]*\\)}" . font-lock-type-face) ; '("{}\\|{[^|]\\([^}]*\\)}" . font-lock-type-face)
`(,(why3-regexp-opt '("invariant" "variant" "diverges" "requires" "ensures" "returns" "raises" "reads" "writes" "assert" "assume" "check")) . font-lock-type-face) `(,(why3-regexp-opt '("invariant" "variant" "diverges" "requires" "ensures" "returns" "raises" "reads" "writes" "assert" "assume" "check")) . font-lock-type-face)
`(,(why3-regexp-opt '("use" "clone" "namespace" "import" "export" "coinductive" "inductive" "external" "constant" "function" "predicate" "val" "exception" "axiom" "lemma" "goal" "type" "mutable" "model" "abstract" "private" "any" "match" "let" "rec" "in" "if" "then" "else" "begin" "end" "while" "for" "to" "downto" "do" "done" "loop" "absurd" "ghost" "try" "with" "theory" "uses" "module")) . font-lock-keyword-face) `(,(why3-regexp-opt '("use" "clone" "namespace" "import" "export" "coinductive" "inductive" "external" "constant" "function" "predicate" "val" "exception" "axiom" "lemma" "goal" "type" "mutable" "model" "abstract" "private" "any" "match" "let" "rec" "in" "if" "then" "else" "begin" "end" "while" "for" "to" "downto" "do" "done" "loop" "absurd" "ghost" "try" "with" "theory" "uses" "module" "converter")) . font-lock-keyword-face)
) )
"Minimal highlighting for Why3 mode") "Minimal highlighting for Why3 mode")
......
...@@ -43,6 +43,7 @@ type mo_rule = ...@@ -43,6 +43,7 @@ type mo_rule =
| MRtheory of th_rule | MRtheory of th_rule
| MRexception of qualid * string | MRexception of qualid * string
| MRval of qualid * string | MRval of qualid * string
| MRconverter of qualid * string
type module_rules = { type module_rules = {
mor_name : qualid; mor_name : qualid;
......
...@@ -52,6 +52,7 @@ ...@@ -52,6 +52,7 @@
"module", MODULE; "module", MODULE;
"exception", EXCEPTION; "exception", EXCEPTION;
"val", VAL; "val", VAL;
"converter", CONVERTER;