Commit 689f7898 authored by Francois Bobot's avatar Francois Bobot

encoding_decorate ne renomme pas les fonctions dont la signature n'a pas changé.

Driver : fix compose dans le bon sens
parent 3c232d4f
......@@ -41,6 +41,9 @@ val apply : 'a trans_reg -> task -> 'a
val compose : task trans_reg -> 'a trans_reg -> 'a trans_reg
val compose_l : task tlist_reg -> 'a tlist_reg -> 'a tlist_reg
(** Composition of transformations [compose f g] is the transformation
which applies f before applying g *)
(* Should be only used with functions working in constant time *)
(* val conv_res : ('a -> 'b) -> 'a trans_reg -> 'b trans_reg *)
......
......@@ -248,7 +248,7 @@ let load_driver env file =
try set_or_raise loc printer (Hashtbl.find printers s) "printer"
with Not_found -> errorm ~loc "unknown printer %s" s end
| Transform s -> begin
try transform := compose (Hashtbl.find transforms s) !transform
try transform := compose !transform (Hashtbl.find transforms s)
with Not_found -> errorm ~loc "unknown transformation %s" s end
| Plugin files -> load_plugin (Filename.dirname file) files
in
......
......@@ -151,10 +151,13 @@ let conv_ls tenv ls =
if ls == ps_equ
then ls
else
let preid = id_clone ls.ls_name in
let tyl = List.map (conv_ty_neg tenv) ls.ls_args in
let ty_res = Util.option_map (conv_ty_pos tenv) ls.ls_value in
create_lsymbol preid tyl ty_res
let ty_res = Util.option_maq (conv_ty_pos tenv) ls.ls_value in
if ty_res == ls.ls_value && List.for_all2 (==) tyl ls.ls_args
then ls
else
let preid = id_clone ls.ls_name in
create_lsymbol preid tyl ty_res
let conv_ts tenv ts =
......@@ -268,8 +271,11 @@ let decl (tenv:tenv) d =
type which are not in recursive bloc")
| Dlogic l ->
let fn = function
| _ls, Some _ -> assert false (* TODO or not
(remove_logic_definition*)
| _ls, Some _ ->
Format.eprintf "@[<hov 3>Encoding_decorate :@\n\
I can't encode definition such as %a@\n\
Perhaps you could use eliminate_definition@\n@]@." Pretty.print_decl d;
assert false
| ls, None ->
try
let ls = Hls.find tenv.trans_lsymbol ls in
......
......@@ -23,10 +23,18 @@ let of_option = function None -> assert false | Some x -> x
let option_map f = function None -> None | Some x -> Some (f x)
let option_maq f = function None as o -> o | Some x as o ->
let r = (f x) in if r == x then o else Some r
let option_apply d f = function None -> d | Some x -> f x
let option_iter f = function None -> () | Some x -> f x
let option_eq eq = function
| None, None -> true
| None, _ | _, None -> false
| Some x, Some y -> eq x y
(* useful list combinators *)
let map_fold_left f acc l =
......
......@@ -23,6 +23,11 @@ val of_option : 'a option -> 'a
val option_map : ('a -> 'b) -> 'a option -> 'b option
val option_maq : ('a -> 'a) -> 'a option -> 'a option
(** same as {! option_map} but [option_maq f o] return o if o is
None or f is the identity (according to (==)) on the argument
given *)
val option_iter : ('a -> unit) -> 'a option -> unit
val option_apply : 'b -> ('a -> 'b) -> 'a option -> 'b
......
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