syntaxe a <= b <= c (pour des operateurs quelconques, bien entendu)

parent bac4d8d1
......@@ -12,7 +12,7 @@
{
logic x2 : int
logic y2 : int
axiom First_octant : 0 <= y2 and y2 <= x2
axiom First_octant : 0 <= y2 <= x2
}
(* The code.
......@@ -29,7 +29,7 @@ logic best(x:int, y:int) =
logic invariant(x:int, y:int, e:int) =
e = 2 * (x + 1) * y2 - (2 * y + 1) * x2 and
2 * (y2 - x2) <= e and e <= 2 * y2
2 * (y2 - x2) <= e <= 2 * y2
lemma Invariant_is_ok : forall x,y,e:int. invariant(x,y,e) -> best(x,y)
}
......
......@@ -32,10 +32,10 @@
let mk_pat p = { pat_loc = loc (); pat_desc = p }
let infix_ppl loc a i b = mk_ppl loc (PPinfix (a, i, b))
let infix_ppl loc a i b = mk_ppl loc (PPbinop (a, i, b))
let infix_pp a i b = infix_ppl (loc ()) a i b
let prefix_ppl loc p a = mk_ppl loc (PPprefix (p, a))
let prefix_ppl loc p a = mk_ppl loc (PPunop (p, a))
let prefix_pp p a = prefix_ppl (loc ()) p a
let infix s = "infix " ^ s
......@@ -359,19 +359,19 @@ lexpr:
{ prefix_pp PPnot $2 }
| lexpr EQUAL lexpr
{ let id = { id = infix "="; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$1; $3])) }
mk_pp (PPinfix ($1, id, $3)) }
| lexpr OP1 lexpr
{ let id = { id = infix $2; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$1; $3])) }
mk_pp (PPinfix ($1, id, $3)) }
| lexpr OP2 lexpr
{ let id = { id = infix $2; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$1; $3])) }
mk_pp (PPinfix ($1, id, $3)) }
| lexpr OP3 lexpr
{ let id = { id = infix $2; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$1; $3])) }
mk_pp (PPinfix ($1, id, $3)) }
| lexpr OP4 lexpr
{ let id = { id = infix $2; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$1; $3])) }
mk_pp (PPinfix ($1, id, $3)) }
| any_op lexpr %prec prefix_op
{ let id = { id = prefix $1; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$2])) }
......
......@@ -29,10 +29,10 @@ type constant = Term.constant
type pp_quant =
| PPforall | PPexists
type pp_infix =
type pp_binop =
| PPand | PPor | PPimplies | PPiff
type pp_prefix =
type pp_unop =
| PPnot
type ident = { id : string; id_loc : loc }
......@@ -66,8 +66,9 @@ and pp_desc =
| PPtrue
| PPfalse
| PPconst of constant
| PPinfix of lexpr * pp_infix * lexpr
| PPprefix of pp_prefix * lexpr
| PPinfix of lexpr * ident * lexpr
| PPbinop of lexpr * pp_binop * lexpr
| PPunop of pp_unop * lexpr
| PPif of lexpr * lexpr * lexpr
| PPquant of pp_quant * uquant list * lexpr list list * lexpr
| PPnamed of string * lexpr
......
......@@ -220,18 +220,20 @@ let specialize_lsymbol p uc =
s, specialize_lsymbol (qloc p) s
let specialize_fsymbol p uc =
let loc = qloc p in
let s, (tl, ty) = specialize_lsymbol p uc in
match ty with
| None -> error ~loc TermExpected
| None -> let loc = qloc p in error ~loc TermExpected
| Some ty -> s, tl, ty
let specialize_psymbol p uc =
let loc = qloc p in
let s, (tl, ty) = specialize_lsymbol p uc in
match ty with
| None -> s, tl
| Some _ -> error ~loc PredicateExpected
| Some _ -> let loc = qloc p in error ~loc PredicateExpected
let is_psymbol p uc =
let s = find_lsymbol p uc in
s.ls_value = None
(** Typing types *)
......@@ -373,6 +375,10 @@ and dterm_node loc env = function
let s, tyl, ty = specialize_fsymbol x env.uc in
let tl = dtype_args s.ls_name loc env tyl tl in
Tapp (s, tl), ty
| PPinfix (e1, x, e2) ->
let s, tyl, ty = specialize_fsymbol (Qident x) env.uc in
let tl = dtype_args s.ls_name loc env tyl [e1; e2] in
Tapp (s, tl), ty
| PPconst (ConstInt _ as c) ->
Tconst c, Tyapp (Ty.ts_int, [])
| PPconst (ConstReal _ as c) ->
......@@ -414,7 +420,7 @@ and dterm_node loc env = function
let e1 = dfmla env e1 in
Teps (x, ty, e1), ty
| PPquant _ | PPif _
| PPprefix _ | PPinfix _ | PPfalse | PPtrue ->
| PPbinop _ | PPunop _ | PPfalse | PPtrue ->
error ~loc TermExpected
and dfmla env e = match e.pp_desc with
......@@ -422,9 +428,9 @@ and dfmla env e = match e.pp_desc with
Ftrue
| PPfalse ->
Ffalse
| PPprefix (PPnot, a) ->
| PPunop (PPnot, a) ->
Fnot (dfmla env a)
| PPinfix (a, (PPand | PPor | PPimplies | PPiff as op), b) ->
| PPbinop (a, (PPand | PPor | PPimplies | PPiff as op), b) ->
Fbinop (binop op, dfmla env a, dfmla env b)
| PPif (a, b, c) ->
Fif (dfmla env a, dfmla env b, dfmla env c)
......@@ -456,6 +462,16 @@ and dfmla env e = match e.pp_desc with
let s, tyl = specialize_psymbol x env.uc in
let tl = dtype_args s.ls_name e.pp_loc env tyl tl in
Fapp (s, tl)
| PPinfix (e12, op2, e3) ->
begin match e12.pp_desc with
| PPinfix (_, op1, e2) when is_psymbol (Qident op1) env.uc ->
let e23 = { e with pp_desc = PPinfix (e2, op2, e3) } in
Fbinop (Fand, dfmla env e12, dfmla env e23)
| _ ->
let s, tyl = specialize_psymbol (Qident op2) env.uc in
let tl = dtype_args s.ls_name e.pp_loc env tyl [e12; e3] in
Fapp (s, tl)
end
| PPlet ({id=x}, e1, e2) ->
let e1 = dterm env e1 in
let ty = e1.dt_ty in
......
......@@ -56,7 +56,7 @@ theory EuclideanDivision
forall x,y:int. y <> 0 -> x = y * div(x,y) + mod(x,y)
axiom Mod_bound:
forall x,y:int. y <> 0 -> 0 <= mod(x,y) and mod(x,y) < abs(y)
forall x,y:int. y <> 0 -> 0 <= mod(x,y) < abs(y)
lemma Mod_1: forall x:int. mod(x,1) = 0
......@@ -76,7 +76,7 @@ theory ComputerDivision
forall x,y:int. y <> 0 -> x = y * div(x,y) + mod(x,y)
axiom Mod_bound:
forall x,y:int. y <> 0 -> -abs(y) < mod(x,y) and mod(x,y) < abs(y)
forall x,y:int. y <> 0 -> -abs(y) < mod(x,y) < abs(y)
lemma Mod_1: forall x:int. mod(x,1) = 0
......
......@@ -25,7 +25,7 @@ theory Abs
axiom Pos: forall x:real. x >= 0.0 -> abs(x) = x
axiom Neg: forall x:real. x <= 0.0 -> abs(x) = -x
lemma Abs_le: forall x,y:real. abs(x) <= y <-> -y <= x and x <= y
lemma Abs_le: forall x,y:real. abs(x) <= y <-> -y <= x <= y
lemma Abs_pos: forall x:real. abs(x) >= 0.0
......@@ -221,7 +221,7 @@ theory Hyperbolic
forall x:real. x >= 1.0 -> arcosh(x) = log(x+sqrt(sqr(x)-1.0))
logic artanh(x:real) : real
axiom Artanh_def:
forall x:real. -1.0 < x and x < 1.0 -> artanh(x) = 0.5*log((1.0+x)/(1.0-x))
forall x:real. -1.0 < x < 1.0 -> artanh(x) = 0.5*log((1.0+x)/(1.0-x))
end
......
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