Correct handling of comparison operators in Sigali
- bug fix: comparison between two non-constant integer expressions in Sigali - bug fix: correct handling of "=" and "<>" operators in Sigali
This commit is contained in:
parent
d27db41485
commit
c61e01f19b
8
CHANGES
8
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)
|
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)
|
Heptagon 1.00.02 (29/10/2013)
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
include config
|
include config
|
||||||
|
|
||||||
#version = $(shell date +"%d%m%y")
|
#version = $(shell date +"%d%m%y")
|
||||||
version = 1.00.03
|
version = 1.00.04
|
||||||
osname=$(shell uname -s)
|
osname=$(shell uname -s)
|
||||||
hardware=$(shell uname -m)
|
hardware=$(shell uname -m)
|
||||||
heptdir = heptagon-$(version)
|
heptdir = heptagon-$(version)
|
||||||
|
|
|
@ -153,6 +153,9 @@ let a_inf e1 e2 =
|
||||||
let a_sup e1 e2 =
|
let a_sup e1 e2 =
|
||||||
Sprim ("a_sup", [e1;e2])
|
Sprim ("a_sup", [e1;e2])
|
||||||
|
|
||||||
|
let a_iminv e1 e2 =
|
||||||
|
Sprim ("a_iminv", [e1;e2])
|
||||||
|
|
||||||
module Printer =
|
module Printer =
|
||||||
struct
|
struct
|
||||||
open Format
|
open Format
|
||||||
|
|
|
@ -119,6 +119,8 @@ val a_inf : exp -> exp -> exp
|
||||||
|
|
||||||
val a_sup : exp -> exp -> exp
|
val a_sup : exp -> exp -> exp
|
||||||
|
|
||||||
|
val a_iminv : exp -> exp -> exp
|
||||||
|
|
||||||
module Printer :
|
module Printer :
|
||||||
sig
|
sig
|
||||||
val print : string -> processus list -> unit
|
val print : string -> processus list -> unit
|
||||||
|
|
|
@ -126,8 +126,7 @@ let rec translate_ext prefix ({ Minils.w_desc = desc; Minils.w_ty = ty }) =
|
||||||
| Minils.Wreinit _ -> raise Untranslatable
|
| Minils.Wreinit _ -> raise Untranslatable
|
||||||
|
|
||||||
(* [translate e = c] *)
|
(* [translate e = c] *)
|
||||||
let rec translate prefix ({ Minils.e_desc = desc; Minils.e_ty = ty } as e) =
|
let rec translate prefix ({ Minils.e_desc = desc } as e) =
|
||||||
let ty = actual_ty ty in
|
|
||||||
match desc with
|
match desc with
|
||||||
| Minils.Eextvalue(ext) -> translate_ext prefix ext
|
| Minils.Eextvalue(ext) -> translate_ext prefix ext
|
||||||
| Minils.Eapp (* pervasives binary or unary stateless operations *)
|
| 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))
|
(translate_ext prefix e2))
|
||||||
| "&", [e1;e2] -> Sand((translate_ext prefix e1),
|
| "&", [e1;e2] -> Sand((translate_ext prefix e1),
|
||||||
(translate_ext prefix e2))
|
(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 =
|
let op,modv =
|
||||||
begin match n with
|
begin match n with
|
||||||
| "<=" -> a_inf,0
|
| "<=" -> a_inf,0
|
||||||
| "<" -> a_inf,-1
|
| "<" -> a_inf,-1
|
||||||
| ">=" -> a_sup,0
|
| ">=" -> a_sup,0
|
||||||
| _ -> a_sup,1
|
| ">" -> a_sup,1
|
||||||
|
| _ -> a_iminv,0 (* p(x)=k <> p = inverse image of k *)
|
||||||
end in
|
end in
|
||||||
let e1 = translate_ext prefix e1 in
|
let e1 = translate_ext prefix e1 in
|
||||||
let sig_e =
|
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)))
|
op e1 (Sconst(Cint(v+modv)))
|
||||||
| _ ->
|
| _ ->
|
||||||
let e2 = translate_ext prefix e2 in
|
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
|
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 *)
|
polynomials *)
|
||||||
Splus(sig_e,Sconst(Ctrue))
|
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),
|
| "+", [e1;e2] -> Splus((translate_ext prefix e1),
|
||||||
(translate_ext prefix e2))
|
(translate_ext prefix e2))
|
||||||
| "-", [e1;e2] -> Splus((translate_ext prefix e1),
|
| "-", [e1;e2] -> Splus((translate_ext prefix e1),
|
||||||
(Sprod((translate_ext prefix e2),(Sconst(Cint(-1))))))
|
(Sprod((translate_ext prefix e2),(Sconst(Cint(-1))))))
|
||||||
| "*", [e1;e2] -> Sprod((translate_ext prefix e1),
|
| "*", [e1;e2] -> Sprod((translate_ext prefix e1),
|
||||||
(translate_ext prefix e2))
|
(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
|
| _ -> raise Untranslatable
|
||||||
end
|
end
|
||||||
(* | Minils.Ewhen(e, c, var) when ((actual_ty e.Minils.e_ty) = Tbool) -> *)
|
(* | Minils.Ewhen(e, c, var) when ((actual_ty e.Minils.e_ty) = Tbool) -> *)
|
||||||
|
|
|
@ -32,7 +32,7 @@
|
||||||
open Names
|
open Names
|
||||||
|
|
||||||
(* version of the compiler *)
|
(* version of the compiler *)
|
||||||
let version = "1.00.03"
|
let version = "1.00.04"
|
||||||
let date = "DATE"
|
let date = "DATE"
|
||||||
|
|
||||||
(* standard module *)
|
(* standard module *)
|
||||||
|
|
Loading…
Reference in a new issue