Skip to content

Commit 12af606

Browse files
Cameron-LowCameron-Low
authored
New tactic: outline (#473)
The main idea is to provide an inverse to inline when proving an equiv. Currently, it supports basic procedure unification that requires manual selection of the program slice to unify with, as well as, requiring near exact matches on program structure. An optional return value can be supplied for situations where the return expression is just a program variable and needs to be renamed/deconstructed. There is also support for statement outlining although, this is more of a transitivity * with program slicing so may require change. Syntax and variants: - Procedure outlining: outline {m} [s - e] lv? <@ M.foo - Statement outlining: outline {m} [s - e] { s1; s2; ... } with - m: 1 or 2 - s,e: code position - M.foo: path to procedure - lv: a left-value when `s = e`, one can use `[s]` instead of `[s-s]` For example usage see: tests/outline.ec
1 parent 1733c19 commit 12af606

11 files changed

Lines changed: 632 additions & 0 deletions

‎src/ecCoreModules.ml‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,14 @@ let name_of_lv lv =
4343
| LvTuple pvs ->
4444
String.concat "_" (List.map (EcTypes.name_of_pvar |- fst) pvs)
4545

46+
let lv_of_expr e =
47+
match e.e_node with
48+
| Evar pv ->
49+
LvVar (pv, e_ty e)
50+
| Etuple pvs ->
51+
LvTuple (List.map (fun e -> EcTypes.destr_var e, e_ty e) pvs)
52+
| _ -> failwith "failed to construct lv from expr"
53+
4654
(* -------------------------------------------------------------------- *)
4755
type instr = EcAst.instr
4856

‎src/ecCoreModules.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ val ty_of_lv : lvalue -> EcTypes.ty
1212
val lv_of_list : (prog_var * ty) list -> lvalue option
1313
val lv_to_list : lvalue -> prog_var list
1414
val name_of_lv : lvalue -> string
15+
val lv_of_expr : expr -> lvalue
1516

1617
(* --------------------------------------------------------------------- *)
1718
type instr = EcAst.instr

‎src/ecHiTacticals.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -189,6 +189,7 @@ and process1_phl (_ : ttenv) (t : phltactic located) (tc : tcenv1) =
189189
| Pcallconcave info -> EcPhlCall.process_call_concave info
190190
| Pswap sw -> EcPhlSwap.process_swap sw
191191
| Pinline info -> EcPhlInline.process_inline info
192+
| Poutline info -> EcPhlOutline.process_outline info
192193
| Pinterleave info -> EcPhlSwap.process_interleave info
193194
| Pcfold info -> EcPhlCodeTx.process_cfold info
194195
| Pkill info -> EcPhlCodeTx.process_kill info

‎src/ecLexer.mll‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -154,6 +154,7 @@
154154
"conseq" , CONSEQ ; (* KW: tactic *)
155155
"exfalso" , EXFALSO ; (* KW: tactic *)
156156
"inline" , INLINE ; (* KW: tactic *)
157+
"outline" , OUTLINE ; (* KW: tactic *)
157158
"interleave" , INTERLEAVE ; (* KW: tactic *)
158159
"alias" , ALIAS ; (* KW: tactic *)
159160
"weakmem" , WEAKMEM ; (* KW: tactic *)

‎src/ecParser.mly‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -512,6 +512,7 @@
512512
%token NOTATION
513513
%token OF
514514
%token OP
515+
%token OUTLINE
515516
%token PCENT
516517
%token PHOARE
517518
%token PIPE
@@ -3129,6 +3130,10 @@ interleave_info:
31293130
| s=side? c1=interleavepos c2=interleavepos c3=interleavepos* k=word
31303131
{ (s, c1, c2 :: c3, k) }
31313132

3133+
%inline outline_kind:
3134+
| s=brace(stmt) { OKstmt(s) }
3135+
| r=sexpr? LEAT f=loc(fident) { OKproc(f, r) }
3136+
31323137
phltactic:
31333138
| PROC
31343139
{ Pfun `Def }
@@ -3219,6 +3224,14 @@ phltactic:
32193224
| INLINE s=side? u=inlineopt? p=codepos
32203225
{ Pinline (`CodePos (s, u, p)) }
32213226

3227+
| OUTLINE s=side LBRACKET st=codepos1 e=option(MINUS e=codepos1 {e}) RBRACKET k=outline_kind
3228+
{ Poutline {
3229+
outline_side = s;
3230+
outline_start = st;
3231+
outline_end = odfl st e;
3232+
outline_kind = k }
3233+
}
3234+
32223235
| KILL s=side? o=codepos
32233236
{ Pkill (s, o, Some 1) }
32243237

‎src/ecParsetree.ml‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -670,6 +670,18 @@ type inline_info = [
670670
(* | `All of oside * inlineopt *)
671671
]
672672

673+
(* -------------------------------------------------------------------- *)
674+
type outline_kind =
675+
| OKstmt of pstmt
676+
| OKproc of pgamepath * pexpr option
677+
678+
type outline_info = {
679+
outline_side: side;
680+
outline_start: codepos1;
681+
outline_end: codepos1;
682+
outline_kind: outline_kind;
683+
}
684+
673685
(* -------------------------------------------------------------------- *)
674686
type fel_info = {
675687
pfel_cntr : pformula;
@@ -731,6 +743,7 @@ type phltactic =
731743
| Pswap of ((oside * swap_kind) located list)
732744
| Pcfold of (oside * codepos * int option)
733745
| Pinline of inline_info
746+
| Poutline of outline_info
734747
| Pinterleave of interleave_info located
735748
| Pkill of (oside * codepos * int option)
736749
| Prnd of oside * semrndpos option * rnd_tac_info_f

‎src/ecUnifyProc.ml‎

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
open EcAst
2+
open EcTypes
3+
open EcModules
4+
open EcSymbols
5+
6+
(*---------------------------------------------------------------------------------------*)
7+
type u_error =
8+
| UE_InvalidRetInstr
9+
| UE_UnexpectedReturn
10+
| UE_ExprNotInLockstep of expr * expr
11+
| UE_InstrNotInLockstep of instr * instr
12+
| UE_DifferentProgramLengths of stmt * stmt
13+
14+
exception UnificationError of u_error
15+
16+
(*---------------------------------------------------------------------------------------*)
17+
type u_value =
18+
| Empty
19+
| Fixed of expr
20+
21+
type umap = u_value Msym.t
22+
23+
(*---------------------------------------------------------------------------------------*)
24+
let rec unify_exprs umap e1 e2 =
25+
match e1.e_node, e2.e_node with
26+
| Eint _, Eint _ -> umap
27+
| Elocal _, Elocal _ -> umap
28+
| Evar pv, e2n ->
29+
let var = symbol_of_pv pv in
30+
31+
(* Only update a value if it hasn't been fixed previously *)
32+
let update value =
33+
match value with
34+
| None ->
35+
begin
36+
match e2n with
37+
| Evar _ -> None
38+
| _ -> raise (UnificationError (UE_ExprNotInLockstep (e1, e2)))
39+
end
40+
| Some Empty -> Some (Fixed e2)
41+
| _ -> value
42+
in
43+
44+
Msym.change update var umap
45+
| Eop _, Eop _ -> umap
46+
| Eapp (f1, a1), Eapp (f2, a2) ->
47+
let umap = unify_exprs umap f1 f2 in
48+
List.fold_left (fun umap (e1, e2) -> unify_exprs umap e1 e2) umap (List.combine a1 a2)
49+
| Equant (_, _, e1), Equant (_, _, e2) ->
50+
unify_exprs umap e1 e2
51+
| Elet (_, e1, u1), Elet (_, e2, u2) ->
52+
let umap = unify_exprs umap e1 e2 in
53+
unify_exprs umap u1 u2
54+
| Etuple t1, Etuple t2 ->
55+
List.fold_left (fun umap (e1, e2) -> unify_exprs umap e1 e2) umap (List.combine t1 t2)
56+
| Eif (c1, t1, f1), Eif (c2, t2, f2) ->
57+
let umap = unify_exprs umap c1 c2 in
58+
let umap = unify_exprs umap t1 t2 in
59+
unify_exprs umap f1 f2
60+
| Ematch (c1, p1, _), Ematch (c2, p2, _) ->
61+
let umap = unify_exprs umap c1 c2 in
62+
List.fold_left (fun umap (e1, e2) -> unify_exprs umap e1 e2) umap (List.combine p1 p2)
63+
| Eproj (e1, _), Eproj (e2, _) ->
64+
unify_exprs umap e1 e2
65+
| _ -> raise (UnificationError (UE_ExprNotInLockstep (e1, e2)))
66+
67+
(*---------------------------------------------------------------------------------------*)
68+
let rec unify_instrs umap i1 i2 =
69+
match i1.i_node, i2.i_node with
70+
| Sasgn(_, e1), Sasgn(_, e2)
71+
| Srnd(_, e1), Srnd(_, e2) ->
72+
unify_exprs umap e1 e2
73+
| Scall(_, _, args1), Scall(_, _, args2) ->
74+
List.fold_left (fun umap (e1, e2) -> unify_exprs umap e1 e2) umap (List.combine args1 args2)
75+
| Sif(e1, st1, sf1), Sif(e2, st2, sf2) ->
76+
let umap = unify_exprs umap e1 e2 in
77+
let umap = unify_stmts umap st1 st2 in
78+
unify_stmts umap sf1 sf2
79+
| Swhile(e1, s1), Swhile(e2, s2) ->
80+
let umap = unify_exprs umap e1 e2 in
81+
unify_stmts umap s1 s2
82+
| Smatch(e1, bs1), Smatch(e2, bs2) ->
83+
let umap = unify_exprs umap e1 e2 in
84+
List.fold_left (fun umap (b1, b2) -> unify_stmts umap (snd b1) (snd b2)) umap (List.combine bs1 bs2)
85+
| Sassert e1, Sassert e2 ->
86+
unify_exprs umap e1 e2
87+
| Sabstract _, Sabstract _ -> umap
88+
| _ -> raise (UnificationError (UE_InstrNotInLockstep (i1, i2)));
89+
90+
and unify_stmts umap s1 s2 =
91+
let s1n, s2n = s1.s_node, s2.s_node in
92+
if List.length s1n <> List.length s2n then
93+
raise (UnificationError (UE_DifferentProgramLengths (s1, s2)));
94+
List.fold_left (fun umap (i1, i2) -> unify_instrs umap i1 i2) umap (List.combine s1n s2n)
95+
96+
(*---------------------------------------------------------------------------------------*)
97+
(* Given a function definition attempt to unify its body with the statements `sb`
98+
and if a return statement is given, also unify it's expression. *)
99+
let unify_func umap fdef sb sr =
100+
(* Unify the body *)
101+
let umap = unify_stmts umap fdef.f_body sb in
102+
103+
(* Unify the return stmt (if it exists) and retrieve its lv *)
104+
match sr with
105+
| Some i -> begin
106+
(* Check that there is a return expression to unify with *)
107+
if fdef.f_ret = None then
108+
raise (UnificationError UE_UnexpectedReturn);
109+
110+
(* Only unify with assignment instructions *)
111+
match i.i_node with
112+
| Sasgn (lv, e) -> Some lv, unify_exprs umap (Option.get fdef.f_ret) e
113+
| _ -> raise (UnificationError UE_InvalidRetInstr)
114+
end
115+
| _ -> None, umap

‎src/ecUnifyProc.mli‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
open EcTypes
2+
open EcModules
3+
open EcSymbols
4+
5+
(*---------------------------------------------------------------------------------------*)
6+
(* `Unification` of procedures *)
7+
(*
8+
Given: r <@ foo(a1: t1, a2: t2, ...); and s1; s2; ...; sr.
9+
Attempt to find values for a1, a2, ... such that, the body of `foo` with a1, a2, ...
10+
replaced will exactly match s1; s2; ..., and that `r <- res` match sr.
11+
Where `res` is the return expression of `foo`.
12+
13+
Currently, this is done by traversing the respective ASTs and when a relevant
14+
program variable is encountered on the lhs, use the rhs expression.
15+
16+
FIXME: This is incredibly basic and should be iterated on with a more advanced
17+
procedure unification algorithm.
18+
*)
19+
20+
(*---------------------------------------------------------------------------------------*)
21+
type u_error =
22+
| UE_InvalidRetInstr
23+
| UE_UnexpectedReturn
24+
| UE_ExprNotInLockstep of expr * expr
25+
| UE_InstrNotInLockstep of instr * instr
26+
| UE_DifferentProgramLengths of stmt * stmt
27+
28+
exception UnificationError of u_error
29+
30+
(*---------------------------------------------------------------------------------------*)
31+
type u_value =
32+
| Empty
33+
| Fixed of expr
34+
35+
type umap = u_value Msym.t
36+
37+
(*---------------------------------------------------------------------------------------*)
38+
(* The following functions attempt to unify unknown program variables
39+
in the lhs with expressions from the rhs *)
40+
val unify_exprs : umap -> expr -> expr -> umap
41+
val unify_instrs : umap -> instr -> instr -> umap
42+
val unify_stmts : umap -> stmt -> stmt -> umap
43+
val unify_func : umap -> function_def -> stmt -> instr option -> lvalue option * umap

0 commit comments

Comments
 (0)