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 2019-12-11 14:11:11 +01:00
commit 079e59edff
30 changed files with 470 additions and 407 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gitlab-pages/docs/language-basics/boolean-if-else.md
View File

@ -21,7 +21,7 @@ let a: bool = true
let b: bool = false let b: bool = false
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let a: bool = true; let a: bool = true;
let b: bool = false; let b: bool = false;
@ -50,7 +50,7 @@ let b: string = "Alice"
// true // true
let c: bool = (a = b) let c: bool = (a = b)
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let a: string = "Alice"; let a: string = "Alice";
let b: string = "Alice"; let b: string = "Alice";
@ -86,7 +86,7 @@ let g: bool = (a >= b)
let h: bool = (a =/= b) let h: bool = (a =/= b)
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let a: int = 5; let a: int = 5;
let b: int = 4; let b: int = 4;
@ -118,7 +118,7 @@ let b: tez = 10mutez
// false // false
let c: bool = (a = b) let c: bool = (a = b)
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let a: tez = 5mutez; let a: tez = 5mutez;
let b: tez = 10mutez; let b: tez = 10mutez;
@ -176,7 +176,7 @@ let min_age: nat = 16n
let is_adult (age: nat) : bool = let is_adult (age: nat) : bool =
if (age > min_age) then true else false if (age > min_age) then true else false
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let min_age: nat = 16n; let min_age: nat = 16n;
@ -199,7 +199,7 @@ let is_adult = (age: nat): bool =>
> You can run the function above with > You can run the function above with
> ``` > ```
> ligo run-function -s cameligo src/if-else.mligo is_adult 21n > ligo run-function -s reasonligo src/if-else.religo is_adult 21n
> ``` > ```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->

18
gitlab-pages/docs/language-basics/functions.md
View File

@ -70,6 +70,22 @@ let add (a: int) (b: int) : int = a + b
The function body is a series of expressions, which are evaluated to give the return The function body is a series of expressions, which are evaluated to give the return
value. value.
<!--ReasonLIGO-->
Functions in ReasonLIGO are defined using the `let` keyword, like value bindings.
The difference is that after the value name a list of function parameters is provided,
along with a return type.
Here's how you define a basic function that accepts two `ints` and returns an `int` as well:
```reasonligo
let add (a: int, b: int) : int = a + b;
```
The function body is a series of expressions, which are evaluated to give the return
value.
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
@ -99,7 +115,7 @@ const a: int = increment(1);
let increment : (int -> int) = fun (i: int) -> i + 1 let increment : (int -> int) = fun (i: int) -> i + 1
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let increment: (int => int) = (i: int) => i + 1; let increment: (int => int) = (i: int) => i + 1;
``` ```

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

@ -22,7 +22,7 @@ type ledger is map(address, tez);
type ledger = (address, tez) map type ledger = (address, tez) map
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type ledger = map(address, tez); type ledger = map(address, tez);
``` ```
@ -57,19 +57,19 @@ let ledger: ledger = Map.literal
> >
> `("<string value>": address)` means that we type-cast a string into an address. > `("<string value>": address)` means that we type-cast a string into an address.
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let ledger: ledger = let ledger: ledger =
Map.literal([ Map.literal([
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, 1000(mutez)), ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, 1000mutez),
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, 2000(mutez)), ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, 2000mutez),
]); ]);
```
> Map.literal constructs the map from a list of key-value pair tuples, `(<key>, <value>)`. > 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. > `("<string value>": address)` means that we type-cast a string into an address.
```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->
### Accessing map values by key ### Accessing map values by key
@ -88,7 +88,7 @@ const balance: option(tez) = ledger[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": add
let balance: tez option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) ledger let balance: tez option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) ledger
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let balance: option(tez) = let balance: option(tez) =
@ -112,7 +112,7 @@ const balance: tez = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)
let balance: tez = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) ledger let balance: tez = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) ledger
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let balance: tez = let balance: tez =
@ -146,7 +146,7 @@ let iter_op (m : ledger) : unit =
in Map.iter assert_eq m in Map.iter assert_eq m
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let iter_op = (m: ledger): unit => { let iter_op = (m: ledger): unit => {
let assert_eq = (i: address, j: tez) => assert(j > 100); let assert_eq = (i: address, j: tez) => assert(j > 100);
@ -173,7 +173,7 @@ let map_op (m : ledger) : ledger =
in Map.map increment m in Map.map increment m
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let map_op = (m: ledger): ledger => { let map_op = (m: ledger): ledger => {
let increment = (ignore: address, j: tez) => j + 1; let increment = (ignore: address, j: tez) => j + 1;
@ -207,7 +207,7 @@ let fold_op (m : ledger) : ledger =
in Map.fold aggregate m 10 in Map.fold aggregate m 10
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let fold_op = (m: ledger): ledger => { let fold_op = (m: ledger): ledger => {
let aggregate = (ignore: address, j: (tez, tez)) => j[0] + j[1]; let aggregate = (ignore: address, j: (tez, tez)) => j[0] + j[1];
@ -243,7 +243,7 @@ type user = {
} }
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type user = { type user = {
id: nat, id: nat,
@ -275,7 +275,7 @@ let user: user = {
} }
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let user: user = { let user: user = {
id: 1n, id: 1n,
@ -301,7 +301,7 @@ const is_admin: bool = user.is_admin;
let is_admin: bool = user.is_admin let is_admin: bool = user.is_admin
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let is_admin: bool = user.is_admin; let is_admin: bool = user.is_admin;
``` ```

15
gitlab-pages/docs/language-basics/math-numbers-tez.md
View File

@ -60,7 +60,7 @@ let g: int = 1_000_000
>let g: int = 1_000_000; >let g: int = 1_000_000;
>``` >```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
// int + int produces int // int + int produces int
@ -71,6 +71,7 @@ let b: int = 5n + 10;
let c: tez = 5mutez + 10mutez; let c: tez = 5mutez + 10mutez;
// you can't add tez + int or tez + nat, this won't compile // you can't add tez + int or tez + nat, this won't compile
// let d: tez = 5mutez + 10n; // let d: tez = 5mutez + 10n;
// two nats produce a nat
let e: nat = 5n + 10n; let e: nat = 5n + 10n;
// nat + int produces an int, this won't compile // nat + int produces an int, this won't compile
// let f: nat = 5n + 10; // let f: nat = 5n + 10;
@ -112,7 +113,7 @@ let b: int = 5n - 2n
let d: tez = 5mutez - 1mt let d: tez = 5mutez - 1mt
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let a: int = 5 - 10; let a: int = 5 - 10;
// substraction of two nats, yields an int // substraction of two nats, yields an int
@ -147,7 +148,7 @@ let b: nat = 5n * 5n
let c: tez = 5n * 5mutez let c: tez = 5n * 5mutez
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let a: int = 5 * 5; let a: int = 5 * 5;
let b: nat = 5n * 5n; let b: nat = 5n * 5n;
@ -179,7 +180,7 @@ let b: nat = 10n / 3n
let c: nat = 10mutez / 3mutez let c: nat = 10mutez / 3mutez
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let a: int = 10 / 3; let a: int = 10 / 3;
let b: nat = 10n / 3n; let b: nat = 10n / 3n;
@ -199,4 +200,10 @@ const a: int = int(1n);
const b: nat = abs(1); const b: nat = abs(1);
``` ```
<!--ReasonLIGO-->
```reasonligo
let a: int = int(1n);
let b: nat = abs(1);
```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->

26
gitlab-pages/docs/language-basics/sets-lists-touples.md
View File

@ -31,7 +31,7 @@ let my_set: int_set =
Set.add 3 (Set.add 2 (Set.add 1 (Set.empty: int set))) Set.add 3 (Set.add 2 (Set.add 1 (Set.empty: int set)))
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type int_set = set(int); type int_set = set(int);
let my_set: int_set = let my_set: int_set =
@ -52,7 +52,7 @@ const my_set_2: int_set = set_empty;
```cameligo ```cameligo
let my_set: int_set = (Set.empty: int set) let my_set: int_set = (Set.empty: int set)
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let my_set: int_set = (Set.empty: set(int)); let my_set: int_set = (Set.empty: set(int));
``` ```
@ -72,7 +72,7 @@ const contains_three_fn: bool = set_mem(3, my_set);
```cameligo ```cameligo
let contains_three: bool = Set.mem 3 my_set let contains_three: bool = Set.mem 3 my_set
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let contains_three: bool = Set.mem(3, my_set); let contains_three: bool = Set.mem(3, my_set);
``` ```
@ -92,7 +92,7 @@ const set_size: nat = size(my_set);
let set_size: nat = Set.size my_set let set_size: nat = Set.size my_set
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let set_size: nat = Set.size(my_set); let set_size: nat = Set.size(my_set);
``` ```
@ -115,7 +115,7 @@ let larger_set: int_set = Set.add 4 my_set
let smaller_set: int_set = Set.remove 3 my_set let smaller_set: int_set = Set.remove 3 my_set
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let larger_set: int_set = Set.add(4, my_set); let larger_set: int_set = Set.add(4, my_set);
@ -140,7 +140,7 @@ let sum (result: int) (i: int) : int = result + i
let sum_of_a_set: int = Set.fold sum my_set 0 let sum_of_a_set: int = Set.fold sum my_set 0
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let sum = (result: int, i: int): int => result + i; let sum = (result: int, i: int): int => result + i;
let sum_of_a_set: int = Set.fold(sum, my_set, 0); let sum_of_a_set: int = Set.fold(sum, my_set, 0);
@ -172,7 +172,7 @@ type int_list = int list
let my_list: int_list = [1; 2; 3] let my_list: int_list = [1; 2; 3]
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type int_list = list(int); type int_list = list(int);
let my_list: int_list = [1, 2, 3]; let my_list: int_list = [1, 2, 3];
@ -196,10 +196,10 @@ let larger_list: int_list = 4 :: my_list
(* CameLIGO doesn't have a List.cons *) (* CameLIGO doesn't have a List.cons *)
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let larger_list: int_list = [4, ...my_list]; let larger_list: int_list = [4, ...my_list];
/* Reasonligo doesn't have a List.cons */ /* ReasonLIGO doesn't have a List.cons */
``` ```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->
@ -226,7 +226,7 @@ let incremented_list: int_list = List.map increment larger_list
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let increment = (i: int): int => i + 1; let increment = (i: int): int => i + 1;
@ -254,7 +254,7 @@ let sum (result: int) (i: int) : int = result + i
let sum_of_a_list: int = List.fold sum my_list 0 let sum_of_a_list: int = List.fold sum my_list 0
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let sum = (result: int, i: int): int => result + i; let sum = (result: int, i: int): int => result + i;
@ -299,7 +299,7 @@ type full_name = string * string
let full_name: full_name = ("Alice", "Johnson") let full_name: full_name = ("Alice", "Johnson")
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type full_name = (string, string); type full_name = (string, string);
/* The parenthesis here are optional */ /* The parenthesis here are optional */
@ -329,7 +329,7 @@ const first_name: string = full_name.1;
let first_name: string = full_name.1 let first_name: string = full_name.1
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let first_name: string = full_name[1]; let first_name: string = full_name[1];
``` ```

4
gitlab-pages/docs/language-basics/src/variables-and-constants/add.religo Normal file
View File

@ -0,0 +1,4 @@
let add = (a: int, b: int): int => {
let c: int = a + b;
c;
};

1
gitlab-pages/docs/language-basics/src/variables-and-constants/const.religo Normal file
View File

@ -0,0 +1 @@
let age : int = 25;

18
gitlab-pages/docs/language-basics/strings.md
View File

@ -16,15 +16,19 @@ const a: string = "Hello Alice";
``` ```
let a: string = "Hello Alice" let a: string = "Hello Alice"
``` ```
<!--ReasonLIGO-->
```
let a: string = "Hello Alice";
```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->
## Concatenating strings ## Concatenating strings
Strings can be concatenated using the `^` operator.
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo--> <!--Pascaligo-->
Strings can be concatenated using the `^` operator.
```pascaligo ```pascaligo
const name: string = "Alice"; const name: string = "Alice";
const greeting: string = "Hello"; const greeting: string = "Hello";
@ -34,12 +38,16 @@ const full_greeting: string = greeting ^ " " ^ name;
const full_greeting_exclamation: string = string_concat(full_greeting, "!"); const full_greeting_exclamation: string = string_concat(full_greeting, "!");
``` ```
<!--Cameligo--> <!--Cameligo-->
Strings can be concatenated using the `^` operator.
```cameligo ```cameligo
let name: string = "Alice" let name: string = "Alice"
let greeting: string = "Hello" let greeting: string = "Hello"
let full_greeting: string = greeting ^ " " ^ name let full_greeting: string = greeting ^ " " ^ name
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
Strings can be concatenated using the `++` operator.
```reasonligo ```reasonligo
let name: string = "Alice"; let name: string = "Alice";
let greeting: string = "Hello"; let greeting: string = "Hello";
@ -64,7 +72,7 @@ const slice: string = string_slice(0n, 1n, name);
let name: string = "Alice" let name: string = "Alice"
let slice: string = String.slice 0n 1n name let slice: string = String.slice 0n 1n name
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let name: string = "Alice"; let name: string = "Alice";
let slice: string = String.slice(0n, 1n, name); let slice: string = String.slice(0n, 1n, name);
@ -89,7 +97,7 @@ const length: nat = size(name);
let name: string = "Alice" let name: string = "Alice"
let length: nat = String.size name let length: nat = String.size name
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let name: string = "Alice"; let name: string = "Alice";
let length: nat = String.size(name); let length: nat = String.size(name);

6
gitlab-pages/docs/language-basics/types.md
View File

@ -27,7 +27,7 @@ type animal_breed = string
let dog_breed: animal_breed = "Saluki" let dog_breed: animal_breed = "Saluki"
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type animal_breed = string; type animal_breed = string;
@ -64,7 +64,7 @@ type account_balances = map(address, tez);
let ledger: account_balances = let ledger: account_balances =
Map.literal([ Map.literal([
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, 10(mutez)), ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, 10mutez),
]); ]);
``` ```
@ -141,7 +141,7 @@ let ledger: account_balances =
Map.literal([ Map.literal([
( (
"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address,
{balance: 10(mutez), number_of_transactions: 5n}, {balance: 10mutez, number_of_transactions: 5n},
), ),
]); ]);

8
gitlab-pages/docs/language-basics/unit-option-pattern-matching.md
View File

@ -24,7 +24,7 @@ const n: unit = Unit;
let n: unit = () let n: unit = ()
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let n: unit = (); let n: unit = ();
``` ```
@ -62,7 +62,7 @@ let u: user = Admin 1000n
let g: user = Guest () let g: user = Guest ()
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type id = nat; type id = nat;
type user = type user =
@ -101,7 +101,7 @@ let p1: dinner = None
let p2: dinner = Some "Hamburgers" let p2: dinner = Some "Hamburgers"
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type dinner = option(string); type dinner = option(string);
@ -138,7 +138,7 @@ let is_hungry (d: dinner) : bool =
| Some s -> false | Some s -> false
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
type dinner = option(string); type dinner = option(string);
let is_hungry = (d: dinner): bool => let is_hungry = (d: dinner): bool =>

8
gitlab-pages/docs/language-basics/variables-and-constants.md
View File

@ -5,6 +5,8 @@ title: Constants & Variables
The next building block after types are constants and variables. The next building block after types are constants and variables.
pleh.
## Constants ## Constants
Constants are immutable by design, which means their values can't be reassigned. Constants are immutable by design, which means their values can't be reassigned.
@ -32,7 +34,7 @@ ligo evaluate-value -s cameligo gitlab-pages/docs/language-basics/src/variables-
# Outputs: 25 # Outputs: 25
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let age: int = 25; let age: int = 25;
``` ```
@ -98,9 +100,9 @@ You can run the `add` function defined above using the LIGO compiler like this:
ligo run-function -s cameligo gitlab-pages/docs/language-basics/src/variables-and-constants/add.mligo add '(1,1)' ligo run-function -s cameligo gitlab-pages/docs/language-basics/src/variables-and-constants/add.mligo add '(1,1)'
# Outputs: 2 # Outputs: 2
``` ```
<!--Reasonligo--> <!--ReasonLIGO-->
As expected from a functional language, Reasonligo uses value-binding As expected from a functional language, ReasonLIGO uses value-binding
for variables rather than assignment. Variables are changed by replacement, for variables rather than assignment. Variables are changed by replacement,
with a new value being bound in place of the old one. with a new value being bound in place of the old one.

129
src/bin/cli.ml
View File

@ -95,14 +95,18 @@ let michelson_code_format =
`Text info `Text info
module Helpers = Ligo.Compile.Helpers module Helpers = Ligo.Compile.Helpers
module Compile = Ligo.Compile.Wrapper module Compile = Ligo.Compile
module Uncompile = Ligo.Uncompile module Uncompile = Ligo.Uncompile
module Run = Ligo.Run.Of_michelson module Run = Ligo.Run.Of_michelson
let compile_file = let compile_file =
let f source_file entry_point syntax display_format michelson_format = let f source_file entry_point syntax display_format michelson_format =
toplevel ~display_format @@ toplevel ~display_format @@
let%bind contract = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed,_ = Compile.Of_simplified.compile simplified in
let%bind mini_c = Compile.Of_typed.compile typed in
let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c entry_point in
let%bind contract = Compile.Of_mini_c.build_contract michelson in
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
in in
let term = let term =
@ -114,7 +118,11 @@ let compile_file =
let measure_contract = let measure_contract =
let f source_file entry_point syntax display_format = let f source_file entry_point syntax display_format =
toplevel ~display_format @@ toplevel ~display_format @@
let%bind contract = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed,_ = Compile.Of_simplified.compile simplified in
let%bind mini_c = Compile.Of_typed.compile typed in
let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c entry_point in
let%bind contract = Compile.Of_mini_c.build_contract michelson in
let open Tezos_utils in let open Tezos_utils in
ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract) ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract)
in in
@ -125,12 +133,28 @@ let measure_contract =
(term , Term.info ~doc cmdname) (term , Term.info ~doc cmdname)
let compile_parameter = let compile_parameter =
let f source_file _entry_point expression syntax display_format michelson_format = let f source_file entry_point expression syntax display_format michelson_format =
toplevel ~display_format @@ toplevel ~display_format @@
(*
TODO:
source_to_michelson_contract will fail if the entry_point does not point to a michelson contract
but we do not check that the type of the parameter matches the type of the given expression
*)
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed_prg,state = Compile.Of_simplified.compile simplified in
let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in
let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in
let env = Ast_typed.program_environment typed_prg in
let%bind (_contract: Tezos_utils.Michelson.michelson) =
(* fails if the given entry point is not a valid contract *)
Compile.Of_mini_c.build_contract michelson_prg in
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
let%bind (_,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in
let%bind compiled_exp = Compile.source_expression_to_michelson_value_as_function ~env ~state expression v_syntax in let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
let%bind value = Run.evaluate_michelson compiled_exp in let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in
let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Expression mini_c_param) [] in
let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
in in
let term = let term =
@ -139,16 +163,29 @@ let compile_parameter =
let doc = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract." in let doc = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract." in
(term , Term.info ~doc cmdname) (term , Term.info ~doc cmdname)
(*-------------------------------------------------------------------------------------------------------------------------------------
TODO: This function does not typecheck anything, add the typecheck against the given entrypoint. For now: does the same as compile_parameter
-------------------------------------------------------------------------------------------------------------------------------------- *)
let compile_storage = let compile_storage =
let f source_file _entry_point expression syntax display_format michelson_format = let f source_file entry_point expression syntax display_format michelson_format =
toplevel ~display_format @@ toplevel ~display_format @@
(*
TODO:
source_to_michelson_contract will fail if the entry_point does not point to a michelson contract
but we do not check that the type of the storage matches the type of the given expression
*)
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed_prg,state = Compile.Of_simplified.compile simplified in
let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in
let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in
let env = Ast_typed.program_environment typed_prg in
let%bind (_contract: Tezos_utils.Michelson.michelson) =
(* fails if the given entry point is not a valid contract *)
Compile.Of_mini_c.build_contract michelson_prg in
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
let%bind (_,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in
let%bind compiled = Compile.source_expression_to_michelson_value_as_function ~env ~state expression v_syntax in let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
let%bind value = Run.evaluate_michelson compiled in let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in
let%bind compiled_param = Compile.Of_mini_c.compile_expression mini_c_param in
let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
in in
let term = let term =
@ -160,14 +197,26 @@ let compile_storage =
let dry_run = let dry_run =
let f source_file entry_point storage input amount sender source syntax display_format = let f source_file entry_point storage input amount sender source syntax display_format =
toplevel ~display_format @@ toplevel ~display_format @@
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed_prg,state = Compile.Of_simplified.compile simplified in
let env = Ast_typed.program_environment typed_prg in
let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in
let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in
let%bind (_contract: Tezos_utils.Michelson.michelson) =
(* fails if the given entry point is not a valid contract *)
Compile.Of_mini_c.build_contract michelson_prg in
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
let%bind (typed_program,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in let%bind simplified = Compile.Of_source.compile_contract_input storage input v_syntax in
let%bind compiled_param = Compile.source_contract_input_to_michelson_value_as_function ~env ~state (storage,input) v_syntax in let%bind typed,_ = Compile.Of_simplified.compile_expression ~env ~state simplified in
let%bind michelson = Compile.typed_to_michelson_program typed_program entry_point in let%bind mini_c = Compile.Of_typed.compile_expression typed in
let%bind args_michelson = Run.evaluate_michelson compiled_param in let%bind compiled_params = Compile.Of_mini_c.compile_expression mini_c in
let%bind args_michelson = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
let%bind michelson_output = Run.run ~options michelson args_michelson in let%bind michelson_output = Run.run_contract ~options michelson_prg.expr michelson_prg.expr_ty args_michelson in
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_program entry_point michelson_output in
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
in in
let term = let term =
@ -180,13 +229,19 @@ let run_function =
let f source_file entry_point parameter amount sender source syntax display_format = let f source_file entry_point parameter amount sender source syntax display_format =
toplevel ~display_format @@ toplevel ~display_format @@
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
let%bind (typed_program,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind compiled_parameter = Compile.source_expression_to_michelson_value_as_function ~env ~state parameter v_syntax in let%bind typed_prg,state = Compile.Of_simplified.compile simplified_prg in
let%bind michelson = Compile.typed_to_michelson_program typed_program entry_point in let env = Ast_typed.program_environment typed_prg in
let%bind args_michelson = Run.evaluate_michelson compiled_parameter in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in
let%bind simplified_param = Compile.Of_source.compile_expression v_syntax parameter in
let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
let%bind compiled_param = Compile.Of_typed.compile_expression typed_param in
let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Entry_name entry_point) [compiled_param] in
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
let%bind michelson_output = Run.run ~options michelson args_michelson in let%bind michelson_output = Run.run ~options michelson.expr michelson.expr_ty in
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_program entry_point michelson_output in let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
in in
let term = let term =
@ -198,11 +253,14 @@ let run_function =
let evaluate_value = let evaluate_value =
let f source_file entry_point amount sender source syntax display_format = let f source_file entry_point amount sender source syntax display_format =
toplevel ~display_format @@ toplevel ~display_format @@
let%bind (typed_program,_,_) = Compile.source_to_typed (Syntax_name syntax) source_file in let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind contract = Compile.typed_to_michelson_value_as_function typed_program entry_point in let%bind typed_prg,_ = Compile.Of_simplified.compile simplified in
let%bind mini_c = Compile.Of_typed.compile typed_prg in
let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in
let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c (Expression exp) [] in
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
let%bind michelson_output = Run.evaluate ~options contract in let%bind michelson_output = Run.run ~options compiled.expr compiled.expr_ty in
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_program entry_point michelson_output in let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
in in
let term = let term =
@ -215,10 +273,13 @@ let compile_expression =
let f expression syntax display_format michelson_format = let f expression syntax display_format michelson_format =
toplevel ~display_format @@ toplevel ~display_format @@
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (None) in let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (None) in
let%bind compiled = Compile.source_expression_to_michelson_value_as_function let env = Ast_typed.Environment.full_empty in
~env:(Ast_typed.Environment.full_empty) ~state:(Typer.Solver.initial_state) let state = Typer.Solver.initial_state in
expression v_syntax in let%bind simplified = Compile.Of_source.compile_expression v_syntax expression in
let%bind value = Run.evaluate_michelson compiled in let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified in
let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in
let%bind compiled_exp = Compile.Of_mini_c.compile_expression mini_c_exp in
let%bind value = Run.evaluate_expression compiled_exp.expr compiled_exp.expr_ty in
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
in in
let term = let term =

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

@ -1,44 +1,58 @@
open Trace
open Mini_c open Mini_c
open Tezos_utils open Tezos_utils
open Proto_alpha_utils
open Trace
let compile_expression_as_function : expression -> _ result = fun e -> let compile_contract : expression -> Compiler.compiled_expression result = fun e ->
let (input , output) = t_unit , e.type_value in let%bind (input_ty , _) = get_t_function e.type_value in
let%bind body = Compiler.Program.translate_expression e Compiler.Environment.empty in
let body = Self_michelson.optimize body in
let body = Michelson.(seq [ i_drop ; body ]) in
let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in
let open! Compiler.Program in
ok { input ; output ; body }
let compile_function = fun e ->
let%bind (input , output) = get_t_function e.type_value in
let%bind body = get_function e in let%bind body = get_function e in
let%bind body = Compiler.Program.translate_function_body body [] input in let%bind body = Compiler.Program.translate_function_body body [] input_ty in
let body = Self_michelson.optimize body in let expr = Self_michelson.optimize body in
let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in
let open! Compiler.Program in let open! Compiler.Program in
ok { input ; output ; body } ok { expr_ty ; expr }
let compile_expression_as_function_entry = fun program name -> let compile_expression : expression -> Compiler.compiled_expression result = fun e ->
let%bind aggregated = aggregate_entry program name true in let%bind expr = Compiler.Program.translate_expression e Compiler.Environment.empty in
let aggregated = Self_mini_c.all_expression aggregated in let expr = Self_michelson.optimize expr in
compile_function aggregated let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in
let open! Compiler.Program in
ok { expr_ty ; expr }
let compile_function_entry = fun program name -> let aggregate_and_compile = fun program form ->
let%bind aggregated = aggregate_entry program name false in let%bind aggregated = aggregate_entry program form in
let aggregated = Self_mini_c.all_expression aggregated in let aggregated' = Self_mini_c.all_expression aggregated in
compile_function aggregated match form with
| ContractForm _ -> compile_contract aggregated'
| ExpressionForm _ -> compile_expression aggregated'
let compile_contract_entry = fun program name -> let aggregate_and_compile_contract = fun program name ->
let%bind aggregated = aggregate_entry program name false in let%bind (exp, idx) = get_entry program name in
let aggregated = Self_mini_c.all_expression aggregated in aggregate_and_compile program (ContractForm (exp, idx))
let%bind compiled = compile_function aggregated in
let%bind (param_ty , storage_ty) = type compiled_expression_t =
let%bind fun_ty = get_t_function aggregated.type_value in | Expression of expression
Mini_c.get_t_pair (fst fun_ty) | Entry_name of string
in
let%bind param_michelson = Compiler.Type.type_ param_ty in let aggregate_and_compile_expression = fun program exp args ->
let%bind storage_michelson = Compiler.Type.type_ storage_ty in match exp with
let contract = Michelson.contract param_michelson storage_michelson compiled.body in | Expression exp ->
aggregate_and_compile program (ExpressionForm ((exp,List.length program), args))
| Entry_name name ->
let%bind (exp, idx) = get_entry program name in
aggregate_and_compile program (ExpressionForm ((exp,idx), args))
let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
fun compiled ->
let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_lambda_parameters compiled.expr_ty in
let%bind param_michelson =
Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's parameter") @@
Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in
let%bind storage_michelson =
Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's storage") @@
Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in
let contract = Michelson.contract param_michelson storage_michelson compiled.expr in
let%bind () =
Trace.trace_tzresult_lwt (simple_error "Invalid contract") @@
Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
ok contract ok contract

51
src/main/compile/wrapper.ml
View File

@ -1,51 +0,0 @@
open Trace
let source_to_typed syntax source_file =
let%bind simplified = Of_source.compile source_file syntax in
let%bind typed,state = Of_simplified.compile simplified in
let env = Ast_typed.program_environment typed in
ok (typed,state,env)
let source_to_typed_expression ~env ~state parameter syntax =
let%bind simplified = Of_source.compile_expression syntax parameter in
let%bind (typed,_) = Of_simplified.compile_expression ~env ~state simplified in
ok typed
let typed_to_michelson_program
(typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_program result =
let%bind mini_c = Of_typed.compile typed in
Of_mini_c.compile_function_entry mini_c entry_point
let typed_to_michelson_value_as_function
(typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_program result =
let%bind mini_c = Of_typed.compile typed in
Of_mini_c.compile_expression_as_function_entry mini_c entry_point
let typed_expression_to_michelson_value_as_function
(typed: Ast_typed.annotated_expression) : Compiler.compiled_program result =
let%bind mini_c = Of_typed.compile_expression typed in
Of_mini_c.compile_expression_as_function mini_c
let simplified_to_compiled_program
~env ~state (exp: Ast_simplified.expression) : Compiler.compiled_program result =
let%bind (typed,_) = Of_simplified.compile_expression ~env ~state exp in
typed_expression_to_michelson_value_as_function typed
let typed_to_michelson_contract
(typed: Ast_typed.program) (entry_point:string) : Michelson.michelson result =
let%bind mini_c = Of_typed.compile typed in
Of_mini_c.compile_contract_entry mini_c entry_point
let source_to_michelson_contract syntax source_file entry_point =
let%bind (typed,_,_) = source_to_typed syntax source_file in
typed_to_michelson_contract typed entry_point
let source_expression_to_michelson_value_as_function ~env ~state parameter syntax =
let%bind typed = source_to_typed_expression ~env ~state parameter syntax in
let%bind mini_c = Of_typed.compile_expression typed in
Of_mini_c.compile_expression_as_function mini_c
let source_contract_input_to_michelson_value_as_function ~env ~state (storage,parameter) syntax =
let%bind simplified = Of_source.compile_contract_input storage parameter syntax in
let%bind typed,_ = Of_simplified.compile_expression ~env ~state simplified in
typed_expression_to_michelson_value_as_function typed

151
src/main/run/of_michelson.ml
View File

@ -1,11 +1,19 @@
open Proto_alpha_utils open Proto_alpha_utils
open Trace open Trace
open Compiler.Program
open Memory_proto_alpha.Protocol.Script_ir_translator open Memory_proto_alpha.Protocol.Script_ir_translator
open Memory_proto_alpha.X open Memory_proto_alpha.X
type options = Memory_proto_alpha.options type options = Memory_proto_alpha.options
type run_res =
| Success of ex_typed_value
| Fail of Memory_proto_alpha.Protocol.Script_repr.expr
type run_failwith_res =
| Failwith_int of int
| Failwith_string of string
| Failwith_bytes of bytes
type dry_run_options = type dry_run_options =
{ amount : string ; { amount : string ;
sender : string option ; sender : string option ;
@ -38,83 +46,11 @@ let make_dry_run_options (opts : dry_run_options) : options result =
ok (Some source) in ok (Some source) in
ok @@ make_options ~amount ?source:sender ?payer:source () ok @@ make_options ~amount ?source:sender ?payer:source ()
let run ?options (* ?(is_input_value = false) *) (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
let Compiler.Program.{input;output;body} : compiled_program = program in
let (Ex_ty input_ty) = input in
let (Ex_ty output_ty) = output in
(* let%bind input_ty_mich =
Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@
Memory_proto_alpha.unparse_michelson_ty input_ty in
let%bind output_ty_mich =
Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@
Memory_proto_alpha.unparse_michelson_ty output_ty in
Format.printf "code: %a\n" Michelson.pp program.body ;
Format.printf "input_ty: %a\n" Michelson.pp input_ty_mich ;
Format.printf "output_ty: %a\n" Michelson.pp output_ty_mich ;
Format.printf "input: %a\n" Michelson.pp input_michelson ; *)
let%bind input =
Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
Memory_proto_alpha.parse_michelson_data input_michelson input_ty
in
let body = Michelson.strip_annots body in
let open! Memory_proto_alpha.Protocol.Script_ir_translator in
let top_level = Toplevel { storage_type = output_ty ; param_type = input_ty ;
root_name = None ; legacy_create_contract_literal = false } in
let%bind descr =
Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
Memory_proto_alpha.parse_michelson ~top_level body
(Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in
let open! Memory_proto_alpha.Protocol.Script_interpreter in
let%bind (Item(output, Empty)) =
Trace.trace_tzresult_lwt (simple_error "error of execution") @@
Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in
ok (Ex_typed_value (output_ty, output))
type failwith_res =
| Failwith_int of int
| Failwith_string of string
| Failwith_bytes of bytes
let get_exec_error_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : Memory_proto_alpha.Protocol.Script_repr.expr result =
let Compiler.Program.{input;output;body} : compiled_program = program in
let (Ex_ty input_ty) = input in
let (Ex_ty output_ty) = output in
let%bind input =
Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
Memory_proto_alpha.parse_michelson_data input_michelson input_ty
in
let body = Michelson.strip_annots body in
let%bind descr =
Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
Memory_proto_alpha.parse_michelson body
(Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in
let%bind err =
Trace.trace_tzresult_lwt (simple_error "unexpected error of execution") @@
Memory_proto_alpha.failure_interpret ?options descr (Item(input, Empty)) in
match err with
| Memory_proto_alpha.Succeed _ -> simple_fail "an error of execution was expected"
| Memory_proto_alpha.Fail expr ->
ok expr
let get_exec_error ?options (program:compiled_program) (input_michelson:Michelson.t) : failwith_res result =
let%bind expr = get_exec_error_aux ?options program input_michelson in
match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims expr with
| Int (_ , i) -> ok (Failwith_int (Z.to_int i))
| String (_ , s) -> ok (Failwith_string s)
| Bytes (_,b) -> ok (Failwith_bytes b)
| _ -> simple_fail "Unknown failwith"
let evaluate ?options program = run ?options program Michelson.d_unit
let ex_value_ty_to_michelson (v : ex_typed_value) : Michelson.t result = let ex_value_ty_to_michelson (v : ex_typed_value) : Michelson.t result =
let (Ex_typed_value (value , ty)) = v in let (Ex_typed_value (value , ty)) = v in
Trace.trace_tzresult_lwt (simple_error "error unparsing michelson result") @@ Trace.trace_tzresult_lwt (simple_error "error unparsing michelson result") @@
Memory_proto_alpha.unparse_michelson_data value ty Memory_proto_alpha.unparse_michelson_data value ty
let evaluate_michelson ?options program =
let%bind etv = evaluate ?options program in
ex_value_ty_to_michelson etv
let pack_payload (payload:Michelson.t) ty = let pack_payload (payload:Michelson.t) ty =
let%bind payload = let%bind payload =
Trace.trace_tzresult_lwt (simple_error "error parsing message") @@ Trace.trace_tzresult_lwt (simple_error "error parsing message") @@
@ -123,3 +59,72 @@ let pack_payload (payload:Michelson.t) ty =
Trace.trace_tzresult_lwt (simple_error "error packing message") @@ Trace.trace_tzresult_lwt (simple_error "error packing message") @@
Memory_proto_alpha.pack ty payload in Memory_proto_alpha.pack ty payload in
ok @@ data ok @@ data
let fetch_lambda_types (contract_ty:ex_ty) =
match contract_ty with
| Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty)
| _ -> simple_fail "failed to fetch lambda types"
let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) : ex_typed_value result =
let open! Tezos_raw_protocol_005_PsBabyM1 in
let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_lambda_types exp_type in
let%bind input =
Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
Memory_proto_alpha.parse_michelson_data input_michelson input_ty
in
let top_level = Script_ir_translator.Toplevel
{ storage_type = output_ty ; param_type = input_ty ;
root_name = None ; legacy_create_contract_literal = false } in
let ty_stack_before = Script_typed_ir.Item_t (input_ty, Empty_t, None) in
let ty_stack_after = Script_typed_ir.Item_t (output_ty, Empty_t, None) in
let exp = Michelson.strip_annots exp in
let%bind descr =
Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
Memory_proto_alpha.parse_michelson ~top_level exp ty_stack_before ty_stack_after in
let open! Memory_proto_alpha.Protocol.Script_interpreter in
let%bind (Item(output, Empty)) =
Trace.trace_tzresult_lwt (simple_error "error of execution") @@
Memory_proto_alpha.interpret ?options descr
(Item(input, Empty)) in
ok (Ex_typed_value (output_ty, output))
let run_expression ?options (exp:Michelson.t) (exp_type:ex_ty) : run_res result =
let open! Tezos_raw_protocol_005_PsBabyM1 in
let (Ex_ty exp_type') = exp_type in
let exp = Michelson.strip_annots exp in
let top_level = Script_ir_translator.Lambda
and ty_stack_before = Script_typed_ir.Empty_t
and ty_stack_after = Script_typed_ir.Item_t (exp_type', Empty_t, None) in
let%bind descr =
Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
Memory_proto_alpha.parse_michelson ~top_level exp ty_stack_before ty_stack_after in
let open! Memory_proto_alpha.Protocol.Script_interpreter in
let%bind res =
Trace.trace_tzresult_lwt (simple_error "error of execution") @@
Memory_proto_alpha.failure_interpret ?options descr Empty in
match res with
| Memory_proto_alpha.Succeed stack ->
let (Item(output, Empty)) = stack in
ok @@ Success (Ex_typed_value (exp_type', output))
| Memory_proto_alpha.Fail expr ->
ok (Fail expr)
let run ?options (exp:Michelson.t) (exp_type:ex_ty) : ex_typed_value result =
let%bind expr = run_expression ?options exp exp_type in
match expr with
| Success res -> ok res
| _ -> simple_fail "Execution terminated with failwith"
let run_failwith ?options (exp:Michelson.t) (exp_type:ex_ty) : run_failwith_res result =
let%bind expr = run_expression ?options exp exp_type in
match expr with
| Fail res -> ( match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims res with
| Int (_ , i) -> ok (Failwith_int (Z.to_int i))
| String (_ , s) -> ok (Failwith_string s)
| Bytes (_,b) -> ok (Failwith_bytes b)
| _ -> simple_fail "Unknown failwith type" )
| _ -> simple_fail "An error of execution was expected"
let evaluate_expression ?options exp exp_type =
let%bind etv = run ?options exp exp_type in
ex_value_ty_to_michelson etv

1
src/passes/6-transpiler/transpiler.mli
View File

@ -48,7 +48,6 @@ val translate_main : AST.lambda -> Location.t ->( anon_function * ( type_value *
(* From an expression [expr], build the expression [fun () -> expr] *) (* From an expression [expr], build the expression [fun () -> expr] *)
val translate_entry : AST.program -> string -> ( anon_function * ( type_value * type_value )) result val translate_entry : AST.program -> string -> ( anon_function * ( type_value * type_value )) result
val functionalize : AST.annotated_expression -> AST.lambda * AST.type_value
*) *)
val extract_constructor : value -> ( string * AST.type_value ) Append_tree.t' -> (string * value * AST.type_value) result val extract_constructor : value -> ( string * AST.type_value ) Append_tree.t' -> (string * value * AST.type_value) result
val extract_tuple : value -> AST.type_value Append_tree.t' -> (value * AST.type_value) list result val extract_tuple : value -> AST.type_value Append_tree.t' -> (value * AST.type_value) list result

48
src/passes/8-compiler/compiler_program.ml
View File

@ -449,49 +449,7 @@ and translate_function anon env input_ty output_ty : michelson result =
i_apply ; i_apply ;
] ]
type compiled_expression = {
type compiled_program = { expr_ty : ex_ty ;
input : ex_ty ; expr : michelson ;
output : ex_ty ;
body : michelson ;
} }
let get_main : program -> string -> (anon_function * _) result = fun p entry ->
let is_main ((( name , expr), _):toplevel_statement) =
match Combinators.Expression.(get_content expr , get_type expr)with
| (E_closure content , T_function ty)
when Var.equal name (Var.of_name entry) ->
Some (content , ty)
| _ -> None
in
let%bind main =
trace_option (simple_error "no functional entry") @@
List.find_map is_main p
in
ok main
let translate_program (p:program) (entry:string) : compiled_program result =
let%bind (main , (input , output)) = get_main p entry in
let%bind body = translate_function_body main [] input in
let%bind input = Compiler_type.Ty.type_ input in
let%bind output = Compiler_type.Ty.type_ output in
ok ({input;output;body}:compiled_program)
let translate_entry (p:anon_function) ty : compiled_program result =
let (input , output) = ty in
let%bind body =
trace (simple_error "compile entry body") @@
translate_function_body p [] input in
let%bind input = Compiler_type.Ty.type_ input in
let%bind output = Compiler_type.Ty.type_ output in
ok ({input;output;body}:compiled_program)
let translate_contract : anon_function -> _ -> michelson result = fun f ty ->
let%bind compiled_program =
trace_strong (corner_case ~loc:__LOC__ "compiling") @@
translate_entry f ty in
let%bind (param_ty , storage_ty) = Combinators.get_t_pair (fst ty) in
let%bind param_michelson = Compiler_type.type_ param_ty in
let%bind storage_michelson = Compiler_type.type_ storage_ty in
let contract = Michelson.contract param_michelson storage_michelson compiled_program.body in
ok contract

14
src/passes/8-compiler/compiler_program.mli
View File

@ -9,10 +9,9 @@ open Operators.Compiler
module Contract_types = Meta_michelson.Types module Contract_types = Meta_michelson.Types
module Stack = Meta_michelson.Stack module Stack = Meta_michelson.Stack
*) *)
type compiled_program = { type compiled_expression = {
input : ex_ty ; expr_ty : ex_ty ;
output : ex_ty ; expr : michelson ;
body : michelson ;
} }
val get_operator : constant -> type_value -> expression list -> predicate result val get_operator : constant -> type_value -> expression list -> predicate result
@ -20,13 +19,6 @@ val translate_expression : expression -> environment -> michelson result
val translate_function_body : anon_function -> environment_element list -> type_value -> michelson result val translate_function_body : anon_function -> environment_element list -> type_value -> michelson result
val translate_value : value -> type_value -> michelson result val translate_value : value -> type_value -> michelson result
val translate_program : program -> string -> compiled_program result
val translate_contract : anon_function -> (type_value * type_value ) -> michelson result
val translate_entry : anon_function -> type_value * type_value -> compiled_program result
(* (*
open Operators.Compiler open Operators.Compiler

12
src/passes/9-self_michelson/helpers.ml
View File

@ -17,3 +17,15 @@ let rec map_expression : mapper -> michelson -> michelson result = fun f e ->
ok @@ Seq (l , lst') ok @@ Seq (l , lst')
) )
| x -> ok x | x -> ok x
open Memory_proto_alpha.Protocol.Script_ir_translator
(* fetches lambda first and second parameter (parameter,storage) *)
let fetch_lambda_parameters : ex_ty -> (ex_ty * ex_ty) result =
let error () = simple_fail "failed to fetch lambda parameters" in
function
| Ex_ty (Lambda_t (in_ty, _, _)) -> (
match in_ty with
| Pair_t ((param_ty,_,_),(storage_ty,_,_),_,_) ->
ok (Ex_ty param_ty, Ex_ty storage_ty)
|_ -> error () )
| _ -> error ()

1
src/passes/9-self_michelson/self_michelson.ml
View File

@ -8,6 +8,7 @@
open Tezos_micheline.Micheline open Tezos_micheline.Micheline
open Tezos_utils.Michelson open Tezos_utils.Michelson
include Helpers
(* `arity p` should be `Some n` only if p is (always) an instruction (* `arity p` should be `Some n` only if p is (always) an instruction
which removes n items from the stack and uses them to push 1 item, which removes n items from the stack and uses them to push 1 item,

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

@ -120,14 +120,6 @@ module Free_variables = struct
end end
(*
Converts `expr` in `fun () -> expr`.
*)
let functionalize (body : expression) : expression =
let content = E_closure { binder = Var.fresh () ; body } in
let type_value = t_function t_unit body.type_value in
{ content ; type_value }
let get_entry (lst : program) (name : string) : (expression * int) result = let get_entry (lst : program) (name : string) : (expression * int) result =
let%bind entry_expression = let%bind entry_expression =
trace_option (Errors.missing_entry_point name) @@ trace_option (Errors.missing_entry_point name) @@
@ -148,29 +140,31 @@ let get_entry (lst : program) (name : string) : (expression * int) result =
in in
ok (entry_expression , entry_index) ok (entry_expression , entry_index)
(* (*
Assume the following code: Assume the following program:
``` ```
const x = 42 const x = 42
const y = 120 const y = 120
const z = 423
const f = () -> x + y const f = () -> x + y
``` ```
It is transformed in: aggregate_entry program "f" (Some [unit]) would return:
``` ```
const f = () ->
let x = 42 in let x = 42 in
let y = 120 in let y = 120 in
let z = 423 in const f = () -> x + y
x + y f(unit)
``` ```
The entry-point can be an expression, which is then functionalized if if arg_lst is None, it means that the entry point is not an arbitrary expression
`to_functionalize` is set to true.
*) *)
let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : expression result = type form_t =
let%bind (entry_expression , entry_index) = get_entry lst name in | ContractForm of (expression * int)
| ExpressionForm of ((expression * int) * expression list)
let aggregate_entry (lst : program) (form : form_t) : expression result =
let (entry_expression , entry_index, arg_lst) = match form with
| ContractForm (exp,i) -> (exp,i,[])
| ExpressionForm ((exp,i),argl) -> (exp,i,argl) in
let pre_declarations = List.until entry_index lst in let pre_declarations = List.until entry_index lst in
let wrapper = let wrapper =
let aux prec cur = let aux prec cur =
@ -179,23 +173,27 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) :
in in
fun expr -> List.fold_right' aux expr pre_declarations fun expr -> List.fold_right' aux expr pre_declarations
in in
match (entry_expression.content , to_functionalize) with match (entry_expression.content , arg_lst) with
| (E_closure l , false) -> ( | (E_closure _ , (hd::tl)) -> (
let l' = { l with body = wrapper l.body } in let%bind type_value' = match entry_expression.type_value with
let%bind t' = | T_function (_,t) -> ok t
let%bind (input_ty , output_ty) = get_t_function entry_expression.type_value in | _ -> simple_fail "Trying to aggregate closure which does not have function type" in
ok (t_function input_ty output_ty) let entry_expression' = List.fold_left
in (fun acc el ->
let e' = { let type_value' = match acc.type_value with
content = E_closure l' ; | T_function (_,t) -> t
type_value = t' ; | e -> e in
} in {
ok e' content = E_application (acc,el) ;
type_value = type_value' ;
}
) )
| (_ , true) -> ( {
ok @@ functionalize @@ wrapper entry_expression content = E_application (entry_expression, hd) ;
type_value = type_value' ;
} tl in
ok @@ wrapper entry_expression'
) )
| _ -> ( | (_ , _) -> (
Format.printf "Not functional: %a\n" PP.expression entry_expression ; ok @@ wrapper entry_expression
fail @@ Errors.not_functional_main name
) )

14
src/test/coase_tests.ml
View File

@ -4,7 +4,8 @@ open Trace
open Test_helpers open Test_helpers
let type_file f = let type_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
ok @@ (typed,state) ok @@ (typed,state)
let get_program = let get_program =
@ -18,6 +19,16 @@ let get_program =
ok program ok program
) )
let compile_main () =
let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/coase.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_mini_c.build_contract michelson_prg in
ok ()
open Ast_simplified open Ast_simplified
let card owner = let card owner =
@ -232,6 +243,7 @@ let sell () =
let main = test_suite "Coase (End to End)" [ let main = test_suite "Coase (End to End)" [
test "compile" compile_main ;
test "buy" buy ; test "buy" buy ;
test "dispatch buy" dispatch_buy ; test "dispatch buy" dispatch_buy ;
test "transfer" transfer ; test "transfer" transfer ;

2
src/test/contracts/high-order.ligo
View File

@ -48,3 +48,5 @@ function foobar5 (const i : int) : int is
function goo (const i : int) : int is function goo (const i : int) : int is
foo(i); foo(i);
} with higher3(i,foo,goo) } with higher3(i,foo,goo)
function foobar6 (const i : int) : (int->int) is f

12
src/test/heap_tests.ml
View File

@ -2,7 +2,8 @@ open Trace
open Test_helpers open Test_helpers
let type_file f = let type_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
ok @@ (typed,state) ok @@ (typed,state)
let get_program = let get_program =
@ -48,10 +49,11 @@ let dummy n =
) )
let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) = let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) =
let%bind program_mich = Compile.Wrapper.typed_to_michelson_program program entry_point in let%bind input_mini_c = Compile.Of_typed.compile_expression input in
let%bind input_mich = Compile.Wrapper.typed_expression_to_michelson_value_as_function input in let%bind mini_c = Compile.Of_typed.compile program in
let%bind input_eval = Run.Of_michelson.evaluate_michelson input_mich in let%bind program_mich = Compile.Of_mini_c.aggregate_and_compile_expression
let%bind res = Run.Of_michelson.run program_mich input_eval in mini_c (Entry_name entry_point) [input_mini_c] in
let%bind res = Run.Of_michelson.run program_mich.expr program_mich.expr_ty in
let%bind output_type = let%bind output_type =
let%bind entry_expression = Ast_typed.get_entry program entry_point in let%bind entry_expression = Ast_typed.get_entry program entry_point in
let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in

15
src/test/integration_tests.ml
View File

@ -4,15 +4,19 @@ open Test_helpers
open Ast_simplified.Combinators open Ast_simplified.Combinators
let retype_file f = let retype_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "reasonligo") f in let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "reasonligo") in
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
let () = Typer.Solver.discard_state state in
let () = Typer.Solver.discard_state state in let () = Typer.Solver.discard_state state in
ok typed ok typed
let mtype_file f = let mtype_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "cameligo") f in let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
let () = Typer.Solver.discard_state state in let () = Typer.Solver.discard_state state in
ok typed ok typed
let type_file f = let type_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
let () = Typer.Solver.discard_state state in let () = Typer.Solver.discard_state state in
ok typed ok typed
@ -184,6 +188,7 @@ let higher_order () : unit result =
let%bind _ = expect_eq_n_int program "foobar3" make_expect in let%bind _ = expect_eq_n_int program "foobar3" make_expect in
let%bind _ = expect_eq_n_int program "foobar4" make_expect in let%bind _ = expect_eq_n_int program "foobar4" make_expect in
let%bind _ = expect_eq_n_int program "foobar5" make_expect in let%bind _ = expect_eq_n_int program "foobar5" make_expect in
(* let%bind _ = applies_expect_eq_n_int program "foobar5" make_expect in *)
ok () ok ()
let higher_order_mligo () : unit result = let higher_order_mligo () : unit result =
@ -208,21 +213,17 @@ let higher_order_religo () : unit result =
let shared_function () : unit result = let shared_function () : unit result =
let%bind program = type_file "./contracts/function-shared.ligo" in let%bind program = type_file "./contracts/function-shared.ligo" in
Format.printf "inc\n" ;
let%bind () = let%bind () =
let make_expect = fun n -> (n + 1) in let make_expect = fun n -> (n + 1) in
expect_eq_n_int program "inc" make_expect expect_eq_n_int program "inc" make_expect
in in
Format.printf "double inc?\n" ;
let%bind () = let%bind () =
expect_eq program "double_inc" (e_int 0) (e_int 2) expect_eq program "double_inc" (e_int 0) (e_int 2)
in in
Format.printf "double incd!\n" ;
let%bind () = let%bind () =
let make_expect = fun n -> (n + 2) in let make_expect = fun n -> (n + 2) in
expect_eq_n_int program "double_inc" make_expect expect_eq_n_int program "double_inc" make_expect
in in
Format.printf "foo\n" ;
let%bind () = let%bind () =
let make_expect = fun n -> (2 * n + 3) in let make_expect = fun n -> (2 * n + 3) in
expect_eq program "foo" (e_int 0) (e_int @@ make_expect 0) expect_eq program "foo" (e_int 0) (e_int @@ make_expect 0)

13
src/test/multisig_tests.ml
View File

@ -2,7 +2,8 @@ open Trace
open Test_helpers open Test_helpers
let type_file f = let type_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
ok @@ (typed,state) ok @@ (typed,state)
let get_program = let get_program =
@ -16,9 +17,13 @@ let get_program =
) )
let compile_main () = let compile_main () =
let%bind program,_ = get_program () in let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/multisig.ligo" (Syntax_name "pascaligo") in
let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson 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_mini_c.build_contract michelson_prg in
ok () ok ()
open Ast_simplified open Ast_simplified

13
src/test/multisig_v2_tests.ml
View File

@ -2,7 +2,8 @@ open Trace
open Test_helpers open Test_helpers
let type_file f = let type_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
ok @@ (typed,state) ok @@ (typed,state)
let get_program = let get_program =
@ -16,9 +17,13 @@ let get_program =
) )
let compile_main () = let compile_main () =
let%bind program,_ = get_program () in let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/multisig-v2.ligo" (Syntax_name "pascaligo") in
let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson 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_mini_c.build_contract michelson_prg in
ok () ok ()
open Ast_simplified open Ast_simplified

51
src/test/test_helpers.ml
View File

@ -35,11 +35,13 @@ open Ast_simplified
let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result = let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result =
let%bind code = let%bind code =
let env = Ast_typed.program_environment program in let env = Ast_typed.program_environment program in
Compile.Wrapper.simplified_to_compiled_program let%bind (typed,_) = Compile.Of_simplified.compile_expression
~env ~state:(Typer.Solver.initial_state) payload in ~env ~state:(Typer.Solver.initial_state) payload in
let Compiler.Program.{input=_;output=(Ex_ty payload_ty);body=_} = code in let%bind mini_c = Compile.Of_typed.compile_expression typed in
Compile.Of_mini_c.compile_expression mini_c in
let (Ex_ty payload_ty) = code.expr_ty in
let%bind (payload: Tezos_utils.Michelson.michelson) = let%bind (payload: Tezos_utils.Michelson.michelson) =
Ligo.Run.Of_michelson.evaluate_michelson code in Ligo.Run.Of_michelson.evaluate_expression code.expr code.expr_ty in
Ligo.Run.Of_michelson.pack_payload payload payload_ty Ligo.Run.Of_michelson.pack_payload payload payload_ty
let sign_message (program:Ast_typed.program) (payload : expression) sk : string result = let sign_message (program:Ast_typed.program) (payload : expression) sk : string result =
@ -76,31 +78,23 @@ let sha_256_hash pl =
open Ast_simplified.Combinators open Ast_simplified.Combinators
let typed_program_with_simplified_input_to_michelson
(program: Ast_typed.program) (entry_point: string)
(input: Ast_simplified.expression) : Compiler.compiled_expression result =
let env = Ast_typed.program_environment program in
let state = Typer.Solver.initial_state in
let%bind (typed_in,_) = Compile.Of_simplified.compile_expression ~env ~state input in
let%bind mini_c_in = Compile.Of_typed.compile_expression typed_in in
let%bind mini_c_prg = Compile.Of_typed.compile program in
Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Entry_name entry_point) [mini_c_in]
let run_typed_program_with_simplified_input ?options let run_typed_program_with_simplified_input ?options
(program: Ast_typed.program) (entry_point: string) (program: Ast_typed.program) (entry_point: string)
(input: Ast_simplified.expression) : Ast_simplified.expression result = (input: Ast_simplified.expression) : Ast_simplified.expression result =
let env = Ast_typed.program_environment program in let%bind michelson_program = typed_program_with_simplified_input_to_michelson program entry_point input in
let%bind michelson_exp = Compile.Wrapper.simplified_to_compiled_program ~env ~state:(Typer.Solver.initial_state) input in let%bind michelson_output = Ligo.Run.Of_michelson.run ?options michelson_program.expr michelson_program.expr_ty in
let%bind evaluated_exp = Ligo.Run.Of_michelson.evaluate_michelson michelson_exp in
let%bind michelson_program = Compile.Wrapper.typed_to_michelson_program program entry_point in
let%bind michelson_output = Ligo.Run.Of_michelson.run ?options michelson_program evaluated_exp in
Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output
let expect_fail_typed_program_with_simplified_input ?options
(program: Ast_typed.program) (entry_point: string)
(input: Ast_simplified.expression) : Ligo.Run.Of_michelson.failwith_res Simple_utils__Trace.result =
let env = Ast_typed.program_environment program in
let%bind michelson_exp = Compile.Wrapper.simplified_to_compiled_program ~env ~state:(Typer.Solver.initial_state) input in
let%bind evaluated_exp = Ligo.Run.Of_michelson.evaluate_michelson michelson_exp in
let%bind michelson_program = Compile.Wrapper.typed_to_michelson_program program entry_point in
Ligo.Run.Of_michelson.get_exec_error ?options michelson_program evaluated_exp
let run_typed_value_as_function
(program: Ast_typed.program) (entry_point:string) : Ast_simplified.expression result =
let%bind michelson_value_as_f = Compile.Wrapper.typed_to_michelson_value_as_function program entry_point in
let%bind result = Ligo.Run.Of_michelson.evaluate michelson_value_as_f in
Uncompile.uncompile_typed_program_entry_expression_result program entry_point result
let expect ?options program entry_point input expecter = let expect ?options program entry_point input expecter =
let%bind result = let%bind result =
let run_error = let run_error =
@ -124,7 +118,9 @@ let expect_fail ?options program entry_point input =
run_typed_program_with_simplified_input ?options program entry_point input run_typed_program_with_simplified_input ?options program entry_point input
let expect_string_failwith ?options program entry_point input expected_failwith = let expect_string_failwith ?options program entry_point input expected_failwith =
let%bind err = expect_fail_typed_program_with_simplified_input ?options program entry_point input in let%bind michelson_program = typed_program_with_simplified_input_to_michelson program entry_point input in
let%bind err = Ligo.Run.Of_michelson.run_failwith
?options michelson_program.expr michelson_program.expr_ty in
match err with match err with
| Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s | Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s
| _ -> simple_fail "Expected to fail with a string" | _ -> simple_fail "Expected to fail with a string"
@ -147,8 +143,11 @@ let expect_evaluate program entry_point expecter =
let content () = Format.asprintf "Entry_point: %s" entry_point in let content () = Format.asprintf "Entry_point: %s" entry_point in
error title content in error title content in
trace error @@ trace error @@
let%bind result = run_typed_value_as_function program entry_point in let%bind mini_c = Ligo.Compile.Of_typed.compile program in
expecter result let%bind michelson_value = Ligo.Compile.Of_mini_c.aggregate_and_compile_expression mini_c (Entry_name entry_point) [] in
let%bind res_michelson = Ligo.Run.Of_michelson.run michelson_value.expr michelson_value.expr_ty in
let%bind res_simpl = Uncompile.uncompile_typed_program_entry_expression_result program entry_point res_michelson in
expecter res_simpl
let expect_eq_evaluate program entry_point expected = let expect_eq_evaluate program entry_point expected =
let expecter = fun result -> let expecter = fun result ->

3
src/test/vote_tests.ml
View File

@ -2,7 +2,8 @@ open Trace
open Test_helpers open Test_helpers
let type_file f = let type_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "cameligo") f in let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
ok @@ (typed,state) ok @@ (typed,state)
let get_program = let get_program =

9
vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml vendored
View File

@ -1096,6 +1096,15 @@ let interpret ?(options = default_options) (instr:('a, 'b) descr) (bef:'a stack)
Script_interpreter.step tezos_context step_constants instr bef >>=?? Script_interpreter.step tezos_context step_constants instr bef >>=??
fun (stack, _) -> return stack fun (stack, _) -> return stack
let unparse_ty_michelson ty =
Script_ir_translator.unparse_ty dummy_environment.tezos_context ty >>=??
fun (n,_) -> return n
let typecheck_contract contract =
let contract' = Tezos_micheline.Micheline.strip_locations contract in
Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>=??
fun _ -> return ()
type 'a interpret_res = type 'a interpret_res =
| Succeed of 'a stack | Succeed of 'a stack
| Fail of Script_repr.expr | Fail of Script_repr.expr