balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'dev' of gitlab.com:ligolang/ligo into rinderknecht-dev

Browse Source
This commit is contained in:
Christian Rinderknecht 2020-01-07 12:54:05 +01:00
commit de0657e8f2
23 changed files with 494 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

287
gitlab-pages/docs/language-basics/maps-records.md
View File

@ -14,17 +14,20 @@ Here's how a custom map type is defined:
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
type ledger is map(address, tez);
type move is (int * int);
type moveset is map(address, move);
```
<!--CameLIGO-->
```cameligo
type ledger = (address, tez) map
type move = int * int
type moveset = (address, move) map
```
<!--ReasonLIGO-->
```reasonligo
type ledger = map(address, tez);
type move = (int, int);
type moveset = map(address, move);
```
<!--END_DOCUSAURUS_CODE_TABS-->
@ -35,9 +38,9 @@ And here's how a map value is populated:
<!--Pascaligo-->
```pascaligo
const ledger: ledger = map
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> 1000mutez;
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) -> 2000mutez;
const moves: moveset = map
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> (1, 2);
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) -> (0, 3);
end
```
> Notice the `->` between the key and its value and `;` to separate individual map entries.
@ -47,9 +50,9 @@ end
<!--CameLIGO-->
```cameligo
let ledger: ledger = Map.literal
[ (("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address), 1000mutez) ;
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), 2000mutez) ;
let moves: moveset = Map.literal
[ (("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address), (1, 2)) ;
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), (0, 3)) ;
]
```
> Map.literal constructs the map from a list of key-value pair tuples, `(<key>, <value>)`.
@ -60,10 +63,10 @@ let ledger: ledger = Map.literal
<!--ReasonLIGO-->
```reasonligo
let ledger: ledger =
let moves: moveset =
Map.literal([
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, 1000mutez),
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, 2000mutez),
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, (1, 2)),
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, (0, 3)),
]);
```
> Map.literal constructs the map from a list of key-value pair tuples, `(<key>, <value>)`.
@ -74,25 +77,25 @@ let ledger: ledger =
### Accessing map values by key
If we want to access a balance from our ledger above, we can use the `[]` operator/accessor to read the associated `tez` value. However, the value we'll get will be wrapped as an optional; in our case `option(tez)`. Here's an example:
If we want to access a move from our moveset above, we can use the `[]` operator/accessor to read the associated `move` value. However, the value we'll get will be wrapped as an optional; in our case `option(move)`. Here's an example:
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
const balance: option(tez) = ledger[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)];
const balance: option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)];
```
<!--CameLIGO-->
```cameligo
let balance: tez option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) ledger
let balance: move option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
```
<!--ReasonLIGO-->
```reasonligo
let balance: option(tez) =
Map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, ledger);
let balance: option(move) =
Map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves);
```
<!--END_DOCUSAURUS_CODE_TABS-->
@ -103,24 +106,61 @@ Accessing a value in a map yields an option, however you can also get the value
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
const balance: tez = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), ledger);
const balance: move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves);
```
<!--CameLIGO-->
```cameligo
let balance: tez = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) ledger
let balance: move = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
```
<!--ReasonLIGO-->
```reasonligo
let balance: tez =
Map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, ledger);
let balance: move =
Map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves);
```
<!--END_DOCUSAURUS_CODE_TABS-->
### Updating the contents of a map
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
The values of a PascaLIGO map can be updated using the ordinary assignment syntax:
```pascaligo
function set_ (var m: moveset) : moveset is
block {
m[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9);
} with m
```
<!--Cameligo-->
We can update a map in CameLIGO using the `Map.update` built-in:
```cameligo
let updated_map: moveset = Map.update ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) (Some (4,9)) moves
```
<!--Reasonligo-->
We can update a map in ReasonLIGO using the `Map.update` built-in:
```reasonligo
let updated_map: moveset = Map.update(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some((4,9)), moves);
```
<!--END_DOCUSAURUS_CODE_TABS-->
### Iteration over the contents of a map
There are three kinds of iteration on LIGO maps, `iter`, `map` and `fold`. `iter`
@ -132,24 +172,24 @@ otherwise.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
function iter_op (const m : ledger) : unit is
function iter_op (const m : moveset) : unit is
block {
function aggregate (const i : address ; const j : tez) : unit is block
{ if (j > 100mutez) then skip else failwith("fail") } with unit ;
function aggregate (const i : address ; const j : move) : unit is block
{ if (j.1 > 1) then skip else failwith("fail") } with unit ;
} with map_iter(aggregate, m) ;
```
<!--CameLIGO-->
```cameligo
let iter_op (m : ledger) : unit =
let assert_eq = fun (i: address) (j: tez) -> assert (j > 100tz)
let iter_op (m : moveset) : unit =
let assert_eq = fun (i: address) (j: move) -> assert (j.0 > 1)
in Map.iter assert_eq m
```
<!--ReasonLIGO-->
```reasonligo
let iter_op = (m: ledger): unit => {
let assert_eq = (i: address, j: tez) => assert(j > 100mutez);
let iter_op = (m: moveset): unit => {
let assert_eq = (i: address, j: move) => assert(j[0] > 1);
Map.iter(assert_eq, m);
};
```
@ -160,23 +200,23 @@ let iter_op = (m: ledger): unit => {
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
function map_op (const m : ledger) : ledger is
function map_op (const m : moveset) : moveset is
block {
function increment (const i : address ; const j : tez) : tez is block { skip } with j + 1mutez ;
function increment (const i : address ; const j : move) : move is block { skip } with (j.0, j.1 + 1) ;
} with map_map(increment, m) ;
```
<!--CameLIGO-->
```cameligo
let map_op (m : ledger) : ledger =
let increment = fun (_: address) (j: tez) -> j + 1tz
let map_op (m : moveset) : moveset =
let increment = fun (_: address) (j: move) -> (j.0, j.1 + 1)
in Map.map increment m
```
<!--ReasonLIGO-->
```reasonligo
let map_op = (m: ledger): ledger => {
let increment = (ignore: address, j: tez) => j + 1tz;
let map_op = (m: moveset): moveset => {
let increment = (ignore: address, j: move) => (j[0], j[1] + 1);
Map.map(increment, m);
};
```
@ -194,30 +234,191 @@ It eventually returns the result of combining all the elements.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
function fold_op (const m : ledger) : tez is
function fold_op (const m : moveset) : int is
block {
function aggregate (const j : tez ; const cur : (address * tez)) : tez is j + cur.1 ;
} with map_fold(aggregate, m , 10mutez)
function aggregate (const j : int ; const cur : (address * (int * int))) : int is j + cur.1.1 ;
} with map_fold(aggregate, m , 5)
```
<!--CameLIGO-->
```cameligo
let fold_op (m : ledger) : ledger =
let aggregate = fun (j: tez) (cur: address * tez) -> j + cur.1 in
Map.fold aggregate m 10tz
let fold_op (m : moveset) : moveset =
let aggregate = fun (j: int) (cur: address * (int * int)) -> j + cur.1.1 in
Map.fold aggregate m 5
```
<!--ReasonLIGO-->
```reasonligo
let fold_op = (m: ledger): ledger => {
let aggregate = (j: tez, cur: (address, tez)) => j + cur[1];
Map.fold(aggregate, m, 10tz);
let fold_op = (m: moveset): moveset => {
let aggregate = (j: int, cur: (address, (int,int))) => j + cur[1][1];
Map.fold(aggregate, m, 5);
};
```
<!--END_DOCUSAURUS_CODE_TABS-->
## Big Maps
Ordinary maps are fine for contracts with a finite lifespan or a bounded number
of users. For many contracts however, the intention is to have a map hold *many*
entries, potentially millions or billions. The cost of loading these entries into
the environment each time a user executes the contract would eventually become
too expensive were it not for big maps. Big maps are a data structure offered by
Tezos which handles the scaling concerns for us. In LIGO, the interface for big
maps is analogous to the one used for ordinary maps.
Here's how we define a big map:
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
type move is (int * int);
type moveset is big_map(address, move);
```
<!--CameLIGO-->
```cameligo
type move = int * int
type moveset = (address, move) big_map
```
<!--ReasonLIGO-->
```reasonligo
type move = (int, int);
type moveset = big_map(address, move);
```
<!--END_DOCUSAURUS_CODE_TABS-->
And here's how a map value is populated:
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
const moves: moveset = big_map
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> (1, 2);
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) -> (0, 3);
end
```
> Notice the `->` between the key and its value and `;` to separate individual map entries.
>
> `("<string value>": address)` means that we type-cast a string into an address.
<!--CameLIGO-->
```cameligo
let moves: moveset = Big_map.literal
[ (("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address), (1, 2)) ;
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), (0, 3)) ;
]
```
> Big_map.literal constructs the map from a list of key-value pair tuples, `(<key>, <value>)`.
> Note also the `;` to separate individual map entries.
>
> `("<string value>": address)` means that we type-cast a string into an address.
<!--ReasonLIGO-->
```reasonligo
let moves: moveset =
Big_map.literal([
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, (1, 2)),
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, (0, 3)),
]);
```
> Big_map.literal constructs the map from a list of key-value pair tuples, `(<key>, <value>)`.
>
> `("<string value>": address)` means that we type-cast a string into an address.
<!--END_DOCUSAURUS_CODE_TABS-->
### Accessing map values by key
If we want to access a move from our moveset above, we can use the `[]` operator/accessor to read the associated `move` value. However, the value we'll get will be wrapped as an optional; in our case `option(move)`. Here's an example:
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
const balance: option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)];
```
<!--CameLIGO-->
```cameligo
let balance: move option = Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
```
<!--ReasonLIGO-->
```reasonligo
let balance: option(move) =
Big_map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves);
```
<!--END_DOCUSAURUS_CODE_TABS-->
#### Obtaining a map value forcefully
Accessing a value in a map yields an option, however you can also get the value directly:
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
const balance: move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves);
```
<!--CameLIGO-->
```cameligo
let balance: move = Big_map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
```
<!--ReasonLIGO-->
```reasonligo
let balance: move = Big_map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves);
```
<!--END_DOCUSAURUS_CODE_TABS-->
### Updating the contents of a big map
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
The values of a PascaLIGO big map can be updated using the ordinary assignment syntax:
```pascaligo
function set_ (var m: moveset) : moveset is
block {
m[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9);
} with m
```
<!--Cameligo-->
We can update a big map in CameLIGO using the `Big_map.update` built-in:
```cameligo
let updated_map: moveset =
Big_map.update ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) (Some (4,9)) moves
```
<!--Reasonligo-->
We can update a big map in ReasonLIGO using the `Big_map.update` built-in:
```reasonligo
let updated_map: moveset =
Big_map.update(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some((4,9)), moves);
```
<!--END_DOCUSAURUS_CODE_TABS-->
## Records
Records are a construct introduced in LIGO, and are not natively available in Michelson. The LIGO compiler translates records into Michelson `Pairs`.

2
src/bin/cli.ml
View File

@ -90,7 +90,7 @@ let predecessor_timestamp =
let open Arg in
let info =
let docv = "PREDECESSOR_TIMESTAMP" in
let doc = "$(docv) is the pedecessor_timestamp (now value) the michelson interpreter will use (e.g. '2000-01-01T10:10:10Z')" in
let doc = "$(docv) is the pedecessor_timestamp (now value minus one minute) the michelson interpreter will use (e.g. '2000-01-01T10:10:10Z')" in
info ~docv ~doc ["predecessor-timestamp"] in
value @@ opt (some string) None info

12
src/bin/expect_tests/contract_tests.ml
View File

@ -939,8 +939,16 @@ let%expect_test _ =
let%expect_test _ =
run_ligo_bad [ "compile-contract" ; contract "bad_address_format.religo" ; "main" ] ;
[%expect {| ligo: in file "bad_address_format.religo", line 2, characters 25-47. Badly formatted address "KT1badaddr": {"location":"in file \"bad_address_format.religo\", line 2, characters 25-47"} |}]
[%expect {| ligo: in file "bad_address_format.religo", line 2, characters 25-47. Badly formatted literal: address "KT1badaddr" {"location":"in file \"bad_address_format.religo\", line 2, characters 25-47"} |}]
let%expect_test _ =
run_ligo_bad [ "compile-contract" ; contract "bad_timestamp.ligo" ; "main" ] ;
[%expect {| ligo: in file "bad_timestamp.ligo", line 5, characters 29-43. Badly formatted timestamp "badtimestamp": {"location":"in file \"bad_timestamp.ligo\", line 5, characters 29-43"} |}]
[%expect {| ligo: in file "bad_timestamp.ligo", line 5, characters 29-43. Badly formatted timestamp "badtimestamp": {"location":"in file \"bad_timestamp.ligo\", line 5, characters 29-43"} |}]
let%expect_test _ =
run_ligo_good [ "dry-run" ; contract "redeclaration.ligo" ; "main" ; "unit" ; "0" ] ;
[%expect {|( [] , 0 ) |}]
let%expect_test _ =
run_ligo_good [ "dry-run" ; contract "double_main.ligo" ; "main" ; "unit" ; "0" ] ;
[%expect {|( [] , 2 ) |}]

25
src/bin/expect_tests/help_tests.ml
View File

@ -198,8 +198,9 @@ let%expect_test _ =
are 'text' (default), 'json' and 'hex'.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the
michelson interpreter will use (e.g. '2000-01-01T10:10:10Z')
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
@ -263,8 +264,9 @@ let%expect_test _ =
are 'text' (default), 'json' and 'hex'.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the
michelson interpreter will use (e.g. '2000-01-01T10:10:10Z')
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
@ -324,8 +326,9 @@ let%expect_test _ =
`plain' whenever the TERM env var is `dumb' or undefined.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the
michelson interpreter will use (e.g. '2000-01-01T10:10:10Z')
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
@ -382,8 +385,9 @@ let%expect_test _ =
`plain' whenever the TERM env var is `dumb' or undefined.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the
michelson interpreter will use (e.g. '2000-01-01T10:10:10Z')
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
@ -435,8 +439,9 @@ let%expect_test _ =
`plain' whenever the TERM env var is `dumb' or undefined.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the
michelson interpreter will use (e.g. '2000-01-01T10:10:10Z')
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported

2
src/bin/expect_tests/typer_error_tests.ml
View File

@ -20,6 +20,6 @@ let%expect_test _ =
[%expect {| ligo: in file "error_typer_6.mligo", line 1, characters 30-64. different type constructors: Expected these two constant type constructors to be the same, but they're different {"a":"string","b":"bool"} |} ] ;
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_7.mligo" ; "main" ] ;
[%expect {| ligo: in file "error_typer_7.mligo", line 4, characters 17-56. records have different sizes: Expected these two types to be the same, but they're different (both are records, but with a different number of arguments) {"a":"record[b -> string , a -> int]","b":"record[c -> bool , b -> string , a -> int]"} |} ] ;
[%expect {| ligo: in file "error_typer_7.mligo", line 4, characters 18-48. records have different sizes: Expected these two types to be the same, but they're different (both are records, but with a different number of arguments) {"a":"record[b -> string , a -> int]","b":"record[c -> bool , b -> string , a -> int]"} |} ] ;

7
src/main/compile/of_mini_c.ml
View File

@ -25,9 +25,10 @@ let aggregate_and_compile = fun program form ->
| ContractForm _ -> compile_contract aggregated'
| ExpressionForm _ -> compile_expression aggregated'
let aggregate_and_compile_contract = fun program name ->
let%bind (exp, _) = get_entry program name in
aggregate_and_compile program (ContractForm exp)
let aggregate_and_compile_contract = fun (program : Types.program) name ->
let%bind (exp, idx) = get_entry program name in
let program' = List.take idx program in
aggregate_and_compile program' (ContractForm exp)
let aggregate_and_compile_expression = fun program exp ->
aggregate_and_compile program (ExpressionForm exp)

4
src/main/display.ml
View File

@ -34,12 +34,12 @@ let rec error_pp ?(dev = false) out (e : error) =
| x -> [ x ] in
let location =
let opt = e |> member "data" |> member "location" |> string in
let aux prec cur =
let aux cur prec =
match prec with
| None -> cur |> member "data" |> member "location" |> string
| Some s -> Some s
in
match List.fold_left aux opt infos with
match List.fold_right aux infos opt with
| None -> ""
| Some s -> s ^ ". "
in

166
src/passes/1-parser/cameligo.ml
View File

@ -6,107 +6,93 @@ module ParserLog = Parser_cameligo.ParserLog
module LexToken = Parser_cameligo.LexToken
module Lexer = Lexer.Make(LexToken)
module Errors = struct
let lexer_error (e: Lexer.error AST.reg) =
let title () = "lexer error" in
let message () = Lexer.error_to_string e.value in
let data = [
("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region
)
] in
error ~data title message
let parser_error start end_ =
let title () = "parser error" in
let message () = "" in
let loc = Region.make
~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_)
in
let data = [
("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
)
] in
error ~data title message
let unrecognized_error start end_ =
let title () = "unrecognized error" in
let message () = "" in
let loc = Region.make
~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_)
in
let data = [
("unrecognized_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
)
] in
error ~data title message
end
open Errors
type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a
let parse (parser: 'a parser) lexbuf =
let Lexer.{read ; close ; _} = Lexer.open_token_stream None in
let result =
try
ok (parser read lexbuf)
with
| Parser.Error ->
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
fail @@ (parser_error start end_)
| Lexer.Error e ->
fail @@ (lexer_error e)
| _ ->
let _ = Printexc.print_backtrace Pervasives.stdout in
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
fail @@ (unrecognized_error start end_)
in
close ();
result
let parse_file (source: string) : AST.t result =
let pp_input =
let prefix = Filename.(source |> basename |> remove_extension)
and suffix = ".pp.mligo"
in prefix ^ suffix in
let prefix = Filename.(source |> basename |> remove_extension)
and suffix = ".pp.mligo"
in prefix ^ suffix in
let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s"
source pp_input in
let%bind () = sys_command cpp_cmd in
source pp_input in
let%bind () = sys_command cpp_cmd in
let%bind channel =
generic_try (simple_error "error opening file") @@
(fun () -> open_in pp_input) in
let lexbuf = Lexing.from_channel channel in
let Lexer.{read ; close ; _} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
start.pos_fname source
in
simple_error str
)
| exn ->
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
(Printexc.to_string exn)
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
start.pos_fname source
in
simple_error str
) @@ (fun () ->
let raw = Parser.contract read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
parse (Parser.contract) lexbuf
let parse_string (s:string) : AST.t result =
let lexbuf = Lexing.from_string s in
let Lexer.{read ; close ; _} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
simple_error str
)
| _ -> simple_error "unrecognized parse_ error"
) @@ (fun () ->
let raw = Parser.contract read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
parse (Parser.contract) lexbuf
let parse_expression (s:string) : AST.expr result =
let lexbuf = Lexing.from_string s in
let Lexer.{read ; close; _} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
simple_error str
)
| exn ->
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
(Printexc.to_string exn)
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
start.pos_fname s
in
simple_error str
) @@ (fun () ->
let raw = Parser.interactive_expr read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
let lexbuf = Lexing.from_string s in
parse (Parser.interactive_expr) lexbuf

2
src/passes/1-parser/cameligo/dune
View File

@ -40,4 +40,6 @@
(executable
(name Unlexer)
(libraries str)
(preprocess
(pps bisect_ppx --conditional))
(modules Unlexer))

156
src/passes/1-parser/pascaligo.ml
View File

@ -6,6 +6,73 @@ module ParserLog = Parser_pascaligo.ParserLog
module LexToken = Parser_pascaligo.LexToken
module Lexer = Lexer.Make(LexToken)
module Errors = struct
let lexer_error (e: Lexer.error AST.reg) =
let title () = "lexer error" in
let message () = Lexer.error_to_string e.value in
let data = [
("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region
)
] in
error ~data title message
let parser_error start end_ =
let title () = "parser error" in
let message () = "" in
let loc = Region.make
~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_)
in
let data = [
("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
)
] in
error ~data title message
let unrecognized_error start end_ =
let title () = "unrecognized error" in
let message () = "" in
let loc = Region.make
~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_)
in
let data = [
("unrecognized_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
)
] in
error ~data title message
end
open Errors
type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a
let parse (parser: 'a parser) lexbuf =
let Lexer.{read ; close ; _} = Lexer.open_token_stream None in
let result =
try
ok (parser read lexbuf)
with
| Parser.Error ->
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
fail @@ (parser_error start end_)
| Lexer.Error e ->
fail @@ (lexer_error e)
| _ ->
let _ = Printexc.print_backtrace Pervasives.stdout in
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
fail @@ (unrecognized_error start end_)
in
close ();
result
let parse_file (source: string) : AST.t result =
let pp_input =
let prefix = Filename.(source |> basename |> remove_extension)
@ -20,93 +87,12 @@ let parse_file (source: string) : AST.t result =
generic_try (simple_error "error opening file") @@
(fun () -> open_in pp_input) in
let lexbuf = Lexing.from_channel channel in
let Lexer.{read ; close ; _} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
start.pos_fname source
in
simple_error str
)
| exn ->
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
(Printexc.to_string exn)
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
start.pos_fname source
in
simple_error str
) @@ (fun () ->
let raw = Parser.contract read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
parse (Parser.contract) lexbuf
let parse_string (s:string) : AST.t result =
let lexbuf = Lexing.from_string s in
let Lexer.{read ; close ; _} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
simple_error str
)
| _ -> simple_error "unrecognized parse_ error"
) @@ (fun () ->
let raw = Parser.contract read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
parse (Parser.contract) lexbuf
let parse_expression (s:string) : AST.expr result =
let lexbuf = Lexing.from_string s in
let Lexer.{read ; close; _} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
simple_error str
)
| exn ->
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
(Printexc.to_string exn)
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
start.pos_fname s
in
simple_error str
) @@ (fun () ->
let raw = Parser.interactive_expr read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
let lexbuf = Lexing.from_string s in
parse (Parser.interactive_expr) lexbuf

6
src/passes/1-parser/reasonligo.ml
View File

@ -24,7 +24,7 @@ module Errors = struct
let message () = "" in
let expression_loc = AST.expr_to_region expr in
let data = [
("expression_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)
] in
error ~data title message
@ -37,7 +37,7 @@ module Errors = struct
~stop:(Pos.from_byte end_)
in
let data = [
("parser_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
)
] in
@ -51,7 +51,7 @@ module Errors = struct
~stop:(Pos.from_byte end_)
in
let data = [
("unrecognized_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
)
] in

2
src/passes/1-parser/reasonligo/dune
View File

@ -44,4 +44,6 @@
(executable
(name Unlexer)
(libraries str)
(preprocess
(pps bisect_ppx --conditional))
(modules Unlexer))

18
src/passes/2-simplify/cameligo.ml
View File

@ -32,7 +32,7 @@ module Errors = struct
in
let data = [
("expected", fun () -> expected_name);
("actual_loc" , fun () -> Format.asprintf "%a" Location.pp_lift @@ Raw.pattern_to_region actual)
("location" , fun () -> Format.asprintf "%a" Location.pp_lift @@ Raw.pattern_to_region actual)
] in
error ~data title message
@ -43,7 +43,7 @@ module Errors = struct
List.fold_left (fun a p -> Region.cover a (Raw.pattern_to_region p))
Region.ghost patterns in
let data = [
("loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ patterns_loc)
("location", fun () -> Format.asprintf "%a" Location.pp_lift @@ patterns_loc)
] in
error ~data title message
@ -52,7 +52,7 @@ module Errors = struct
let message () =
Format.asprintf "unknown predefined type \"%s\"" name.Region.value in
let data = [
("typename_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region)
] in
error ~data title message
@ -63,7 +63,7 @@ module Errors = struct
Format.asprintf "untyped function parameters are not supported yet" in
let param_loc = var.Region.region in
let data = [
("param_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc)
] in
error ~data title message
@ -74,7 +74,7 @@ module Errors = struct
Format.asprintf "tuple patterns are not supported yet" in
let pattern_loc = Raw.pattern_to_region p in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
] in
error ~data title message
@ -85,7 +85,7 @@ module Errors = struct
Format.asprintf "constant constructors are not supported yet" in
let pattern_loc = Raw.pattern_to_region p in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
] in
error ~data title message
@ -97,7 +97,7 @@ module Errors = struct
are not supported yet" in
let pattern_loc = Raw.pattern_to_region p in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
] in
error ~data title message
@ -119,7 +119,7 @@ module Errors = struct
Format.asprintf "currently, only constructors are supported in patterns" in
let pattern_loc = Raw.pattern_to_region p in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
] in
error ~data title message
@ -130,7 +130,7 @@ module Errors = struct
Format.asprintf "currently, only empty lists and constructors (::) \
are supported in patterns" in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
] in
error ~data title message

18
src/passes/2-simplify/pascaligo.ml
View File

@ -72,7 +72,7 @@ module Errors = struct
Format.asprintf "constant constructors are not supported yet" in
let pattern_loc = Raw.pattern_to_region p in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
] in
error ~data title message
@ -104,7 +104,7 @@ module Errors = struct
let message () =
Format.asprintf "unknown predefined type \"%s\"" name.Region.value in
let data = [
("typename_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region)
] in
error ~data title message
@ -116,7 +116,7 @@ module Errors = struct
are not supported yet" in
let pattern_loc = Raw.pattern_to_region p in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
] in
error ~data title message
@ -127,7 +127,7 @@ module Errors = struct
Format.asprintf "currently, only constructors are supported in patterns" in
let pattern_loc = Raw.pattern_to_region p in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
] in
error ~data title message
@ -138,7 +138,7 @@ module Errors = struct
Format.asprintf "tuple patterns are not supported yet" in
let pattern_loc = Raw.pattern_to_region p in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) ;
(** TODO: The labelled arguments should be flowing from the CLI. *)
("pattern",
@ -154,7 +154,7 @@ module Errors = struct
in patterns are supported" in
let pattern_loc = Raw.pattern_to_region pattern in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
] in
error ~data title message
@ -165,7 +165,7 @@ module Errors = struct
Format.asprintf "currently, only empty lists and x::y \
are supported in patterns" in
let data = [
("pattern_loc",
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ cons.Region.region)
] in
error ~data title message
@ -174,7 +174,7 @@ module Errors = struct
let title () = "unexpected anonymous function" in
let message () = "you provided a function declaration without name" in
let data = [
("loc" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
("location" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
] in
error ~data title message
@ -182,7 +182,7 @@ module Errors = struct
let title () = "unexpected named function" in
let message () = "you provided a function expression with a name (remove it)" in
let data = [
("loc" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
("location" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
] in
error ~data title message

19
src/passes/3-self_ast_simplified/literals.ml
View File

@ -3,23 +3,32 @@ open Trace
open Proto_alpha_utils
module Errors = struct
let bad_literal_address s_addr loc () =
let title = (thunk ("Badly formatted address \""^s_addr^"\"")) in
let message () = "" in
let bad_format e () =
let title = (thunk ("Badly formatted literal")) in
let message () = Format.asprintf "%a" Ast_simplified.PP.expression e in
let data = [
("location" , fun () -> Format.asprintf "%a" Location.pp loc)
("location" , fun () -> Format.asprintf "%a" Location.pp e.location)
] in
error ~data title message ()
end
open Errors
let peephole_expression : expression -> expression result = fun e ->
let return expression = ok { e with expression } in
match e.expression with
| E_literal (Literal_key_hash s) as l -> (
let open Tezos_crypto in
let%bind (_pkh:Crypto.Signature.public_key_hash) =
Trace.trace_tzresult (bad_format e) @@
Signature.Public_key_hash.of_b58check s in
return l
)
| E_literal (Literal_address s) as l -> (
let open Memory_proto_alpha in
let%bind (_contract:Protocol.Alpha_context.Contract.t) =
Trace.trace_alpha_tzresult (bad_literal_address s e.location) @@
Trace.trace_alpha_tzresult (bad_format e) @@
Protocol.Alpha_context.Contract.of_b58check s in
return l
)

1
src/passes/3-self_ast_simplified/tezos_type_annotation.ml
View File

@ -17,6 +17,7 @@ let peephole_expression : expression -> expression result = fun e ->
match e.expression with
| E_ascription (e' , t) as e -> (
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_int i) , T_constant (TC_timestamp)) -> return @@ E_literal (Literal_timestamp i)
| (E_literal (Literal_string str) , T_constant (TC_timestamp)) ->
let%bind time =

3
src/passes/8-compiler/compiler_type.ml
View File

@ -15,6 +15,7 @@ module Ty = struct
let tez_k = Mutez_key None
let int_k = Int_key None
let string_k = String_key None
let key_hash_k = Key_hash_key None
let address_k = Address_key None
let timestamp_k = Timestamp_key None
let bytes_k = Bytes_key None
@ -72,7 +73,7 @@ module Ty = struct
| Base_operation -> fail (not_comparable "operation")
| Base_signature -> fail (not_comparable "signature")
| Base_key -> fail (not_comparable "key")
| Base_key_hash -> fail (not_comparable "key_hash")
| Base_key_hash -> return key_hash_k
| Base_chain_id -> fail (not_comparable "chain_id")
let comparable_type : type_value -> ex_comparable_ty result = fun tv ->

6
src/stages/common/PP.ml
View File

@ -190,12 +190,12 @@ let literal ppf (l:literal) = match l with
| Literal_mutez n -> fprintf ppf "%dmutez" n
| Literal_string s -> fprintf ppf "%S" s
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
| Literal_address s -> fprintf ppf "@%S" s
| Literal_address s -> fprintf ppf "address %S" s
| Literal_operation _ -> fprintf ppf "Operation(...bytes)"
| Literal_key s -> fprintf ppf "key %s" s
| Literal_key_hash s -> fprintf ppf "key_hash %s" s
| Literal_signature s -> fprintf ppf "Signature %s" s
| Literal_chain_id s -> fprintf ppf "Chain_id %s" s
| Literal_signature s -> fprintf ppf "signature %s" s
| Literal_chain_id s -> fprintf ppf "chain_id %s" s
let%expect_test _ =
Format.printf "%a" literal (Literal_bytes (Bytes.of_string "foo")) ;

4
src/stages/mini_c/misc.ml
View File

@ -129,14 +129,14 @@ let get_entry (lst : program) (name : string) : (expression * int) result =
then Some decl_expr
else None
in
List.find_map aux lst
List.find_map aux (List.rev lst)
in
let entry_index =
let aux x =
let (((decl_name , _) , _)) = x in
Var.equal decl_name (Var.of_name name)
in
List.find_index aux lst
(List.length lst) - (List.find_index aux (List.rev lst)) - 1
in
ok (entry_expression , entry_index)

8
src/test/contracts/double_main.ligo Normal file
View File

@ -0,0 +1,8 @@
function main(const p : unit; const s : int) : list(operation) * int is
((list end : list(operation)), s + 1)
function main(const p : unit; const s : int) : list(operation) * int is
begin
const ret : list(operation) * int = main(p, s)
end
with (ret.0, ret.1 + 1)

6
src/test/contracts/redeclaration.ligo Normal file
View File

@ -0,0 +1,6 @@
function foo(const p : unit) : int is 0
function main(const p : unit; const s : int) : list(operation) * int is
((list end : list(operation)), foo(unit))
function foo(const p : unit) : int is 1

8
src/test/multisig_tests.ml
View File

@ -17,10 +17,10 @@ let get_program =
)
let compile_main () =
let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/multisig.ligo" (Syntax_name "pascaligo") in
let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in
let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/multisig.ligo" (Syntax_name "pascaligo") in
let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in
let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
let%bind (_contract: Tezos_utils.Michelson.michelson) =
(* fails if the given entry point is not a valid contract *)
Ligo.Compile.Of_michelson.build_contract michelson_prg in

5
vendors/ligo-utils/simple-utils/x_list.ml vendored
View File

@ -5,6 +5,11 @@ let rec remove n = function
| _ :: tl when n = 0 -> tl
| hd :: tl -> hd :: remove (n - 1) tl
let rec take n = function
| [] -> []
| _ when n = 0 -> []
| hd :: tl -> hd :: take (n - 1) tl
let map ?(acc = []) f lst =
let rec aux acc f = function
| [] -> acc