Replaced expression "copy ... with ..." by instruction "patch ... with".
This commit is contained in:
parent
c3b304db4a
commit
4c9a743411
30
AST.ml
30
AST.ml
@ -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
|
||||||
@ -325,6 +325,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;
|
||||||
@ -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
18
AST.mli
@ -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
|
||||||
|
@ -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" *)
|
||||||
|
10
LexToken.mll
10
LexToken.mll
@ -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 _
|
||||||
|
@ -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" *)
|
||||||
|
25
Parser.mly
25
Parser.mly
@ -427,6 +427,19 @@ single_instr:
|
|||||||
| 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
|
||||||
|
@ -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,8 +17,7 @@ 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
|
||||||
@ -26,15 +25,15 @@ entrypoint contribute (storage store : state;
|
|||||||
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,8 +58,7 @@ 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;
|
||||||
|
Loading…
Reference in New Issue
Block a user