Replaced expression "copy ... with ..." by instruction "patch ... with".
This commit is contained in:
parent
c3b304db4a
commit
4c9a743411
44
AST.ml
44
AST.ml
@ -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
|
||||
@ -318,13 +318,21 @@ and instruction =
|
||||
| Block of block reg
|
||||
|
||||
and single_instr =
|
||||
Cond of conditional reg
|
||||
| Case of case_instr reg
|
||||
| Assign of assignment reg
|
||||
| Loop of loop
|
||||
| ProcCall of fun_call
|
||||
| Fail of fail_instr reg
|
||||
| Skip of kwd_skip
|
||||
Cond of conditional reg
|
||||
| Case of case_instr reg
|
||||
| Assign of assignment reg
|
||||
| Loop of loop
|
||||
| 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
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_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
|
||||
|
@ -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" *)
|
||||
|
10
LexToken.mll
10
LexToken.mll
@ -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 _
|
||||
|
@ -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" *)
|
||||
|
39
Parser.mly
39
Parser.mly
@ -420,13 +420,26 @@ instruction:
|
||||
| block { Block $1 }
|
||||
|
||||
single_instr:
|
||||
conditional { Cond $1 }
|
||||
| case_instr { Case $1 }
|
||||
| assignment { Assign $1 }
|
||||
| loop { Loop $1 }
|
||||
| proc_call { ProcCall $1 }
|
||||
| fail_instr { Fail $1 }
|
||||
| Skip { Skip $1 }
|
||||
conditional { Cond $1 }
|
||||
| case_instr { Case $1 }
|
||||
| assignment { Assign $1 }
|
||||
| loop { Loop $1 }
|
||||
| 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
|
||||
|
@ -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,24 +17,23 @@ entrypoint contribute (storage store : state;
|
||||
else
|
||||
case store.backers[sender] of
|
||||
None ->
|
||||
store :=
|
||||
copy store with
|
||||
record
|
||||
backers = add_binding ((sender, amount), store.backers)
|
||||
end
|
||||
patch store with
|
||||
record
|
||||
backers = add_binding ((sender, amount), store.backers)
|
||||
end
|
||||
| _ -> skip
|
||||
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,11 +58,10 @@ entrypoint claim (storage store : state; const sender : address)
|
||||
else
|
||||
begin
|
||||
amount := store.backers[sender];
|
||||
store :=
|
||||
copy store with
|
||||
record
|
||||
backers = remove_entry (sender, store.backers)
|
||||
end;
|
||||
patch store with
|
||||
record
|
||||
backers = remove_entry (sender, store.backers)
|
||||
end;
|
||||
operations := [Transfer (sender, amount)]
|
||||
end
|
||||
end
|
||||
|
Loading…
Reference in New Issue
Block a user