Merge remote-tracking branch 'origin/dev' into rinderknecht-dev
This commit is contained in:
commit
c5b5ffe51a
@ -12,7 +12,8 @@ stages:
|
|||||||
- build_and_deploy_website
|
- build_and_deploy_website
|
||||||
|
|
||||||
.build_binary: &build_binary
|
.build_binary: &build_binary
|
||||||
stage: build_and_package_binaries
|
# To run in sequence and save CPU usage, use stage: build_and_package_binaries
|
||||||
|
stage: test
|
||||||
script:
|
script:
|
||||||
- $build_binary_script "$target_os_family" "$target_os" "$target_os_version"
|
- $build_binary_script "$target_os_family" "$target_os" "$target_os_version"
|
||||||
- $package_binary_script "$target_os_family" "$target_os" "$target_os_version"
|
- $package_binary_script "$target_os_family" "$target_os" "$target_os_version"
|
||||||
@ -23,6 +24,11 @@ stages:
|
|||||||
.website_build: &website_build
|
.website_build: &website_build
|
||||||
stage: build_and_deploy_website
|
stage: build_and_deploy_website
|
||||||
image: node:8
|
image: node:8
|
||||||
|
dependencies:
|
||||||
|
- build-and-package-debian-9
|
||||||
|
- build-and-package-debian-10
|
||||||
|
- build-and-package-ubuntu-18-04
|
||||||
|
- build-and-package-ubuntu-19-04
|
||||||
before_script:
|
before_script:
|
||||||
- scripts/install_native_dependencies.sh
|
- scripts/install_native_dependencies.sh
|
||||||
- scripts/install_opam.sh # TODO: or scripts/install_build_environment.sh ?
|
- scripts/install_opam.sh # TODO: or scripts/install_build_environment.sh ?
|
||||||
@ -122,7 +128,8 @@ build-and-publish-latest-docker-image:
|
|||||||
# based on desired targets
|
# based on desired targets
|
||||||
build-and-package-debian-9:
|
build-and-package-debian-9:
|
||||||
<<: *docker
|
<<: *docker
|
||||||
stage: build_and_package_binaries
|
# To run in sequence and save CPU usage, use stage: build_and_package_binaries
|
||||||
|
stage: test
|
||||||
variables:
|
variables:
|
||||||
target_os_family: "debian"
|
target_os_family: "debian"
|
||||||
target_os: "debian"
|
target_os: "debian"
|
||||||
@ -131,7 +138,8 @@ build-and-package-debian-9:
|
|||||||
|
|
||||||
build-and-package-debian-10:
|
build-and-package-debian-10:
|
||||||
<<: *docker
|
<<: *docker
|
||||||
stage: build_and_package_binaries
|
# To run in sequence and save CPU usage, use stage: build_and_package_binaries
|
||||||
|
stage: test
|
||||||
variables:
|
variables:
|
||||||
target_os_family: "debian"
|
target_os_family: "debian"
|
||||||
target_os: "debian"
|
target_os: "debian"
|
||||||
@ -140,7 +148,8 @@ build-and-package-debian-10:
|
|||||||
|
|
||||||
build-and-package-ubuntu-18-04:
|
build-and-package-ubuntu-18-04:
|
||||||
<<: *docker
|
<<: *docker
|
||||||
stage: build_and_package_binaries
|
# To run in sequence and save CPU usage, use stage: build_and_package_binaries
|
||||||
|
stage: test
|
||||||
variables:
|
variables:
|
||||||
target_os_family: "debian"
|
target_os_family: "debian"
|
||||||
target_os: "ubuntu"
|
target_os: "ubuntu"
|
||||||
@ -149,7 +158,8 @@ build-and-package-ubuntu-18-04:
|
|||||||
|
|
||||||
build-and-package-ubuntu-19-04:
|
build-and-package-ubuntu-19-04:
|
||||||
<<: *docker
|
<<: *docker
|
||||||
stage: build_and_package_binaries
|
# To run in sequence and save CPU usage, use stage: build_and_package_binaries
|
||||||
|
stage: test
|
||||||
variables:
|
variables:
|
||||||
target_os_family: "debian"
|
target_os_family: "debian"
|
||||||
target_os: "ubuntu"
|
target_os: "ubuntu"
|
||||||
|
@ -71,3 +71,44 @@ const my_account: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address);
|
|||||||
```
|
```
|
||||||
<!--END_DOCUSAURUS_CODE_TABS-->
|
<!--END_DOCUSAURUS_CODE_TABS-->
|
||||||
|
|
||||||
|
## Signatures
|
||||||
|
|
||||||
|
`signature` is a LIGO datatype used for Tezos signature (edsig, spsig).
|
||||||
|
|
||||||
|
Here's how you can define a signature:
|
||||||
|
|
||||||
|
<!--DOCUSAURUS_CODE_TABS-->
|
||||||
|
<!--Pascaligo-->
|
||||||
|
```pascaligo group=e
|
||||||
|
const my_signature: signature = ("edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7": signature);
|
||||||
|
```
|
||||||
|
<!--CameLIGO-->
|
||||||
|
```cameligo group=e
|
||||||
|
let my_signature: signature = ("edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7": signature)
|
||||||
|
```
|
||||||
|
<!--ReasonLIGO-->
|
||||||
|
```reasonligo group=e
|
||||||
|
let my_signature: signature = ("edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7": signature);
|
||||||
|
```
|
||||||
|
<!--END_DOCUSAURUS_CODE_TABS-->
|
||||||
|
|
||||||
|
## keys
|
||||||
|
|
||||||
|
`key` is a LIGO datatype used for Tezos public key.
|
||||||
|
|
||||||
|
Here's how you can define a key:
|
||||||
|
|
||||||
|
<!--DOCUSAURUS_CODE_TABS-->
|
||||||
|
<!--Pascaligo-->
|
||||||
|
```pascaligo group=f
|
||||||
|
const my_key: key = ("edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav": key);
|
||||||
|
```
|
||||||
|
<!--CameLIGO-->
|
||||||
|
```cameligo group=f
|
||||||
|
let my_key: key = ("edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav": key)
|
||||||
|
```
|
||||||
|
<!--ReasonLIGO-->
|
||||||
|
```reasonligo group=f
|
||||||
|
let my_key: key = ("edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav": key);
|
||||||
|
```
|
||||||
|
<!--END_DOCUSAURUS_CODE_TABS-->
|
37
src/bin/expect_tests/literals.ml
Normal file
37
src/bin/expect_tests/literals.ml
Normal file
@ -0,0 +1,37 @@
|
|||||||
|
open Cli_expect
|
||||||
|
|
||||||
|
let%expect_test _ =
|
||||||
|
run_ligo_good ["interpret" ; "(\"edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7\":signature)" ; "--syntax=pascaligo"] ;
|
||||||
|
[%expect {| signature edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7 |}]
|
||||||
|
|
||||||
|
let%expect_test _ =
|
||||||
|
run_ligo_bad ["interpret" ; "(\"thisisnotasignature\":signature)" ; "--syntax=pascaligo"] ;
|
||||||
|
[%expect {|
|
||||||
|
ligo: in file "", line 0, characters 1-32. Badly formatted literal: signature thisisnotasignature {"location":"in file \"\", line 0, characters 1-32"}
|
||||||
|
|
||||||
|
|
||||||
|
If you're not sure how to fix this error, you can
|
||||||
|
do one of the following:
|
||||||
|
|
||||||
|
* Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
|
||||||
|
* Ask a question on our Discord: https://discord.gg/9rhYaEt
|
||||||
|
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
|
||||||
|
* Check the changelog by running 'ligo changelog' |}]
|
||||||
|
|
||||||
|
let%expect_test _ =
|
||||||
|
run_ligo_good ["interpret" ; "(\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\":key)" ; "--syntax=pascaligo"] ;
|
||||||
|
[%expect {| key edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav |}]
|
||||||
|
|
||||||
|
let%expect_test _ =
|
||||||
|
run_ligo_bad ["interpret" ; "(\"thisisnotapublickey\":key)" ; "--syntax=pascaligo"] ;
|
||||||
|
[%expect {|
|
||||||
|
ligo: in file "", line 0, characters 1-26. Badly formatted literal: key thisisnotapublickey {"location":"in file \"\", line 0, characters 1-26"}
|
||||||
|
|
||||||
|
|
||||||
|
If you're not sure how to fix this error, you can
|
||||||
|
do one of the following:
|
||||||
|
|
||||||
|
* Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
|
||||||
|
* Ask a question on our Discord: https://discord.gg/9rhYaEt
|
||||||
|
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
|
||||||
|
* Check the changelog by running 'ligo changelog' |}]
|
@ -223,8 +223,9 @@ and expr =
|
|||||||
| EString of string_expr
|
| EString of string_expr
|
||||||
| EList of list_expr
|
| EList of list_expr
|
||||||
| EConstr of constr_expr
|
| EConstr of constr_expr
|
||||||
| ERecord of field_assign reg ne_injection reg
|
| ERecord of record reg
|
||||||
| EProj of projection reg
|
| EProj of projection reg
|
||||||
|
| EUpdate of update reg
|
||||||
| EVar of variable
|
| EVar of variable
|
||||||
| ECall of (expr * expr nseq) reg
|
| ECall of (expr * expr nseq) reg
|
||||||
| EBytes of (string * Hex.t) reg
|
| EBytes of (string * Hex.t) reg
|
||||||
@ -307,6 +308,7 @@ and comp_expr =
|
|||||||
| Equal of equal bin_op reg
|
| Equal of equal bin_op reg
|
||||||
| Neq of neq bin_op reg
|
| Neq of neq bin_op reg
|
||||||
|
|
||||||
|
and record = field_assign reg ne_injection
|
||||||
and projection = {
|
and projection = {
|
||||||
struct_name : variable;
|
struct_name : variable;
|
||||||
selector : dot;
|
selector : dot;
|
||||||
@ -323,6 +325,17 @@ and field_assign = {
|
|||||||
field_expr : expr
|
field_expr : expr
|
||||||
}
|
}
|
||||||
|
|
||||||
|
and update = {
|
||||||
|
lbrace : lbrace;
|
||||||
|
record : path;
|
||||||
|
kwd_with : kwd_with;
|
||||||
|
updates : record reg;
|
||||||
|
rbrace : rbrace;
|
||||||
|
}
|
||||||
|
and path =
|
||||||
|
Name of variable
|
||||||
|
| Path of projection reg
|
||||||
|
|
||||||
and 'a case = {
|
and 'a case = {
|
||||||
kwd_match : kwd_match;
|
kwd_match : kwd_match;
|
||||||
expr : expr;
|
expr : expr;
|
||||||
@ -443,8 +456,12 @@ let expr_to_region = function
|
|||||||
| ECond {region;_} | ETuple {region;_} | ECase {region;_}
|
| ECond {region;_} | ETuple {region;_} | ECase {region;_}
|
||||||
| ECall {region;_} | EVar {region; _} | EProj {region; _}
|
| ECall {region;_} | EVar {region; _} | EProj {region; _}
|
||||||
| EUnit {region;_} | EPar {region;_} | EBytes {region; _}
|
| EUnit {region;_} | EPar {region;_} | EBytes {region; _}
|
||||||
| ESeq {region; _} | ERecord {region; _} -> region
|
| ESeq {region; _} | ERecord {region; _} | EUpdate {region; _} -> region
|
||||||
|
|
||||||
let selection_to_region = function
|
let selection_to_region = function
|
||||||
FieldName f -> f.region
|
FieldName f -> f.region
|
||||||
| Component c -> c.region
|
| Component c -> c.region
|
||||||
|
|
||||||
|
let path_to_region = function
|
||||||
|
Name var -> var.region
|
||||||
|
| Path {region; _} -> region
|
||||||
|
@ -584,6 +584,7 @@ core_expr:
|
|||||||
| list(expr) { EList (EListComp $1) }
|
| list(expr) { EList (EListComp $1) }
|
||||||
| sequence { ESeq $1 }
|
| sequence { ESeq $1 }
|
||||||
| record_expr { ERecord $1 }
|
| record_expr { ERecord $1 }
|
||||||
|
| update_record { EUpdate $1 }
|
||||||
| par(expr) { EPar $1 }
|
| par(expr) { EPar $1 }
|
||||||
| par(expr ":" type_expr {$1,$2,$3}) { EAnnot $1 }
|
| par(expr ":" type_expr {$1,$2,$3}) { EAnnot $1 }
|
||||||
|
|
||||||
@ -622,6 +623,21 @@ record_expr:
|
|||||||
terminator}
|
terminator}
|
||||||
in {region; value} }
|
in {region; value} }
|
||||||
|
|
||||||
|
update_record:
|
||||||
|
"{" path "with" sep_or_term_list(field_assignment,";") "}" {
|
||||||
|
let region = cover $1 $5 in
|
||||||
|
let ne_elements, terminator = $4 in
|
||||||
|
let value = {
|
||||||
|
lbrace = $1;
|
||||||
|
record = $2;
|
||||||
|
kwd_with = $3;
|
||||||
|
updates = { value = {compound = Braces($1,$5);
|
||||||
|
ne_elements;
|
||||||
|
terminator};
|
||||||
|
region = cover $3 $5};
|
||||||
|
rbrace = $5}
|
||||||
|
in {region; value} }
|
||||||
|
|
||||||
field_assignment:
|
field_assignment:
|
||||||
field_name "=" expr {
|
field_name "=" expr {
|
||||||
let start = $1.region in
|
let start = $1.region in
|
||||||
@ -643,3 +659,7 @@ sequence:
|
|||||||
Some ne_elements, terminator in
|
Some ne_elements, terminator in
|
||||||
let value = {compound; elements; terminator}
|
let value = {compound; elements; terminator}
|
||||||
in {region; value} }
|
in {region; value} }
|
||||||
|
|
||||||
|
path :
|
||||||
|
"<ident>" {Name $1}
|
||||||
|
| projection { Path $1}
|
||||||
|
@ -175,6 +175,18 @@ and print_projection state {value; _} =
|
|||||||
print_token state selector ".";
|
print_token state selector ".";
|
||||||
print_nsepseq state "." print_selection field_path
|
print_nsepseq state "." print_selection field_path
|
||||||
|
|
||||||
|
and print_update state {value; _} =
|
||||||
|
let {lbrace; record; kwd_with; updates; rbrace} = value in
|
||||||
|
print_token state lbrace "{";
|
||||||
|
print_path state record;
|
||||||
|
print_token state kwd_with "with";
|
||||||
|
print_record_expr state updates;
|
||||||
|
print_token state rbrace "}"
|
||||||
|
|
||||||
|
and print_path state = function
|
||||||
|
Name var -> print_var state var
|
||||||
|
| Path path -> print_projection state path
|
||||||
|
|
||||||
and print_selection state = function
|
and print_selection state = function
|
||||||
FieldName id -> print_var state id
|
FieldName id -> print_var state id
|
||||||
| Component c -> print_int state c
|
| Component c -> print_int state c
|
||||||
@ -329,6 +341,7 @@ and print_expr state = function
|
|||||||
| ECall e -> print_fun_call state e
|
| ECall e -> print_fun_call state e
|
||||||
| EVar v -> print_var state v
|
| EVar v -> print_var state v
|
||||||
| EProj p -> print_projection state p
|
| EProj p -> print_projection state p
|
||||||
|
| EUpdate u -> print_update state u
|
||||||
| EUnit e -> print_unit state e
|
| EUnit e -> print_unit state e
|
||||||
| EBytes b -> print_bytes state b
|
| EBytes b -> print_bytes state b
|
||||||
| EPar e -> print_expr_par state e
|
| EPar e -> print_expr_par state e
|
||||||
@ -765,6 +778,9 @@ and pp_expr state = function
|
|||||||
| EProj {value; region} ->
|
| EProj {value; region} ->
|
||||||
pp_loc_node state "EProj" region;
|
pp_loc_node state "EProj" region;
|
||||||
pp_projection state value
|
pp_projection state value
|
||||||
|
| EUpdate {value; region} ->
|
||||||
|
pp_loc_node state "EUpdate" region;
|
||||||
|
pp_update state value
|
||||||
| EVar v ->
|
| EVar v ->
|
||||||
pp_node state "EVar";
|
pp_node state "EVar";
|
||||||
pp_ident (state#pad 1 0) v
|
pp_ident (state#pad 1 0) v
|
||||||
@ -857,6 +873,18 @@ and pp_projection state proj =
|
|||||||
pp_ident (state#pad (1+len) 0) proj.struct_name;
|
pp_ident (state#pad (1+len) 0) proj.struct_name;
|
||||||
List.iteri (apply len) selections
|
List.iteri (apply len) selections
|
||||||
|
|
||||||
|
and pp_update state update =
|
||||||
|
pp_path state update.record;
|
||||||
|
pp_ne_injection pp_field_assign state update.updates.value
|
||||||
|
|
||||||
|
and pp_path state = function
|
||||||
|
Name name ->
|
||||||
|
pp_node state "Name";
|
||||||
|
pp_ident (state#pad 1 0) name
|
||||||
|
| Path {value; region} ->
|
||||||
|
pp_loc_node state "Path" region;
|
||||||
|
pp_projection state value
|
||||||
|
|
||||||
and pp_selection state = function
|
and pp_selection state = function
|
||||||
FieldName fn ->
|
FieldName fn ->
|
||||||
pp_node state "FieldName";
|
pp_node state "FieldName";
|
||||||
|
@ -24,3 +24,6 @@ let e = Some (a, B b)
|
|||||||
let z = z.1.2
|
let z = z.1.2
|
||||||
let v = "hello" ^ "world" ^ "!"
|
let v = "hello" ^ "world" ^ "!"
|
||||||
let w = Map.literal [(1,"1"); (2,"2")]
|
let w = Map.literal [(1,"1"); (2,"2")]
|
||||||
|
|
||||||
|
let r = { field = 0}
|
||||||
|
let r = { r with field = 42}
|
||||||
|
@ -324,7 +324,7 @@ and record_patch = {
|
|||||||
kwd_patch : kwd_patch;
|
kwd_patch : kwd_patch;
|
||||||
path : path;
|
path : path;
|
||||||
kwd_with : kwd_with;
|
kwd_with : kwd_with;
|
||||||
record_inj : field_assign reg ne_injection reg
|
record_inj : record reg
|
||||||
}
|
}
|
||||||
|
|
||||||
and cond_expr = {
|
and cond_expr = {
|
||||||
@ -443,8 +443,9 @@ and expr =
|
|||||||
| EList of list_expr
|
| EList of list_expr
|
||||||
| ESet of set_expr
|
| ESet of set_expr
|
||||||
| EConstr of constr_expr
|
| EConstr of constr_expr
|
||||||
| ERecord of field_assign reg ne_injection reg
|
| ERecord of record reg
|
||||||
| EProj of projection reg
|
| EProj of projection reg
|
||||||
|
| EUpdate of update reg
|
||||||
| EMap of map_expr
|
| EMap of map_expr
|
||||||
| EVar of Lexer.lexeme reg
|
| EVar of Lexer.lexeme reg
|
||||||
| ECall of fun_call
|
| ECall of fun_call
|
||||||
@ -556,6 +557,7 @@ and field_assign = {
|
|||||||
equal : equal;
|
equal : equal;
|
||||||
field_expr : expr
|
field_expr : expr
|
||||||
}
|
}
|
||||||
|
and record = field_assign reg ne_injection
|
||||||
|
|
||||||
and projection = {
|
and projection = {
|
||||||
struct_name : variable;
|
struct_name : variable;
|
||||||
@ -563,6 +565,12 @@ and projection = {
|
|||||||
field_path : (selection, dot) nsepseq
|
field_path : (selection, dot) nsepseq
|
||||||
}
|
}
|
||||||
|
|
||||||
|
and update = {
|
||||||
|
record : path;
|
||||||
|
kwd_with : kwd_with;
|
||||||
|
updates : record reg;
|
||||||
|
}
|
||||||
|
|
||||||
and selection =
|
and selection =
|
||||||
FieldName of field_name
|
FieldName of field_name
|
||||||
| Component of (Lexer.lexeme * Z.t) reg
|
| Component of (Lexer.lexeme * Z.t) reg
|
||||||
@ -641,6 +649,7 @@ let rec expr_to_region = function
|
|||||||
| ERecord e -> record_expr_to_region e
|
| ERecord e -> record_expr_to_region e
|
||||||
| EMap e -> map_expr_to_region e
|
| EMap e -> map_expr_to_region e
|
||||||
| ETuple e -> tuple_expr_to_region e
|
| ETuple e -> tuple_expr_to_region e
|
||||||
|
| EUpdate {region; _}
|
||||||
| EProj {region; _}
|
| EProj {region; _}
|
||||||
| EVar {region; _}
|
| EVar {region; _}
|
||||||
| ECall {region; _}
|
| ECall {region; _}
|
||||||
|
@ -829,6 +829,7 @@ core_expr:
|
|||||||
| map_expr { EMap $1 }
|
| map_expr { EMap $1 }
|
||||||
| set_expr { ESet $1 }
|
| set_expr { ESet $1 }
|
||||||
| record_expr { ERecord $1 }
|
| record_expr { ERecord $1 }
|
||||||
|
| update_record { EUpdate $1 }
|
||||||
| "<constr>" arguments {
|
| "<constr>" arguments {
|
||||||
let region = cover $1.region $2.region in
|
let region = cover $1.region $2.region in
|
||||||
EConstr (ConstrApp {region; value = $1, Some $2})
|
EConstr (ConstrApp {region; value = $1, Some $2})
|
||||||
@ -921,6 +922,16 @@ record_expr:
|
|||||||
closing = RBracket $4}
|
closing = RBracket $4}
|
||||||
in {region; value} }
|
in {region; value} }
|
||||||
|
|
||||||
|
update_record:
|
||||||
|
path "with" ne_injection("record",field_assignment){
|
||||||
|
let region = cover (path_to_region $1) $3.region in
|
||||||
|
let value = {
|
||||||
|
record = $1;
|
||||||
|
kwd_with = $2;
|
||||||
|
updates = $3}
|
||||||
|
in {region; value} }
|
||||||
|
|
||||||
|
|
||||||
field_assignment:
|
field_assignment:
|
||||||
field_name "=" expr {
|
field_name "=" expr {
|
||||||
let region = cover $1.region (expr_to_region $3)
|
let region = cover $1.region (expr_to_region $3)
|
||||||
|
@ -433,6 +433,7 @@ and print_expr state = function
|
|||||||
| ESet e -> print_set_expr state e
|
| ESet e -> print_set_expr state e
|
||||||
| EConstr e -> print_constr_expr state e
|
| EConstr e -> print_constr_expr state e
|
||||||
| ERecord e -> print_record_expr state e
|
| ERecord e -> print_record_expr state e
|
||||||
|
| EUpdate e -> print_update_expr state e
|
||||||
| EProj e -> print_projection state e
|
| EProj e -> print_projection state e
|
||||||
| EMap e -> print_map_expr state e
|
| EMap e -> print_map_expr state e
|
||||||
| EVar v -> print_var state v
|
| EVar v -> print_var state v
|
||||||
@ -597,6 +598,12 @@ and print_field_assign state {value; _} =
|
|||||||
print_token state equal "=";
|
print_token state equal "=";
|
||||||
print_expr state field_expr
|
print_expr state field_expr
|
||||||
|
|
||||||
|
and print_update_expr state {value; _} =
|
||||||
|
let {record; kwd_with; updates} = value in
|
||||||
|
print_path state record;
|
||||||
|
print_token state kwd_with "with";
|
||||||
|
print_record_expr state updates
|
||||||
|
|
||||||
and print_projection state {value; _} =
|
and print_projection state {value; _} =
|
||||||
let {struct_name; selector; field_path} = value in
|
let {struct_name; selector; field_path} = value in
|
||||||
print_var state struct_name;
|
print_var state struct_name;
|
||||||
@ -1191,6 +1198,10 @@ and pp_projection state proj =
|
|||||||
pp_ident (state#pad (1+len) 0) proj.struct_name;
|
pp_ident (state#pad (1+len) 0) proj.struct_name;
|
||||||
List.iteri (apply len) selections
|
List.iteri (apply len) selections
|
||||||
|
|
||||||
|
and pp_update state update =
|
||||||
|
pp_path state update.record;
|
||||||
|
pp_ne_injection pp_field_assign state update.updates.value
|
||||||
|
|
||||||
and pp_selection state = function
|
and pp_selection state = function
|
||||||
FieldName name ->
|
FieldName name ->
|
||||||
pp_node state "FieldName";
|
pp_node state "FieldName";
|
||||||
@ -1366,6 +1377,9 @@ and pp_expr state = function
|
|||||||
| EProj {value; region} ->
|
| EProj {value; region} ->
|
||||||
pp_loc_node state "EProj" region;
|
pp_loc_node state "EProj" region;
|
||||||
pp_projection state value
|
pp_projection state value
|
||||||
|
| EUpdate {value; region} ->
|
||||||
|
pp_loc_node state "EUpdate" region;
|
||||||
|
pp_update state value
|
||||||
| EMap e_map ->
|
| EMap e_map ->
|
||||||
pp_node state "EMap";
|
pp_node state "EMap";
|
||||||
pp_map_expr (state#pad 1 0) e_map
|
pp_map_expr (state#pad 1 0) e_map
|
||||||
|
@ -24,6 +24,8 @@ function back (var store : store) : list (operation) * store is
|
|||||||
x := map [1 -> "1"; 2 -> "2"];
|
x := map [1 -> "1"; 2 -> "2"];
|
||||||
y := a.b.c[3];
|
y := a.b.c[3];
|
||||||
a := "hello " ^ "world" ^ "!";
|
a := "hello " ^ "world" ^ "!";
|
||||||
|
r := record a = 0 end;
|
||||||
|
r := r with record a = 42 end;
|
||||||
patch store.backers with set [(1); f(2*3)];
|
patch store.backers with set [(1); f(2*3)];
|
||||||
remove (1,2,3) from set foo.bar;
|
remove (1,2,3) from set foo.bar;
|
||||||
remove 3 from map foo.bar;
|
remove 3 from map foo.bar;
|
||||||
|
@ -702,6 +702,7 @@ common_expr:
|
|||||||
| "<bytes>" { EBytes $1 }
|
| "<bytes>" { EBytes $1 }
|
||||||
| "<ident>" | module_field { EVar $1 }
|
| "<ident>" | module_field { EVar $1 }
|
||||||
| projection { EProj $1 }
|
| projection { EProj $1 }
|
||||||
|
| update_record { EUpdate $1 }
|
||||||
| "<string>" { EString (String $1) }
|
| "<string>" { EString (String $1) }
|
||||||
| unit { EUnit $1 }
|
| unit { EUnit $1 }
|
||||||
| "false" { ELogic (BoolExpr (False $1)) }
|
| "false" { ELogic (BoolExpr (False $1)) }
|
||||||
@ -788,6 +789,25 @@ projection:
|
|||||||
field_path = snd $4}
|
field_path = snd $4}
|
||||||
in {region; value} }
|
in {region; value} }
|
||||||
|
|
||||||
|
path :
|
||||||
|
"<ident>" {Name $1}
|
||||||
|
| projection { Path $1}
|
||||||
|
|
||||||
|
update_record :
|
||||||
|
"{""..."path "," sep_or_term_list(field_assignment,",") "}" {
|
||||||
|
let region = cover $1 $6 in
|
||||||
|
let ne_elements, terminator = $5 in
|
||||||
|
let value = {
|
||||||
|
lbrace = $1;
|
||||||
|
record = $3;
|
||||||
|
kwd_with = $4;
|
||||||
|
updates = { value = {compound = Braces($1,$6);
|
||||||
|
ne_elements;
|
||||||
|
terminator};
|
||||||
|
region = cover $4 $6};
|
||||||
|
rbrace = $6}
|
||||||
|
in {region; value} }
|
||||||
|
|
||||||
sequence_or_record_in:
|
sequence_or_record_in:
|
||||||
expr ";" sep_or_term_list(expr,";") {
|
expr ";" sep_or_term_list(expr,";") {
|
||||||
let elts, _region = $3 in
|
let elts, _region = $3 in
|
||||||
|
@ -262,6 +262,40 @@ let rec simpl_expression :
|
|||||||
List.map aux @@ npseq_to_list path in
|
List.map aux @@ npseq_to_list path in
|
||||||
return @@ e_accessor ~loc var path'
|
return @@ e_accessor ~loc var path'
|
||||||
in
|
in
|
||||||
|
let simpl_path : Raw.path -> string * Ast_simplified.access_path = fun p ->
|
||||||
|
match p with
|
||||||
|
| Raw.Name v -> (v.value , [])
|
||||||
|
| Raw.Path p -> (
|
||||||
|
let p' = p.value in
|
||||||
|
let var = p'.struct_name.value in
|
||||||
|
let path = p'.field_path in
|
||||||
|
let path' =
|
||||||
|
let aux (s:Raw.selection) =
|
||||||
|
match s with
|
||||||
|
| FieldName property -> Access_record property.value
|
||||||
|
| Component index -> Access_tuple (Z.to_int (snd index.value))
|
||||||
|
in
|
||||||
|
List.map aux @@ npseq_to_list path in
|
||||||
|
(var , path')
|
||||||
|
)
|
||||||
|
in
|
||||||
|
let simpl_update = fun (u:Raw.update Region.reg) ->
|
||||||
|
let (u, loc) = r_split u in
|
||||||
|
let (name, path) = simpl_path u.record in
|
||||||
|
let record = match path with
|
||||||
|
| [] -> e_variable (Var.of_name name)
|
||||||
|
| _ -> e_accessor (e_variable (Var.of_name name)) path in
|
||||||
|
let updates = u.updates.value.ne_elements in
|
||||||
|
let%bind updates' =
|
||||||
|
let aux (f:Raw.field_assign Raw.reg) =
|
||||||
|
let (f,_) = r_split f in
|
||||||
|
let%bind expr = simpl_expression f.field_expr in
|
||||||
|
ok (f.field_name.value, expr)
|
||||||
|
in
|
||||||
|
bind_map_list aux @@ npseq_to_list updates
|
||||||
|
in
|
||||||
|
return @@ e_update ~loc record updates'
|
||||||
|
in
|
||||||
|
|
||||||
trace (simplifying_expr t) @@
|
trace (simplifying_expr t) @@
|
||||||
match t with
|
match t with
|
||||||
@ -367,6 +401,7 @@ let rec simpl_expression :
|
|||||||
let map = SMap.of_list fields in
|
let map = SMap.of_list fields in
|
||||||
return @@ e_record ~loc map
|
return @@ e_record ~loc map
|
||||||
| EProj p -> simpl_projection p
|
| EProj p -> simpl_projection p
|
||||||
|
| EUpdate u -> simpl_update u
|
||||||
| EConstr (ESomeApp a) ->
|
| EConstr (ESomeApp a) ->
|
||||||
let (_, args), loc = r_split a in
|
let (_, args), loc = r_split a in
|
||||||
let%bind arg = simpl_expression args in
|
let%bind arg = simpl_expression args in
|
||||||
|
@ -339,6 +339,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
|
|||||||
let aux prev (k, v) = SMap.add k v prev in
|
let aux prev (k, v) = SMap.add k v prev in
|
||||||
return @@ e_record (List.fold_left aux SMap.empty fields)
|
return @@ e_record (List.fold_left aux SMap.empty fields)
|
||||||
| EProj p -> simpl_projection p
|
| EProj p -> simpl_projection p
|
||||||
|
| EUpdate u -> simpl_update u
|
||||||
| EConstr (ConstrApp c) -> (
|
| EConstr (ConstrApp c) -> (
|
||||||
let ((c, args) , loc) = r_split c in
|
let ((c, args) , loc) = r_split c in
|
||||||
match args with
|
match args with
|
||||||
@ -463,6 +464,24 @@ let rec simpl_expression (t:Raw.expr) : expr result =
|
|||||||
let%bind (_ty_opt, f') = simpl_fun_expression ~loc f
|
let%bind (_ty_opt, f') = simpl_fun_expression ~loc f
|
||||||
in return @@ f'
|
in return @@ f'
|
||||||
|
|
||||||
|
|
||||||
|
and simpl_update = fun (u:Raw.update Region.reg) ->
|
||||||
|
let (u, loc) = r_split u in
|
||||||
|
let (name, path) = simpl_path u.record in
|
||||||
|
let record = match path with
|
||||||
|
| [] -> e_variable (Var.of_name name)
|
||||||
|
| _ -> e_accessor (e_variable (Var.of_name name)) path in
|
||||||
|
let updates = u.updates.value.ne_elements in
|
||||||
|
let%bind updates' =
|
||||||
|
let aux (f:Raw.field_assign Raw.reg) =
|
||||||
|
let (f,_) = r_split f in
|
||||||
|
let%bind expr = simpl_expression f.field_expr in
|
||||||
|
ok (f.field_name.value, expr)
|
||||||
|
in
|
||||||
|
bind_map_list aux @@ npseq_to_list updates
|
||||||
|
in
|
||||||
|
ok @@ e_update ~loc record updates'
|
||||||
|
|
||||||
and simpl_logic_expression (t:Raw.logic_expr) : expression result =
|
and simpl_logic_expression (t:Raw.logic_expr) : expression result =
|
||||||
let return x = ok x in
|
let return x = ok x in
|
||||||
match t with
|
match t with
|
||||||
|
@ -41,6 +41,15 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
|
|||||||
let%bind res = bind_fold_lmap aux (ok init') m in
|
let%bind res = bind_fold_lmap aux (ok init') m in
|
||||||
ok res
|
ok res
|
||||||
)
|
)
|
||||||
|
| E_update {record;updates} -> (
|
||||||
|
let%bind res = self init' record in
|
||||||
|
let aux res (_, expr) =
|
||||||
|
let%bind res = fold_expression self res expr in
|
||||||
|
ok res
|
||||||
|
in
|
||||||
|
let%bind res = bind_fold_list aux res updates in
|
||||||
|
ok res
|
||||||
|
)
|
||||||
| E_let_in { binder = _ ; rhs ; result } -> (
|
| E_let_in { binder = _ ; rhs ; result } -> (
|
||||||
let%bind res = self init' rhs in
|
let%bind res = self init' rhs in
|
||||||
let%bind res = self res result in
|
let%bind res = self res result in
|
||||||
@ -131,6 +140,11 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
|
|||||||
let%bind m' = bind_map_lmap self m in
|
let%bind m' = bind_map_lmap self m in
|
||||||
return @@ E_record m'
|
return @@ E_record m'
|
||||||
)
|
)
|
||||||
|
| E_update {record; updates} -> (
|
||||||
|
let%bind record = self record in
|
||||||
|
let%bind updates = bind_map_list (fun(l,e) -> let%bind e = self e in ok (l,e)) updates in
|
||||||
|
return @@ E_update {record;updates}
|
||||||
|
)
|
||||||
| E_constructor (name , e) -> (
|
| E_constructor (name , e) -> (
|
||||||
let%bind e' = self e in
|
let%bind e' = self e in
|
||||||
return @@ E_constructor (name , e')
|
return @@ E_constructor (name , e')
|
||||||
|
@ -68,6 +68,20 @@ let peephole_expression : expression -> expression result = fun e ->
|
|||||||
Protocol.Alpha_context.Contract.of_b58check s in
|
Protocol.Alpha_context.Contract.of_b58check s in
|
||||||
return l
|
return l
|
||||||
)
|
)
|
||||||
|
| E_literal (Literal_signature s) as l -> (
|
||||||
|
let open Tezos_crypto in
|
||||||
|
let%bind (_sig:Crypto.Signature.t) =
|
||||||
|
Trace.trace_tzresult (bad_format e) @@
|
||||||
|
Signature.of_b58check s in
|
||||||
|
return l
|
||||||
|
)
|
||||||
|
| E_literal (Literal_key s) as l -> (
|
||||||
|
let open Tezos_crypto in
|
||||||
|
let%bind (_k:Crypto.Signature.public_key) =
|
||||||
|
Trace.trace_tzresult (bad_format e) @@
|
||||||
|
Signature.Public_key.of_b58check s in
|
||||||
|
return l
|
||||||
|
)
|
||||||
| E_constant (C_BIG_MAP_LITERAL as cst, lst) -> (
|
| E_constant (C_BIG_MAP_LITERAL as cst, lst) -> (
|
||||||
let%bind elt =
|
let%bind elt =
|
||||||
trace_option (bad_single_arity cst e.location) @@
|
trace_option (bad_single_arity cst e.location) @@
|
||||||
|
@ -18,6 +18,8 @@ let peephole_expression : expression -> expression result = fun e ->
|
|||||||
| E_ascription (e' , t) as e -> (
|
| E_ascription (e' , t) as e -> (
|
||||||
match (e'.expression , t.type_expression') with
|
match (e'.expression , t.type_expression') with
|
||||||
| (E_literal (Literal_string s) , T_constant (TC_key_hash)) -> return @@ E_literal (Literal_key_hash s)
|
| (E_literal (Literal_string s) , T_constant (TC_key_hash)) -> return @@ E_literal (Literal_key_hash s)
|
||||||
|
| (E_literal (Literal_string s) , T_constant (TC_signature)) -> return @@ E_literal (Literal_signature s)
|
||||||
|
| (E_literal (Literal_string s) , T_constant (TC_key)) -> return @@ E_literal (Literal_key s)
|
||||||
| (E_literal (Literal_int i) , T_constant (TC_timestamp)) -> return @@ E_literal (Literal_timestamp i)
|
| (E_literal (Literal_int i) , T_constant (TC_timestamp)) -> return @@ E_literal (Literal_timestamp i)
|
||||||
| (E_literal (Literal_string str) , T_constant (TC_timestamp)) ->
|
| (E_literal (Literal_string str) , T_constant (TC_timestamp)) ->
|
||||||
let%bind time =
|
let%bind time =
|
||||||
|
@ -529,6 +529,27 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
|
|||||||
let%bind (m' , state') = I.bind_fold_lmap aux (ok (I.LMap.empty , state)) m in
|
let%bind (m' , state') = I.bind_fold_lmap aux (ok (I.LMap.empty , state)) m in
|
||||||
let wrapped = Wrap.record (I.LMap.map get_type_annotation m') in
|
let wrapped = Wrap.record (I.LMap.map get_type_annotation m') in
|
||||||
return_wrapped (E_record m') state' wrapped
|
return_wrapped (E_record m') state' wrapped
|
||||||
|
| E_update {record; updates} ->
|
||||||
|
let%bind (record, state) = type_expression e state record in
|
||||||
|
let aux (lst,state) (k, expr) =
|
||||||
|
let%bind (expr', state) = type_expression e state expr in
|
||||||
|
ok ((k,expr')::lst, state)
|
||||||
|
in
|
||||||
|
let%bind (updates, state) = bind_fold_list aux ([], state) updates in
|
||||||
|
let wrapped = get_type_annotation record in
|
||||||
|
let%bind wrapped = match wrapped.type_value' with
|
||||||
|
| T_record record ->
|
||||||
|
let aux (k, e) =
|
||||||
|
let field_op = I.LMap.find_opt k record in
|
||||||
|
match field_op with
|
||||||
|
| None -> failwith @@ Format.asprintf "field %a is not part of record" Stage_common.PP.label k
|
||||||
|
| Some tv -> O.assert_type_value_eq (tv, get_type_annotation e)
|
||||||
|
in
|
||||||
|
let%bind () = bind_iter_list aux updates in
|
||||||
|
ok (record)
|
||||||
|
| _ -> failwith "Update an expression which is not a record"
|
||||||
|
in
|
||||||
|
return_wrapped (E_record_update (record, updates)) state (Wrap.record wrapped)
|
||||||
(* Data-structure *)
|
(* Data-structure *)
|
||||||
|
|
||||||
(*
|
(*
|
||||||
@ -1089,6 +1110,14 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
|
|||||||
| E_record_accessor (r, Label s) ->
|
| E_record_accessor (r, Label s) ->
|
||||||
let%bind r' = untype_expression r in
|
let%bind r' = untype_expression r in
|
||||||
return (e_accessor r' [Access_record s])
|
return (e_accessor r' [Access_record s])
|
||||||
|
| E_record_update (r, updates) ->
|
||||||
|
let%bind r' = untype_expression r in
|
||||||
|
let aux (Label l,e) =
|
||||||
|
let%bind e = untype_expression e in
|
||||||
|
ok (l, e)
|
||||||
|
in
|
||||||
|
let%bind updates = bind_map_list aux updates in
|
||||||
|
return (e_update r' updates)
|
||||||
| E_map m ->
|
| E_map m ->
|
||||||
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
|
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
|
||||||
return (e_map m')
|
return (e_map m')
|
||||||
|
@ -496,6 +496,26 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
|
|||||||
in
|
in
|
||||||
let%bind m' = I.bind_fold_lmap aux (ok I.LMap.empty) m in
|
let%bind m' = I.bind_fold_lmap aux (ok I.LMap.empty) m in
|
||||||
return (E_record m') (t_record (I.LMap.map get_type_annotation m') ())
|
return (E_record m') (t_record (I.LMap.map get_type_annotation m') ())
|
||||||
|
| E_update {record; updates} ->
|
||||||
|
let%bind record = type_expression' e record in
|
||||||
|
let aux acc (k, expr) =
|
||||||
|
let%bind expr' = type_expression' e expr in
|
||||||
|
ok ((k,expr')::acc)
|
||||||
|
in
|
||||||
|
let%bind updates = bind_fold_list aux ([]) updates in
|
||||||
|
let wrapped = get_type_annotation record in
|
||||||
|
let%bind () = match wrapped.type_value' with
|
||||||
|
| T_record record ->
|
||||||
|
let aux (k, e) =
|
||||||
|
let field_op = I.LMap.find_opt k record in
|
||||||
|
match field_op with
|
||||||
|
| None -> failwith @@ Format.asprintf "field %a is not part of record" Stage_common.PP.label k
|
||||||
|
| Some tv -> O.assert_type_value_eq (tv, get_type_annotation e)
|
||||||
|
in
|
||||||
|
bind_iter_list aux updates
|
||||||
|
| _ -> failwith "Update an expression which is not a record"
|
||||||
|
in
|
||||||
|
return (E_record_update (record, updates)) wrapped
|
||||||
(* Data-structure *)
|
(* Data-structure *)
|
||||||
| E_list lst ->
|
| E_list lst ->
|
||||||
let%bind lst' = bind_map_list (type_expression' e) lst in
|
let%bind lst' = bind_map_list (type_expression' e) lst in
|
||||||
@ -876,6 +896,14 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
|
|||||||
| E_record_accessor (r, Label s) ->
|
| E_record_accessor (r, Label s) ->
|
||||||
let%bind r' = untype_expression r in
|
let%bind r' = untype_expression r in
|
||||||
return (e_accessor r' [Access_record s])
|
return (e_accessor r' [Access_record s])
|
||||||
|
| E_record_update (r, updates) ->
|
||||||
|
let%bind r' = untype_expression r in
|
||||||
|
let aux (Label l,e) =
|
||||||
|
let%bind e = untype_expression e in
|
||||||
|
ok (l, e)
|
||||||
|
in
|
||||||
|
let%bind updates = bind_map_list aux updates in
|
||||||
|
return (e_update r' updates)
|
||||||
| E_map m ->
|
| E_map m ->
|
||||||
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
|
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
|
||||||
return (e_map m')
|
return (e_map m')
|
||||||
|
@ -217,7 +217,7 @@ let record_access_to_lr : type_value -> type_value AST.label_map -> string -> (t
|
|||||||
let%bind (_ , lst) =
|
let%bind (_ , lst) =
|
||||||
let aux = fun (ty , acc) cur ->
|
let aux = fun (ty , acc) cur ->
|
||||||
let%bind (a , b) =
|
let%bind (a , b) =
|
||||||
trace_strong (corner_case ~loc:__LOC__ "recard access pair") @@
|
trace_strong (corner_case ~loc:__LOC__ "record access pair") @@
|
||||||
Mini_c.get_t_pair ty in
|
Mini_c.get_t_pair ty in
|
||||||
match cur with
|
match cur with
|
||||||
| `Left -> ok (a , acc @ [(a , `Left)])
|
| `Left -> ok (a , acc @ [(a , `Left)])
|
||||||
@ -365,6 +365,23 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
|
|||||||
let%bind record' = transpile_annotated_expression record in
|
let%bind record' = transpile_annotated_expression record in
|
||||||
let expr = List.fold_left aux record' path in
|
let expr = List.fold_left aux record' path in
|
||||||
ok expr
|
ok expr
|
||||||
|
| E_record_update (record, updates) ->
|
||||||
|
let%bind ty' = transpile_type (get_type_annotation record) in
|
||||||
|
let%bind ty_lmap =
|
||||||
|
trace_strong (corner_case ~loc:__LOC__ "not a record") @@
|
||||||
|
get_t_record (get_type_annotation record) in
|
||||||
|
let%bind ty'_lmap = AST.bind_map_lmap transpile_type ty_lmap in
|
||||||
|
let aux (Label l, expr) =
|
||||||
|
let%bind path =
|
||||||
|
trace_strong (corner_case ~loc:__LOC__ "record access") @@
|
||||||
|
record_access_to_lr ty' ty'_lmap l in
|
||||||
|
let path' = List.map snd path in
|
||||||
|
let%bind expr' = transpile_annotated_expression expr in
|
||||||
|
ok (path',expr')
|
||||||
|
in
|
||||||
|
let%bind updates = bind_map_list aux updates in
|
||||||
|
let%bind record = transpile_annotated_expression record in
|
||||||
|
return @@ E_update (record, updates)
|
||||||
| E_constant (name , lst) -> (
|
| E_constant (name , lst) -> (
|
||||||
let iterator_generator iterator_name =
|
let iterator_generator iterator_name =
|
||||||
let lambda_to_iterator_body (f : AST.annotated_expression) (l : AST.lambda) =
|
let lambda_to_iterator_body (f : AST.annotated_expression) (l : AST.lambda) =
|
||||||
|
@ -127,14 +127,18 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
|
|||||||
get_string v in
|
get_string v in
|
||||||
return (E_literal (Literal_key_hash n))
|
return (E_literal (Literal_key_hash n))
|
||||||
)
|
)
|
||||||
| TC_chain_id -> (
|
| TC_chain_id -> (
|
||||||
let%bind n =
|
let%bind n =
|
||||||
trace_strong (wrong_mini_c_value "chain_id" v) @@
|
trace_strong (wrong_mini_c_value "chain_id" v) @@
|
||||||
get_string v in
|
get_string v in
|
||||||
return (E_literal (Literal_chain_id n))
|
return (E_literal (Literal_chain_id n))
|
||||||
)
|
)
|
||||||
| TC_signature ->
|
| TC_signature -> (
|
||||||
fail @@ bad_untranspile "signature" v
|
let%bind n =
|
||||||
|
trace_strong (wrong_mini_c_value "signature" v) @@
|
||||||
|
get_string v in
|
||||||
|
return (E_literal (Literal_signature n))
|
||||||
|
)
|
||||||
)
|
)
|
||||||
| T_operator type_operator -> (
|
| T_operator type_operator -> (
|
||||||
match type_operator with
|
match type_operator with
|
||||||
|
@ -84,6 +84,15 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
|
|||||||
let%bind res = self init' exp in
|
let%bind res = self init' exp in
|
||||||
ok res
|
ok res
|
||||||
)
|
)
|
||||||
|
| E_update (r, updates) -> (
|
||||||
|
let%bind res = self init' r in
|
||||||
|
let aux prev (_,e) =
|
||||||
|
let%bind res = self prev e in
|
||||||
|
ok res
|
||||||
|
in
|
||||||
|
let%bind res = bind_fold_list aux res updates in
|
||||||
|
ok res
|
||||||
|
)
|
||||||
|
|
||||||
type mapper = expression -> expression result
|
type mapper = expression -> expression result
|
||||||
|
|
||||||
@ -149,3 +158,8 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
|
|||||||
let%bind exp' = self exp in
|
let%bind exp' = self exp in
|
||||||
return @@ E_assignment (s, lrl, exp')
|
return @@ E_assignment (s, lrl, exp')
|
||||||
)
|
)
|
||||||
|
| E_update (r, updates) -> (
|
||||||
|
let%bind r = self r in
|
||||||
|
let%bind updates = bind_map_list (fun (p,e) -> let%bind e = self e in ok(p,e)) updates in
|
||||||
|
return @@ E_update(r,updates)
|
||||||
|
)
|
||||||
|
@ -66,6 +66,8 @@ let rec is_pure : expression -> bool = fun e ->
|
|||||||
|
|
||||||
| E_constant (c, args)
|
| E_constant (c, args)
|
||||||
-> is_pure_constant c && List.for_all is_pure args
|
-> is_pure_constant c && List.for_all is_pure args
|
||||||
|
| E_update (e, updates)
|
||||||
|
-> is_pure e && List.for_all (fun (_,e) -> is_pure e) updates
|
||||||
|
|
||||||
(* I'm not sure about these. Maybe can be tested better? *)
|
(* I'm not sure about these. Maybe can be tested better? *)
|
||||||
| E_application _
|
| E_application _
|
||||||
@ -109,6 +111,8 @@ let rec is_assigned : ignore_lambdas:bool -> expression_variable -> expression -
|
|||||||
match e.content with
|
match e.content with
|
||||||
| E_assignment (x, _, e) ->
|
| E_assignment (x, _, e) ->
|
||||||
it x || self e
|
it x || self e
|
||||||
|
| E_update (r, updates) ->
|
||||||
|
List.fold_left (fun prev (_,e) -> prev || self e) (self r) updates
|
||||||
| E_closure { binder; body } ->
|
| E_closure { binder; body } ->
|
||||||
if ignore_lambdas
|
if ignore_lambdas
|
||||||
then false
|
then false
|
||||||
|
@ -94,6 +94,10 @@ let rec replace : expression -> var_name -> var_name -> expression =
|
|||||||
let v = replace_var v in
|
let v = replace_var v in
|
||||||
let e = replace e in
|
let e = replace e in
|
||||||
return @@ E_assignment (v, path, e)
|
return @@ E_assignment (v, path, e)
|
||||||
|
| E_update (r, updates) ->
|
||||||
|
let r = replace r in
|
||||||
|
let updates = List.map (fun (p,e)-> (p, replace e)) updates in
|
||||||
|
return @@ E_update (r,updates)
|
||||||
| E_while (cond, body) ->
|
| E_while (cond, body) ->
|
||||||
let cond = replace cond in
|
let cond = replace cond in
|
||||||
let body = replace body in
|
let body = replace body in
|
||||||
@ -205,6 +209,11 @@ let rec subst_expression : body:expression -> x:var_name -> expr:expression -> e
|
|||||||
if Var.equal s x then raise Bad_argument ;
|
if Var.equal s x then raise Bad_argument ;
|
||||||
return @@ E_assignment (s, lrl, exp')
|
return @@ E_assignment (s, lrl, exp')
|
||||||
)
|
)
|
||||||
|
| E_update (r, updates) -> (
|
||||||
|
let r' = self r in
|
||||||
|
let updates' = List.map (fun (p,e) -> (p, self e)) updates in
|
||||||
|
return @@ E_update(r',updates')
|
||||||
|
)
|
||||||
|
|
||||||
let%expect_test _ =
|
let%expect_test _ =
|
||||||
let dummy_type = T_base Base_unit in
|
let dummy_type = T_base Base_unit in
|
||||||
|
@ -402,6 +402,34 @@ and translate_expression (expr:expression) (env:environment) : michelson result
|
|||||||
i_push_unit ;
|
i_push_unit ;
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
|
| E_update (record, updates) -> (
|
||||||
|
let%bind record' = translate_expression record env in
|
||||||
|
let insts = [
|
||||||
|
i_comment "r_update: start, move the record on top # env";
|
||||||
|
record';] in
|
||||||
|
let aux (init :t list) (update,expr) =
|
||||||
|
let record_var = Var.fresh () in
|
||||||
|
let env' = Environment.add (record_var, record.type_value) env in
|
||||||
|
let%bind expr' = translate_expression expr env' in
|
||||||
|
let modify_code =
|
||||||
|
let aux acc step = match step with
|
||||||
|
| `Left -> seq [dip i_unpair ; acc ; i_pair]
|
||||||
|
| `Right -> seq [dip i_unpiar ; acc ; i_piar]
|
||||||
|
in
|
||||||
|
let init = dip i_drop in
|
||||||
|
List.fold_right' aux init update
|
||||||
|
in
|
||||||
|
ok @@ init @ [
|
||||||
|
expr';
|
||||||
|
i_comment "r_updates : compute rhs # rhs:env";
|
||||||
|
modify_code;
|
||||||
|
i_comment "r_update: modify code # record+rhs : env";
|
||||||
|
]
|
||||||
|
in
|
||||||
|
let%bind insts = bind_fold_list aux insts updates in
|
||||||
|
return @@ seq insts
|
||||||
|
|
||||||
|
)
|
||||||
| E_while (expr , block) -> (
|
| E_while (expr , block) -> (
|
||||||
let%bind expr' = translate_expression expr env in
|
let%bind expr' = translate_expression expr env in
|
||||||
let%bind block' = translate_expression block env in
|
let%bind block' = translate_expression block env in
|
||||||
|
@ -40,6 +40,8 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result =
|
|||||||
ok @@ D_string (Signature.Public_key_hash.to_b58check n)
|
ok @@ D_string (Signature.Public_key_hash.to_b58check n)
|
||||||
| (Key_t _ ), n ->
|
| (Key_t _ ), n ->
|
||||||
ok @@ D_string (Signature.Public_key.to_b58check n)
|
ok @@ D_string (Signature.Public_key.to_b58check n)
|
||||||
|
| (Signature_t _ ), n ->
|
||||||
|
ok @@ D_string (Signature.to_b58check n)
|
||||||
| (Timestamp_t _), n ->
|
| (Timestamp_t _), n ->
|
||||||
let n =
|
let n =
|
||||||
Z.to_int @@
|
Z.to_int @@
|
||||||
|
@ -26,6 +26,7 @@ let rec expression ppf (e:expression) = match e.expression with
|
|||||||
| E_tuple lst -> fprintf ppf "(%a)" (tuple_sep_d expression) lst
|
| E_tuple lst -> fprintf ppf "(%a)" (tuple_sep_d expression) lst
|
||||||
| E_accessor (ae, p) -> fprintf ppf "%a.%a" expression ae access_path p
|
| E_accessor (ae, p) -> fprintf ppf "%a.%a" expression ae access_path p
|
||||||
| E_record m -> fprintf ppf "{%a}" (lrecord_sep expression (const " , ")) m
|
| E_record m -> fprintf ppf "{%a}" (lrecord_sep expression (const " , ")) m
|
||||||
|
| E_update {record; updates} -> fprintf ppf "%a with {%a}" expression record (tuple_sep_d (fun ppf (a,b) -> fprintf ppf "%a = %a" label a expression b)) updates
|
||||||
| E_map m -> fprintf ppf "[%a]" (list_sep_d assoc_expression) m
|
| E_map m -> fprintf ppf "[%a]" (list_sep_d assoc_expression) m
|
||||||
| E_big_map m -> fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m
|
| E_big_map m -> fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m
|
||||||
| E_list lst -> fprintf ppf "[%a]" (list_sep_d expression) lst
|
| E_list lst -> fprintf ppf "[%a]" (list_sep_d expression) lst
|
||||||
|
@ -172,6 +172,9 @@ let e_ez_record ?loc (lst : (string * expr) list) : expression =
|
|||||||
let e_record ?loc map =
|
let e_record ?loc map =
|
||||||
let lst = Map.String.to_kv_list map in
|
let lst = Map.String.to_kv_list map in
|
||||||
e_ez_record ?loc lst
|
e_ez_record ?loc lst
|
||||||
|
let e_update ?loc record updates =
|
||||||
|
let updates = List.map (fun (x,y) -> (Label x, y)) updates in
|
||||||
|
location_wrap ?loc @@ E_update {record; updates}
|
||||||
|
|
||||||
let get_e_accessor = fun t ->
|
let get_e_accessor = fun t ->
|
||||||
match t with
|
match t with
|
||||||
|
@ -108,6 +108,7 @@ val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expre
|
|||||||
|
|
||||||
val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
|
val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
|
||||||
val e_record : ?loc:Location.t -> expr Map.String.t -> expression
|
val e_record : ?loc:Location.t -> expr Map.String.t -> expression
|
||||||
|
val e_update : ?loc:Location.t -> expression -> (string * expression) list -> expression
|
||||||
|
|
||||||
val e_ez_record : ?loc:Location.t -> ( string * expr ) list -> expression
|
val e_ez_record : ?loc:Location.t -> ( string * expr ) list -> expression
|
||||||
(*
|
(*
|
||||||
|
@ -99,7 +99,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
|
|||||||
PP.expression a
|
PP.expression a
|
||||||
PP.expression b
|
PP.expression b
|
||||||
in
|
in
|
||||||
fail @@ (fun () -> error (thunk "comparing constant with other stuff") error_content ())
|
fail @@ (fun () -> error (thunk "comparing constant with other expression") error_content ())
|
||||||
|
|
||||||
| E_constructor (ca, a), E_constructor (cb, b) when ca = cb -> (
|
| E_constructor (ca, a), E_constructor (cb, b) when ca = cb -> (
|
||||||
let%bind _eq = assert_value_eq (a, b) in
|
let%bind _eq = assert_value_eq (a, b) in
|
||||||
@ -108,7 +108,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
|
|||||||
| E_constructor _, E_constructor _ ->
|
| E_constructor _, E_constructor _ ->
|
||||||
simple_fail "different constructors"
|
simple_fail "different constructors"
|
||||||
| E_constructor _, _ ->
|
| E_constructor _, _ ->
|
||||||
simple_fail "comparing constructor with other stuff"
|
simple_fail "comparing constructor with other expression"
|
||||||
|
|
||||||
| E_tuple lsta, E_tuple lstb -> (
|
| E_tuple lsta, E_tuple lstb -> (
|
||||||
let%bind lst =
|
let%bind lst =
|
||||||
@ -118,7 +118,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
|
|||||||
ok ()
|
ok ()
|
||||||
)
|
)
|
||||||
| E_tuple _, _ ->
|
| E_tuple _, _ ->
|
||||||
simple_fail "comparing tuple with other stuff"
|
simple_fail "comparing tuple with other expression"
|
||||||
|
|
||||||
| E_record sma, E_record smb -> (
|
| E_record sma, E_record smb -> (
|
||||||
let aux _ a b =
|
let aux _ a b =
|
||||||
@ -130,7 +130,20 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
|
|||||||
ok ()
|
ok ()
|
||||||
)
|
)
|
||||||
| E_record _, _ ->
|
| E_record _, _ ->
|
||||||
simple_fail "comparing record with other stuff"
|
simple_fail "comparing record with other expression"
|
||||||
|
|
||||||
|
| E_update ura, E_update urb ->
|
||||||
|
let%bind lst =
|
||||||
|
generic_try (simple_error "updates with different number of fields")
|
||||||
|
(fun () -> List.combine ura.updates urb.updates) in
|
||||||
|
let aux ((Label a,expra),(Label b, exprb))=
|
||||||
|
assert (String.equal a b);
|
||||||
|
assert_value_eq (expra,exprb)
|
||||||
|
in
|
||||||
|
let%bind _all = bind_list @@ List.map aux lst in
|
||||||
|
ok ()
|
||||||
|
| E_update _, _ ->
|
||||||
|
simple_fail "comparing record update with other expression"
|
||||||
|
|
||||||
| (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
|
| (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
|
||||||
let%bind lst = generic_try (simple_error "maps of different lengths")
|
let%bind lst = generic_try (simple_error "maps of different lengths")
|
||||||
@ -146,7 +159,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
|
|||||||
ok ()
|
ok ()
|
||||||
)
|
)
|
||||||
| (E_map _ | E_big_map _), _ ->
|
| (E_map _ | E_big_map _), _ ->
|
||||||
simple_fail "comparing map with other stuff"
|
simple_fail "comparing map with other expression"
|
||||||
|
|
||||||
| E_list lsta, E_list lstb -> (
|
| E_list lsta, E_list lstb -> (
|
||||||
let%bind lst =
|
let%bind lst =
|
||||||
@ -156,7 +169,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
|
|||||||
ok ()
|
ok ()
|
||||||
)
|
)
|
||||||
| E_list _, _ ->
|
| E_list _, _ ->
|
||||||
simple_fail "comparing list with other stuff"
|
simple_fail "comparing list with other expression"
|
||||||
|
|
||||||
| E_set lsta, E_set lstb -> (
|
| E_set lsta, E_set lstb -> (
|
||||||
let lsta' = List.sort (compare) lsta in
|
let lsta' = List.sort (compare) lsta in
|
||||||
@ -168,7 +181,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
|
|||||||
ok ()
|
ok ()
|
||||||
)
|
)
|
||||||
| E_set _, _ ->
|
| E_set _, _ ->
|
||||||
simple_fail "comparing set with other stuff"
|
simple_fail "comparing set with other expression"
|
||||||
|
|
||||||
| (E_ascription (a , _) , _b') -> assert_value_eq (a , b)
|
| (E_ascription (a , _) , _b') -> assert_value_eq (a , b)
|
||||||
| (_a' , E_ascription (b , _)) -> assert_value_eq (a , b)
|
| (_a' , E_ascription (b , _)) -> assert_value_eq (a , b)
|
||||||
|
@ -43,6 +43,7 @@ and expression' =
|
|||||||
| E_record of expr label_map
|
| E_record of expr label_map
|
||||||
(* TODO: Change it to (expr * access) *)
|
(* TODO: Change it to (expr * access) *)
|
||||||
| E_accessor of (expr * access_path)
|
| E_accessor of (expr * access_path)
|
||||||
|
| E_update of update
|
||||||
(* Data Structures *)
|
(* Data Structures *)
|
||||||
| E_map of (expr * expr) list
|
| E_map of (expr * expr) list
|
||||||
| E_big_map of (expr * expr) list
|
| E_big_map of (expr * expr) list
|
||||||
@ -63,6 +64,6 @@ and expression = {
|
|||||||
expression : expression' ;
|
expression : expression' ;
|
||||||
location : Location.t ;
|
location : Location.t ;
|
||||||
}
|
}
|
||||||
|
and update = {record: expr; updates: (label*expr)list}
|
||||||
|
|
||||||
and matching_expr = (expr,unit) matching
|
and matching_expr = (expr,unit) matching
|
||||||
|
@ -34,6 +34,7 @@ and expression ppf (e:expression) : unit =
|
|||||||
| E_lambda l -> fprintf ppf "%a" lambda l
|
| E_lambda l -> fprintf ppf "%a" lambda l
|
||||||
| E_tuple_accessor (ae, i) -> fprintf ppf "%a.%d" annotated_expression ae i
|
| E_tuple_accessor (ae, i) -> fprintf ppf "%a.%d" annotated_expression ae i
|
||||||
| E_record_accessor (ae, l) -> fprintf ppf "%a.%a" annotated_expression ae label l
|
| E_record_accessor (ae, l) -> fprintf ppf "%a.%a" annotated_expression ae label l
|
||||||
|
| E_record_update (ae, ups) -> fprintf ppf "%a with record[%a]" annotated_expression ae (lmap_sep annotated_expression (const " , ")) (LMap.of_list ups)
|
||||||
| E_tuple lst -> fprintf ppf "tuple[@; @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) lst
|
| E_tuple lst -> fprintf ppf "tuple[@; @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) lst
|
||||||
| E_record m -> fprintf ppf "record[%a]" (lmap_sep annotated_expression (const " , ")) m
|
| E_record m -> fprintf ppf "record[%a]" (lmap_sep annotated_expression (const " , ")) m
|
||||||
| E_map m -> fprintf ppf "map[@; @[<v>%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m
|
| E_map m -> fprintf ppf "map[@; @[<v>%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m
|
||||||
|
@ -178,6 +178,7 @@ module Free_variables = struct
|
|||||||
| E_constructor (_ , a) -> self a
|
| E_constructor (_ , a) -> self a
|
||||||
| E_record m -> unions @@ List.map self @@ LMap.to_list m
|
| E_record m -> unions @@ List.map self @@ LMap.to_list m
|
||||||
| E_record_accessor (a, _) -> self a
|
| E_record_accessor (a, _) -> self a
|
||||||
|
| E_record_update (r,ups) -> union (self r) @@ unions @@ List.map (fun (_,e) -> self e) ups
|
||||||
| E_tuple_accessor (a, _) -> self a
|
| E_tuple_accessor (a, _) -> self a
|
||||||
| E_list lst -> unions @@ List.map self lst
|
| E_list lst -> unions @@ List.map self lst
|
||||||
| E_set lst -> unions @@ List.map self lst
|
| E_set lst -> unions @@ List.map self lst
|
||||||
@ -508,6 +509,7 @@ let rec assert_value_eq (a, b: (value*value)) : unit result =
|
|||||||
fail @@ different_values_because_different_types "set vs. non-set" a b
|
fail @@ different_values_because_different_types "set vs. non-set" a b
|
||||||
| (E_literal _, _) | (E_variable _, _) | (E_application _, _)
|
| (E_literal _, _) | (E_variable _, _) | (E_application _, _)
|
||||||
| (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _)
|
| (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _)
|
||||||
|
| (E_record_update _,_)
|
||||||
| (E_record_accessor _, _)
|
| (E_record_accessor _, _)
|
||||||
| (E_look_up _, _) | (E_matching _, _)
|
| (E_look_up _, _) | (E_matching _, _)
|
||||||
| (E_assign _ , _)
|
| (E_assign _ , _)
|
||||||
|
@ -72,6 +72,14 @@ module Captured_variables = struct
|
|||||||
let%bind lst' = bind_map_list self @@ LMap.to_list m in
|
let%bind lst' = bind_map_list self @@ LMap.to_list m in
|
||||||
ok @@ unions lst'
|
ok @@ unions lst'
|
||||||
| E_record_accessor (a, _) -> self a
|
| E_record_accessor (a, _) -> self a
|
||||||
|
| E_record_update (r,ups) ->
|
||||||
|
let%bind r = self r in
|
||||||
|
let aux (_, e) =
|
||||||
|
let%bind e = self e in
|
||||||
|
ok e
|
||||||
|
in
|
||||||
|
let%bind lst = bind_map_list aux ups in
|
||||||
|
ok @@ union r @@ unions lst
|
||||||
| E_tuple_accessor (a, _) -> self a
|
| E_tuple_accessor (a, _) -> self a
|
||||||
| E_list lst ->
|
| E_list lst ->
|
||||||
let%bind lst' = bind_map_list self lst in
|
let%bind lst' = bind_map_list self lst in
|
||||||
|
@ -82,6 +82,7 @@ and 'a expression' =
|
|||||||
(* Record *)
|
(* Record *)
|
||||||
| E_record of ('a) label_map
|
| E_record of ('a) label_map
|
||||||
| E_record_accessor of (('a) * label)
|
| E_record_accessor of (('a) * label)
|
||||||
|
| E_record_update of ('a * (label* 'a) list)
|
||||||
(* Data Structures *)
|
(* Data Structures *)
|
||||||
| E_map of (('a) * ('a)) list
|
| E_map of (('a) * ('a)) list
|
||||||
| E_big_map of (('a) * ('a)) list
|
| E_big_map of (('a) * ('a)) list
|
||||||
|
@ -162,7 +162,7 @@ and type_constant ppf (tc:type_constant) : unit =
|
|||||||
| TC_address -> "address"
|
| TC_address -> "address"
|
||||||
| TC_key -> "key"
|
| TC_key -> "key"
|
||||||
| TC_key_hash -> "key_hash"
|
| TC_key_hash -> "key_hash"
|
||||||
| TC_signature -> "signatuer"
|
| TC_signature -> "signature"
|
||||||
| TC_timestamp -> "timestamp"
|
| TC_timestamp -> "timestamp"
|
||||||
| TC_chain_id -> "chain_id"
|
| TC_chain_id -> "chain_id"
|
||||||
in
|
in
|
||||||
|
@ -99,6 +99,8 @@ and expression' ppf (e:expression') = match e with
|
|||||||
fprintf ppf "fold %a on %a with %a do ( %a )" expression collection expression initial Stage_common.PP.name name expression body
|
fprintf ppf "fold %a on %a with %a do ( %a )" expression collection expression initial Stage_common.PP.name name expression body
|
||||||
| E_assignment (r , path , e) ->
|
| E_assignment (r , path , e) ->
|
||||||
fprintf ppf "%a.%a := %a" Stage_common.PP.name r (list_sep lr (const ".")) path expression e
|
fprintf ppf "%a.%a := %a" Stage_common.PP.name r (list_sep lr (const ".")) path expression e
|
||||||
|
| E_update (r, updates) ->
|
||||||
|
fprintf ppf "%a with {%a}" expression r (list_sep_d (fun ppf (path, e) -> fprintf ppf "%a = %a" (list_sep lr (const ".")) path expression e)) updates
|
||||||
| E_while (e , b) ->
|
| E_while (e , b) ->
|
||||||
fprintf ppf "while (%a) %a" expression e expression b
|
fprintf ppf "while (%a) %a" expression e expression b
|
||||||
|
|
||||||
|
@ -81,6 +81,7 @@ module Free_variables = struct
|
|||||||
| E_sequence (x, y) -> union (self x) (self y)
|
| E_sequence (x, y) -> union (self x) (self y)
|
||||||
(* NB different from ast_typed... *)
|
(* NB different from ast_typed... *)
|
||||||
| E_assignment (v, _, e) -> unions [ var_name b v ; self e ]
|
| E_assignment (v, _, e) -> unions [ var_name b v ; self e ]
|
||||||
|
| E_update (e, updates) -> union (self e) (unions @@ List.map (fun (_,e) -> self e) updates)
|
||||||
| E_while (cond , body) -> union (self cond) (self body)
|
| E_while (cond , body) -> union (self cond) (self body)
|
||||||
|
|
||||||
and var_name : bindings -> var_name -> bindings = fun b n ->
|
and var_name : bindings -> var_name -> bindings = fun b n ->
|
||||||
|
@ -71,6 +71,7 @@ and expression' =
|
|||||||
| E_let_in of ((var_name * type_value) * expression * expression)
|
| E_let_in of ((var_name * type_value) * expression * expression)
|
||||||
| E_sequence of (expression * expression)
|
| E_sequence of (expression * expression)
|
||||||
| E_assignment of (expression_variable * [`Left | `Right] list * expression)
|
| E_assignment of (expression_variable * [`Left | `Right] list * expression)
|
||||||
|
| E_update of (expression * ([`Left | `Right] list * expression) list)
|
||||||
| E_while of (expression * expression)
|
| E_while of (expression * expression)
|
||||||
|
|
||||||
and expression = {
|
and expression = {
|
||||||
|
@ -175,6 +175,10 @@ module Substitution = struct
|
|||||||
let%bind val_ = s_annotated_expression ~v ~expr val_ in
|
let%bind val_ = s_annotated_expression ~v ~expr val_ in
|
||||||
let%bind l = s_label ~v ~expr l in
|
let%bind l = s_label ~v ~expr l in
|
||||||
ok @@ T.E_record_accessor (val_, l)
|
ok @@ T.E_record_accessor (val_, l)
|
||||||
|
| T.E_record_update (r, ups) ->
|
||||||
|
let%bind r = s_annotated_expression ~v ~expr r in
|
||||||
|
let%bind ups = bind_map_list (fun (l,e) -> let%bind e = s_annotated_expression ~v ~expr e in ok (l,e)) ups in
|
||||||
|
ok @@ T.E_record_update (r,ups)
|
||||||
| T.E_map val_val_list ->
|
| T.E_map val_val_list ->
|
||||||
let%bind val_val_list = bind_map_list (fun (val1 , val2) ->
|
let%bind val_val_list = bind_map_list (fun (val1 , val2) ->
|
||||||
let%bind val1 = s_annotated_expression ~v ~expr val1 in
|
let%bind val1 = s_annotated_expression ~v ~expr val1 in
|
||||||
|
@ -38,7 +38,8 @@ function modify (const r : foobar) : foobar is
|
|||||||
|
|
||||||
function modify_abc (const r : abc) : abc is
|
function modify_abc (const r : abc) : abc is
|
||||||
block {
|
block {
|
||||||
r.b := 2048 ;
|
const c : int = 42;
|
||||||
|
r := r with record b = 2048; c = c; end;
|
||||||
} with r
|
} with r
|
||||||
|
|
||||||
type big_record is record
|
type big_record is record
|
||||||
@ -56,3 +57,12 @@ const br : big_record = record
|
|||||||
d = 23 ;
|
d = 23 ;
|
||||||
e = 23 ;
|
e = 23 ;
|
||||||
end
|
end
|
||||||
|
|
||||||
|
type double_record is record
|
||||||
|
inner : abc;
|
||||||
|
end
|
||||||
|
|
||||||
|
function modify_inner (const r : double_record) : double_record is
|
||||||
|
block {
|
||||||
|
r := r with record inner = r.inner with record b = 2048; end; end;
|
||||||
|
} with r
|
||||||
|
@ -28,7 +28,7 @@ let projection (r : foobar) : int = r.foo + r.bar
|
|||||||
|
|
||||||
let modify (r : foobar) : foobar = {foo = 256; bar = r.bar}
|
let modify (r : foobar) : foobar = {foo = 256; bar = r.bar}
|
||||||
|
|
||||||
let modify_abc (r : abc) : abc = {a = r.a; b = 2048; c = r.c}
|
let modify_abc (r : abc) : abc = let c = 42 in {r with b = 2048; c = c}
|
||||||
|
|
||||||
type big_record = {
|
type big_record = {
|
||||||
a : int ;
|
a : int ;
|
||||||
@ -45,3 +45,9 @@ let br : big_record = {
|
|||||||
d = 23 ;
|
d = 23 ;
|
||||||
e = 23 ;
|
e = 23 ;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
type double_record = {
|
||||||
|
inner : abc;
|
||||||
|
}
|
||||||
|
|
||||||
|
let modify_inner (r : double_record) : double_record = {r with inner = {r.inner with b = 2048 }}
|
||||||
|
53
src/test/contracts/record.religo
Normal file
53
src/test/contracts/record.religo
Normal file
@ -0,0 +1,53 @@
|
|||||||
|
type foobar = {
|
||||||
|
foo : int ,
|
||||||
|
bar : int ,
|
||||||
|
};
|
||||||
|
|
||||||
|
let fb : foobar = {
|
||||||
|
foo : 0 ,
|
||||||
|
bar : 0 ,
|
||||||
|
};
|
||||||
|
|
||||||
|
type abc = {
|
||||||
|
a : int ,
|
||||||
|
b : int ,
|
||||||
|
c : int
|
||||||
|
};
|
||||||
|
|
||||||
|
let abc : abc = {
|
||||||
|
a : 42 ,
|
||||||
|
b : 142 ,
|
||||||
|
c : 242
|
||||||
|
};
|
||||||
|
|
||||||
|
let a : int = abc.a;
|
||||||
|
let b : int = abc.b;
|
||||||
|
let c : int = abc.c;
|
||||||
|
|
||||||
|
let projection = (r : foobar) : int => r.foo + r.bar;
|
||||||
|
|
||||||
|
let modify = (r : foobar) : foobar => {foo : 256, bar : r.bar};
|
||||||
|
|
||||||
|
let modify_abc = (r : abc) : abc => {...r,b : 2048 , c:42};
|
||||||
|
|
||||||
|
type big_record = {
|
||||||
|
a : int ,
|
||||||
|
b : int ,
|
||||||
|
c : int ,
|
||||||
|
d : int ,
|
||||||
|
e : int ,
|
||||||
|
};
|
||||||
|
|
||||||
|
let br : big_record = {
|
||||||
|
a : 23 ,
|
||||||
|
b : 23 ,
|
||||||
|
c : 23 ,
|
||||||
|
d : 23 ,
|
||||||
|
e : 23 ,
|
||||||
|
};
|
||||||
|
|
||||||
|
type double_record = {
|
||||||
|
inner : abc,
|
||||||
|
};
|
||||||
|
|
||||||
|
let modify_inner = (r : double_record) : double_record => {...r,inner : {...r.inner, b : 2048 } };
|
@ -682,7 +682,7 @@ let record () : unit result =
|
|||||||
let make_expected = fun n -> ez_e_record [
|
let make_expected = fun n -> ez_e_record [
|
||||||
("a" , e_int n) ;
|
("a" , e_int n) ;
|
||||||
("b" , e_int 2048) ;
|
("b" , e_int 2048) ;
|
||||||
("c" , e_int n)
|
("c" , e_int 42)
|
||||||
] in
|
] in
|
||||||
expect_eq_n program "modify_abc" make_input make_expected
|
expect_eq_n program "modify_abc" make_input make_expected
|
||||||
in
|
in
|
||||||
@ -690,6 +690,107 @@ let record () : unit result =
|
|||||||
let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in
|
let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in
|
||||||
expect_eq_evaluate program "br" expected
|
expect_eq_evaluate program "br" expected
|
||||||
in
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = fun n -> ez_e_record [("inner", record_ez_int ["a";"b";"c"] n)] in
|
||||||
|
let make_expected = fun n -> ez_e_record [("inner", ez_e_record[
|
||||||
|
("a" , e_int n) ;
|
||||||
|
("b" , e_int 2048) ;
|
||||||
|
("c" , e_int n)
|
||||||
|
])] in
|
||||||
|
expect_eq_n program "modify_inner" make_input make_expected
|
||||||
|
in
|
||||||
|
ok ()
|
||||||
|
|
||||||
|
let record_mligo () : unit result =
|
||||||
|
let%bind program = mtype_file "./contracts/record.mligo" in
|
||||||
|
let%bind () =
|
||||||
|
let expected = record_ez_int ["foo" ; "bar"] 0 in
|
||||||
|
expect_eq_evaluate program "fb" expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let%bind () = expect_eq_evaluate program "a" (e_int 42) in
|
||||||
|
let%bind () = expect_eq_evaluate program "b" (e_int 142) in
|
||||||
|
let%bind () = expect_eq_evaluate program "c" (e_int 242) in
|
||||||
|
ok ()
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = record_ez_int ["foo" ; "bar"] in
|
||||||
|
let make_expected = fun n -> e_int (2 * n) in
|
||||||
|
expect_eq_n program "projection" make_input make_expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = record_ez_int ["foo" ; "bar"] in
|
||||||
|
let make_expected = fun n -> ez_e_record [("foo" , e_int 256) ; ("bar" , e_int n) ] in
|
||||||
|
expect_eq_n program "modify" make_input make_expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = record_ez_int ["a" ; "b" ; "c"] in
|
||||||
|
let make_expected = fun n -> ez_e_record [
|
||||||
|
("a" , e_int n) ;
|
||||||
|
("b" , e_int 2048) ;
|
||||||
|
("c" , e_int 42)
|
||||||
|
] in
|
||||||
|
expect_eq_n program "modify_abc" make_input make_expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in
|
||||||
|
expect_eq_evaluate program "br" expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = fun n -> ez_e_record [("inner", record_ez_int ["a";"b";"c"] n)] in
|
||||||
|
let make_expected = fun n -> ez_e_record [("inner", ez_e_record[
|
||||||
|
("a" , e_int n) ;
|
||||||
|
("b" , e_int 2048) ;
|
||||||
|
("c" , e_int n)
|
||||||
|
])] in
|
||||||
|
expect_eq_n program "modify_inner" make_input make_expected
|
||||||
|
in
|
||||||
|
ok ()
|
||||||
|
|
||||||
|
let record_religo () : unit result =
|
||||||
|
let%bind program = retype_file "./contracts/record.religo" in
|
||||||
|
let%bind () =
|
||||||
|
let expected = record_ez_int ["foo" ; "bar"] 0 in
|
||||||
|
expect_eq_evaluate program "fb" expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let%bind () = expect_eq_evaluate program "a" (e_int 42) in
|
||||||
|
let%bind () = expect_eq_evaluate program "b" (e_int 142) in
|
||||||
|
let%bind () = expect_eq_evaluate program "c" (e_int 242) in
|
||||||
|
ok ()
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = record_ez_int ["foo" ; "bar"] in
|
||||||
|
let make_expected = fun n -> e_int (2 * n) in
|
||||||
|
expect_eq_n program "projection" make_input make_expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = record_ez_int ["foo" ; "bar"] in
|
||||||
|
let make_expected = fun n -> ez_e_record [("foo" , e_int 256) ; ("bar" , e_int n) ] in
|
||||||
|
expect_eq_n program "modify" make_input make_expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = record_ez_int ["a" ; "b" ; "c"] in
|
||||||
|
let make_expected = fun n -> ez_e_record [
|
||||||
|
("a" , e_int n) ;
|
||||||
|
("b" , e_int 2048) ;
|
||||||
|
("c" , e_int 42)
|
||||||
|
] in
|
||||||
|
expect_eq_n program "modify_abc" make_input make_expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in
|
||||||
|
expect_eq_evaluate program "br" expected
|
||||||
|
in
|
||||||
|
let%bind () =
|
||||||
|
let make_input = fun n -> ez_e_record [("inner", record_ez_int ["a";"b";"c"] n)] in
|
||||||
|
let make_expected = fun n -> ez_e_record [("inner", ez_e_record[
|
||||||
|
("a" , e_int n) ;
|
||||||
|
("b" , e_int 2048) ;
|
||||||
|
("c" , e_int n)
|
||||||
|
])] in
|
||||||
|
expect_eq_n program "modify_inner" make_input make_expected
|
||||||
|
in
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
let tuple () : unit result =
|
let tuple () : unit result =
|
||||||
@ -1912,6 +2013,8 @@ let main = test_suite "Integration (End to End)" [
|
|||||||
test "tuple (mligo)" tuple_mligo ;
|
test "tuple (mligo)" tuple_mligo ;
|
||||||
test "tuple (religo)" tuple_religo ;
|
test "tuple (religo)" tuple_religo ;
|
||||||
test "record" record ;
|
test "record" record ;
|
||||||
|
test "record (mligo)" record_mligo ;
|
||||||
|
test "record (religo)" record_religo ;
|
||||||
test "condition simple" condition_simple ;
|
test "condition simple" condition_simple ;
|
||||||
test "condition (ligo)" condition ;
|
test "condition (ligo)" condition ;
|
||||||
test "condition (mligo)" condition_mligo ;
|
test "condition (mligo)" condition_mligo ;
|
||||||
|
1
vendors/UnionFind/.gitignore
vendored
Normal file
1
vendors/UnionFind/.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
|||||||
|
*.install
|
5
vendors/UnionFind/dune
vendored
5
vendors/UnionFind/dune
vendored
@ -4,8 +4,3 @@
|
|||||||
(wrapped false)
|
(wrapped false)
|
||||||
(modules Partition0 Partition1 Partition2 Partition3 Partition UnionFind)
|
(modules Partition0 Partition1 Partition2 Partition3 Partition UnionFind)
|
||||||
(modules_without_implementation Partition))
|
(modules_without_implementation Partition))
|
||||||
|
|
||||||
(test
|
|
||||||
(modules PartitionMain)
|
|
||||||
(libraries UnionFind)
|
|
||||||
(name PartitionMain))
|
|
||||||
|
Loading…
Reference in New Issue
Block a user