Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

New code-position variants: ^()<-, and ^(x)<- to match tuples. #707

Merged
merged 1 commit into from
Feb 5, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 9 additions & 0 deletions src/ecMatching.ml
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ module Position = struct
| `If
| `While
| `Assign of lvmatch
| `AssignTuple of lvmatch
| `Sample of lvmatch
| `Call of lvmatch
| `Match
Expand Down Expand Up @@ -122,6 +123,14 @@ module Zipper = struct
-> i-1
| _ -> i
end
| Sasgn (lv, _), `AssignTuple lvm -> begin
match lv, lvm with
| LvTuple _, `LvmNone -> i-1
| LvTuple pvs, `LvmVar pvm
when List.exists (fun (pv, _) -> EcReduction.EqTest.for_pv env pv pvm) pvs
-> i-1
| _ -> i
end

| _ -> i

Expand Down
1 change: 1 addition & 0 deletions src/ecMatching.mli
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ module Position : sig
| `While
| `Match
| `Assign of lvmatch
| `AssignTuple of lvmatch
| `Sample of lvmatch
| `Call of lvmatch
]
Expand Down
9 changes: 5 additions & 4 deletions src/ecParser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -1462,9 +1462,9 @@ update_cond:
| MINUS bs=branch_select { Pupc_del bs }

fun_update:
| cp=loc(codepos) sup=update_stmt
| cp=loc(codepos) sup=update_stmt
{ List.map (fun v -> (cp, Pup_stmt v)) sup }
| cp=loc(codepos) cup=update_cond
| cp=loc(codepos) cup=update_cond
{ [(cp, Pup_cond cup)] }

(* -------------------------------------------------------------------- *)
Expand Down Expand Up @@ -2486,6 +2486,7 @@ icodepos_r:
| lvm=lvmatch LESAMPLE { (`Sample lvm :> pcp_match) }
| lvm=lvmatch LEAT { (`Call lvm :> pcp_match) }
| lvm=lvmatch LARROW { (`Assign lvm :> pcp_match) }
| lvm=paren(lvmatch) LARROW { (`AssignTuple lvm :> pcp_match) }

lvmatch:
| empty { (`LvmNone :> plvmatch) }
Expand Down Expand Up @@ -3703,7 +3704,7 @@ hintoption:
| x=lident {
match unloc x with
| "rigid" -> `Rigid
| _ ->
| _ ->
parse_error x.pl_loc
(Some ("invalid option: " ^ (unloc x)))
}
Expand All @@ -3716,7 +3717,7 @@ hint:
{ { ht_local = local;
ht_prio = prio;
ht_base = base ;
ht_names = l;
ht_names = l;
ht_options = odfl [] opts; } }

(* -------------------------------------------------------------------- *)
Expand Down
1 change: 1 addition & 0 deletions src/ecParsetree.ml
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ type pcp_match = [
| `While
| `Match
| `Assign of plvmatch
| `AssignTuple of plvmatch
| `Sample of plvmatch
| `Call of plvmatch
]
Expand Down
24 changes: 13 additions & 11 deletions src/ecPrinting.ml
Original file line number Diff line number Diff line change
Expand Up @@ -452,8 +452,8 @@ let pp_shorten_path (cond : P.path -> qsymbol -> bool) (fmt : Format.formatter)
| None ->
Format.fprintf fmt "%a" EcSymbols.pp_qsymbol plong
| Some pshort ->
Format.fprintf fmt "%a (shorten name: %a)"
EcSymbols.pp_qsymbol plong
Format.fprintf fmt "%a (shorten name: %a)"
EcSymbols.pp_qsymbol plong
EcSymbols.pp_qsymbol pshort

(* -------------------------------------------------------------------- *)
Expand Down Expand Up @@ -940,7 +940,7 @@ let pp_tuple (type v)

let pp_proji (type v)
(ppe : PPEnv.t)
(pp_sub : PPEnv.t -> opprec * iassoc -> v pp)
(pp_sub : PPEnv.t -> opprec * iassoc -> v pp)
(fmt : Format.formatter)
((e, i) : v * int)
=
Expand Down Expand Up @@ -1601,7 +1601,7 @@ and try_pp_chained_orderings
let sb = EcMatching.MEV.assubst ue ev ppe.ppe_env in
let i1 = Fsubst.f_subst sb i1 in
let i2 = Fsubst.f_subst sb i2 in

(op, tvi), (i1, i2)
end

Expand All @@ -1626,7 +1626,7 @@ and try_pp_chained_orderings
le;

let acc = (op, tvi, i2) :: acc in

Option.fold ~none:(i1, acc) ~some:(collect acc (Some i1)) f1
in
match collect [] None f with
Expand Down Expand Up @@ -1720,8 +1720,8 @@ and match_pp_notations
let nts = EcEnv.Op.get_notations ~head ppe.PPEnv.ppe_env in

List.find_map_opt try_notation nts


and try_pp_notations
(ppe : PPEnv.t)
(outer : opprec * iassoc)
Expand Down Expand Up @@ -2269,6 +2269,8 @@ let pp_codepos1 (ppe : PPEnv.t) (fmt : Format.formatter) ((off, cp) : CP.codepos
| `Call (`LvmVar pv) -> Format.asprintf "%a<@" (pp_pv ppe) pv
| `Assign `LvmNone -> "<-"
| `Assign (`LvmVar pv) -> Format.asprintf "%a<-" (pp_pv ppe) pv
| `AssignTuple `LvmNone -> "()<-"
| `AssignTuple (`LvmVar pv) -> Format.asprintf "(%a)<-" (pp_pv ppe) pv
in Format.asprintf "^%s" k in

match i with
Expand All @@ -2290,7 +2292,7 @@ let pp_codeoffset1 (ppe : PPEnv.t) (fmt : Format.formatter) (offset : CP.codeoff
(* -------------------------------------------------------------------- *)
let pp_codepos (ppe : PPEnv.t) (fmt : Format.formatter) ((nm, cp1) : CP.codepos) =
let pp_nm (fmt : Format.formatter) ((cp, bs) : CP.codepos1 * CP.codepos_brsel) =
let bs =
let bs =
match bs with
| `Cond true -> "."
| `Cond false -> "?"
Expand Down Expand Up @@ -3030,7 +3032,7 @@ let pp_rwbase ppe fmt (p, rws) =
let pp_solvedb ppe fmt (db: (int * (P.path * _) list) list) =
List.iter (fun (lvl, ps) ->
Format.fprintf fmt "[%3d] %a\n%!"
lvl
lvl
(pp_list ", " (pp_axhnt ppe))
ps)
db;
Expand All @@ -3050,7 +3052,7 @@ let pp_solvedb ppe fmt (db: (int * (P.path * _) list) list) =
match ir with
| `Default -> ""
| `Rigid -> " (rigid)" in

Format.fprintf fmt "%a%s\n\n%!" (pp_axiom ppe) ax ir)
lemmas
end
Expand Down Expand Up @@ -3563,7 +3565,7 @@ let pp_by_theory
(pp : PPEnv.t -> (EcPath.path * 'a) pp)
(fmt : Format.formatter)
(xs : (EcPath.path * 'a) list)
=
=
let tr =
List.fold_left (fun tr ((p, _) as x) ->
Trie.add (EcPath.tolist (oget (EcPath.prefix p))) x tr
Expand Down
4 changes: 3 additions & 1 deletion src/ecTyping.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3081,7 +3081,7 @@ and trans_form_or_pattern env mode ?mv ?ps ue pf tt =
| PFdecimal (n, f) ->
f_decimal (n, f)

| PFtuple pes ->
| PFtuple pes ->
let esig = List.map (fun _ -> EcUnify.UniEnv.fresh ue) pes in
tt |> oiter (fun tt -> unify_or_fail env ue f.pl_loc ~expct:tt (ttuple esig));
let es = List.map2 (fun tt pe -> transf env ~tt pe) esig pes in
Expand Down Expand Up @@ -3608,6 +3608,8 @@ and trans_cp_match ?(memory : memory option) (env : EcEnv.env) (p : pcp_match) :
`Call (trans_lv_match ?memory env lv)
| `Assign lv ->
`Assign (trans_lv_match ?memory env lv)
| `AssignTuple lv ->
`AssignTuple (trans_lv_match ?memory env lv)
(* -------------------------------------------------------------------- *)
and trans_cp_base ?(memory : memory option) (env : EcEnv.env) (p : pcp_base) : cp_base =
match p with
Expand Down
23 changes: 23 additions & 0 deletions tests/codepos-tuple-name.ec
Original file line number Diff line number Diff line change
@@ -0,0 +1,23 @@
(* -------------------------------------------------------------------- *)
require import AllCore.

module M = {
proc f() = {
var x : int;
var y : int;
var z : int;

y <- 1;
(x, z) <- (0, 0);
return y;
}
}.

op p : int -> bool.

lemma L : hoare[M.f : true ==> p res].
proof.
proc.
swap ^()<- @ ^y<-.
swap ^y<- @ ^(x)<-.
abort.