diff --git a/CHANGES b/CHANGES index 5090f23..56ba9ef 100644 --- a/CHANGES +++ b/CHANGES @@ -1,8 +1,14 @@ +Heptagon 1.00.04 (14/01/2014) +----------------------------- + + - bug fix: comparison between two non-constant integer expressions in Sigali + - bug fix: correct handling of "=" and "<>" operators in Sigali + Heptagon 1.00.03 (20/11/2013) ----------------------------- - - buf fix: tomato application with contracts + - bug fix: tomato application with contracts Heptagon 1.00.02 (29/10/2013) ----------------------------- diff --git a/Makefile-distrib b/Makefile-distrib index 5b5a579..7c78be6 100644 --- a/Makefile-distrib +++ b/Makefile-distrib @@ -2,7 +2,7 @@ include config #version = $(shell date +"%d%m%y") -version = 1.00.03 +version = 1.00.04 osname=$(shell uname -s) hardware=$(shell uname -m) heptdir = heptagon-$(version) diff --git a/compiler/minils/sigali/sigali.ml b/compiler/minils/sigali/sigali.ml index 3143af7..65e6382 100644 --- a/compiler/minils/sigali/sigali.ml +++ b/compiler/minils/sigali/sigali.ml @@ -153,6 +153,9 @@ let a_inf e1 e2 = let a_sup e1 e2 = Sprim ("a_sup", [e1;e2]) +let a_iminv e1 e2 = + Sprim ("a_iminv", [e1;e2]) + module Printer = struct open Format diff --git a/compiler/minils/sigali/sigali.mli b/compiler/minils/sigali/sigali.mli index 6d53909..4dbdf19 100644 --- a/compiler/minils/sigali/sigali.mli +++ b/compiler/minils/sigali/sigali.mli @@ -119,6 +119,8 @@ val a_inf : exp -> exp -> exp val a_sup : exp -> exp -> exp +val a_iminv : exp -> exp -> exp + module Printer : sig val print : string -> processus list -> unit diff --git a/compiler/minils/sigali/sigalimain.ml b/compiler/minils/sigali/sigalimain.ml index 64b82a0..c423a7d 100644 --- a/compiler/minils/sigali/sigalimain.ml +++ b/compiler/minils/sigali/sigalimain.ml @@ -126,8 +126,7 @@ let rec translate_ext prefix ({ Minils.w_desc = desc; Minils.w_ty = ty }) = | Minils.Wreinit _ -> raise Untranslatable (* [translate e = c] *) -let rec translate prefix ({ Minils.e_desc = desc; Minils.e_ty = ty } as e) = - let ty = actual_ty ty in +let rec translate prefix ({ Minils.e_desc = desc } as e) = match desc with | Minils.Eextvalue(ext) -> translate_ext prefix ext | Minils.Eapp (* pervasives binary or unary stateless operations *) @@ -140,13 +139,24 @@ let rec translate prefix ({ Minils.e_desc = desc; Minils.e_ty = ty } as e) = (translate_ext prefix e2)) | "&", [e1;e2] -> Sand((translate_ext prefix e1), (translate_ext prefix e2)) - | ("<="|"<"|">="|">"), [e1;e2] -> + | "=", [e1;e2] when (actual_ty e1.Minils.w_ty) = Tbool -> + let e1 = translate_ext prefix e1 in + let e2 = translate_ext prefix e2 in + (* e1 = e2 iff (e1 and e2) or (not e1 and not e2) *) + (e1 &~ e2) |~ ((~~ e1) &~ (~~ e2)) + | "<>", [e1;e2] when (actual_ty e1.Minils.w_ty) = Tbool -> + let e1 = translate_ext prefix e1 in + let e2 = translate_ext prefix e2 in + (* e1 <> e2 iff (e1 and not e2) or (not e1 and e2) *) + (e1 &~ (~~ e2)) |~ ((~~ e1) &~ e2) + | ("<="|"<"|">="|">"|"="), [e1;e2] -> let op,modv = begin match n with | "<=" -> a_inf,0 | "<" -> a_inf,-1 | ">=" -> a_sup,0 - | _ -> a_sup,1 + | ">" -> a_sup,1 + | _ -> a_iminv,0 (* p(x)=k <> p = inverse image of k *) end in let e1 = translate_ext prefix e1 in let sig_e = @@ -155,27 +165,30 @@ let rec translate prefix ({ Minils.e_desc = desc; Minils.e_ty = ty } as e) = op e1 (Sconst(Cint(v+modv))) | _ -> let e2 = translate_ext prefix e2 in - op (Sminus(e1,e2)) (Sconst(Cint(modv))) + op (Splus(e1,(Sprod(e2,(Sconst(Cint(-1))))))) (Sconst(Cint(modv))) end in - (* a_inf and a_sup : +1 to translate ideals to boolean + (* a_inf, a_sup and a_iminv : +1 to translate ideals to boolean polynomials *) Splus(sig_e,Sconst(Ctrue)) + | "<>", [e1;e2] -> + (* e1 <> e2 --> not(a_iminv((e1+(e2*(-1))),0)) *) + let e1 = translate_ext prefix e1 in + let sig_e = + begin match e2.Minils.w_desc with + | Minils.Wconst({se_desc = Sint(v)}) -> + a_iminv e1 (Sconst(Cint(v))) + | _ -> + let e2 = translate_ext prefix e2 in + a_iminv (Splus(e1,(Sprod(e2,(Sconst(Cint(-1))))))) (Sconst(Cint(0))) + end in + (* a_iminv : +1 to translate ideals to boolean polynomials *) + Snot(Splus(sig_e,Sconst(Ctrue))) | "+", [e1;e2] -> Splus((translate_ext prefix e1), (translate_ext prefix e2)) | "-", [e1;e2] -> Splus((translate_ext prefix e1), (Sprod((translate_ext prefix e2),(Sconst(Cint(-1)))))) | "*", [e1;e2] -> Sprod((translate_ext prefix e1), (translate_ext prefix e2)) - | "=", [e1;e2] when (ty = Tbool) -> - let e1 = translate_ext prefix e1 in - let e2 = translate_ext prefix e2 in - (* e1 = e2 iff (e1 and e2) or (not e1 and not e2) *) - (e1 &~ e2) |~ ((~~ e1) &~ (~~ e2)) - | "<>", [e1;e2] when ty = Tbool -> - let e1 = translate_ext prefix e1 in - let e2 = translate_ext prefix e2 in - (* e1 <> e2 iff (e1 and not e2) or (not e1 and e2) *) - (e1 &~ (~~ e2)) |~ ((~~ e1) &~ e2) | _ -> raise Untranslatable end (* | Minils.Ewhen(e, c, var) when ((actual_ty e.Minils.e_ty) = Tbool) -> *) diff --git a/compiler/utilities/global/compiler_options.ml b/compiler/utilities/global/compiler_options.ml index e6761f7..751d84d 100644 --- a/compiler/utilities/global/compiler_options.ml +++ b/compiler/utilities/global/compiler_options.ml @@ -32,7 +32,7 @@ open Names (* version of the compiler *) -let version = "1.00.03" +let version = "1.00.04" let date = "DATE" (* standard module *)