let rec pred p =
CurrentLoc.set p.loc;
let enode = match p.content with
| Pfalse -> JCPEconst(JCCboolean false)
| Ptrue -> JCPEconst(JCCboolean true)
| Papp(pinfo,labels,tl) ->
let name = translated_name pinfo in
let args =
List.map2
(fun lv t ->
let t' = term t in
if isLogicFloatType t.term_type && isLogicRealType lv.lv_type
then
mkexpr (JCPEcast(t', mktype (JCPTnative Treal))) t.term_loc
else t')
pinfo.l_profile
tl
in
JCPEapp(name,logic_labels_assoc labels, args)
| Prel((Rlt | Rgt | Rle | Rge as rel),t1,t2)
when app_term_type isPointerType false t1.term_type ->
let sube = mkexpr (JCPEbinary(term t1,`Bsub,term t2)) p.loc in
JCPEbinary(sube,relation rel,zero_expr)
| Prel(Req,t1,t2) when isTypeTagType t1.term_type ->
JCPEeqtype(tag t1,tag t2)
| Prel(Rneq,t1,t2) when isTypeTagType t1.term_type ->
let eq = mkexpr (JCPEeqtype(tag t1,tag t2)) p.loc in
JCPEunary(`Unot,eq)
| Prel(rel,t1,t2) ->
let res =
product (fun t1 t2 -> mkexpr (JCPEbinary(t1,relation rel,t2)) p.loc)
(coerce_floats t1) (coerce_floats t2)
in (mkconjunct res p.loc)#node
| Pand(p1,p2) ->
JCPEbinary(pred p1,`Bland,pred p2)
| Por(p1,p2) ->
JCPEbinary(pred p1,`Blor,pred p2)
| Pxor(p1,p2) ->
let notp2 = { p2 with content = Pnot p2; } in
let p1notp2 = { p with content = Pand(p1,notp2); } in
let notp1 = { p1 with content = Pnot p1; } in
let p2notp1 = { p with content = Pand(p2,notp1); } in
JCPEbinary(pred p1notp2,`Blor,pred p2notp1)
| Pimplies(p1,p2) ->
JCPEbinary(pred p1,`Bimplies,pred p2)
| Piff(p1,p2) ->
JCPEbinary(pred p1,`Biff,pred p2)
| Pnot p -> JCPEunary(`Unot,pred p)
| Pif(t,p1,p2) -> JCPEif(term t,pred p1,pred p2)
| Plet(_v,_t,_p) ->
Extlib.not_yet_implemented "Interp.pred Plet"
| Pforall([],p) -> (pred p)#node
| Pforall([v],p) ->
JCPEquantifier(Forall,ltype v.lv_type,
[new identifier v.lv_name], [],pred p)
| Pforall(v::q,subp) ->
let newp = { p with content = Pforall(q,subp) } in
JCPEquantifier(Forall,ltype v.lv_type,
[new identifier v.lv_name], [],pred newp)
| Pexists([],p) -> (pred p)#node
| Pexists([v],p) ->
JCPEquantifier(Exists,ltype v.lv_type,
[new identifier v.lv_name], [],pred p)
| Pexists(v::q,subp) ->
let newp = { p with content = Pexists(q,subp) } in
JCPEquantifier(Exists,ltype v.lv_type,
[new identifier v.lv_name], [],pred newp)
| Pold p -> JCPEold(pred p)
| Pat(p,lab) -> JCPEat(pred p,logic_label lab)
| Pvalid_index(t1,t2) ->
let e1 = term t1 in
let e2 = term t2 in
let eoffmin = mkexpr (JCPEoffset(Offset_min,e1)) p.loc in
let emin = mkexpr (JCPEbinary(eoffmin,`Ble,e2)) p.loc in
let eoffmax = mkexpr (JCPEoffset(Offset_max,e1)) p.loc in
let emax = mkexpr (JCPEbinary(eoffmax,`Bge,e2)) p.loc in
(mkconjunct [emin; emax] p.loc)#node
| Pvalid_range(t1,t2,t3) ->
let e1 = term t1 in
let e2 = term t2 in
let e3 = term t3 in
let eoffmin = mkexpr (JCPEoffset(Offset_min,e1)) p.loc in
let emin = mkexpr (JCPEbinary(eoffmin,`Ble,e2)) p.loc in
let eoffmax = mkexpr (JCPEoffset(Offset_max,e1)) p.loc in
let emax = mkexpr (JCPEbinary(eoffmax,`Bge,e3)) p.loc in
(mkconjunct [emin; emax] p.loc)#node
| Pvalid({ term_node = TBinOp(PlusPI,t1,{term_node = Trange (t2,t3)})}) ->
let e1 = terms t1 in
let mk_one_pred e1 =
match t2,t3 with
| None,None -> true_expr
| Some t2,None ->
let e2 = term t2 in
let eoffmin = mkexpr (JCPEoffset(Offset_min,e1)) p.loc in
mkexpr (JCPEbinary(eoffmin,`Ble,e2)) p.loc
| None, Some t3 ->
let e3 = term t3 in
let eoffmax = mkexpr (JCPEoffset(Offset_max,e1)) p.loc in
mkexpr (JCPEbinary(eoffmax,`Bge,e3)) p.loc
| Some t2,Some t3 ->
let e2 = term t2 in
let e3 = term t3 in
let eoffmin = mkexpr (JCPEoffset(Offset_min,e1)) p.loc in
let emin = mkexpr (JCPEbinary(eoffmin,`Ble,e2)) p.loc in
let eoffmax = mkexpr (JCPEoffset(Offset_max,e1)) p.loc in
let emax = mkexpr (JCPEbinary(eoffmax,`Bge,e3)) p.loc in
mkconjunct [emin; emax] p.loc
in (mkconjunct (List.map mk_one_pred e1) p.loc)#node
| Pvalid({ term_node = TBinOp(PlusPI,t1,t2)}) ->
let e1 = terms t1 in
let e2 = term t2 in
(mkconjunct
(List.flatten
(List.map
(fun e1 ->
let eoffmin = mkexpr (JCPEoffset(Offset_min,e1)) p.loc in
let emin = mkexpr (JCPEbinary(eoffmin,`Ble,e2)) p.loc in
let eoffmax = mkexpr (JCPEoffset(Offset_max,e1)) p.loc in
let emax = mkexpr (JCPEbinary(eoffmax,`Bge,e2)) p.loc in
[emin; emax])
e1)) p.loc)#node
| Pvalid t ->
let elist =
List.flatten (List.map (fun e ->
let eoffmin = mkexpr (JCPEoffset(Offset_min,e)) p.loc in
let emin = mkexpr (JCPEbinary(eoffmin,`Ble,zero_expr)) p.loc in
let eoffmax = mkexpr (JCPEoffset(Offset_max,e)) p.loc in
let emax = mkexpr (JCPEbinary(eoffmax,`Bge,zero_expr)) p.loc in
[emin; emax]
) (terms t))
in
(mkconjunct elist p.loc)#node
| Pfresh _t ->
Extlib.not_yet_implemented "Interp.pred Pfresh"
| Psubtype({term_node = Ttypeof t},{term_node = Ttype ty}) ->
JCPEinstanceof(term t,get_struct_name (pointed_type ty))
| Psubtype(_t1,_t2) ->
Extlib.not_yet_implemented "Interp.pred Psubtype"
| Pseparated(_seps) ->
Extlib.not_yet_implemented "Interp.pred Pseparated"
in
mkexpr enode p.loc