Replaced expression "copy ... with ..." by instruction "patch ... with".

This commit is contained in:
Christian Rinderknecht 2019-03-19 14:32:43 +01:00
parent c3b304db4a
commit 4c9a743411
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
7 changed files with 74 additions and 75 deletions

30
AST.ml
View File

@ -42,7 +42,6 @@ let sepseq_to_region to_region = function
type kwd_begin = Region.t
type kwd_case = Region.t
type kwd_const = Region.t
type kwd_copy = Region.t
type kwd_down = Region.t
type kwd_else = Region.t
type kwd_end = Region.t
@ -56,6 +55,7 @@ type kwd_is = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
type kwd_of = Region.t
type kwd_patch = Region.t
type kwd_procedure = Region.t
type kwd_record = Region.t
type kwd_skip = Region.t
@ -325,6 +325,14 @@ and single_instr =
| ProcCall of fun_call
| Fail of fail_instr reg
| Skip of kwd_skip
| Patch of record_patch reg
and record_patch = {
kwd_patch : kwd_patch;
record_name : variable;
kwd_with : kwd_with;
delta : record_injection reg
}
and fail_instr = {
kwd_fail : kwd_fail;
@ -474,7 +482,6 @@ and constr_expr =
and record_expr =
RecordInj of record_injection reg
| RecordProj of record_projection reg
| RecordCopy of record_copy reg
and record_injection = {
opening : kwd_record;
@ -495,13 +502,6 @@ and record_projection = {
field_path : (field_name, dot) nsepseq
}
and record_copy = {
kwd_copy : kwd_copy;
record_name : variable;
kwd_with : kwd_with;
delta : record_injection reg
}
and tuple = (expr, comma) nsepseq par reg
and empty_list = typed_empty_list par
@ -640,8 +640,7 @@ and constr_expr_to_region = function
and record_expr_to_region = function
RecordInj {region; _}
| RecordProj {region; _}
| RecordCopy {region; _} -> region
| RecordProj {region; _} -> region
let instr_to_region = function
Single Cond {region; _}
@ -653,6 +652,7 @@ let instr_to_region = function
| Single ProcCall {region; _}
| Single Skip region
| Single Fail {region; _}
| Single Patch {region; _}
| Block {region; _} -> region
let pattern_to_region = function
@ -938,6 +938,7 @@ and print_single_instr = function
| ProcCall fun_call -> print_fun_call fun_call
| Fail {value; _} -> print_fail value
| Skip kwd_skip -> print_token kwd_skip "skip"
| Patch {value; _} -> print_patch value
and print_fail {kwd_fail; fail_expr} =
print_token kwd_fail "fail";
@ -1114,7 +1115,6 @@ and print_constr_expr = function
and print_record_expr = function
RecordInj e -> print_record_injection e
| RecordProj e -> print_record_projection e
| RecordCopy e -> print_record_copy e
and print_record_injection {value; _} =
let {opening; fields; terminator; close} = value in
@ -1138,9 +1138,9 @@ and print_record_projection {value; _} =
and print_field_path sequence =
print_nsepseq "." print_var sequence
and print_record_copy {value; _} =
let {kwd_copy; record_name; kwd_with; delta} = value in
print_token kwd_copy "copy";
and print_patch (node: record_patch) =
let {kwd_patch; record_name; kwd_with; delta} = node in
print_token kwd_patch "patch";
print_var record_name;
print_token kwd_with "with";
print_record_injection delta

18
AST.mli
View File

@ -26,7 +26,6 @@ val sepseq_to_region : ('a -> Region.t) -> ('a,'sep) sepseq -> Region.t
type kwd_begin = Region.t
type kwd_case = Region.t
type kwd_const = Region.t
type kwd_copy = Region.t
type kwd_down = Region.t
type kwd_else = Region.t
type kwd_end = Region.t
@ -40,6 +39,7 @@ type kwd_is = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
type kwd_of = Region.t
type kwd_patch = Region.t
type kwd_procedure = Region.t
type kwd_record = Region.t
type kwd_skip = Region.t
@ -309,6 +309,14 @@ and single_instr =
| ProcCall of fun_call
| Fail of fail_instr reg
| Skip of kwd_skip
| Patch of record_patch reg
and record_patch = {
kwd_patch : kwd_patch;
record_name : variable;
kwd_with : kwd_with;
delta : record_injection reg
}
and fail_instr = {
kwd_fail : kwd_fail;
@ -458,7 +466,6 @@ and constr_expr =
and record_expr =
RecordInj of record_injection reg
| RecordProj of record_projection reg
| RecordCopy of record_copy reg
and record_injection = {
opening : kwd_record;
@ -479,13 +486,6 @@ and record_projection = {
field_path : (field_name, dot) nsepseq
}
and record_copy = {
kwd_copy : kwd_copy;
record_name : variable;
kwd_with : kwd_with;
delta : record_injection reg
}
and tuple = (expr, comma) nsepseq par reg
and empty_list = typed_empty_list par

View File

@ -70,7 +70,6 @@ type t =
| Begin of Region.t (* "begin" *)
| Case of Region.t (* "case" *)
| Const of Region.t (* "const" *)
| Copy of Region.t (* "copy" *)
| Down of Region.t (* "down" *)
| Fail of Region.t (* "fail" *)
| If of Region.t (* "if" *)
@ -85,6 +84,7 @@ type t =
| End of Region.t (* "end" *)
| Then of Region.t (* "then" *)
| Else of Region.t (* "else" *)
| Patch of Region.t (* "patch" *)
| Procedure of Region.t (* "procedure" *)
| Record of Region.t (* "record" *)
| Skip of Region.t (* "skip" *)

View File

@ -69,7 +69,6 @@ type t =
| Begin of Region.t
| Case of Region.t
| Const of Region.t
| Copy of Region.t
| Down of Region.t
| Fail of Region.t
| If of Region.t
@ -84,6 +83,7 @@ type t =
| End of Region.t
| Then of Region.t
| Else of Region.t
| Patch of Region.t
| Procedure of Region.t
| Record of Region.t
| Skip of Region.t
@ -188,7 +188,6 @@ let proj_token = function
| Begin region -> region, "Begin"
| Case region -> region, "Case"
| Const region -> region, "Const"
| Copy region -> region, "Copy"
| Down region -> region, "Down"
| Fail region -> region, "Fail"
| If region -> region, "If"
@ -203,6 +202,7 @@ let proj_token = function
| End region -> region, "End"
| Then region -> region, "Then"
| Else region -> region, "Else"
| Patch region -> region, "Patch"
| Procedure region -> region, "Procedure"
| Record region -> region, "Record"
| Skip region -> region, "Skip"
@ -272,7 +272,6 @@ let to_lexeme = function
| Begin _ -> "begin"
| Case _ -> "case"
| Const _ -> "const"
| Copy _ -> "copy"
| Down _ -> "down"
| Fail _ -> "fail"
| If _ -> "if"
@ -287,6 +286,7 @@ let to_lexeme = function
| End _ -> "end"
| Then _ -> "then"
| Else _ -> "else"
| Patch _ -> "patch"
| Procedure _ -> "procedure"
| Record _ -> "record"
| Skip _ -> "skip"
@ -324,7 +324,6 @@ let keywords = [
(fun reg -> Begin reg);
(fun reg -> Case reg);
(fun reg -> Const reg);
(fun reg -> Copy reg);
(fun reg -> Down reg);
(fun reg -> Fail reg);
(fun reg -> If reg);
@ -339,6 +338,7 @@ let keywords = [
(fun reg -> End reg);
(fun reg -> Then reg);
(fun reg -> Else reg);
(fun reg -> Patch reg);
(fun reg -> Procedure reg);
(fun reg -> Record reg);
(fun reg -> Skip reg);
@ -548,7 +548,6 @@ let is_kwd = function
Begin _
| Case _
| Const _
| Copy _
| Down _
| Fail _
| If _
@ -563,6 +562,7 @@ let is_kwd = function
| End _
| Then _
| Else _
| Patch _
| Procedure _
| Record _
| Skip _

View File

@ -47,7 +47,6 @@
%token <Region.t> Begin (* "begin" *)
%token <Region.t> Case (* "case" *)
%token <Region.t> Const (* "const" *)
%token <Region.t> Copy (* "copy" *)
%token <Region.t> Down (* "down" *)
%token <Region.t> Fail (* "fail" *)
%token <Region.t> If (* "if" *)
@ -62,6 +61,7 @@
%token <Region.t> End (* "end" *)
%token <Region.t> Then (* "then" *)
%token <Region.t> Else (* "else" *)
%token <Region.t> Patch (* "patch" *)
%token <Region.t> Procedure (* "procedure" *)
%token <Region.t> Record (* "record" *)
%token <Region.t> Skip (* "skip" *)

View File

@ -427,6 +427,19 @@ single_instr:
| proc_call { ProcCall $1 }
| fail_instr { Fail $1 }
| Skip { Skip $1 }
| record_patch { Patch $1 }
record_patch:
Patch record_name With record_injection {
let region = cover $1 $4.region in
let value = {
kwd_patch = $1;
record_name = $2;
kwd_with = $3;
delta = $4}
in {region; value}
}
fail_instr:
Fail expr {
@ -722,7 +735,6 @@ map_selection:
record_expr:
record_injection { RecordInj $1 }
| record_projection { RecordProj $1 }
| record_copy { RecordCopy $1 }
record_injection:
Record
@ -780,17 +792,6 @@ record_projection:
in {region; value}
}
record_copy:
Copy record_name With record_injection {
let region = cover $1 $4.region in
let value = {
kwd_copy = $1;
record_name = $2;
kwd_with = $3;
delta = $4}
in {region; value}
}
fun_call:
fun_name arguments {
let region = cover $1.region $2.region

View File

@ -1,4 +1,4 @@
type state is
type store is
record
goal : nat;
deadline : timestamp;
@ -6,10 +6,10 @@ type state is
funded : bool
end
entrypoint contribute (storage store : state;
entrypoint contribute (storage store : store;
const sender : address;
const amount : mutez)
: state * list (operation) is
: store * list (operation) is
var operations : list (operation) := []
begin
if now > store.deadline then
@ -17,8 +17,7 @@ entrypoint contribute (storage store : state;
else
case store.backers[sender] of
None ->
store :=
copy store with
patch store with
record
backers = add_binding ((sender, amount), store.backers)
end
@ -26,15 +25,15 @@ entrypoint contribute (storage store : state;
end
end with (store, operations)
entrypoint withdraw (storage store : state; const sender : address)
: state * list (operation) is
entrypoint withdraw (storage store : store; const sender : address)
: store * list (operation) is
var operations : list (operation) := []
begin
if sender = owner then
if now >= store.deadline then
if balance >= store.goal then
begin
store := copy store with record funded = True end;
patch store with record funded = True end;
operations := [Transfer (owner, balance)]
end
else fail "Below target"
@ -42,8 +41,8 @@ entrypoint withdraw (storage store : state; const sender : address)
else skip
end with (store, operations)
entrypoint claim (storage store : state; const sender : address)
: state * list (operation) is
entrypoint claim (storage store : store; const sender : address)
: store * list (operation) is
var operations : list (operation) := []
var amount : mutez := 0
begin
@ -59,8 +58,7 @@ entrypoint claim (storage store : state; const sender : address)
else
begin
amount := store.backers[sender];
store :=
copy store with
patch store with
record
backers = remove_entry (sender, store.backers)
end;