From 62595d02b388d03d7802bf653a05976ee9ee5706 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 7 Oct 2022 12:19:57 +0100 Subject: [PATCH 01/81] stub code for viper --- src/viper/dune | 5 +++++ src/viper/pretty.ml | 2 ++ src/viper/syntax.ml | 1 + src/viper/trans.ml | 1 + 4 files changed, 9 insertions(+) create mode 100644 src/viper/dune create mode 100644 src/viper/pretty.ml create mode 100644 src/viper/syntax.ml create mode 100644 src/viper/trans.ml diff --git a/src/viper/dune b/src/viper/dune new file mode 100644 index 00000000000..53f71a7f196 --- /dev/null +++ b/src/viper/dune @@ -0,0 +1,5 @@ +(library + (name viper) + (libraries lib mo_def mo_types) + (instrumentation (backend bisect_ppx --bisect-silent yes)) +) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml new file mode 100644 index 00000000000..7731171d4e6 --- /dev/null +++ b/src/viper/pretty.ml @@ -0,0 +1,2 @@ +let prog p = "" + diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml new file mode 100644 index 00000000000..5e34b3f3b0b --- /dev/null +++ b/src/viper/syntax.ml @@ -0,0 +1 @@ +type prog = unit diff --git a/src/viper/trans.ml b/src/viper/trans.ml new file mode 100644 index 00000000000..a7f259752b8 --- /dev/null +++ b/src/viper/trans.ml @@ -0,0 +1 @@ +let trans (p : Mo_def.Syntax.prog) : Syntax.prog = () From fce1e32b5d09da906be1cb79096a8d3589220b46 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 7 Oct 2022 12:24:20 +0100 Subject: [PATCH 02/81] initial command line arg --- src/exes/moc.ml | 5 ++++- src/pipeline/dune | 1 + src/pipeline/pipeline.ml | 16 ++++++++++++++++ src/pipeline/pipeline.mli | 2 ++ 4 files changed, 23 insertions(+), 1 deletion(-) diff --git a/src/exes/moc.ml b/src/exes/moc.ml index a1da31ca595..8f51bed472c 100644 --- a/src/exes/moc.ml +++ b/src/exes/moc.ml @@ -10,7 +10,7 @@ let usage = "Usage: " ^ name ^ " [option] [file ...]" (* Argument handling *) -type mode = Default | Check | StableCompatible | Compile | Run | Interact | PrintDeps | Explain +type mode = Default | Check | StableCompatible | Compile | Run | Interact | PrintDeps | Explain | Viper let mode = ref Default let args = ref [] @@ -42,6 +42,7 @@ let argspec = [ "-r", Arg.Unit (set_mode Run), " interpret programs"; "-i", Arg.Unit (set_mode Interact), " run interactive REPL (implies -r)"; "--check", Arg.Unit (set_mode Check), " type-check only"; + "--viper", Arg.Unit (set_mode Viper), " emit viper code"; "--stable-compatible", Arg.Tuple [ Arg.String (fun fp -> Flags.pre_ref := Some fp); @@ -189,6 +190,8 @@ let process_files files : unit = exit_on_none (Pipeline.run_files_and_stdin files) | Check -> Diag.run (Pipeline.check_files files) + | Viper -> + Diag.run (Pipeline.viper_files files) | StableCompatible -> begin match (!Flags.pre_ref, !Flags.post_ref) with diff --git a/src/pipeline/dune b/src/pipeline/dune index c4ae822f552..a756a57222a 100644 --- a/src/pipeline/dune +++ b/src/pipeline/dune @@ -18,6 +18,7 @@ ir_passes codegen rts + viper ) (inline_tests) (preprocess (per_module ((pps ppx_inline_test) resolve_import_test))) diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index 0f0e057da2b..bf48ae09f3c 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -483,6 +483,22 @@ let check_files' parsefn files : check_result = let check_files files : check_result = check_files' parse_file files +(* Generate Viper *) + +type viper_result = unit Diag.result + +let viper_files' parsefn files : check_result = + let open Diag.Syntax in + let* libs, progs, senv = load_progs parse_file files initial_stat_env in + let vs = List.map Viper.Trans.trans progs in + let ss = List.map Viper.Pretty.prog vs in + Diag.return () + + +let viper_files files : viper_result = + viper_files' parse_file files + + (* Generate IDL *) let generate_idl files : Idllib.Syntax.prog Diag.result = diff --git a/src/pipeline/pipeline.mli b/src/pipeline/pipeline.mli index a814e2c5583..30aa1dc1ff4 100644 --- a/src/pipeline/pipeline.mli +++ b/src/pipeline/pipeline.mli @@ -15,6 +15,8 @@ val print_deps: string -> unit val check_files : string list -> unit Diag.result val check_files' : parse_fn -> string list -> unit Diag.result +val viper_files : string list -> unit Diag.result + val stable_compatible : string -> string -> unit Diag.result val generate_idl : string list -> Idllib.Syntax.prog Diag.result From cc5499f48457dfd0ec2e114ac0dcbb6831fbe36c Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 7 Oct 2022 13:40:25 +0100 Subject: [PATCH 03/81] output translations, add annotations and formatting --- src/exes/moc.ml | 3 ++- src/pipeline/pipeline.ml | 8 ++++---- src/pipeline/pipeline.mli | 2 +- src/viper/dune | 2 +- src/viper/pretty.ml | 17 ++++++++++++++++- src/viper/syntax.ml | 7 ++++++- src/viper/trans.ml | 16 +++++++++++++++- 7 files changed, 45 insertions(+), 10 deletions(-) diff --git a/src/exes/moc.ml b/src/exes/moc.ml index 8f51bed472c..252421a5a5a 100644 --- a/src/exes/moc.ml +++ b/src/exes/moc.ml @@ -191,7 +191,8 @@ let process_files files : unit = | Check -> Diag.run (Pipeline.check_files files) | Viper -> - Diag.run (Pipeline.viper_files files) + let ss = Diag.run (Pipeline.viper_files files) in + List.iter2 (fun f s -> printf "%s\n%s" f s) files ss | StableCompatible -> begin match (!Flags.pre_ref, !Flags.post_ref) with diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index bf48ae09f3c..576bafe1ee8 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -485,14 +485,14 @@ let check_files files : check_result = (* Generate Viper *) -type viper_result = unit Diag.result +type viper_result = string list Diag.result -let viper_files' parsefn files : check_result = +let viper_files' parsefn files : viper_result = let open Diag.Syntax in let* libs, progs, senv = load_progs parse_file files initial_stat_env in - let vs = List.map Viper.Trans.trans progs in + let vs = List.map Viper.Trans.prog progs in let ss = List.map Viper.Pretty.prog vs in - Diag.return () + Diag.return ss let viper_files files : viper_result = diff --git a/src/pipeline/pipeline.mli b/src/pipeline/pipeline.mli index 30aa1dc1ff4..e4ee6fac8e0 100644 --- a/src/pipeline/pipeline.mli +++ b/src/pipeline/pipeline.mli @@ -15,7 +15,7 @@ val print_deps: string -> unit val check_files : string list -> unit Diag.result val check_files' : parse_fn -> string list -> unit Diag.result -val viper_files : string list -> unit Diag.result +val viper_files : string list -> string list Diag.result val stable_compatible : string -> string -> unit Diag.result diff --git a/src/viper/dune b/src/viper/dune index 53f71a7f196..7ba0a3a3e5d 100644 --- a/src/viper/dune +++ b/src/viper/dune @@ -1,5 +1,5 @@ (library (name viper) - (libraries lib mo_def mo_types) + (libraries lib lang_utils mo_def mo_types) (instrumentation (backend bisect_ppx --bisect-silent yes)) ) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 7731171d4e6..43b9cd44685 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -1,2 +1,17 @@ -let prog p = "" +open Source +open Syntax + +open Format + +let pp_info ppf NoInfo = () + +let pp_prog ppf p = + match p.it with + | Prog -> + fprintf ppf "Prog %a" pp_info p.note + + +let prog p = + Lib.Format.with_str_formatter (fun ppf -> + pp_prog ppf) p diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index 5e34b3f3b0b..955b2f0f385 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -1 +1,6 @@ -type prog = unit +type info = NoInfo + +type prog = (prog', info) Source.annotated_phrase + +and prog' = + Prog diff --git a/src/viper/trans.ml b/src/viper/trans.ml index a7f259752b8..847b2265080 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -1 +1,15 @@ -let trans (p : Mo_def.Syntax.prog) : Syntax.prog = () +open Source +open Syntax + + +let rec prog (p : Mo_def.Syntax.prog) : Syntax.prog = + let (it, note) = prog' p in + { it; + at = p.at; (* annotate with source location. *) + note (* and returned info *) + } + +and prog' p = + match p.it with + | _ -> + (Prog, NoInfo) From 353050e416ebeb677dcac9d3ca50f6369715b232 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 7 Oct 2022 15:29:15 +0100 Subject: [PATCH 04/81] some viper --- src/viper/dune | 3 ++- src/viper/syntax.ml | 58 +++++++++++++++++++++++++++++++++++++++++++++ src/viper/trans.ml | 2 +- 3 files changed, 61 insertions(+), 2 deletions(-) diff --git a/src/viper/dune b/src/viper/dune index 7ba0a3a3e5d..c4ca240203f 100644 --- a/src/viper/dune +++ b/src/viper/dune @@ -1,5 +1,6 @@ (library (name viper) - (libraries lib lang_utils mo_def mo_types) + + (libraries lib num lang_utils mo_def mo_types) (instrumentation (backend bisect_ppx --bisect-silent yes)) ) diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index 955b2f0f385..bff34e647bc 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -1,6 +1,64 @@ type info = NoInfo +type id = (string, info) Source.annotated_phrase + type prog = (prog', info) Source.annotated_phrase and prog' = Prog + +and item = (item', info) Source.annotated_phrase +and item' = + (* | import path *) + | FieldI of id * typ + | MethodI of id * localvardecl list * exp list * exp list * seqn option + +and localvardecl = id * typ + +and seqn = (stmt list * decl list, info ) Source.annotated_phrase + +and decl = ((id * typ), info) Source.annotated_phrase + +and exp = (exp', info) Source.annotated_phrase + +and exp' = + | BoolE of bool + | IntN of int (* Num.Big_int.t *) + | Add of exp * exp + | Sub of exp * exp + | Mul of exp * exp + | Div of exp * exp + | Mod of exp * exp + | Lt of exp * exp + | Le of exp * exp + | Gt of exp * exp + | Ge of exp * exp + | Eq of exp * exp + | Ne of exp * exp + | FldAcc of fldacc + +and invariants = exp list + +and stmt = (stmt', info) Source.annotated_phrase + +and fldacc = (exp * id) + +and stmt' = + | MethodCallS of id * exp list * id list + | ExhaleS of exp + | InhaleS of exp + | AssertS of exp + | AssumeS of exp + | SeqnS of seqn + | VarAssignE of id * exp + | FieldAssignE of fldacc * exp + | IfS of exp * seqn * seqn + | WhileE of exp * invariants * seqn + | LabelE of id * invariants + + +and typ = (typ', info) Source.annotated_phrase + +and typ' = + | IntT + diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 847b2265080..3e3786f4b06 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -2,7 +2,7 @@ open Source open Syntax -let rec prog (p : Mo_def.Syntax.prog) : Syntax.prog = +let rec prog (p : Mo_def.Syntax.prog) : prog = let (it, note) = prog' p in { it; at = p.at; (* annotate with source location. *) From e11d48622df5b32ba1f799e5d458f6a402e27f3f Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 7 Oct 2022 18:22:18 +0100 Subject: [PATCH 05/81] start on pretty (not pretty) --- src/viper/pretty.ml | 69 +++++++++++++++++++++++++++++++++++++++++++-- src/viper/syntax.ml | 55 +++++++++++++++++++++++------------- src/viper/trans.ml | 2 +- 3 files changed, 102 insertions(+), 24 deletions(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 43b9cd44685..14ac65aaa4b 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -3,13 +3,76 @@ open Syntax open Format +let pr = pp_print_string + +let comma ppf () = fprintf ppf ",@ " + +let semi ppf () = fprintf ppf ";@ " + let pp_info ppf NoInfo = () -let pp_prog ppf p = +let rec pp_prog ppf p = match p.it with - | Prog -> - fprintf ppf "Prog %a" pp_info p.note + | is -> + fprintf ppf "@[%a@]" + (pp_print_list pp_item) is + +and pp_item ppf i = + match i.it with + | FieldI (id, typ) -> + fprintf ppf "@[<2>field %s :@ %a@]" + id.it + pp_typ typ + | MethodI (id, locals, rets, pres, posts, bo) -> + fprintf ppf "@[<2>method %s%a :@ %a %a %a %a @]" + id.it + pp_locals locals + pp_returns rets + pp_pres pres + pp_posts posts + pp_block_opt bo + +and pp_block_opt ppf bo = + match bo with + | None -> () + | Some ss -> () (* TODO *) + +and pp_pres ppf exps = + fprintf ppf "@[%a@]" (pp_print_list pp_pre) exps + +and pp_pre ppf exp = + fprintf ppf "requires @[<2>%a@]" pp_exp exp + +and pp_posts ppf exps = + fprintf ppf "@[%a@]" (pp_print_list pp_pre) exps + +and pp_post ppf exp = + fprintf ppf "ensures @[<2>%a@]" pp_exp exp + +and pp_local ppf (id, typ) = + fprintf ppf "@[<2>%s :@ %a@]" + id.it + pp_typ typ + +and pp_locals ppf pars = + fprintf ppf "@[<1>(%a)@]" + (pp_print_list ~pp_sep:comma (pp_local)) pars + +and pp_returns ppf pars = + match pars with + | [] -> () + | _ -> + fprintf ppf "returns @[<1>(%a)@]" + (pp_print_list ~pp_sep:comma (pp_local)) pars + +and pp_typ ppf t = + match t.it with + | IntT -> pr ppf "Int" + | BoolT -> pr ppf "Bool" +and pp_exp ppf exp = + match exp.it with + | _ -> pr ppf "?" (* TBC *) let prog p = Lib.Format.with_str_formatter (fun ppf -> diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index bff34e647bc..bf562f13946 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -2,18 +2,15 @@ type info = NoInfo type id = (string, info) Source.annotated_phrase -type prog = (prog', info) Source.annotated_phrase - -and prog' = - Prog +type prog = (item list, info) Source.annotated_phrase and item = (item', info) Source.annotated_phrase and item' = (* | import path *) | FieldI of id * typ - | MethodI of id * localvardecl list * exp list * exp list * seqn option + | MethodI of id * par list * par list * exp list * exp list * seqn option -and localvardecl = id * typ +and par = id * typ and seqn = (stmt list * decl list, info ) Source.annotated_phrase @@ -22,26 +19,43 @@ and decl = ((id * typ), info) Source.annotated_phrase and exp = (exp', info) Source.annotated_phrase and exp' = - | BoolE of bool - | IntN of int (* Num.Big_int.t *) - | Add of exp * exp - | Sub of exp * exp - | Mul of exp * exp - | Div of exp * exp - | Mod of exp * exp - | Lt of exp * exp - | Le of exp * exp - | Gt of exp * exp - | Ge of exp * exp - | Eq of exp * exp - | Ne of exp * exp + | BoolLitE of bool + | NullLitE + | IntE of int (* Num.Big_int.t *) + | AddE of exp * exp + | SubE of exp * exp + | MulE of exp * exp + | DivE of exp * exp + | ModE of exp * exp + | LtCmpE of exp * exp + | LeCmpE of exp * exp + | GtCmpE of exp * exp + | GeCmpE of exp * exp + | EqCmpE of exp * exp + | NeCmpE of exp * exp + | MinusE of exp + | NotE of exp * exp + | AndE of exp * exp + | OrE of exp * exp + | Implies of exp * exp | FldAcc of fldacc + | PermExp of perm + +and perm = (perm', info) Source.annotated_phrase + +and perm' = + | WildcardP + | FullP + | NoP + | EpsilonP +(* | FractionalP of exp * exp | ...*) + and invariants = exp list and stmt = (stmt', info) Source.annotated_phrase -and fldacc = (exp * id) +and fldacc = exp * id and stmt' = | MethodCallS of id * exp list * id list @@ -61,4 +75,5 @@ and typ = (typ', info) Source.annotated_phrase and typ' = | IntT + | BoolT diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 3e3786f4b06..90ed61cab97 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -12,4 +12,4 @@ let rec prog (p : Mo_def.Syntax.prog) : prog = and prog' p = match p.it with | _ -> - (Prog, NoInfo) + ([], NoInfo) From b14abe356bf40e0dde901eed9df54efcceb79893 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Mon, 10 Oct 2022 18:05:03 +0100 Subject: [PATCH 06/81] hack in more viper --- src/exes/moc.ml | 4 +- src/pipeline/pipeline.ml | 11 +- src/pipeline/pipeline.mli | 2 +- src/viper/syntax.ml | 8 +- src/viper/trans.ml | 389 +++++++++++++++++++++++++++++++++++++- 5 files changed, 394 insertions(+), 20 deletions(-) diff --git a/src/exes/moc.ml b/src/exes/moc.ml index 252421a5a5a..4dd8abd5a00 100644 --- a/src/exes/moc.ml +++ b/src/exes/moc.ml @@ -191,8 +191,8 @@ let process_files files : unit = | Check -> Diag.run (Pipeline.check_files files) | Viper -> - let ss = Diag.run (Pipeline.viper_files files) in - List.iter2 (fun f s -> printf "%s\n%s" f s) files ss + let s = Diag.run (Pipeline.viper_files files) in + printf "%s" s | StableCompatible -> begin match (!Flags.pre_ref, !Flags.post_ref) with diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index 576bafe1ee8..abe80a07920 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -485,14 +485,17 @@ let check_files files : check_result = (* Generate Viper *) -type viper_result = string list Diag.result +type viper_result = string Diag.result let viper_files' parsefn files : viper_result = let open Diag.Syntax in let* libs, progs, senv = load_progs parse_file files initial_stat_env in - let vs = List.map Viper.Trans.prog progs in - let ss = List.map Viper.Pretty.prog vs in - Diag.return ss + let* () = Typing.check_actors senv progs in + let prog = CompUnit.combine_progs progs in + let u = CompUnit.comp_unit_of_prog false prog in + let v = Viper.Trans.unit u in + let s = Viper.Pretty.prog v in + Diag.return s let viper_files files : viper_result = diff --git a/src/pipeline/pipeline.mli b/src/pipeline/pipeline.mli index e4ee6fac8e0..4a8df4f1126 100644 --- a/src/pipeline/pipeline.mli +++ b/src/pipeline/pipeline.mli @@ -15,7 +15,7 @@ val print_deps: string -> unit val check_files : string list -> unit Diag.result val check_files' : parse_fn -> string list -> unit Diag.result -val viper_files : string list -> string list Diag.result +val viper_files : string list -> string Diag.result val stable_compatible : string -> string -> unit Diag.result diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index bf562f13946..10c1dab3929 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -12,16 +12,18 @@ and item' = and par = id * typ -and seqn = (stmt list * decl list, info ) Source.annotated_phrase +and seqn = (decl list * stmt list, info ) Source.annotated_phrase -and decl = ((id * typ), info) Source.annotated_phrase +and decl = (id * typ, info) Source.annotated_phrase and exp = (exp', info) Source.annotated_phrase and exp' = + | LocalVar of id * typ + | Result of typ | BoolLitE of bool | NullLitE - | IntE of int (* Num.Big_int.t *) + | IntLitE of int (* Num.Big_int.t *) | AddE of exp * exp | SubE of exp * exp | MulE of exp * exp diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 90ed61cab97..53721a76b3e 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -1,15 +1,384 @@ open Source + open Syntax +module T = Mo_types.Type +module M = Mo_def.Syntax + +let unit (u : Mo_def.Syntax.comp_unit) : prog = + let { M.imports; M.body } = u.it in + match body.it with + | M.ActorU(id_opt, decs) -> + { it = []; + at = body.at; + note = NoInfo + } + | _ -> assert false + +(* +let rec exp e = match e.it with + | VarE x -> "VarE" $$ [id x] + | LitE l -> "LitE" $$ [lit !l] + | ActorUrlE e -> "ActorUrlE" $$ [exp e] + | UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; Arrange_ops.unop uo; exp e] + | BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; Arrange_ops.binop bo; exp e2] + | RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; Arrange_ops.relop ro; exp e2] + | ShowE (ot, e) -> "ShowE" $$ [operator_type !ot; exp e] + | ToCandidE es -> "ToCandidE" $$ exps es + | FromCandidE e -> "FromCandidE" $$ [exp e] + | TupE es -> "TupE" $$ exps es + | ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)] + | ObjBlockE (s, dfs) -> "ObjBlockE" $$ [obj_sort s] @ List.map dec_field dfs + | ObjE ([], efs) -> "ObjE" $$ List.map exp_field efs + | ObjE (bases, efs) -> "ObjE" $$ exps bases @ [Atom "with"] @ List.map exp_field efs + | DotE (e, x) -> "DotE" $$ [exp e; id x] + | AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2] + | ArrayE (m, es) -> "ArrayE" $$ [mut m] @ exps es + | IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2] + | FuncE (x, sp, tp, p, t, sugar, e') -> + "FuncE" $$ [ + Atom (Type.string_of_typ e.note.note_typ); + shared_pat sp; + Atom x] @ + List.map typ_bind tp @ [ + pat p; + (match t with None -> Atom "_" | Some t -> typ t); + Atom (if sugar then "" else "="); + exp e' + ] + | CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ inst ts @ [exp e2] + | BlockE ds -> "BlockE" $$ List.map dec ds + | NotE e -> "NotE" $$ [exp e] + | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] + | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] + | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] + | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs + | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] + | LoopE (e1, None) -> "LoopE" $$ [exp e1] + | LoopE (e1, Some e2) -> "LoopE" $$ [exp e1; exp e2] + | ForE (p, e1, e2) -> "ForE" $$ [pat p; exp e1; exp e2] + | LabelE (i, t, e) -> "LabelE" $$ [id i; typ t; exp e] + | DebugE e -> "DebugE" $$ [exp e] + | BreakE (i, e) -> "BreakE" $$ [id i; exp e] + | RetE e -> "RetE" $$ [exp e] + | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] + | AwaitE e -> "AwaitE" $$ [exp e] + | AssertE e -> "AssertE" $$ [exp e] + | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] + | OptE e -> "OptE" $$ [exp e] + | DoOptE e -> "DoOptE" $$ [exp e] + | BangE e -> "BangE" $$ [exp e] + | TagE (i, e) -> "TagE" $$ [id i; exp e] + | PrimE p -> "PrimE" $$ [Atom p] + | ImportE (f, _fp) -> "ImportE" $$ [Atom f] + | ThrowE e -> "ThrowE" $$ [exp e] + | TryE (e, cs) -> "TryE" $$ [exp e] @ List.map catch cs + | IgnoreE e -> "IgnoreE" $$ [exp e] + +and exps es = List.map exp es + +and inst inst = match inst.it with + | None -> [] + | Some ts -> List.map typ ts + +and pat p = match p.it with + | WildP -> Atom "WildP" + | VarP x -> "VarP" $$ [id x] + | TupP ps -> "TupP" $$ List.map pat ps + | ObjP ps -> "ObjP" $$ List.map pat_field ps + | AnnotP (p, t) -> "AnnotP" $$ [pat p; typ t] + | LitP l -> "LitP" $$ [lit !l] + | SignP (uo, l) -> "SignP" $$ [Arrange_ops.unop uo ; lit !l] + | OptP p -> "OptP" $$ [pat p] + | TagP (i, p) -> "TagP" $$ [tag i; pat p] + | AltP (p1,p2) -> "AltP" $$ [pat p1; pat p2] + | ParP p -> "ParP" $$ [pat p] + +and lit = function + | NullLit -> Atom "NullLit" + | BoolLit true -> "BoolLit" $$ [ Atom "true" ] + | BoolLit false -> "BoolLit" $$ [ Atom "false" ] + | NatLit n -> "NatLit" $$ [ Atom (Numerics.Nat.to_pretty_string n) ] + | Nat8Lit n -> "Nat8Lit" $$ [ Atom (Numerics.Nat8.to_pretty_string n) ] + | Nat16Lit n -> "Nat16Lit" $$ [ Atom (Numerics.Nat16.to_pretty_string n) ] + | Nat32Lit n -> "Nat32Lit" $$ [ Atom (Numerics.Nat32.to_pretty_string n) ] + | Nat64Lit n -> "Nat64Lit" $$ [ Atom (Numerics.Nat64.to_pretty_string n) ] + | IntLit i -> "IntLit" $$ [ Atom (Numerics.Int.to_pretty_string i) ] + | Int8Lit i -> "Int8Lit" $$ [ Atom (Numerics.Int_8.to_pretty_string i) ] + | Int16Lit i -> "Int16Lit" $$ [ Atom (Numerics.Int_16.to_pretty_string i) ] + | Int32Lit i -> "Int32Lit" $$ [ Atom (Numerics.Int_32.to_pretty_string i) ] + | Int64Lit i -> "Int64Lit" $$ [ Atom (Numerics.Int_64.to_pretty_string i) ] + | FloatLit f -> "FloatLit" $$ [ Atom (Numerics.Float.to_pretty_string f) ] + | CharLit c -> "CharLit" $$ [ Atom (string_of_int c) ] + | TextLit t -> "TextLit" $$ [ Atom t ] + | BlobLit b -> "BlobLit" $$ [ Atom b ] + | PreLit (s,p) -> "PreLit" $$ [ Atom s; Arrange_type.prim p ] + +and case c = "case" $$ [pat c.it.pat; exp c.it.exp] + +and catch c = "catch" $$ [pat c.it.pat; exp c.it.exp] + +and pat_field pf = pf.it.id.it $$ [pat pf.it.pat] + +and obj_sort s = match s.it with + | Type.Object -> Atom "Object" + | Type.Actor -> Atom "Actor" + | Type.Module -> Atom "Module" + | Type.Memory -> Atom "Memory" + +and shared_pat sp = match sp.it with + | Type.Local -> Atom "Local" + | Type.Shared (Type.Write, p) -> "Shared" $$ [pat p] + | Type.Shared (Type.Query, p) -> "Query" $$ [pat p] + +and func_sort s = match s.it with + | Type.Local -> Atom "Local" + | Type.Shared Type.Write -> Atom "Shared" + | Type.Shared Type.Query -> Atom "Query" + +and mut m = match m.it with + | Const -> Atom "Const" + | Var -> Atom "Var" + +and vis v = match v.it with + | Public None -> Atom "Public" + | Public (Some m) -> "Public" $$ [Atom m] + | Private -> Atom "Private" + | System -> Atom "System" + +and stab s_opt = match s_opt with + | None -> Atom "(Flexible)" + | Some s -> + (match s.it with + | Flexible -> Atom "Flexible" + | Stable -> Atom "Stable") + +and typ_field (tf : typ_field) = match tf.it with + | ValF (id, t, m) -> id.it $$ [typ t; mut m] + | TypF (id', tbs, t) -> + "TypF" $$ [id id'] @ List.map typ_bind tbs @ [typ t] +and typ_item ((id, ty) : typ_item) = + match id with + | None -> [typ ty] + | Some { it;_ } -> [Atom it; typ ty] + +and typ_tag (tt : typ_tag) + = tt.it.tag.it $$ [typ tt.it.typ] + +and typ_bind (tb : typ_bind) + = tb.it.var.it $$ [typ tb.it.bound] + +and dec_field (df : dec_field) + = "DecField" $$ [dec df.it.dec; vis df.it.vis; stab df.it.stab] + +and exp_field (ef : exp_field) + = "ExpField" $$ [mut ef.it.mut; id ef.it.id; exp ef.it.exp] + +and operator_type t = Atom (Type.string_of_typ t) + +and path p = match p.it with + | IdH i -> "IdH" $$ [id i] + | DotH (p,i) -> "DotH" $$ [path p; id i] + +and typ t = match t.it with + | PathT (p, ts) -> "PathT" $$ [path p] @ List.map typ ts + | PrimT p -> "PrimT" $$ [Atom p] + | ObjT (s, ts) -> "ObjT" $$ [obj_sort s] @ List.map typ_field ts + | ArrayT (m, t) -> "ArrayT" $$ [mut m; typ t] + | OptT t -> "OptT" $$ [typ t] + | VariantT cts -> "VariantT" $$ List.map typ_tag cts + | TupT ts -> "TupT" $$ List.concat_map typ_item ts + | FuncT (s, tbs, at, rt) -> "FuncT" $$ [func_sort s] @ List.map typ_bind tbs @ [ typ at; typ rt] + | AsyncT (t1, t2) -> "AsyncT" $$ [typ t1; typ t2] + | AndT (t1, t2) -> "AndT" $$ [typ t1; typ t2] + | OrT (t1, t2) -> "OrT" $$ [typ t1; typ t2] + | ParT t -> "ParT" $$ [typ t] + | NamedT (id, t) -> "NamedT" $$ [Atom id.it; typ t] + +and dec d = match d.it with + | ExpD e -> "ExpD" $$ [exp e ] + | LetD (p, e) -> "LetD" $$ [pat p; exp e] + | VarD (x, e) -> "VarD" $$ [id x; exp e] + | TypD (x, tp, t) -> + "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] + | ClassD (sp, x, tp, p, rt, s, i', dfs) -> + "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [ + pat p; + (match rt with None -> Atom "_" | Some t -> typ t); + obj_sort s; id i' + ] @ List.map dec_field dfs + + *) + +let rec dec_field d = + let (d', info) = dec_field' d.it in + { it = d'; + at = d.at; + note = info } + +and dec_field' d = + match d with + (* | ExpD e -> "ExpD" $$ [exp e ] *) + + | M.VarD (x, e) -> + (* TODO: translate e? *) + (FieldI(id x, tr_typ e.note.M.note_typ), + NoInfo) + | M.(LetD ({it=VarP f;_}, + {it=FuncE(x, sp, tp, p, t_opt, sugar, + { it = BlockE ds; at; _} );_})) -> + (MethodI(id f, args p, rets t_opt, [], [], Some (block at ds)), + NoInfo) +(* + | TypD (x, tp, t) -> + "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] + | ClassD (sp, x, tp, p, rt, s, i', dfs) -> + "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [ + pat p; + (match rt with None -> Atom "_" | Some t -> typ t); + obj_sort s; id i' + ] @ List.map dec_field dfs +*) + +and args p = match p.it with + | M.TupP ps -> + List.map (fun {it = M.VarP x; note; _} -> (id x, tr_typ note)) ps + +and block at ds = + { it = decs ds; + at; + note = NoInfo } + +and decs ds = + match ds with + | [] -> ([],[]) + | d::ds' -> + let (l, s) = dec d in + let (ls, ss) = decs ds' in + (l @ ls, s @ ss) + +and dec d = + match d.it with + | M.VarD (x, e) -> + (* TODO: translate e? *) + ([{ it = (id x, tr_typ e.note.M.note_typ); + at = d.at; + note = NoInfo }], + [{ it = VarAssignE (id x, exp e); + at = d.at; + note = NoInfo }]) + | M.(LetD ({it=VarP x;_}, e))-> + ([{ it = (id x, tr_typ e.note.M.note_typ); + at = d.at; + note = NoInfo }], + [{ it = VarAssignE (id x, exp e); + at = d.at; + note = NoInfo }]) + | M.(ExpD {it=IfE(e, + { it = BlockE ds1; at = at1; _}, + { it = BlockE ds2; at = at2; _}); + _})-> + ([], + [{ it = IfS(exp e, block at1 ds1, block at2 ds2); + at = d.at; + note = NoInfo }]) + + + +and exp e = + let (e', info) = exp' e.it in + { it = e'; + at = e.at; + note = info } + +and exp' e = + match e with + | M.VarE x -> + (*TODO: need environment to distinguish fields from locals *) + (LocalVar (id x, tr_typ e.M.note.note_typ), + NoInfo) + | M.LitE r -> + begin match !r with + | M.BoolLit b -> + (BoolLitE b, NoInfo) + | M.IntLit i -> + (IntLitE 0, NoInfo) + end +(* + | VarE x -> + | LitE l -> "LitE" $$ [lit !l] + | ActorUrlE e -> "ActorUrlE" $$ [exp e] + | UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; Arrange_ops.unop uo; exp e] + | BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; Arrange_ops.binop bo; exp e2] + | RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; Arrange_ops.relop ro; exp e2] + | ShowE (ot, e) -> "ShowE" $$ [operator_type !ot; exp e] + | ToCandidE es -> "ToCandidE" $$ exps es + | FromCandidE e -> "FromCandidE" $$ [exp e] + | TupE es -> "TupE" $$ exps es + | ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)] + | ObjBlockE (s, dfs) -> "ObjBlockE" $$ [obj_sort s] @ List.map dec_field dfs + | ObjE ([], efs) -> "ObjE" $$ List.map exp_field efs + | ObjE (bases, efs) -> "ObjE" $$ exps bases @ [Atom "with"] @ List.map exp_field efs + | DotE (e, x) -> "DotE" $$ [exp e; id x] + | AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2] + | ArrayE (m, es) -> "ArrayE" $$ [mut m] @ exps es + | IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2] + | FuncE (x, sp, tp, p, t, sugar, e') -> + "FuncE" $$ [ + Atom (Type.string_of_typ e.note.note_typ); + shared_pat sp; + Atom x] @ + List.map typ_bind tp @ [ + pat p; + (match t with None -> Atom "_" | Some t -> typ t); + Atom (if sugar then "" else "="); + exp e' + ] + | CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ inst ts @ [exp e2] + | BlockE ds -> "BlockE" $$ List.map dec ds + | NotE e -> "NotE" $$ [exp e] + | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] + | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] + | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] + | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs + | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] + | LoopE (e1, None) -> "LoopE" $$ [exp e1] + | LoopE (e1, Some e2) -> "LoopE" $$ [exp e1; exp e2] + | ForE (p, e1, e2) -> "ForE" $$ [pat p; exp e1; exp e2] + | LabelE (i, t, e) -> "LabelE" $$ [id i; typ t; exp e] + | DebugE e -> "DebugE" $$ [exp e] + | BreakE (i, e) -> "BreakE" $$ [id i; exp e] + | RetE e -> "RetE" $$ [exp e] + | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] + | AwaitE e -> "AwaitE" $$ [exp e] + | AssertE e -> "AssertE" $$ [exp e] + | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] + | OptE e -> "OptE" $$ [exp e] + | DoOptE e -> "DoOptE" $$ [exp e] + | BangE e -> "BangE" $$ [exp e] + | TagE (i, e) -> "TagE" $$ [id i; exp e] + | PrimE p -> "PrimE" $$ [Atom p] + | ImportE (f, _fp) -> "ImportE" $$ [Atom f] + | ThrowE e -> "ThrowE" $$ [exp e] + | TryE (e, cs) -> "TryE" $$ [exp e] @ List.map catch cs + | IgnoreE e -> "IgnoreE" $$ [exp e] +*) + + +and rets t_opt = + match t_opt with + | None -> [] + | Some t -> + match T.normalize t.note with + | T.Tup [] -> [] -let rec prog (p : Mo_def.Syntax.prog) : prog = - let (it, note) = prog' p in - { it; - at = p.at; (* annotate with source location. *) - note (* and returned info *) - } +and id id = { it = id.it; at = id.at; note = NoInfo } -and prog' p = - match p.it with - | _ -> - ([], NoInfo) +and tr_typ typ = + { it = tr_typ' typ; + at = Source.no_region; + note = NoInfo } +and tr_typ' typ = + match T.normalize typ with + | T.Prim T.Int -> IntT + | T.Prim T.Bool -> BoolT From 18e600375195354ee74f9babbcc2b1c9ad0925ce Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Tue, 11 Oct 2022 13:23:08 +0100 Subject: [PATCH 07/81] better printing --- src/mo_frontend/typing.ml | 1 + src/viper/dune | 2 +- src/viper/pretty.ml | 55 ++++++++++++++++++--- src/viper/syntax.ml | 12 ++--- src/viper/test/claim.mo | 22 +++++++++ src/viper/trans.ml | 101 +++++++++++++++++++++++++++++--------- 6 files changed, 156 insertions(+), 37 deletions(-) create mode 100644 src/viper/test/claim.mo diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml index 3aa0fa18597..9aadf3eb6bb 100644 --- a/src/mo_frontend/typing.ml +++ b/src/mo_frontend/typing.ml @@ -1236,6 +1236,7 @@ and infer_exp'' env exp : T.typ = let t1, ve1 = infer_pat_exhaustive (if T.is_shared_sort sort then local_error else warn) env' pat in let ve2 = T.Env.adjoin ve ve1 in let ts2 = List.map (check_typ env') ts2 in + typ.note <- T.seq ts2; (* HACK *) let codom = T.codom c (fun () -> T.Con(List.hd cs,[])) ts2 in if not env.pre then begin let env'' = diff --git a/src/viper/dune b/src/viper/dune index c4ca240203f..fe2c6c1ade4 100644 --- a/src/viper/dune +++ b/src/viper/dune @@ -1,6 +1,6 @@ (library (name viper) - (libraries lib num lang_utils mo_def mo_types) + (libraries lib num lang_utils mo_def mo_types mo_values) (instrumentation (backend bisect_ppx --bisect-silent yes)) ) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 14ac65aaa4b..e6010d98f74 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -20,11 +20,11 @@ let rec pp_prog ppf p = and pp_item ppf i = match i.it with | FieldI (id, typ) -> - fprintf ppf "@[<2>field %s :@ %a@]" + fprintf ppf "@[<2>field %s:@ %a@]" id.it pp_typ typ | MethodI (id, locals, rets, pres, posts, bo) -> - fprintf ppf "@[<2>method %s%a :@ %a %a %a %a @]" + fprintf ppf "@[method %s%a@ %a@ %a@ %a@; %a@]" id.it pp_locals locals pp_returns rets @@ -35,7 +35,20 @@ and pp_item ppf i = and pp_block_opt ppf bo = match bo with | None -> () - | Some ss -> () (* TODO *) + | Some seqn -> + pp_seqn ppf seqn + +and pp_seqn ppf seqn = + let (ds, ss) = seqn.it in + fprintf ppf "@[{ %a@ %a @;<0 -2>}@]" + (pp_print_list pp_decl) ds + (pp_print_list pp_stmt) ss + +and pp_decl ppf decl = + let (id, typ) = decl.it in + fprintf ppf "@[var %s: %a@]" + id.it + pp_typ typ and pp_pres ppf exps = fprintf ppf "@[%a@]" (pp_print_list pp_pre) exps @@ -50,7 +63,7 @@ and pp_post ppf exp = fprintf ppf "ensures @[<2>%a@]" pp_exp exp and pp_local ppf (id, typ) = - fprintf ppf "@[<2>%s :@ %a@]" + fprintf ppf "@[<2>%s: %a@]" id.it pp_typ typ @@ -72,9 +85,35 @@ and pp_typ ppf t = and pp_exp ppf exp = match exp.it with - | _ -> pr ppf "?" (* TBC *) + | LocalVar (id, _) -> + fprintf ppf "%s" id.it + | NotE e -> + fprintf ppf "@[(not %a)@]" pp_exp e + | BoolLitE b -> + fprintf ppf "%s" (if b then "true" else "false") + | IntLitE i -> + fprintf ppf "%s" (Mo_values.Numerics.Int.to_string i) + +and pp_stmt ppf stmt = + match stmt.it with + | SeqnS seqn -> pp_seqn ppf seqn + | IfS(exp1, s1, { it = ([],[]); _ }) -> + fprintf ppf "@[if %a@ %a@]" + pp_exp exp1 + pp_seqn s1 + | IfS(exp1, s1, s2) -> + fprintf ppf "@[if %a@ %aelse@ %a@]" + pp_exp exp1 + pp_seqn s1 + pp_seqn s2 + | VarAssignS(id, exp) -> + fprintf ppf "@[%s := %a@]" + id.it + pp_exp exp let prog p = - Lib.Format.with_str_formatter (fun ppf -> - pp_prog ppf) p - + let b = Buffer.create 16 in + let ppf = Format.formatter_of_buffer b in + Format.fprintf ppf "@[%a@]" pp_prog p; + Format.pp_print_flush ppf (); + Buffer.contents b diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index 10c1dab3929..db2d45136cc 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -23,7 +23,7 @@ and exp' = | Result of typ | BoolLitE of bool | NullLitE - | IntLitE of int (* Num.Big_int.t *) + | IntLitE of Mo_values.Numerics.Int.t | AddE of exp * exp | SubE of exp * exp | MulE of exp * exp @@ -36,7 +36,7 @@ and exp' = | EqCmpE of exp * exp | NeCmpE of exp * exp | MinusE of exp - | NotE of exp * exp + | NotE of exp | AndE of exp * exp | OrE of exp * exp | Implies of exp * exp @@ -66,11 +66,11 @@ and stmt' = | AssertS of exp | AssumeS of exp | SeqnS of seqn - | VarAssignE of id * exp - | FieldAssignE of fldacc * exp + | VarAssignS of id * exp + | FieldAssignS of fldacc * exp | IfS of exp * seqn * seqn - | WhileE of exp * invariants * seqn - | LabelE of id * invariants + | WhileS of exp * invariants * seqn + | LabelS of id * invariants and typ = (typ', info) Source.annotated_phrase diff --git a/src/viper/test/claim.mo b/src/viper/test/claim.mo new file mode 100644 index 00000000000..74416cd9e9f --- /dev/null +++ b/src/viper/test/claim.mo @@ -0,0 +1,22 @@ +actor { + + + var claimed = false; + + var count = 0 : Int; + + + public shared func claim() : async () { + var t = true; + let f = false; + if (not claimed) { + claimed := true; +/* + await async { + count := 1; + }; + */ + }; + }; + +} \ No newline at end of file diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 53721a76b3e..0d752b45d08 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -5,11 +5,11 @@ open Syntax module T = Mo_types.Type module M = Mo_def.Syntax -let unit (u : Mo_def.Syntax.comp_unit) : prog = +let rec unit (u : Mo_def.Syntax.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with | M.ActorU(id_opt, decs) -> - { it = []; + { it = dec_fields decs; at = body.at; note = NoInfo } @@ -210,14 +210,17 @@ and dec d = match d.it with *) -let rec dec_field d = +and dec_fields ds = + List.map dec_field ds + +and dec_field d = let (d', info) = dec_field' d.it in { it = d'; at = d.at; note = info } and dec_field' d = - match d with + match d.M.dec.it with (* | ExpD e -> "ExpD" $$ [exp e ] *) | M.VarD (x, e) -> @@ -226,8 +229,8 @@ and dec_field' d = NoInfo) | M.(LetD ({it=VarP f;_}, {it=FuncE(x, sp, tp, p, t_opt, sugar, - { it = BlockE ds; at; _} );_})) -> - (MethodI(id f, args p, rets t_opt, [], [], Some (block at ds)), + {it = AsyncE (_, e); _} );_})) -> (* ignore async *) + (MethodI(id f, args p, rets t_opt, [], [], Some (stmt e)), NoInfo) (* | TypD (x, tp, t) -> @@ -264,46 +267,96 @@ and dec d = ([{ it = (id x, tr_typ e.note.M.note_typ); at = d.at; note = NoInfo }], - [{ it = VarAssignE (id x, exp e); + [{ it = VarAssignS (id x, exp e); at = d.at; note = NoInfo }]) | M.(LetD ({it=VarP x;_}, e))-> ([{ it = (id x, tr_typ e.note.M.note_typ); at = d.at; note = NoInfo }], - [{ it = VarAssignE (id x, exp e); - at = d.at; - note = NoInfo }]) - | M.(ExpD {it=IfE(e, - { it = BlockE ds1; at = at1; _}, - { it = BlockE ds2; at = at2; _}); - _})-> - ([], - [{ it = IfS(exp e, block at1 ds1, block at2 ds2); + [{ it = VarAssignS (id x, exp e); at = d.at; note = NoInfo }]) + | M.(ExpD e) -> + let s = stmt e in + s.it + +and stmt s : seqn = + match s.it with + | M.TupE [] -> + block s.at [] + | M.BlockE ds -> + block s.at ds + | M.IfE(e, s1, s2) -> + { it = + ([], + [ { it = IfS(exp e, stmt s1, stmt s2); + at = s.at; + note = NoInfo } ]); + at = s.at; + note = NoInfo } +(* + | M.AsyncE(_, e) -> (* gross hack *) + { it = + ([], + [ { it = SeqnS (stmt e); + at = s.at; + note = NoInfo } ]); + at = s.at; + note = NoInfo } +*) + | M.WhileE(e, s1) -> + { it = + ([], + [ { it = WhileS(exp e, [], stmt s1); (* TODO: invariant *) + at = s.at; + note = NoInfo } ]); + at = s.at; + note = NoInfo } + | M.AssignE({it = VarE id; _}, e2) when isLocal id-> + let loc = { it = id.it; at = id.at; note = NoInfo } in + { it = + ([], + [ { it = VarAssignS(loc, exp e2); + at = s.at; + note = NoInfo } ]); + at = s.at; + note = NoInfo } +(* + | M.AssignE({it = VarE id;_}, e2) when isField e1-> + { it = + ([], + [ { it = FieldAssignS((), exp e2); + at = s.at; + note = NoInfo } ]); + at = s.at; + note = NoInfo } +*) +and isLocal id = true (* fix me *) and exp e = - let (e', info) = exp' e.it in + let (e', info) = exp' e in { it = e'; at = e.at; note = info } -and exp' e = - match e with +and exp' (e : M.exp) = + match e.it with | M.VarE x -> (*TODO: need environment to distinguish fields from locals *) - (LocalVar (id x, tr_typ e.M.note.note_typ), + (LocalVar (id x, tr_typ e.note.note_typ), NoInfo) | M.LitE r -> begin match !r with | M.BoolLit b -> (BoolLitE b, NoInfo) | M.IntLit i -> - (IntLitE 0, NoInfo) + (IntLitE i, NoInfo) end + | M.NotE e -> + (NotE (exp e), NoInfo) (* | VarE x -> | LitE l -> "LitE" $$ [lit !l] @@ -369,8 +422,11 @@ and rets t_opt = match t_opt with | None -> [] | Some t -> - match T.normalize t.note with + (match T.normalize t.note with | T.Tup [] -> [] + | T.Async (_, _) -> []) + + and id id = { it = id.it; at = id.at; note = NoInfo } @@ -382,3 +438,4 @@ and tr_typ' typ = match T.normalize typ with | T.Prim T.Int -> IntT | T.Prim T.Bool -> BoolT + From 07a791299230a5a65f0a4eb8bfd4e20e57c33ba3 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Tue, 11 Oct 2022 18:14:26 +0100 Subject: [PATCH 08/81] mo stuff --- src/viper/dune | 2 +- src/viper/test/claim.mo | 2 +- src/viper/trans.ml | 466 +++++++++++++++++++++------------------- 3 files changed, 252 insertions(+), 218 deletions(-) diff --git a/src/viper/dune b/src/viper/dune index fe2c6c1ade4..e983e120de7 100644 --- a/src/viper/dune +++ b/src/viper/dune @@ -1,6 +1,6 @@ (library (name viper) - (libraries lib num lang_utils mo_def mo_types mo_values) + (libraries lib wasm num lang_utils mo_def mo_types mo_values) (instrumentation (backend bisect_ppx --bisect-silent yes)) ) diff --git a/src/viper/test/claim.mo b/src/viper/test/claim.mo index 74416cd9e9f..ab3ff22b1bd 100644 --- a/src/viper/test/claim.mo +++ b/src/viper/test/claim.mo @@ -8,7 +8,7 @@ actor { public shared func claim() : async () { var t = true; - let f = false; + let f = false or true; if (not claimed) { claimed := true; /* diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 0d752b45d08..5af78be5b05 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -5,233 +5,67 @@ open Syntax module T = Mo_types.Type module M = Mo_def.Syntax +let fail sexp = + failwith (Wasm.Sexpr.to_string 80 sexp) + +type sort = Field | Local | Method + +module Env = T.Env + +type ctxt = + { self : string; + ids : sort T.Env.t + } + let rec unit (u : Mo_def.Syntax.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with | M.ActorU(id_opt, decs) -> - { it = dec_fields decs; + let ctxt = { self = "self"; ids = Env.empty } in + let (ctxt', mk_is) = dec_fields ctxt decs in + let is = List.map (fun mk_i -> mk_i ctxt') mk_is in + { it = is; at = body.at; note = NoInfo } | _ -> assert false -(* -let rec exp e = match e.it with - | VarE x -> "VarE" $$ [id x] - | LitE l -> "LitE" $$ [lit !l] - | ActorUrlE e -> "ActorUrlE" $$ [exp e] - | UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; Arrange_ops.unop uo; exp e] - | BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; Arrange_ops.binop bo; exp e2] - | RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; Arrange_ops.relop ro; exp e2] - | ShowE (ot, e) -> "ShowE" $$ [operator_type !ot; exp e] - | ToCandidE es -> "ToCandidE" $$ exps es - | FromCandidE e -> "FromCandidE" $$ [exp e] - | TupE es -> "TupE" $$ exps es - | ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)] - | ObjBlockE (s, dfs) -> "ObjBlockE" $$ [obj_sort s] @ List.map dec_field dfs - | ObjE ([], efs) -> "ObjE" $$ List.map exp_field efs - | ObjE (bases, efs) -> "ObjE" $$ exps bases @ [Atom "with"] @ List.map exp_field efs - | DotE (e, x) -> "DotE" $$ [exp e; id x] - | AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2] - | ArrayE (m, es) -> "ArrayE" $$ [mut m] @ exps es - | IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2] - | FuncE (x, sp, tp, p, t, sugar, e') -> - "FuncE" $$ [ - Atom (Type.string_of_typ e.note.note_typ); - shared_pat sp; - Atom x] @ - List.map typ_bind tp @ [ - pat p; - (match t with None -> Atom "_" | Some t -> typ t); - Atom (if sugar then "" else "="); - exp e' - ] - | CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ inst ts @ [exp e2] - | BlockE ds -> "BlockE" $$ List.map dec ds - | NotE e -> "NotE" $$ [exp e] - | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] - | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] - | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] - | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs - | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] - | LoopE (e1, None) -> "LoopE" $$ [exp e1] - | LoopE (e1, Some e2) -> "LoopE" $$ [exp e1; exp e2] - | ForE (p, e1, e2) -> "ForE" $$ [pat p; exp e1; exp e2] - | LabelE (i, t, e) -> "LabelE" $$ [id i; typ t; exp e] - | DebugE e -> "DebugE" $$ [exp e] - | BreakE (i, e) -> "BreakE" $$ [id i; exp e] - | RetE e -> "RetE" $$ [exp e] - | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] - | AwaitE e -> "AwaitE" $$ [exp e] - | AssertE e -> "AssertE" $$ [exp e] - | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] - | OptE e -> "OptE" $$ [exp e] - | DoOptE e -> "DoOptE" $$ [exp e] - | BangE e -> "BangE" $$ [exp e] - | TagE (i, e) -> "TagE" $$ [id i; exp e] - | PrimE p -> "PrimE" $$ [Atom p] - | ImportE (f, _fp) -> "ImportE" $$ [Atom f] - | ThrowE e -> "ThrowE" $$ [exp e] - | TryE (e, cs) -> "TryE" $$ [exp e] @ List.map catch cs - | IgnoreE e -> "IgnoreE" $$ [exp e] - -and exps es = List.map exp es - -and inst inst = match inst.it with - | None -> [] - | Some ts -> List.map typ ts - -and pat p = match p.it with - | WildP -> Atom "WildP" - | VarP x -> "VarP" $$ [id x] - | TupP ps -> "TupP" $$ List.map pat ps - | ObjP ps -> "ObjP" $$ List.map pat_field ps - | AnnotP (p, t) -> "AnnotP" $$ [pat p; typ t] - | LitP l -> "LitP" $$ [lit !l] - | SignP (uo, l) -> "SignP" $$ [Arrange_ops.unop uo ; lit !l] - | OptP p -> "OptP" $$ [pat p] - | TagP (i, p) -> "TagP" $$ [tag i; pat p] - | AltP (p1,p2) -> "AltP" $$ [pat p1; pat p2] - | ParP p -> "ParP" $$ [pat p] - -and lit = function - | NullLit -> Atom "NullLit" - | BoolLit true -> "BoolLit" $$ [ Atom "true" ] - | BoolLit false -> "BoolLit" $$ [ Atom "false" ] - | NatLit n -> "NatLit" $$ [ Atom (Numerics.Nat.to_pretty_string n) ] - | Nat8Lit n -> "Nat8Lit" $$ [ Atom (Numerics.Nat8.to_pretty_string n) ] - | Nat16Lit n -> "Nat16Lit" $$ [ Atom (Numerics.Nat16.to_pretty_string n) ] - | Nat32Lit n -> "Nat32Lit" $$ [ Atom (Numerics.Nat32.to_pretty_string n) ] - | Nat64Lit n -> "Nat64Lit" $$ [ Atom (Numerics.Nat64.to_pretty_string n) ] - | IntLit i -> "IntLit" $$ [ Atom (Numerics.Int.to_pretty_string i) ] - | Int8Lit i -> "Int8Lit" $$ [ Atom (Numerics.Int_8.to_pretty_string i) ] - | Int16Lit i -> "Int16Lit" $$ [ Atom (Numerics.Int_16.to_pretty_string i) ] - | Int32Lit i -> "Int32Lit" $$ [ Atom (Numerics.Int_32.to_pretty_string i) ] - | Int64Lit i -> "Int64Lit" $$ [ Atom (Numerics.Int_64.to_pretty_string i) ] - | FloatLit f -> "FloatLit" $$ [ Atom (Numerics.Float.to_pretty_string f) ] - | CharLit c -> "CharLit" $$ [ Atom (string_of_int c) ] - | TextLit t -> "TextLit" $$ [ Atom t ] - | BlobLit b -> "BlobLit" $$ [ Atom b ] - | PreLit (s,p) -> "PreLit" $$ [ Atom s; Arrange_type.prim p ] - -and case c = "case" $$ [pat c.it.pat; exp c.it.exp] - -and catch c = "catch" $$ [pat c.it.pat; exp c.it.exp] - -and pat_field pf = pf.it.id.it $$ [pat pf.it.pat] - -and obj_sort s = match s.it with - | Type.Object -> Atom "Object" - | Type.Actor -> Atom "Actor" - | Type.Module -> Atom "Module" - | Type.Memory -> Atom "Memory" - -and shared_pat sp = match sp.it with - | Type.Local -> Atom "Local" - | Type.Shared (Type.Write, p) -> "Shared" $$ [pat p] - | Type.Shared (Type.Query, p) -> "Query" $$ [pat p] - -and func_sort s = match s.it with - | Type.Local -> Atom "Local" - | Type.Shared Type.Write -> Atom "Shared" - | Type.Shared Type.Query -> Atom "Query" - -and mut m = match m.it with - | Const -> Atom "Const" - | Var -> Atom "Var" - -and vis v = match v.it with - | Public None -> Atom "Public" - | Public (Some m) -> "Public" $$ [Atom m] - | Private -> Atom "Private" - | System -> Atom "System" - -and stab s_opt = match s_opt with - | None -> Atom "(Flexible)" - | Some s -> - (match s.it with - | Flexible -> Atom "Flexible" - | Stable -> Atom "Stable") - -and typ_field (tf : typ_field) = match tf.it with - | ValF (id, t, m) -> id.it $$ [typ t; mut m] - | TypF (id', tbs, t) -> - "TypF" $$ [id id'] @ List.map typ_bind tbs @ [typ t] -and typ_item ((id, ty) : typ_item) = - match id with - | None -> [typ ty] - | Some { it;_ } -> [Atom it; typ ty] - -and typ_tag (tt : typ_tag) - = tt.it.tag.it $$ [typ tt.it.typ] - -and typ_bind (tb : typ_bind) - = tb.it.var.it $$ [typ tb.it.bound] - -and dec_field (df : dec_field) - = "DecField" $$ [dec df.it.dec; vis df.it.vis; stab df.it.stab] - -and exp_field (ef : exp_field) - = "ExpField" $$ [mut ef.it.mut; id ef.it.id; exp ef.it.exp] - -and operator_type t = Atom (Type.string_of_typ t) - -and path p = match p.it with - | IdH i -> "IdH" $$ [id i] - | DotH (p,i) -> "DotH" $$ [path p; id i] - -and typ t = match t.it with - | PathT (p, ts) -> "PathT" $$ [path p] @ List.map typ ts - | PrimT p -> "PrimT" $$ [Atom p] - | ObjT (s, ts) -> "ObjT" $$ [obj_sort s] @ List.map typ_field ts - | ArrayT (m, t) -> "ArrayT" $$ [mut m; typ t] - | OptT t -> "OptT" $$ [typ t] - | VariantT cts -> "VariantT" $$ List.map typ_tag cts - | TupT ts -> "TupT" $$ List.concat_map typ_item ts - | FuncT (s, tbs, at, rt) -> "FuncT" $$ [func_sort s] @ List.map typ_bind tbs @ [ typ at; typ rt] - | AsyncT (t1, t2) -> "AsyncT" $$ [typ t1; typ t2] - | AndT (t1, t2) -> "AndT" $$ [typ t1; typ t2] - | OrT (t1, t2) -> "OrT" $$ [typ t1; typ t2] - | ParT t -> "ParT" $$ [typ t] - | NamedT (id, t) -> "NamedT" $$ [Atom id.it; typ t] - -and dec d = match d.it with - | ExpD e -> "ExpD" $$ [exp e ] - | LetD (p, e) -> "LetD" $$ [pat p; exp e] - | VarD (x, e) -> "VarD" $$ [id x; exp e] - | TypD (x, tp, t) -> - "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] - | ClassD (sp, x, tp, p, rt, s, i', dfs) -> - "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [ - pat p; - (match rt with None -> Atom "_" | Some t -> typ t); - obj_sort s; id i' - ] @ List.map dec_field dfs - - *) - -and dec_fields ds = - List.map dec_field ds - -and dec_field d = - let (d', info) = dec_field' d.it in - { it = d'; - at = d.at; - note = info } - -and dec_field' d = +and dec_fields (ctxt : ctxt) (ds : M.dec_field list) = + match ds with + | [] -> + (ctxt, []) + | d :: ds -> + let ctxt, mk_i = dec_field ctxt d in + let ctxt, mk_is = dec_fields ctxt ds in + (ctxt, mk_i::mk_is) + +and dec_field ctxt d = + let (ctxt, mk_i) = dec_field' ctxt d.it in + (ctxt, + fun ctxt' -> + let (i, info) = mk_i ctxt' in + { it = i; + at = d.at; + note = info }) + +and dec_field' ctxt d = match d.M.dec.it with (* | ExpD e -> "ExpD" $$ [exp e ] *) | M.VarD (x, e) -> + { ctxt with ids = Env.add x.it Field ctxt.ids }, (* TODO: translate e? *) - (FieldI(id x, tr_typ e.note.M.note_typ), - NoInfo) + fun ctxt' -> + (FieldI(id x, tr_typ e.note.M.note_typ), + NoInfo) | M.(LetD ({it=VarP f;_}, {it=FuncE(x, sp, tp, p, t_opt, sugar, {it = AsyncE (_, e); _} );_})) -> (* ignore async *) - (MethodI(id f, args p, rets t_opt, [], [], Some (stmt e)), - NoInfo) + { ctxt with ids = Env.add f.it Method ctxt.ids }, + fun ctxt' -> (MethodI(id f, args p, rets t_opt, [], [], Some (stmt e)), + NoInfo) + | _ -> fail (Mo_def.Arrange.dec d.M.dec) + (* | TypD (x, tp, t) -> "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] @@ -275,14 +109,14 @@ and dec d = at = d.at; note = NoInfo }], [{ it = VarAssignS (id x, exp e); - at = d.at; - note = NoInfo }]) - + at = d.at; + note = NoInfo }]) | M.(ExpD e) -> let s = stmt e in s.it + | _ -> fail (Mo_def.Arrange.dec d) -and stmt s : seqn = +and stmt (s : M.exp) : seqn = match s.it with | M.TupE [] -> block s.at [] @@ -323,6 +157,7 @@ and stmt s : seqn = note = NoInfo } ]); at = s.at; note = NoInfo } + | _ -> fail (Mo_def.Arrange.exp s) (* | M.AssignE({it = VarE id;_}, e2) when isField e1-> { it = @@ -334,14 +169,13 @@ and stmt s : seqn = note = NoInfo } *) -and isLocal id = true (* fix me *) +and isLocal id = true (* fix me *) and exp e = let (e', info) = exp' e in { it = e'; at = e.at; note = info } - and exp' (e : M.exp) = match e.it with | M.VarE x -> @@ -354,9 +188,11 @@ and exp' (e : M.exp) = (BoolLitE b, NoInfo) | M.IntLit i -> (IntLitE i, NoInfo) + | _ -> fail (Mo_def.Arrange.exp e) end | M.NotE e -> (NotE (exp e), NoInfo) + | _ -> fail (Mo_def.Arrange.exp e) (* | VarE x -> | LitE l -> "LitE" $$ [lit !l] @@ -439,3 +275,201 @@ and tr_typ' typ = | T.Prim T.Int -> IntT | T.Prim T.Bool -> BoolT + + +(* +let rec exp e = match e.it with + | VarE x -> "VarE" $$ [id x] + | LitE l -> "LitE" $$ [lit !l] + | ActorUrlE e -> "ActorUrlE" $$ [exp e] + | UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; Arrange_ops.unop uo; exp e] + | BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; Arrange_ops.binop bo; exp e2] + | RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; Arrange_ops.relop ro; exp e2] + | ShowE (ot, e) -> "ShowE" $$ [operator_type !ot; exp e] + | ToCandidE es -> "ToCandidE" $$ exps es + | FromCandidE e -> "FromCandidE" $$ [exp e] + | TupE es -> "TupE" $$ exps es + | ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)] + | ObjBlockE (s, dfs) -> "ObjBlockE" $$ [obj_sort s] @ List.map dec_field dfs + | ObjE ([], efs) -> "ObjE" $$ List.map exp_field efs + | ObjE (bases, efs) -> "ObjE" $$ exps bases @ [Atom "with"] @ List.map exp_field efs + | DotE (e, x) -> "DotE" $$ [exp e; id x] + | AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2] + | ArrayE (m, es) -> "ArrayE" $$ [mut m] @ exps es + | IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2] + | FuncE (x, sp, tp, p, t, sugar, e') -> + "FuncE" $$ [ + Atom (Type.string_of_typ e.note.note_typ); + shared_pat sp; + Atom x] @ + List.map typ_bind tp @ [ + pat p; + (match t with None -> Atom "_" | Some t -> typ t); + Atom (if sugar then "" else "="); + exp e' + ] + | CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ inst ts @ [exp e2] + | BlockE ds -> "BlockE" $$ List.map dec ds + | NotE e -> "NotE" $$ [exp e] + | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] + | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] + | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] + | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs + | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] + | LoopE (e1, None) -> "LoopE" $$ [exp e1] + | LoopE (e1, Some e2) -> "LoopE" $$ [exp e1; exp e2] + | ForE (p, e1, e2) -> "ForE" $$ [pat p; exp e1; exp e2] + | LabelE (i, t, e) -> "LabelE" $$ [id i; typ t; exp e] + | DebugE e -> "DebugE" $$ [exp e] + | BreakE (i, e) -> "BreakE" $$ [id i; exp e] + | RetE e -> "RetE" $$ [exp e] + | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] + | AwaitE e -> "AwaitE" $$ [exp e] + | AssertE e -> "AssertE" $$ [exp e] + | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] + | OptE e -> "OptE" $$ [exp e] + | DoOptE e -> "DoOptE" $$ [exp e] + | BangE e -> "BangE" $$ [exp e] + | TagE (i, e) -> "TagE" $$ [id i; exp e] + | PrimE p -> "PrimE" $$ [Atom p] + | ImportE (f, _fp) -> "ImportE" $$ [Atom f] + | ThrowE e -> "ThrowE" $$ [exp e] + | TryE (e, cs) -> "TryE" $$ [exp e] @ List.map catch cs + | IgnoreE e -> "IgnoreE" $$ [exp e] + +and exps es = List.map exp es + +and inst inst = match inst.it with + | None -> [] + | Some ts -> List.map typ ts + +and pat p = match p.it with + | WildP -> Atom "WildP" + | VarP x -> "VarP" $$ [id x] + | TupP ps -> "TupP" $$ List.map pat ps + | ObjP ps -> "ObjP" $$ List.map pat_field ps + | AnnotP (p, t) -> "AnnotP" $$ [pat p; typ t] + | LitP l -> "LitP" $$ [lit !l] + | SignP (uo, l) -> "SignP" $$ [Arrange_ops.unop uo ; lit !l] + | OptP p -> "OptP" $$ [pat p] + | TagP (i, p) -> "TagP" $$ [tag i; pat p] + | AltP (p1,p2) -> "AltP" $$ [pat p1; pat p2] + | ParP p -> "ParP" $$ [pat p] + +and lit = function + | NullLit -> Atom "NullLit" + | BoolLit true -> "BoolLit" $$ [ Atom "true" ] + | BoolLit false -> "BoolLit" $$ [ Atom "false" ] + | NatLit n -> "NatLit" $$ [ Atom (Numerics.Nat.to_pretty_string n) ] + | Nat8Lit n -> "Nat8Lit" $$ [ Atom (Numerics.Nat8.to_pretty_string n) ] + | Nat16Lit n -> "Nat16Lit" $$ [ Atom (Numerics.Nat16.to_pretty_string n) ] + | Nat32Lit n -> "Nat32Lit" $$ [ Atom (Numerics.Nat32.to_pretty_string n) ] + | Nat64Lit n -> "Nat64Lit" $$ [ Atom (Numerics.Nat64.to_pretty_string n) ] + | IntLit i -> "IntLit" $$ [ Atom (Numerics.Int.to_pretty_string i) ] + | Int8Lit i -> "Int8Lit" $$ [ Atom (Numerics.Int_8.to_pretty_string i) ] + | Int16Lit i -> "Int16Lit" $$ [ Atom (Numerics.Int_16.to_pretty_string i) ] + | Int32Lit i -> "Int32Lit" $$ [ Atom (Numerics.Int_32.to_pretty_string i) ] + | Int64Lit i -> "Int64Lit" $$ [ Atom (Numerics.Int_64.to_pretty_string i) ] + | FloatLit f -> "FloatLit" $$ [ Atom (Numerics.Float.to_pretty_string f) ] + | CharLit c -> "CharLit" $$ [ Atom (string_of_int c) ] + | TextLit t -> "TextLit" $$ [ Atom t ] + | BlobLit b -> "BlobLit" $$ [ Atom b ] + | PreLit (s,p) -> "PreLit" $$ [ Atom s; Arrange_type.prim p ] + +and case c = "case" $$ [pat c.it.pat; exp c.it.exp] + +and catch c = "catch" $$ [pat c.it.pat; exp c.it.exp] + +and pat_field pf = pf.it.id.it $$ [pat pf.it.pat] + +and obj_sort s = match s.it with + | Type.Object -> Atom "Object" + | Type.Actor -> Atom "Actor" + | Type.Module -> Atom "Module" + | Type.Memory -> Atom "Memory" + +and shared_pat sp = match sp.it with + | Type.Local -> Atom "Local" + | Type.Shared (Type.Write, p) -> "Shared" $$ [pat p] + | Type.Shared (Type.Query, p) -> "Query" $$ [pat p] + +and func_sort s = match s.it with + | Type.Local -> Atom "Local" + | Type.Shared Type.Write -> Atom "Shared" + | Type.Shared Type.Query -> Atom "Query" + +and mut m = match m.it with + | Const -> Atom "Const" + | Var -> Atom "Var" + +and vis v = match v.it with + | Public None -> Atom "Public" + | Public (Some m) -> "Public" $$ [Atom m] + | Private -> Atom "Private" + | System -> Atom "System" + +and stab s_opt = match s_opt with + | None -> Atom "(Flexible)" + | Some s -> + (match s.it with + | Flexible -> Atom "Flexible" + | Stable -> Atom "Stable") + +and typ_field (tf : typ_field) = match tf.it with + | ValF (id, t, m) -> id.it $$ [typ t; mut m] + | TypF (id', tbs, t) -> + "TypF" $$ [id id'] @ List.map typ_bind tbs @ [typ t] +and typ_item ((id, ty) : typ_item) = + match id with + | None -> [typ ty] + | Some { it;_ } -> [Atom it; typ ty] + +and typ_tag (tt : typ_tag) + = tt.it.tag.it $$ [typ tt.it.typ] + +and typ_bind (tb : typ_bind) + = tb.it.var.it $$ [typ tb.it.bound] + +and dec_field (df : dec_field) + = "DecField" $$ [dec df.it.dec; vis df.it.vis; stab df.it.stab] + +and exp_field (ef : exp_field) + = "ExpField" $$ [mut ef.it.mut; id ef.it.id; exp ef.it.exp] + +and operator_type t = Atom (Type.string_of_typ t) + +and path p = match p.it with + | IdH i -> "IdH" $$ [id i] + | DotH (p,i) -> "DotH" $$ [path p; id i] + +and typ t = match t.it with + | PathT (p, ts) -> "PathT" $$ [path p] @ List.map typ ts + | PrimT p -> "PrimT" $$ [Atom p] + | ObjT (s, ts) -> "ObjT" $$ [obj_sort s] @ List.map typ_field ts + | ArrayT (m, t) -> "ArrayT" $$ [mut m; typ t] + | OptT t -> "OptT" $$ [typ t] + | VariantT cts -> "VariantT" $$ List.map typ_tag cts + | TupT ts -> "TupT" $$ List.concat_map typ_item ts + | FuncT (s, tbs, at, rt) -> "FuncT" $$ [func_sort s] @ List.map typ_bind tbs @ [ typ at; typ rt] + | AsyncT (t1, t2) -> "AsyncT" $$ [typ t1; typ t2] + | AndT (t1, t2) -> "AndT" $$ [typ t1; typ t2] + | OrT (t1, t2) -> "OrT" $$ [typ t1; typ t2] + | ParT t -> "ParT" $$ [typ t] + | NamedT (id, t) -> "NamedT" $$ [Atom id.it; typ t] + +and dec d = match d.it with + | ExpD e -> "ExpD" $$ [exp e ] + | LetD (p, e) -> "LetD" $$ [pat p; exp e] + | VarD (x, e) -> "VarD" $$ [id x; exp e] + | TypD (x, tp, t) -> + "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] + | ClassD (sp, x, tp, p, rt, s, i', dfs) -> + "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [ + pat p; + (match rt with None -> Atom "_" | Some t -> typ t); + obj_sort s; id i' + ] @ List.map dec_field dfs + + *) + + From 4b0a637ddc528fff0016eb85dbd21c7adbea1bd3 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Tue, 11 Oct 2022 18:18:02 +0100 Subject: [PATCH 09/81] fix translation of NotE --- src/viper/pretty.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index e6010d98f74..74a210c8dab 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -88,7 +88,7 @@ and pp_exp ppf exp = | LocalVar (id, _) -> fprintf ppf "%s" id.it | NotE e -> - fprintf ppf "@[(not %a)@]" pp_exp e + fprintf ppf "@[(!%a)@]" pp_exp e | BoolLitE b -> fprintf ppf "%s" (if b then "true" else "false") | IntLitE i -> From 838d39990fa5de8f5258156954bd771d19f9479d Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Wed, 12 Oct 2022 11:43:54 +0100 Subject: [PATCH 10/81] plumb contexts --- src/viper/test/claim.mo | 2 +- src/viper/trans.ml | 86 ++++++++++++++++++++++++----------------- 2 files changed, 52 insertions(+), 36 deletions(-) diff --git a/src/viper/test/claim.mo b/src/viper/test/claim.mo index ab3ff22b1bd..74416cd9e9f 100644 --- a/src/viper/test/claim.mo +++ b/src/viper/test/claim.mo @@ -8,7 +8,7 @@ actor { public shared func claim() : async () { var t = true; - let f = false or true; + let f = false; if (not claimed) { claimed := true; /* diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 5af78be5b05..3d9664fecab 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -62,8 +62,10 @@ and dec_field' ctxt d = {it=FuncE(x, sp, tp, p, t_opt, sugar, {it = AsyncE (_, e); _} );_})) -> (* ignore async *) { ctxt with ids = Env.add f.it Method ctxt.ids }, - fun ctxt' -> (MethodI(id f, args p, rets t_opt, [], [], Some (stmt e)), - NoInfo) + fun ctxt' -> + let ctxt'' = ctxt' in (* TODO: add args (and rets?) *) + (MethodI(id f, args p, rets t_opt, [], [], Some (stmt ctxt'' e)), + NoInfo) | _ -> fail (Mo_def.Arrange.dec d.M.dec) (* @@ -81,51 +83,62 @@ and args p = match p.it with | M.TupP ps -> List.map (fun {it = M.VarP x; note; _} -> (id x, tr_typ note)) ps -and block at ds = - { it = decs ds; +and block ctxt at ds = + let ctxt, mk_ss = decs ctxt ds in + { it = mk_ss ctxt; at; note = NoInfo } -and decs ds = +and decs ctxt ds = match ds with - | [] -> ([],[]) + | [] -> (ctxt, fun ctxt' -> ([],[])) | d::ds' -> - let (l, s) = dec d in - let (ls, ss) = decs ds' in - (l @ ls, s @ ss) + let (ctxt1, mk_s) = dec ctxt d in + let (ctxt2, mk_ss) = decs ctxt1 ds' in + (ctxt2, + fun ctxt' -> + let (l, s) = mk_s ctxt' in + let (ls, ss) = mk_ss ctxt' in + (l @ ls, s @ ss)) -and dec d = +and dec ctxt d = match d.it with | M.VarD (x, e) -> (* TODO: translate e? *) - ([{ it = (id x, tr_typ e.note.M.note_typ); + { ctxt with ids = Env.add x.it Local ctxt.ids }, + fun ctxt' -> + ([{ it = (id x, tr_typ e.note.M.note_typ); at = d.at; note = NoInfo }], - [{ it = VarAssignS (id x, exp e); - at = d.at; - note = NoInfo }]) + [{ it = VarAssignS (id x, exp ctxt' e); + at = d.at; + note = NoInfo } ]) | M.(LetD ({it=VarP x;_}, e))-> - ([{ it = (id x, tr_typ e.note.M.note_typ); - at = d.at; - note = NoInfo }], - [{ it = VarAssignS (id x, exp e); - at = d.at; - note = NoInfo }]) + { ctxt with ids = Env.add x.it Local ctxt.ids }, + fun ctxt' -> + ([{ it = (id x, tr_typ e.note.M.note_typ); + at = d.at; + note = NoInfo }], + [{ it = VarAssignS (id x, exp ctxt' e); + at = d.at; + note = NoInfo }]) | M.(ExpD e) -> - let s = stmt e in - s.it + (ctxt, + fun ctxt' -> + let s = stmt ctxt' e in + s.it) | _ -> fail (Mo_def.Arrange.dec d) -and stmt (s : M.exp) : seqn = +and stmt ctxt (s : M.exp) : seqn = match s.it with | M.TupE [] -> - block s.at [] + block ctxt s.at [] | M.BlockE ds -> - block s.at ds + block ctxt s.at ds | M.IfE(e, s1, s2) -> { it = ([], - [ { it = IfS(exp e, stmt s1, stmt s2); + [ { it = IfS(exp ctxt e, stmt ctxt s1, stmt ctxt s2); at = s.at; note = NoInfo } ]); at = s.at; @@ -143,7 +156,7 @@ and stmt (s : M.exp) : seqn = | M.WhileE(e, s1) -> { it = ([], - [ { it = WhileS(exp e, [], stmt s1); (* TODO: invariant *) + [ { it = WhileS(exp ctxt e, [], stmt ctxt s1); (* TODO: invariant *) at = s.at; note = NoInfo } ]); at = s.at; @@ -152,7 +165,7 @@ and stmt (s : M.exp) : seqn = let loc = { it = id.it; at = id.at; note = NoInfo } in { it = ([], - [ { it = VarAssignS(loc, exp e2); + [ { it = VarAssignS(loc, exp ctxt e2); at = s.at; note = NoInfo } ]); at = s.at; @@ -171,17 +184,22 @@ and stmt (s : M.exp) : seqn = and isLocal id = true (* fix me *) -and exp e = - let (e', info) = exp' e in +and exp ctxt e = + let (e', info) = exp' ctxt e in { it = e'; at = e.at; note = info } -and exp' (e : M.exp) = +and exp' ctxt (e : M.exp) = match e.it with - | M.VarE x -> + | M.VarE x (* when Env.find x.it ctxt = Local *) -> + (LocalVar (id x, tr_typ e.note.note_typ), + NoInfo) +(* + | M.VarE x when Env.find x.it ctxt = Field -> (*TODO: need environment to distinguish fields from locals *) (LocalVar (id x, tr_typ e.note.note_typ), NoInfo) +*) | M.LitE r -> begin match !r with | M.BoolLit b -> @@ -191,7 +209,7 @@ and exp' (e : M.exp) = | _ -> fail (Mo_def.Arrange.exp e) end | M.NotE e -> - (NotE (exp e), NoInfo) + (NotE (exp ctxt e), NoInfo) | _ -> fail (Mo_def.Arrange.exp e) (* | VarE x -> @@ -262,8 +280,6 @@ and rets t_opt = | T.Tup [] -> [] | T.Async (_, _) -> []) - - and id id = { it = id.it; at = id.at; note = NoInfo } and tr_typ typ = From 26151604e73efc4e9a75b4af9f4ce8918764cab2 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Wed, 12 Oct 2022 16:33:13 +0100 Subject: [PATCH 11/81] add self prefix on field access; add self param to methods --- src/viper/pretty.ml | 12 +++++++++ src/viper/syntax.ml | 1 + src/viper/trans.ml | 61 ++++++++++++++++++++++++++++++++++----------- 3 files changed, 59 insertions(+), 15 deletions(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 74a210c8dab..7bfcaba35b8 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -82,11 +82,14 @@ and pp_typ ppf t = match t.it with | IntT -> pr ppf "Int" | BoolT -> pr ppf "Bool" + | RefT -> pr ppf "Ref" and pp_exp ppf exp = match exp.it with | LocalVar (id, _) -> fprintf ppf "%s" id.it + | FldAcc fldacc -> + pp_fldacc ppf fldacc | NotE e -> fprintf ppf "@[(!%a)@]" pp_exp e | BoolLitE b -> @@ -110,6 +113,15 @@ and pp_stmt ppf stmt = fprintf ppf "@[%s := %a@]" id.it pp_exp exp + | FieldAssignS(fldacc, exp2) -> + fprintf ppf "@[%a := %a@]" + pp_fldacc fldacc + pp_exp exp2 + +and pp_fldacc ppf fldacc = + match fldacc with + | (exp1, id) -> + fprintf ppf "@[(%a).%s@]" pp_exp exp1 id.it let prog p = let b = Buffer.create 16 in diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index db2d45136cc..71ea4d6bdd7 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -78,4 +78,5 @@ and typ = (typ', info) Source.annotated_phrase and typ' = | IntT | BoolT + | RefT diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 3d9664fecab..bc46dffcdcd 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -13,15 +13,23 @@ type sort = Field | Local | Method module Env = T.Env type ctxt = - { self : string; + { self : string option; ids : sort T.Env.t } +let self ctxt at = + match ctxt.self with + | Some id -> { it = LocalVar ({ it = id; at; note = NoInfo}, + { it = RefT; at; note = NoInfo }); + at; + note = NoInfo } + | _ -> failwith "no self" + let rec unit (u : Mo_def.Syntax.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with | M.ActorU(id_opt, decs) -> - let ctxt = { self = "self"; ids = Env.empty } in + let ctxt = { self = None; ids = Env.empty } in let (ctxt', mk_is) = dec_fields ctxt decs in let is = List.map (fun mk_i -> mk_i ctxt') mk_is in { it = is; @@ -63,8 +71,10 @@ and dec_field' ctxt d = {it = AsyncE (_, e); _} );_})) -> (* ignore async *) { ctxt with ids = Env.add f.it Method ctxt.ids }, fun ctxt' -> - let ctxt'' = ctxt' in (* TODO: add args (and rets?) *) - (MethodI(id f, args p, rets t_opt, [], [], Some (stmt ctxt'' e)), + let self_id = {it = "$Self"; at = Source.no_region; note = NoInfo } in + let ctxt'' = { ctxt' with self = Some self_id.it } + in (* TODO: add args (and rets?) *) + (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, [], [], Some (stmt ctxt'' e)), NoInfo) | _ -> fail (Mo_def.Arrange.dec d.M.dec) @@ -161,16 +171,29 @@ and stmt ctxt (s : M.exp) : seqn = note = NoInfo } ]); at = s.at; note = NoInfo } - | M.AssignE({it = VarE id; _}, e2) when isLocal id-> - let loc = { it = id.it; at = id.at; note = NoInfo } in - { it = - ([], - [ { it = VarAssignS(loc, exp ctxt e2); - at = s.at; - note = NoInfo } ]); - at = s.at; - note = NoInfo } + | M.(AssignE({it = VarE x; _}, e2)) -> + match Env.find x.it ctxt.ids with + | Local -> + let loc = { it = x.it; at = x.at; note = NoInfo } in + { it = + ([], + [ { it = VarAssignS(loc, exp ctxt e2); + at = s.at; + note = NoInfo } ]); + at = s.at; + note = NoInfo } + | Field -> + let fld = (self ctxt x.at, id x) in + { it = + ([], + [ { it = FieldAssignS(fld, exp ctxt e2); + at = s.at; + note = NoInfo } ]); + at = s.at; + note = NoInfo } + | _ -> fail (Mo_def.Arrange.exp s) + (* | M.AssignE({it = VarE id;_}, e2) when isField e1-> { it = @@ -192,8 +215,16 @@ and exp ctxt e = and exp' ctxt (e : M.exp) = match e.it with | M.VarE x (* when Env.find x.it ctxt = Local *) -> - (LocalVar (id x, tr_typ e.note.note_typ), - NoInfo) + begin + match Env.find x.it ctxt.ids with + | Local -> + (LocalVar (id x, tr_typ e.note.note_typ), + NoInfo) + | Field -> + (FldAcc (self ctxt x.at, id x), + NoInfo) + | _ -> fail (Mo_def.Arrange.exp e) + end (* | M.VarE x when Env.find x.it ctxt = Field -> (*TODO: need environment to distinguish fields from locals *) From 9f7d7958add57462564d6fcf7afc6918325d3441 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Thu, 13 Oct 2022 15:14:34 +0100 Subject: [PATCH 12/81] handle await async {}; add test variants --- src/viper/test/claim-broken.mo | 16 ++++++++++++++++ src/viper/test/claim-simple.mo | 14 ++++++++++++++ src/viper/test/claim.mo | 6 ------ src/viper/trans.ml | 7 +++---- 4 files changed, 33 insertions(+), 10 deletions(-) create mode 100644 src/viper/test/claim-broken.mo create mode 100644 src/viper/test/claim-simple.mo diff --git a/src/viper/test/claim-broken.mo b/src/viper/test/claim-broken.mo new file mode 100644 index 00000000000..22a1b141751 --- /dev/null +++ b/src/viper/test/claim-broken.mo @@ -0,0 +1,16 @@ +actor { + + var claimed = false; + + var count = 0 : Int; + + public shared func claim() : async () { + if (not claimed) { + await async { + claimed := true; + count := 1; + }; + }; + }; + +} \ No newline at end of file diff --git a/src/viper/test/claim-simple.mo b/src/viper/test/claim-simple.mo new file mode 100644 index 00000000000..e5df23859f8 --- /dev/null +++ b/src/viper/test/claim-simple.mo @@ -0,0 +1,14 @@ +actor { + + var claimed = false; + + var count = 0 : Int; + + public shared func claim() : async () { + if (not claimed) { + claimed := true; + count := 1; + }; + }; + +} \ No newline at end of file diff --git a/src/viper/test/claim.mo b/src/viper/test/claim.mo index 74416cd9e9f..44b5c169c24 100644 --- a/src/viper/test/claim.mo +++ b/src/viper/test/claim.mo @@ -1,21 +1,15 @@ actor { - var claimed = false; var count = 0 : Int; - public shared func claim() : async () { - var t = true; - let f = false; if (not claimed) { claimed := true; -/* await async { count := 1; }; - */ }; }; diff --git a/src/viper/trans.ml b/src/viper/trans.ml index bc46dffcdcd..37e31577b49 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -153,16 +153,15 @@ and stmt ctxt (s : M.exp) : seqn = note = NoInfo } ]); at = s.at; note = NoInfo } -(* - | M.AsyncE(_, e) -> (* gross hack *) + | M.(AwaitE({ it = AsyncE (_, e); _ })) -> (* gross hack *) { it = ([], - [ { it = SeqnS (stmt e); + (* TODO: add havoc etc *) + [ { it = SeqnS (stmt ctxt e); at = s.at; note = NoInfo } ]); at = s.at; note = NoInfo } -*) | M.WhileE(e, s1) -> { it = ([], From 6c125117d3c915506d88d247a5aa9f82a095b7f3 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 14 Oct 2022 12:52:48 +0200 Subject: [PATCH 13/81] viper: src-loc mapping (#3484) Adds reverse (Viper -> Motoko) source region mapping. --- src/pipeline/pipeline.ml | 2 +- src/viper/pretty.ml | 55 ++++++++++++++++++++++++++++++++++++---- src/viper/syntax.ml | 2 +- 3 files changed, 52 insertions(+), 7 deletions(-) diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index abe80a07920..960889f54a5 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -494,7 +494,7 @@ let viper_files' parsefn files : viper_result = let prog = CompUnit.combine_progs progs in let u = CompUnit.comp_unit_of_prog false prog in let v = Viper.Trans.unit u in - let s = Viper.Pretty.prog v in + let s, _ = Viper.Pretty.prog v in Diag.return s diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 7bfcaba35b8..134bed5c46e 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -3,6 +3,8 @@ open Syntax open Format +let marks = ref [] + let pr = pp_print_string let comma ppf () = fprintf ppf ",@ " @@ -98,23 +100,24 @@ and pp_exp ppf exp = fprintf ppf "%s" (Mo_values.Numerics.Int.to_string i) and pp_stmt ppf stmt = + marks := stmt.at :: !marks; match stmt.it with | SeqnS seqn -> pp_seqn ppf seqn | IfS(exp1, s1, { it = ([],[]); _ }) -> - fprintf ppf "@[if %a@ %a@]" + fprintf ppf "\017@[if %a@ %a@]\019" pp_exp exp1 pp_seqn s1 | IfS(exp1, s1, s2) -> - fprintf ppf "@[if %a@ %aelse@ %a@]" + fprintf ppf "\017@[if %a@ %aelse@ %a@]\019" pp_exp exp1 pp_seqn s1 pp_seqn s2 | VarAssignS(id, exp) -> - fprintf ppf "@[%s := %a@]" + fprintf ppf "\017@[%s := %a@]\019" id.it pp_exp exp | FieldAssignS(fldacc, exp2) -> - fprintf ppf "@[%a := %a@]" + fprintf ppf "\017@[%a := %a@]\019" pp_fldacc fldacc pp_exp exp2 @@ -128,4 +131,46 @@ let prog p = let ppf = Format.formatter_of_buffer b in Format.fprintf ppf "@[%a@]" pp_prog p; Format.pp_print_flush ppf (); - Buffer.contents b + let marks = ref (List.rev_map (fun loc -> loc, loc) !marks, [], []) in + let pos = ref 0 in + let push line column = match !marks with + | (mot, vip) :: clos, ope, don -> marks := clos, (mot, { vip with left = { vip.left with line; column } }) :: ope, don + | _ -> assert false in + let pop line column = match !marks with + | clos, (mot, vip) :: ope, don -> marks := clos, ope, (mot, { vip with right = { vip.right with line; column } }) :: don + | _ -> assert false in + let line = ref 1 in + let examine = function + | '\n' -> line := !line + 1; pos := 0; '\n'; + | '\017' -> push !line !pos; '\017' + | '\019' -> pop !line !pos; '\017' + | a -> pos := !pos + 1; a in + let clean = function + | '\017' -> false + | _ -> true in + let b = Buffer.(of_seq Seq.(filter clean (map examine (to_seq b)))) in + let dump = List.iter (fun (mot, vip) -> Printf.eprintf "(MOT: %d:%d...%d:%d) -> (VIP: %d:%d...%d:%d)\n" mot.left.line mot.left.column mot.right.line mot.right.column vip.left.line vip.left.column vip.right.line vip.right.column) in + let _, _, mapping = !marks in + (* + Printf.eprintf "\nLINES: %d\n" !line; + dump mapping; + *) + let inside { left; right } other = + left.file = other.left.file && + right.file = other.right.file && + (other.left.line, other.left.column) <= (left.line, left.column) && + (right.line, right.column) <= (other.right.line, other.right.column) in + let lookup (r : Source.region) = + let tighten prev (mot, vip) = + if inside r vip + then Some mot + else prev in + List.fold_left tighten None mapping in +(* +let _, vip = List.(hd (tl ( mapping))) in +let vip = { vip with left = { vip.left with column = vip.left.column + 1 } } in +let Some mot = lookup vip in +Printf.eprintf "\ninput (VIP: %d:%d...%d:%d)\n" vip.left.line vip.left.column vip.right.line vip.right.column; +Printf.eprintf "\nfound (MOT: %d:%d...%d:%d)\n" mot.left.line mot.left.column mot.right.line mot.right.column; +*) + Buffer.contents b, lookup diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index 71ea4d6bdd7..948d3db762d 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -12,7 +12,7 @@ and item' = and par = id * typ -and seqn = (decl list * stmt list, info ) Source.annotated_phrase +and seqn = (decl list * stmt list, info) Source.annotated_phrase and decl = (id * typ, info) Source.annotated_phrase From 18449d70052309627ca0967b918f3ab71398c857 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 14 Oct 2022 13:22:42 +0200 Subject: [PATCH 14/81] viper: cleanups (#3485) * clean up junk * split `pp_stmt` * do XON/XOFF wrapping centrally in `pp_stmt` * `prog_mapped` also points to the right (generated) file --- src/pipeline/pipeline.ml | 2 +- src/viper/pretty.ml | 34 +++++++++++++++------------------- 2 files changed, 16 insertions(+), 20 deletions(-) diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index 960889f54a5..abe80a07920 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -494,7 +494,7 @@ let viper_files' parsefn files : viper_result = let prog = CompUnit.combine_progs progs in let u = CompUnit.comp_unit_of_prog false prog in let v = Viper.Trans.unit u in - let s, _ = Viper.Pretty.prog v in + let s = Viper.Pretty.prog v in Diag.return s diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 134bed5c46e..3204f6083ac 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -101,23 +101,26 @@ and pp_exp ppf exp = and pp_stmt ppf stmt = marks := stmt.at :: !marks; - match stmt.it with + fprintf ppf "\017%a\019" + pp_stmt' stmt.it + +and pp_stmt' ppf = function | SeqnS seqn -> pp_seqn ppf seqn | IfS(exp1, s1, { it = ([],[]); _ }) -> - fprintf ppf "\017@[if %a@ %a@]\019" + fprintf ppf "@[if %a@ %a@]" pp_exp exp1 pp_seqn s1 | IfS(exp1, s1, s2) -> - fprintf ppf "\017@[if %a@ %aelse@ %a@]\019" + fprintf ppf "@[if %a@ %aelse@ %a@]" pp_exp exp1 pp_seqn s1 pp_seqn s2 | VarAssignS(id, exp) -> - fprintf ppf "\017@[%s := %a@]\019" + fprintf ppf "@[%s := %a@]" id.it pp_exp exp | FieldAssignS(fldacc, exp2) -> - fprintf ppf "\017@[%a := %a@]\019" + fprintf ppf "@[%a := %a@]" pp_fldacc fldacc pp_exp exp2 @@ -126,12 +129,15 @@ and pp_fldacc ppf fldacc = | (exp1, id) -> fprintf ppf "@[(%a).%s@]" pp_exp exp1 id.it -let prog p = +let prog_mapped file p = let b = Buffer.create 16 in let ppf = Format.formatter_of_buffer b in Format.fprintf ppf "@[%a@]" pp_prog p; Format.pp_print_flush ppf (); - let marks = ref (List.rev_map (fun loc -> loc, loc) !marks, [], []) in + let in_file { left; right } = + let left, right = { left with file }, { right with file } in + { left ; right } in + let marks = ref (List.rev_map (fun loc -> loc, in_file loc) !marks, [], []) in let pos = ref 0 in let push line column = match !marks with | (mot, vip) :: clos, ope, don -> marks := clos, (mot, { vip with left = { vip.left with line; column } }) :: ope, don @@ -149,12 +155,7 @@ let prog p = | '\017' -> false | _ -> true in let b = Buffer.(of_seq Seq.(filter clean (map examine (to_seq b)))) in - let dump = List.iter (fun (mot, vip) -> Printf.eprintf "(MOT: %d:%d...%d:%d) -> (VIP: %d:%d...%d:%d)\n" mot.left.line mot.left.column mot.right.line mot.right.column vip.left.line vip.left.column vip.right.line vip.right.column) in let _, _, mapping = !marks in - (* - Printf.eprintf "\nLINES: %d\n" !line; - dump mapping; - *) let inside { left; right } other = left.file = other.left.file && right.file = other.right.file && @@ -166,11 +167,6 @@ let prog p = then Some mot else prev in List.fold_left tighten None mapping in -(* -let _, vip = List.(hd (tl ( mapping))) in -let vip = { vip with left = { vip.left with column = vip.left.column + 1 } } in -let Some mot = lookup vip in -Printf.eprintf "\ninput (VIP: %d:%d...%d:%d)\n" vip.left.line vip.left.column vip.right.line vip.right.column; -Printf.eprintf "\nfound (MOT: %d:%d...%d:%d)\n" mot.left.line mot.left.column mot.right.line mot.right.column; -*) Buffer.contents b, lookup + +let prog p = fst (prog_mapped "" p) From 36bea43a49b6ac9b432e326b4996f448d1ef55e0 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 14 Oct 2022 19:03:43 +0200 Subject: [PATCH 15/81] viper: testing (#3487) Set up testing infrastructure for Viper - moved tests to `test/viper` - added `Makefile` - augmented `run.sh` - accepted initial output - the `.vpr` files are also checked with `silicon` backend Run these by `make -C test/viper` but this is not (yet) added to the outer `Makefile`. --- default.nix | 8 ++++++ test/run.sh | 25 +++++++++++++++++-- test/viper/Makefile | 12 +++++++++ .../viper/test => test/viper}/claim-broken.mo | 0 .../viper/test => test/viper}/claim-simple.mo | 0 {src/viper/test => test/viper}/claim.mo | 0 test/viper/ok/claim-broken.silicon.ok | 1 + test/viper/ok/claim-broken.silicon.ret.ok | 1 + test/viper/ok/claim-broken.vpr.ok | 12 +++++++++ test/viper/ok/claim-simple.silicon.ok | 1 + test/viper/ok/claim-simple.silicon.ret.ok | 1 + test/viper/ok/claim-simple.vpr.ok | 10 ++++++++ test/viper/ok/claim.silicon.ok | 1 + test/viper/ok/claim.silicon.ret.ok | 1 + test/viper/ok/claim.vpr.ok | 12 +++++++++ 15 files changed, 83 insertions(+), 2 deletions(-) create mode 100644 test/viper/Makefile rename {src/viper/test => test/viper}/claim-broken.mo (100%) rename {src/viper/test => test/viper}/claim-simple.mo (100%) rename {src/viper/test => test/viper}/claim.mo (100%) create mode 100644 test/viper/ok/claim-broken.silicon.ok create mode 100644 test/viper/ok/claim-broken.silicon.ret.ok create mode 100644 test/viper/ok/claim-broken.vpr.ok create mode 100644 test/viper/ok/claim-simple.silicon.ok create mode 100644 test/viper/ok/claim-simple.silicon.ret.ok create mode 100644 test/viper/ok/claim-simple.vpr.ok create mode 100644 test/viper/ok/claim.silicon.ok create mode 100644 test/viper/ok/claim.silicon.ret.ok create mode 100644 test/viper/ok/claim.vpr.ok diff --git a/default.nix b/default.nix index 21e8384ef50..1e8dada3cc0 100644 --- a/default.nix +++ b/default.nix @@ -490,6 +490,7 @@ rec { run-deser = test_subdir "run-deser" [ deser ]; perf = perf_subdir "perf" [ moc nixpkgs.drun ]; bench = perf_subdir "bench" [ moc nixpkgs.drun ]; + viper = perf_subdir "viper" [ moc ]; inherit qc lsp unit candid profiling-graphs coverage; }) // { recurseForDerivations = true; }; @@ -750,6 +751,11 @@ rec { builtins.attrValues js; }; + viperServer = builtins.fetchurl { + url = https://github.com/viperproject/viperserver/releases/download/v-2022-10-13-0725/viperserver.jar; + sha256 = "0vvkyz58ni0hh49arlgc7xr8cl1q5200h9pmd3kmqpkiv1my3f22"; + }; + shell = stdenv.mkDerivation { name = "motoko-shell"; @@ -780,6 +786,7 @@ rec { nixpkgs.nix-update nixpkgs.rlwrap # for `rlwrap moc` nixpkgs.difftastic + nixpkgs.openjdk nixpkgs.z3 nixpkgs.jq # for viper dev ] )); @@ -797,6 +804,7 @@ rec { LOCALE_ARCHIVE = nixpkgs.lib.optionalString stdenv.isLinux "${nixpkgs.glibcLocales}/lib/locale/locale-archive"; MOTOKO_BASE = base-src; CANDID_TESTS = "${nixpkgs.sources.candid}/test"; + VIPER_SERVER = "${viperServer}"; # allow building this as a derivation, so that hydra builds and caches # the dependencies of shell. diff --git a/test/run.sh b/test/run.sh index 7035aa7b453..19c36265d53 100755 --- a/test/run.sh +++ b/test/run.sh @@ -13,6 +13,7 @@ # -i: Only check mo to idl generation # -p: Produce perf statistics # only compiles and runs drun, writes stats to $PERF_OUT +# -v: Translate to Viper # function realpath() { @@ -24,6 +25,7 @@ ACCEPT=no DTESTS=no IDL=no PERF=no +VIPER=no WASMTIME_OPTIONS="--disable-cache" WRAP_drun=$(realpath $(dirname $0)/drun-wrapper.sh) WRAP_ic_ref_run=$(realpath $(dirname $0)/ic-ref-run-wrapper.sh) @@ -35,7 +37,7 @@ ECHO=echo # Always do GC in tests, unless it's disabled in `EXTRA_MOC_ARGS` EXTRA_MOC_ARGS="--force-gc $EXTRA_MOC_ARGS" -while getopts "adpstir" o; do +while getopts "adpstirv" o; do case "${o}" in a) ACCEPT=yes @@ -55,6 +57,9 @@ while getopts "adpstir" o; do i) IDL=yes ;; + v) + VIPER=yes + ;; esac done @@ -93,7 +98,9 @@ function normalize () { # Normalize instruction locations on traps, added by ic-ref ad6ea9e sed -e 's/region:0x[0-9a-fA-F]\+-0x[0-9a-fA-F]\+/region:0xXXX-0xXXX/g' | # Delete everything after Oom - sed -e '/RTS error: Cannot grow memory/q' \ + sed -e '/RTS error: Cannot grow memory/q' | + # Delete Viper meta-output + sed -e '/^Silicon /d' \ > $1.norm mv $1.norm $1 fi @@ -264,6 +271,20 @@ do then run didc didc --check $out/$base.did fi + elif [ $VIPER = 'yes' ] + then + run vpr $moc_with_flags --viper $base.mo -o $out/$base.vpr + vpr_succeeded=$? + + normalize $out/$base.vpr + diff_files="$diff_files $base.vpr" + + if [ "$vpr_succeeded" -eq 0 ] + then + run silicon java -Xmx2048m -Xss16m -cp $VIPER_SERVER \ + viper.silicon.SiliconRunner --logLevel OFF --z3Exe $(which z3) \ + $out/$base.vpr + fi else if [ "$SKIP_RUNNING" != yes -a "$PERF" != yes ] then diff --git a/test/viper/Makefile b/test/viper/Makefile new file mode 100644 index 00000000000..23a8f8b267b --- /dev/null +++ b/test/viper/Makefile @@ -0,0 +1,12 @@ +RUNFLAGS = -v + +all: + ../run.sh $(RUNFLAGS) *.mo + +accept: + ../run.sh $(RUNFLAGS) -a *.mo + +clean: + rm -rf _out + +include ../*.mk diff --git a/src/viper/test/claim-broken.mo b/test/viper/claim-broken.mo similarity index 100% rename from src/viper/test/claim-broken.mo rename to test/viper/claim-broken.mo diff --git a/src/viper/test/claim-simple.mo b/test/viper/claim-simple.mo similarity index 100% rename from src/viper/test/claim-simple.mo rename to test/viper/claim-simple.mo diff --git a/src/viper/test/claim.mo b/test/viper/claim.mo similarity index 100% rename from src/viper/test/claim.mo rename to test/viper/claim.mo diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok new file mode 100644 index 00000000000..4ce04bc3d7f --- /dev/null +++ b/test/viper/ok/claim-broken.silicon.ok @@ -0,0 +1 @@ + [0] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim-broken.vpr@5.10--5.26) diff --git a/test/viper/ok/claim-broken.silicon.ret.ok b/test/viper/ok/claim-broken.silicon.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/viper/ok/claim-broken.silicon.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/viper/ok/claim-broken.vpr.ok b/test/viper/ok/claim-broken.vpr.ok new file mode 100644 index 00000000000..be70e149b4d --- /dev/null +++ b/test/viper/ok/claim-broken.vpr.ok @@ -0,0 +1,12 @@ +field claimed: Bool +field count: Int +method claim($Self: Ref) + { + if (!($Self).claimed) + { + { + ($Self).claimed := true + ($Self).count := 1 + } + } + } diff --git a/test/viper/ok/claim-simple.silicon.ok b/test/viper/ok/claim-simple.silicon.ok new file mode 100644 index 00000000000..74fe52d8853 --- /dev/null +++ b/test/viper/ok/claim-simple.silicon.ok @@ -0,0 +1 @@ + [0] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim-simple.vpr@5.10--5.26) diff --git a/test/viper/ok/claim-simple.silicon.ret.ok b/test/viper/ok/claim-simple.silicon.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/viper/ok/claim-simple.silicon.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/viper/ok/claim-simple.vpr.ok b/test/viper/ok/claim-simple.vpr.ok new file mode 100644 index 00000000000..fa7ac6c78ba --- /dev/null +++ b/test/viper/ok/claim-simple.vpr.ok @@ -0,0 +1,10 @@ +field claimed: Bool +field count: Int +method claim($Self: Ref) + { + if (!($Self).claimed) + { + ($Self).claimed := true + ($Self).count := 1 + } + } diff --git a/test/viper/ok/claim.silicon.ok b/test/viper/ok/claim.silicon.ok new file mode 100644 index 00000000000..d7437e94764 --- /dev/null +++ b/test/viper/ok/claim.silicon.ok @@ -0,0 +1 @@ + [0] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim.vpr@5.10--5.26) diff --git a/test/viper/ok/claim.silicon.ret.ok b/test/viper/ok/claim.silicon.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/viper/ok/claim.silicon.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok new file mode 100644 index 00000000000..5b7be9ba39a --- /dev/null +++ b/test/viper/ok/claim.vpr.ok @@ -0,0 +1,12 @@ +field claimed: Bool +field count: Int +method claim($Self: Ref) + { + if (!($Self).claimed) + { + ($Self).claimed := true + { + ($Self).count := 1 + } + } + } From c6feeaf342dea914ea56ab532e61cc33f6ce5e48 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 14 Oct 2022 23:36:57 +0200 Subject: [PATCH 16/81] handle equality comparisons --- src/viper/pretty.ml | 2 ++ src/viper/trans.ml | 4 +++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 3204f6083ac..78b3e78e113 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -98,6 +98,8 @@ and pp_exp ppf exp = fprintf ppf "%s" (if b then "true" else "false") | IntLitE i -> fprintf ppf "%s" (Mo_values.Numerics.Int.to_string i) + | EqCmpE (e1, e2) -> + fprintf ppf "(%a == %a)" pp_exp e1 pp_exp e2 and pp_stmt ppf stmt = marks := stmt.at :: !marks; diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 37e31577b49..0c835926d0c 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -239,7 +239,9 @@ and exp' ctxt (e : M.exp) = | _ -> fail (Mo_def.Arrange.exp e) end | M.NotE e -> - (NotE (exp ctxt e), NoInfo) + NotE (exp ctxt e), NoInfo + | M.RelE (ot, e1, EqOp, e2) -> + EqCmpE (exp ctxt e1, exp ctxt e2), NoInfo | _ -> fail (Mo_def.Arrange.exp e) (* | VarE x -> From 137337ebed79c0342a895fab35d58643a5c00e8f Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 14 Oct 2022 23:48:51 +0200 Subject: [PATCH 17/81] handle `OrE` and `AndE` --- src/viper/pretty.ml | 4 ++++ src/viper/trans.ml | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 78b3e78e113..25a6c69287b 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -100,6 +100,10 @@ and pp_exp ppf exp = fprintf ppf "%s" (Mo_values.Numerics.Int.to_string i) | EqCmpE (e1, e2) -> fprintf ppf "(%a == %a)" pp_exp e1 pp_exp e2 + | OrE (e1, e2) -> + fprintf ppf "(%a || %a)" pp_exp e1 pp_exp e2 + | AndE (e1, e2) -> + fprintf ppf "(%a && %a)" pp_exp e1 pp_exp e2 and pp_stmt ppf stmt = marks := stmt.at :: !marks; diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 0c835926d0c..199f4e3c4cb 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -242,6 +242,10 @@ and exp' ctxt (e : M.exp) = NotE (exp ctxt e), NoInfo | M.RelE (ot, e1, EqOp, e2) -> EqCmpE (exp ctxt e1, exp ctxt e2), NoInfo + | M.OrE (e1, e2) -> + OrE (exp ctxt e1, exp ctxt e2), NoInfo + | M.AndE (e1, e2) -> + AndE (exp ctxt e1, exp ctxt e2), NoInfo | _ -> fail (Mo_def.Arrange.exp e) (* | VarE x -> From d1799c970e86e3e129b6a9f2084b426703bf73a7 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Sat, 15 Oct 2022 14:24:31 +0200 Subject: [PATCH 18/81] fix copy&pasto --- src/viper/pretty.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 25a6c69287b..e5df1a5cc66 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -59,7 +59,7 @@ and pp_pre ppf exp = fprintf ppf "requires @[<2>%a@]" pp_exp exp and pp_posts ppf exps = - fprintf ppf "@[%a@]" (pp_print_list pp_pre) exps + fprintf ppf "@[%a@]" (pp_print_list pp_post) exps and pp_post ppf exp = fprintf ppf "ensures @[<2>%a@]" pp_exp exp From 47ad446965fa8dd38c4a8cbc6889e4ba310a0b41 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Sat, 15 Oct 2022 16:31:04 +0200 Subject: [PATCH 19/81] implement `>` --- src/viper/pretty.ml | 2 ++ src/viper/trans.ml | 2 ++ 2 files changed, 4 insertions(+) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index e5df1a5cc66..81a9b5eb6b4 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -100,6 +100,8 @@ and pp_exp ppf exp = fprintf ppf "%s" (Mo_values.Numerics.Int.to_string i) | EqCmpE (e1, e2) -> fprintf ppf "(%a == %a)" pp_exp e1 pp_exp e2 + | GtCmpE (e1, e2) -> + fprintf ppf "(%a > %a)" pp_exp e1 pp_exp e2 | OrE (e1, e2) -> fprintf ppf "(%a || %a)" pp_exp e1 pp_exp e2 | AndE (e1, e2) -> diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 199f4e3c4cb..ed95abb7f61 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -242,6 +242,8 @@ and exp' ctxt (e : M.exp) = NotE (exp ctxt e), NoInfo | M.RelE (ot, e1, EqOp, e2) -> EqCmpE (exp ctxt e1, exp ctxt e2), NoInfo + | M.RelE (ot, e1, GtOp, e2) -> + GtCmpE (exp ctxt e1, exp ctxt e2), NoInfo | M.OrE (e1, e2) -> OrE (exp ctxt e1, exp ctxt e2), NoInfo | M.AndE (e1, e2) -> From 6b59baf5068f3cfbb625e2bee14e6e465b6102f6 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Sat, 15 Oct 2022 18:30:39 +0200 Subject: [PATCH 20/81] pretty-print all binary operators --- src/viper/pretty.ml | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 81a9b5eb6b4..5b64e9076bd 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -94,18 +94,24 @@ and pp_exp ppf exp = pp_fldacc ppf fldacc | NotE e -> fprintf ppf "@[(!%a)@]" pp_exp e + | MinusE e -> + fprintf ppf "@[(-%a)@]" pp_exp e | BoolLitE b -> fprintf ppf "%s" (if b then "true" else "false") | IntLitE i -> fprintf ppf "%s" (Mo_values.Numerics.Int.to_string i) - | EqCmpE (e1, e2) -> - fprintf ppf "(%a == %a)" pp_exp e1 pp_exp e2 - | GtCmpE (e1, e2) -> - fprintf ppf "(%a > %a)" pp_exp e1 pp_exp e2 - | OrE (e1, e2) -> - fprintf ppf "(%a || %a)" pp_exp e1 pp_exp e2 - | AndE (e1, e2) -> - fprintf ppf "(%a && %a)" pp_exp e1 pp_exp e2 + | AddE (e1, e2) | SubE (e1, e2) | MulE (e1, e2) | DivE (e1, e2) | ModE (e1, e2) + | EqCmpE (e1, e2) | NeCmpE (e1, e2) | GtCmpE (e1, e2) | GeCmpE (e1, e2) | LtCmpE (e1, e2) | LeCmpE (e1, e2) + | Implies (e1, e2) | OrE (e1, e2) | AndE (e1, e2) -> + let op = match exp.it with + | AddE _ -> "+" | SubE _ -> "-" + | MulE _ -> "*" | DivE _ -> "/" | ModE _ -> "%" + | EqCmpE _ -> "==" | NeCmpE _ -> "!=" + | GtCmpE _ -> ">" | GeCmpE _ -> ">=" + | LtCmpE _ -> "<" | LeCmpE _ -> "<=" + | Implies _ -> "==>" | OrE _ -> "||" | AndE _ -> "&&" + | _ -> failwith "not a binary operator" in + fprintf ppf "(%a %s %a)" pp_exp e1 op pp_exp e2 and pp_stmt ppf stmt = marks := stmt.at :: !marks; From 45444919cc9e97cbb11416e7093a843bbc7975ad Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Sat, 15 Oct 2022 19:18:19 +0200 Subject: [PATCH 21/81] binops --- src/viper/trans.ml | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/src/viper/trans.ml b/src/viper/trans.ml index ed95abb7f61..bdd8bf0866a 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -212,6 +212,7 @@ and exp ctxt e = at = e.at; note = info } and exp' ctxt (e : M.exp) = + let open Mo_values.Operator in match e.it with | M.VarE x (* when Env.find x.it ctxt = Local *) -> begin @@ -240,10 +241,25 @@ and exp' ctxt (e : M.exp) = end | M.NotE e -> NotE (exp ctxt e), NoInfo - | M.RelE (ot, e1, EqOp, e2) -> - EqCmpE (exp ctxt e1, exp ctxt e2), NoInfo - | M.RelE (ot, e1, GtOp, e2) -> - GtCmpE (exp ctxt e1, exp ctxt e2), NoInfo + | M.RelE (ot, e1, op, e2) -> + let e1, e2 = exp ctxt e1, exp ctxt e2 in + (match op with + | EqOp -> EqCmpE (e1, e2) + | NeqOp -> NeCmpE (e1, e2) + | GtOp -> GtCmpE (e1, e2) + | GeOp -> GeCmpE (e1, e2) + | LtOp -> LtCmpE (e1, e2) + | LeOp -> LeCmpE (e1, e2) + ), NoInfo + | M.BinE (ot, e1, op, e2) -> + let e1, e2 = exp ctxt e1, exp ctxt e2 in + (match op with + | AddOp -> AddE (e1, e2) + | SubOp -> SubE (e1, e2) + | MulOp -> MulE (e1, e2) + | DivOp -> DivE (e1, e2) + | ModOp -> ModE (e1, e2) + ), NoInfo | M.OrE (e1, e2) -> OrE (exp ctxt e1, exp ctxt e2), NoInfo | M.AndE (e1, e2) -> From 228ba23355d6b98bb85c6eee724a1f0d67d06c50 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Sun, 16 Oct 2022 00:00:10 +0200 Subject: [PATCH 22/81] viper: invariants (#3488) This implements actor-global invariants. They get (currently) declared with a actor-level `assert` and translated to a Viper macro, that gets both `require`d and `ensure`d from each method by calls to those macros. TODOs: - [ ] find better syntax - [x] use invariant(s) for pre/postconditions on each actor method - [x] `self` access in `define` - [x] `__init__` should only have a postcondition (depends on #3486) - [x] allow more than one invariant --- src/viper/pretty.ml | 7 ++-- src/viper/syntax.ml | 2 ++ src/viper/trans.ml | 45 ++++++++++++++++++++------ test/viper/claim-simple.mo | 2 +- test/viper/invariant.mo | 13 ++++++++ test/viper/ok/invariant.silicon.ok | 1 + test/viper/ok/invariant.silicon.ret.ok | 1 + test/viper/ok/invariant.vpr.ok | 11 +++++++ 8 files changed, 69 insertions(+), 13 deletions(-) create mode 100644 test/viper/invariant.mo create mode 100644 test/viper/ok/invariant.silicon.ok create mode 100644 test/viper/ok/invariant.silicon.ret.ok create mode 100644 test/viper/ok/invariant.vpr.ok diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 5b64e9076bd..7e67352de8a 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -33,9 +33,10 @@ and pp_item ppf i = pp_pres pres pp_posts posts pp_block_opt bo + | InvariantI (s, e) -> (* TODO: srcloc mapping *) + fprintf ppf "@[<2>define %s(self) (%a)@]" s pp_exp e -and pp_block_opt ppf bo = - match bo with +and pp_block_opt ppf = function | None -> () | Some seqn -> pp_seqn ppf seqn @@ -92,6 +93,8 @@ and pp_exp ppf exp = fprintf ppf "%s" id.it | FldAcc fldacc -> pp_fldacc ppf fldacc + | MacroCall (m, e) -> + fprintf ppf "@[%s(%a)@]" m pp_exp e | NotE e -> fprintf ppf "@[(!%a)@]" pp_exp e | MinusE e -> diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index 948d3db762d..f4d35f94ee3 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -9,6 +9,7 @@ and item' = (* | import path *) | FieldI of id * typ | MethodI of id * par list * par list * exp list * exp list * seqn option + | InvariantI of string * exp and par = id * typ @@ -42,6 +43,7 @@ and exp' = | Implies of exp * exp | FldAcc of fldacc | PermExp of perm + | MacroCall of string * exp and perm = (perm', info) Source.annotated_phrase diff --git a/src/viper/trans.ml b/src/viper/trans.ml index bdd8bf0866a..95434ee431f 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -25,14 +25,36 @@ let self ctxt at = note = NoInfo } | _ -> failwith "no self" -let rec unit (u : Mo_def.Syntax.comp_unit) : prog = +let rec extract_invariants : item list -> (par -> invariants -> invariants) = function + | [] -> fun _ x -> x + | { it = InvariantI (s, e); at; _ } :: p -> + fun self es -> + { it = MacroCall(s, { it = LocalVar (fst self, snd self) + ; at + ; note = NoInfo }) + ; at + ; note = NoInfo } :: extract_invariants p self es + | _ :: p -> extract_invariants p + +let rec adorn_invariants (is : par -> invariants -> invariants) = function + | [] -> [] + | { it = MethodI (d, (self :: _ as i), o, r, e, b); _ } as m :: p -> + let pre_is = function + | "__init__" -> fun _ l -> l + | _ -> is in + let m = { m with it = MethodI (d, i, o, pre_is d.it self r, is self e, b) } in + m :: adorn_invariants is p + | i :: p -> i :: adorn_invariants is p + +let rec unit (u : M.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with | M.ActorU(id_opt, decs) -> let ctxt = { self = None; ids = Env.empty } in - let (ctxt', mk_is) = dec_fields ctxt decs in + let ctxt', mk_is = dec_fields ctxt decs in let is = List.map (fun mk_i -> mk_i ctxt') mk_is in - { it = is; + let invs = extract_invariants is in + { it = adorn_invariants invs is; at = body.at; note = NoInfo } @@ -76,6 +98,10 @@ and dec_field' ctxt d = in (* TODO: add args (and rets?) *) (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, [], [], Some (stmt ctxt'' e)), NoInfo) + | M.(ExpD { it = AssertE e; at; _ }) -> + ctxt, + fun ctxt' -> + InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "self" } e), NoInfo | _ -> fail (Mo_def.Arrange.dec d.M.dec) (* @@ -122,8 +148,8 @@ and dec ctxt d = note = NoInfo }], [{ it = VarAssignS (id x, exp ctxt' e); at = d.at; - note = NoInfo } ]) - | M.(LetD ({it=VarP x;_}, e))-> + note = NoInfo }]) + | M.(LetD ({it=VarP x;_}, e)) -> { ctxt with ids = Env.add x.it Local ctxt.ids }, fun ctxt' -> ([{ it = (id x, tr_typ e.note.M.note_typ); @@ -171,7 +197,7 @@ and stmt ctxt (s : M.exp) : seqn = at = s.at; note = NoInfo } | M.(AssignE({it = VarE x; _}, e2)) -> - match Env.find x.it ctxt.ids with + begin match Env.find x.it ctxt.ids with | Local -> let loc = { it = x.it; at = x.at; note = NoInfo } in { it = @@ -190,9 +216,10 @@ and stmt ctxt (s : M.exp) : seqn = note = NoInfo } ]); at = s.at; note = NoInfo } - + end + | M.LitE e -> { it = [], []; at = s.at; note = NoInfo } | _ -> fail (Mo_def.Arrange.exp s) - + (* | M.AssignE({it = VarE id;_}, e2) when isField e1-> { it = @@ -541,5 +568,3 @@ and dec d = match d.it with ] @ List.map dec_field dfs *) - - diff --git a/test/viper/claim-simple.mo b/test/viper/claim-simple.mo index e5df23859f8..4ea8dc7d5e5 100644 --- a/test/viper/claim-simple.mo +++ b/test/viper/claim-simple.mo @@ -11,4 +11,4 @@ actor { }; }; -} \ No newline at end of file +} diff --git a/test/viper/invariant.mo b/test/viper/invariant.mo new file mode 100644 index 00000000000..34b4922c8e1 --- /dev/null +++ b/test/viper/invariant.mo @@ -0,0 +1,13 @@ +actor { + + var claimed = false; + + var count = 0 : Int; + + assert claimed and not (-1 == -1) and (-42 == -42) or true; + assert count > 0; + + public shared func claim() : async () { + }; + +} diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok new file mode 100644 index 00000000000..73cf9891ab9 --- /dev/null +++ b/test/viper/ok/invariant.silicon.ok @@ -0,0 +1 @@ + [0] Contract might not be well-formed. There might be insufficient permission to access $Self.claimed (invariant.vpr@6.12--6.30) diff --git a/test/viper/ok/invariant.silicon.ret.ok b/test/viper/ok/invariant.silicon.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/viper/ok/invariant.silicon.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok new file mode 100644 index 00000000000..fbdb297c9be --- /dev/null +++ b/test/viper/ok/invariant.vpr.ok @@ -0,0 +1,11 @@ +field claimed: Bool +field count: Int +define invariant_7(self) (((((self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) +define invariant_8(self) (((self).count > 0)) +method claim($Self: Ref) + requires invariant_7($Self) + requires invariant_8($Self) + ensures invariant_7($Self) + ensures invariant_8($Self) { + + } From 7459811d3db1997e4099306684ff19c36c79044b Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Sun, 16 Oct 2022 12:27:05 +0200 Subject: [PATCH 23/81] pretty-print `null` --- src/viper/pretty.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 7e67352de8a..7ef53df74b5 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -99,6 +99,8 @@ and pp_exp ppf exp = fprintf ppf "@[(!%a)@]" pp_exp e | MinusE e -> fprintf ppf "@[(-%a)@]" pp_exp e + | NullLitE -> + fprintf ppf "null" | BoolLitE b -> fprintf ppf "%s" (if b then "true" else "false") | IntLitE i -> From e5a25afd2ccbc9e69bd16ee97a192193a29072cb Mon Sep 17 00:00:00 2001 From: Arshavir Ter-Gabrielyan Date: Sun, 16 Oct 2022 23:54:33 +0200 Subject: [PATCH 24/81] Support generation of __init__ methods based on actor private fields (#3486) This PR extends the Motoko to Viper translation with initialization statements for each actor private field. These statements form the body of a special `__init__` method (that establishes the canister's invariant for the first time). Main assumptions: * Initializing expressions can be translated as expressions; no imperative code (a.k.a. Viper statements) needs to be used * The name `__init__` is not used elsewhere in the program * The method `__init__` should be supplied with permissions to write into each actor private field (alternatively, the translation would need to be extended with `inhale` statements corresponding to each field) --- src/viper/trans.ml | 78 ++++++++++++++++++--------- test/viper/ok/claim-broken.silicon.ok | 3 +- test/viper/ok/claim-broken.vpr.ok | 5 ++ test/viper/ok/claim-simple.silicon.ok | 3 +- test/viper/ok/claim-simple.vpr.ok | 5 ++ test/viper/ok/claim.silicon.ok | 3 +- test/viper/ok/claim.vpr.ok | 5 ++ test/viper/ok/invariant.silicon.ok | 3 +- test/viper/ok/invariant.vpr.ok | 7 +++ 9 files changed, 83 insertions(+), 29 deletions(-) diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 95434ee431f..921027a15ae 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -50,28 +50,50 @@ let rec unit (u : M.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with | M.ActorU(id_opt, decs) -> - let ctxt = { self = None; ids = Env.empty } in - let ctxt', mk_is = dec_fields ctxt decs in - let is = List.map (fun mk_i -> mk_i ctxt') mk_is in - let invs = extract_invariants is in - { it = adorn_invariants invs is; - at = body.at; - note = NoInfo - } + let ctxt = { self = None; ids = Env.empty } in + let ctxt', inits, mk_is = dec_fields ctxt decs in + let is' = List.map (fun mk_i -> mk_i ctxt') mk_is in + let init_id = id_at "__init__" Source.no_region in + let self_id = id_at "$Self" Source.no_region in + let ctxt'' = { ctxt' with self = Some self_id.it } in + let init_list = List.map (fun (id, init) -> + { at = { left = id.at.left; right = init.at.right }; + it = FieldAssignS((self ctxt'' init.at, id), exp ctxt'' init); + note = NoInfo + }) inits in + let init_body = + { at = body.at; (* ATG: Is this the correct position? *) + it = [], init_list; + note = NoInfo + } in + let m = + { it = MethodI(init_id, [ + self_id, { it = RefT; at = self_id.at; note = NoInfo } + ], [], [], [], Some init_body); + at = no_region; + note = NoInfo + } in + let is = m :: is' in + let invs = extract_invariants is in + { it = adorn_invariants invs is; + at = body.at; + note = NoInfo + } | _ -> assert false and dec_fields (ctxt : ctxt) (ds : M.dec_field list) = match ds with | [] -> - (ctxt, []) + (ctxt, [], []) | d :: ds -> - let ctxt, mk_i = dec_field ctxt d in - let ctxt, mk_is = dec_fields ctxt ds in - (ctxt, mk_i::mk_is) + let ctxt, init, mk_i = dec_field ctxt d in + let ctxt, inits, mk_is = dec_fields ctxt ds in + (ctxt, (match init with Some i -> i::inits | _ -> inits), mk_i::mk_is) and dec_field ctxt d = - let (ctxt, mk_i) = dec_field' ctxt d.it in + let ctxt, init, mk_i = dec_field' ctxt d.it in (ctxt, + init, fun ctxt' -> let (i, info) = mk_i ctxt' in { it = i; @@ -83,23 +105,25 @@ and dec_field' ctxt d = (* | ExpD e -> "ExpD" $$ [exp e ] *) | M.VarD (x, e) -> - { ctxt with ids = Env.add x.it Field ctxt.ids }, - (* TODO: translate e? *) - fun ctxt' -> - (FieldI(id x, tr_typ e.note.M.note_typ), - NoInfo) + { ctxt with ids = Env.add x.it Field ctxt.ids }, + Some (id x, e), + fun ctxt' -> + (FieldI(id x, tr_typ e.note.M.note_typ), + NoInfo) | M.(LetD ({it=VarP f;_}, {it=FuncE(x, sp, tp, p, t_opt, sugar, {it = AsyncE (_, e); _} );_})) -> (* ignore async *) - { ctxt with ids = Env.add f.it Method ctxt.ids }, - fun ctxt' -> - let self_id = {it = "$Self"; at = Source.no_region; note = NoInfo } in - let ctxt'' = { ctxt' with self = Some self_id.it } - in (* TODO: add args (and rets?) *) - (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, [], [], Some (stmt ctxt'' e)), + { ctxt with ids = Env.add f.it Method ctxt.ids }, + None, + fun ctxt' -> + let self_id = id_at "$Self" Source.no_region in + let ctxt'' = { ctxt' with self = Some self_id.it } + in (* TODO: add args (and rets?) *) + (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, [], [], Some (stmt ctxt'' e)), NoInfo) | M.(ExpD { it = AssertE e; at; _ }) -> ctxt, + None, fun ctxt' -> InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "self" } e), NoInfo | _ -> fail (Mo_def.Arrange.dec d.M.dec) @@ -252,6 +276,8 @@ and exp' ctxt (e : M.exp) = NoInfo) | _ -> fail (Mo_def.Arrange.exp e) end + | M.AnnotE(a, b) -> + exp' ctxt a (* | M.VarE x when Env.find x.it ctxt = Field -> (*TODO: need environment to distinguish fields from locals *) @@ -361,6 +387,8 @@ and rets t_opt = | T.Tup [] -> [] | T.Async (_, _) -> []) +and id_at id at = { it = id; at = at; note = NoInfo } + and id id = { it = id.it; at = id.at; note = NoInfo } and tr_typ typ = @@ -371,7 +399,7 @@ and tr_typ' typ = match T.normalize typ with | T.Prim T.Int -> IntT | T.Prim T.Bool -> BoolT - + | _ -> fail (Mo_types.Arrange_type.typ (T.normalize typ)) (* diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok index 4ce04bc3d7f..f5c2ba08b03 100644 --- a/test/viper/ok/claim-broken.silicon.ok +++ b/test/viper/ok/claim-broken.silicon.ok @@ -1 +1,2 @@ - [0] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim-broken.vpr@5.10--5.26) + [0] Assignment might fail. There might be insufficient permission to access $Self.claimed (claim-broken.vpr@3.6--3.30) + [1] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim-broken.vpr@10.10--10.26) diff --git a/test/viper/ok/claim-broken.vpr.ok b/test/viper/ok/claim-broken.vpr.ok index be70e149b4d..a76ca0e4ba4 100644 --- a/test/viper/ok/claim-broken.vpr.ok +++ b/test/viper/ok/claim-broken.vpr.ok @@ -1,3 +1,8 @@ +method __init__($Self: Ref) + { + ($Self).claimed := false + ($Self).count := 0 + } field claimed: Bool field count: Int method claim($Self: Ref) diff --git a/test/viper/ok/claim-simple.silicon.ok b/test/viper/ok/claim-simple.silicon.ok index 74fe52d8853..cf1b75bf84b 100644 --- a/test/viper/ok/claim-simple.silicon.ok +++ b/test/viper/ok/claim-simple.silicon.ok @@ -1 +1,2 @@ - [0] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim-simple.vpr@5.10--5.26) + [0] Assignment might fail. There might be insufficient permission to access $Self.claimed (claim-simple.vpr@3.6--3.30) + [1] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim-simple.vpr@10.10--10.26) diff --git a/test/viper/ok/claim-simple.vpr.ok b/test/viper/ok/claim-simple.vpr.ok index fa7ac6c78ba..db9f926edc5 100644 --- a/test/viper/ok/claim-simple.vpr.ok +++ b/test/viper/ok/claim-simple.vpr.ok @@ -1,3 +1,8 @@ +method __init__($Self: Ref) + { + ($Self).claimed := false + ($Self).count := 0 + } field claimed: Bool field count: Int method claim($Self: Ref) diff --git a/test/viper/ok/claim.silicon.ok b/test/viper/ok/claim.silicon.ok index d7437e94764..a1f650bfc66 100644 --- a/test/viper/ok/claim.silicon.ok +++ b/test/viper/ok/claim.silicon.ok @@ -1 +1,2 @@ - [0] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim.vpr@5.10--5.26) + [0] Assignment might fail. There might be insufficient permission to access $Self.claimed (claim.vpr@3.6--3.30) + [1] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim.vpr@10.10--10.26) diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok index 5b7be9ba39a..06a07f630d9 100644 --- a/test/viper/ok/claim.vpr.ok +++ b/test/viper/ok/claim.vpr.ok @@ -1,3 +1,8 @@ +method __init__($Self: Ref) + { + ($Self).claimed := false + ($Self).count := 0 + } field claimed: Bool field count: Int method claim($Self: Ref) diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok index 73cf9891ab9..d59e22287f1 100644 --- a/test/viper/ok/invariant.silicon.ok +++ b/test/viper/ok/invariant.silicon.ok @@ -1 +1,2 @@ - [0] Contract might not be well-formed. There might be insufficient permission to access $Self.claimed (invariant.vpr@6.12--6.30) + [0] Contract might not be well-formed. There might be insufficient permission to access $Self.claimed (invariant.vpr@2.11--2.29) + [1] Contract might not be well-formed. There might be insufficient permission to access $Self.claimed (invariant.vpr@13.12--13.30) diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index fbdb297c9be..6f78cf49f87 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -1,3 +1,10 @@ +method __init__($Self: Ref) + ensures invariant_7($Self) + ensures invariant_8($Self) + { + ($Self).claimed := false + ($Self).count := 0 + } field claimed: Bool field count: Int define invariant_7(self) (((((self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) From 9f1761bbf5c71be6f1663a0251655413fddb08ef Mon Sep 17 00:00:00 2001 From: Ryan Vandersmith Date: Mon, 17 Oct 2022 10:02:28 -0600 Subject: [PATCH 25/81] Add 'moc.js' endpoint for Viper integration --- src/js/common.ml | 6 ++++++ src/js/moc_js.ml | 1 + 2 files changed, 7 insertions(+) diff --git a/src/js/common.ml b/src/js/common.ml index b25564e772f..f4aac7a6c0b 100644 --- a/src/js/common.ml +++ b/src/js/common.ml @@ -112,6 +112,12 @@ let js_parse_candid s = Js.some (js_of_sexpr ast) ) +let js_viper filenames = + let parse_result = Pipeline.viper_files (filenames |> Array.to_list |> List.map Js.to_string) in + js_result parse_result (fun result -> + Js.some (Js.string result) + ) + let js_save_file filename content = let filename = Js.to_string filename in let content = Js.to_string content in diff --git a/src/js/moc_js.ml b/src/js/moc_js.ml index c60e1543ade..5f4e100eaeb 100644 --- a/src/js/moc_js.ml +++ b/src/js/moc_js.ml @@ -29,4 +29,5 @@ let () = method compileWasm mode s = Flags.compiled := true; js_compile_wasm mode s method parseMotoko s = js_parse_motoko s method parseCandid s = js_parse_candid s + method viper s = js_viper s end); From 7ca05ce6a4aea23f5e391e6915369a9f27bca6b0 Mon Sep 17 00:00:00 2001 From: Ryan Vandersmith Date: Mon, 17 Oct 2022 10:29:56 -0600 Subject: [PATCH 26/81] Reorganize moc.js endpoint --- src/js/common.ml | 12 ++++++------ src/js/moc_js.ml | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/js/common.ml b/src/js/common.ml index f4aac7a6c0b..a9396c10529 100644 --- a/src/js/common.ml +++ b/src/js/common.ml @@ -60,6 +60,12 @@ let js_run list source = let list = Js.to_array list |> Array.to_list |> List.map Js.to_string in ignore (Pipeline.run_stdin_from_file list (Js.to_string source)) +let js_viper filenames = + let result = Pipeline.viper_files (filenames |> Array.to_list |> List.map Js.to_string) in + js_result result (fun s -> + Js.some (Js.string s) + ) + let js_candid source = js_result (Pipeline.generate_idl [Js.to_string source]) (fun prog -> @@ -112,12 +118,6 @@ let js_parse_candid s = Js.some (js_of_sexpr ast) ) -let js_viper filenames = - let parse_result = Pipeline.viper_files (filenames |> Array.to_list |> List.map Js.to_string) in - js_result parse_result (fun result -> - Js.some (Js.string result) - ) - let js_save_file filename content = let filename = Js.to_string filename in let content = Js.to_string content in diff --git a/src/js/moc_js.ml b/src/js/moc_js.ml index 5f4e100eaeb..d03fd7e3628 100644 --- a/src/js/moc_js.ml +++ b/src/js/moc_js.ml @@ -24,10 +24,10 @@ let () = method gcFlags option = gc_flags option method run list s = Flags.compiled := false; wrap_output (fun _ -> js_run list s) method check s = Flags.compiled := false; js_check s + method viper filenames = js_viper filenames method candid s = Flags.compiled := true; js_candid s method stableCompatible pre post = js_stable_compatible pre post method compileWasm mode s = Flags.compiled := true; js_compile_wasm mode s method parseMotoko s = js_parse_motoko s method parseCandid s = js_parse_candid s - method viper s = js_viper s end); From 28831209b726b69d6a6f05f5939c4f6180ac4c6e Mon Sep 17 00:00:00 2001 From: Ryan Vandersmith Date: Mon, 17 Oct 2022 11:28:11 -0600 Subject: [PATCH 27/81] Convert JS array to OCaml array --- src/js/common.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/js/common.ml b/src/js/common.ml index a9396c10529..608df9791df 100644 --- a/src/js/common.ml +++ b/src/js/common.ml @@ -61,7 +61,7 @@ let js_run list source = ignore (Pipeline.run_stdin_from_file list (Js.to_string source)) let js_viper filenames = - let result = Pipeline.viper_files (filenames |> Array.to_list |> List.map Js.to_string) in + let result = Pipeline.viper_files (Js.to_array filenames |> Array.to_list |> List.map Js.to_string) in js_result result (fun s -> Js.some (Js.string s) ) From e56ee70587bef469e5ed4aa5fdd11be02b211f88 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Tue, 18 Oct 2022 12:38:18 +0200 Subject: [PATCH 28/81] update `viperserver` nightly --- default.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/default.nix b/default.nix index 1e8dada3cc0..bc23b55a54e 100644 --- a/default.nix +++ b/default.nix @@ -752,8 +752,8 @@ rec { }; viperServer = builtins.fetchurl { - url = https://github.com/viperproject/viperserver/releases/download/v-2022-10-13-0725/viperserver.jar; - sha256 = "0vvkyz58ni0hh49arlgc7xr8cl1q5200h9pmd3kmqpkiv1my3f22"; + url = https://github.com/viperproject/viperserver/releases/download/v-2022-10-18-0728/viperserver.jar; + sha256 = "sha256:0j0p70h6jv96d9j97xr3nyb97xc44cxnn76dwx3drs6ifnhx14wx"; }; shell = stdenv.mkDerivation { From 33edfcafb7d7f64a0eaee3f0b93c4249ad8378dd Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 19 Oct 2022 13:57:44 +0200 Subject: [PATCH 29/81] indentation --- src/viper/trans.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 921027a15ae..14c8eb7016a 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -122,10 +122,10 @@ and dec_field' ctxt d = (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, [], [], Some (stmt ctxt'' e)), NoInfo) | M.(ExpD { it = AssertE e; at; _ }) -> - ctxt, + ctxt, None, - fun ctxt' -> - InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "self" } e), NoInfo + fun ctxt' -> + InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "self" } e), NoInfo | _ -> fail (Mo_def.Arrange.dec d.M.dec) (* From 1a061f2473684e790d242539a17cd39f339b4a4a Mon Sep 17 00:00:00 2001 From: Arshavir Ter-Gabrielyan Date: Wed, 19 Oct 2022 20:18:57 +0200 Subject: [PATCH 30/81] Generate method specs in Motoko to Viper translation (#3496) This PR enables method specs in Motoko to Viper translation (including both access permissions to all actor private fields and canister invariant). Co-authored-by: Claudio Russo Co-authored-by: Gabor Greif --- src/viper/pretty.ml | 14 +++- src/viper/syntax.ml | 13 ++-- src/viper/trans.ml | 82 +++++++++++++++++------ test/viper/ok/claim-broken.silicon.ok | 2 - test/viper/ok/claim-broken.silicon.ret.ok | 1 - test/viper/ok/claim-broken.vpr.ok | 8 ++- test/viper/ok/claim-simple.silicon.ok | 2 - test/viper/ok/claim-simple.silicon.ret.ok | 1 - test/viper/ok/claim-simple.vpr.ok | 8 ++- test/viper/ok/claim.silicon.ok | 2 - test/viper/ok/claim.silicon.ret.ok | 1 - test/viper/ok/claim.vpr.ok | 8 ++- test/viper/ok/invariant.silicon.ok | 3 +- test/viper/ok/invariant.vpr.ok | 10 ++- 14 files changed, 104 insertions(+), 51 deletions(-) delete mode 100644 test/viper/ok/claim-broken.silicon.ok delete mode 100644 test/viper/ok/claim-broken.silicon.ret.ok delete mode 100644 test/viper/ok/claim-simple.silicon.ok delete mode 100644 test/viper/ok/claim-simple.silicon.ret.ok delete mode 100644 test/viper/ok/claim.silicon.ok delete mode 100644 test/viper/ok/claim.silicon.ret.ok diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 7ef53df74b5..60e98c362c4 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -33,8 +33,8 @@ and pp_item ppf i = pp_pres pres pp_posts posts pp_block_opt bo - | InvariantI (s, e) -> (* TODO: srcloc mapping *) - fprintf ppf "@[<2>define %s(self) (%a)@]" s pp_exp e + | InvariantI (inv_name, e) -> (* TODO: srcloc mapping *) + fprintf ppf "@[<2>define %s($Self) (%a)@]" inv_name pp_exp e and pp_block_opt ppf = function | None -> () @@ -117,6 +117,16 @@ and pp_exp ppf exp = | Implies _ -> "==>" | OrE _ -> "||" | AndE _ -> "&&" | _ -> failwith "not a binary operator" in fprintf ppf "(%a %s %a)" pp_exp e1 op pp_exp e2 + | PermE p -> pp_perm ppf p + | AccE (fldacc, perm) -> fprintf ppf "@[acc(%a,%a)@]" pp_fldacc fldacc pp_exp perm + | _ -> fprintf ppf "@[// pretty printer not implemented for node at %s@]" (string_of_region exp.at) + +and pp_perm ppf perm = + match perm.it with + | NoP -> fprintf ppf "none" + | FullP -> fprintf ppf "write" + | WildcardP -> fprintf ppf "wildcard" + | FractionalP (a, b) -> fprintf ppf "@[(%a/%a)@]" pp_exp a pp_exp b and pp_stmt ppf stmt = marks := stmt.at :: !marks; diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index f4d35f94ee3..3862a44ddf5 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -42,18 +42,17 @@ and exp' = | OrE of exp * exp | Implies of exp * exp | FldAcc of fldacc - | PermExp of perm + | PermE of perm (* perm_amount *) + | AccE of fldacc * exp (* acc((rcvr: exp).field, (exp: perm_amount)) *) | MacroCall of string * exp and perm = (perm', info) Source.annotated_phrase and perm' = - | WildcardP - | FullP - | NoP - | EpsilonP -(* | FractionalP of exp * exp | ...*) - + | NoP (* 0 / 1 *) + | FullP (* 1 / 1 *) + | WildcardP (* 1 / N for some N *) + | FractionalP of exp * exp (* (a: exp) / (b: exp) *) and invariants = exp list diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 14c8eb7016a..2bf71607ce4 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -36,16 +36,6 @@ let rec extract_invariants : item list -> (par -> invariants -> invariants) = fu ; note = NoInfo } :: extract_invariants p self es | _ :: p -> extract_invariants p -let rec adorn_invariants (is : par -> invariants -> invariants) = function - | [] -> [] - | { it = MethodI (d, (self :: _ as i), o, r, e, b); _ } as m :: p -> - let pre_is = function - | "__init__" -> fun _ l -> l - | _ -> is in - let m = { m with it = MethodI (d, i, o, pre_is d.it self r, is self e, b) } in - m :: adorn_invariants is p - | i :: p -> i :: adorn_invariants is p - let rec unit (u : M.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with @@ -55,7 +45,37 @@ let rec unit (u : M.comp_unit) : prog = let is' = List.map (fun mk_i -> mk_i ctxt') mk_is in let init_id = id_at "__init__" Source.no_region in let self_id = id_at "$Self" Source.no_region in + let self_typ = { it = RefT; at = self_id.at; note = NoInfo } in let ctxt'' = { ctxt' with self = Some self_id.it } in + let perms = List.map (fun (id, _) -> fun (at : region) -> + AccE( + (self ctxt'' at, id), + { at; + it = PermE { + at; + it = FullP; + note = NoInfo + }; + note = NoInfo + } + )) inits in + let perm = fun (at : region) -> + { at; + it = List.fold_left + (fun pexp -> fun p_fn -> AndE( + { at; + it = pexp; + note = NoInfo + }, + { at; + it = (p_fn at); + note = NoInfo + })) + (BoolLitE true) + perms; + note = NoInfo + } in + (* Add initializer *) let init_list = List.map (fun (id, init) -> { at = { left = id.at.left; right = init.at.right }; it = FieldAssignS((self ctxt'' init.at, id), exp ctxt'' init); @@ -66,19 +86,37 @@ let rec unit (u : M.comp_unit) : prog = it = [], init_list; note = NoInfo } in - let m = - { it = MethodI(init_id, [ - self_id, { it = RefT; at = self_id.at; note = NoInfo } - ], [], [], [], Some init_body); + let init_m = + { it = MethodI(init_id, [self_id, self_typ], [], [], [], Some init_body); at = no_region; note = NoInfo } in - let is = m :: is' in - let invs = extract_invariants is in - { it = adorn_invariants invs is; - at = body.at; - note = NoInfo - } + let is'' = init_m :: is' in + (* Add permissions *) + let is''' = List.map (fun {it; at; note: info} -> ( + match it with + | MethodI (id, ins, outs, pres, posts, body) -> + { at; + it = MethodI (id, ins, outs, (perm at)::pres, (perm at)::posts, body); + note + } + | _ -> {it; at; note} + )) is'' in + (* Add functional invariants *) + let invs = extract_invariants is''' (self_id, self_typ) [] in + let is = List.map (fun {it; at; note: info} -> + match it with + | MethodI (id, ins, outs, pres, posts, body) -> + { at; + it = MethodI(id, ins, outs, (if id.it = init_id.it then pres else List.append pres invs), List.append posts invs, body); + note + } + | _ -> {it; at; note} + ) is''' in + { it = is; + at = body.at; + note = NoInfo + } | _ -> assert false and dec_fields (ctxt : ctxt) (ds : M.dec_field list) = @@ -124,8 +162,8 @@ and dec_field' ctxt d = | M.(ExpD { it = AssertE e; at; _ }) -> ctxt, None, - fun ctxt' -> - InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "self" } e), NoInfo + fun ctxt' -> + InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "$Self" } e), NoInfo | _ -> fail (Mo_def.Arrange.dec d.M.dec) (* diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok deleted file mode 100644 index f5c2ba08b03..00000000000 --- a/test/viper/ok/claim-broken.silicon.ok +++ /dev/null @@ -1,2 +0,0 @@ - [0] Assignment might fail. There might be insufficient permission to access $Self.claimed (claim-broken.vpr@3.6--3.30) - [1] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim-broken.vpr@10.10--10.26) diff --git a/test/viper/ok/claim-broken.silicon.ret.ok b/test/viper/ok/claim-broken.silicon.ret.ok deleted file mode 100644 index 69becfa16f9..00000000000 --- a/test/viper/ok/claim-broken.silicon.ret.ok +++ /dev/null @@ -1 +0,0 @@ -Return code 1 diff --git a/test/viper/ok/claim-broken.vpr.ok b/test/viper/ok/claim-broken.vpr.ok index a76ca0e4ba4..80ea392bbd8 100644 --- a/test/viper/ok/claim-broken.vpr.ok +++ b/test/viper/ok/claim-broken.vpr.ok @@ -1,11 +1,15 @@ -method __init__($Self: Ref) +method __init__($Self: Ref) + requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) { ($Self).claimed := false ($Self).count := 0 } field claimed: Bool field count: Int -method claim($Self: Ref) +method claim($Self: Ref) + requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) { if (!($Self).claimed) { diff --git a/test/viper/ok/claim-simple.silicon.ok b/test/viper/ok/claim-simple.silicon.ok deleted file mode 100644 index cf1b75bf84b..00000000000 --- a/test/viper/ok/claim-simple.silicon.ok +++ /dev/null @@ -1,2 +0,0 @@ - [0] Assignment might fail. There might be insufficient permission to access $Self.claimed (claim-simple.vpr@3.6--3.30) - [1] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim-simple.vpr@10.10--10.26) diff --git a/test/viper/ok/claim-simple.silicon.ret.ok b/test/viper/ok/claim-simple.silicon.ret.ok deleted file mode 100644 index 69becfa16f9..00000000000 --- a/test/viper/ok/claim-simple.silicon.ret.ok +++ /dev/null @@ -1 +0,0 @@ -Return code 1 diff --git a/test/viper/ok/claim-simple.vpr.ok b/test/viper/ok/claim-simple.vpr.ok index db9f926edc5..0126b83530e 100644 --- a/test/viper/ok/claim-simple.vpr.ok +++ b/test/viper/ok/claim-simple.vpr.ok @@ -1,11 +1,15 @@ -method __init__($Self: Ref) +method __init__($Self: Ref) + requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) { ($Self).claimed := false ($Self).count := 0 } field claimed: Bool field count: Int -method claim($Self: Ref) +method claim($Self: Ref) + requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) { if (!($Self).claimed) { diff --git a/test/viper/ok/claim.silicon.ok b/test/viper/ok/claim.silicon.ok deleted file mode 100644 index a1f650bfc66..00000000000 --- a/test/viper/ok/claim.silicon.ok +++ /dev/null @@ -1,2 +0,0 @@ - [0] Assignment might fail. There might be insufficient permission to access $Self.claimed (claim.vpr@3.6--3.30) - [1] Conditional statement might fail. There might be insufficient permission to access $Self.claimed (claim.vpr@10.10--10.26) diff --git a/test/viper/ok/claim.silicon.ret.ok b/test/viper/ok/claim.silicon.ret.ok deleted file mode 100644 index 69becfa16f9..00000000000 --- a/test/viper/ok/claim.silicon.ret.ok +++ /dev/null @@ -1 +0,0 @@ -Return code 1 diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok index 06a07f630d9..232ba195fb0 100644 --- a/test/viper/ok/claim.vpr.ok +++ b/test/viper/ok/claim.vpr.ok @@ -1,11 +1,15 @@ -method __init__($Self: Ref) +method __init__($Self: Ref) + requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) { ($Self).claimed := false ($Self).count := 0 } field claimed: Bool field count: Int -method claim($Self: Ref) +method claim($Self: Ref) + requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) { if (!($Self).claimed) { diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok index d59e22287f1..72b10251123 100644 --- a/test/viper/ok/invariant.silicon.ok +++ b/test/viper/ok/invariant.silicon.ok @@ -1,2 +1 @@ - [0] Contract might not be well-formed. There might be insufficient permission to access $Self.claimed (invariant.vpr@2.11--2.29) - [1] Contract might not be well-formed. There might be insufficient permission to access $Self.claimed (invariant.vpr@13.12--13.30) + [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@5.11--5.29) diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index 6f78cf49f87..b29e5effcdc 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -1,4 +1,6 @@ -method __init__($Self: Ref) +method __init__($Self: Ref) + requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) ensures invariant_7($Self) ensures invariant_8($Self) { @@ -7,11 +9,13 @@ method __init__($Self: Ref) } field claimed: Bool field count: Int -define invariant_7(self) (((((self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) -define invariant_8(self) (((self).count > 0)) +define invariant_7($Self) ((((($Self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) +define invariant_8($Self) ((($Self).count > 0)) method claim($Self: Ref) + requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) requires invariant_7($Self) requires invariant_8($Self) + ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) ensures invariant_7($Self) ensures invariant_8($Self) { From fcce5110742fcb9d583e2bc9ff71862a95f07eed Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Thu, 20 Oct 2022 23:38:37 +0200 Subject: [PATCH 31/81] viper: assertions (#3499) This adds the various kinds of static assertions to the Motoko grammar. - `assert:invariant` followed by a boolean expression is an actor invariant We don't have dedicated Motoko syntax yet, so they are just Motoko statements. See `test/viper/ok/invariant.vpr.ok` how they get pretty-printed on the Viper side. - `assert:func` followed by a boolean expression is a precondition to the enclosing `func` (only inputs and globals should be referenced) - `assert:return` is a postcondition (only inputs, results and globals should be referenced) Also adds Motoko operator `implies`, (which translates to Viper `==>`). --- emacs/motoko-mode.el | 2 ++ src/ir_def/construct.ml | 1 + src/ir_def/construct.mli | 1 + src/lowering/desugar.ml | 4 +++- src/mo_def/arrange.ml | 9 ++++++++- src/mo_def/syntax.ml | 6 +++++- src/mo_frontend/assertions.mly | 23 +++++++++++++++++++++++ src/mo_frontend/definedness.ml | 3 ++- src/mo_frontend/dune | 3 ++- src/mo_frontend/effect.ml | 3 ++- src/mo_frontend/error_reporting.ml | 2 ++ src/mo_frontend/parser.mly | 13 ++++++++----- src/mo_frontend/printers.ml | 2 ++ src/mo_frontend/source_lexer.mll | 2 ++ src/mo_frontend/source_token.ml | 6 ++++++ src/mo_frontend/traversals.ml | 4 +++- src/mo_frontend/typing.ml | 10 ++++++++-- src/mo_interpreter/interpret.ml | 9 ++++++++- src/viper/pretty.ml | 6 ++++++ src/viper/syntax.ml | 2 ++ src/viper/trans.ml | 19 +++++++++++++++++-- test/viper/invariant.mo | 7 +++++-- test/viper/ok/invariant.vpr.ok | 8 +++++++- 23 files changed, 125 insertions(+), 20 deletions(-) create mode 100644 src/mo_frontend/assertions.mly diff --git a/emacs/motoko-mode.el b/emacs/motoko-mode.el index 19f25a2cc72..c3fc3412d04 100644 --- a/emacs/motoko-mode.el +++ b/emacs/motoko-mode.el @@ -72,6 +72,8 @@ "var" "while" "prim" + "invariant" + "implies" )) ;; Braces introduce blocks; it's nice to make them stand ;; out more than ordinary symbols diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml index e00c444250b..faa91680c22 100644 --- a/src/ir_def/construct.ml +++ b/src/ir_def/construct.ml @@ -321,6 +321,7 @@ let notE : Ir.exp -> Ir.exp = fun e -> primE (RelPrim (T.bool, Operator.EqOp)) [e; falseE ()] let andE : Ir.exp -> Ir.exp -> Ir.exp = fun e1 e2 -> ifE e1 e2 (falseE ()) T.bool let orE : Ir.exp -> Ir.exp -> Ir.exp = fun e1 e2 -> ifE e1 (trueE ()) e2 T.bool +let impliesE : Ir.exp -> Ir.exp -> Ir.exp = fun e1 e2 -> orE (notE e1) e2 let rec conjE : Ir.exp list -> Ir.exp = function | [] -> trueE () | [x] -> x diff --git a/src/ir_def/construct.mli b/src/ir_def/construct.mli index 4692835dc1f..91cfbfc6419 100644 --- a/src/ir_def/construct.mli +++ b/src/ir_def/construct.mli @@ -97,6 +97,7 @@ val trueE : unit -> exp val notE : exp -> exp val andE : exp -> exp -> exp val orE : exp -> exp -> exp +val impliesE : exp -> exp -> exp val conjE : exp list -> exp val declare_idE : id -> typ -> exp -> exp diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml index 08e78ffaa1e..177944ed0b2 100644 --- a/src/lowering/desugar.ml +++ b/src/lowering/desugar.ml @@ -201,6 +201,7 @@ and exp' at note = function | S.NotE e -> (notE (exp e)).it | S.AndE (e1, e2) -> (andE (exp e1) (exp e2)).it | S.OrE (e1, e2) -> (orE (exp e1) (exp e2)).it + | S.ImpliesE (e1, e2) -> (impliesE (exp e1) (exp e2)).it | S.IfE (e1, e2, e3) -> I.IfE (exp e1, exp e2, exp e3) | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs) | S.TryE (e1, cs) -> I.TryE (exp e1, cases cs) @@ -222,7 +223,8 @@ and exp' at note = function | T.Async (t, _) -> t | _ -> assert false) | S.AwaitE e -> I.PrimE (I.AwaitPrim, [exp e]) - | S.AssertE e -> I.PrimE (I.AssertPrim, [exp e]) + | S.AssertE (Runtime, e) -> I.PrimE (I.AssertPrim, [exp e]) + | S.AssertE (_, e) -> (unitE ()).it | S.AnnotE (e, _) -> assert false | S.ImportE (f, ir) -> raise (Invalid_argument (Printf.sprintf "Import expression found in unit body: %s" f)) | S.PrimE s -> raise (Invalid_argument ("Unapplied prim " ^ s)) diff --git a/src/mo_def/arrange.ml b/src/mo_def/arrange.ml index 993021ed5fc..59200e63754 100644 --- a/src/mo_def/arrange.ml +++ b/src/mo_def/arrange.ml @@ -45,6 +45,7 @@ let rec exp e = match e.it with | NotE e -> "NotE" $$ [exp e] | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] + | ImpliesE (e1, e2) -> "ImpliesE"$$ [exp e1; exp e2] | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] @@ -57,7 +58,13 @@ let rec exp e = match e.it with | RetE e -> "RetE" $$ [exp e] | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] | AwaitE e -> "AwaitE" $$ [exp e] - | AssertE e -> "AssertE" $$ [exp e] + | AssertE (Runtime, e) -> "AssertE" $$ [exp e] + | AssertE (Invariant, e) -> "Invariant" $$ [exp e] + | AssertE (Precondition, e) -> "Precondition" $$ [exp e] + | AssertE (Postcondition, e) -> "Postcondition" $$ [exp e] + | AssertE (Loop_entry, e) -> "Loop_entry" $$ [exp e] + | AssertE (Loop_continue, e) -> "Loop_continue" $$ [exp e] + | AssertE (Loop_exit, e) -> "Loop_exit" $$ [exp e] | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] | OptE e -> "OptE" $$ [exp e] | DoOptE e -> "DoOptE" $$ [exp e] diff --git a/src/mo_def/syntax.ml b/src/mo_def/syntax.ml index 69b445bcdd8..5794819fef0 100644 --- a/src/mo_def/syntax.ml +++ b/src/mo_def/syntax.ml @@ -173,6 +173,7 @@ and exp' = | NotE of exp (* negation *) | AndE of exp * exp (* conjunction *) | OrE of exp * exp (* disjunction *) + | ImpliesE of exp * exp (* implication *) | IfE of exp * exp * exp (* conditional *) | SwitchE of exp * case list (* switch *) | WhileE of exp * exp (* while-do loop *) @@ -184,7 +185,7 @@ and exp' = | DebugE of exp (* debugging *) | AsyncE of typ_bind * exp (* async *) | AwaitE of exp (* await *) - | AssertE of exp (* assertion *) + | AssertE of assert_kind * exp (* assertion *) | AnnotE of exp * typ (* type annotation *) | ImportE of (string * resolved_import ref) (* import statement *) | ThrowE of exp (* throw exception *) @@ -195,6 +196,9 @@ and exp' = | AtomE of string (* atom *) *) +and assert_kind = + | Runtime | Invariant | Precondition | Postcondition | Loop_entry | Loop_continue | Loop_exit + and dec_field = dec_field' Source.phrase and dec_field' = {dec : dec; vis : vis; stab: stab option} diff --git a/src/mo_frontend/assertions.mly b/src/mo_frontend/assertions.mly new file mode 100644 index 00000000000..cb66647c569 --- /dev/null +++ b/src/mo_frontend/assertions.mly @@ -0,0 +1,23 @@ +%token INVARIANT +(* I get +> Error: 54 states have shift/reduce conflicts. +when I write this here (instead of in parser.mly) + +%token IMPLIES +%nonassoc IMPLIES +*) +%% + +%public exp_bin(B) : + | e1=exp_bin(B) IMPLIES e2=exp_bin(ob) + { ImpliesE(e1, e2) @? at $sloc } + +%public exp_nondec(B) : + | ASSERT COLON INVARIANT e=exp_nest + { AssertE(Invariant, e) @? at $sloc } + | ASSERT COLON FUNC e=exp_nest + { AssertE(Precondition, e) @? at $sloc } + | ASSERT COLON RETURN e=exp_nest + { AssertE(Postcondition, e) @? at $sloc } + +%% diff --git a/src/mo_frontend/definedness.ml b/src/mo_frontend/definedness.ml index 6ecdeeb72a1..2328089a5f6 100644 --- a/src/mo_frontend/definedness.ml +++ b/src/mo_frontend/definedness.ml @@ -113,6 +113,7 @@ let rec exp msgs e : f = match e.it with | NotE e -> exp msgs e | AndE (e1, e2) -> exps msgs [e1; e2] | OrE (e1, e2) -> exps msgs [e1; e2] + | ImpliesE (e1, e2) -> exps msgs [e1; e2] | IfE (e1, e2, e3) -> exps msgs [e1; e2; e3] | SwitchE (e, cs) -> exp msgs e ++ cases msgs cs | TryE (e, cs) -> exp msgs e ++ cases msgs cs @@ -124,7 +125,7 @@ let rec exp msgs e : f = match e.it with | DebugE e -> exp msgs e | AsyncE (_, e) -> exp msgs e | AwaitE e -> exp msgs e - | AssertE e -> exp msgs e + | AssertE (_, e) -> exp msgs e | AnnotE (e, t) -> exp msgs e | OptE e -> exp msgs e | DoOptE e -> exp msgs e diff --git a/src/mo_frontend/dune b/src/mo_frontend/dune index 7ed50b1a97a..fc19593f91e 100644 --- a/src/mo_frontend/dune +++ b/src/mo_frontend/dune @@ -4,7 +4,8 @@ (instrumentation (backend bisect_ppx --bisect-silent yes)) ) (menhir - (modules parser) + (modules parser assertions) + (merge_into parser) (flags --table --inspection -v --strict) (infer true) ) diff --git a/src/mo_frontend/effect.ml b/src/mo_frontend/effect.ml index d5276bbb705..55c24816d32 100644 --- a/src/mo_frontend/effect.ml +++ b/src/mo_frontend/effect.ml @@ -49,7 +49,7 @@ let rec infer_effect_exp (exp:Syntax.exp) : T.eff = | TagE (_, exp1) | DotE (exp1, _) | NotE exp1 - | AssertE exp1 + | AssertE (_, exp1) | LabelE (_, _, exp1) | BreakE (_, exp1) | RetE exp1 @@ -64,6 +64,7 @@ let rec infer_effect_exp (exp:Syntax.exp) : T.eff = | CallE (exp1, _, exp2) | AndE (exp1, exp2) | OrE (exp1, exp2) + | ImpliesE (exp1, exp2) | WhileE (exp1, exp2) | LoopE (exp1, Some exp2) | ForE (_, exp1, exp2) -> diff --git a/src/mo_frontend/error_reporting.ml b/src/mo_frontend/error_reporting.ml index a62aba376e1..0f8afd5b6c4 100644 --- a/src/mo_frontend/error_reporting.ml +++ b/src/mo_frontend/error_reporting.ml @@ -116,8 +116,10 @@ let terminal2token (type a) (symbol : a terminal) : token = | T_ANDOP -> ANDOP | T_ANDASSIGN -> ANDASSIGN | T_AND -> AND + | T_IMPLIES -> IMPLIES | T_ADDOP -> ADDOP | T_ACTOR -> ACTOR + | T_INVARIANT -> INVARIANT | T_WRAPADDOP -> WRAPADDOP | T_WRAPSUBOP -> WRAPSUBOP | T_WRAPMULOP -> WRAPMULOP diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly index e4be5f7abf5..9611b455e14 100644 --- a/src/mo_frontend/parser.mly +++ b/src/mo_frontend/parser.mly @@ -236,6 +236,9 @@ and objblock s dec_fields = %token PRIM %token UNDERSCORE +%token IMPLIES +%nonassoc IMPLIES + %nonassoc RETURN_NO_ARG IF_NO_ELSE LOOP_NO_WHILE %nonassoc ELSE WHILE @@ -550,7 +553,7 @@ lit : bl : DISALLOWED { PrimE("dummy") @? at $sloc } -ob : e=exp_obj { e } +%public ob : e=exp_obj { e } exp_obj : | LCURLY efs=seplist(exp_field, semicolon) RCURLY @@ -625,7 +628,7 @@ exp_un(B) : | FROM_CANDID e=exp_un(ob) { FromCandidE e @? at $sloc } -exp_bin(B) : +%public exp_bin(B) : | e=exp_un(B) { e } | e1=exp_bin(B) op=binop e2=exp_bin(ob) @@ -639,7 +642,7 @@ exp_bin(B) : | e=exp_bin(B) COLON t=typ_nobin { AnnotE(e, t) @? at $sloc } -exp_nondec(B) : +%public exp_nondec(B) : | e=exp_bin(B) { e } | e1=exp_bin(B) ASSIGN e2=exp(ob) @@ -655,7 +658,7 @@ exp_nondec(B) : | AWAIT e=exp_nest { AwaitE(e) @? at $sloc } | ASSERT e=exp_nest - { AssertE(e) @? at $sloc } + { AssertE(Runtime, e) @? at $sloc } | LABEL x=id rt=annot_opt e=exp_nest { let x' = ("continue " ^ x.it) @@ x.at in let unit () = TupT [] @! at $sloc in @@ -717,7 +720,7 @@ exp(B) : | d=dec_var { match d.it with ExpD e -> e | _ -> BlockE([d]) @? at $sloc } -exp_nest : +%public exp_nest : | e=block { e } | e=exp(bl) diff --git a/src/mo_frontend/printers.ml b/src/mo_frontend/printers.ml index 12e16596ba0..f8bb52ed9d3 100644 --- a/src/mo_frontend/printers.ml +++ b/src/mo_frontend/printers.ml @@ -131,8 +131,10 @@ let string_of_symbol = function | X (T T_ANDOP) -> binop "&" | X (T T_ANDASSIGN) -> binassign "&=" | X (T T_AND) -> "and" + | X (T T_IMPLIES) -> "implies" | X (T T_ADDOP) -> unop "+" | X (T T_ACTOR) -> "actor" + | X (T T_INVARIANT) -> "invariant" (* non-terminals *) | X (N N_bl) -> "" | X (N N_case) -> "" diff --git a/src/mo_frontend/source_lexer.mll b/src/mo_frontend/source_lexer.mll index 94ce6245a01..08d082d10e9 100644 --- a/src/mo_frontend/source_lexer.mll +++ b/src/mo_frontend/source_lexer.mll @@ -212,6 +212,8 @@ rule token mode = parse | "if" { IF } | "ignore" { IGNORE } | "in" { IN } + | "invariant" { INVARIANT } + | "implies" { IMPLIES } | "import" { IMPORT } | "module" { MODULE } | "not" { NOT } diff --git a/src/mo_frontend/source_token.ml b/src/mo_frontend/source_token.ml index ae4ee7942f6..ffb647e68e1 100644 --- a/src/mo_frontend/source_token.ml +++ b/src/mo_frontend/source_token.ml @@ -55,6 +55,7 @@ type token = | BANG | AND | OR + | IMPLIES | NOT | IMPORT | MODULE @@ -114,6 +115,7 @@ type token = | TEXT of string | PRIM | UNDERSCORE + | INVARIANT (* Trivia *) | LINEFEED of line_feed | SINGLESPACE @@ -177,6 +179,7 @@ let to_parser_token : | BANG -> Ok Parser.BANG | AND -> Ok Parser.AND | OR -> Ok Parser.OR + | IMPLIES -> Ok Parser.IMPLIES | NOT -> Ok Parser.NOT | IMPORT -> Ok Parser.IMPORT | MODULE -> Ok Parser.MODULE @@ -236,6 +239,7 @@ let to_parser_token : | TEXT s -> Ok (Parser.TEXT s) | PRIM -> Ok Parser.PRIM | UNDERSCORE -> Ok Parser.UNDERSCORE + | INVARIANT -> Ok Parser.INVARIANT (*Trivia *) | SINGLESPACE -> Error (Space 1) | SPACE n -> Error (Space n) @@ -361,6 +365,8 @@ let string_of_parser_token = function | Parser.TEXT _ -> "TEXT of string" | Parser.PRIM -> "PRIM" | Parser.UNDERSCORE -> "UNDERSCORE" + | Parser.INVARIANT -> "INVARIANT" + | Parser.IMPLIES -> "IMPLIES" let is_lineless_trivia : token -> void trivia option = function | SINGLESPACE -> Some (Space 1) diff --git a/src/mo_frontend/traversals.ml b/src/mo_frontend/traversals.ml index 62564713e8d..86ba96bd143 100644 --- a/src/mo_frontend/traversals.ml +++ b/src/mo_frontend/traversals.ml @@ -15,7 +15,7 @@ let rec over_exp (f : exp -> exp) (exp : exp) : exp = match exp.it with | TagE (x, exp1) -> f { exp with it = TagE (x, over_exp f exp1) } | DotE (exp1, x) -> f { exp with it = DotE (over_exp f exp1, x) } | NotE exp1 -> f { exp with it = NotE (over_exp f exp1) } - | AssertE exp1 -> f { exp with it = AssertE (over_exp f exp1) } + | AssertE (how, exp1) -> f { exp with it = AssertE (how, over_exp f exp1) } | LabelE (x, y, exp1) -> f { exp with it = LabelE (x, y, over_exp f exp1) } | BreakE (x, exp1) -> f { exp with it = BreakE (x, over_exp f exp1) } | RetE exp1 -> f { exp with it = RetE (over_exp f exp1) } @@ -37,6 +37,8 @@ let rec over_exp (f : exp -> exp) (exp : exp) : exp = match exp.it with f { exp with it = AndE (over_exp f exp1, over_exp f exp2) } | OrE (exp1, exp2) -> f { exp with it = OrE (over_exp f exp1, over_exp f exp2) } + | ImpliesE (exp1, exp2) -> + f { exp with it = ImpliesE (over_exp f exp1, over_exp f exp2) } | WhileE (exp1, exp2) -> f { exp with it = WhileE (over_exp f exp1, over_exp f exp2) } | LoopE (exp1, exp2_opt) -> diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml index 9aadf3eb6bb..22492408ce7 100644 --- a/src/mo_frontend/typing.ml +++ b/src/mo_frontend/typing.ml @@ -745,7 +745,7 @@ let rec is_explicit_exp e = | BreakE _ | RetE _ | ThrowE _ -> false | VarE _ - | RelE _ | NotE _ | AndE _ | OrE _ | ShowE _ | ToCandidE _ | FromCandidE _ + | RelE _ | NotE _ | AndE _ | OrE _ | ImpliesE _ | ShowE _ | ToCandidE _ | FromCandidE _ | AssignE _ | IgnoreE _ | AssertE _ | DebugE _ | WhileE _ | ForE _ | AnnotE _ | ImportE _ -> @@ -1293,6 +1293,12 @@ and infer_exp'' env exp : T.typ = check_exp_strong env T.bool exp2 end; T.bool + | ImpliesE (exp1, exp2) -> + if not env.pre then begin + check_exp_strong env T.bool exp1; + check_exp_strong env T.bool exp2 + end; + T.bool | IfE (exp1, exp2, exp3) -> if not env.pre then check_exp_strong env T.bool exp1; let t2 = infer_exp env exp2 in @@ -1429,7 +1435,7 @@ and infer_exp'' env exp : T.typ = "expected async type, but expression has type%a" display_typ_expand t1 ) - | AssertE exp1 -> + | AssertE (_, exp1) -> if not env.pre then check_exp_strong env T.bool exp1; T.unit | AnnotE (exp1, typ) -> diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml index abbfee7bb9a..ac84d5c085e 100644 --- a/src/mo_interpreter/interpret.ml +++ b/src/mo_interpreter/interpret.ml @@ -545,6 +545,12 @@ and interpret_exp_mut env exp (k : V.value V.cont) = then k v1 else interpret_exp env exp2 k ) + | ImpliesE (exp1, exp2) -> + interpret_exp env exp1 (fun v1 -> + interpret_exp env exp2 (fun v2 -> + k V.(Bool (as_bool v1 <= as_bool v2)) + ) + ) | IfE (exp1, exp2, exp3) -> interpret_exp env exp1 (fun v1 -> if V.as_bool v1 @@ -619,12 +625,13 @@ and interpret_exp_mut env exp (k : V.value V.cont) = | AwaitE exp1 -> interpret_exp env exp1 (fun v1 -> await env exp.at (V.as_async v1) k) - | AssertE exp1 -> + | AssertE (Runtime, exp1) -> interpret_exp env exp1 (fun v -> if V.as_bool v then k V.unit else trap exp.at "assertion failure" ) + | AssertE (_, exp1) -> k V.unit | AnnotE (exp1, _typ) -> interpret_exp env exp1 k | IgnoreE exp1 -> diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 60e98c362c4..17f105e6526 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -152,6 +152,12 @@ and pp_stmt' ppf = function fprintf ppf "@[%a := %a@]" pp_fldacc fldacc pp_exp exp2 + | PreconditionS(exp) -> + fprintf ppf "@[/*requires %a*/@]" + pp_exp exp + | PostconditionS(exp) -> + fprintf ppf "@[/*ensures %a*/@]" + pp_exp exp and pp_fldacc ppf fldacc = match fldacc with diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index 3862a44ddf5..c7c9a994bc5 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -72,6 +72,8 @@ and stmt' = | IfS of exp * seqn * seqn | WhileS of exp * invariants * seqn | LabelS of id * invariants + | PreconditionS of exp + | PostconditionS of exp and typ = (typ', info) Source.annotated_phrase diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 2bf71607ce4..4e3e2ef7be6 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -157,9 +157,12 @@ and dec_field' ctxt d = let self_id = id_at "$Self" Source.no_region in let ctxt'' = { ctxt' with self = Some self_id.it } in (* TODO: add args (and rets?) *) - (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, [], [], Some (stmt ctxt'' e)), + let stmts = stmt ctxt'' e in + let pres, stmts' = List.partition_map (function { it = PreconditionS exp; _ } -> Left exp | s -> Right s) (snd stmts.it) in + let posts, stmts' = List.partition_map (function { it = PostconditionS exp; _ } -> Left exp | s -> Right s) stmts' in + (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, pres, posts, Some { stmts with it = fst stmts.it, stmts' } ), NoInfo) - | M.(ExpD { it = AssertE e; at; _ }) -> + | M.(ExpD { it = AssertE (Invariant, e); at; _ }) -> ctxt, None, fun ctxt' -> @@ -280,6 +283,16 @@ and stmt ctxt (s : M.exp) : seqn = note = NoInfo } end | M.LitE e -> { it = [], []; at = s.at; note = NoInfo } + | M.AssertE (Precondition, e) -> + { it = [], + [ { it = PreconditionS (exp ctxt e); at = s.at; note = NoInfo } ]; + at = s.at; + note = NoInfo } + | M.AssertE (Postcondition, e) -> + { it = [], + [ { it = PostconditionS (exp ctxt e); at = s.at; note = NoInfo } ]; + at = s.at; + note = NoInfo } | _ -> fail (Mo_def.Arrange.exp s) (* @@ -355,6 +368,8 @@ and exp' ctxt (e : M.exp) = OrE (exp ctxt e1, exp ctxt e2), NoInfo | M.AndE (e1, e2) -> AndE (exp ctxt e1, exp ctxt e2), NoInfo + | M.ImpliesE (e1, e2) -> + Implies (exp ctxt e1, exp ctxt e2), NoInfo | _ -> fail (Mo_def.Arrange.exp e) (* | VarE x -> diff --git a/test/viper/invariant.mo b/test/viper/invariant.mo index 34b4922c8e1..3d357585862 100644 --- a/test/viper/invariant.mo +++ b/test/viper/invariant.mo @@ -4,10 +4,13 @@ actor { var count = 0 : Int; - assert claimed and not (-1 == -1) and (-42 == -42) or true; - assert count > 0; + assert:invariant claimed and not (-1 == -1) and (-42 == -42) or true; + assert:invariant count > 0; + assert:invariant not claimed implies count == 0; public shared func claim() : async () { + assert:func count >= 0; + assert:return count >= 0; }; } diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index b29e5effcdc..7a7b5147450 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -3,6 +3,7 @@ method __init__($Self: Ref) ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) ensures invariant_7($Self) ensures invariant_8($Self) + ensures invariant_9($Self) { ($Self).claimed := false ($Self).count := 0 @@ -11,12 +12,17 @@ field claimed: Bool field count: Int define invariant_7($Self) ((((($Self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) define invariant_8($Self) ((($Self).count > 0)) +define invariant_9($Self) (((!($Self).claimed) ==> (($Self).count == 0))) method claim($Self: Ref) requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + requires (($Self).count >= 0) requires invariant_7($Self) requires invariant_8($Self) + requires invariant_9($Self) ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) + ensures (($Self).count >= 0) ensures invariant_7($Self) - ensures invariant_8($Self) { + ensures invariant_8($Self) + ensures invariant_9($Self) { } From c62fa80028af9b18db2c5c85617130bf6d7a5c76 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 21 Oct 2022 10:00:46 +0100 Subject: [PATCH 32/81] experiment: viper await async ghost state (#3500) - adds await async await ghost variables and internal assertions - experiment with lighter weight helper for constructing internal nodes. --- src/viper/pretty.ml | 18 ++- src/viper/trans.ml | 177 ++++++++++++++++++-------- test/viper/ok/claim-broken.silicon.ok | 1 + test/viper/ok/claim-broken.vpr.ok | 38 ++++-- test/viper/ok/claim-simple.silicon.ok | 1 + test/viper/ok/claim-simple.vpr.ok | 19 ++- test/viper/ok/claim.silicon.ok | 1 + test/viper/ok/claim.vpr.ok | 36 ++++-- test/viper/ok/invariant.silicon.ok | 2 +- test/viper/ok/invariant.vpr.ok | 37 +++--- 10 files changed, 228 insertions(+), 102 deletions(-) create mode 100644 test/viper/ok/claim-broken.silicon.ok create mode 100644 test/viper/ok/claim-simple.silicon.ok create mode 100644 test/viper/ok/claim.silicon.ok diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 17f105e6526..4969f74f0e6 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -26,7 +26,7 @@ and pp_item ppf i = id.it pp_typ typ | MethodI (id, locals, rets, pres, posts, bo) -> - fprintf ppf "@[method %s%a@ %a@ %a@ %a@; %a@]" + fprintf ppf "@[method %s%a@; %a@; %a@; %a@; %a@]" id.it pp_locals locals pp_returns rets @@ -57,13 +57,13 @@ and pp_pres ppf exps = fprintf ppf "@[%a@]" (pp_print_list pp_pre) exps and pp_pre ppf exp = - fprintf ppf "requires @[<2>%a@]" pp_exp exp + fprintf ppf "@[requires %a@]" pp_exp exp and pp_posts ppf exps = fprintf ppf "@[%a@]" (pp_print_list pp_post) exps and pp_post ppf exp = - fprintf ppf "ensures @[<2>%a@]" pp_exp exp + fprintf ppf "@[ensures %a@]" pp_exp exp and pp_local ppf (id, typ) = fprintf ppf "@[<2>%s: %a@]" @@ -78,7 +78,7 @@ and pp_returns ppf pars = match pars with | [] -> () | _ -> - fprintf ppf "returns @[<1>(%a)@]" + fprintf ppf "@[<1> returns (%a)@]" (pp_print_list ~pp_sep:comma (pp_local)) pars and pp_typ ppf t = @@ -148,10 +148,16 @@ and pp_stmt' ppf = function fprintf ppf "@[%s := %a@]" id.it pp_exp exp - | FieldAssignS(fldacc, exp2) -> + | FieldAssignS(fldacc, exp) -> fprintf ppf "@[%a := %a@]" pp_fldacc fldacc - pp_exp exp2 + pp_exp exp + | InhaleS exp -> + fprintf ppf "@[inhale %a@]" + pp_exp exp + | ExhaleS exp -> + fprintf ppf "@[exhale %a@]" + pp_exp exp | PreconditionS(exp) -> fprintf ppf "@[/*requires %a*/@]" pp_exp exp diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 4e3e2ef7be6..0e8dfcaf7fa 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -1,28 +1,71 @@ open Source + open Syntax module T = Mo_types.Type module M = Mo_def.Syntax +module Stamps = Env.Make(String) + +let stamps : int Stamps.t ref = ref Stamps.empty + +let (!!!) at it = { it; at; note = NoInfo} + +let intLitE at i = + !!! at (IntLitE (Mo_values.Numerics.Int.of_int i)) + +let accE at fldacc = + !!! at + (AccE( + fldacc, + !!! at (PermE (!!! at FullP)))) + + +let conjoin es at = + match es with + | [] -> !!! at (BoolLitE true) + | e0::es0 -> + List.fold_left + (fun e1 -> fun e2 -> + !!! at (AndE(e1, e2))) + e0 + es0 + +let fresh_stamp name = + let n = Lib.Option.get (Stamps.find_opt name !stamps) 0 in + stamps := Stamps.add name (n + 1) !stamps; + n + +let fresh_id name = + let n = fresh_stamp name in + if n = 0 then + name + else Printf.sprintf "%s_%i" name (fresh_stamp name) + let fail sexp = failwith (Wasm.Sexpr.to_string 80 sexp) + type sort = Field | Local | Method module Env = T.Env type ctxt = { self : string option; - ids : sort T.Env.t + ids : sort T.Env.t; + ghost_items : (ctxt -> item) list ref; + ghost_inits : (ctxt -> stmt) list ref; + ghost_perms : (ctxt -> Source.region -> exp) list ref; + (* invariants : (ctxt -> exp) list ref; *) } let self ctxt at = match ctxt.self with | Some id -> { it = LocalVar ({ it = id; at; note = NoInfo}, { it = RefT; at; note = NoInfo }); - at; - note = NoInfo } + at; + note = NoInfo } | _ -> failwith "no self" let rec extract_invariants : item list -> (par -> invariants -> invariants) = function @@ -40,48 +83,35 @@ let rec unit (u : M.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with | M.ActorU(id_opt, decs) -> - let ctxt = { self = None; ids = Env.empty } in + let ctxt = { self = None; ids = Env.empty; ghost_items = ref []; ghost_inits = ref []; ghost_perms = ref [] } in let ctxt', inits, mk_is = dec_fields ctxt decs in let is' = List.map (fun mk_i -> mk_i ctxt') mk_is in + (* given is', compute ghost_is *) + let ghost_is = List.map (fun mk_i -> mk_i ctxt') !(ctxt.ghost_items) in let init_id = id_at "__init__" Source.no_region in let self_id = id_at "$Self" Source.no_region in let self_typ = { it = RefT; at = self_id.at; note = NoInfo } in let ctxt'' = { ctxt' with self = Some self_id.it } in let perms = List.map (fun (id, _) -> fun (at : region) -> - AccE( - (self ctxt'' at, id), - { at; - it = PermE { - at; - it = FullP; - note = NoInfo - }; - note = NoInfo - } - )) inits in - let perm = fun (at : region) -> - { at; - it = List.fold_left - (fun pexp -> fun p_fn -> AndE( - { at; - it = pexp; - note = NoInfo - }, - { at; - it = (p_fn at); - note = NoInfo - })) - (BoolLitE true) - perms; - note = NoInfo - } in + (accE at (self ctxt'' at, id))) inits in + let ghost_perms = List.map (fun mk_p -> fun at -> + mk_p ctxt'' at) !(ctxt.ghost_perms) in + let perm = + fun (at : region) -> + List.fold_left + (fun pexp -> fun p_fn -> + !!! at (AndE(pexp, p_fn at))) + (!!! at (BoolLitE true)) + (perms @ ghost_perms) + in (* Add initializer *) - let init_list = List.map (fun (id, init) -> + let init_list = List.map (fun (id, init) -> { at = { left = id.at.left; right = init.at.right }; it = FieldAssignS((self ctxt'' init.at, id), exp ctxt'' init); note = NoInfo }) inits in - let init_body = + let init_list = init_list @ List.map (fun mk_s -> mk_s ctxt'') !(ctxt.ghost_inits) in + let init_body = { at = body.at; (* ATG: Is this the correct position? *) it = [], init_list; note = NoInfo @@ -91,28 +121,37 @@ let rec unit (u : M.comp_unit) : prog = at = no_region; note = NoInfo } in + let is'' = init_m :: is' in (* Add permissions *) let is''' = List.map (fun {it; at; note: info} -> ( match it with | MethodI (id, ins, outs, pres, posts, body) -> - { at; - it = MethodI (id, ins, outs, (perm at)::pres, (perm at)::posts, body); - note - } - | _ -> {it; at; note} - )) is'' in + { at; + it = MethodI (id, ins, outs, + !!! at (MacroCall("$Perm", self ctxt'' at))::pres, + !!! at (MacroCall("$Perm", self ctxt'' at))::posts, body); + note + } + | _ -> {it; at; note})) is'' in (* Add functional invariants *) let invs = extract_invariants is''' (self_id, self_typ) [] in - let is = List.map (fun {it; at; note: info} -> + let is4 = List.map (fun {it; at; note: info} -> match it with | MethodI (id, ins, outs, pres, posts, body) -> { at; - it = MethodI(id, ins, outs, (if id.it = init_id.it then pres else List.append pres invs), List.append posts invs, body); + it = MethodI(id, ins, outs, + (if id.it = init_id.it + then pres + else pres @ [!!! at (MacroCall("$Inv", self ctxt'' at))]), + posts @ [!!! at (MacroCall("$Inv", self ctxt'' at))], + body); note } - | _ -> {it; at; note} - ) is''' in + | _ -> {it; at; note}) is''' in + let perm_def = !!! (body.at) (InvariantI("$Perm", perm body.at)) in + let inv_def = !!! (body.at) (InvariantI("$Inv", conjoin invs body.at)) in + let is = ghost_is @ (perm_def :: inv_def :: is4) in { it = is; at = body.at; note = NoInfo @@ -244,15 +283,51 @@ and stmt ctxt (s : M.exp) : seqn = note = NoInfo } ]); at = s.at; note = NoInfo } - | M.(AwaitE({ it = AsyncE (_, e); _ })) -> (* gross hack *) - { it = + | M.(AwaitE({ it = AsyncE (_, e); at;_ })) -> (* gross hack *) + let id' = fresh_id "$message_async" in + let id = { it = id'; at = Source.no_region; note = NoInfo } in + ctxt.ghost_items := + (fun ctxt -> + { it = FieldI (id, { it = IntT; at = Source.no_region; note = NoInfo }); at = Source.no_region; note = NoInfo }) :: + !(ctxt.ghost_items); + let mk_s = fun ctxt -> + { it = FieldAssignS( + (self ctxt Source.no_region, id), + intLitE (Source.no_region) 0); + at = Source.no_region; + note = NoInfo } + in + ctxt.ghost_inits := mk_s :: !(ctxt.ghost_inits); + let mk_p = fun ctxt at -> + accE at (self ctxt Source.no_region, id) + in + ctxt.ghost_perms := mk_p :: !(ctxt.ghost_perms); + let (!!) p = !!! at p in + !!! (s.at) ([], - (* TODO: add havoc etc *) - [ { it = SeqnS (stmt ctxt e); - at = s.at; - note = NoInfo } ]); - at = s.at; - note = NoInfo } + [ !!(FieldAssignS( + (self ctxt Source.no_region, id), + (!!(AddE(!!(FldAcc (self ctxt Source.no_region, id)), + intLitE Source.no_region 1))))); + !!(ExhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), + !!(MacroCall("$Inv", self ctxt at)))))); + !!(SeqnS ( + !!([], + [ + !!(InhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), + !!(AndE(!!(MacroCall("$Inv", self ctxt at)), + !!(GtCmpE(!!(FldAcc (self ctxt Source.no_region, id)), intLitE Source.no_region 0)))))))) + ; + !!(FieldAssignS( + (self ctxt Source.no_region, id), + (!!(SubE(!!(FldAcc (self ctxt at, id)), + intLitE Source.no_region 1))))); + !!! (e.at) (SeqnS (stmt ctxt e)); + !!(ExhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), + !!(MacroCall("$Inv", self ctxt at)))))) ]))); + !!(InhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), + !!(MacroCall("$Inv", self ctxt at)))))); + ]) | M.WhileE(e, s1) -> { it = ([], diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok new file mode 100644 index 00000000000..4af4e03fca5 --- /dev/null +++ b/test/viper/ok/claim-broken.silicon.ok @@ -0,0 +1 @@ +Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-broken.vpr@4.1) diff --git a/test/viper/ok/claim-broken.vpr.ok b/test/viper/ok/claim-broken.vpr.ok index 80ea392bbd8..b4c311300aa 100644 --- a/test/viper/ok/claim-broken.vpr.ok +++ b/test/viper/ok/claim-broken.vpr.ok @@ -1,21 +1,39 @@ -method __init__($Self: Ref) - requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) +field $message_async: Int +define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && + acc(($Self).$message_async,write))) +define $Inv($Self) (true) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) { ($Self).claimed := false - ($Self).count := 0 + ($Self).count := 0 + ($Self).$message_async := 0 } field claimed: Bool field count: Int -method claim($Self: Ref) - requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) +method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) { if (!($Self).claimed) { + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) { - ($Self).claimed := true - ($Self).count := 1 - } + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).claimed := true + ($Self).count := 1 + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) } } diff --git a/test/viper/ok/claim-simple.silicon.ok b/test/viper/ok/claim-simple.silicon.ok new file mode 100644 index 00000000000..c704b94e8c8 --- /dev/null +++ b/test/viper/ok/claim-simple.silicon.ok @@ -0,0 +1 @@ +Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-simple.vpr@2.1) diff --git a/test/viper/ok/claim-simple.vpr.ok b/test/viper/ok/claim-simple.vpr.ok index 0126b83530e..39011021883 100644 --- a/test/viper/ok/claim-simple.vpr.ok +++ b/test/viper/ok/claim-simple.vpr.ok @@ -1,15 +1,22 @@ -method __init__($Self: Ref) - requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) +define $Perm($Self) (((true && acc(($Self).claimed,write)) && acc(($Self).count,write))) +define $Inv($Self) (true) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) { ($Self).claimed := false ($Self).count := 0 } field claimed: Bool field count: Int -method claim($Self: Ref) - requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) +method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) { if (!($Self).claimed) { diff --git a/test/viper/ok/claim.silicon.ok b/test/viper/ok/claim.silicon.ok new file mode 100644 index 00000000000..5909e1f7a45 --- /dev/null +++ b/test/viper/ok/claim.silicon.ok @@ -0,0 +1 @@ +Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim.vpr@4.1) diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok index 232ba195fb0..815cfad29d9 100644 --- a/test/viper/ok/claim.vpr.ok +++ b/test/viper/ok/claim.vpr.ok @@ -1,21 +1,39 @@ -method __init__($Self: Ref) - requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) +field $message_async: Int +define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && + acc(($Self).$message_async,write))) +define $Inv($Self) (true) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) { ($Self).claimed := false - ($Self).count := 0 + ($Self).count := 0 + ($Self).$message_async := 0 } field claimed: Bool field count: Int -method claim($Self: Ref) - requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) +method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) { if (!($Self).claimed) { ($Self).claimed := true + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) { - ($Self).count := 1 - } + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).count := 1 + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) } } diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok index 72b10251123..1e255f267f3 100644 --- a/test/viper/ok/invariant.silicon.ok +++ b/test/viper/ok/invariant.silicon.ok @@ -1 +1 @@ - [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@5.11--5.29) + [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.12--7.23) diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index 7a7b5147450..c49268a42c9 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -1,9 +1,10 @@ -method __init__($Self: Ref) - requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures invariant_7($Self) - ensures invariant_8($Self) - ensures invariant_9($Self) +define $Perm($Self) (((true && acc(($Self).claimed,write)) && acc(($Self).count,write))) +define $Inv($Self) (((invariant_7($Self) && invariant_8($Self)) && invariant_9($Self))) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) { ($Self).claimed := false ($Self).count := 0 @@ -13,16 +14,14 @@ field count: Int define invariant_7($Self) ((((($Self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) define invariant_8($Self) ((($Self).count > 0)) define invariant_9($Self) (((!($Self).claimed) ==> (($Self).count == 0))) -method claim($Self: Ref) - requires ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - requires (($Self).count >= 0) - requires invariant_7($Self) - requires invariant_8($Self) - requires invariant_9($Self) - ensures ((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) - ensures (($Self).count >= 0) - ensures invariant_7($Self) - ensures invariant_8($Self) - ensures invariant_9($Self) { - - } +method claim($Self: Ref) + + requires $Perm($Self) + requires (($Self).count >= 0) + requires $Inv($Self) + ensures $Perm($Self) + ensures (($Self).count >= 0) + ensures $Inv($Self) + { + + } From 08c89414c850691104b707be851eb7a825dfaf5d Mon Sep 17 00:00:00 2001 From: Arshavir Ter-Gabrielyan Date: Fri, 21 Oct 2022 11:41:44 +0200 Subject: [PATCH 33/81] Add async constraint into test/viper/claim.mo accept --- test/viper/claim.mo | 7 ++++++- test/viper/ok/claim.silicon.ok | 2 +- test/viper/ok/claim.vpr.ok | 6 ++++-- 3 files changed, 11 insertions(+), 4 deletions(-) diff --git a/test/viper/claim.mo b/test/viper/claim.mo index 44b5c169c24..de247c7af2b 100644 --- a/test/viper/claim.mo +++ b/test/viper/claim.mo @@ -4,11 +4,16 @@ actor { var count = 0 : Int; + assert:invariant count == 0 or count == 1; + assert:invariant not claimed implies count == 0; + public shared func claim() : async () { if (not claimed) { claimed := true; + await async { - count := 1; + // TODO: assert:1:async (claimed and count == 0); + count += 1; }; }; }; diff --git a/test/viper/ok/claim.silicon.ok b/test/viper/ok/claim.silicon.ok index 5909e1f7a45..16935144ec1 100644 --- a/test/viper/ok/claim.silicon.ok +++ b/test/viper/ok/claim.silicon.ok @@ -1 +1 @@ -Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim.vpr@4.1) + [0] Exhale might fail. Assertion $Self.count == 0 || $Self.count == 1 might not hold. (claim.vpr@37.22--37.49) diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok index 815cfad29d9..0243144d8cf 100644 --- a/test/viper/ok/claim.vpr.ok +++ b/test/viper/ok/claim.vpr.ok @@ -1,7 +1,7 @@ field $message_async: Int define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && acc(($Self).$message_async,write))) -define $Inv($Self) (true) +define $Inv($Self) ((invariant_7($Self) && invariant_8($Self))) method __init__($Self: Ref) requires $Perm($Self) @@ -14,6 +14,8 @@ method __init__($Self: Ref) } field claimed: Bool field count: Int +define invariant_7($Self) (((($Self).count == 0) || (($Self).count == 1))) +define invariant_8($Self) (((!($Self).claimed) ==> (($Self).count == 0))) method claim($Self: Ref) requires $Perm($Self) @@ -30,7 +32,7 @@ method claim($Self: Ref) inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) ($Self).$message_async := (($Self).$message_async - 1) { - ($Self).count := 1 + ($Self).count := (($Self).count + 1) } exhale ($Perm($Self) && $Inv($Self)) } From 222b601ac8d5cdf0558373241cb81c85513c2a47 Mon Sep 17 00:00:00 2001 From: Arshavir Ter-Gabrielyan Date: Fri, 21 Oct 2022 11:44:29 +0200 Subject: [PATCH 34/81] Add manual encoding into test/viper/ok/claim.vpr.ok --- test/viper/ok/claim.vpr.ok | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok index 0243144d8cf..33c3e227cbb 100644 --- a/test/viper/ok/claim.vpr.ok +++ b/test/viper/ok/claim.vpr.ok @@ -1,7 +1,19 @@ field $message_async: Int define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && acc(($Self).$message_async,write))) -define $Inv($Self) ((invariant_7($Self) && invariant_8($Self))) + +define invariant_7($Self) ( + ((($Self).count == 0) || (($Self).count == 1)) +) +define invariant_8($Self) ( + ((!($Self).claimed) ==> (($Self).count == 0)) +) +define $Inv($Self) ( + (invariant_7($Self) && invariant_8($Self)) + && (0 <= ($Self).$message_async && ($Self).$message_async <= 1) + && (($Self).$message_async == 1 ==> $Self.claimed && $Self.count == 0) +) + method __init__($Self: Ref) requires $Perm($Self) @@ -38,4 +50,4 @@ method claim($Self: Ref) } inhale ($Perm($Self) && $Inv($Self)) } - } + } \ No newline at end of file From 44fb500157597c1f834ca481d5d76e187a195911 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 21 Oct 2022 12:19:51 +0100 Subject: [PATCH 35/81] fix tests to increment counter --- test/viper/claim-broken.mo | 2 +- test/viper/claim-simple.mo | 2 +- test/viper/ok/claim-broken.vpr.ok | 2 +- test/viper/ok/claim-simple.vpr.ok | 2 +- test/viper/ok/claim.vpr.ok | 16 ++-------------- 5 files changed, 6 insertions(+), 18 deletions(-) diff --git a/test/viper/claim-broken.mo b/test/viper/claim-broken.mo index 22a1b141751..2ec203a5450 100644 --- a/test/viper/claim-broken.mo +++ b/test/viper/claim-broken.mo @@ -8,7 +8,7 @@ actor { if (not claimed) { await async { claimed := true; - count := 1; + count += 1; }; }; }; diff --git a/test/viper/claim-simple.mo b/test/viper/claim-simple.mo index 4ea8dc7d5e5..1e085be5a36 100644 --- a/test/viper/claim-simple.mo +++ b/test/viper/claim-simple.mo @@ -7,7 +7,7 @@ actor { public shared func claim() : async () { if (not claimed) { claimed := true; - count := 1; + count += 1; }; }; diff --git a/test/viper/ok/claim-broken.vpr.ok b/test/viper/ok/claim-broken.vpr.ok index b4c311300aa..a228be89e97 100644 --- a/test/viper/ok/claim-broken.vpr.ok +++ b/test/viper/ok/claim-broken.vpr.ok @@ -30,7 +30,7 @@ method claim($Self: Ref) ($Self).$message_async := (($Self).$message_async - 1) { ($Self).claimed := true - ($Self).count := 1 + ($Self).count := (($Self).count + 1) } exhale ($Perm($Self) && $Inv($Self)) } diff --git a/test/viper/ok/claim-simple.vpr.ok b/test/viper/ok/claim-simple.vpr.ok index 39011021883..3ef97ab6656 100644 --- a/test/viper/ok/claim-simple.vpr.ok +++ b/test/viper/ok/claim-simple.vpr.ok @@ -21,6 +21,6 @@ method claim($Self: Ref) if (!($Self).claimed) { ($Self).claimed := true - ($Self).count := 1 + ($Self).count := (($Self).count + 1) } } diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok index 33c3e227cbb..0243144d8cf 100644 --- a/test/viper/ok/claim.vpr.ok +++ b/test/viper/ok/claim.vpr.ok @@ -1,19 +1,7 @@ field $message_async: Int define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && acc(($Self).$message_async,write))) - -define invariant_7($Self) ( - ((($Self).count == 0) || (($Self).count == 1)) -) -define invariant_8($Self) ( - ((!($Self).claimed) ==> (($Self).count == 0)) -) -define $Inv($Self) ( - (invariant_7($Self) && invariant_8($Self)) - && (0 <= ($Self).$message_async && ($Self).$message_async <= 1) - && (($Self).$message_async == 1 ==> $Self.claimed && $Self.count == 0) -) - +define $Inv($Self) ((invariant_7($Self) && invariant_8($Self))) method __init__($Self: Ref) requires $Perm($Self) @@ -50,4 +38,4 @@ method claim($Self: Ref) } inhale ($Perm($Self) && $Inv($Self)) } - } \ No newline at end of file + } From 59d7ba83ec796fc7cafd3f6881b7ac7db37f938e Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 21 Oct 2022 18:10:07 +0100 Subject: [PATCH 36/81] viper: map translation exceptions to diagnostic errors (#3503) * map translation errors to diagnostic errors * Apply suggestions from code review * map translation errors to diagnostic errors --- src/pipeline/pipeline.ml | 2 +- src/viper/trans.ml | 61 +++++++++++++--------------- test/viper/ok/unsupported.vpr.ok | 3 ++ test/viper/ok/unsupported.vpr.ret.ok | 1 + test/viper/unsupported.mo | 5 +++ 5 files changed, 38 insertions(+), 34 deletions(-) create mode 100644 test/viper/ok/unsupported.vpr.ok create mode 100644 test/viper/ok/unsupported.vpr.ret.ok create mode 100644 test/viper/unsupported.mo diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index abe80a07920..02217a463b1 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -493,7 +493,7 @@ let viper_files' parsefn files : viper_result = let* () = Typing.check_actors senv progs in let prog = CompUnit.combine_progs progs in let u = CompUnit.comp_unit_of_prog false prog in - let v = Viper.Trans.unit u in + let* v = Viper.Trans.unit u in let s = Viper.Pretty.prog v in Diag.return s diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 0e8dfcaf7fa..87a0f8f22a5 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -43,10 +43,11 @@ let fresh_id name = name else Printf.sprintf "%s_%i" name (fresh_stamp name) -let fail sexp = - failwith (Wasm.Sexpr.to_string 80 sexp) +exception Unsupported of Source.region * string + +let unsupported at sexp = + raise (Unsupported (at, (Wasm.Sexpr.to_string 80 sexp))) - type sort = Field | Local | Method module Env = T.Env @@ -79,7 +80,14 @@ let rec extract_invariants : item list -> (par -> invariants -> invariants) = fu ; note = NoInfo } :: extract_invariants p self es | _ :: p -> extract_invariants p -let rec unit (u : M.comp_unit) : prog = +let rec unit (u : M.comp_unit) : prog Diag.result = + Diag.( + try return (unit' u) with + | Unsupported (at, desc) -> error at "0" "viper" ("translation to viper failed:\n"^desc) + | _ -> error u.it.M.body.at "1" "viper" "translation to viper failed" + ) + +and unit' (u : M.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with | M.ActorU(id_opt, decs) -> @@ -206,7 +214,8 @@ and dec_field' ctxt d = None, fun ctxt' -> InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "$Self" } e), NoInfo - | _ -> fail (Mo_def.Arrange.dec d.M.dec) + | _ -> + unsupported d.M.dec.at (Mo_def.Arrange.dec d.M.dec) (* | TypD (x, tp, t) -> @@ -267,7 +276,8 @@ and dec ctxt d = fun ctxt' -> let s = stmt ctxt' e in s.it) - | _ -> fail (Mo_def.Arrange.dec d) + | _ -> + unsupported d.at (Mo_def.Arrange.dec d) and stmt ctxt (s : M.exp) : seqn = match s.it with @@ -316,8 +326,8 @@ and stmt ctxt (s : M.exp) : seqn = [ !!(InhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), !!(AndE(!!(MacroCall("$Inv", self ctxt at)), - !!(GtCmpE(!!(FldAcc (self ctxt Source.no_region, id)), intLitE Source.no_region 0)))))))) - ; + !!(GtCmpE(!!(FldAcc (self ctxt Source.no_region, id)), + intLitE Source.no_region 0)))))))); !!(FieldAssignS( (self ctxt Source.no_region, id), (!!(SubE(!!(FldAcc (self ctxt at, id)), @@ -368,20 +378,8 @@ and stmt ctxt (s : M.exp) : seqn = [ { it = PostconditionS (exp ctxt e); at = s.at; note = NoInfo } ]; at = s.at; note = NoInfo } - | _ -> fail (Mo_def.Arrange.exp s) - -(* - | M.AssignE({it = VarE id;_}, e2) when isField e1-> - { it = - ([], - [ { it = FieldAssignS((), exp e2); - at = s.at; - note = NoInfo } ]); - at = s.at; - note = NoInfo } -*) - -and isLocal id = true (* fix me *) + | _ -> + unsupported s.at (Mo_def.Arrange.exp s) and exp ctxt e = let (e', info) = exp' ctxt e in @@ -391,7 +389,7 @@ and exp ctxt e = and exp' ctxt (e : M.exp) = let open Mo_values.Operator in match e.it with - | M.VarE x (* when Env.find x.it ctxt = Local *) -> + | M.VarE x -> begin match Env.find x.it ctxt.ids with | Local -> @@ -400,23 +398,19 @@ and exp' ctxt (e : M.exp) = | Field -> (FldAcc (self ctxt x.at, id x), NoInfo) - | _ -> fail (Mo_def.Arrange.exp e) + | _ -> + unsupported e.at (Mo_def.Arrange.exp e) end | M.AnnotE(a, b) -> exp' ctxt a -(* - | M.VarE x when Env.find x.it ctxt = Field -> - (*TODO: need environment to distinguish fields from locals *) - (LocalVar (id x, tr_typ e.note.note_typ), - NoInfo) -*) | M.LitE r -> begin match !r with | M.BoolLit b -> (BoolLitE b, NoInfo) | M.IntLit i -> (IntLitE i, NoInfo) - | _ -> fail (Mo_def.Arrange.exp e) + | _ -> + unsupported e.at (Mo_def.Arrange.exp e) end | M.NotE e -> NotE (exp ctxt e), NoInfo @@ -445,7 +439,8 @@ and exp' ctxt (e : M.exp) = AndE (exp ctxt e1, exp ctxt e2), NoInfo | M.ImpliesE (e1, e2) -> Implies (exp ctxt e1, exp ctxt e2), NoInfo - | _ -> fail (Mo_def.Arrange.exp e) + | _ -> + unsupported e.at (Mo_def.Arrange.exp e) (* | VarE x -> | LitE l -> "LitE" $$ [lit !l] @@ -527,7 +522,7 @@ and tr_typ' typ = match T.normalize typ with | T.Prim T.Int -> IntT | T.Prim T.Bool -> BoolT - | _ -> fail (Mo_types.Arrange_type.typ (T.normalize typ)) + | _ -> unsupported Source.no_region (Mo_types.Arrange_type.typ (T.normalize typ)) (* diff --git a/test/viper/ok/unsupported.vpr.ok b/test/viper/ok/unsupported.vpr.ok new file mode 100644 index 00000000000..019477562e4 --- /dev/null +++ b/test/viper/ok/unsupported.vpr.ok @@ -0,0 +1,3 @@ +unsupported.mo:3.3-3.13: viper error [0], translation to viper failed: +(LetD (VarP x) (LitE (TextLit ))) + diff --git a/test/viper/ok/unsupported.vpr.ret.ok b/test/viper/ok/unsupported.vpr.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/viper/ok/unsupported.vpr.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/viper/unsupported.mo b/test/viper/unsupported.mo new file mode 100644 index 00000000000..da15c134bea --- /dev/null +++ b/test/viper/unsupported.mo @@ -0,0 +1,5 @@ +actor { + + let x = ""; // strings aren't supported + +} From fee72de5905f8271e8635c78ad491432b2433c3f Mon Sep 17 00:00:00 2001 From: Ryan Vandersmith Date: Fri, 21 Oct 2022 11:35:59 -0600 Subject: [PATCH 37/81] viper: error source mappings in `moc.js` (#3501) Passes the `lookup` function through `moc.js` to facilitate source mapping in VS Code. Co-authored-by: Arshavir Ter-Gabrielyan --- src/exes/moc.ml | 2 +- src/js/common.ml | 31 ++++++++++++++++++++----------- src/pipeline/pipeline.ml | 6 ++---- src/pipeline/pipeline.mli | 2 +- 4 files changed, 24 insertions(+), 17 deletions(-) diff --git a/src/exes/moc.ml b/src/exes/moc.ml index 4dd8abd5a00..c00e8e95870 100644 --- a/src/exes/moc.ml +++ b/src/exes/moc.ml @@ -191,7 +191,7 @@ let process_files files : unit = | Check -> Diag.run (Pipeline.check_files files) | Viper -> - let s = Diag.run (Pipeline.viper_files files) in + let (s, _) = Diag.run (Pipeline.viper_files files) in printf "%s" s | StableCompatible -> begin diff --git a/src/js/common.ml b/src/js/common.ml index 608df9791df..238b4af81be 100644 --- a/src/js/common.ml +++ b/src/js/common.ml @@ -62,16 +62,28 @@ let js_run list source = let js_viper filenames = let result = Pipeline.viper_files (Js.to_array filenames |> Array.to_list |> List.map Js.to_string) in - js_result result (fun s -> - Js.some (Js.string s) - ) + js_result result (fun (viper, lookup) -> + let js_viper = Js.string viper in + let js_lookup = Js.wrap_callback (fun js_file js_region -> + let file = Js.to_string js_file in + let viper_region = match js_region |> Js.to_array |> Array.to_list with + | [a; b; c; d] -> + lookup { left = { file; line = a + 1; column = b }; right = { file; line = c + 1; column = d } } + | _ -> None in + match viper_region with + | Some region -> + Js.some (range_of_region region) + | None -> Js.null) in + Js.some (object%js + val viper = js_viper + val lookup = js_lookup + end)) let js_candid source = js_result (Pipeline.generate_idl [Js.to_string source]) (fun prog -> let code = Idllib.Arrange_idl.string_of_prog prog in - Js.some (Js.string code) - ) + Js.some (Js.string code)) let js_stable_compatible pre post = js_result (Pipeline.stable_compatible (Js.to_string pre) (Js.to_string post)) (fun _ -> Js.null) @@ -100,23 +112,20 @@ let js_compile_wasm mode source = val wasm = code val candid = Js.string candid val stable = sig_ - end) - ) + end)) let js_parse_motoko s = let parse_result = Pipeline.parse_string "main" (Js.to_string s) in js_result parse_result (fun (prog, _) -> (* let _ = Pipeline.infer_prog *) let ast = Mo_def.Arrange.prog prog in - Js.some (js_of_sexpr ast) - ) + Js.some (js_of_sexpr ast)) let js_parse_candid s = let parse_result = Idllib.Pipeline.parse_string (Js.to_string s) in js_result parse_result (fun (prog, _) -> let ast = Idllib.Arrange_idl.prog prog in - Js.some (js_of_sexpr ast) - ) + Js.some (js_of_sexpr ast)) let js_save_file filename content = let filename = Js.to_string filename in diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index 02217a463b1..3d2ef19147b 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -485,7 +485,7 @@ let check_files files : check_result = (* Generate Viper *) -type viper_result = string Diag.result +type viper_result = (string * (Source.region -> Source.region option)) Diag.result let viper_files' parsefn files : viper_result = let open Diag.Syntax in @@ -494,14 +494,12 @@ let viper_files' parsefn files : viper_result = let prog = CompUnit.combine_progs progs in let u = CompUnit.comp_unit_of_prog false prog in let* v = Viper.Trans.unit u in - let s = Viper.Pretty.prog v in + let s = Viper.Pretty.prog_mapped "" v in Diag.return s - let viper_files files : viper_result = viper_files' parse_file files - (* Generate IDL *) let generate_idl files : Idllib.Syntax.prog Diag.result = diff --git a/src/pipeline/pipeline.mli b/src/pipeline/pipeline.mli index 4a8df4f1126..c3b4f024e64 100644 --- a/src/pipeline/pipeline.mli +++ b/src/pipeline/pipeline.mli @@ -15,7 +15,7 @@ val print_deps: string -> unit val check_files : string list -> unit Diag.result val check_files' : parse_fn -> string list -> unit Diag.result -val viper_files : string list -> string Diag.result +val viper_files : string list -> (string * (Source.region -> Source.region option)) Diag.result val stable_compatible : string -> string -> unit Diag.result From 0835e123e548057edcfc8683031de049b0c10478 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 21 Oct 2022 19:26:08 +0200 Subject: [PATCH 38/81] XON/XOFF for methods --- src/viper/pretty.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 4969f74f0e6..953eac31f86 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -26,7 +26,8 @@ and pp_item ppf i = id.it pp_typ typ | MethodI (id, locals, rets, pres, posts, bo) -> - fprintf ppf "@[method %s%a@; %a@; %a@; %a@; %a@]" + marks := i.at :: !marks; + fprintf ppf "\017@[method %s%a@; %a@; %a@; %a@; %a@]\019" id.it pp_locals locals pp_returns rets From 5e112ec697840adc6acccb7e85a41f86874d93f3 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Sat, 22 Oct 2022 21:59:34 +0200 Subject: [PATCH 39/81] viper: parse and emit concurrency assertions (#3504) This adds assertions of the form `assert:1:async ;` to the grammar, and each `async { ... }` block should specify one. The conditions are collected and inserted into the summary actor invariant as implication tails with a head condition that the corresponding `async` block is in-flight. This PR builds on the foundation of #3500. Notes: - the `1` between the colons signifies that _at most one_ instantiation of the `async` block is permitted (unicity). The business logic is required to ensure this side condition - the boolean `` is evaluated in actor context (no local access allowed) and states a condition that an in-flight concurrent action must respect (upon invocation) - the `assert:1:async` should be the first expression in the `async` block. This PR does not touch the subject of _message callback_ s, which are a similar concept. TODOs: - [x] harvest `ConcurrencyS` - [x] build condition - [x] include into `$Inv` - [x] remove hacks - [ ] can we improve the context-dependent templating? - [ ] cleanups - [ ] can we get rid of the imperative flag numbers and ghost state? Co-authored-by: Claudio Russo --- src/mo_def/syntax.ml | 2 +- src/mo_frontend/assertions.mly | 2 + src/viper/pretty.ml | 8 ++- src/viper/syntax.ml | 6 ++ src/viper/trans.ml | 60 ++++++++++++++++++-- test/viper/async.mo | 27 +++++++++ test/viper/claim.mo | 4 +- test/viper/ok/async.silicon.ok | 1 + test/viper/ok/async.silicon.ret.ok | 1 + test/viper/ok/async.vpr.ok | 72 ++++++++++++++++++++++++ test/viper/ok/claim-broken.silicon.ok | 2 +- test/viper/ok/claim-broken.vpr.ok | 74 ++++++++++++------------- test/viper/ok/claim-simple.silicon.ok | 2 +- test/viper/ok/claim-simple.vpr.ok | 50 ++++++++--------- test/viper/ok/claim.silicon.ok | 1 - test/viper/ok/claim.vpr.ok | 80 ++++++++++++++------------- test/viper/ok/invariant.silicon.ok | 2 +- test/viper/ok/invariant.vpr.ok | 52 ++++++++--------- 18 files changed, 304 insertions(+), 142 deletions(-) create mode 100644 test/viper/async.mo create mode 100644 test/viper/ok/async.silicon.ok create mode 100644 test/viper/ok/async.silicon.ret.ok create mode 100644 test/viper/ok/async.vpr.ok delete mode 100644 test/viper/ok/claim.silicon.ok diff --git a/src/mo_def/syntax.ml b/src/mo_def/syntax.ml index 5794819fef0..81f594ac7ea 100644 --- a/src/mo_def/syntax.ml +++ b/src/mo_def/syntax.ml @@ -197,7 +197,7 @@ and exp' = *) and assert_kind = - | Runtime | Invariant | Precondition | Postcondition | Loop_entry | Loop_continue | Loop_exit + | Runtime | Invariant | Precondition | Postcondition | Concurrency of string | Loop_entry | Loop_continue | Loop_exit and dec_field = dec_field' Source.phrase and dec_field' = {dec : dec; vis : vis; stab: stab option} diff --git a/src/mo_frontend/assertions.mly b/src/mo_frontend/assertions.mly index cb66647c569..fd3789254b1 100644 --- a/src/mo_frontend/assertions.mly +++ b/src/mo_frontend/assertions.mly @@ -19,5 +19,7 @@ when I write this here (instead of in parser.mly) { AssertE(Precondition, e) @? at $sloc } | ASSERT COLON RETURN e=exp_nest { AssertE(Postcondition, e) @? at $sloc } + | ASSERT COLON s=NAT COLON ASYNC e=exp_nest + { AssertE(Concurrency s, e) @? at $sloc } %% diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 953eac31f86..8109f0c8ce8 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -137,11 +137,11 @@ and pp_stmt ppf stmt = and pp_stmt' ppf = function | SeqnS seqn -> pp_seqn ppf seqn | IfS(exp1, s1, { it = ([],[]); _ }) -> - fprintf ppf "@[if %a@ %a@]" + fprintf ppf "@[if (%a)@ %a@]" pp_exp exp1 pp_seqn s1 | IfS(exp1, s1, s2) -> - fprintf ppf "@[if %a@ %aelse@ %a@]" + fprintf ppf "@[if (%a)@ %aelse@ %a@]" pp_exp exp1 pp_seqn s1 pp_seqn s2 @@ -165,6 +165,10 @@ and pp_stmt' ppf = function | PostconditionS(exp) -> fprintf ppf "@[/*ensures %a*/@]" pp_exp exp + | ConcurrencyS(max, exp, _) -> + fprintf ppf "@[/*concurrency max %s, cond: s %a*/@]" + max + pp_exp exp and pp_fldacc ppf fldacc = match fldacc with diff --git a/src/viper/syntax.ml b/src/viper/syntax.ml index c7c9a994bc5..334b61dcde9 100644 --- a/src/viper/syntax.ml +++ b/src/viper/syntax.ml @@ -58,6 +58,9 @@ and invariants = exp list and stmt = (stmt', info) Source.annotated_phrase +and tmpl = (tmpl', info) Source.annotated_phrase +and tmpl' = (Mo_def.Syntax.exp -> exp) -> exp + and fldacc = exp * id and stmt' = @@ -72,8 +75,11 @@ and stmt' = | IfS of exp * seqn * seqn | WhileS of exp * invariants * seqn | LabelS of id * invariants + (* TODO: these are temporary helper terms that should not appear in the final translation + we should avoid introducing them in the first place if possible, so they can be removed *) | PreconditionS of exp | PostconditionS of exp + | ConcurrencyS of string * exp * tmpl and typ = (typ', info) Source.annotated_phrase diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 87a0f8f22a5..71acce19ca3 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -32,6 +32,10 @@ let conjoin es at = e0 es0 +let rec adjoin ctxt e = function + | [] -> e + | f :: fs -> f ctxt (adjoin ctxt e fs) + let fresh_stamp name = let n = Lib.Option.get (Stamps.find_opt name !stamps) 0 in stamps := Stamps.add name (n + 1) !stamps; @@ -58,7 +62,7 @@ type ctxt = ghost_items : (ctxt -> item) list ref; ghost_inits : (ctxt -> stmt) list ref; ghost_perms : (ctxt -> Source.region -> exp) list ref; - (* invariants : (ctxt -> exp) list ref; *) + ghost_conc : (ctxt -> exp -> exp) list ref; } let self ctxt at = @@ -80,6 +84,27 @@ let rec extract_invariants : item list -> (par -> invariants -> invariants) = fu ; note = NoInfo } :: extract_invariants p self es | _ :: p -> extract_invariants p +let rec extract_concurrency (seq : seqn) : stmt' list * seqn = + let open List in + let extr (concs, stmts) s : stmt' list * stmt list = + match s.it with + | ConcurrencyS _ -> s.it :: concs, stmts + | SeqnS seq -> + let concs', seq = extract_concurrency seq in + rev_append concs' concs, { s with it = SeqnS seq } :: stmts + | WhileS (e, inv, seq) -> + let concs', seq = extract_concurrency seq in + rev_append concs' concs, { s with it = WhileS (e, inv, seq) } :: stmts + | IfS (e, the, els) -> + let the_concs, the = extract_concurrency the in + let els_concs, els = extract_concurrency els in + rev_append els_concs (rev_append the_concs concs), { s with it = IfS (e, the, els) } :: stmts + | _ -> concs, s :: stmts in + + let stmts = snd seq.it in + let conc, stmts = List.fold_left extr ([], []) stmts in + rev conc, { seq with it = fst seq.it, rev stmts } + let rec unit (u : M.comp_unit) : prog Diag.result = Diag.( try return (unit' u) with @@ -91,7 +116,7 @@ and unit' (u : M.comp_unit) : prog = let { M.imports; M.body } = u.it in match body.it with | M.ActorU(id_opt, decs) -> - let ctxt = { self = None; ids = Env.empty; ghost_items = ref []; ghost_inits = ref []; ghost_perms = ref [] } in + let ctxt = { self = None; ids = Env.empty; ghost_items = ref []; ghost_inits = ref []; ghost_perms = ref []; ghost_conc = ref [] } in let ctxt', inits, mk_is = dec_fields ctxt decs in let is' = List.map (fun mk_i -> mk_i ctxt') mk_is in (* given is', compute ghost_is *) @@ -102,8 +127,7 @@ and unit' (u : M.comp_unit) : prog = let ctxt'' = { ctxt' with self = Some self_id.it } in let perms = List.map (fun (id, _) -> fun (at : region) -> (accE at (self ctxt'' at, id))) inits in - let ghost_perms = List.map (fun mk_p -> fun at -> - mk_p ctxt'' at) !(ctxt.ghost_perms) in + let ghost_perms = List.map (fun mk_p -> mk_p ctxt'') !(ctxt.ghost_perms) in let perm = fun (at : region) -> List.fold_left @@ -158,7 +182,7 @@ and unit' (u : M.comp_unit) : prog = } | _ -> {it; at; note}) is''' in let perm_def = !!! (body.at) (InvariantI("$Perm", perm body.at)) in - let inv_def = !!! (body.at) (InvariantI("$Inv", conjoin invs body.at)) in + let inv_def = !!! (body.at) (InvariantI("$Inv", adjoin ctxt'' (conjoin invs body.at) !(ctxt.ghost_conc))) in let is = ghost_is @ (perm_def :: inv_def :: is4) in { it = is; at = body.at; @@ -205,6 +229,7 @@ and dec_field' ctxt d = let ctxt'' = { ctxt' with self = Some self_id.it } in (* TODO: add args (and rets?) *) let stmts = stmt ctxt'' e in + let _, stmts = extract_concurrency stmts in let pres, stmts' = List.partition_map (function { it = PreconditionS exp; _ } -> Left exp | s -> Right s) (snd stmts.it) in let posts, stmts' = List.partition_map (function { it = PostconditionS exp; _ } -> Left exp | s -> Right s) stmts' in (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, pres, posts, Some { stmts with it = fst stmts.it, stmts' } ), @@ -312,6 +337,22 @@ and stmt ctxt (s : M.exp) : seqn = accE at (self ctxt Source.no_region, id) in ctxt.ghost_perms := mk_p :: !(ctxt.ghost_perms); + let stmts = stmt ctxt e in + (* assume that each `async {...}` has an assertion *) + let conc, _ = extract_concurrency stmts in + let mk_c = match conc with + | [] -> + fun _ x -> x + | ConcurrencyS ("1", _, cond) :: _ -> + let (!!) p = !!! (cond.at) p in + let zero, one = intLitE Source.no_region 0, intLitE Source.no_region 1 in + fun ctxt x -> + let ghost_fld () = !!(FldAcc (self ctxt Source.no_region, id)) in + let between = !!(AndE (!!(LeCmpE (zero, ghost_fld ())), !!(LeCmpE (ghost_fld (), one)))) in + let is_one = !!(EqCmpE (ghost_fld (), one)) in + !!(AndE (x, !!(AndE (between, !!(Implies (is_one, cond.it (exp ctxt))))))) + | _ -> unsupported e.at (Mo_def.Arrange.exp e) in + ctxt.ghost_conc := mk_c :: !(ctxt.ghost_conc); let (!!) p = !!! at p in !!! (s.at) ([], @@ -332,7 +373,7 @@ and stmt ctxt (s : M.exp) : seqn = (self ctxt Source.no_region, id), (!!(SubE(!!(FldAcc (self ctxt at, id)), intLitE Source.no_region 1))))); - !!! (e.at) (SeqnS (stmt ctxt e)); + !!! (e.at) (SeqnS stmts); !!(ExhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), !!(MacroCall("$Inv", self ctxt at)))))) ]))); !!(InhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), @@ -378,6 +419,13 @@ and stmt ctxt (s : M.exp) : seqn = [ { it = PostconditionS (exp ctxt e); at = s.at; note = NoInfo } ]; at = s.at; note = NoInfo } + | M.AssertE (Concurrency n, e) -> + { it = [], + [ { it = ConcurrencyS (n, exp ctxt e, { it = (|>) e; at = s.at; note = NoInfo }) + ; at = s.at + ; note = NoInfo } ]; + at = s.at; + note = NoInfo } | _ -> unsupported s.at (Mo_def.Arrange.exp s) diff --git a/test/viper/async.mo b/test/viper/async.mo new file mode 100644 index 00000000000..96686bea776 --- /dev/null +++ b/test/viper/async.mo @@ -0,0 +1,27 @@ +actor { + + var flag = false; + + public shared func claim() : async () { + flag := true; + flag := false; + await async { + assert:1:async not flag; + flag := true; + flag := false; + flag := flag + }; + if flag { + await async { + assert:1:async flag; + flag := false + } + } else { + await async { + assert:1:async flag; + flag := false + } + } + } + +} diff --git a/test/viper/claim.mo b/test/viper/claim.mo index de247c7af2b..7dd5154f79f 100644 --- a/test/viper/claim.mo +++ b/test/viper/claim.mo @@ -12,10 +12,10 @@ actor { claimed := true; await async { - // TODO: assert:1:async (claimed and count == 0); + assert:1:async (claimed and count == 0); count += 1; }; }; }; -} \ No newline at end of file +} diff --git a/test/viper/ok/async.silicon.ok b/test/viper/ok/async.silicon.ok new file mode 100644 index 00000000000..68f34dc1b46 --- /dev/null +++ b/test/viper/ok/async.silicon.ok @@ -0,0 +1 @@ + [0] Exhale might fail. Assertion $Self.$message_async <= 1 might not hold. (async.vpr@33.16--33.43) diff --git a/test/viper/ok/async.silicon.ret.ok b/test/viper/ok/async.silicon.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/viper/ok/async.silicon.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/viper/ok/async.vpr.ok b/test/viper/ok/async.vpr.ok new file mode 100644 index 00000000000..4995458cf1c --- /dev/null +++ b/test/viper/ok/async.vpr.ok @@ -0,0 +1,72 @@ +field $message_async_4: Int + field $message_async_2: Int + field $message_async: Int + define $Perm($Self) (((((true && acc(($Self).flag,write)) && acc(($Self).$message_async_4,write)) && + acc(($Self).$message_async_2,write)) && acc(($Self).$message_async,write))) + define $Inv($Self) ((((true && (((0 <= ($Self).$message_async) && (($Self).$message_async <= 1)) && (( + ($Self).$message_async == 1) ==> (!($Self).flag)))) && (((0 <= ($Self).$message_async_2) && ( + ($Self).$message_async_2 <= 1)) && ((($Self).$message_async_2 == 1) ==> + ($Self).flag))) && (((0 <= ($Self).$message_async_4) && (($Self).$message_async_4 <= 1)) && (( + ($Self).$message_async_4 == 1) ==> ($Self).flag)))) + method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).flag := false + ($Self).$message_async_4 := 0 + ($Self).$message_async_2 := 0 + ($Self).$message_async := 0 + } + field flag: Bool + method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).flag := true + ($Self).flag := false + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).flag := true + ($Self).flag := false + ($Self).flag := ($Self).flag + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + if (($Self).flag) + { + ($Self).$message_async_4 := (($Self).$message_async_4 + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async_4 > 0))) + ($Self).$message_async_4 := (($Self).$message_async_4 - 1) + { + ($Self).flag := false + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + }else + { + ($Self).$message_async_2 := (($Self).$message_async_2 + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async_2 > 0))) + ($Self).$message_async_2 := (($Self).$message_async_2 - 1) + { + ($Self).flag := false + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + } + } diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok index 4af4e03fca5..0260ccf75cc 100644 --- a/test/viper/ok/claim-broken.silicon.ok +++ b/test/viper/ok/claim-broken.silicon.ok @@ -1 +1 @@ -Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-broken.vpr@4.1) +Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-broken.vpr@4.2) diff --git a/test/viper/ok/claim-broken.vpr.ok b/test/viper/ok/claim-broken.vpr.ok index a228be89e97..652cdc8104d 100644 --- a/test/viper/ok/claim-broken.vpr.ok +++ b/test/viper/ok/claim-broken.vpr.ok @@ -1,39 +1,39 @@ field $message_async: Int -define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && - acc(($Self).$message_async,write))) -define $Inv($Self) (true) -method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).claimed := false - ($Self).count := 0 - ($Self).$message_async := 0 - } -field claimed: Bool -field count: Int -method claim($Self: Ref) - - requires $Perm($Self) - requires $Inv($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - if (!($Self).claimed) - { - ($Self).$message_async := (($Self).$message_async + 1) - exhale ($Perm($Self) && $Inv($Self)) + define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && + acc(($Self).$message_async,write))) + define $Inv($Self) (true) + method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + ($Self).$message_async := 0 + } + field claimed: Bool + field count: Int + method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + if ((!($Self).claimed)) { - inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) - ($Self).$message_async := (($Self).$message_async - 1) - { - ($Self).claimed := true - ($Self).count := (($Self).count + 1) - } - exhale ($Perm($Self) && $Inv($Self)) - } - inhale ($Perm($Self) && $Inv($Self)) - } - } + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).claimed := true + ($Self).count := (($Self).count + 1) + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + } + } diff --git a/test/viper/ok/claim-simple.silicon.ok b/test/viper/ok/claim-simple.silicon.ok index c704b94e8c8..185e4dbc76f 100644 --- a/test/viper/ok/claim-simple.silicon.ok +++ b/test/viper/ok/claim-simple.silicon.ok @@ -1 +1 @@ -Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-simple.vpr@2.1) +Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-simple.vpr@2.2) diff --git a/test/viper/ok/claim-simple.vpr.ok b/test/viper/ok/claim-simple.vpr.ok index 3ef97ab6656..f65ef2764b4 100644 --- a/test/viper/ok/claim-simple.vpr.ok +++ b/test/viper/ok/claim-simple.vpr.ok @@ -1,26 +1,26 @@ define $Perm($Self) (((true && acc(($Self).claimed,write)) && acc(($Self).count,write))) -define $Inv($Self) (true) -method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).claimed := false - ($Self).count := 0 - } -field claimed: Bool -field count: Int -method claim($Self: Ref) - - requires $Perm($Self) - requires $Inv($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - if (!($Self).claimed) - { - ($Self).claimed := true - ($Self).count := (($Self).count + 1) - } - } + define $Inv($Self) (true) + method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + } + field claimed: Bool + field count: Int + method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + if ((!($Self).claimed)) + { + ($Self).claimed := true + ($Self).count := (($Self).count + 1) + } + } diff --git a/test/viper/ok/claim.silicon.ok b/test/viper/ok/claim.silicon.ok deleted file mode 100644 index 16935144ec1..00000000000 --- a/test/viper/ok/claim.silicon.ok +++ /dev/null @@ -1 +0,0 @@ - [0] Exhale might fail. Assertion $Self.count == 0 || $Self.count == 1 might not hold. (claim.vpr@37.22--37.49) diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok index 0243144d8cf..8cdf5f34dfc 100644 --- a/test/viper/ok/claim.vpr.ok +++ b/test/viper/ok/claim.vpr.ok @@ -1,41 +1,43 @@ field $message_async: Int -define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && - acc(($Self).$message_async,write))) -define $Inv($Self) ((invariant_7($Self) && invariant_8($Self))) -method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).claimed := false - ($Self).count := 0 - ($Self).$message_async := 0 - } -field claimed: Bool -field count: Int -define invariant_7($Self) (((($Self).count == 0) || (($Self).count == 1))) -define invariant_8($Self) (((!($Self).claimed) ==> (($Self).count == 0))) -method claim($Self: Ref) - - requires $Perm($Self) - requires $Inv($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - if (!($Self).claimed) - { - ($Self).claimed := true - ($Self).$message_async := (($Self).$message_async + 1) - exhale ($Perm($Self) && $Inv($Self)) + define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && + acc(($Self).$message_async,write))) + define $Inv($Self) (((invariant_7($Self) && invariant_8($Self)) && (((0 <= + ($Self).$message_async) && (($Self).$message_async <= 1)) && ((($Self).$message_async == 1) ==> ( + ($Self).claimed && (($Self).count == 0)))))) + method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + ($Self).$message_async := 0 + } + field claimed: Bool + field count: Int + define invariant_7($Self) (((($Self).count == 0) || (($Self).count == 1))) + define invariant_8($Self) (((!($Self).claimed) ==> (($Self).count == 0))) + method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + if ((!($Self).claimed)) { - inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) - ($Self).$message_async := (($Self).$message_async - 1) - { - ($Self).count := (($Self).count + 1) - } - exhale ($Perm($Self) && $Inv($Self)) - } - inhale ($Perm($Self) && $Inv($Self)) - } - } + ($Self).claimed := true + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).count := (($Self).count + 1) + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + } + } diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok index 1e255f267f3..2bc6a732b72 100644 --- a/test/viper/ok/invariant.silicon.ok +++ b/test/viper/ok/invariant.silicon.ok @@ -1 +1 @@ - [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.12--7.23) + [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.14--7.25) diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index c49268a42c9..dda09358dc2 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -1,27 +1,27 @@ define $Perm($Self) (((true && acc(($Self).claimed,write)) && acc(($Self).count,write))) -define $Inv($Self) (((invariant_7($Self) && invariant_8($Self)) && invariant_9($Self))) -method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).claimed := false - ($Self).count := 0 - } -field claimed: Bool -field count: Int -define invariant_7($Self) ((((($Self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) -define invariant_8($Self) ((($Self).count > 0)) -define invariant_9($Self) (((!($Self).claimed) ==> (($Self).count == 0))) -method claim($Self: Ref) - - requires $Perm($Self) - requires (($Self).count >= 0) - requires $Inv($Self) - ensures $Perm($Self) - ensures (($Self).count >= 0) - ensures $Inv($Self) - { - - } + define $Inv($Self) (((invariant_7($Self) && invariant_8($Self)) && invariant_9($Self))) + method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + } + field claimed: Bool + field count: Int + define invariant_7($Self) ((((($Self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) + define invariant_8($Self) ((($Self).count > 0)) + define invariant_9($Self) (((!($Self).claimed) ==> (($Self).count == 0))) + method claim($Self: Ref) + + requires $Perm($Self) + requires (($Self).count >= 0) + requires $Inv($Self) + ensures $Perm($Self) + ensures (($Self).count >= 0) + ensures $Inv($Self) + { + + } From 29ae2b614afa7dddc8acb12247b18f80b1c342e9 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sat, 22 Oct 2022 22:44:30 +0100 Subject: [PATCH 40/81] tidy code; report more unsupported syntax; add // @verify to test sources --- src/mo_def/arrange.ml | 1 + src/mo_frontend/static.ml | 1 + src/viper/trans.ml | 76 +++++++++----- test/viper/async.mo | 2 + test/viper/claim-broken.mo | 2 + test/viper/claim-simple.mo | 2 + test/viper/claim.mo | 2 + test/viper/invariant.mo | 2 + test/viper/ok/async.silicon.ok | 2 +- test/viper/ok/async.vpr.ok | 142 +++++++++++++------------- test/viper/ok/claim-broken.silicon.ok | 2 +- test/viper/ok/claim-broken.vpr.ok | 76 +++++++------- test/viper/ok/claim-simple.silicon.ok | 2 +- test/viper/ok/claim-simple.vpr.ok | 50 ++++----- test/viper/ok/claim.vpr.ok | 84 +++++++-------- test/viper/ok/invariant.silicon.ok | 2 +- test/viper/ok/invariant.vpr.ok | 52 +++++----- test/viper/ok/unsupported.vpr.ok | 2 +- test/viper/unsupported.mo | 2 + 19 files changed, 269 insertions(+), 235 deletions(-) diff --git a/src/mo_def/arrange.ml b/src/mo_def/arrange.ml index 59200e63754..c61b3df3db7 100644 --- a/src/mo_def/arrange.ml +++ b/src/mo_def/arrange.ml @@ -65,6 +65,7 @@ let rec exp e = match e.it with | AssertE (Loop_entry, e) -> "Loop_entry" $$ [exp e] | AssertE (Loop_continue, e) -> "Loop_continue" $$ [exp e] | AssertE (Loop_exit, e) -> "Loop_exit" $$ [exp e] + | AssertE (Concurrency s, e) -> "Concurrency"^s $$ [exp e] | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] | OptE e -> "OptE" $$ [exp e] | DoOptE e -> "DoOptE" $$ [exp e] diff --git a/src/mo_frontend/static.ml b/src/mo_frontend/static.ml index 4ce4c9d82b2..8e8a44063b3 100644 --- a/src/mo_frontend/static.ml +++ b/src/mo_frontend/static.ml @@ -86,6 +86,7 @@ let rec exp m e = match e.it with | ThrowE _ | TryE _ | BangE _ + | ImpliesE _ -> err m e.at and dec_fields m dfs = List.iter (fun df -> dec m df.it.dec) dfs diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 71acce19ca3..0220f143064 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -1,15 +1,32 @@ open Source - open Syntax module T = Mo_types.Type module M = Mo_def.Syntax +module Arrange = Mo_def.Arrange module Stamps = Env.Make(String) +(* symbol generation *) + let stamps : int Stamps.t ref = ref Stamps.empty +let reset_stamps () = stamps := Stamps.empty + +let fresh_stamp name = + let n = Lib.Option.get (Stamps.find_opt name !stamps) 0 in + stamps := Stamps.add name (n + 1) !stamps; + n + +let fresh_id name = + let n = fresh_stamp name in + if n = 0 then + name + else Printf.sprintf "%s_%i" name (fresh_stamp name) + +(* helpers for constructing annotated syntax *) + let (!!!) at it = { it; at; note = NoInfo} let intLitE at i = @@ -21,7 +38,6 @@ let accE at fldacc = fldacc, !!! at (PermE (!!! at FullP)))) - let conjoin es at = match es with | [] -> !!! at (BoolLitE true) @@ -36,17 +52,8 @@ let rec adjoin ctxt e = function | [] -> e | f :: fs -> f ctxt (adjoin ctxt e fs) -let fresh_stamp name = - let n = Lib.Option.get (Stamps.find_opt name !stamps) 0 in - stamps := Stamps.add name (n + 1) !stamps; - n - -let fresh_id name = - let n = fresh_stamp name in - if n = 0 then - name - else Printf.sprintf "%s_%i" name (fresh_stamp name) +(* exception for reporting unsupported Motoko syntax *) exception Unsupported of Source.region * string let unsupported at sexp = @@ -107,6 +114,7 @@ let rec extract_concurrency (seq : seqn) : stmt' list * seqn = let rec unit (u : M.comp_unit) : prog Diag.result = Diag.( + reset_stamps(); try return (unit' u) with | Unsupported (at, desc) -> error at "0" "viper" ("translation to viper failed:\n"^desc) | _ -> error u.it.M.body.at "1" "viper" "translation to viper failed" @@ -211,8 +219,6 @@ and dec_field ctxt d = and dec_field' ctxt d = match d.M.dec.it with - (* | ExpD e -> "ExpD" $$ [exp e ] *) - | M.VarD (x, e) -> { ctxt with ids = Env.add x.it Field ctxt.ids }, Some (id x, e), @@ -225,6 +231,7 @@ and dec_field' ctxt d = { ctxt with ids = Env.add f.it Method ctxt.ids }, None, fun ctxt' -> + let open Either in let self_id = id_at "$Self" Source.no_region in let ctxt'' = { ctxt' with self = Some self_id.it } in (* TODO: add args (and rets?) *) @@ -240,8 +247,7 @@ and dec_field' ctxt d = fun ctxt' -> InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "$Self" } e), NoInfo | _ -> - unsupported d.M.dec.at (Mo_def.Arrange.dec d.M.dec) - + unsupported d.M.dec.at (Arrange.dec d.M.dec) (* | TypD (x, tp, t) -> "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] @@ -255,7 +261,15 @@ and dec_field' ctxt d = and args p = match p.it with | M.TupP ps -> - List.map (fun {it = M.VarP x; note; _} -> (id x, tr_typ note)) ps + List.map ( + fun p -> + match p.it with + | M.VarP x -> + (id x, tr_typ p.note) + | _ -> unsupported p.at (Arrange.pat p) + ) + ps + | _ -> unsupported p.at (Arrange.pat p) and block ctxt at ds = let ctxt, mk_ss = decs ctxt ds in @@ -302,7 +316,7 @@ and dec ctxt d = let s = stmt ctxt' e in s.it) | _ -> - unsupported d.at (Mo_def.Arrange.dec d) + unsupported d.at (Arrange.dec d) and stmt ctxt (s : M.exp) : seqn = match s.it with @@ -351,7 +365,7 @@ and stmt ctxt (s : M.exp) : seqn = let between = !!(AndE (!!(LeCmpE (zero, ghost_fld ())), !!(LeCmpE (ghost_fld (), one)))) in let is_one = !!(EqCmpE (ghost_fld (), one)) in !!(AndE (x, !!(AndE (between, !!(Implies (is_one, cond.it (exp ctxt))))))) - | _ -> unsupported e.at (Mo_def.Arrange.exp e) in + | _ -> unsupported e.at (Arrange.exp e) in ctxt.ghost_conc := mk_c :: !(ctxt.ghost_conc); let (!!) p = !!! at p in !!! (s.at) @@ -407,19 +421,21 @@ and stmt ctxt (s : M.exp) : seqn = note = NoInfo } ]); at = s.at; note = NoInfo } + | _ -> + unsupported s.at (Arrange.exp s) end | M.LitE e -> { it = [], []; at = s.at; note = NoInfo } - | M.AssertE (Precondition, e) -> + | M.AssertE (M.Precondition, e) -> { it = [], [ { it = PreconditionS (exp ctxt e); at = s.at; note = NoInfo } ]; at = s.at; note = NoInfo } - | M.AssertE (Postcondition, e) -> + | M.AssertE (M.Postcondition, e) -> { it = [], [ { it = PostconditionS (exp ctxt e); at = s.at; note = NoInfo } ]; at = s.at; note = NoInfo } - | M.AssertE (Concurrency n, e) -> + | M.AssertE (M.Concurrency n, e) -> { it = [], [ { it = ConcurrencyS (n, exp ctxt e, { it = (|>) e; at = s.at; note = NoInfo }) ; at = s.at @@ -427,7 +443,7 @@ and stmt ctxt (s : M.exp) : seqn = at = s.at; note = NoInfo } | _ -> - unsupported s.at (Mo_def.Arrange.exp s) + unsupported s.at (Arrange.exp s) and exp ctxt e = let (e', info) = exp' ctxt e in @@ -441,13 +457,13 @@ and exp' ctxt (e : M.exp) = begin match Env.find x.it ctxt.ids with | Local -> - (LocalVar (id x, tr_typ e.note.note_typ), + (LocalVar (id x, tr_typ e.note.M.note_typ), NoInfo) | Field -> (FldAcc (self ctxt x.at, id x), NoInfo) | _ -> - unsupported e.at (Mo_def.Arrange.exp e) + unsupported e.at (Arrange.exp e) end | M.AnnotE(a, b) -> exp' ctxt a @@ -458,7 +474,7 @@ and exp' ctxt (e : M.exp) = | M.IntLit i -> (IntLitE i, NoInfo) | _ -> - unsupported e.at (Mo_def.Arrange.exp e) + unsupported e.at (Arrange.exp e) end | M.NotE e -> NotE (exp ctxt e), NoInfo @@ -480,6 +496,7 @@ and exp' ctxt (e : M.exp) = | MulOp -> MulE (e1, e2) | DivOp -> DivE (e1, e2) | ModOp -> ModE (e1, e2) + | _ -> unsupported e.at (Arrange.exp e) ), NoInfo | M.OrE (e1, e2) -> OrE (exp ctxt e1, exp ctxt e2), NoInfo @@ -488,7 +505,7 @@ and exp' ctxt (e : M.exp) = | M.ImpliesE (e1, e2) -> Implies (exp ctxt e1, exp ctxt e2), NoInfo | _ -> - unsupported e.at (Mo_def.Arrange.exp e) + unsupported e.at (Arrange.exp e) (* | VarE x -> | LitE l -> "LitE" $$ [lit !l] @@ -556,7 +573,9 @@ and rets t_opt = | Some t -> (match T.normalize t.note with | T.Tup [] -> [] - | T.Async (_, _) -> []) + | T.Async (_, _) -> [] + | _ -> unsupported t.at (Arrange.typ t) + ) and id_at id at = { it = id; at = at; note = NoInfo } @@ -573,6 +592,7 @@ and tr_typ' typ = | _ -> unsupported Source.no_region (Mo_types.Arrange_type.typ (T.normalize typ)) +(* Crib sheet for other remaining syntax to translate *) (* let rec exp e = match e.it with | VarE x -> "VarE" $$ [id x] diff --git a/test/viper/async.mo b/test/viper/async.mo index 96686bea776..c3f18d7d643 100644 --- a/test/viper/async.mo +++ b/test/viper/async.mo @@ -1,3 +1,5 @@ +// @verify + actor { var flag = false; diff --git a/test/viper/claim-broken.mo b/test/viper/claim-broken.mo index 2ec203a5450..3d0c49cf95f 100644 --- a/test/viper/claim-broken.mo +++ b/test/viper/claim-broken.mo @@ -1,3 +1,5 @@ +// @verify + actor { var claimed = false; diff --git a/test/viper/claim-simple.mo b/test/viper/claim-simple.mo index 1e085be5a36..d36c7f09ffb 100644 --- a/test/viper/claim-simple.mo +++ b/test/viper/claim-simple.mo @@ -1,3 +1,5 @@ +// @verify + actor { var claimed = false; diff --git a/test/viper/claim.mo b/test/viper/claim.mo index 7dd5154f79f..e3e08b52d6d 100644 --- a/test/viper/claim.mo +++ b/test/viper/claim.mo @@ -1,3 +1,5 @@ +// @verify + actor { var claimed = false; diff --git a/test/viper/invariant.mo b/test/viper/invariant.mo index 3d357585862..e9088546536 100644 --- a/test/viper/invariant.mo +++ b/test/viper/invariant.mo @@ -1,3 +1,5 @@ +// @verify + actor { var claimed = false; diff --git a/test/viper/ok/async.silicon.ok b/test/viper/ok/async.silicon.ok index 68f34dc1b46..4cd9741c5a2 100644 --- a/test/viper/ok/async.silicon.ok +++ b/test/viper/ok/async.silicon.ok @@ -1 +1 @@ - [0] Exhale might fail. Assertion $Self.$message_async <= 1 might not hold. (async.vpr@33.16--33.43) + [0] Exhale might fail. Assertion $Self.$message_async <= 1 might not hold. (async.vpr@33.15--33.42) diff --git a/test/viper/ok/async.vpr.ok b/test/viper/ok/async.vpr.ok index 4995458cf1c..b0a40dca425 100644 --- a/test/viper/ok/async.vpr.ok +++ b/test/viper/ok/async.vpr.ok @@ -1,72 +1,72 @@ field $message_async_4: Int - field $message_async_2: Int - field $message_async: Int - define $Perm($Self) (((((true && acc(($Self).flag,write)) && acc(($Self).$message_async_4,write)) && - acc(($Self).$message_async_2,write)) && acc(($Self).$message_async,write))) - define $Inv($Self) ((((true && (((0 <= ($Self).$message_async) && (($Self).$message_async <= 1)) && (( - ($Self).$message_async == 1) ==> (!($Self).flag)))) && (((0 <= ($Self).$message_async_2) && ( - ($Self).$message_async_2 <= 1)) && ((($Self).$message_async_2 == 1) ==> - ($Self).flag))) && (((0 <= ($Self).$message_async_4) && (($Self).$message_async_4 <= 1)) && (( - ($Self).$message_async_4 == 1) ==> ($Self).flag)))) - method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).flag := false - ($Self).$message_async_4 := 0 - ($Self).$message_async_2 := 0 - ($Self).$message_async := 0 - } - field flag: Bool - method claim($Self: Ref) - - requires $Perm($Self) - requires $Inv($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).flag := true - ($Self).flag := false - ($Self).$message_async := (($Self).$message_async + 1) - exhale ($Perm($Self) && $Inv($Self)) - { - inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) - ($Self).$message_async := (($Self).$message_async - 1) - { - ($Self).flag := true - ($Self).flag := false - ($Self).flag := ($Self).flag - } - exhale ($Perm($Self) && $Inv($Self)) - } - inhale ($Perm($Self) && $Inv($Self)) - if (($Self).flag) - { - ($Self).$message_async_4 := (($Self).$message_async_4 + 1) - exhale ($Perm($Self) && $Inv($Self)) - { - inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async_4 > 0))) - ($Self).$message_async_4 := (($Self).$message_async_4 - 1) - { - ($Self).flag := false - } - exhale ($Perm($Self) && $Inv($Self)) - } - inhale ($Perm($Self) && $Inv($Self)) - }else - { - ($Self).$message_async_2 := (($Self).$message_async_2 + 1) - exhale ($Perm($Self) && $Inv($Self)) - { - inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async_2 > 0))) - ($Self).$message_async_2 := (($Self).$message_async_2 - 1) - { - ($Self).flag := false - } - exhale ($Perm($Self) && $Inv($Self)) - } - inhale ($Perm($Self) && $Inv($Self)) - } - } +field $message_async_2: Int +field $message_async: Int +define $Perm($Self) (((((true && acc(($Self).flag,write)) && acc(($Self).$message_async_4,write)) && + acc(($Self).$message_async_2,write)) && acc(($Self).$message_async,write))) +define $Inv($Self) ((((true && (((0 <= ($Self).$message_async) && (($Self).$message_async <= 1)) && (( + ($Self).$message_async == 1) ==> (!($Self).flag)))) && (((0 <= ($Self).$message_async_2) && ( + ($Self).$message_async_2 <= 1)) && ((($Self).$message_async_2 == 1) ==> + ($Self).flag))) && (((0 <= ($Self).$message_async_4) && (($Self).$message_async_4 <= 1)) && (( + ($Self).$message_async_4 == 1) ==> ($Self).flag)))) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).flag := false + ($Self).$message_async_4 := 0 + ($Self).$message_async_2 := 0 + ($Self).$message_async := 0 + } +field flag: Bool +method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).flag := true + ($Self).flag := false + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).flag := true + ($Self).flag := false + ($Self).flag := ($Self).flag + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + if (($Self).flag) + { + ($Self).$message_async_4 := (($Self).$message_async_4 + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async_4 > 0))) + ($Self).$message_async_4 := (($Self).$message_async_4 - 1) + { + ($Self).flag := false + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + }else + { + ($Self).$message_async_2 := (($Self).$message_async_2 + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async_2 > 0))) + ($Self).$message_async_2 := (($Self).$message_async_2 - 1) + { + ($Self).flag := false + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + } + } diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok index 0260ccf75cc..4af4e03fca5 100644 --- a/test/viper/ok/claim-broken.silicon.ok +++ b/test/viper/ok/claim-broken.silicon.ok @@ -1 +1 @@ -Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-broken.vpr@4.2) +Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-broken.vpr@4.1) diff --git a/test/viper/ok/claim-broken.vpr.ok b/test/viper/ok/claim-broken.vpr.ok index 652cdc8104d..a87d4097850 100644 --- a/test/viper/ok/claim-broken.vpr.ok +++ b/test/viper/ok/claim-broken.vpr.ok @@ -1,39 +1,39 @@ field $message_async: Int - define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && - acc(($Self).$message_async,write))) - define $Inv($Self) (true) - method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).claimed := false - ($Self).count := 0 - ($Self).$message_async := 0 - } - field claimed: Bool - field count: Int - method claim($Self: Ref) - - requires $Perm($Self) - requires $Inv($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - if ((!($Self).claimed)) - { - ($Self).$message_async := (($Self).$message_async + 1) - exhale ($Perm($Self) && $Inv($Self)) - { - inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) - ($Self).$message_async := (($Self).$message_async - 1) - { - ($Self).claimed := true - ($Self).count := (($Self).count + 1) - } - exhale ($Perm($Self) && $Inv($Self)) - } - inhale ($Perm($Self) && $Inv($Self)) - } - } +define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && + acc(($Self).$message_async,write))) +define $Inv($Self) (true) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + ($Self).$message_async := 0 + } +field claimed: Bool +field count: Int +method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + if ((!($Self).claimed)) + { + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).claimed := true + ($Self).count := (($Self).count + 1) + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + } + } diff --git a/test/viper/ok/claim-simple.silicon.ok b/test/viper/ok/claim-simple.silicon.ok index 185e4dbc76f..c704b94e8c8 100644 --- a/test/viper/ok/claim-simple.silicon.ok +++ b/test/viper/ok/claim-simple.silicon.ok @@ -1 +1 @@ -Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-simple.vpr@2.2) +Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-simple.vpr@2.1) diff --git a/test/viper/ok/claim-simple.vpr.ok b/test/viper/ok/claim-simple.vpr.ok index f65ef2764b4..50d2875b529 100644 --- a/test/viper/ok/claim-simple.vpr.ok +++ b/test/viper/ok/claim-simple.vpr.ok @@ -1,26 +1,26 @@ define $Perm($Self) (((true && acc(($Self).claimed,write)) && acc(($Self).count,write))) - define $Inv($Self) (true) - method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).claimed := false - ($Self).count := 0 - } - field claimed: Bool - field count: Int - method claim($Self: Ref) - - requires $Perm($Self) - requires $Inv($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - if ((!($Self).claimed)) - { - ($Self).claimed := true - ($Self).count := (($Self).count + 1) - } - } +define $Inv($Self) (true) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + } +field claimed: Bool +field count: Int +method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + if ((!($Self).claimed)) + { + ($Self).claimed := true + ($Self).count := (($Self).count + 1) + } + } diff --git a/test/viper/ok/claim.vpr.ok b/test/viper/ok/claim.vpr.ok index 8cdf5f34dfc..593ce616846 100644 --- a/test/viper/ok/claim.vpr.ok +++ b/test/viper/ok/claim.vpr.ok @@ -1,43 +1,43 @@ field $message_async: Int - define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && - acc(($Self).$message_async,write))) - define $Inv($Self) (((invariant_7($Self) && invariant_8($Self)) && (((0 <= - ($Self).$message_async) && (($Self).$message_async <= 1)) && ((($Self).$message_async == 1) ==> ( - ($Self).claimed && (($Self).count == 0)))))) - method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).claimed := false - ($Self).count := 0 - ($Self).$message_async := 0 - } - field claimed: Bool - field count: Int - define invariant_7($Self) (((($Self).count == 0) || (($Self).count == 1))) - define invariant_8($Self) (((!($Self).claimed) ==> (($Self).count == 0))) - method claim($Self: Ref) - - requires $Perm($Self) - requires $Inv($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - if ((!($Self).claimed)) - { - ($Self).claimed := true - ($Self).$message_async := (($Self).$message_async + 1) - exhale ($Perm($Self) && $Inv($Self)) - { - inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) - ($Self).$message_async := (($Self).$message_async - 1) - { - ($Self).count := (($Self).count + 1) - } - exhale ($Perm($Self) && $Inv($Self)) - } - inhale ($Perm($Self) && $Inv($Self)) - } - } +define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && + acc(($Self).$message_async,write))) +define $Inv($Self) (((invariant_9($Self) && invariant_10($Self)) && (((0 <= + ($Self).$message_async) && (($Self).$message_async <= 1)) && ((($Self).$message_async == 1) ==> ( + ($Self).claimed && (($Self).count == 0)))))) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + ($Self).$message_async := 0 + } +field claimed: Bool +field count: Int +define invariant_9($Self) (((($Self).count == 0) || (($Self).count == 1))) +define invariant_10($Self) (((!($Self).claimed) ==> (($Self).count == 0))) +method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + if ((!($Self).claimed)) + { + ($Self).claimed := true + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).count := (($Self).count + 1) + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + } + } diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok index 2bc6a732b72..94a1ad16eff 100644 --- a/test/viper/ok/invariant.silicon.ok +++ b/test/viper/ok/invariant.silicon.ok @@ -1 +1 @@ - [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.14--7.25) + [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.13--7.24) diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index dda09358dc2..02b476ff633 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -1,27 +1,27 @@ define $Perm($Self) (((true && acc(($Self).claimed,write)) && acc(($Self).count,write))) - define $Inv($Self) (((invariant_7($Self) && invariant_8($Self)) && invariant_9($Self))) - method __init__($Self: Ref) - - requires $Perm($Self) - ensures $Perm($Self) - ensures $Inv($Self) - { - ($Self).claimed := false - ($Self).count := 0 - } - field claimed: Bool - field count: Int - define invariant_7($Self) ((((($Self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) - define invariant_8($Self) ((($Self).count > 0)) - define invariant_9($Self) (((!($Self).claimed) ==> (($Self).count == 0))) - method claim($Self: Ref) - - requires $Perm($Self) - requires (($Self).count >= 0) - requires $Inv($Self) - ensures $Perm($Self) - ensures (($Self).count >= 0) - ensures $Inv($Self) - { - - } +define $Inv($Self) (((invariant_9($Self) && invariant_10($Self)) && invariant_11($Self))) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + } +field claimed: Bool +field count: Int +define invariant_9($Self) ((((($Self).claimed && (!(-1 == -1))) && (-42 == -42)) || true)) +define invariant_10($Self) ((($Self).count > 0)) +define invariant_11($Self) (((!($Self).claimed) ==> (($Self).count == 0))) +method claim($Self: Ref) + + requires $Perm($Self) + requires (($Self).count >= 0) + requires $Inv($Self) + ensures $Perm($Self) + ensures (($Self).count >= 0) + ensures $Inv($Self) + { + + } diff --git a/test/viper/ok/unsupported.vpr.ok b/test/viper/ok/unsupported.vpr.ok index 019477562e4..30d4be4428b 100644 --- a/test/viper/ok/unsupported.vpr.ok +++ b/test/viper/ok/unsupported.vpr.ok @@ -1,3 +1,3 @@ -unsupported.mo:3.3-3.13: viper error [0], translation to viper failed: +unsupported.mo:5.3-5.13: viper error [0], translation to viper failed: (LetD (VarP x) (LitE (TextLit ))) diff --git a/test/viper/unsupported.mo b/test/viper/unsupported.mo index da15c134bea..1dcec99779f 100644 --- a/test/viper/unsupported.mo +++ b/test/viper/unsupported.mo @@ -1,3 +1,5 @@ +// @verify + actor { let x = ""; // strings aren't supported From b8bdba2a6d25844a52adff972b610c28d20f6c5c Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Sun, 23 Oct 2022 10:36:30 +0200 Subject: [PATCH 41/81] viper: ignore generated `.mo.vpr` files --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index c22647c5079..85225065ee3 100644 --- a/.gitignore +++ b/.gitignore @@ -13,6 +13,8 @@ result* /samples/**/*.txt +**/*.mo.vpr + enable-internals # Editor configuration From 45d100a68c0c995a1773039156d1efc2a63ac2c4 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Mon, 24 Oct 2022 10:15:01 +0100 Subject: [PATCH 42/81] viper: refactor using !!! helper (#3511) * refactor using git diff HEAD! helper * Update src/viper/trans.ml * more tweaks * remove id_at --- src/viper/trans.ml | 258 +++++++++++++++++---------------------------- 1 file changed, 94 insertions(+), 164 deletions(-) diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 0220f143064..89cf706e290 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -74,21 +74,15 @@ type ctxt = let self ctxt at = match ctxt.self with - | Some id -> { it = LocalVar ({ it = id; at; note = NoInfo}, - { it = RefT; at; note = NoInfo }); - at; - note = NoInfo } + | Some id -> !!! at (LocalVar (!!! at id,!!! at RefT)) | _ -> failwith "no self" let rec extract_invariants : item list -> (par -> invariants -> invariants) = function | [] -> fun _ x -> x | { it = InvariantI (s, e); at; _ } :: p -> fun self es -> - { it = MacroCall(s, { it = LocalVar (fst self, snd self) - ; at - ; note = NoInfo }) - ; at - ; note = NoInfo } :: extract_invariants p self es + !!! at (MacroCall(s, !!! at (LocalVar (fst self, snd self)))) + :: extract_invariants p self es | _ :: p -> extract_invariants p let rec extract_concurrency (seq : seqn) : stmt' list * seqn = @@ -129,9 +123,9 @@ and unit' (u : M.comp_unit) : prog = let is' = List.map (fun mk_i -> mk_i ctxt') mk_is in (* given is', compute ghost_is *) let ghost_is = List.map (fun mk_i -> mk_i ctxt') !(ctxt.ghost_items) in - let init_id = id_at "__init__" Source.no_region in - let self_id = id_at "$Self" Source.no_region in - let self_typ = { it = RefT; at = self_id.at; note = NoInfo } in + let init_id = !!! (Source.no_region) "__init__" in + let self_id = !!! (Source.no_region) "$Self" in + let self_typ = !!! (self_id.at) RefT in let ctxt'' = { ctxt' with self = Some self_id.it } in let perms = List.map (fun (id, _) -> fun (at : region) -> (accE at (self ctxt'' at, id))) inits in @@ -146,56 +140,44 @@ and unit' (u : M.comp_unit) : prog = in (* Add initializer *) let init_list = List.map (fun (id, init) -> - { at = { left = id.at.left; right = init.at.right }; - it = FieldAssignS((self ctxt'' init.at, id), exp ctxt'' init); - note = NoInfo - }) inits in + !!! { left = id.at.left; right = init.at.right } + (FieldAssignS((self ctxt'' init.at, id), exp ctxt'' init))) + inits in let init_list = init_list @ List.map (fun mk_s -> mk_s ctxt'') !(ctxt.ghost_inits) in let init_body = - { at = body.at; (* ATG: Is this the correct position? *) - it = [], init_list; - note = NoInfo - } in + !!! (body.at) ([], init_list)(* ATG: Is this the correct position? *) + in let init_m = - { it = MethodI(init_id, [self_id, self_typ], [], [], [], Some init_body); - at = no_region; - note = NoInfo - } in - + !!! (body.at) (MethodI(init_id, [self_id, self_typ], [], [], [], Some init_body)) + in let is'' = init_m :: is' in (* Add permissions *) let is''' = List.map (fun {it; at; note: info} -> ( match it with | MethodI (id, ins, outs, pres, posts, body) -> - { at; - it = MethodI (id, ins, outs, - !!! at (MacroCall("$Perm", self ctxt'' at))::pres, - !!! at (MacroCall("$Perm", self ctxt'' at))::posts, body); - note - } + !!! at + (MethodI (id, ins, outs, + !!! at (MacroCall("$Perm", self ctxt'' at))::pres, + !!! at (MacroCall("$Perm", self ctxt'' at))::posts, + body)) | _ -> {it; at; note})) is'' in (* Add functional invariants *) let invs = extract_invariants is''' (self_id, self_typ) [] in let is4 = List.map (fun {it; at; note: info} -> match it with | MethodI (id, ins, outs, pres, posts, body) -> - { at; - it = MethodI(id, ins, outs, - (if id.it = init_id.it - then pres - else pres @ [!!! at (MacroCall("$Inv", self ctxt'' at))]), - posts @ [!!! at (MacroCall("$Inv", self ctxt'' at))], - body); - note - } + !!! at + (MethodI(id, ins, outs, + (if id.it = init_id.it + then pres + else pres @ [!!! at (MacroCall("$Inv", self ctxt'' at))]), + posts @ [!!! at (MacroCall("$Inv", self ctxt'' at))], + body)) | _ -> {it; at; note}) is''' in let perm_def = !!! (body.at) (InvariantI("$Perm", perm body.at)) in let inv_def = !!! (body.at) (InvariantI("$Inv", adjoin ctxt'' (conjoin invs body.at) !(ctxt.ghost_conc))) in let is = ghost_is @ (perm_def :: inv_def :: is4) in - { it = is; - at = body.at; - note = NoInfo - } + !!! (body.at) is | _ -> assert false and dec_fields (ctxt : ctxt) (ds : M.dec_field list) = @@ -210,12 +192,10 @@ and dec_fields (ctxt : ctxt) (ds : M.dec_field list) = and dec_field ctxt d = let ctxt, init, mk_i = dec_field' ctxt d.it in (ctxt, - init, + init, fun ctxt' -> let (i, info) = mk_i ctxt' in - { it = i; - at = d.at; - note = info }) + !!! (d.at) i) and dec_field' ctxt d = match d.M.dec.it with @@ -232,20 +212,20 @@ and dec_field' ctxt d = None, fun ctxt' -> let open Either in - let self_id = id_at "$Self" Source.no_region in + let self_id = !!! (Source.no_region) "$Self" in let ctxt'' = { ctxt' with self = Some self_id.it } in (* TODO: add args (and rets?) *) let stmts = stmt ctxt'' e in let _, stmts = extract_concurrency stmts in let pres, stmts' = List.partition_map (function { it = PreconditionS exp; _ } -> Left exp | s -> Right s) (snd stmts.it) in let posts, stmts' = List.partition_map (function { it = PostconditionS exp; _ } -> Left exp | s -> Right s) stmts' in - (MethodI(id f, (self_id, {it = RefT; at = Source.no_region; note = NoInfo})::args p, rets t_opt, pres, posts, Some { stmts with it = fst stmts.it, stmts' } ), + (MethodI(id f, (self_id, !!! Source.no_region RefT)::args p, rets t_opt, pres, posts, Some { stmts with it = fst stmts.it, stmts' } ), NoInfo) | M.(ExpD { it = AssertE (Invariant, e); at; _ }) -> ctxt, None, - fun ctxt' -> - InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "$Self" } e), NoInfo + fun ctxt' -> + (InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "$Self" } e), NoInfo) | _ -> unsupported d.M.dec.at (Arrange.dec d.M.dec) (* @@ -261,21 +241,18 @@ and dec_field' ctxt d = and args p = match p.it with | M.TupP ps -> - List.map ( - fun p -> - match p.it with - | M.VarP x -> - (id x, tr_typ p.note) - | _ -> unsupported p.at (Arrange.pat p) - ) - ps + List.map + (fun p -> + match p.it with + | M.VarP x -> + (id x, tr_typ p.note) + | _ -> unsupported p.at (Arrange.pat p)) + ps | _ -> unsupported p.at (Arrange.pat p) and block ctxt at ds = let ctxt, mk_ss = decs ctxt ds in - { it = mk_ss ctxt; - at; - note = NoInfo } + !!! at (mk_ss ctxt) and decs ctxt ds = match ds with @@ -290,27 +267,20 @@ and decs ctxt ds = (l @ ls, s @ ss)) and dec ctxt d = + let (!!) p = !!! (d.at) p in match d.it with | M.VarD (x, e) -> (* TODO: translate e? *) { ctxt with ids = Env.add x.it Local ctxt.ids }, fun ctxt' -> - ([{ it = (id x, tr_typ e.note.M.note_typ); - at = d.at; - note = NoInfo }], - [{ it = VarAssignS (id x, exp ctxt' e); - at = d.at; - note = NoInfo }]) + ([ !!(id x, tr_typ e.note.M.note_typ) ], + [ !!(VarAssignS (id x, exp ctxt' e)) ]) | M.(LetD ({it=VarP x;_}, e)) -> { ctxt with ids = Env.add x.it Local ctxt.ids }, fun ctxt' -> - ([{ it = (id x, tr_typ e.note.M.note_typ); - at = d.at; - note = NoInfo }], - [{ it = VarAssignS (id x, exp ctxt' e); - at = d.at; - note = NoInfo }]) - | M.(ExpD e) -> + ([ !!(id x, tr_typ e.note.M.note_typ) ], + [ !!(VarAssignS (id x, exp ctxt' e)) ]) + | M.(ExpD e) -> (* TODO: restrict to e of unit type? *) (ctxt, fun ctxt' -> let s = stmt ctxt' e in @@ -319,36 +289,31 @@ and dec ctxt d = unsupported d.at (Arrange.dec d) and stmt ctxt (s : M.exp) : seqn = + let (!!) p = !!! (s.at) p in match s.it with | M.TupE [] -> block ctxt s.at [] | M.BlockE ds -> block ctxt s.at ds | M.IfE(e, s1, s2) -> - { it = - ([], - [ { it = IfS(exp ctxt e, stmt ctxt s1, stmt ctxt s2); - at = s.at; - note = NoInfo } ]); - at = s.at; - note = NoInfo } + !!([], + [ !!(IfS(exp ctxt e, stmt ctxt s1, stmt ctxt s2))]) | M.(AwaitE({ it = AsyncE (_, e); at;_ })) -> (* gross hack *) - let id' = fresh_id "$message_async" in - let id = { it = id'; at = Source.no_region; note = NoInfo } in + let id = fresh_id "$message_async" in + let (!!) p = !!! (s.at) p in ctxt.ghost_items := (fun ctxt -> - { it = FieldI (id, { it = IntT; at = Source.no_region; note = NoInfo }); at = Source.no_region; note = NoInfo }) :: - !(ctxt.ghost_items); + !!(FieldI (!!id, !!IntT))) :: + !(ctxt.ghost_items); let mk_s = fun ctxt -> - { it = FieldAssignS( - (self ctxt Source.no_region, id), - intLitE (Source.no_region) 0); - at = Source.no_region; - note = NoInfo } + !!! at + (FieldAssignS ( + (self ctxt s.at, !!id), + intLitE (s.at) 0)) in ctxt.ghost_inits := mk_s :: !(ctxt.ghost_inits); let mk_p = fun ctxt at -> - accE at (self ctxt Source.no_region, id) + accE at (self ctxt at, !!! at id) in ctxt.ghost_perms := mk_p :: !(ctxt.ghost_perms); let stmts = stmt ctxt e in @@ -361,32 +326,31 @@ and stmt ctxt (s : M.exp) : seqn = let (!!) p = !!! (cond.at) p in let zero, one = intLitE Source.no_region 0, intLitE Source.no_region 1 in fun ctxt x -> - let ghost_fld () = !!(FldAcc (self ctxt Source.no_region, id)) in + let ghost_fld () = !!(FldAcc (self ctxt cond.at, !!id)) in let between = !!(AndE (!!(LeCmpE (zero, ghost_fld ())), !!(LeCmpE (ghost_fld (), one)))) in let is_one = !!(EqCmpE (ghost_fld (), one)) in !!(AndE (x, !!(AndE (between, !!(Implies (is_one, cond.it (exp ctxt))))))) | _ -> unsupported e.at (Arrange.exp e) in ctxt.ghost_conc := mk_c :: !(ctxt.ghost_conc); - let (!!) p = !!! at p in - !!! (s.at) - ([], + !! ([], [ !!(FieldAssignS( - (self ctxt Source.no_region, id), - (!!(AddE(!!(FldAcc (self ctxt Source.no_region, id)), + (self ctxt Source.no_region, !!id), + (!!(AddE(!!(FldAcc (self ctxt (s.at), !!id)), intLitE Source.no_region 1))))); !!(ExhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), !!(MacroCall("$Inv", self ctxt at)))))); !!(SeqnS ( + let (!!) p = !!! at p in !!([], [ !!(InhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), !!(AndE(!!(MacroCall("$Inv", self ctxt at)), - !!(GtCmpE(!!(FldAcc (self ctxt Source.no_region, id)), + !!(GtCmpE(!!(FldAcc (self ctxt at, !!id)), intLitE Source.no_region 0)))))))); !!(FieldAssignS( - (self ctxt Source.no_region, id), - (!!(SubE(!!(FldAcc (self ctxt at, id)), - intLitE Source.no_region 1))))); + (self ctxt at, !!id), + (!!(SubE(!!(FldAcc (self ctxt at, !!id)), + intLitE at 1))))); !!! (e.at) (SeqnS stmts); !!(ExhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), !!(MacroCall("$Inv", self ctxt at)))))) ]))); @@ -394,116 +358,84 @@ and stmt ctxt (s : M.exp) : seqn = !!(MacroCall("$Inv", self ctxt at)))))); ]) | M.WhileE(e, s1) -> - { it = - ([], - [ { it = WhileS(exp ctxt e, [], stmt ctxt s1); (* TODO: invariant *) - at = s.at; - note = NoInfo } ]); - at = s.at; - note = NoInfo } + !!([], + [ !!(WhileS(exp ctxt e, [], stmt ctxt s1)) ]) (* TODO: Invariant *) | M.(AssignE({it = VarE x; _}, e2)) -> begin match Env.find x.it ctxt.ids with | Local -> - let loc = { it = x.it; at = x.at; note = NoInfo } in - { it = - ([], - [ { it = VarAssignS(loc, exp ctxt e2); - at = s.at; - note = NoInfo } ]); - at = s.at; - note = NoInfo } + let loc = !!! (x.at) (x.it) in + !!([], + [ !!(VarAssignS(loc, exp ctxt e2)) ]) | Field -> let fld = (self ctxt x.at, id x) in - { it = - ([], - [ { it = FieldAssignS(fld, exp ctxt e2); - at = s.at; - note = NoInfo } ]); - at = s.at; - note = NoInfo } + !!([], + [ !!(FieldAssignS(fld, exp ctxt e2)) ]) | _ -> unsupported s.at (Arrange.exp s) end - | M.LitE e -> { it = [], []; at = s.at; note = NoInfo } | M.AssertE (M.Precondition, e) -> - { it = [], - [ { it = PreconditionS (exp ctxt e); at = s.at; note = NoInfo } ]; - at = s.at; - note = NoInfo } + !!( [], + [ !!(PreconditionS (exp ctxt e)) ]) | M.AssertE (M.Postcondition, e) -> - { it = [], - [ { it = PostconditionS (exp ctxt e); at = s.at; note = NoInfo } ]; - at = s.at; - note = NoInfo } + !!([], + [ !!(PostconditionS (exp ctxt e)) ]) | M.AssertE (M.Concurrency n, e) -> - { it = [], - [ { it = ConcurrencyS (n, exp ctxt e, { it = (|>) e; at = s.at; note = NoInfo }) - ; at = s.at - ; note = NoInfo } ]; - at = s.at; - note = NoInfo } + !!([], + [ !!(ConcurrencyS (n, exp ctxt e, !! ((|>) e))) ]); | _ -> unsupported s.at (Arrange.exp s) and exp ctxt e = - let (e', info) = exp' ctxt e in - { it = e'; - at = e.at; - note = info } -and exp' ctxt (e : M.exp) = let open Mo_values.Operator in + let (!!) p = !!! (e.at) p in match e.it with | M.VarE x -> begin match Env.find x.it ctxt.ids with | Local -> - (LocalVar (id x, tr_typ e.note.M.note_typ), - NoInfo) + !!(LocalVar (id x, tr_typ e.note.M.note_typ)) | Field -> - (FldAcc (self ctxt x.at, id x), - NoInfo) + !!(FldAcc (self ctxt x.at, id x)) | _ -> unsupported e.at (Arrange.exp e) end | M.AnnotE(a, b) -> - exp' ctxt a + exp ctxt a | M.LitE r -> begin match !r with | M.BoolLit b -> - (BoolLitE b, NoInfo) + !!(BoolLitE b) | M.IntLit i -> - (IntLitE i, NoInfo) + !!(IntLitE i) | _ -> unsupported e.at (Arrange.exp e) end | M.NotE e -> - NotE (exp ctxt e), NoInfo + !!(NotE (exp ctxt e)) | M.RelE (ot, e1, op, e2) -> let e1, e2 = exp ctxt e1, exp ctxt e2 in - (match op with + !!(match op with | EqOp -> EqCmpE (e1, e2) | NeqOp -> NeCmpE (e1, e2) | GtOp -> GtCmpE (e1, e2) | GeOp -> GeCmpE (e1, e2) | LtOp -> LtCmpE (e1, e2) - | LeOp -> LeCmpE (e1, e2) - ), NoInfo + | LeOp -> LeCmpE (e1, e2)) | M.BinE (ot, e1, op, e2) -> let e1, e2 = exp ctxt e1, exp ctxt e2 in - (match op with + !!(match op with | AddOp -> AddE (e1, e2) | SubOp -> SubE (e1, e2) | MulOp -> MulE (e1, e2) | DivOp -> DivE (e1, e2) | ModOp -> ModE (e1, e2) - | _ -> unsupported e.at (Arrange.exp e) - ), NoInfo + | _ -> unsupported e.at (Arrange.exp e)) | M.OrE (e1, e2) -> - OrE (exp ctxt e1, exp ctxt e2), NoInfo + !!(OrE (exp ctxt e1, exp ctxt e2)) | M.AndE (e1, e2) -> - AndE (exp ctxt e1, exp ctxt e2), NoInfo + !!(AndE (exp ctxt e1, exp ctxt e2)) | M.ImpliesE (e1, e2) -> - Implies (exp ctxt e1, exp ctxt e2), NoInfo + !!(Implies (exp ctxt e1, exp ctxt e2)) | _ -> unsupported e.at (Arrange.exp e) (* @@ -577,8 +509,6 @@ and rets t_opt = | _ -> unsupported t.at (Arrange.typ t) ) -and id_at id at = { it = id; at = at; note = NoInfo } - and id id = { it = id.it; at = id.at; note = NoInfo } and tr_typ typ = From d76781f1f6c1d5ce2a29055cdb728b7e47c736fa Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Mon, 24 Oct 2022 17:11:02 +0200 Subject: [PATCH 43/81] viper: add the concurrency condition, observe verification fail (#3507) The program is semantically broken, so I'd expect that it would fail to verify. --- test/viper/claim-broken.mo | 6 +++++- test/viper/ok/claim-broken.silicon.ok | 2 +- test/viper/ok/claim-broken.vpr.ok | 6 +++++- 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/test/viper/claim-broken.mo b/test/viper/claim-broken.mo index 3d0c49cf95f..7074a4fc32e 100644 --- a/test/viper/claim-broken.mo +++ b/test/viper/claim-broken.mo @@ -6,13 +6,17 @@ actor { var count = 0 : Int; + assert:invariant not claimed implies count == 0; + assert:invariant count == 0 or count == 1; + public shared func claim() : async () { if (not claimed) { await async { + assert:1:async (claimed and count == 0); claimed := true; count += 1; }; }; }; -} \ No newline at end of file +} diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok index 4af4e03fca5..2738a3acfa7 100644 --- a/test/viper/ok/claim-broken.silicon.ok +++ b/test/viper/ok/claim-broken.silicon.ok @@ -1 +1 @@ -Parse warning: In macro $Inv, the following parameters were defined but not used: $Self (claim-broken.vpr@4.1) + [0] Exhale might fail. Assertion $Self.$message_async == 1 ==> $Self.claimed && $Self.count == 0 might not hold. (claim-broken.vpr@31.20--31.47) diff --git a/test/viper/ok/claim-broken.vpr.ok b/test/viper/ok/claim-broken.vpr.ok index a87d4097850..f2061664183 100644 --- a/test/viper/ok/claim-broken.vpr.ok +++ b/test/viper/ok/claim-broken.vpr.ok @@ -1,7 +1,9 @@ field $message_async: Int define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && acc(($Self).$message_async,write))) -define $Inv($Self) (true) +define $Inv($Self) (((invariant_9($Self) && invariant_10($Self)) && (((0 <= + ($Self).$message_async) && (($Self).$message_async <= 1)) && ((($Self).$message_async == 1) ==> ( + ($Self).claimed && (($Self).count == 0)))))) method __init__($Self: Ref) requires $Perm($Self) @@ -14,6 +16,8 @@ method __init__($Self: Ref) } field claimed: Bool field count: Int +define invariant_9($Self) (((!($Self).claimed) ==> (($Self).count == 0))) +define invariant_10($Self) (((($Self).count == 0) || (($Self).count == 1))) method claim($Self: Ref) requires $Perm($Self) From 80c1d39179348168a78c802fc97d8b489ca2452a Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Mon, 24 Oct 2022 17:25:16 +0200 Subject: [PATCH 44/81] turn runtime `assert`s into Viper `assume`s (#3506) Turn Motoko runtime assertions (plain `assert`s) into Viper `assume`s. Naturally, no side-effecting things are allowed in the condition, otherwise Viper won't verify. --- src/viper/pretty.ml | 17 ++++++++++------- src/viper/trans.ml | 5 ++++- test/viper/invariant.mo | 1 + test/viper/ok/invariant.vpr.ok | 2 +- 4 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 8109f0c8ce8..d8f304edaee 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -136,20 +136,20 @@ and pp_stmt ppf stmt = and pp_stmt' ppf = function | SeqnS seqn -> pp_seqn ppf seqn - | IfS(exp1, s1, { it = ([],[]); _ }) -> + | IfS (exp1, s1, { it = ([],[]); _ }) -> fprintf ppf "@[if (%a)@ %a@]" pp_exp exp1 pp_seqn s1 - | IfS(exp1, s1, s2) -> + | IfS (exp1, s1, s2) -> fprintf ppf "@[if (%a)@ %aelse@ %a@]" pp_exp exp1 pp_seqn s1 pp_seqn s2 - | VarAssignS(id, exp) -> + | VarAssignS (id, exp) -> fprintf ppf "@[%s := %a@]" id.it pp_exp exp - | FieldAssignS(fldacc, exp) -> + | FieldAssignS (fldacc, exp) -> fprintf ppf "@[%a := %a@]" pp_fldacc fldacc pp_exp exp @@ -159,13 +159,16 @@ and pp_stmt' ppf = function | ExhaleS exp -> fprintf ppf "@[exhale %a@]" pp_exp exp - | PreconditionS(exp) -> + | AssumeS exp -> + fprintf ppf "@[assume %a@]" + pp_exp exp + | PreconditionS exp -> fprintf ppf "@[/*requires %a*/@]" pp_exp exp - | PostconditionS(exp) -> + | PostconditionS exp -> fprintf ppf "@[/*ensures %a*/@]" pp_exp exp - | ConcurrencyS(max, exp, _) -> + | ConcurrencyS (max, exp, _) -> fprintf ppf "@[/*concurrency max %s, cond: s %a*/@]" max pp_exp exp diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 89cf706e290..a31e0c65410 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -381,7 +381,10 @@ and stmt ctxt (s : M.exp) : seqn = [ !!(PostconditionS (exp ctxt e)) ]) | M.AssertE (M.Concurrency n, e) -> !!([], - [ !!(ConcurrencyS (n, exp ctxt e, !! ((|>) e))) ]); + [ !!(ConcurrencyS (n, exp ctxt e, !! ((|>) e))) ]) + | M.AssertE (M.Runtime, e) -> + !!([], + [ !!(AssumeS (exp ctxt e)) ]) | _ -> unsupported s.at (Arrange.exp s) diff --git a/test/viper/invariant.mo b/test/viper/invariant.mo index e9088546536..3c34277434f 100644 --- a/test/viper/invariant.mo +++ b/test/viper/invariant.mo @@ -12,6 +12,7 @@ actor { public shared func claim() : async () { assert:func count >= 0; + assert claimed implies count > 0; assert:return count >= 0; }; diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index 02b476ff633..b18fd8bc713 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -23,5 +23,5 @@ method claim($Self: Ref) ensures (($Self).count >= 0) ensures $Inv($Self) { - + assume (($Self).claimed ==> (($Self).count > 0)) } From 29d87d67a1e9bc31ae1fe87f021fa2467c36ab34 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Tue, 25 Oct 2022 15:20:57 +0200 Subject: [PATCH 45/81] bump `viperserver.jar` --- default.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/default.nix b/default.nix index bc23b55a54e..be146399b54 100644 --- a/default.nix +++ b/default.nix @@ -752,8 +752,8 @@ rec { }; viperServer = builtins.fetchurl { - url = https://github.com/viperproject/viperserver/releases/download/v-2022-10-18-0728/viperserver.jar; - sha256 = "sha256:0j0p70h6jv96d9j97xr3nyb97xc44cxnn76dwx3drs6ifnhx14wx"; + url = https://github.com/viperproject/viperserver/releases/download/v-2022-10-25-0730/viperserver.jar; + sha256 = "sha256:0w1s31c0lr2g60bjjpnz3hclwkgzz0vrywq9i2l4pw4y2cwl0plc"; }; shell = stdenv.mkDerivation { From a8b19cf222bfedfd2a9d251d83d089d85f81d92b Mon Sep 17 00:00:00 2001 From: Arshavir Ter-Gabrielyan Date: Tue, 25 Oct 2022 20:50:44 +0200 Subject: [PATCH 46/81] Support static assertions as `assert:system` in Motoko to Viper translation (#3520) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Why this is needed: * Peace of mind assertion that Viper can derive what you think should hold. * Smoke testing soundness of the verification technique or proving that code is unreachable via assert:system false. * One can use static assertions to introspect a program that fails to verify. * There’s also the possibility to replace dynamic assertion with static ones (e.g., to have stronger guarantees or simply save some cycles). * In case the proof search is undecidable, user-defined static assertions can guide quantifier instantiation heuristics. --- src/mo_def/arrange.ml | 1 + src/mo_def/syntax.ml | 2 +- src/mo_frontend/assertions.mly | 2 ++ src/viper/pretty.ml | 3 ++ src/viper/trans.ml | 3 ++ test/viper/assertions.mo | 26 ++++++++++++++++ test/viper/ok/assertions.silicon.ok | 2 ++ test/viper/ok/assertions.silicon.ret.ok | 1 + test/viper/ok/assertions.vpr.ok | 41 +++++++++++++++++++++++++ 9 files changed, 80 insertions(+), 1 deletion(-) create mode 100644 test/viper/assertions.mo create mode 100644 test/viper/ok/assertions.silicon.ok create mode 100644 test/viper/ok/assertions.silicon.ret.ok create mode 100644 test/viper/ok/assertions.vpr.ok diff --git a/src/mo_def/arrange.ml b/src/mo_def/arrange.ml index c61b3df3db7..f73532d0d99 100644 --- a/src/mo_def/arrange.ml +++ b/src/mo_def/arrange.ml @@ -59,6 +59,7 @@ let rec exp e = match e.it with | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] | AwaitE e -> "AwaitE" $$ [exp e] | AssertE (Runtime, e) -> "AssertE" $$ [exp e] + | AssertE (Static, e) -> "Static_AssertE" $$ [exp e] | AssertE (Invariant, e) -> "Invariant" $$ [exp e] | AssertE (Precondition, e) -> "Precondition" $$ [exp e] | AssertE (Postcondition, e) -> "Postcondition" $$ [exp e] diff --git a/src/mo_def/syntax.ml b/src/mo_def/syntax.ml index 81f594ac7ea..6225664b5fd 100644 --- a/src/mo_def/syntax.ml +++ b/src/mo_def/syntax.ml @@ -197,7 +197,7 @@ and exp' = *) and assert_kind = - | Runtime | Invariant | Precondition | Postcondition | Concurrency of string | Loop_entry | Loop_continue | Loop_exit + | Runtime | Static | Invariant | Precondition | Postcondition | Concurrency of string | Loop_entry | Loop_continue | Loop_exit and dec_field = dec_field' Source.phrase and dec_field' = {dec : dec; vis : vis; stab: stab option} diff --git a/src/mo_frontend/assertions.mly b/src/mo_frontend/assertions.mly index fd3789254b1..f4f78a47650 100644 --- a/src/mo_frontend/assertions.mly +++ b/src/mo_frontend/assertions.mly @@ -13,6 +13,8 @@ when I write this here (instead of in parser.mly) { ImpliesE(e1, e2) @? at $sloc } %public exp_nondec(B) : + | ASSERT COLON SYSTEM e=exp_nest + { AssertE(Static, e) @? at $sloc } | ASSERT COLON INVARIANT e=exp_nest { AssertE(Invariant, e) @? at $sloc } | ASSERT COLON FUNC e=exp_nest diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index d8f304edaee..f4a4f8261da 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -162,6 +162,9 @@ and pp_stmt' ppf = function | AssumeS exp -> fprintf ppf "@[assume %a@]" pp_exp exp + | AssertS exp -> + fprintf ppf "@[assert %a@]" + pp_exp exp | PreconditionS exp -> fprintf ppf "@[/*requires %a*/@]" pp_exp exp diff --git a/src/viper/trans.ml b/src/viper/trans.ml index a31e0c65410..007777195d4 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -382,6 +382,9 @@ and stmt ctxt (s : M.exp) : seqn = | M.AssertE (M.Concurrency n, e) -> !!([], [ !!(ConcurrencyS (n, exp ctxt e, !! ((|>) e))) ]) + | M.AssertE (M.Static, e) -> + !!([], + [ !!(AssertS (exp ctxt e)) ]) | M.AssertE (M.Runtime, e) -> !!([], [ !!(AssumeS (exp ctxt e)) ]) diff --git a/test/viper/assertions.mo b/test/viper/assertions.mo new file mode 100644 index 00000000000..7ad5c4a28e8 --- /dev/null +++ b/test/viper/assertions.mo @@ -0,0 +1,26 @@ +// @verify + +// This example should demonstrate all static assertions that are currently +// supported. + +actor { + + var u = false; + var v = 0 : Int; + + assert:invariant u; // canister invariant + + public shared func claim() : async () { + assert:func v >= 0; // function precondition + + assert:system u implies v > 0; // static assertion + assert u implies v > 0; // dynamic assertion + + await async { + assert:1:async true; // concurrency constraints + }; + + assert:return v >= 0; // function postcondition + }; + +} diff --git a/test/viper/ok/assertions.silicon.ok b/test/viper/ok/assertions.silicon.ok new file mode 100644 index 00000000000..202af03d0c2 --- /dev/null +++ b/test/viper/ok/assertions.silicon.ok @@ -0,0 +1,2 @@ + [0] Postcondition of __init__ might not hold. Assertion $Self.u might not hold. (assertions.vpr@10.13--10.24) + [1] Assert might fail. Assertion $Self.u ==> $Self.v > 0 might not hold. (assertions.vpr@28.15--28.44) diff --git a/test/viper/ok/assertions.silicon.ret.ok b/test/viper/ok/assertions.silicon.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/viper/ok/assertions.silicon.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/viper/ok/assertions.vpr.ok b/test/viper/ok/assertions.vpr.ok new file mode 100644 index 00000000000..c834272478d --- /dev/null +++ b/test/viper/ok/assertions.vpr.ok @@ -0,0 +1,41 @@ +field $message_async: Int +define $Perm($Self) ((((true && acc(($Self).u,write)) && acc(($Self).v,write)) && + acc(($Self).$message_async,write))) +define $Inv($Self) ((invariant_11($Self) && (((0 <= ($Self).$message_async) && ( + ($Self).$message_async <= 1)) && ((($Self).$message_async == 1) ==> true)))) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).u := false + ($Self).v := 0 + ($Self).$message_async := 0 + } +field u: Bool +field v: Int +define invariant_11($Self) (($Self).u) +method claim($Self: Ref) + + requires $Perm($Self) + requires (($Self).v >= 0) + requires $Inv($Self) + ensures $Perm($Self) + ensures (($Self).v >= 0) + ensures $Inv($Self) + { + assert (($Self).u ==> (($Self).v > 0)) + assume (($Self).u ==> (($Self).v > 0)) + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + } From b18c52e67d6cbd7f72f888946f1f0cc6628abad9 Mon Sep 17 00:00:00 2001 From: rvanasa Date: Wed, 26 Oct 2022 18:56:56 -0600 Subject: [PATCH 47/81] Reset 'marks' at the beginning of 'prog_mapped' --- src/viper/pretty.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index f4a4f8261da..8ec5fa8e0e3 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -182,6 +182,7 @@ and pp_fldacc ppf fldacc = fprintf ppf "@[(%a).%s@]" pp_exp exp1 id.it let prog_mapped file p = + marks := []; let b = Buffer.create 16 in let ppf = Format.formatter_of_buffer b in Format.fprintf ppf "@[%a@]" pp_prog p; From 1e34444b67fa0d8e5e26c3e8ff3eb9819695bdef Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Tue, 8 Nov 2022 22:49:57 +0100 Subject: [PATCH 48/81] patch `rocksdb` --- nix/drun.nix | 2 ++ nix/rocks.diff | 11 +++++++++++ 2 files changed, 13 insertions(+) create mode 100644 nix/rocks.diff diff --git a/nix/drun.nix b/nix/drun.nix index b4ac8ac3692..ac2be2b574f 100644 --- a/nix/drun.nix +++ b/nix/drun.nix @@ -17,6 +17,8 @@ pkgs: cargoSha256 = "sha256-dhDXhVNAAHzLRHdA6MpIGuoY76UhiF4ObeLO4gG/wo4="; + patches = [ ./rocks.diff ]; + nativeBuildInputs = with pkgs; [ pkg-config cmake diff --git a/nix/rocks.diff b/nix/rocks.diff new file mode 100644 index 00000000000..1ae4969bf20 --- /dev/null +++ b/nix/rocks.diff @@ -0,0 +1,11 @@ +--- nix/overlays/rocksdb/default.nix 2022-11-08 22:33:02.990791181 +0100 ++++ nix/overlays/rocksdb/default.nix 2022-11-08 22:41:14.188317227 +0100 +@@ -35,6 +35,8 @@ + + cmakeFlags = [ + "-DPORTABLE=1" ++ "-DisSSE42()=0" ++ "-DisPCLMULQDQ()=0" + "-DWITH_JEMALLOC=${if enableJemalloc then "1" else "0"}" + "-DWITH_JNI=0" + "-DWITH_BENCHMARK_TOOLS=0" From ddaeb09410b5c191ebad0c7ce4550c7dbf3c45cf Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 9 Nov 2022 13:23:50 +0100 Subject: [PATCH 49/81] next try --- nix/drun.nix | 2 +- nix/rocks1.diff | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) create mode 100644 nix/rocks1.diff diff --git a/nix/drun.nix b/nix/drun.nix index ac2be2b574f..11faf3e4c36 100644 --- a/nix/drun.nix +++ b/nix/drun.nix @@ -17,7 +17,7 @@ pkgs: cargoSha256 = "sha256-dhDXhVNAAHzLRHdA6MpIGuoY76UhiF4ObeLO4gG/wo4="; - patches = [ ./rocks.diff ]; + patches = [ ./rocks1.diff ]; nativeBuildInputs = with pkgs; [ pkg-config diff --git a/nix/rocks1.diff b/nix/rocks1.diff new file mode 100644 index 00000000000..e333b9de60c --- /dev/null +++ b/nix/rocks1.diff @@ -0,0 +1,10 @@ +--- drun-vendor.tar.gz/librocksdb-sys/build.rs 2022-11-09 00:20:37.207477667 +0100 ++++ drun-vendor.tar.gz/librocksdb-sys/build.rs 2022-11-09 12:14:40.144832181 +0100 +@@ -118,6 +118,7 @@ + config.define("OS_MACOSX", Some("1")); + config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); + config.define("ROCKSDB_LIB_IO_POSIX", Some("1")); ++ config.define("isSSE42()", Some("0")); + } else if target.contains("android") { + config.define("OS_ANDROID", Some("1")); + config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); From a88eb35a5a7a7b3cd4d362ced175cd7b4b180fe3 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 9 Nov 2022 18:14:11 +0100 Subject: [PATCH 50/81] victory! --- nix/drun.nix | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/nix/drun.nix b/nix/drun.nix index 11faf3e4c36..fd6124ff27c 100644 --- a/nix/drun.nix +++ b/nix/drun.nix @@ -16,8 +16,29 @@ pkgs: # the command therein manually. cargoSha256 = "sha256-dhDXhVNAAHzLRHdA6MpIGuoY76UhiF4ObeLO4gG/wo4="; + # sha256 = "ea803b02f2db51aaa6302492ab5fa1301e05c9def68b7eefedddad522814ed00"; - patches = [ ./rocks1.diff ]; + # patches = [ ./rocks1.diff ]; + patchPhase = '' + pwd + ls .. + cd ../drun-vendor.tar.gz + ls -l librocksdb-sys/build.rs + patch librocksdb-sys/build.rs << EOF +@@ -118,6 +118,8 @@ + config.define("OS_MACOSX", Some("1")); + config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); + config.define("ROCKSDB_LIB_IO_POSIX", Some("1")); ++ config.define("isSSE42()", Some("0")); ++ config.define("isPCLMULQDQ()", Some("0")); + } else if target.contains("android") { + config.define("OS_ANDROID", Some("1")); + config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); +EOF + + sed -i -e s/08d86b53188dc6f15c8dc09d8aadece72e39f145e3ae497bb8711936a916335a/b099df5e4401ea37f9c04060cfc19a9f2d78e8f3ff90ce80377ad6f0164532c1/g librocksdb-sys/.cargo-checksum.json + cd - + ''; nativeBuildInputs = with pkgs; [ pkg-config From 218a85d3a7b546154a3ca80589fadaea38544417 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 9 Nov 2022 18:20:56 +0100 Subject: [PATCH 51/81] clean up --- nix/drun.nix | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/nix/drun.nix b/nix/drun.nix index fd6124ff27c..c0f452f1d26 100644 --- a/nix/drun.nix +++ b/nix/drun.nix @@ -16,12 +16,8 @@ pkgs: # the command therein manually. cargoSha256 = "sha256-dhDXhVNAAHzLRHdA6MpIGuoY76UhiF4ObeLO4gG/wo4="; - # sha256 = "ea803b02f2db51aaa6302492ab5fa1301e05c9def68b7eefedddad522814ed00"; - # patches = [ ./rocks1.diff ]; patchPhase = '' - pwd - ls .. cd ../drun-vendor.tar.gz ls -l librocksdb-sys/build.rs patch librocksdb-sys/build.rs << EOF @@ -37,6 +33,7 @@ pkgs: EOF sed -i -e s/08d86b53188dc6f15c8dc09d8aadece72e39f145e3ae497bb8711936a916335a/b099df5e4401ea37f9c04060cfc19a9f2d78e8f3ff90ce80377ad6f0164532c1/g librocksdb-sys/.cargo-checksum.json + cd - ''; From f59eba099bc78c0147a7da92df7d4bd2bbecff8f Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 9 Nov 2022 18:44:11 +0100 Subject: [PATCH 52/81] Delete rocks.diff --- nix/rocks.diff | 11 ----------- 1 file changed, 11 deletions(-) delete mode 100644 nix/rocks.diff diff --git a/nix/rocks.diff b/nix/rocks.diff deleted file mode 100644 index 1ae4969bf20..00000000000 --- a/nix/rocks.diff +++ /dev/null @@ -1,11 +0,0 @@ ---- nix/overlays/rocksdb/default.nix 2022-11-08 22:33:02.990791181 +0100 -+++ nix/overlays/rocksdb/default.nix 2022-11-08 22:41:14.188317227 +0100 -@@ -35,6 +35,8 @@ - - cmakeFlags = [ - "-DPORTABLE=1" -+ "-DisSSE42()=0" -+ "-DisPCLMULQDQ()=0" - "-DWITH_JEMALLOC=${if enableJemalloc then "1" else "0"}" - "-DWITH_JNI=0" - "-DWITH_BENCHMARK_TOOLS=0" From 74cc67a9505aac0fa8924bb02abf6a0fec1f4513 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 9 Nov 2022 18:44:24 +0100 Subject: [PATCH 53/81] Delete rocks1.diff --- nix/rocks1.diff | 10 ---------- 1 file changed, 10 deletions(-) delete mode 100644 nix/rocks1.diff diff --git a/nix/rocks1.diff b/nix/rocks1.diff deleted file mode 100644 index e333b9de60c..00000000000 --- a/nix/rocks1.diff +++ /dev/null @@ -1,10 +0,0 @@ ---- drun-vendor.tar.gz/librocksdb-sys/build.rs 2022-11-09 00:20:37.207477667 +0100 -+++ drun-vendor.tar.gz/librocksdb-sys/build.rs 2022-11-09 12:14:40.144832181 +0100 -@@ -118,6 +118,7 @@ - config.define("OS_MACOSX", Some("1")); - config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); - config.define("ROCKSDB_LIB_IO_POSIX", Some("1")); -+ config.define("isSSE42()", Some("0")); - } else if target.contains("android") { - config.define("OS_ANDROID", Some("1")); - config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); From 54fd3f4d9d06ee08a900b77d5bd48eb34073940a Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 9 Nov 2022 19:30:25 +0100 Subject: [PATCH 54/81] only do the defines for M1 --- nix/drun.nix | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/nix/drun.nix b/nix/drun.nix index c0f452f1d26..aefc9bcd9b2 100644 --- a/nix/drun.nix +++ b/nix/drun.nix @@ -21,18 +21,20 @@ pkgs: cd ../drun-vendor.tar.gz ls -l librocksdb-sys/build.rs patch librocksdb-sys/build.rs << EOF -@@ -118,6 +118,8 @@ +@@ -118,6 +118,10 @@ config.define("OS_MACOSX", Some("1")); config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); config.define("ROCKSDB_LIB_IO_POSIX", Some("1")); -+ config.define("isSSE42()", Some("0")); -+ config.define("isPCLMULQDQ()", Some("0")); ++ if target.contains("aarch64") { ++ config.define("isSSE42()", Some("0")); ++ config.define("isPCLMULQDQ()", Some("0")); ++ } } else if target.contains("android") { config.define("OS_ANDROID", Some("1")); config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); EOF - sed -i -e s/08d86b53188dc6f15c8dc09d8aadece72e39f145e3ae497bb8711936a916335a/b099df5e4401ea37f9c04060cfc19a9f2d78e8f3ff90ce80377ad6f0164532c1/g librocksdb-sys/.cargo-checksum.json + sed -i -e s/08d86b53188dc6f15c8dc09d8aadece72e39f145e3ae497bb8711936a916335a/536e44802de57cc7d3690c90c80f154f770f48e82b82756c36443b8b47c9b5e7/g librocksdb-sys/.cargo-checksum.json cd - ''; From eadb2d59e7c8438a93cf9c7677631d86dac205ef Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 9 Nov 2022 19:51:14 +0100 Subject: [PATCH 55/81] bump to newest nightly --- default.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/default.nix b/default.nix index be146399b54..02d887d1a2d 100644 --- a/default.nix +++ b/default.nix @@ -752,8 +752,8 @@ rec { }; viperServer = builtins.fetchurl { - url = https://github.com/viperproject/viperserver/releases/download/v-2022-10-25-0730/viperserver.jar; - sha256 = "sha256:0w1s31c0lr2g60bjjpnz3hclwkgzz0vrywq9i2l4pw4y2cwl0plc"; + url = https://github.com/viperproject/viperserver/releases/download/v-2022-11-09-0713/viperserver.jar; + sha256 = "sha256:0yqzmi7ci1zmdcsr4vkz05s5h9836vn4ap3hzj08y60rvgsab9k4"; }; shell = stdenv.mkDerivation { From 13f67e0bc6c9f8864e3ce037a90c4b90c091be44 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Thu, 10 Nov 2022 08:39:15 +0100 Subject: [PATCH 56/81] filter out underscores --- src/viper/pretty.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 8ec5fa8e0e3..028a3954e9e 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -105,7 +105,7 @@ and pp_exp ppf exp = | BoolLitE b -> fprintf ppf "%s" (if b then "true" else "false") | IntLitE i -> - fprintf ppf "%s" (Mo_values.Numerics.Int.to_string i) + fprintf ppf "%s" String.(of_seq (Seq.filter (fun c -> c <> '_') (to_seq (Mo_values.Numerics.Int.to_string i)))) | AddE (e1, e2) | SubE (e1, e2) | MulE (e1, e2) | DivE (e1, e2) | ModE (e1, e2) | EqCmpE (e1, e2) | NeCmpE (e1, e2) | GtCmpE (e1, e2) | GeCmpE (e1, e2) | LtCmpE (e1, e2) | LeCmpE (e1, e2) | Implies (e1, e2) | OrE (e1, e2) | AndE (e1, e2) -> From 487e04109b7c6c7923e5cf38268d185b230d9ac7 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Mon, 14 Nov 2022 17:50:03 +0100 Subject: [PATCH 57/81] ignore viper temporaries --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 85225065ee3..c00c4e5497e 100644 --- a/.gitignore +++ b/.gitignore @@ -14,6 +14,7 @@ result* /samples/**/*.txt **/*.mo.vpr +test/viper/tmp enable-internals From 8cf94fb9474ecb5ab520f0181bcd5475fb0c873c Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Tue, 15 Nov 2022 17:51:00 +0100 Subject: [PATCH 58/81] viper: conditionalise lexer/grammar (#3574) Enable verification-specific keywords (and grammar productions) under two circumstances: - when `--viper` option is given to `moc` - when the environment variable `MOC_UNLOCK_VERIFICATION` is set The latter way is needed for running also the backend tests (and the env-var is set by by the `Makefile` centrally). The grammar productions for the ad-hoc `assert:*` productions are specifically disabled when not in verification mode. Tests added to check the absence of verification-mode constructs in normal mode. Co-authored-by: Claudio Russo --- src/lang_utils/error_codes.ml | 1 + src/mo_frontend/assertions.mly | 10 +++++----- src/mo_frontend/lexer_lib.ml | 3 +++ src/mo_frontend/parser.mly | 8 ++++++++ src/mo_frontend/source_lexer.mll | 4 ++-- src/pipeline/pipeline.ml | 9 +++++---- test/fail/ok/verification-asserts.tc.ok | 10 ++++++++++ test/fail/ok/verification-asserts.tc.ret.ok | 1 + test/fail/ok/verification-implies.tc.ok | 4 ++++ test/fail/ok/verification-implies.tc.ret.ok | 1 + test/fail/verification-asserts.mo | 7 +++++++ test/fail/verification-implies.mo | 2 ++ test/viper/Makefile | 1 + test/viper/ok/claim-broken.silicon.ret.ok | 1 + 14 files changed, 51 insertions(+), 11 deletions(-) create mode 100644 test/fail/ok/verification-asserts.tc.ok create mode 100644 test/fail/ok/verification-asserts.tc.ret.ok create mode 100644 test/fail/ok/verification-implies.tc.ok create mode 100644 test/fail/ok/verification-implies.tc.ret.ok create mode 100644 test/fail/verification-asserts.mo create mode 100644 test/fail/verification-implies.mo create mode 100644 test/viper/ok/claim-broken.silicon.ret.ok diff --git a/src/lang_utils/error_codes.ml b/src/lang_utils/error_codes.ml index 458bfb4aa7c..7f6f76df51e 100644 --- a/src/lang_utils/error_codes.ml +++ b/src/lang_utils/error_codes.ml @@ -184,4 +184,5 @@ let error_codes : (string * string option) list = "M0178", None; (* Bases of record extensions must be either objects or modules *) "M0179", None; (* Mutable (var) fields from bases must be overwritten explicitly *) "M0180", None; (* Shared function has unexpected type parameters *) + "M0181", None; (* Verification mode assertions not allowed *) ] diff --git a/src/mo_frontend/assertions.mly b/src/mo_frontend/assertions.mly index f4f78a47650..8f6f1897bb5 100644 --- a/src/mo_frontend/assertions.mly +++ b/src/mo_frontend/assertions.mly @@ -14,14 +14,14 @@ when I write this here (instead of in parser.mly) %public exp_nondec(B) : | ASSERT COLON SYSTEM e=exp_nest - { AssertE(Static, e) @? at $sloc } + { is_verification &&& AssertE(Static, e) @? at $sloc } | ASSERT COLON INVARIANT e=exp_nest - { AssertE(Invariant, e) @? at $sloc } + { is_verification &&& AssertE(Invariant, e) @? at $sloc } | ASSERT COLON FUNC e=exp_nest - { AssertE(Precondition, e) @? at $sloc } + { is_verification &&& AssertE(Precondition, e) @? at $sloc } | ASSERT COLON RETURN e=exp_nest - { AssertE(Postcondition, e) @? at $sloc } + { is_verification &&& AssertE(Postcondition, e) @? at $sloc } | ASSERT COLON s=NAT COLON ASYNC e=exp_nest - { AssertE(Concurrency s, e) @? at $sloc } + { is_verification &&& AssertE(Concurrency s, e) @? at $sloc } %% diff --git a/src/mo_frontend/lexer_lib.ml b/src/mo_frontend/lexer_lib.ml index 73deaf6c870..4ba54102d06 100644 --- a/src/mo_frontend/lexer_lib.ml +++ b/src/mo_frontend/lexer_lib.ml @@ -5,13 +5,16 @@ *) type mode = { privileged : bool; + verification : bool; } let mode : mode = { privileged = Option.is_some (Sys.getenv_opt "MOC_UNLOCK_PRIM"); + verification = Option.is_some (Sys.getenv_opt "MOC_UNLOCK_VERIFICATION"); } let mode_priv : mode = { mode with privileged = true } +let mode_verification : mode = { mode with verification = true } exception Error of Source.region * string diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly index 9611b455e14..3176b3ae56b 100644 --- a/src/mo_frontend/parser.mly +++ b/src/mo_frontend/parser.mly @@ -199,6 +199,14 @@ and objblock s dec_fields = | _ -> ()) dec_fields; ObjBlockE(s, dec_fields) +(* Verification mode only *) + +let (&&&) cond action = + if not cond then syntax_error action.at "M0181" "verification assertions not permitted in normal mode"; + action + +let is_verification = Lexer_lib.(mode.verification) + %} %token EOF DISALLOWED diff --git a/src/mo_frontend/source_lexer.mll b/src/mo_frontend/source_lexer.mll index 08d082d10e9..1ef7ef06f3f 100644 --- a/src/mo_frontend/source_lexer.mll +++ b/src/mo_frontend/source_lexer.mll @@ -212,8 +212,8 @@ rule token mode = parse | "if" { IF } | "ignore" { IGNORE } | "in" { IN } - | "invariant" { INVARIANT } - | "implies" { IMPLIES } + | "invariant" as s { if mode.verification then INVARIANT else ID s } + | "implies" as s { if mode.verification then IMPLIES else ID s } | "import" { IMPORT } | "module" { MODULE } | "not" { NOT } diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index 3d2ef19147b..2d6fb42489f 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -132,6 +132,7 @@ let parse_file' mode at filename : (Syntax.prog * rel_path) Diag.result = ) let parse_file = parse_file' Lexer.mode +let parse_verification_file = parse_file' Lexer.mode_verification (* Import file name resolution *) @@ -236,7 +237,7 @@ let internals, initial_stat_env = let parse_stab_sig s name = let open Diag.Syntax in - let mode = {Lexer.privileged = false} in + let mode = Lexer.{privileged = false; verification = false} in let lexer = Lexing.from_string s in let parse = Parser.Incremental.parse_stab_sig in let* sig_ = generic_parse_with mode lexer parse name in @@ -246,7 +247,7 @@ let parse_stab_sig_from_file filename : Syntax.stab_sig Diag.result = let ic = Stdlib.open_in filename in Diag.finally (fun () -> close_in ic) ( let open Diag.Syntax in - let mode = {Lexer.privileged = false} in + let mode = Lexer.{privileged = false; verification = false} in let lexer = Lexing.from_channel ic in let parse = Parser.Incremental.parse_stab_sig in let* sig_ = generic_parse_with mode lexer parse filename in @@ -489,7 +490,7 @@ type viper_result = (string * (Source.region -> Source.region option)) Diag.resu let viper_files' parsefn files : viper_result = let open Diag.Syntax in - let* libs, progs, senv = load_progs parse_file files initial_stat_env in + let* libs, progs, senv = load_progs parsefn files initial_stat_env in let* () = Typing.check_actors senv progs in let prog = CompUnit.combine_progs progs in let u = CompUnit.comp_unit_of_prog false prog in @@ -498,7 +499,7 @@ let viper_files' parsefn files : viper_result = Diag.return s let viper_files files : viper_result = - viper_files' parse_file files + viper_files' parse_verification_file files (* Generate IDL *) diff --git a/test/fail/ok/verification-asserts.tc.ok b/test/fail/ok/verification-asserts.tc.ok new file mode 100644 index 00000000000..f8aaf7c217a --- /dev/null +++ b/test/fail/ok/verification-asserts.tc.ok @@ -0,0 +1,10 @@ +verification-asserts.mo:1.1-1.19: syntax error [M0181], verification assertions not permitted in normal mode +verification-asserts.mo:2.1-2.20: syntax error [M0181], verification assertions not permitted in normal mode +verification-asserts.mo:3.1-3.17: syntax error [M0181], verification assertions not permitted in normal mode +verification-asserts.mo:4.1-4.19: syntax error [M0181], verification assertions not permitted in normal mode +verification-asserts.mo:7.8-7.17: syntax error [M0001], unexpected token 'invariant', expected one of token or sequence: + system + return + invariant + func + : async diff --git a/test/fail/ok/verification-asserts.tc.ret.ok b/test/fail/ok/verification-asserts.tc.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/fail/ok/verification-asserts.tc.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/fail/ok/verification-implies.tc.ok b/test/fail/ok/verification-implies.tc.ok new file mode 100644 index 00000000000..c28341b61ad --- /dev/null +++ b/test/fail/ok/verification-implies.tc.ok @@ -0,0 +1,4 @@ +verification-implies.mo:2.1-2.5: type error [M0097], expected function type, but expression produces type + Bool +verification-implies.mo:2.5-2.6: info, this looks like an unintended function call, perhaps a missing ';'? +verification-implies.mo:2.6-2.13: type error [M0057], unbound variable implies diff --git a/test/fail/ok/verification-implies.tc.ret.ok b/test/fail/ok/verification-implies.tc.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/fail/ok/verification-implies.tc.ret.ok @@ -0,0 +1 @@ +Return code 1 diff --git a/test/fail/verification-asserts.mo b/test/fail/verification-asserts.mo new file mode 100644 index 00000000000..6be7d479170 --- /dev/null +++ b/test/fail/verification-asserts.mo @@ -0,0 +1,7 @@ +assert:system true; +assert:1:async true; +assert:func true; +assert:return true; + +// `invariant` is a keyword in verification mode only +assert:invariant true; diff --git a/test/fail/verification-implies.mo b/test/fail/verification-implies.mo new file mode 100644 index 00000000000..51652748434 --- /dev/null +++ b/test/fail/verification-implies.mo @@ -0,0 +1,2 @@ +// `implies` is a keyword in verification mode only +true implies true; diff --git a/test/viper/Makefile b/test/viper/Makefile index 23a8f8b267b..9a04148d1e1 100644 --- a/test/viper/Makefile +++ b/test/viper/Makefile @@ -1,4 +1,5 @@ RUNFLAGS = -v +export MOC_UNLOCK_VERIFICATION = viper all: ../run.sh $(RUNFLAGS) *.mo diff --git a/test/viper/ok/claim-broken.silicon.ret.ok b/test/viper/ok/claim-broken.silicon.ret.ok new file mode 100644 index 00000000000..69becfa16f9 --- /dev/null +++ b/test/viper/ok/claim-broken.silicon.ret.ok @@ -0,0 +1 @@ +Return code 1 From 15152f8dcb406060f84bbe03e6df90587bc78e7a Mon Sep 17 00:00:00 2001 From: Ryan Vandersmith Date: Tue, 15 Nov 2022 16:31:45 -0700 Subject: [PATCH 59/81] viper: enable recent VS Code extension improvements (#3581) * Add source locations to AST s-expressions * Return module type information and source locations with AST * Update 'parseCandid()' to use new output format * Combine diagnostic messages from parsing and type checking * Split 'parseMotoko' and 'parseMotokoTypes' for different use cases * Fix pattern matching precedence * Add source locations to fields, cases, variant tags, and type bindings * Add source locations to pat_field * Combine Arrange and Arrange_source modules using a config arg * Use functor pattern for Arrange config * Update interface for node-motoko * Account for imports in moc.js parseMotokoTyped() * Enable passing multiple paths to parseMotokoTyped() * Replace type ASTs with strings * Add version property to 'moc.js' and 'moc_interpreter.js' exports * Add setCandidPath() function to 'moc.js' and 'moc_interpreter.js' * Rename 'Arrange_types' -> 'Arrange_sources_types' for clarity * Include type annotations for patterns * Elide async type scopes with 'show_stamps' setting * Return empty string instead of main file path to simplify source location s-expressions * Annotate 'typ' s-expression with pretty type string * Fix missing line of code after merge --- src/js/common.ml | 45 +++- src/js/moc_interpreter.ml | 2 + src/js/moc_js.ml | 5 +- src/mo_def/arrange.ml | 427 +++++++++++++++++++++----------------- src/mo_types/type.ml | 16 +- 5 files changed, 283 insertions(+), 212 deletions(-) diff --git a/src/js/common.ml b/src/js/common.ml index 238b4af81be..483211c322c 100644 --- a/src/js/common.ml +++ b/src/js/common.ml @@ -53,6 +53,8 @@ let js_result (result : 'a Diag.result) (wrap_code: 'a -> 'b) = val code = Js.null end +let js_version = Js.string Source_id.id + let js_check source = js_result (Pipeline.check_files [Js.to_string source]) (fun _ -> Js.null) @@ -114,18 +116,38 @@ let js_compile_wasm mode source = val stable = sig_ end)) -let js_parse_motoko s = - let parse_result = Pipeline.parse_string "main" (Js.to_string s) in - js_result parse_result (fun (prog, _) -> - (* let _ = Pipeline.infer_prog *) - let ast = Mo_def.Arrange.prog prog in - Js.some (js_of_sexpr ast)) - let js_parse_candid s = let parse_result = Idllib.Pipeline.parse_string (Js.to_string s) in js_result parse_result (fun (prog, _) -> - let ast = Idllib.Arrange_idl.prog prog in - Js.some (js_of_sexpr ast)) + Js.some (js_of_sexpr (Idllib.Arrange_idl.prog prog))) + +let js_parse_motoko s = + let main_file = "" in + let parse_result = Pipeline.parse_string main_file (Js.to_string s) in + js_result parse_result (fun (prog, _) -> + let module Arrange = Mo_def.Arrange.Make (struct + let include_sources = true + let include_types = false + let main_file = Some main_file + end) + in Js.some (js_of_sexpr (Arrange.prog prog))) + +let js_parse_motoko_typed paths = + let paths = paths |> Js.to_array |> Array.to_list in + let + load_result = Pipeline.load_progs Pipeline.parse_file (paths |> List.map Js.to_string) Pipeline.initial_stat_env + in + js_result load_result (fun (libs, progs, senv) -> + progs |> List.map (fun prog -> + let module Arrange_sources_types = Mo_def.Arrange.Make (struct + let include_sources = true + let include_types = true + let main_file = Some prog.at.left.file + end) + in object%js + val ast = js_of_sexpr (Arrange_sources_types.prog prog) + (* val typ = js_of_sexpr (Arrange_sources_types.typ typ) *) + end) |> Array.of_list |> Js.array |> Js.some) let js_save_file filename content = let filename = Js.to_string filename in @@ -155,13 +177,18 @@ let wrap_output f = let add_package package dir = let libs = Flags.package_urls in libs := Flags.M.add (Js.to_string package) (Js.to_string dir) !libs + let clear_package () = Flags.package_urls := Flags.M.empty + +let set_candid_path path = Flags.actor_idl_path := Some (Js.to_string path) + let set_actor_aliases entries = let entries = Array.map (fun kv -> let kv = Js.to_array kv in Js.to_string (Array.get kv 0), Js.to_string (Array.get kv 1)) (Js.to_array entries) in let aliases = Flags.actor_aliases in aliases := Flags.M.of_seq (Array.to_seq entries) + let set_public_metadata entries = let entries = Array.map Js.to_string (Js.to_array entries) in Flags.public_metadata_names := Array.to_list entries diff --git a/src/js/moc_interpreter.ml b/src/js/moc_interpreter.ml index 2b050c87e27..e072554d29e 100644 --- a/src/js/moc_interpreter.ml +++ b/src/js/moc_interpreter.ml @@ -13,9 +13,11 @@ let () = Flags.actor_idl_path := Some "idl/"; Js.export "Motoko" (object%js + val version = js_version method saveFile name content = js_save_file name content method addPackage package dir = add_package package dir method clearPackage () = clear_package () + method setCandidPath path = set_candid_path path method setActorAliases entries = set_actor_aliases entries method run list s = wrap_output (fun _ -> js_run list s) end); diff --git a/src/js/moc_js.ml b/src/js/moc_js.ml index d03fd7e3628..ec2488a136f 100644 --- a/src/js/moc_js.ml +++ b/src/js/moc_js.ml @@ -12,6 +12,7 @@ let () = Flags.actor_idl_path := Some "idl/"; Js.export "Motoko" (object%js + val version = js_version method saveFile name content = js_save_file name content method removeFile name = js_remove_file name method renameFile oldpath newpath = js_rename_file oldpath newpath @@ -19,6 +20,7 @@ let () = method readDir path = js_read_dir path method addPackage package dir = add_package package dir method clearPackage () = clear_package () + method setCandidPath path = set_candid_path path method setActorAliases entries = set_actor_aliases entries method setPublicMetadata entries = set_public_metadata entries method gcFlags option = gc_flags option @@ -28,6 +30,7 @@ let () = method candid s = Flags.compiled := true; js_candid s method stableCompatible pre post = js_stable_compatible pre post method compileWasm mode s = Flags.compiled := true; js_compile_wasm mode s - method parseMotoko s = js_parse_motoko s method parseCandid s = js_parse_candid s + method parseMotoko s = js_parse_motoko s + method parseMotokoTyped paths = js_parse_motoko_typed paths end); diff --git a/src/mo_def/arrange.ml b/src/mo_def/arrange.ml index f73532d0d99..ccb20d2d10c 100644 --- a/src/mo_def/arrange.ml +++ b/src/mo_def/arrange.ml @@ -5,185 +5,218 @@ open Source open Syntax open Wasm.Sexpr -let ($$) head inner = Node (head, inner) - -and id i = Atom i.it -and tag i = Atom ("#" ^ i.it) - -let rec exp e = match e.it with - | VarE x -> "VarE" $$ [id x] - | LitE l -> "LitE" $$ [lit !l] - | ActorUrlE e -> "ActorUrlE" $$ [exp e] - | UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; Arrange_ops.unop uo; exp e] - | BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; Arrange_ops.binop bo; exp e2] - | RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; Arrange_ops.relop ro; exp e2] - | ShowE (ot, e) -> "ShowE" $$ [operator_type !ot; exp e] - | ToCandidE es -> "ToCandidE" $$ exps es - | FromCandidE e -> "FromCandidE" $$ [exp e] - | TupE es -> "TupE" $$ exps es - | ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)] - | ObjBlockE (s, dfs) -> "ObjBlockE" $$ [obj_sort s] @ List.map dec_field dfs - | ObjE ([], efs) -> "ObjE" $$ List.map exp_field efs - | ObjE (bases, efs) -> "ObjE" $$ exps bases @ [Atom "with"] @ List.map exp_field efs - | DotE (e, x) -> "DotE" $$ [exp e; id x] - | AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2] - | ArrayE (m, es) -> "ArrayE" $$ [mut m] @ exps es - | IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2] - | FuncE (x, sp, tp, p, t, sugar, e') -> - "FuncE" $$ [ - Atom (Type.string_of_typ e.note.note_typ); - shared_pat sp; - Atom x] @ - List.map typ_bind tp @ [ - pat p; - (match t with None -> Atom "_" | Some t -> typ t); - Atom (if sugar then "" else "="); - exp e' - ] - | CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ inst ts @ [exp e2] - | BlockE ds -> "BlockE" $$ List.map dec ds - | NotE e -> "NotE" $$ [exp e] - | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] - | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] - | ImpliesE (e1, e2) -> "ImpliesE"$$ [exp e1; exp e2] - | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] - | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs - | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] - | LoopE (e1, None) -> "LoopE" $$ [exp e1] - | LoopE (e1, Some e2) -> "LoopE" $$ [exp e1; exp e2] - | ForE (p, e1, e2) -> "ForE" $$ [pat p; exp e1; exp e2] - | LabelE (i, t, e) -> "LabelE" $$ [id i; typ t; exp e] - | DebugE e -> "DebugE" $$ [exp e] - | BreakE (i, e) -> "BreakE" $$ [id i; exp e] - | RetE e -> "RetE" $$ [exp e] - | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] - | AwaitE e -> "AwaitE" $$ [exp e] - | AssertE (Runtime, e) -> "AssertE" $$ [exp e] - | AssertE (Static, e) -> "Static_AssertE" $$ [exp e] - | AssertE (Invariant, e) -> "Invariant" $$ [exp e] - | AssertE (Precondition, e) -> "Precondition" $$ [exp e] - | AssertE (Postcondition, e) -> "Postcondition" $$ [exp e] - | AssertE (Loop_entry, e) -> "Loop_entry" $$ [exp e] - | AssertE (Loop_continue, e) -> "Loop_continue" $$ [exp e] - | AssertE (Loop_exit, e) -> "Loop_exit" $$ [exp e] - | AssertE (Concurrency s, e) -> "Concurrency"^s $$ [exp e] - | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] - | OptE e -> "OptE" $$ [exp e] - | DoOptE e -> "DoOptE" $$ [exp e] - | BangE e -> "BangE" $$ [exp e] - | TagE (i, e) -> "TagE" $$ [id i; exp e] - | PrimE p -> "PrimE" $$ [Atom p] - | ImportE (f, _fp) -> "ImportE" $$ [Atom f] - | ThrowE e -> "ThrowE" $$ [exp e] - | TryE (e, cs) -> "TryE" $$ [exp e] @ List.map catch cs - | IgnoreE e -> "IgnoreE" $$ [exp e] - -and exps es = List.map exp es - -and inst inst = match inst.it with - | None -> [] - | Some ts -> List.map typ ts - -and pat p = match p.it with - | WildP -> Atom "WildP" - | VarP x -> "VarP" $$ [id x] - | TupP ps -> "TupP" $$ List.map pat ps - | ObjP ps -> "ObjP" $$ List.map pat_field ps - | AnnotP (p, t) -> "AnnotP" $$ [pat p; typ t] - | LitP l -> "LitP" $$ [lit !l] - | SignP (uo, l) -> "SignP" $$ [Arrange_ops.unop uo ; lit !l] - | OptP p -> "OptP" $$ [pat p] - | TagP (i, p) -> "TagP" $$ [tag i; pat p] - | AltP (p1,p2) -> "AltP" $$ [pat p1; pat p2] - | ParP p -> "ParP" $$ [pat p] - -and lit = function - | NullLit -> Atom "NullLit" - | BoolLit true -> "BoolLit" $$ [ Atom "true" ] - | BoolLit false -> "BoolLit" $$ [ Atom "false" ] - | NatLit n -> "NatLit" $$ [ Atom (Numerics.Nat.to_pretty_string n) ] - | Nat8Lit n -> "Nat8Lit" $$ [ Atom (Numerics.Nat8.to_pretty_string n) ] - | Nat16Lit n -> "Nat16Lit" $$ [ Atom (Numerics.Nat16.to_pretty_string n) ] - | Nat32Lit n -> "Nat32Lit" $$ [ Atom (Numerics.Nat32.to_pretty_string n) ] - | Nat64Lit n -> "Nat64Lit" $$ [ Atom (Numerics.Nat64.to_pretty_string n) ] - | IntLit i -> "IntLit" $$ [ Atom (Numerics.Int.to_pretty_string i) ] - | Int8Lit i -> "Int8Lit" $$ [ Atom (Numerics.Int_8.to_pretty_string i) ] - | Int16Lit i -> "Int16Lit" $$ [ Atom (Numerics.Int_16.to_pretty_string i) ] - | Int32Lit i -> "Int32Lit" $$ [ Atom (Numerics.Int_32.to_pretty_string i) ] - | Int64Lit i -> "Int64Lit" $$ [ Atom (Numerics.Int_64.to_pretty_string i) ] - | FloatLit f -> "FloatLit" $$ [ Atom (Numerics.Float.to_pretty_string f) ] - | CharLit c -> "CharLit" $$ [ Atom (string_of_int c) ] - | TextLit t -> "TextLit" $$ [ Atom t ] - | BlobLit b -> "BlobLit" $$ [ Atom b ] - | PreLit (s,p) -> "PreLit" $$ [ Atom s; Arrange_type.prim p ] - -and case c = "case" $$ [pat c.it.pat; exp c.it.exp] - -and catch c = "catch" $$ [pat c.it.pat; exp c.it.exp] - -and pat_field pf = pf.it.id.it $$ [pat pf.it.pat] - -and obj_sort s = match s.it with - | Type.Object -> Atom "Object" - | Type.Actor -> Atom "Actor" - | Type.Module -> Atom "Module" - | Type.Memory -> Atom "Memory" - -and shared_pat sp = match sp.it with - | Type.Local -> Atom "Local" - | Type.Shared (Type.Write, p) -> "Shared" $$ [pat p] - | Type.Shared (Type.Query, p) -> "Query" $$ [pat p] - -and func_sort s = match s.it with - | Type.Local -> Atom "Local" - | Type.Shared Type.Write -> Atom "Shared" - | Type.Shared Type.Query -> Atom "Query" - -and mut m = match m.it with - | Const -> Atom "Const" - | Var -> Atom "Var" - -and vis v = match v.it with - | Public None -> Atom "Public" - | Public (Some m) -> "Public" $$ [Atom m] - | Private -> Atom "Private" - | System -> Atom "System" - -and stab s_opt = match s_opt with - | None -> Atom "(Flexible)" - | Some s -> - (match s.it with - | Flexible -> Atom "Flexible" - | Stable -> Atom "Stable") - -and typ_field (tf : typ_field) = match tf.it with - | ValF (id, t, m) -> id.it $$ [typ t; mut m] - | TypF (id', tbs, t) -> - "TypF" $$ [id id'] @ List.map typ_bind tbs @ [typ t] -and typ_item ((id, ty) : typ_item) = - match id with - | None -> [typ ty] - | Some { it;_ } -> [Atom it; typ ty] - -and typ_tag (tt : typ_tag) - = tt.it.tag.it $$ [typ tt.it.typ] - -and typ_bind (tb : typ_bind) - = tb.it.var.it $$ [typ tb.it.bound] - -and dec_field (df : dec_field) - = "DecField" $$ [dec df.it.dec; vis df.it.vis; stab df.it.stab] - -and exp_field (ef : exp_field) - = "ExpField" $$ [mut ef.it.mut; id ef.it.id; exp ef.it.exp] - -and operator_type t = Atom (Type.string_of_typ t) - -and path p = match p.it with - | IdH i -> "IdH" $$ [id i] - | DotH (p,i) -> "DotH" $$ [path p; id i] - -and typ t = match t.it with +module type Config = sig + val include_sources : bool + val include_types : bool + val main_file : string option +end + +module Default = struct + let include_sources = false + let include_types = false + let main_file = None +end + +module Type_pretty = Mo_types.Type.MakePretty (Mo_types.Type.ElideStamps) + +module Make (Cfg : Config) = struct + let ($$) head inner = Node (head, inner) + + let pos p = + let file = match Cfg.main_file with + | Some f when f <> p.file -> p.file + | _ -> "" + in "Pos" $$ [Atom file; Atom (string_of_int p.line); Atom (string_of_int p.column)] + let source at it = if Cfg.include_sources && at <> Source.no_region then "@" $$ [pos at.left; pos at.right; it] else it + + let typ typ = Atom (Type_pretty.string_of_typ typ) + (* let typ typ = Atom (Type.string_of_typ typ) *) + (* let typ = Mo_types.Arrange_type.typ *) + + let eff (eff : Mo_types.Type.eff) = match eff with + | Mo_types.Type.Triv -> Atom "Triv" + | Mo_types.Type.Await -> Atom "Await" + + let annot_typ t it = if Cfg.include_types then ":" $$ [it; typ t] else it + let annot note = annot_typ note.note_typ + + let id i = Atom i.it + let tag i = Atom ("#" ^ i.it) + + let rec exp e = match e.it with + | VarE x -> "VarE" $$ [id x] + | LitE l -> "LitE" $$ [lit !l] + | ActorUrlE e -> "ActorUrlE" $$ [exp e] + | UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; Arrange_ops.unop uo; exp e] + | BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; Arrange_ops.binop bo; exp e2] + | RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; Arrange_ops.relop ro; exp e2] + | ShowE (ot, e) -> "ShowE" $$ [operator_type !ot; exp e] + | ToCandidE es -> "ToCandidE" $$ exps es + | FromCandidE e -> "FromCandidE" $$ [exp e] + | TupE es -> "TupE" $$ exps es + | ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)] + | ObjBlockE (s, dfs) -> "ObjBlockE" $$ [obj_sort s] @ List.map dec_field dfs + | ObjE ([], efs) -> "ObjE" $$ List.map exp_field efs + | ObjE (bases, efs) -> "ObjE" $$ exps bases @ [Atom "with"] @ List.map exp_field efs + | DotE (e, x) -> "DotE" $$ [exp e; id x] + | AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2] + | ArrayE (m, es) -> "ArrayE" $$ [mut m] @ exps es + | IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2] + | FuncE (x, sp, tp, p, t, sugar, e') -> + "FuncE" $$ [ + Atom (Type.string_of_typ e.note.note_typ); + shared_pat sp; + Atom x] @ + List.map typ_bind tp @ [ + pat p; + (match t with None -> Atom "_" | Some t -> typ t); + Atom (if sugar then "" else "="); + exp e' + ] + | CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ inst ts @ [exp e2] + | BlockE ds -> "BlockE" $$ List.map dec ds + | NotE e -> "NotE" $$ [exp e] + | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] + | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] + | ImpliesE (e1, e2) -> "ImpliesE"$$ [exp e1; exp e2] + | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] + | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs + | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] + | LoopE (e1, None) -> "LoopE" $$ [exp e1] + | LoopE (e1, Some e2) -> "LoopE" $$ [exp e1; exp e2] + | ForE (p, e1, e2) -> "ForE" $$ [pat p; exp e1; exp e2] + | LabelE (i, t, e) -> "LabelE" $$ [id i; typ t; exp e] + | DebugE e -> "DebugE" $$ [exp e] + | BreakE (i, e) -> "BreakE" $$ [id i; exp e] + | RetE e -> "RetE" $$ [exp e] + | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] + | AwaitE e -> "AwaitE" $$ [exp e] + | AssertE (Runtime, e) -> "AssertE" $$ [exp e] + | AssertE (Static, e) -> "Static_AssertE" $$ [exp e] + | AssertE (Invariant, e) -> "Invariant" $$ [exp e] + | AssertE (Precondition, e) -> "Precondition" $$ [exp e] + | AssertE (Postcondition, e) -> "Postcondition" $$ [exp e] + | AssertE (Loop_entry, e) -> "Loop_entry" $$ [exp e] + | AssertE (Loop_continue, e) -> "Loop_continue" $$ [exp e] + | AssertE (Loop_exit, e) -> "Loop_exit" $$ [exp e] + | AssertE (Concurrency s, e) -> "Concurrency"^s $$ [exp e] + | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] + | OptE e -> "OptE" $$ [exp e] + | DoOptE e -> "DoOptE" $$ [exp e] + | BangE e -> "BangE" $$ [exp e] + | TagE (i, e) -> "TagE" $$ [id i; exp e] + | PrimE p -> "PrimE" $$ [Atom p] + | ImportE (f, _fp) -> "ImportE" $$ [Atom f] + | ThrowE e -> "ThrowE" $$ [exp e] + | TryE (e, cs) -> "TryE" $$ [exp e] @ List.map catch cs + | IgnoreE e -> "IgnoreE" $$ [exp e] + + and exps es = List.map exp es + + and inst inst = match inst.it with + | None -> [] + | Some ts -> List.map typ ts + + and pat p = source p.at (annot_typ p.note (match p.it with + | WildP -> Atom "WildP" + | VarP x -> "VarP" $$ [id x] + | TupP ps -> "TupP" $$ List.map pat ps + | ObjP ps -> "ObjP" $$ List.map pat_field ps + | AnnotP (p, t) -> "AnnotP" $$ [pat p; typ t] + | LitP l -> "LitP" $$ [lit !l] + | SignP (uo, l) -> "SignP" $$ [Arrange_ops.unop uo ; lit !l] + | OptP p -> "OptP" $$ [pat p] + | TagP (i, p) -> "TagP" $$ [tag i; pat p] + | AltP (p1, p2) -> "AltP" $$ [pat p1; pat p2] + | ParP p -> "ParP" $$ [pat p])) + + and lit = function + | NullLit -> Atom "NullLit" + | BoolLit true -> "BoolLit" $$ [ Atom "true" ] + | BoolLit false -> "BoolLit" $$ [ Atom "false" ] + | NatLit n -> "NatLit" $$ [ Atom (Numerics.Nat.to_pretty_string n) ] + | Nat8Lit n -> "Nat8Lit" $$ [ Atom (Numerics.Nat8.to_pretty_string n) ] + | Nat16Lit n -> "Nat16Lit" $$ [ Atom (Numerics.Nat16.to_pretty_string n) ] + | Nat32Lit n -> "Nat32Lit" $$ [ Atom (Numerics.Nat32.to_pretty_string n) ] + | Nat64Lit n -> "Nat64Lit" $$ [ Atom (Numerics.Nat64.to_pretty_string n) ] + | IntLit i -> "IntLit" $$ [ Atom (Numerics.Int.to_pretty_string i) ] + | Int8Lit i -> "Int8Lit" $$ [ Atom (Numerics.Int_8.to_pretty_string i) ] + | Int16Lit i -> "Int16Lit" $$ [ Atom (Numerics.Int_16.to_pretty_string i) ] + | Int32Lit i -> "Int32Lit" $$ [ Atom (Numerics.Int_32.to_pretty_string i) ] + | Int64Lit i -> "Int64Lit" $$ [ Atom (Numerics.Int_64.to_pretty_string i) ] + | FloatLit f -> "FloatLit" $$ [ Atom (Numerics.Float.to_pretty_string f) ] + | CharLit c -> "CharLit" $$ [ Atom (string_of_int c) ] + | TextLit t -> "TextLit" $$ [ Atom t ] + | BlobLit b -> "BlobLit" $$ [ Atom b ] + | PreLit (s, p) -> "PreLit" $$ [ Atom s; Arrange_type.prim p ] + + and case c = source c.at ("case" $$ [pat c.it.pat; exp c.it.exp]) + + and catch c = "catch" $$ [pat c.it.pat; exp c.it.exp] + + and pat_field pf = source pf.at (pf.it.id.it $$ [pat pf.it.pat]) + + and obj_sort s = match s.it with + | Type.Object -> Atom "Object" + | Type.Actor -> Atom "Actor" + | Type.Module -> Atom "Module" + | Type.Memory -> Atom "Memory" + + and shared_pat sp = match sp.it with + | Type.Local -> Atom "Local" + | Type.Shared (Type.Write, p) -> "Shared" $$ [pat p] + | Type.Shared (Type.Query, p) -> "Query" $$ [pat p] + + and func_sort s = match s.it with + | Type.Local -> Atom "Local" + | Type.Shared Type.Write -> Atom "Shared" + | Type.Shared Type.Query -> Atom "Query" + + and mut m = match m.it with + | Const -> Atom "Const" + | Var -> Atom "Var" + + and vis v = match v.it with + | Public None -> Atom "Public" + | Public (Some m) -> "Public" $$ [Atom m] + | Private -> Atom "Private" + | System -> Atom "System" + + and stab s_opt = match s_opt with + | None -> Atom "(Flexible)" + | Some s -> + (match s.it with + | Flexible -> Atom "Flexible" + | Stable -> Atom "Stable") + + and typ_field (tf : typ_field) = match tf.it with + | ValF (id, t, m) -> id.it $$ [typ t; mut m] + | TypF (id', tbs, t) -> + "TypF" $$ [id id'] @ List.map typ_bind tbs @ [typ t] + and typ_item ((id, ty) : typ_item) = + match id with + | None -> [typ ty] + | Some { it;_ } -> [Atom it; typ ty] + + and typ_tag (tt : typ_tag) + = source tt.at (tt.it.tag.it $$ [typ tt.it.typ]) + + and typ_bind (tb : typ_bind) + = source tb.at (tb.it.var.it $$ [typ tb.it.bound]) + + and dec_field (df : dec_field) + = source df.at ("DecField" $$ [dec df.it.dec; vis df.it.vis; stab df.it.stab]) + + and exp_field (ef : exp_field) + = source ef.at ("ExpField" $$ [mut ef.it.mut; id ef.it.id; exp ef.it.exp]) + + and operator_type t = Atom (Type.string_of_typ t) + + and path p = match p.it with + | IdH i -> "IdH" $$ [id i] + | DotH (p, i) -> "DotH" $$ [path p; id i] + + and typ t = source t.at (annot_typ t.note (match t.it with | PathT (p, ts) -> "PathT" $$ [path p] @ List.map typ ts | PrimT p -> "PrimT" $$ [Atom p] | ObjT (s, ts) -> "ObjT" $$ [obj_sort s] @ List.map typ_field ts @@ -196,19 +229,23 @@ and typ t = match t.it with | AndT (t1, t2) -> "AndT" $$ [typ t1; typ t2] | OrT (t1, t2) -> "OrT" $$ [typ t1; typ t2] | ParT t -> "ParT" $$ [typ t] - | NamedT (id, t) -> "NamedT" $$ [Atom id.it; typ t] - -and dec d = match d.it with - | ExpD e -> "ExpD" $$ [exp e ] - | LetD (p, e) -> "LetD" $$ [pat p; exp e] - | VarD (x, e) -> "VarD" $$ [id x; exp e] - | TypD (x, tp, t) -> - "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] - | ClassD (sp, x, tp, p, rt, s, i', dfs) -> - "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [ - pat p; - (match rt with None -> Atom "_" | Some t -> typ t); - obj_sort s; id i' - ] @ List.map dec_field dfs - -and prog prog = "Prog" $$ List.map dec prog.it + | NamedT (id, t) -> "NamedT" $$ [Atom id.it; typ t])) + + and dec d = source d.at (match d.it with + | ExpD e -> "ExpD" $$ [exp e ] + | LetD (p, e) -> "LetD" $$ [pat p; exp e] + | VarD (x, e) -> "VarD" $$ [id x; exp e] + | TypD (x, tp, t) -> + "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] + | ClassD (sp, x, tp, p, rt, s, i', dfs) -> + "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [ + pat p; + (match rt with None -> Atom "_" | Some t -> typ t); + obj_sort s; id i' + ] @ List.map dec_field dfs) + + and prog p = "Prog" $$ List.map dec p.it +end + +(* Defaults *) +include Make (Default) diff --git a/src/mo_types/type.ml b/src/mo_types/type.ml index 65afc1f2065..f2b8d190b28 100644 --- a/src/mo_types/type.ml +++ b/src/mo_types/type.ml @@ -1529,13 +1529,15 @@ and pp_typ_pre vs ppf t = match t with (* No case for grammar production `PRIM s` *) | Async (t1, t2) -> - (match t1 with - | Var(_, n) when fst (List.nth vs n) = "" -> - fprintf ppf "@[<2>async@ %a@]" (pp_typ_pre vs) t2 - | _ -> - fprintf ppf "@[<2>async<%a>@ %a@]" - (pp_typ' vs) t1 - (pp_typ_pre vs) t2) + if Cfg.show_stamps then + match t1 with + | Var(_, n) when fst (List.nth vs n) = "" -> + fprintf ppf "@[<2>async@ %a@]" (pp_typ_pre vs) t2 + | _ -> + fprintf ppf "@[<2>async<%a>@ %a@]" + (pp_typ' vs) t1 + (pp_typ_pre vs) t2 + else fprintf ppf "@[<2>async@ %a@]" (pp_typ_pre vs) t2 | Obj ((Module | Actor | Memory) as os, fs) -> pp_typ_obj vs ppf (os, fs) | t -> From fbf13f51f2733d209fd95066c7fef9cee76a345d Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Nov 2022 14:07:35 +0100 Subject: [PATCH 60/81] cover `WhileS`, but no invariant yet --- src/viper/pretty.ml | 4 ++++ test/viper/invariant.mo | 7 +++++++ test/viper/ok/invariant.silicon.ok | 4 +++- test/viper/ok/invariant.vpr.ok | 12 ++++++++++++ 4 files changed, 26 insertions(+), 1 deletion(-) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index 028a3954e9e..e00d7004215 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -145,6 +145,10 @@ and pp_stmt' ppf = function pp_exp exp1 pp_seqn s1 pp_seqn s2 + | WhileS (exp, _, s) -> (* TODO: Invariant *) + fprintf ppf "@[while (%a) {@ %a}@]" + pp_exp exp + pp_seqn s | VarAssignS (id, exp) -> fprintf ppf "@[%s := %a@]" id.it diff --git a/test/viper/invariant.mo b/test/viper/invariant.mo index 3c34277434f..01529eff0af 100644 --- a/test/viper/invariant.mo +++ b/test/viper/invariant.mo @@ -16,4 +16,11 @@ actor { assert:return count >= 0; }; + public shared func loops(/*j : Int*/) : async () { + //var i = j; + while (/*i > 0*/false) { + //i -= 1 + } + } + } diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok index 94a1ad16eff..7b8e4f5de10 100644 --- a/test/viper/ok/invariant.silicon.ok +++ b/test/viper/ok/invariant.silicon.ok @@ -1 +1,3 @@ - [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.13--7.24) +The operation couldn’t be completed. Unable to locate a Java Runtime. +Please visit http://www.java.com for information on installing Java. + diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index b18fd8bc713..5b5ea60450c 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -25,3 +25,15 @@ method claim($Self: Ref) { assume (($Self).claimed ==> (($Self).count > 0)) } +method loops($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + while (false) { + { + + }} + } From d097d3ce33c37e73d3431f0111c251a78e84fa8b Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Nov 2022 14:34:08 +0100 Subject: [PATCH 61/81] explicitly fail on `MethodCallS` and `LabelS` this fixes warnings --- src/viper/pretty.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/viper/pretty.ml b/src/viper/pretty.ml index e00d7004215..f1bdfcd2c0a 100644 --- a/src/viper/pretty.ml +++ b/src/viper/pretty.ml @@ -179,6 +179,8 @@ and pp_stmt' ppf = function fprintf ppf "@[/*concurrency max %s, cond: s %a*/@]" max pp_exp exp + | MethodCallS (_, _, _) + | LabelS (_, _) -> failwith "MethodCallS or LabelS?" and pp_fldacc ppf fldacc = match fldacc with From de28e14db0f7489d861ec87fa5cfaa06275cc4fe Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Nov 2022 14:47:07 +0100 Subject: [PATCH 62/81] Update default.nix Co-authored-by: Bas van Dijk --- default.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/default.nix b/default.nix index 02d887d1a2d..35844fbf99a 100644 --- a/default.nix +++ b/default.nix @@ -751,7 +751,7 @@ rec { builtins.attrValues js; }; - viperServer = builtins.fetchurl { + viperServer = nixpkgs.fetchurl { url = https://github.com/viperproject/viperserver/releases/download/v-2022-11-09-0713/viperserver.jar; sha256 = "sha256:0yqzmi7ci1zmdcsr4vkz05s5h9836vn4ap3hzj08y60rvgsab9k4"; }; From 4fd70110c4d498d22f47819ac560e1ec7c26eb12 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Nov 2022 14:52:47 +0100 Subject: [PATCH 63/81] refresh the download link --- default.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/default.nix b/default.nix index 35844fbf99a..a0507c26ade 100644 --- a/default.nix +++ b/default.nix @@ -752,8 +752,8 @@ rec { }; viperServer = nixpkgs.fetchurl { - url = https://github.com/viperproject/viperserver/releases/download/v-2022-11-09-0713/viperserver.jar; - sha256 = "sha256:0yqzmi7ci1zmdcsr4vkz05s5h9836vn4ap3hzj08y60rvgsab9k4"; + url = https://github.com/viperproject/viperserver/releases/download/v-2022-11-16-0717/viperserver.jar; + sha256 = "sha256:03y612gqcz671ch3m9yhsm4vcg6vfhh1h2sp5hx6xh0azi4k6z69"; }; shell = stdenv.mkDerivation { From d0c5f9d5d24b7bc104c874e431d127d0e1faa48c Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Nov 2022 15:01:48 +0100 Subject: [PATCH 64/81] accept --- test/fail/ok/syntax2.tc.ok | 1 + test/fail/ok/syntax3.tc.ok | 1 + test/fail/ok/syntax5.tc.ok | 1 + 3 files changed, 3 insertions(+) diff --git a/test/fail/ok/syntax2.tc.ok b/test/fail/ok/syntax2.tc.ok index 5b9912ffea4..eb3081e794b 100644 --- a/test/fail/ok/syntax2.tc.ok +++ b/test/fail/ok/syntax2.tc.ok @@ -7,6 +7,7 @@ syntax2.mo:2.1-2.4: syntax error [M0001], unexpected token 'let', expected one o ; seplist(,) or + implies . : diff --git a/test/fail/ok/syntax3.tc.ok b/test/fail/ok/syntax3.tc.ok index 70e7c6fb8d9..028eebd7729 100644 --- a/test/fail/ok/syntax3.tc.ok +++ b/test/fail/ok/syntax3.tc.ok @@ -6,6 +6,7 @@ syntax3.mo:1.3-1.4: syntax error [M0001], unexpected token ';', expected one of or + implies . , seplist(,,) diff --git a/test/fail/ok/syntax5.tc.ok b/test/fail/ok/syntax5.tc.ok index 62e5fef4e4d..95550080467 100644 --- a/test/fail/ok/syntax5.tc.ok +++ b/test/fail/ok/syntax5.tc.ok @@ -6,6 +6,7 @@ syntax5.mo:3.1: syntax error [M0001], unexpected end of input, expected one of t or + implies . , seplist(,,) From 401520de5543be74ae58da95d9dd56d8c890f14c Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Nov 2022 15:56:18 +0100 Subject: [PATCH 65/81] add ingredients for viper testing --- default.nix | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/default.nix b/default.nix index a0507c26ade..97495bdf70e 100644 --- a/default.nix +++ b/default.nix @@ -350,6 +350,7 @@ rec { patchShebangs . ${llvmEnv} export ESM=${nixpkgs.sources.esm} + export VIPER_SERVER=${viperServer} type -p moc && moc --version make -C ${dir} ''; @@ -490,7 +491,7 @@ rec { run-deser = test_subdir "run-deser" [ deser ]; perf = perf_subdir "perf" [ moc nixpkgs.drun ]; bench = perf_subdir "bench" [ moc nixpkgs.drun ]; - viper = perf_subdir "viper" [ moc ]; + viper = test_subdir "viper" [ moc nixpkgs.which nixpkgs.openjdk nixpkgs.z3 ]; inherit qc lsp unit candid profiling-graphs coverage; }) // { recurseForDerivations = true; }; From 91a4d92cf9e09abbadc8f8594596d1d52d396f7a Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Nov 2022 16:50:12 +0100 Subject: [PATCH 66/81] accept --- test/viper/ok/assertions.silicon.ok | 2 ++ test/viper/ok/async.silicon.ok | 1 + test/viper/ok/claim-broken.silicon.ok | 1 + test/viper/ok/invariant.silicon.ok | 3 +-- 4 files changed, 5 insertions(+), 2 deletions(-) diff --git a/test/viper/ok/assertions.silicon.ok b/test/viper/ok/assertions.silicon.ok index 202af03d0c2..b4fc83fc5a4 100644 --- a/test/viper/ok/assertions.silicon.ok +++ b/test/viper/ok/assertions.silicon.ok @@ -1,2 +1,4 @@ [0] Postcondition of __init__ might not hold. Assertion $Self.u might not hold. (assertions.vpr@10.13--10.24) + [1] Assert might fail. Assertion $Self.u ==> $Self.v > 0 might not hold. (assertions.vpr@28.15--28.44) + diff --git a/test/viper/ok/async.silicon.ok b/test/viper/ok/async.silicon.ok index 4cd9741c5a2..c094e0351ca 100644 --- a/test/viper/ok/async.silicon.ok +++ b/test/viper/ok/async.silicon.ok @@ -1 +1,2 @@ [0] Exhale might fail. Assertion $Self.$message_async <= 1 might not hold. (async.vpr@33.15--33.42) + diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok index 2738a3acfa7..f994146f206 100644 --- a/test/viper/ok/claim-broken.silicon.ok +++ b/test/viper/ok/claim-broken.silicon.ok @@ -1 +1,2 @@ [0] Exhale might fail. Assertion $Self.$message_async == 1 ==> $Self.claimed && $Self.count == 0 might not hold. (claim-broken.vpr@31.20--31.47) + diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok index 7b8e4f5de10..f605f1b9156 100644 --- a/test/viper/ok/invariant.silicon.ok +++ b/test/viper/ok/invariant.silicon.ok @@ -1,3 +1,2 @@ -The operation couldn’t be completed. Unable to locate a Java Runtime. -Please visit http://www.java.com for information on installing Java. + [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.13--7.24) From 857a0f73eff6cf708d5939d3c3d4f901fa2b500d Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Wed, 16 Nov 2022 21:07:16 +0100 Subject: [PATCH 67/81] undo merge snafu --- nix/drun.nix | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/nix/drun.nix b/nix/drun.nix index 20a28c0be19..46f4309ef91 100644 --- a/nix/drun.nix +++ b/nix/drun.nix @@ -38,28 +38,6 @@ EOF cd - ''; - patchPhase = '' - cd ../drun-vendor.tar.gz - ls -l librocksdb-sys/build.rs - patch librocksdb-sys/build.rs << EOF -@@ -118,6 +118,10 @@ - config.define("OS_MACOSX", Some("1")); - config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); - config.define("ROCKSDB_LIB_IO_POSIX", Some("1")); -+ if target.contains("aarch64") { -+ config.define("isSSE42()", Some("0")); -+ config.define("isPCLMULQDQ()", Some("0")); -+ } - } else if target.contains("android") { - config.define("OS_ANDROID", Some("1")); - config.define("ROCKSDB_PLATFORM_POSIX", Some("1")); -EOF - - sed -i -e s/08d86b53188dc6f15c8dc09d8aadece72e39f145e3ae497bb8711936a916335a/536e44802de57cc7d3690c90c80f154f770f48e82b82756c36443b8b47c9b5e7/g librocksdb-sys/.cargo-checksum.json - - cd - - ''; - nativeBuildInputs = with pkgs; [ pkg-config cmake From f24d08c97905df72f54b473ceb4a48a6027e2574 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Thu, 17 Nov 2022 00:05:17 +0100 Subject: [PATCH 68/81] simplify --- src/mo_frontend/parser.mly | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly index 3176b3ae56b..11135b7a77a 100644 --- a/src/mo_frontend/parser.mly +++ b/src/mo_frontend/parser.mly @@ -579,7 +579,6 @@ exp_plain : exp_nullary(B) : | e=B - { e } | e=exp_plain { e } | x=id @@ -730,7 +729,6 @@ exp(B) : %public exp_nest : | e=block - { e } | e=exp(bl) { e } From 5c3954f359e123394210619467c42c69d96be577 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 18 Nov 2022 10:53:57 +0000 Subject: [PATCH 69/81] move IMPLIES token to assertions.mly --- src/mo_frontend/assertions.mly | 9 ++++----- src/mo_frontend/parser.mly | 3 +-- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/src/mo_frontend/assertions.mly b/src/mo_frontend/assertions.mly index 8f6f1897bb5..01346682dbf 100644 --- a/src/mo_frontend/assertions.mly +++ b/src/mo_frontend/assertions.mly @@ -1,11 +1,10 @@ +(* viper only tokens and productions *) %token INVARIANT -(* I get -> Error: 54 states have shift/reduce conflicts. -when I write this here (instead of in parser.mly) - %token IMPLIES -%nonassoc IMPLIES +(* +%nonassoc IMPLIES (* see parser.mly *) *) + %% %public exp_bin(B) : diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly index 11135b7a77a..7c72594ac72 100644 --- a/src/mo_frontend/parser.mly +++ b/src/mo_frontend/parser.mly @@ -244,8 +244,7 @@ let is_verification = Lexer_lib.(mode.verification) %token PRIM %token UNDERSCORE -%token IMPLIES -%nonassoc IMPLIES +%nonassoc IMPLIES (* see assertions.mly *) %nonassoc RETURN_NO_ARG IF_NO_ELSE LOOP_NO_WHILE %nonassoc ELSE WHILE From 5072557b478874c557c886edd16b4b1d55b1123f Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Fri, 18 Nov 2022 10:58:02 +0000 Subject: [PATCH 70/81] tweaks --- src/mo_frontend/assertions.mly | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/mo_frontend/assertions.mly b/src/mo_frontend/assertions.mly index 01346682dbf..2a5ed4aa350 100644 --- a/src/mo_frontend/assertions.mly +++ b/src/mo_frontend/assertions.mly @@ -1,4 +1,5 @@ -(* viper only tokens and productions *) +(* Viper only tokens and productions *) + %token INVARIANT %token IMPLIES (* From f93555f0db111956fdc43a1e961f4d8a8b3b1528 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 18 Nov 2022 12:22:46 +0100 Subject: [PATCH 71/81] viper: associate the first `exhale` with the `async` expression (#3524) This changes the srcloc of certain Viper subexpression to better track the original Motoko. --- src/viper/trans.ml | 62 +++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/src/viper/trans.ml b/src/viper/trans.ml index 007777195d4..e6b851e188e 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -298,9 +298,10 @@ and stmt ctxt (s : M.exp) : seqn = | M.IfE(e, s1, s2) -> !!([], [ !!(IfS(exp ctxt e, stmt ctxt s1, stmt ctxt s2))]) - | M.(AwaitE({ it = AsyncE (_, e); at;_ })) -> (* gross hack *) + | M.(AwaitE({ it = AsyncE (_, e); at; _ })) -> (* gross hack *) let id = fresh_id "$message_async" in let (!!) p = !!! (s.at) p in + let (!@) p = !!! at p in ctxt.ghost_items := (fun ctxt -> !!(FieldI (!!id, !!IntT))) :: @@ -323,40 +324,39 @@ and stmt ctxt (s : M.exp) : seqn = | [] -> fun _ x -> x | ConcurrencyS ("1", _, cond) :: _ -> - let (!!) p = !!! (cond.at) p in + let (!?) p = !!! (cond.at) p in let zero, one = intLitE Source.no_region 0, intLitE Source.no_region 1 in fun ctxt x -> - let ghost_fld () = !!(FldAcc (self ctxt cond.at, !!id)) in - let between = !!(AndE (!!(LeCmpE (zero, ghost_fld ())), !!(LeCmpE (ghost_fld (), one)))) in - let is_one = !!(EqCmpE (ghost_fld (), one)) in - !!(AndE (x, !!(AndE (between, !!(Implies (is_one, cond.it (exp ctxt))))))) + let ghost_fld () = !?(FldAcc (self ctxt cond.at, !?id)) in + let between = !?(AndE (!?(LeCmpE (zero, ghost_fld ())), !?(LeCmpE (ghost_fld (), one)))) in + let is_one = !?(EqCmpE (ghost_fld (), one)) in + !?(AndE (x, !?(AndE (between, !?(Implies (is_one, cond.it (exp ctxt))))))) | _ -> unsupported e.at (Arrange.exp e) in ctxt.ghost_conc := mk_c :: !(ctxt.ghost_conc); - !! ([], - [ !!(FieldAssignS( - (self ctxt Source.no_region, !!id), - (!!(AddE(!!(FldAcc (self ctxt (s.at), !!id)), - intLitE Source.no_region 1))))); - !!(ExhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), - !!(MacroCall("$Inv", self ctxt at)))))); - !!(SeqnS ( - let (!!) p = !!! at p in - !!([], - [ - !!(InhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), - !!(AndE(!!(MacroCall("$Inv", self ctxt at)), - !!(GtCmpE(!!(FldAcc (self ctxt at, !!id)), - intLitE Source.no_region 0)))))))); - !!(FieldAssignS( - (self ctxt at, !!id), - (!!(SubE(!!(FldAcc (self ctxt at, !!id)), - intLitE at 1))))); - !!! (e.at) (SeqnS stmts); - !!(ExhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), - !!(MacroCall("$Inv", self ctxt at)))))) ]))); - !!(InhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), - !!(MacroCall("$Inv", self ctxt at)))))); - ]) + !!([], + [ !!(FieldAssignS( + (self ctxt Source.no_region, !!id), + (!!(AddE(!!(FldAcc (self ctxt (s.at), !!id)), + intLitE Source.no_region 1))))); + !@(ExhaleS (!@(AndE(!@(MacroCall("$Perm", self ctxt at)), + !@(MacroCall("$Inv", self ctxt at)))))); + !@(SeqnS ( + !@([], + [ + !@(InhaleS (!@(AndE(!@(MacroCall("$Perm", self ctxt at)), + !@(AndE(!@(MacroCall("$Inv", self ctxt at)), + !@(GtCmpE(!@(FldAcc (self ctxt at, !@id)), + intLitE Source.no_region 0)))))))); + !@(FieldAssignS( + (self ctxt at, !@id), + (!@(SubE(!@(FldAcc (self ctxt at, !@id)), + intLitE at 1))))); + !!! (e.at) (SeqnS stmts); + !@(ExhaleS (!@(AndE(!@(MacroCall("$Perm", self ctxt at)), + !@(MacroCall("$Inv", self ctxt at)))))) ]))); + !!(InhaleS (!!(AndE(!!(MacroCall("$Perm", self ctxt at)), + !!(MacroCall("$Inv", self ctxt at)))))); + ]) | M.WhileE(e, s1) -> !!([], [ !!(WhileS(exp ctxt e, [], stmt ctxt s1)) ]) (* TODO: Invariant *) From 74553c7440b5bc16aad935afbb317a9128c0fd56 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 18 Nov 2022 15:30:00 +0100 Subject: [PATCH 72/81] viper: switch to stable server (#3593) It still has somewhat outdated backends, but we never had problems with those. But this gives a non-moving download URL, so that's a win! --- default.nix | 4 ++-- test/viper/ok/assertions.silicon.ok | 2 -- test/viper/ok/async.silicon.ok | 1 - test/viper/ok/claim-broken.silicon.ok | 1 - test/viper/ok/invariant.silicon.ok | 1 - 5 files changed, 2 insertions(+), 7 deletions(-) diff --git a/default.nix b/default.nix index 97495bdf70e..bc1b8fa7f14 100644 --- a/default.nix +++ b/default.nix @@ -753,8 +753,8 @@ rec { }; viperServer = nixpkgs.fetchurl { - url = https://github.com/viperproject/viperserver/releases/download/v-2022-11-16-0717/viperserver.jar; - sha256 = "sha256:03y612gqcz671ch3m9yhsm4vcg6vfhh1h2sp5hx6xh0azi4k6z69"; + url = https://github.com/viperproject/viperserver/releases/download/v.22.11-release/viperserver.jar; + sha256 = "sha256-debC8ZpbIjgpEeISCISU0EVySJvf+WsUkUaLuJ526wA="; }; shell = stdenv.mkDerivation { diff --git a/test/viper/ok/assertions.silicon.ok b/test/viper/ok/assertions.silicon.ok index b4fc83fc5a4..202af03d0c2 100644 --- a/test/viper/ok/assertions.silicon.ok +++ b/test/viper/ok/assertions.silicon.ok @@ -1,4 +1,2 @@ [0] Postcondition of __init__ might not hold. Assertion $Self.u might not hold. (assertions.vpr@10.13--10.24) - [1] Assert might fail. Assertion $Self.u ==> $Self.v > 0 might not hold. (assertions.vpr@28.15--28.44) - diff --git a/test/viper/ok/async.silicon.ok b/test/viper/ok/async.silicon.ok index c094e0351ca..4cd9741c5a2 100644 --- a/test/viper/ok/async.silicon.ok +++ b/test/viper/ok/async.silicon.ok @@ -1,2 +1 @@ [0] Exhale might fail. Assertion $Self.$message_async <= 1 might not hold. (async.vpr@33.15--33.42) - diff --git a/test/viper/ok/claim-broken.silicon.ok b/test/viper/ok/claim-broken.silicon.ok index f994146f206..2738a3acfa7 100644 --- a/test/viper/ok/claim-broken.silicon.ok +++ b/test/viper/ok/claim-broken.silicon.ok @@ -1,2 +1 @@ [0] Exhale might fail. Assertion $Self.$message_async == 1 ==> $Self.claimed && $Self.count == 0 might not hold. (claim-broken.vpr@31.20--31.47) - diff --git a/test/viper/ok/invariant.silicon.ok b/test/viper/ok/invariant.silicon.ok index f605f1b9156..94a1ad16eff 100644 --- a/test/viper/ok/invariant.silicon.ok +++ b/test/viper/ok/invariant.silicon.ok @@ -1,2 +1 @@ [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.13--7.24) - From 585bc73db70e3314b70b3b32283727dc4c089ec8 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 18 Nov 2022 16:25:14 +0100 Subject: [PATCH 73/81] add a Changelog entry --- Changelog.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changelog.md b/Changelog.md index 4539ef9c9ba..e39f7dc5c32 100644 --- a/Changelog.md +++ b/Changelog.md @@ -9,6 +9,10 @@ rejected, not accepted, to be consistent with the declarations of mutable fields and mutable objects. + * Experimental Viper integration by compiling a very narrow subset of + Motoko to the verification intermediate language. See `src/viper/README.md` + and the PR for details. (#3477). + ## 0.7.3 (2022-11-01) * motoko (`moc`) From 781ded26d6fbcca55b5db439d9dc3c80de3f8bc7 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 18 Nov 2022 16:46:34 +0100 Subject: [PATCH 74/81] Remove crib sheet Just look in `src/mo_def/arrange.ml`. --- src/viper/trans.ml | 197 --------------------------------------------- 1 file changed, 197 deletions(-) diff --git a/src/viper/trans.ml b/src/viper/trans.ml index e6b851e188e..b6c95a0b73a 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -526,200 +526,3 @@ and tr_typ' typ = | T.Prim T.Int -> IntT | T.Prim T.Bool -> BoolT | _ -> unsupported Source.no_region (Mo_types.Arrange_type.typ (T.normalize typ)) - - -(* Crib sheet for other remaining syntax to translate *) -(* -let rec exp e = match e.it with - | VarE x -> "VarE" $$ [id x] - | LitE l -> "LitE" $$ [lit !l] - | ActorUrlE e -> "ActorUrlE" $$ [exp e] - | UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; Arrange_ops.unop uo; exp e] - | BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; Arrange_ops.binop bo; exp e2] - | RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; Arrange_ops.relop ro; exp e2] - | ShowE (ot, e) -> "ShowE" $$ [operator_type !ot; exp e] - | ToCandidE es -> "ToCandidE" $$ exps es - | FromCandidE e -> "FromCandidE" $$ [exp e] - | TupE es -> "TupE" $$ exps es - | ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)] - | ObjBlockE (s, dfs) -> "ObjBlockE" $$ [obj_sort s] @ List.map dec_field dfs - | ObjE ([], efs) -> "ObjE" $$ List.map exp_field efs - | ObjE (bases, efs) -> "ObjE" $$ exps bases @ [Atom "with"] @ List.map exp_field efs - | DotE (e, x) -> "DotE" $$ [exp e; id x] - | AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2] - | ArrayE (m, es) -> "ArrayE" $$ [mut m] @ exps es - | IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2] - | FuncE (x, sp, tp, p, t, sugar, e') -> - "FuncE" $$ [ - Atom (Type.string_of_typ e.note.note_typ); - shared_pat sp; - Atom x] @ - List.map typ_bind tp @ [ - pat p; - (match t with None -> Atom "_" | Some t -> typ t); - Atom (if sugar then "" else "="); - exp e' - ] - | CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ inst ts @ [exp e2] - | BlockE ds -> "BlockE" $$ List.map dec ds - | NotE e -> "NotE" $$ [exp e] - | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] - | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] - | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] - | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs - | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] - | LoopE (e1, None) -> "LoopE" $$ [exp e1] - | LoopE (e1, Some e2) -> "LoopE" $$ [exp e1; exp e2] - | ForE (p, e1, e2) -> "ForE" $$ [pat p; exp e1; exp e2] - | LabelE (i, t, e) -> "LabelE" $$ [id i; typ t; exp e] - | DebugE e -> "DebugE" $$ [exp e] - | BreakE (i, e) -> "BreakE" $$ [id i; exp e] - | RetE e -> "RetE" $$ [exp e] - | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] - | AwaitE e -> "AwaitE" $$ [exp e] - | AssertE e -> "AssertE" $$ [exp e] - | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] - | OptE e -> "OptE" $$ [exp e] - | DoOptE e -> "DoOptE" $$ [exp e] - | BangE e -> "BangE" $$ [exp e] - | TagE (i, e) -> "TagE" $$ [id i; exp e] - | PrimE p -> "PrimE" $$ [Atom p] - | ImportE (f, _fp) -> "ImportE" $$ [Atom f] - | ThrowE e -> "ThrowE" $$ [exp e] - | TryE (e, cs) -> "TryE" $$ [exp e] @ List.map catch cs - | IgnoreE e -> "IgnoreE" $$ [exp e] - -and exps es = List.map exp es - -and inst inst = match inst.it with - | None -> [] - | Some ts -> List.map typ ts - -and pat p = match p.it with - | WildP -> Atom "WildP" - | VarP x -> "VarP" $$ [id x] - | TupP ps -> "TupP" $$ List.map pat ps - | ObjP ps -> "ObjP" $$ List.map pat_field ps - | AnnotP (p, t) -> "AnnotP" $$ [pat p; typ t] - | LitP l -> "LitP" $$ [lit !l] - | SignP (uo, l) -> "SignP" $$ [Arrange_ops.unop uo ; lit !l] - | OptP p -> "OptP" $$ [pat p] - | TagP (i, p) -> "TagP" $$ [tag i; pat p] - | AltP (p1,p2) -> "AltP" $$ [pat p1; pat p2] - | ParP p -> "ParP" $$ [pat p] - -and lit = function - | NullLit -> Atom "NullLit" - | BoolLit true -> "BoolLit" $$ [ Atom "true" ] - | BoolLit false -> "BoolLit" $$ [ Atom "false" ] - | NatLit n -> "NatLit" $$ [ Atom (Numerics.Nat.to_pretty_string n) ] - | Nat8Lit n -> "Nat8Lit" $$ [ Atom (Numerics.Nat8.to_pretty_string n) ] - | Nat16Lit n -> "Nat16Lit" $$ [ Atom (Numerics.Nat16.to_pretty_string n) ] - | Nat32Lit n -> "Nat32Lit" $$ [ Atom (Numerics.Nat32.to_pretty_string n) ] - | Nat64Lit n -> "Nat64Lit" $$ [ Atom (Numerics.Nat64.to_pretty_string n) ] - | IntLit i -> "IntLit" $$ [ Atom (Numerics.Int.to_pretty_string i) ] - | Int8Lit i -> "Int8Lit" $$ [ Atom (Numerics.Int_8.to_pretty_string i) ] - | Int16Lit i -> "Int16Lit" $$ [ Atom (Numerics.Int_16.to_pretty_string i) ] - | Int32Lit i -> "Int32Lit" $$ [ Atom (Numerics.Int_32.to_pretty_string i) ] - | Int64Lit i -> "Int64Lit" $$ [ Atom (Numerics.Int_64.to_pretty_string i) ] - | FloatLit f -> "FloatLit" $$ [ Atom (Numerics.Float.to_pretty_string f) ] - | CharLit c -> "CharLit" $$ [ Atom (string_of_int c) ] - | TextLit t -> "TextLit" $$ [ Atom t ] - | BlobLit b -> "BlobLit" $$ [ Atom b ] - | PreLit (s,p) -> "PreLit" $$ [ Atom s; Arrange_type.prim p ] - -and case c = "case" $$ [pat c.it.pat; exp c.it.exp] - -and catch c = "catch" $$ [pat c.it.pat; exp c.it.exp] - -and pat_field pf = pf.it.id.it $$ [pat pf.it.pat] - -and obj_sort s = match s.it with - | Type.Object -> Atom "Object" - | Type.Actor -> Atom "Actor" - | Type.Module -> Atom "Module" - | Type.Memory -> Atom "Memory" - -and shared_pat sp = match sp.it with - | Type.Local -> Atom "Local" - | Type.Shared (Type.Write, p) -> "Shared" $$ [pat p] - | Type.Shared (Type.Query, p) -> "Query" $$ [pat p] - -and func_sort s = match s.it with - | Type.Local -> Atom "Local" - | Type.Shared Type.Write -> Atom "Shared" - | Type.Shared Type.Query -> Atom "Query" - -and mut m = match m.it with - | Const -> Atom "Const" - | Var -> Atom "Var" - -and vis v = match v.it with - | Public None -> Atom "Public" - | Public (Some m) -> "Public" $$ [Atom m] - | Private -> Atom "Private" - | System -> Atom "System" - -and stab s_opt = match s_opt with - | None -> Atom "(Flexible)" - | Some s -> - (match s.it with - | Flexible -> Atom "Flexible" - | Stable -> Atom "Stable") - -and typ_field (tf : typ_field) = match tf.it with - | ValF (id, t, m) -> id.it $$ [typ t; mut m] - | TypF (id', tbs, t) -> - "TypF" $$ [id id'] @ List.map typ_bind tbs @ [typ t] -and typ_item ((id, ty) : typ_item) = - match id with - | None -> [typ ty] - | Some { it;_ } -> [Atom it; typ ty] - -and typ_tag (tt : typ_tag) - = tt.it.tag.it $$ [typ tt.it.typ] - -and typ_bind (tb : typ_bind) - = tb.it.var.it $$ [typ tb.it.bound] - -and dec_field (df : dec_field) - = "DecField" $$ [dec df.it.dec; vis df.it.vis; stab df.it.stab] - -and exp_field (ef : exp_field) - = "ExpField" $$ [mut ef.it.mut; id ef.it.id; exp ef.it.exp] - -and operator_type t = Atom (Type.string_of_typ t) - -and path p = match p.it with - | IdH i -> "IdH" $$ [id i] - | DotH (p,i) -> "DotH" $$ [path p; id i] - -and typ t = match t.it with - | PathT (p, ts) -> "PathT" $$ [path p] @ List.map typ ts - | PrimT p -> "PrimT" $$ [Atom p] - | ObjT (s, ts) -> "ObjT" $$ [obj_sort s] @ List.map typ_field ts - | ArrayT (m, t) -> "ArrayT" $$ [mut m; typ t] - | OptT t -> "OptT" $$ [typ t] - | VariantT cts -> "VariantT" $$ List.map typ_tag cts - | TupT ts -> "TupT" $$ List.concat_map typ_item ts - | FuncT (s, tbs, at, rt) -> "FuncT" $$ [func_sort s] @ List.map typ_bind tbs @ [ typ at; typ rt] - | AsyncT (t1, t2) -> "AsyncT" $$ [typ t1; typ t2] - | AndT (t1, t2) -> "AndT" $$ [typ t1; typ t2] - | OrT (t1, t2) -> "OrT" $$ [typ t1; typ t2] - | ParT t -> "ParT" $$ [typ t] - | NamedT (id, t) -> "NamedT" $$ [Atom id.it; typ t] - -and dec d = match d.it with - | ExpD e -> "ExpD" $$ [exp e ] - | LetD (p, e) -> "LetD" $$ [pat p; exp e] - | VarD (x, e) -> "VarD" $$ [id x; exp e] - | TypD (x, tp, t) -> - "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] - | ClassD (sp, x, tp, p, rt, s, i', dfs) -> - "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [ - pat p; - (match rt with None -> Atom "_" | Some t -> typ t); - obj_sort s; id i' - ] @ List.map dec_field dfs - - *) From ffa3c7336285031cedfc5b78fe3cd85093bbfd2f Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 18 Nov 2022 16:48:47 +0100 Subject: [PATCH 75/81] remove more --- src/viper/trans.ml | 70 ---------------------------------------------- 1 file changed, 70 deletions(-) diff --git a/src/viper/trans.ml b/src/viper/trans.ml index b6c95a0b73a..4cdd44839a2 100644 --- a/src/viper/trans.ml +++ b/src/viper/trans.ml @@ -228,16 +228,6 @@ and dec_field' ctxt d = (InvariantI (Printf.sprintf "invariant_%d" at.left.line, exp { ctxt' with self = Some "$Self" } e), NoInfo) | _ -> unsupported d.M.dec.at (Arrange.dec d.M.dec) -(* - | TypD (x, tp, t) -> - "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t] - | ClassD (sp, x, tp, p, rt, s, i', dfs) -> - "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [ - pat p; - (match rt with None -> Atom "_" | Some t -> typ t); - obj_sort s; id i' - ] @ List.map dec_field dfs -*) and args p = match p.it with | M.TupP ps -> @@ -444,66 +434,6 @@ and exp ctxt e = !!(Implies (exp ctxt e1, exp ctxt e2)) | _ -> unsupported e.at (Arrange.exp e) -(* - | VarE x -> - | LitE l -> "LitE" $$ [lit !l] - | ActorUrlE e -> "ActorUrlE" $$ [exp e] - | UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; Arrange_ops.unop uo; exp e] - | BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; Arrange_ops.binop bo; exp e2] - | RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; Arrange_ops.relop ro; exp e2] - | ShowE (ot, e) -> "ShowE" $$ [operator_type !ot; exp e] - | ToCandidE es -> "ToCandidE" $$ exps es - | FromCandidE e -> "FromCandidE" $$ [exp e] - | TupE es -> "TupE" $$ exps es - | ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)] - | ObjBlockE (s, dfs) -> "ObjBlockE" $$ [obj_sort s] @ List.map dec_field dfs - | ObjE ([], efs) -> "ObjE" $$ List.map exp_field efs - | ObjE (bases, efs) -> "ObjE" $$ exps bases @ [Atom "with"] @ List.map exp_field efs - | DotE (e, x) -> "DotE" $$ [exp e; id x] - | AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2] - | ArrayE (m, es) -> "ArrayE" $$ [mut m] @ exps es - | IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2] - | FuncE (x, sp, tp, p, t, sugar, e') -> - "FuncE" $$ [ - Atom (Type.string_of_typ e.note.note_typ); - shared_pat sp; - Atom x] @ - List.map typ_bind tp @ [ - pat p; - (match t with None -> Atom "_" | Some t -> typ t); - Atom (if sugar then "" else "="); - exp e' - ] - | CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ inst ts @ [exp e2] - | BlockE ds -> "BlockE" $$ List.map dec ds - | NotE e -> "NotE" $$ [exp e] - | AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2] - | OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2] - | IfE (e1, e2, e3) -> "IfE" $$ [exp e1; exp e2; exp e3] - | SwitchE (e, cs) -> "SwitchE" $$ [exp e] @ List.map case cs - | WhileE (e1, e2) -> "WhileE" $$ [exp e1; exp e2] - | LoopE (e1, None) -> "LoopE" $$ [exp e1] - | LoopE (e1, Some e2) -> "LoopE" $$ [exp e1; exp e2] - | ForE (p, e1, e2) -> "ForE" $$ [pat p; exp e1; exp e2] - | LabelE (i, t, e) -> "LabelE" $$ [id i; typ t; exp e] - | DebugE e -> "DebugE" $$ [exp e] - | BreakE (i, e) -> "BreakE" $$ [id i; exp e] - | RetE e -> "RetE" $$ [exp e] - | AsyncE (tb, e) -> "AsyncE" $$ [typ_bind tb; exp e] - | AwaitE e -> "AwaitE" $$ [exp e] - | AssertE e -> "AssertE" $$ [exp e] - | AnnotE (e, t) -> "AnnotE" $$ [exp e; typ t] - | OptE e -> "OptE" $$ [exp e] - | DoOptE e -> "DoOptE" $$ [exp e] - | BangE e -> "BangE" $$ [exp e] - | TagE (i, e) -> "TagE" $$ [id i; exp e] - | PrimE p -> "PrimE" $$ [Atom p] - | ImportE (f, _fp) -> "ImportE" $$ [Atom f] - | ThrowE e -> "ThrowE" $$ [exp e] - | TryE (e, cs) -> "TryE" $$ [exp e] @ List.map catch cs - | IgnoreE e -> "IgnoreE" $$ [exp e] -*) - and rets t_opt = match t_opt with From 55af5445d7b1c5b2171eb1c8a0db741dbd5d3b27 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 18 Nov 2022 19:47:00 +0100 Subject: [PATCH 76/81] spruce up this test a bit --- test/viper/invariant.mo | 4 ++-- test/viper/ok/invariant.vpr.ok | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/test/viper/invariant.mo b/test/viper/invariant.mo index 01529eff0af..f26a5d71ef3 100644 --- a/test/viper/invariant.mo +++ b/test/viper/invariant.mo @@ -17,8 +17,8 @@ actor { }; public shared func loops(/*j : Int*/) : async () { - //var i = j; - while (/*i > 0*/false) { + var i : Int = 0; + while (i > 0) { //i -= 1 } } diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index 5b5ea60450c..2b03981c23e 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -31,8 +31,9 @@ method loops($Self: Ref) requires $Inv($Self) ensures $Perm($Self) ensures $Inv($Self) - { - while (false) { + { var i: Int + i := 0 + while ((i > 0)) { { }} From 98c563f776f3871c4e7cd75bbe77c8ad063b8e63 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Fri, 18 Nov 2022 20:04:32 +0100 Subject: [PATCH 77/81] add some more features --- test/viper/invariant.mo | 2 +- test/viper/ok/invariant.vpr.ok | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/viper/invariant.mo b/test/viper/invariant.mo index f26a5d71ef3..37e1d946ff5 100644 --- a/test/viper/invariant.mo +++ b/test/viper/invariant.mo @@ -19,7 +19,7 @@ actor { public shared func loops(/*j : Int*/) : async () { var i : Int = 0; while (i > 0) { - //i -= 1 + i += 1 } } diff --git a/test/viper/ok/invariant.vpr.ok b/test/viper/ok/invariant.vpr.ok index 2b03981c23e..06b14fe0dea 100644 --- a/test/viper/ok/invariant.vpr.ok +++ b/test/viper/ok/invariant.vpr.ok @@ -35,6 +35,6 @@ method loops($Self: Ref) i := 0 while ((i > 0)) { { - + i := (i + 1) }} } From 4f1512543fb2de4689237f7233a1e1dc41902176 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Tue, 22 Nov 2022 15:17:36 +0100 Subject: [PATCH 78/81] fix: thread the mode into the parser (#3599) Turns out I was doing a bunch of things wrong. Now we make the relevant `Lexer_lib.mode` accessible from the parser productions (previously it just accessed a constant thing). This makes `--viper` to select the `verification` mode in the parser too (lexer was already fine). --- src/languageServer/imports.ml | 5 +++- src/mo_frontend/assertions.mly | 34 ++++++++++++++++++++----- src/mo_frontend/parser.mly | 8 ------ src/mo_frontend/parser_lib.ml | 1 + src/mo_frontend/parsing.ml | 3 ++- src/mo_frontend/parsing.mli | 3 ++- src/pipeline/pipeline.ml | 2 +- test/fail/ok/verification-asserts.tc.ok | 8 +++--- 8 files changed, 42 insertions(+), 22 deletions(-) diff --git a/src/languageServer/imports.ml b/src/languageServer/imports.ml index 975fe0e7b53..0c269580990 100644 --- a/src/languageServer/imports.ml +++ b/src/languageServer/imports.ml @@ -9,7 +9,10 @@ type import = string * string let parse_with mode lexbuf parser = let tokenizer, _ = Lexer.tokenizer mode lexbuf in - Ok (Parsing.parse 0 (parser lexbuf.Lexing.lex_curr_p) tokenizer lexbuf) + Ok + (Parsing.parse Lexer_lib.mode 0 + (parser lexbuf.Lexing.lex_curr_p) + tokenizer lexbuf) let parse_string s = try diff --git a/src/mo_frontend/assertions.mly b/src/mo_frontend/assertions.mly index 2a5ed4aa350..58311e3cc40 100644 --- a/src/mo_frontend/assertions.mly +++ b/src/mo_frontend/assertions.mly @@ -1,4 +1,26 @@ -(* Viper only tokens and productions *) +%{ + +let verification_syntax_error at code msg = + Diag.add_msg (Option.get !Parser_lib.msg_store) + (Diag.error_message at code "verification syntax" msg) + +(* Verification mode only *) + +let (&&&) cond (action : Mo_def.Syntax.exp) = + if not cond then + verification_syntax_error + action.Source.at + "M0181" "verification assertions not permitted in normal mode"; + action + +let is_verification () = + match !Parser_lib.mode with + | None -> assert false + | Some mode -> mode.Lexer_lib.verification + +%} + +(* Viper-only tokens and productions *) %token INVARIANT %token IMPLIES @@ -14,14 +36,14 @@ %public exp_nondec(B) : | ASSERT COLON SYSTEM e=exp_nest - { is_verification &&& AssertE(Static, e) @? at $sloc } + { is_verification () &&& AssertE(Static, e) @? at $sloc } | ASSERT COLON INVARIANT e=exp_nest - { is_verification &&& AssertE(Invariant, e) @? at $sloc } + { is_verification () &&& AssertE(Invariant, e) @? at $sloc } | ASSERT COLON FUNC e=exp_nest - { is_verification &&& AssertE(Precondition, e) @? at $sloc } + { is_verification () &&& AssertE(Precondition, e) @? at $sloc } | ASSERT COLON RETURN e=exp_nest - { is_verification &&& AssertE(Postcondition, e) @? at $sloc } + { is_verification () &&& AssertE(Postcondition, e) @? at $sloc } | ASSERT COLON s=NAT COLON ASYNC e=exp_nest - { is_verification &&& AssertE(Concurrency s, e) @? at $sloc } + { is_verification () &&& AssertE(Concurrency s, e) @? at $sloc } %% diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly index 7c72594ac72..4a877a96dab 100644 --- a/src/mo_frontend/parser.mly +++ b/src/mo_frontend/parser.mly @@ -199,14 +199,6 @@ and objblock s dec_fields = | _ -> ()) dec_fields; ObjBlockE(s, dec_fields) -(* Verification mode only *) - -let (&&&) cond action = - if not cond then syntax_error action.at "M0181" "verification assertions not permitted in normal mode"; - action - -let is_verification = Lexer_lib.(mode.verification) - %} %token EOF DISALLOWED diff --git a/src/mo_frontend/parser_lib.ml b/src/mo_frontend/parser_lib.ml index 63c331d1174..3c22db4836b 100644 --- a/src/mo_frontend/parser_lib.ml +++ b/src/mo_frontend/parser_lib.ml @@ -2,5 +2,6 @@ exception Imports of Mo_def.Syntax.dec list (* Temporary hack! *) let msg_store : Diag.msg_store option ref = ref None +let mode : Lexer_lib.mode option ref = ref None let triv_table : Mo_def.Trivia.triv_table ref = ref Mo_def.Trivia.empty_triv_table diff --git a/src/mo_frontend/parsing.ml b/src/mo_frontend/parsing.ml index 112c79c27ed..f5ad803b60e 100644 --- a/src/mo_frontend/parsing.ml +++ b/src/mo_frontend/parsing.ml @@ -70,11 +70,12 @@ let slice_lexeme lexbuf i1 i2 = then "" (* Too rare to care *) else Bytes.sub_string lexbuf.lex_buffer offset len -let parse error_detail checkpoint lexer lexbuf = +let parse mode error_detail checkpoint lexer lexbuf = Diag.with_message_store (fun m -> try (* Temporary hack! *) Parser_lib.msg_store := Some m; + Parser_lib.mode := Some mode; Some (E.entry checkpoint lexer) with E.Error ((start, end_), explanations) -> let at = diff --git a/src/mo_frontend/parsing.mli b/src/mo_frontend/parsing.mli index 8b0a16296f8..1d04d9fd880 100644 --- a/src/mo_frontend/parsing.mli +++ b/src/mo_frontend/parsing.mli @@ -8,7 +8,8 @@ type error_detail = int (* TODO: make this a datatype! *) exception Error of string * Lexing.position * Lexing.position -val parse : error_detail -> +val parse : Lexer_lib.mode -> + error_detail -> 'a Parser.MenhirInterpreter.checkpoint -> Parser.MenhirInterpreter.supplier -> Lexing.lexbuf -> diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml index 2d6fb42489f..eaeabf1b0ec 100644 --- a/src/pipeline/pipeline.ml +++ b/src/pipeline/pipeline.ml @@ -96,7 +96,7 @@ let generic_parse_with mode lexer parser name : _ Diag.result = let* mk_syntax = try Parser_lib.triv_table := triv_table; - Parsing.parse (!Flags.error_detail) (parser lexer.Lexing.lex_curr_p) tokenizer lexer + Parsing.parse mode (!Flags.error_detail) (parser lexer.Lexing.lex_curr_p) tokenizer lexer with Lexer.Error (at, msg) -> Diag.error at"M0002" "syntax" msg in let phrase = mk_syntax name in diff --git a/test/fail/ok/verification-asserts.tc.ok b/test/fail/ok/verification-asserts.tc.ok index f8aaf7c217a..49ea928a86e 100644 --- a/test/fail/ok/verification-asserts.tc.ok +++ b/test/fail/ok/verification-asserts.tc.ok @@ -1,7 +1,7 @@ -verification-asserts.mo:1.1-1.19: syntax error [M0181], verification assertions not permitted in normal mode -verification-asserts.mo:2.1-2.20: syntax error [M0181], verification assertions not permitted in normal mode -verification-asserts.mo:3.1-3.17: syntax error [M0181], verification assertions not permitted in normal mode -verification-asserts.mo:4.1-4.19: syntax error [M0181], verification assertions not permitted in normal mode +verification-asserts.mo:1.1-1.19: verification syntax error [M0181], verification assertions not permitted in normal mode +verification-asserts.mo:2.1-2.20: verification syntax error [M0181], verification assertions not permitted in normal mode +verification-asserts.mo:3.1-3.17: verification syntax error [M0181], verification assertions not permitted in normal mode +verification-asserts.mo:4.1-4.19: verification syntax error [M0181], verification assertions not permitted in normal mode verification-asserts.mo:7.8-7.17: syntax error [M0001], unexpected token 'invariant', expected one of token or sequence: system return From e8edbcb906ec3654e1a26da07769b2329709ab6e Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Tue, 22 Nov 2022 23:33:56 +0100 Subject: [PATCH 79/81] test that `--viper` works --- test/repl/ok/viper.stdout.ok | 43 ++++++++++++++++++++++++++++++++++++ test/repl/viper.sh | 27 ++++++++++++++++++++++ 2 files changed, 70 insertions(+) create mode 100644 test/repl/ok/viper.stdout.ok create mode 100755 test/repl/viper.sh diff --git a/test/repl/ok/viper.stdout.ok b/test/repl/ok/viper.stdout.ok new file mode 100644 index 00000000000..7a1aaf1d945 --- /dev/null +++ b/test/repl/ok/viper.stdout.ok @@ -0,0 +1,43 @@ +field $message_async: Int +define $Perm($Self) ((((true && acc(($Self).claimed,write)) && acc(($Self).count,write)) && + acc(($Self).$message_async,write))) +define $Inv($Self) (((invariant_7($Self) && invariant_8($Self)) && (((0 <= + ($Self).$message_async) && (($Self).$message_async <= 1)) && ((($Self).$message_async == 1) ==> ( + ($Self).claimed && (($Self).count == 0)))))) +method __init__($Self: Ref) + + requires $Perm($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + ($Self).claimed := false + ($Self).count := 0 + ($Self).$message_async := 0 + } +field claimed: Bool +field count: Int +define invariant_7($Self) (((($Self).count == 0) || (($Self).count == 1))) +define invariant_8($Self) (((!($Self).claimed) ==> (($Self).count == 0))) +method claim($Self: Ref) + + requires $Perm($Self) + requires $Inv($Self) + ensures $Perm($Self) + ensures $Inv($Self) + { + if ((!($Self).claimed)) + { + ($Self).claimed := true + ($Self).$message_async := (($Self).$message_async + 1) + exhale ($Perm($Self) && $Inv($Self)) + { + inhale ($Perm($Self) && ($Inv($Self) && (($Self).$message_async > 0))) + ($Self).$message_async := (($Self).$message_async - 1) + { + ($Self).count := (($Self).count + 1) + } + exhale ($Perm($Self) && $Inv($Self)) + } + inhale ($Perm($Self) && $Inv($Self)) + } + } diff --git a/test/repl/viper.sh b/test/repl/viper.sh new file mode 100755 index 00000000000..f8c7bedd9c6 --- /dev/null +++ b/test/repl/viper.sh @@ -0,0 +1,27 @@ +#!/usr/bin/env bash + +# Tests that `moc` can output Viper code +(cat <<__END__ +actor { + + var claimed = false; + + var count = 0 : Int; + + assert:invariant count == 0 or count == 1; + assert:invariant not claimed implies count == 0; + + public shared func claim() : async () { + if (not claimed) { + claimed := true; + + await async { + assert:1:async (claimed and count == 0); + count += 1; + }; + }; + }; + +} +__END__ +) | moc --viper /dev/stdin From 7bf26355612547a601f54f854fdad997885509b3 Mon Sep 17 00:00:00 2001 From: Gabor Greif Date: Tue, 22 Nov 2022 23:35:34 +0100 Subject: [PATCH 80/81] Update test/repl/viper.sh --- test/repl/viper.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/repl/viper.sh b/test/repl/viper.sh index f8c7bedd9c6..7b2c11c9213 100755 --- a/test/repl/viper.sh +++ b/test/repl/viper.sh @@ -1,7 +1,7 @@ #!/usr/bin/env bash # Tests that `moc` can output Viper code -(cat <<__END__ +(cat <<__END__ actor { var claimed = false; From 998f48482d244aa8ade88138eb27013dbdbebfe7 Mon Sep 17 00:00:00 2001 From: Arshavir Ter-Gabrielyan Date: Fri, 25 Nov 2022 12:08:37 +0100 Subject: [PATCH 81/81] Document `--viper` in `src/viper/README.md` (#3601) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This PR adds a readme file that covers the following aspects behind Formal Motoko: (1) Disclaimer; (2) Introduction — Overview | Formal specification | Static vs. dynamic assertions | Testing vs. formal verification | Precondition of public functions | Examples; (3) Contributing — Building | Running | Testing | File structure | Further information --- README.md | 1 + src/viper/README.md | 255 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 256 insertions(+) create mode 100644 src/viper/README.md diff --git a/README.md b/README.md index d69f93eef71..fa08f18c1f4 100644 --- a/README.md +++ b/README.md @@ -12,6 +12,7 @@ A safe, simple, actor-based programming language for authoring [Internet Compute * [Concrete syntax](doc/md/examples/grammar.txt). * [Documentation sources](doc/md/). * [Base library documentation](doc/md/base/index.md). +* [_Motoko-san_: a prototypical deductive verifier](src/viper/README.md). ## Introduction diff --git a/src/viper/README.md b/src/viper/README.md new file mode 100644 index 00000000000..a013f081873 --- /dev/null +++ b/src/viper/README.md @@ -0,0 +1,255 @@ +_Motoko-san_ +============ + +> Disclaimer — this is an _early prototype_; in particular: +> * This project comes with no guarantees whatsoever. +> * The [currently supported subset of Motoko](#Subset) is insufficient for most real-world applications. +> * DFINITY currently has no plans to continue the development of _Motoko-san_. + + +_Motoko-san_ is a prototype code-level verifier for Motoko. The project started at the DFINITY Foundation as a way to demonstrate that Motoko (and the Internet Computer in general) are well-suited for developing formally verified Web3 software. + +-------------------------------------------------------------------------------- +**Jump to:** + +**[Introduction](#Introduction) —** + [Overview](#Overview) + | [Formal specification](#FormalSpecs) + | [Static vs. dynamic assertions](#statVsDyn) + | [Testing vs. formal verification](#testsVsVerif) + | [Precondition of public functions](#publicFuncPreconds) + | [Examples](#Examples) + +**[Contributing](#Contrib) —** + [Building](#Building) + | [Running](#Running) + | [Testing](#Testing) + | [File structure](#Struct) + +**[Currently supported features](#Subset)** + +**[Further information](#Further)** + +-------------------------------------------------------------------------------- + + +Introduction +------------ + + +**Overview** + + +The verifier is implemented as a `moc` compiler feature. When `moc --viper $FILE` is invoked, the Motoko source code from `$FILE` is first translated into the Viper intermediate verification language (currently emitted into stdout) and then compiled. The generated Viper program can be submitted to the Viper tool. If the generated Viper program verifies, this implies that the Motoko source code respects the _formal code specification_, e.g., canister invariants, and that Viper established the corresponding formal proof of correctness. + +**Formal code specification** + + +Formal code specifications are written as part of the Motoko source code. These specifications are _static_, i.e., they do not affect the canister's runtime behavior. If a Motoko canister is compiled with `moc --viper`, it may contain static code specifications defined via the following keywords (`exp : Type` below denotes an expression of type `Type`): + +* `assert:invariant (exp : Bool);` — actor-level invariant; must be ensured right after canister initialization and after every _atomic block_ execution. May appear only at the level of actor members. +* `assert:1:async (exp : Bool);` — an `await async { ... }` block may include this as the first statement; the intention is two-fold: + * at most _one_ instance of this code block can be pending execution. + * specify that the property `exp` is _intended_ to hold when this block execution begins. + * require that the tool actually _checks_ whether this assumption holds (given this actor's entire source code) +* `assert:system (exp : Bool);` — a _static assertion_ that asks the verifier to prove that the property `exp` holds. Useful while designing code-level canister specifications. + +Note: the above syntax is provisional. It has been used so far to avoid introducing breaking changes to the Motoko grammar. In the future, _Motoko-san_ may switch to bespoke syntax for code specifications. + +**Static vs. dynamic assertions** + + +The expression `assert ` (which is already available in Motoko proper) means a _dynamic assertion_, i.e., a runtime check of the Boolean condition ``. Note, however, that adding an `assert ` expression (for some Boolean expression ``) affects the static verification of the canister. Concretely, the verifier will _take for granted_ that `` holds after this statement (since any execution violating this assumption would trap). + +**Testing vs. formal verification** + + +Dynamic assertions can also be used for testing. Of course, the downside of testing is that if is typically not feasible to test against _all_ possible scenarios; the untested scenarios can be exploited by an attacker. In contrast, formal verification relies on statically known information to _prove the absence of attacks_. + +**Precondition of public functions** + + +In particular, dynamic assertions are very useful for specifying _preconditions_ of an actor's public functions (i.e., functions exposed in the Candid API configuration). Since such functions can be invoked by anyone; the identity of the caller is statically unknown. It is thus necessary to check all of the assumptions at runtime, by writing `assert `(here, `` denotes some `Bool` expression representing a function's precondition). Conversely, writing `assert:system ` at the top of a public function will never verify because _Motoko-san_ has zero knowledge about the caller. + +**Examples** + + +To get a better idea about how code-level specifications help formalize what a Motoko canister is intended to do, please refer to the examples in `moc/test/viper`. + +Contributing to _Motoko-san_ +---------------------------- + + +**Building the Motoko compiler** + + +1. Clone https://github.com/dfinity/motoko + ```bash + cd motoko + ``` +4. Install Nix: + ```bash + curl -L https://nixos.org/nix/install | sh + ``` +5. Obtain Nix cache (this speeds up the following steps): + ```bash + nix-env -iA cachix -f https://cachix.org/api/v1/install + cachix use ic-hs-test + ``` +6. Enter Nix shell (the first run of this command may take a while): + ```bash + nix-shell + ``` +7. Finally, build the Motoko compiler runtime and the compiler itself: + ```bash + [nix-shell:motoko]$ make -C rts + [nix-shell:motoko]$ make -C src + ``` + + +**Running _Motoko-san_** + + +```bash +[nix-shell:motoko] moc -viper input.mo > output.vpr +``` + +You may then verify the `output.vpr` file using [Viper](https://viper.ethz.ch/). Soon, there will be an interactive IDE integration for VS Code, s.t. the outputs do not need to be verified by manually invoking Viper. + +**Testing _Motoko-san_** + + +After modifying the code and recompiling `moc`, don't forget to test the changes by running +```bash +[nix-shell:motoko]$ make -C test/viper +``` + +Each test case consists of a (formally specified) Motoko source file, say, `$TEST` (e.g., `invariant.mo`) and the expected test results, represented via a triplet of files: +* `test/viper/ok/$TEST.vpr.ok` — what the Motoko compiler is expected to generate; this should be a Viper program. +* `test/viper/ok/$TEST.silicon.ok` — verification errors reported by the Viper tool. For example: + ``` + [0] Postcondition of __init__ might not hold. Assertion $Self.count > 0 might not hold. (invariant.vpr@7.13--7.24) + ``` + Note: Silicon is the name of one of the backends supported by Viper. +* `test/viper/ok/$TEST.silicon.ret.ok` — the return code from running Viper on this input. For example: + ``` + Return code 1 + ``` + +**File structure** + + +The implementation of _Motoko-san_ consists of the following source files: + +* `src/viper/syntax.ml` — the Viper AST implementation. +* `src/viper/pretty.ml` — the Viper pretty printer. Used for serializing Viper AST into text. +* `src/viper/trans.ml` — the Motoko-to-Viper translation. Implements the logic of _Motoko-san_. + + +Currently supported language features +------------------------------------- + + +_Motoko-san_ is an early prototype. The tool supports only a modest subset of [_Motoko proper_](https://internetcomputer.org/docs/current/developer-docs/build/cdks/motoko-dfinity/about-this-guide), which is not sufficient for most real-world applications. However, we hope that _Motoko-san_ will enable the community to build more sophisticated Motoko code-level verifiers, simply by extending this prototype. In particular, the tool enables verifying _reentrancy safety_ in simple (asynchronous) smart contracts (e.g., `test/viper/claim.mo`). + +Below, we summarize the language features that _Motoko-san_ currently supports. For each feature, we try to estimate the complexity of its natural generalization. For that purpose, we use the terms _trivial_ (e.g., extending code by analogy), _simple_ (we already know how to do it), _hard_ (more discussions would be needed to figure out the exact approach or feasible level of generality). + +* **Literal actor declarations** — The only supported top-level entity is an actor literal: + + `actor ClaimReward { ... }` and `actor { ... }` + + Extending to actor classes and modules is _simple_. + +* **Primitive types** — Only integer and Boolean types are supported (including literals of these types): + + * `Bool`: `not`, `or`, `and`, `implies` (short circuiting semantics) + + * `Int`: `+`, `/`, `*`, `-`, `%` + + * Relations: `==`, `!=`, `<`, `>`, `>=`, `<=` + + Supporting `Text`, `Nat`, `Int32`, tuples, record, and variants is _simple_. + + Supporting `Option` types is _trivial_. + + Supporting `async` types is _hard_. + + Supporting `Float`, function types, co-inductive, mutually recursive, and sub-typing is _hard_. + + Supporting container types and generic types, e.g., arrays (`[var T]`) and `HashMap`, is _hard_. + +* **Declarations** + + * **Actor fields** + * Mutable: `var x = ...` + * Immutable: `let y = ...` + * Fields may _not_ be initialized via block expressions: `let z = { ... };` + + * **Public functions** — Only functions of `async ()` type with no arguments are supported: + + `public func claim() : async () = { ... };` + + Supporting function arguments and return values is _simple_. + + * **Private functions** — Currently not supported (extension is _simple_). + + * **Local declarations** — Only local variable declarations with trivial left-hand side are supported: + + `var x = ...;` and `let y = ...;` + + Supporting pattern matching declarations (e.g., `let (a, b) = ...;`) is _simple_. + +* **Statements** + + * `()`-typed block statements and sequential composition: + + `{ var x = 0 : Int; x := x + 1; }` + + Supporting `let y = do { let y = 1 : Int; y + y };` is _simple_. + + * Runtime assertions: `assert i <= MAX;` + + * Assignments (to local variables and actor fields): `x := x + 1` + + * `if-[else]` statements + + Supporting pattern-matching is conceptually _simple_. + + * `while` loops (loop invariants are not currently supported) + + Supporting `for` loops is _simple_. + + Supporting `break` and `continue` is _simple_. + + * `await async { ... }` — Asynchronous code blocks that are immediately awaited on. + + Supporting general `await`s and `async`s is _hard_. + + Supporting async function calls is _simple_. + +* **Static code specifications** — Note that the syntax is provisional: + + * `assert:invariant` — Canister-level invariants + + * `assert:1:async` — Async constraints (at block entry) + + Extending to support, e.g., `assert:`_`N`_`:async` constraints (for _`N`_ > 1) is _simple_. + + Extending to support async constraints at block exit is _trivial_. + + * `assert:func` — Function preconditions + + * `assert:return` — Function postconditions + + * `assert:system` — Compile-time assertions + + **Loop invariants** — Extension is _simple_. + + **Pure functions** — The tool could be easily extended with a keyword, e.g., `@pure`, to specify functions that are verifier to be side-effect free; such functions could be used inside other code specifications, e.g., `assert:invariant is_okay()` for some `@pure func is_okay() : Bool`. This feature requires private functions. + +Further information +------------------- + + +If you have questions, please contact the Motoko compiler developers. You may do that, e.g., by filing a ticket via https://github.com/dfinity/motoko/issues/new +(please add `viper` into the labels).