extraction: no more OCaml code for map.Map

sudoku example now uses arrays only
parent e4746a0b
...@@ -1199,7 +1199,7 @@ clean:: ...@@ -1199,7 +1199,7 @@ clean::
# Ocaml realizations # Ocaml realizations
####################### #######################
OCAMLLIBS_FILES = why3__BigInt why3__IntAux why3__Array why3__Map OCAMLLIBS_FILES = why3__BigInt why3__IntAux why3__Array
OCAMLLIBS_MODULES := $(addprefix lib/ocaml/, $(OCAMLLIBS_FILES)) OCAMLLIBS_MODULES := $(addprefix lib/ocaml/, $(OCAMLLIBS_FILES))
......
...@@ -128,17 +128,6 @@ theory list.Combine ...@@ -128,17 +128,6 @@ theory list.Combine
syntax function combine "(List.combine %1 %2)" syntax function combine "(List.combine %1 %2)"
end end
(* map *)
theory map.Map
syntax type map "((%1, %2) Why3__Map.map)"
syntax function const "(Why3__Map.const %1)"
syntax function ([]) "(Why3__Map.get %1 %2)"
syntax function get "(Why3__Map.get %1 %2)"
syntax function ([<-]) "(Why3__Map.set %1 %2 %3)"
syntax function set "(Why3__Map.set %1 %2 %3)"
end
(* WhyML *) (* WhyML *)
module ref.Ref module ref.Ref
......
This diff is collapsed.
...@@ -16,7 +16,7 @@ ifeq ($(BENCH),yes) ...@@ -16,7 +16,7 @@ ifeq ($(BENCH),yes)
endif endif
MAIN = main MAIN = main
OBJ = sudoku__Grid sudoku__TheClassicalSudokuGrid sudoku__Solver OBJ = map__Map sudoku__Grid sudoku__TheClassicalSudokuGrid sudoku__Solver
ML = $(addsuffix .ml, $(OBJ)) ML = $(addsuffix .ml, $(OBJ))
CMO = $(addsuffix .cmo, $(OBJ)) CMO = $(addsuffix .cmo, $(OBJ))
......
This diff is collapsed.
(* inefficient implementation of theory map.Map
to be used in OCaml extracted code (see driver ocaml.drv) *)
type ('a, 'b) map =
{ default : 'b;
table : ('a * 'b) list;
}
let get (x: ('a, 'b) map) (x1: 'a) : 'b =
try
List.assoc x1 x.table
with Not_found -> x.default
let rec update l x y =
match l with
| [] -> [x,y]
| (z,_) as t :: r ->
if x = z then (z,y) :: r else t :: update r x y
let set (x: ('a, 'b) map) (x1: 'a) (x2: 'b) : ('a, 'b) map =
{ x with table = update x.table x1 x2 }
let mixfix_lbrb (a: ('a, 'b) map) (i: 'a) : 'b = get a i
let mixfix_lblsmnrb (a: ('a, 'b) map) (i: 'a) (v: 'b) : ('a, 'b) map =
set a i v
let const (x: 'b) : ('a, 'b) map =
{ default = x ; table = [] }
...@@ -508,7 +508,7 @@ let print_param_decl info fmt ls = ...@@ -508,7 +508,7 @@ let print_param_decl info fmt ls =
(print_lident info) ls.ls_name (print_lident info) ls.ls_name
else begin else begin
let vars = name_args ls.ls_args in let vars = name_args ls.ls_args in
fprintf fmt "@[<hov 2>(*let %a %a : %a =@ %a*)@]" fprintf fmt "@[<hov 2>let %a %a : %a =@ %a@]"
(print_ls info) ls (print_ls info) ls
(print_list space (print_vs_arg info)) vars (print_list space (print_vs_arg info)) vars
(print_ls_type info) ls.ls_value (print_ls_type info) ls.ls_value
......
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