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

44
AST.ml
View File

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

View File

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

View File

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

View File

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

View File

@ -420,13 +420,26 @@ instruction:
| block { Block $1 } | block { Block $1 }
single_instr: single_instr:
conditional { Cond $1 } conditional { Cond $1 }
| case_instr { Case $1 } | case_instr { Case $1 }
| assignment { Assign $1 } | assignment { Assign $1 }
| loop { Loop $1 } | loop { Loop $1 }
| proc_call { ProcCall $1 } | proc_call { ProcCall $1 }
| fail_instr { Fail $1 } | fail_instr { Fail $1 }
| Skip { Skip $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_instr:
Fail expr { Fail expr {
@ -722,7 +735,6 @@ map_selection:
record_expr: record_expr:
record_injection { RecordInj $1 } record_injection { RecordInj $1 }
| record_projection { RecordProj $1 } | record_projection { RecordProj $1 }
| record_copy { RecordCopy $1 }
record_injection: record_injection:
Record Record
@ -780,17 +792,6 @@ record_projection:
in {region; value} 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_call:
fun_name arguments { fun_name arguments {
let region = cover $1.region $2.region let region = cover $1.region $2.region

View File

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