Merge branch 'dev' of https://gitlab.com/ligolang/ligo into rinderknecht@reasonligo_parsing

# Conflicts:
#	src/passes/1-parser/reasonligo/error.messages.checked-in
This commit is contained in:
Sander Spies 2020-03-24 14:10:30 +01:00
commit af319ba236
241 changed files with 13013 additions and 3891 deletions

View File

@ -17,7 +17,7 @@ services:
# - ./website/versioned_docs:/app/website/versioned_docs # - ./website/versioned_docs:/app/website/versioned_docs
- ./website/sidebars.json:/app/website/sidebars.json - ./website/sidebars.json:/app/website/sidebars.json
- ./website/docusaurus.config.js:/app/website/docusaurus.config.js - ./website/docusaurus.config.js:/app/website/docusaurus.config.js
- ./website/versions.json:/app/website/versions.json # - ./website/versions.json:/app/website/versions.json
# - ./website/core/AlgoliaSearch.js:/app/website/core/AlgoliaSearch.js # - ./website/core/AlgoliaSearch.js:/app/website/core/AlgoliaSearch.js
working_dir: /app/website working_dir: /app/website

View File

@ -10,6 +10,6 @@ Its files are in `parser/parser_name`.
## Concrete Syntax Tree ## Concrete Syntax Tree
The CST is the aforementioned structured representation of the program. Is is structurally very close to the source code, and is mostly an intermediary there because manipulating string is not practical. The CST is the aforementioned structured representation of the program. Is is structurally very close to the source code, and is mostly an intermediary there because manipulating string is not practical.
Its files are in `parser/parser_name`. Its files are in `parser/parser_name`.
## Simplifier ## Sugar_to_core
A Simplifier is a function that takes a CST and outputs the corresponding Common AST. This is the actual bridge between a given syntax and LIGO. A Sugar_to_core is a function that takes a CST and outputs the corresponding Common AST. This is the actual bridge between a given syntax and LIGO.
Its files are in `simplify/parser_name`. Its files are in `simplify/parser_name`.

View File

@ -6,7 +6,7 @@ title: Middle End
The Middle-End is the core of LIGO. It is also composed of three parts. The Middle-End is the core of LIGO. It is also composed of three parts.
## Common AST ## Common AST
The Common AST is the closest thing to what could be called “LIGO lang”. As such, it should be as simple as possible. Collapsing particular cases in more general constructs is encouraged. Documenting it is crucial for people wholl write new parsers or editor support for Front-end related things. The Common AST is the closest thing to what could be called “LIGO lang”. As such, it should be as simple as possible. Collapsing particular cases in more general constructs is encouraged. Documenting it is crucial for people wholl write new parsers or editor support for Front-end related things.
Its files are in `ast_simplified/`, of interest is the definition of the AST itself in `ast_simplified/types.ml`. Its files are in `ast_core/`, of interest is the definition of the AST itself in `ast_core/types.ml`.
## Type Checker ## Type Checker
The Type Checker, among other things, checks that a given AST is valid with regard to type-safety. It also annotates expressions with their types, free-variables and local environments. The Type Checker, among other things, checks that a given AST is valid with regard to type-safety. It also annotates expressions with their types, free-variables and local environments.
As time passes, we want to make the type-system stronger, to encode arbitrarily complex properties in an extensible manner. As time passes, we want to make the type-system stronger, to encode arbitrarily complex properties in an extensible manner.

View File

@ -102,7 +102,7 @@ What's going on is similar to the last program: `expect_eq_evaluate` runs a prog
For example, once the program stops running the value of `address` is `"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"`. The *comparison*, however, is made to a constructed expression. For example, once the program stops running the value of `address` is `"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"`. The *comparison*, however, is made to a constructed expression.
Remember that we're testing from OCaml, but the program is written and evaluated as LIGO. In order to provide a proper comparison, we convert our expected test values into LIGO expressions and data. Constructors such as `e_list` and `e_address` provide a bridge between LIGO and OCaml. Their definitions can be found in files such as [src/stages/ast_simplified/combinators.ml](https://gitlab.com/ligolang/ligo/blob/dev/src/stages/ast_simplified/combinators.ml), or using [Merlin's definition point finder](https://github.com/ocaml/merlin/wiki). These same functions are used during the simplification stage of LIGO compilation, so becoming familiar with them will help prepare you to work on the [front end](contributors/big-picture/front-end/). Remember that we're testing from OCaml, but the program is written and evaluated as LIGO. In order to provide a proper comparison, we convert our expected test values into LIGO expressions and data. Constructors such as `e_list` and `e_address` provide a bridge between LIGO and OCaml. Their definitions can be found in files such as [src/stages/ast_core/combinators.ml](https://gitlab.com/ligolang/ligo/blob/dev/src/stages/ast_core/combinators.ml), or using [Merlin's definition point finder](https://github.com/ocaml/merlin/wiki). These same functions are used during the simplification stage of LIGO compilation, so becoming familiar with them will help prepare you to work on the [front end](contributors/big-picture/front-end/).
## How To Write A Test For LIGO ## How To Write A Test For LIGO

View File

@ -0,0 +1,11 @@
---
id: faq
title: FAQ
---
# Frequently Asked Questions
Before you ask...
## Question One
Answer.

View File

@ -299,3 +299,78 @@ gitlab-pages/docs/language-basics/src/functions/incr_map.religo incr_map
</Syntax> </Syntax>
## Nested functions (also known as closures)
It's possible to place functions inside other functions. These functions
have access to variables in the same scope.
<Syntax syntax="pascaligo">
```pascaligo
function closure_example (const i : int) : int is
block {
function closure (const j : int) : int is i + j
} with closure (i)
```
</Syntax>
<Syntax syntax="cameligo">
```cameligo
let closure_example (i : int) : int =
let closure : int -> int = fun (j : int) -> i + j in
closure i
```
</Syntax>
<Syntax syntax="reasonligo">
```reasonligo
let closure_example = (i : int) : int => {
let closure = (j: int): int => i + j;
closure(i);
};
```
</Syntax>
## Recursive function
LIGO functions are not recursive by default, the user need to indicate that the function is recursive.
At the moment, recursive function are limited to one (possibly tupled) parameter and recursion is
limited to tail recursion (i.e the recursive call should be the last expression of the function)
<Syntax syntax="pascaligo">
In PascaLigo recursive functions are defined using the `recursive` keyword
```pascaligo group=d
recursive function sum (const n : int; const acc: int) : int is
if n<1 then acc else sum(n-1,acc+n)
recursive function fibo (const n: int; const n_1: int; const n_0 :int) : int is
if n<2 then n_1 else fibo(n-1,n_1+n_0,n_1)
```
</Syntax>
<Syntax syntax="cameligo">
In CameLigo recursive functions are defined using the `rec` keyword
```cameligo group=d
let rec sum ((n,acc):int * int) : int =
if (n < 1) then acc else sum (n-1, acc+n)
let rec fibo ((n,n_1,n_0):int*int*int) : int =
if (n < 2) then n_1 else fibo (n-1, n_1 + n_0, n_1)
```
</Syntax>
<Syntax syntax="reasonligo">
In ReasonLigo recursive functions are defined using the `rec` keyword
```reasonligo group=d
let rec sum = ((n, acc) : (int,int)): int =>
if (n < 1) {acc;} else {sum ((n-1,acc+n));};
let rec fibo = ((n, n_1, n_0) : (int,int,int)): int =>
if (n < 2) {n_1;} else {fibo ((n-1,n_1+n_0,n_1));};
```
</Syntax>

View File

@ -57,45 +57,21 @@ constant, therefore it makes no sense in CameLIGO to feature loops,
which we understand as syntactic constructs where the state of a which we understand as syntactic constructs where the state of a
stopping condition is mutated, as with "while" loops in PascaLIGO. stopping condition is mutated, as with "while" loops in PascaLIGO.
Instead, CameLIGO implements a *folded operation* by means of a Instead, CameLIGO loops are written by means of a tail recursive function
predefined function named `Loop.fold_while`. It takes an initial value
of a certain type, called an *accumulator*, and repeatedly calls a
given function, called *folded function*, that takes that
accumulator and returns the next value of the accumulator, until a
condition is met and the fold stops with the final value of the
accumulator. The iterated function needs to have a special type: if
the type of the accumulator is `t`, then it must have the type `bool *
t` (not simply `t`). It is the boolean value that denotes whether the
stopping condition has been reached.
Here is how to compute the greatest common divisors of two natural Here is how to compute the greatest common divisors of two natural
numbers by means of Euclid's algorithm: numbers by means of Euclid's algorithm:
```cameligo group=a ```cameligo group=a
let iter (x,y : nat * nat) : bool * (nat * nat) = let rec iter (x,y : nat * nat) : nat =
if y = 0n then false, (x,y) else true, (y, x mod y) if y = 0n then x else iter (y, x mod y)
let gcd (x,y : nat * nat) : nat = let gcd (x,y : nat * nat) : nat =
let x,y = if x < y then y,x else x,y in let x,y = if x < y then y,x else x,y in
let x,y = Loop.fold_while iter (x,y) iter (x,y)
in x
``` ```
To ease the writing and reading of the iterated functions (here, > Note that `fold_while`, `stop` and `continue` (now `Loop.resume`) are
`iter`), two predefined functions are provided: `Loop.resume` and
`Loop.stop`:
```cameligo group=a
let iter (x,y : nat * nat) : bool * (nat * nat) =
if y = 0n then Loop.stop (x,y) else Loop.resume (y, x mod y)
let gcd (x,y : nat * nat) : nat =
let x,y = if x < y then y,x else x,y in
let x,y = Loop.fold_while iter (x,y)
in x
```
> Note that `stop` and `continue` (now `Loop.resume`) are
> *deprecated*. > *deprecated*.
You can call the function `gcd` defined above using the LIGO compiler You can call the function `gcd` defined above using the LIGO compiler
@ -114,47 +90,22 @@ constant, therefore it makes no sense in ReasonLIGO to feature loops,
which we understand as syntactic constructs where the state of a which we understand as syntactic constructs where the state of a
stopping condition is mutated, as with "while" loops in PascaLIGO. stopping condition is mutated, as with "while" loops in PascaLIGO.
Instead, ReasonLIGO features a *fold operation* as a predefined Instead, ReasonLIGO loops are written by means of tail recursive functions
function named `Loop.fold_while`. It takes an initial value of a
certain type, called an *accumulator*, and repeatedly calls a given
function, called *iterated function*, that takes that accumulator and
returns the next value of the accumulator, until a condition is met
and the fold stops with the final value of the accumulator. The
iterated function needs to have a special type: if the type of the
accumulator is `t`, then it must have the type `bool * t` (not simply
`t`). It is the boolean value that denotes whether the stopping
condition has been reached.
Here is how to compute the greatest common divisors of two natural Here is how to compute the greatest common divisors of two natural
numbers by means of Euclid's algorithm: numbers by means of Euclid's algorithm:
```reasonligo group=a ```reasonligo group=a
let iter = ((x,y) : (nat, nat)) : (bool, (nat, nat)) => let rec iter = ((x,y) : (nat, nat)) : nat =>
if (y == 0n) { (false, (x,y)); } else { (true, (y, x mod y)); }; if (y == 0n) { x; } else { iter ((y, x mod y)); };
let gcd = ((x,y) : (nat, nat)) : nat => { let gcd = ((x,y) : (nat, nat)) : nat => {
let (x,y) = if (x < y) { (y,x); } else { (x,y); }; let (x,y) = if (x < y) { (y,x); } else { (x,y); };
let (x,y) = Loop.fold_while (iter, (x,y)); iter ((x,y))
x
}; };
``` ```
To ease the writing and reading of the iterated functions (here, > Note that `fold_while`, `stop` and `continue` (now `Loop.resume`) are
`iter`), two predefined functions are provided: `Loop.resume` and
`Loop.stop`:
```reasonligo group=b
let iter = ((x,y) : (nat, nat)) : (bool, (nat, nat)) =>
if (y == 0n) { Loop.stop ((x,y)); } else { Loop.resume ((y, x mod y)); };
let gcd = ((x,y) : (nat, nat)) : nat => {
let (x,y) = if (x < y) { (y,x); } else { (x,y); };
let (x,y) = Loop.fold_while (iter, (x,y));
x
};
```
> Note that `stop` and `continue` (now `Loop.resume`) are
> *deprecated*. > *deprecated*.
</Syntax> </Syntax>

View File

@ -1,25 +1,33 @@
--- ---
id: big-map-reference id: big-map-reference
title: Big Maps — Scalable Maps title: Big_map
description: A lazily deserialized map that's intended to store large amounts of data.
hide_table_of_contents: true
--- ---
import Syntax from '@theme/Syntax'; import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
Ordinary maps are fine for contracts with a finite lifespan or a A lazily deserialized map that's intended to store large amounts of data.
bounded number of users. For many contracts however, the intention is
to have a map holding *many* entries, potentially millions of
them. The cost of loading those 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
Michelson which handles the scaling concerns for us. In LIGO, the
interface for big maps is analogous to the one used for ordinary maps.
# Declaring a Map The gast costs of deserialized maps are higher than standard maps as data is lazily deserialized.
<SyntaxTitle syntax="pascaligo">
type big_map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type ('key, 'value) big_map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type big_map ('key, 'value)
</SyntaxTitle>
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=big_maps The type of a big map from values of type `key` to
values of type `value` is `big_map (key, value)`.
```pascaligo group=big_map
type move is int * int type move is int * int
type register is big_map (address, move) type register is big_map (address, move)
``` ```
@ -27,7 +35,10 @@ type register is big_map (address, move)
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=big_maps The type of a big map from values of type `key` to values
of type `value` is `(key, value) big_map`.
```cameligo group=big_map
type move = int * int type move = int * int
type register = (address, move) big_map type register = (address, move) big_map
``` ```
@ -35,59 +46,91 @@ type register = (address, move) big_map
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=big_maps The type of a big map from values of type `key` to
values of type `value` is `big_map (key, value)`.
```reasonligo group=big_map
type move = (int, int); type move = (int, int);
type register = big_map (address, move); type register = big_map (address, move);
``` ```
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function empty : big_map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val empty : ('key, 'value) big_map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let empty: big_map ('key, 'value)
</SyntaxTitle>
Create an empty big_map.
# Creating an Empty Big Map
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=big_maps ```pascaligo group=big_map
const empty : register = big_map [] const empty : register = Big_map.empty
```
Alternatively, you can also create an empty big_map using:
```pascaligo group=big_map
const empty_alternative : register = big_map []
``` ```
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=big_maps ```cameligo group=big_map
let empty : register = Big_map.empty let empty : register = Big_map.empty
``` ```
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=big_maps ```reasonligo group=big_map
let empty : register = Big_map.empty let empty : register = Big_map.empty
``` ```
</Syntax> </Syntax>
# Creating a Non-empty Map <SyntaxTitle syntax="pascaligo">
function literal : list ('key * 'value) -> big_map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val literal : ('key * 'value) list -> ('key, 'value) big_map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let literal: list(('key, 'value)) => big_map('key, 'value)
</SyntaxTitle>
Create a non-empty big_map.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=big_maps ```pascaligo group=big_map
const moves : register = const moves : register =
Big_map.literal (list [
(("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address), (1,2));
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (0,3))]);
```
Alternative way of creating an empty big_map:
```pascaligo group=big_map
const moves_alternative : register =
big_map [ big_map [
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) -> (1,2); ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) -> (1,2);
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) -> (0,3)] ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) -> (0,3)];
``` ```
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=big_maps ```cameligo group=big_map
let moves : register = let moves : register =
Big_map.literal [ Big_map.literal [
(("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address), (1,2)); (("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address), (1,2));
@ -97,7 +140,7 @@ let moves : register =
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=big_maps ```reasonligo group=big_map
let moves : register = let moves : register =
Big_map.literal ([ Big_map.literal ([
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address, (1,2)), ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address, (1,2)),
@ -106,21 +149,40 @@ let moves : register =
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function find_opt : 'key -> big_map ('key, 'value) -> option 'value
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val find_opt : 'key -> ('key, 'value) big_map -> 'value option
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let find_opt : ('key, big_map ('key, 'value)) => option ('value)
</SyntaxTitle>
# Accessing Values Retrieve a value from a big map with the given key.
Because the key may be missing in the big map, the result is an
*optional value*.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=big_maps ```pascaligo group=big_map
const my_balance : option (move) = const my_balance : option (move) =
moves [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address)] Big_map.find_opt (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), moves)
```
Alternatively:
```pascaligo group=big_map
const my_balance_alternative : option (move) =
moves [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address)];
``` ```
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=big_maps ```cameligo group=big_map
let my_balance : move option = let my_balance : move option =
Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) moves Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) moves
``` ```
@ -128,33 +190,62 @@ let my_balance : move option =
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=big_maps ```reasonligo group=big_map
let my_balance : option (move) = let my_balance : option (move) =
Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address, moves); Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address, moves);
``` ```
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function update : 'key -> option 'value -> big_map ('key, 'value) -> big_map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val update: 'key -> 'value option -> ('key, 'value) big_map -> ('key, 'value) big_map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let update: ('key, option('value), big_map ('key, 'value)) => big_map ('key, 'value)
</SyntaxTitle>
Note: when `None` is used as a value, the value is removed from the big_map.
# Updating Big Maps
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=big_maps ```pascaligo group=big_map
function add (var m : register) : register is const updated_big_map : register = Big_map.update(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some (4,9), moves);
```
Alternatively:
```pascaligo group=big_map
function update (var m : register) : register is
block { block {
m [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9) m [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9);
} with m } with m
const updated_map : register = add (moves)
``` ```
If multiple bindings need to be updated, PascaLIGO offers a *patch
instruction* for maps, similar to that for records.
```pascaligo group=big_map
function assignments (var m : register) : register is
block {
patch m with map [
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) -> (4,9);
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) -> (1,2)
]
} with m
```
> Note the use of the keyword `map` instead of `big_map` (which is not
> a keyword).
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=big_maps ```cameligo group=big_map
let updated_map : register = let updated_map : register =
Big_map.update Big_map.update
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) (Some (4,9)) moves ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) (Some (4,9)) moves
@ -163,7 +254,7 @@ let updated_map : register =
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=big_maps ```reasonligo group=big_map
let updated_map : register = let updated_map : register =
Big_map.update Big_map.update
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some ((4,9)), moves); (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some ((4,9)), moves);
@ -171,14 +262,64 @@ let updated_map : register =
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function add : 'key -> 'value -> big_map ('key, 'value) -> big_map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val add : 'key -> 'value -> ('key, 'value) big_map -> ('key, 'value) big_map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let add: ('key, 'value, big_map('key, 'value)) => big_map('key, 'value)
</SyntaxTitle>
<Syntax syntax="pascaligo">
# Removing Bindings ```pascaligo group=big_map
const added_item : register = Big_map.add (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (4, 9), moves)
```
</Syntax>
<Syntax syntax="cameligo">
```cameligo group=big_map
let add (m : register) : register =
Big_map.add
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) (4,9) m
```
</Syntax>
<Syntax syntax="reasonligo">
```reasonligo group=big_map
let add = (m: register): register =>
Big_map.add
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (4,9), m);
```
</Syntax>
<SyntaxTitle syntax="pascaligo">
function remove: 'key -> big_map ('key, 'value) -> big_map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val remove: 'key -> ('key, 'value) big_map -> ('key, 'value) big_map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let remove: ('key, big_map ('key, 'value)) => big_map ('key, 'value)
</SyntaxTitle>
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=big_maps ```pascaligo group=big_map
const updated_map : register =
Big_map.remove (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves)
```
Alternatively, the instruction `remove key from map m` removes the key
`key` from the big map `m` (note that the keyword is `map`, not
`big_map`).
```pascaligo group=big_map
function rem (var m : register) : register is function rem (var m : register) : register is
block { block {
remove ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) from map moves remove ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) from map moves
@ -190,17 +331,17 @@ const updated_map : register = rem (moves)
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=big_maps ```cameligo group=big_map
let updated_map : register = let updated_map : register =
Map.remove ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves Big_map.remove ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
``` ```
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=big_maps ```reasonligo group=big_map
let updated_map : register = let updated_map : register =
Map.remove (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves) Big_map.remove (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves)
``` ```
</Syntax> </Syntax>

View File

@ -0,0 +1,69 @@
---
id: bitwise-reference
title: Bitwise
description: Operations on bytes
hide_table_of_contents: true
---
import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
<SyntaxTitle syntax="pascaligo">
function and : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val and : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let and: (nat, nat) -> nat
</SyntaxTitle>
A bitwise `and` operation.
<SyntaxTitle syntax="pascaligo">
function or : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val or : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let or: (nat, nat) -> nat
</SyntaxTitle>
A bitwise `or` operation.
<SyntaxTitle syntax="pascaligo">
function xor : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val xor : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let xor: (nat, nat) -> nat
</SyntaxTitle>
A bitwise `xor` operation.
<SyntaxTitle syntax="pascaligo">
function shift_left : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val shift_left : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let shift_left: (nat, nat) -> nat
</SyntaxTitle>
A bitwise shift left operation.
<SyntaxTitle syntax="pascaligo">
function shift_right : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val shift_right : nat -> nat -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let shift_right: (nat, nat) -> nat
</SyntaxTitle>
A bitwise shift right operation.

View File

@ -1,21 +1,43 @@
--- ---
id: bytes-reference id: bytes-reference
title: Bytes — Manipulate bytes data title: Bytes
description: Operations on bytes
hide_table_of_contents: true
--- ---
import Syntax from '@theme/Syntax'; import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
## Bytes.concat(b1: bytes, b2: bytes) : bytes <SyntaxTitle syntax="pascaligo">
type bytes
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type bytes
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type bytes
</SyntaxTitle>
<SyntaxTitle syntax="pascaligo">
function concat : bytes -> bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val concat : bytes -> bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let concat: (bytes, bytes) => bytes
</SyntaxTitle>
Concatenate together two `bytes` arguments and return the result. Concatenate together two `bytes` arguments and return the result.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo ```pascaligo
function concat_op (const s : bytes) : bytes is function concat_op (const s : bytes) : bytes is Bytes.concat(s , 0x7070)
begin skip end with bytes_concat(s , 0x7070)
``` ```
> Note that `bytes_concat` is *deprecated*.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -33,41 +55,58 @@ let concat_op = (s: bytes): bytes => Bytes.concat(s, 0x7070);
</Syntax> </Syntax>
## Bytes.slice(pos1: nat, pos2: nat, data: bytes) : bytes <SyntaxTitle syntax="pascaligo">
function sub : nat -> nat -> bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val sub : nat -> nat -> bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let sub : (nat, nat, bytes) => bytes
</SyntaxTitle>
Extract the bytes between `pos1` and `pos2`. **Positions are zero indexed and Extract the bytes between `pos1` and `pos2`. **Positions are zero indexed and
inclusive**. For example if you gave the input "ff7a7aff" to the following: inclusive**. For example if you gave the input "ff7a7aff" to the following:
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo ```pascaligo
function slice_op (const s : bytes) : bytes is function slice_op (const s : bytes) : bytes is Bytes.sub(1n , 2n , s)
begin skip end with bytes_slice(1n , 2n , s)
``` ```
> Note that `bytes_slice` is *deprecated*.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo ```cameligo
let slice_op (s : bytes) : bytes = let slice_op (s : bytes) : bytes = Bytes.sub 1n 2n s
Bytes.slice 1n 2n s
``` ```
> Note that `Bytes.slice` is *deprecated*.
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
``` ```
let slice_op = (s: bytes): bytes => Bytes.slice(1n, 2n, s); let slice_op = (s: bytes): bytes => Bytes.sub(1n, 2n, s);
``` ```
> Note that `Bytes.slice` is *deprecated*.
</Syntax> </Syntax>
It would return "7a7a" rather than "ff7a" or "ff" or "7a". It would return "7a7a" rather than "ff7a" or "ff" or "7a".
## Bytes.pack(data: a') : bytes <SyntaxTitle syntax="pascaligo">
function pack : 'a -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val pack : 'a -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let pack : 'a => bytes
</SyntaxTitle>
Converts Michelson data structures to a binary format for serialization. Converts Michelson data structures to a binary format for serialization.
@ -105,10 +144,19 @@ let id_string = (p: string) : option(string) => {
</Syntax> </Syntax>
## Bytes.unpack(packed: bytes) : a' <SyntaxTitle syntax="pascaligo">
function unpack : bytes -> option 'a
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val unpack : bytes -> 'a option
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let unpack: bytes => option('a)
</SyntaxTitle>
Reverses the result of using `unpack` on data, going from Michelson's binary Reverses the result of using `pack` on data.
serialization format to the `option` type annotated on the call.
As the conversion might fail an option type is returned.
> ⚠️ `PACK` and `UNPACK` are features of Michelson that are intended to be used by people that really know what they're doing. There are several failure cases (such as `UNPACK`ing a lambda from an untrusted source), most of which are beyond the scope of this document. Don't use these functions without doing your homework first. > ⚠️ `PACK` and `UNPACK` are features of Michelson that are intended to be used by people that really know what they're doing. There are several failure cases (such as `UNPACK`ing a lambda from an untrusted source), most of which are beyond the scope of this document. Don't use these functions without doing your homework first.
@ -143,3 +191,12 @@ let id_string = (p: string) : option(string) => {
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function length : bytes -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val length : bytes -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let length: bytes => nat
</SyntaxTitle>

View File

@ -1,11 +1,58 @@
--- ---
id: crypto-reference id: crypto-reference
title: Crypto — Cryptographic functions title: Crypto
description: Cryptographic operations
hide_table_of_contents: true
--- ---
import Syntax from '@theme/Syntax'; import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
## Crypto.blake2b(data: bytes): bytes <SyntaxTitle syntax="pascaligo">
type key
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type key
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type key
</SyntaxTitle>
A public cryptographic key.
<SyntaxTitle syntax="pascaligo">
type key_hash
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type key_hash
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type key_hash
</SyntaxTitle>
The hash of a public cryptographic key.
<SyntaxTitle syntax="pascaligo">
type signature
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type signature
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type signature
</SyntaxTitle>
A cryptographic signature.
<SyntaxTitle syntax="pascaligo">
function blake2b : bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val blake2b : bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let blake2b: bytes => bytes
</SyntaxTitle>
Runs the [blake2b hash algorithm](https://en.wikipedia.org/wiki/BLAKE_(hash_function)#BLAKE2) Runs the [blake2b hash algorithm](https://en.wikipedia.org/wiki/BLAKE_(hash_function)#BLAKE2)
over the given `bytes` data and returns a `bytes` representing the hash. over the given `bytes` data and returns a `bytes` representing the hash.
@ -15,9 +62,11 @@ over the given `bytes` data and returns a `bytes` representing the hash.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo ```pascaligo
function hasherman_blake (const s: bytes) : bytes is blake2b(s) function hasherman_blake (const s: bytes) : bytes is Crypto.blake2b(s)
``` ```
> Note that `blake2b` is *deprecated*. Please use `Crypto.blake2b`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -25,6 +74,8 @@ function hasherman_blake (const s: bytes) : bytes is blake2b(s)
let hasherman_blake (s: bytes) : bytes = Crypto.blake2b s let hasherman_blake (s: bytes) : bytes = Crypto.blake2b s
``` ```
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
@ -34,8 +85,15 @@ let hasherman_blake = (s: bytes) => Crypto.blake2b(s);
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
## Crypto.sha256(data: bytes) : bytes function sha256 : bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val sha256 : bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let sha256: bytes => bytes
</SyntaxTitle>
Runs the [sha256 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the given Runs the [sha256 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the given
`bytes` data and returns a `bytes` representing the hash. `bytes` data and returns a `bytes` representing the hash.
@ -45,10 +103,11 @@ Runs the [sha256 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the g
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo ```pascaligo
function hasherman (const s : bytes) : bytes is function hasherman (const s : bytes) : bytes is Crypto.sha256(s)
begin skip end with sha_256(s)
``` ```
> Note that `sha_256` is *deprecated*. Please use `Crypto.sha256`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -66,8 +125,15 @@ let hasherman = (s: bytes): bytes => Crypto.sha256(s);
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
## Crypto.sha512(data: bytes) : bytes function sha512 : bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val sha512 : bytes -> bytes
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let sha512: bytes => bytes
</SyntaxTitle>
Runs the [sha512 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the given Runs the [sha512 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the given
`bytes` data and returns a `bytes` representing the hash. `bytes` data and returns a `bytes` representing the hash.
@ -77,9 +143,11 @@ Runs the [sha512 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the g
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo ```pascaligo
function hasherman512 (const s: bytes) : bytes is sha_512(s) function hasherman512 (const s: bytes) : bytes is Crypto.sha512(s)
``` ```
> Note that `sha_512` is *deprecated*. Please use `Crypto.sha512`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -96,8 +164,15 @@ let hasherman512 = (s: bytes) => Crypto.sha512(s);
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
## Crypto.hash_key(k: key) : key_hash function hash_key : key -> key_hash
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val hash_key : key -> key_hash
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let hash_key: key => key_hash
</SyntaxTitle>
Hashes a key for easy comparison and storage. Hashes a key for easy comparison and storage.
@ -108,11 +183,13 @@ Hashes a key for easy comparison and storage.
```pascaligo ```pascaligo
function check_hash_key (const kh1 : key_hash; const k2 : key) : bool * key_hash is block { function check_hash_key (const kh1 : key_hash; const k2 : key) : bool * key_hash is block {
var ret : bool := False ; var ret : bool := False ;
var kh2 : key_hash := crypto_hash_key(k2) ; var kh2 : key_hash := Crypto.hash_key(k2) ;
if kh1 = kh2 then ret := True else skip; if kh1 = kh2 then ret := True else skip;
} with (ret, kh2) } with (ret, kh2)
``` ```
> Note that `hash_key` is *deprecated*. Please use `Crypto.hash_key`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -141,8 +218,15 @@ let check_hash_key = ((kh1, k2): (key_hash, key)) : (bool, key_hash) => {
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
## Crypto.check(pk: key, signed: signature, data: bytes) : bool function check : key -> signature -> bytes -> bool
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val check : key -> signature -> bytes -> bool
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let check: (key, signature, bytes) => bool
</SyntaxTitle>
Check that a message has been signed by a particular key. Check that a message has been signed by a particular key.
@ -157,9 +241,11 @@ function check_signature
(const pk: key; (const pk: key;
const signed: signature; const signed: signature;
const msg: bytes) : bool const msg: bytes) : bool
is crypto_check(pk, signed, msg) is Crypto.check(pk, signed, msg)
``` ```
> Note that `crypto_check` is *deprecated*. Please use `Crypto.check`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">

View File

@ -1,11 +1,96 @@
--- ---
id: current-reference id: current-reference
title: Tezos - Things relating to the current execution context title: Tezos
description: General operations for Tezos
hide_table_of_contents: true
--- ---
import Syntax from '@theme/Syntax'; import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
# Tezos.balance <SyntaxTitle syntax="pascaligo">
type timestamp
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type timestamp
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type timestamp
</SyntaxTitle>
A date in the real world.
<SyntaxTitle syntax="pascaligo">
type mutez
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type mutez
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type mutez
</SyntaxTitle>
A specific type for tokens.
<SyntaxTitle syntax="pascaligo">
type address
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type address
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type address
</SyntaxTitle>
An untyped address which can refer to a smart contract or account.
<SyntaxTitle syntax="pascaligo">
type contract('parameter)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type 'parameter contract
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type contract('parameter)
</SyntaxTitle>
A typed contract.
Use `unit` as `parameter` to indicate an implicit account.
<SyntaxTitle syntax="pascaligo">
type operation
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type operation
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type operation
</SyntaxTitle>
An operation emitted by the contract
<SyntaxTitle syntax="pascaligo">
type chain_id
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type chain_id
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type chain_id
</SyntaxTitle>
The identifier of a chain, used to indicate test or main chains.
<SyntaxTitle syntax="pascaligo">
function balance : mutez
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val balance : mutez
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let balance: mutez
</SyntaxTitle>
Get the balance for the contract. Get the balance for the contract.
@ -42,7 +127,15 @@ let main = ((p,s) : (unit, tez)) =>
</Syntax> </Syntax>
## Tezos.now <SyntaxTitle syntax="pascaligo">
function now : timestamp
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val now : timestamp
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let now: timestamp
</SyntaxTitle>
Returns the current time as a [unix timestamp](https://en.wikipedia.org/wiki/Unix_time). Returns the current time as a [unix timestamp](https://en.wikipedia.org/wiki/Unix_time).
@ -64,7 +157,7 @@ const some_date: timestamp = ("2000-01-01T10:10:10Z" : timestamp);
const one_day_later: timestamp = some_date + one_day; const one_day_later: timestamp = some_date + one_day;
``` ```
> Note that `now` is *deprecated*. > Note that `now` is *deprecated*. Please use `Tezos.now`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -106,7 +199,7 @@ const one_day: int = 86_400;
const in_24_hrs: timestamp = today - one_day; const in_24_hrs: timestamp = today - one_day;
``` ```
> Note that `now` is *deprecated*. > Note that `now` is *deprecated*. Please use `Tezos.now`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -145,7 +238,7 @@ for numbers
const not_tommorow: bool = (Tezos.now = in_24_hrs) const not_tommorow: bool = (Tezos.now = in_24_hrs)
``` ```
> Note that `now` is *deprecated*. > Note that `now` is *deprecated*. Please use `Tezos.now`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -169,7 +262,15 @@ let not_tomorrow: bool = (Tezos.now == in_24_hrs);
## Amount <SyntaxTitle syntax="pascaligo">
function amount : mutez
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val amount : mutez
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let amount: mutez
</SyntaxTitle>
Get the amount of tez provided by the sender to complete this Get the amount of tez provided by the sender to complete this
transaction. transaction.
@ -207,7 +308,15 @@ let threshold = (p : unit) : int =>
</Syntax> </Syntax>
## Sender <SyntaxTitle syntax="pascaligo">
function sender : address
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val sender : address
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let sender: address
</SyntaxTitle>
Get the address that initiated the current transaction. Get the address that initiated the current transaction.
@ -219,7 +328,7 @@ Get the address that initiated the current transaction.
function main (const p : unit) : address is Tezos.sender function main (const p : unit) : address is Tezos.sender
``` ```
> Note that `sender` is *deprecated*. > Note that `sender` is *deprecated*. Please use `Tezos.sender`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -243,7 +352,15 @@ let main = (p : unit) : address => Tezos.sender;
## Address <SyntaxTitle syntax="pascaligo">
function address : contract 'a -> address
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val address : 'a contract -> address
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let address: contract('a) => address
</SyntaxTitle>
Get the address associated with a value of type `contract`. Get the address associated with a value of type `contract`.
@ -257,7 +374,7 @@ function main (const p : key_hash) : address is block {
} with Tezos.address(c) } with Tezos.address(c)
``` ```
> Note that `implicit_account` and `address` are *deprecated*. > Note that `implicit_account` and `address` are *deprecated*. Please use `Tezos.implicit_account` and `Tezos.address` instead.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -287,7 +404,15 @@ let main = (p : key_hash) : address => {
</Syntax> </Syntax>
## Self Address <SyntaxTitle syntax="pascaligo">
function self_address : address
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val self_address : address
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let self_address: address
</SyntaxTitle>
Get the address of the currently running contract. Get the address of the currently running contract.
@ -299,7 +424,7 @@ Get the address of the currently running contract.
function main (const p : unit) : address is Tezos.self_address function main (const p : unit) : address is Tezos.self_address
``` ```
> Note that `self_address` is *deprecated*. > Note that `self_address` is *deprecated*. Please use `Tezos.self_address`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -320,8 +445,15 @@ let main = (p : unit) : address => Tezos.self_address;
> Note that `Current.self_address` is *deprecated*. > Note that `Current.self_address` is *deprecated*.
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
## Self function self : string -> contract 'a
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val self : string -> 'a contract
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let self: string => contract('a)
</SyntaxTitle>
Typecast the currently running contract with an entrypoint annotation. Typecast the currently running contract with an entrypoint annotation.
If your are using entrypoints: use "%bar" for constructor Bar If your are using entrypoints: use "%bar" for constructor Bar
@ -353,13 +485,21 @@ let main = (p: unit) : contract(unit) =>
</Syntax> </Syntax>
## Implicit Account <SyntaxTitle syntax="pascaligo">
function implicit_account : key_hash -> contract 'a
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val implicit_account : key_hash -> 'a contract
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let implicit_account: key_hash => contract('a)
</SyntaxTitle>
Get the default contract associated with an on-chain key-pair. This Get the default contract associated with an on-chain key-pair. This
contract does not execute code, instead it exists to receive tokens on contract does not execute code, instead it exists to receive tokens on
behalf of a key's owner. behalf of a key's owner.
See also: http://tezos.gitlab.io/user/glossary.html#implicit-account
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
@ -368,7 +508,7 @@ function main (const kh: key_hash) : contract (unit) is
Tezos.implicit_account (kh) Tezos.implicit_account (kh)
``` ```
> Note that `implicit_account` is *deprecated*. > Note that `implicit_account` is *deprecated*. Please use `Tezos.implicit_account`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -392,7 +532,15 @@ let main = (kh : key_hash): contract (unit) =>
</Syntax> </Syntax>
## Source <SyntaxTitle syntax="pascaligo">
function source : address
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val source : address
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let source: address
</SyntaxTitle>
Get the _originator_ (address) of the current transaction. That is, if Get the _originator_ (address) of the current transaction. That is, if
a chain of transactions led to the current execution get the address a chain of transactions led to the current execution get the address
@ -426,7 +574,7 @@ current transaction.
function main (const p: unit) : address is Tezos.source function main (const p: unit) : address is Tezos.source
``` ```
> Note that `source` is *deprecated*. > Note that `source` is *deprecated*. Please use `Tezos.source`.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -449,7 +597,15 @@ let main = (p : unit) : address => Tezos.source;
</Syntax> </Syntax>
## Failwith <SyntaxTitle syntax="pascaligo">
function failwith : string -> unit
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
function failwith : string -> unit
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
function failwith : string -> unit
</SyntaxTitle>
Cause the contract to fail with an error message. Cause the contract to fail with an error message.
@ -485,3 +641,125 @@ let main = ((p,s) : (int, unit)) =>
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function chain_id : chain_id
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val chain_id : chain_id
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let chain_id: chain_id
</SyntaxTitle>
Get the identifier of the chain to distinguish between main and test chains.
This is mainly intended to avoid replay attacks between the chains, and can currently
only be used together with `Bytes.pack` and `Bytes.unpack`.
<Syntax syntax="pascaligo">
```pascaligo
type storage is bytes
function main (const ignore : unit; const storage: storage) :
(list(operation) * storage) is block {
const packed : bytes = Bytes.pack (Tezos.chain_id);
if (storage =/= packed) then {
failwith("wrong chain")
} else
skip;
} with ((nil: list(operation)), packed)
```
</Syntax>
<Syntax syntax="cameligo">
```cameligo
type storage = bytes
let main ((ignore, storage): (unit * storage)) =
let packed = Bytes.pack Tezos.chain_id in
if (storage <> packed) then
(failwith "wrong chain" : (operation list * storage))
else
(([]: operation list), (packed: storage))
```
</Syntax>
<Syntax syntax="reasonligo">
```reasonligo
type storage = bytes;
let main = ((ignore, storage): (unit, storage)) => {
let packed = Bytes.pack(Tezos.chain_id);
if (storage != packed) {
(failwith("wrong chain"): (list(operation), storage));
} else {
([]: list(operation), packed);
}
};
```
</Syntax>
<SyntaxTitle syntax="pascaligo">
function transaction : 'parameter -> mutez -> contract('parameter) -> operation
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val transaction : 'parameter -> mutez -> 'parameter contract -> operation
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let transaction: 'parameter -> mutez -> contract('parameter) -> operation
</SyntaxTitle>
Create a transaction to a contract or account.
To indicate an account, use `unit` as `parameter`.
<SyntaxTitle syntax="pascaligo">
function set_delegate : option(key_hash) -> operation
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val set_delegate : key_hash option -> operation
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let set_delegate: option(key_hash) => operation
</SyntaxTitle>
Create a delegation.
See also: http://tezos.gitlab.io/user/glossary.html?highlight=delegate#delegate
<SyntaxTitle syntax="pascaligo">
function get_contract_opt : address -> option(contract('parameter))
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val get_contract_opt : address -> 'parameter contract option
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let get_contract_opt : address => option(contract('parameter))
</SyntaxTitle>
Get a contract from an address.
When no contract is found or the contract doesn't match the type,
`None` is returned.
<SyntaxTitle syntax="pascaligo">
function get_entrypoint_opt : string -> address -> option(contract('parameter))
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
function get_entrypoint_opt : string -> address -> 'parameter contract option
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
function get_entrypoint_opt: (string, address) => option(contract('parameter))
</SyntaxTitle>
Get a contract from an address and entrypoint.
Entrypoints are written in the form of: `%entrypoint`.
When no contract is found or the contract doesn't match the type,
`None` is returned.

View File

@ -1,96 +1,62 @@
--- ---
id: list-reference id: list-reference
title: Lists — Linear Collections title: List
description: List operations
hide_table_of_contents: true
--- ---
import Syntax from '@theme/Syntax'; import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
Lists are linear collections of elements of the same type. Linear <SyntaxTitle syntax="pascaligo">
means that, in order to reach an element in a list, we must visit all type list ('t)
the elements before (sequential access). Elements can be repeated, as </SyntaxTitle>
only their order in the collection matters. The first element is <SyntaxTitle syntax="cameligo">
called the *head*, and the sub-list after the head is called the type 't list
*tail*. For those familiar with algorithmic data structure, you can </SyntaxTitle>
think of a list a *stack*, where the top is written on the left. <SyntaxTitle syntax="reasonligo">
type list('t)
</SyntaxTitle>
# Defining Lists A sequence of elements of the same type.
<SyntaxTitle syntax="pascaligo">
function length : nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val length : nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let length: nat
</SyntaxTitle>
<Syntax syntax="pascaligo"> Get the number of elements in a list.
```pascaligo group=lists <SyntaxTitle syntax="pascaligo">
const empty_list : list (int) = nil // Or list [] function size : nat
const my_list : list (int) = list [1; 2; 2] // The head is 1 </SyntaxTitle>
``` <SyntaxTitle syntax="cameligo">
val size : nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let size: nat
</SyntaxTitle>
</Syntax> Get the number of elements in a list.
<Syntax syntax="cameligo">
```cameligo group=lists Synonym for `List.length`.
let empty_list : int list = []
let my_list : int list = [1; 2; 2] // The head is 1
```
</Syntax>
<Syntax syntax="reasonligo">
```reasonligo group=lists
let empty_list : list (int) = [];
let my_list : list (int) = [1, 2, 2]; // The head is 1
```
</Syntax>
# Adding to Lists
Lists can be augmented by adding an element before the head (or, in
terms of stack, by *pushing an element on top*).
<Syntax syntax="pascaligo">
```pascaligo group=lists
const larger_list : list (int) = 5 # my_list // [5;1;2;2]
```
</Syntax>
<Syntax syntax="cameligo">
```cameligo group=lists
let larger_list : int list = 5 :: my_list // [5;1;2;2]
```
</Syntax>
<Syntax syntax="reasonligo">
```reasonligo group=lists
let larger_list : list (int) = [5, ...my_list]; // [5,1,2,2]
```
</Syntax>
# Functional Iteration over Lists
A *functional iterator* is a function that traverses a data structure
and calls in turn a given function over the elements of that structure
to compute some value. Another approach is possible in PascaLIGO:
*loops* (see the relevant section).
There are three kinds of functional iterations over LIGO lists: the
*iterated operation*, the *map operation* (not to be confused with the
*map data structure*) and the *fold operation*.
## Iterated Operation over Lists
The first, the *iterated operation*, is an iteration over the list
with a unit return value. It is useful to enforce certain invariants
on the element of a list, or fail.
<SyntaxTitle syntax="pascaligo">
function iter : ('a -> unit) -> list('a) -> unit
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val iter : ('a -> unit) -> 'a list -> unit
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let iter: (('a => unit), list('a)) => unit
</SyntaxTitle>
Iterate over items in a list.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
@ -104,6 +70,8 @@ function iter_op (const l : list (int)) : unit is
> Note that `list_iter` is *deprecated*. > Note that `list_iter` is *deprecated*.
Alternatively it's also possible to use [loops](../language-basics/loops.md).
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -126,17 +94,23 @@ let iter_op = (l : list (int)) : unit => {
</Syntax> </Syntax>
## Mapped Operation over Lists <SyntaxTitle syntax="pascaligo">
function map : ('a -> 'b) -> list('a) -> list('b)
We may want to change all the elements of a given list by applying to </SyntaxTitle>
them a function. This is called a *map operation*, not to be confused <SyntaxTitle syntax="cameligo">
with the map data structure. val map : ('a -> 'b) -> 'a list -> 'b list
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let map: (('a => 'b), list('a)) => list('b)
</SyntaxTitle>
Apply a function to items of a list to create a new list.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=lists ```pascaligo group=lists
const larger_list: list(int) = list [1; 2; 3]
function increment (const i : int): int is i + 1 function increment (const i : int): int is i + 1
// Creates a new list with all elements incremented by 1 // Creates a new list with all elements incremented by 1
@ -149,6 +123,8 @@ const plus_one : list (int) = List.map (increment, larger_list)
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=lists ```cameligo group=lists
let larger_list: int list = [1; 2; 3]
let increment (i : int) : int = i + 1 let increment (i : int) : int = i + 1
// Creates a new list with all elements incremented by 1 // Creates a new list with all elements incremented by 1
@ -159,6 +135,8 @@ let plus_one : int list = List.map increment larger_list
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=lists ```reasonligo group=lists
let larger_list: list(int) = [1, 2, 3];
let increment = (i : int) : int => i + 1; let increment = (i : int) : int => i + 1;
// Creates a new list with all elements incremented by 1 // Creates a new list with all elements incremented by 1
@ -167,22 +145,25 @@ let plus_one : list (int) = List.map (increment, larger_list);
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function fold : (('accumulator -> 'item -> 'accumulator) -> list('item) -> 'accumulator) -> 'accumulator
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val fold : ('accumulator -> 'item -> 'accumulator) -> 'item list -> 'accumulator -> 'accumulator
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let fold: ((('accumulator, 'item) => 'accumulator), list('item), 'accumulator) => 'accumulator
</SyntaxTitle>
[Fold over items in a list](../language-basics/sets-lists-tuples#folded-operation-over-lists);
## Folded Operation over Lists
A *folded operation* is the most general of iterations. The folded
function takes two arguments: an *accumulator* and the structure
*element* at hand, with which it then produces a new accumulator. This
enables having a partial result that becomes complete when the
traversal of the data structure is over.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=lists ```pascaligo group=lists
const my_list: list(int) = list [1; 2; 3]
function sum (const acc : int; const i : int): int is acc + i function sum (const acc : int; const i : int): int is acc + i
const sum_of_elements : int = List.fold (sum, my_list, 0) const sum_of_elements : int = List.fold (sum, my_list, 0)
``` ```
@ -192,7 +173,10 @@ const sum_of_elements : int = List.fold (sum, my_list, 0)
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=lists ```cameligo group=lists
let sum (acc, i: int * int) : int = acc + i let my_list : int list = [1; 2; 3]
let sum (acc, i : int * int) : int = acc + i
let sum_of_elements : int = List.fold sum my_list 0 let sum_of_elements : int = List.fold sum my_list 0
``` ```
@ -200,40 +184,11 @@ let sum_of_elements : int = List.fold sum my_list 0
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=lists ```reasonligo group=lists
let my_list : list(int) = [1, 2, 3];
let sum = ((result, i): (int, int)): int => result + i; let sum = ((result, i): (int, int)): int => result + i;
let sum_of_elements : int = List.fold (sum, my_list, 0); let sum_of_elements : int = List.fold (sum, my_list, 0);
``` ```
</Syntax> </Syntax>
# List Length
Get the number of elements in a list.
<Syntax syntax="pascaligo">
```pascaligo
function size_of (const l : list (int)) : nat is List.length (l)
```
> Note that `size` is *deprecated*.
</Syntax>
<Syntax syntax="cameligo">
```cameligo
let size_of (l : int list) : nat = List.length l
```
</Syntax>
<Syntax syntax="reasonligo">
```reasonligo
let size_of = (l : list (int)) : nat => List.length (l);
```
</Syntax>

View File

@ -1,22 +1,28 @@
--- ---
id: map-reference id: map-reference
title: Maps title: Map
description: Map operations
hide_table_of_contents: true
--- ---
import Syntax from '@theme/Syntax'; import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
*Maps* are a data structure which associate values of the same type to <SyntaxTitle syntax="pascaligo">
values of the same type. The former are called *key* and the latter type map ('key, 'value)
*values*. Together they make up a *binding*. An additional requirement </SyntaxTitle>
is that the type of the keys must be *comparable*, in the Michelson <SyntaxTitle syntax="cameligo">
sense. type ('key, 'value) map
</SyntaxTitle>
# Declaring a Map <SyntaxTitle syntax="reasonligo">
type map ('key, 'value)
</SyntaxTitle>
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
The type of a map from values of type `key` to
values of type `value` is `map (key, value)`.
```pascaligo group=maps ```pascaligo group=maps
type move is int * int type move is int * int
type register is map (address, move) type register is map (address, move)
@ -25,6 +31,9 @@ type register is map (address, move)
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
The type of a map from values of type `key` to values
of type `value` is `(key, value) map`.
```cameligo group=maps ```cameligo group=maps
type move = int * int type move = int * int
type register = (address, move) map type register = (address, move) map
@ -33,6 +42,9 @@ type register = (address, move) map
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
The type of a map from values of type `key` to
values of type `value` is `map (key, value)`.
```reasonligo group=maps ```reasonligo group=maps
type move = (int, int); type move = (int, int);
type register = map (address, move); type register = map (address, move);
@ -40,13 +52,26 @@ type register = map (address, move);
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function empty : map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val empty : ('key, 'value) map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let empty: map('key, 'value)
</SyntaxTitle>
# Creating an Empty Map Create an empty map.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=maps
const empty : register = Map.empty
```
Or
```pascaligo group=maps ```pascaligo group=maps
const empty : register = map [] const empty : register = map []
``` ```
@ -68,16 +93,34 @@ let empty : register = Map.empty
</Syntax> </Syntax>
# Creating a Non-empty Map <SyntaxTitle syntax="pascaligo">
function literal : list ('key * 'value) -> map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val literal : ('key * 'value) list -> ('key, 'value) map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let literal: list(('key, 'value)) => map('key, 'value)
</SyntaxTitle>
Create a non-empty map.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=maps ```pascaligo group=maps
const moves : register = const moves : register =
Map.literal (list [
(("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address), (1,2));
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (0,3))]);
```
Alternative way of creating an empty map:
```pascaligo group=maps
const moves_alternative : register =
map [ map [
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) -> (1,2); ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) -> (1,2);
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) -> (0,3)] ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) -> (0,3)];
``` ```
</Syntax> </Syntax>
@ -103,14 +146,32 @@ let moves : register =
</Syntax> </Syntax>
# Accessing Map Bindings <SyntaxTitle syntax="pascaligo">
function find_opt : 'key -> map ('key, 'value) -> option 'value
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val find_opt : 'key -> ('key, 'value) map -> 'value option
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let find_opt : ('key, map ('key, 'value)) => option ('value)
</SyntaxTitle>
Retrieve a (option) value from a map with the given key. Returns `None` if the
key is missing and the value otherwise.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=maps ```pascaligo group=maps
const my_balance : option (move) = const my_balance : option (move) =
moves [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address)] Map.find_opt (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), moves)
```
Alternatively:
```pascaligo group=maps
const my_balance_alternative : option (move) =
moves [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address)];
``` ```
</Syntax> </Syntax>
@ -126,67 +187,40 @@ let my_balance : move option =
```reasonligo group=maps ```reasonligo group=maps
let my_balance : option (move) = let my_balance : option (move) =
Map.find_opt (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), moves); Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address, moves);
``` ```
</Syntax> </Syntax>
Notice how the value we read is an optional value: this is to force <SyntaxTitle syntax="pascaligo">
the reader to account for a missing key in the map. This requires function update : 'key -> option 'value -> map ('key, 'value) -> map ('key, 'value)
*pattern matching*. </SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val update: 'key -> 'value option -> ('key, 'value) map -> ('key, 'value) map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let update: ('key, option('value), map('key, 'value)) => map ('key, 'value)
</SyntaxTitle>
Note: when `None` is used as a value, the key and associated value is removed
from the map.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=maps ```pascaligo group=maps
function force_access (const key : address; const moves : register) : move is const updated_map : register = Map.update(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some (4,9), moves);
case moves[key] of
Some (move) -> move
| None -> (failwith ("No move.") : move)
end
``` ```
</Syntax> Alternatively:
<Syntax syntax="cameligo">
```cameligo group=maps
let force_access (key, moves : address * register) : move =
match Map.find_opt key moves with
Some move -> move
| None -> (failwith "No move." : move)
```
</Syntax>
<Syntax syntax="reasonligo">
```reasonligo group=maps
let force_access = ((key, moves) : (address, register)) : move => {
switch (Map.find_opt (key, moves)) {
| Some (move) => move
| None => failwith ("No move.") : move
}
};
```
</Syntax>
# Updating a Map
Given a map, we may want to add a new binding, remove one, or modify
one by changing the value associated to an already existing key. All
those operations are called *updates*.
<Syntax syntax="pascaligo">
```pascaligo group=maps ```pascaligo group=maps
function assign (var m : register) : register is
function update (var m : register) : register is
block { block {
m [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9) m [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9);
} with m } with m
``` ```
If multiple bindings need to be updated, PascaLIGO offers a *patch If multiple bindings need to be updated, PascaLIGO offers a *patch
@ -206,14 +240,40 @@ function assignments (var m : register) : register is
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=maps ```cameligo group=maps
let assign (m : register) : register = let updated_map : register =
Map.update Map.update
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) (Some (4,9)) m ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) (Some (4,9)) moves
``` ```
Notice the optional value `Some (4,9)` instead of `(4,9)`. If we had
use `None` instead, that would have meant that the binding is removed.
As a particular case, we can only add a key and its associated value. </Syntax>
<Syntax syntax="reasonligo">
```reasonligo group=maps
let updated_map : register =
Map.update
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some ((4,9)), moves);
```
</Syntax>
<SyntaxTitle syntax="pascaligo">
function add : 'key -> 'value -> map ('key, 'value) -> map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val add : 'key -> 'value -> ('key, 'value) map -> ('key, 'value) map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let add: ('key, 'value, map('key, 'value)) => map('key, 'value)
</SyntaxTitle>
<Syntax syntax="pascaligo">
```pascaligo group=maps
const added_item : register = Map.add (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (4, 9), moves)
```
</Syntax>
<Syntax syntax="cameligo">
```cameligo group=maps ```cameligo group=maps
let add (m : register) : register = let add (m : register) : register =
@ -225,18 +285,7 @@ let add (m : register) : register =
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=maps ```reasonligo group=maps
let assign = (m : register) : register => let add = (m: register): register =>
Map.update
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), Some ((4,9)), m);
```
Notice the optional value `Some (4,9)` instead of `(4,9)`. If we had
use `None` instead, that would have meant that the binding is removed.
As a particular case, we can only add a key and its associated value.
```reasonligo group=maps
let add = (m : register) : register =>
Map.add Map.add
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (4,9), m); (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (4,9), m);
``` ```
@ -244,57 +293,63 @@ let add = (m : register) : register =>
</Syntax> </Syntax>
To remove a binding from a map, we need its key. <SyntaxTitle syntax="pascaligo">
function remove : 'key -> map ('key, 'value) -> map ('key, 'value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val remove : 'key -> ('key, 'value) map -> ('key, 'value) map
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let remove: (key, map('key, 'value)) => map('key, 'value)
</SyntaxTitle>
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=maps ```pascaligo group=maps
function delete (const key : address; var moves : register) : register is const updated_map : register =
Map.remove (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves)
```
Alternatively, the instruction `remove key from map m` removes the key
`key` from the map `m`.
```pascaligo group=maps
function rem (var m : register) : register is
block { block {
remove key from map moves remove ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) from map moves
} with moves } with m
const updated_map : register = rem (moves)
``` ```
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo group=maps ```cameligo group=maps
let delete (key, moves : address * register) : register = let updated_map : register =
Map.remove key moves Map.remove ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
``` ```
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo group=maps ```reasonligo group=maps
let delete = ((key, moves) : (address, register)) : register => let updated_map : register =
Map.remove (key, moves); Map.remove (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves)
``` ```
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
# Functional Iteration over Maps function iter : ((key, value) -> unit) -> map (key, value) -> unit
</SyntaxTitle>
A *functional iterator* is a function that traverses a data structure <SyntaxTitle syntax="cameligo">
and calls in turn a given function over the elements of that structure val iter : (('key * 'value) -> unit) -> ('key, 'value) map -> unit
to compute some value. Another approach is possible in PascaLIGO: </SyntaxTitle>
*loops* (see the relevant section). <SyntaxTitle syntax="reasonligo">
let iter: ((('key, 'value)) => unit, map('key, 'value)) => unit
There are three kinds of functional iterations over LIGO maps: the </SyntaxTitle>
*iterated operation*, the *map operation* (not to be confused with the
*map data structure*) and the *fold operation*.
## Iterated Operation over Maps
The first, the *iterated operation*, is an iteration over the map with
no return value: its only use is to produce side-effects. This can be
useful if for example you would like to check that each value inside
of a map is within a certain range, and fail with an error otherwise.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
@ -330,14 +385,15 @@ let iter_op = (m : register) : unit => {
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
## Map Operations over Maps function map : (('key, 'value) -> ('mapped_key, 'mapped_item)) -> map ('key, 'value) -> map ('mapped_key, 'mapped_value)
</SyntaxTitle>
We may want to change all the bindings of a map by applying to them a <SyntaxTitle syntax="cameligo">
function. This is called a *map operation*, not to be confused with val map : (('key * 'value) -> ('mapped_key * 'mapped_item)) -> (key, value) map -> (mapped_key, mapped_value) map
the map data structure. The predefined functional iterator </SyntaxTitle>
implementing the map operation over maps is called `Map.map`. <SyntaxTitle syntax="reasonligo">
let map: ((('key, 'value)) => ('mapped_key, 'mapped_item), map(key, value)) => map(mapped_key, mapped_value)
</SyntaxTitle>
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
@ -374,14 +430,15 @@ let map_op = (m : register) : register => {
</Syntax> </Syntax>
## Folded Operations over Maps <SyntaxTitle syntax="pascaligo">
function fold : (('accumulator -> ('key, 'value) -> 'accumulator) -> map ('key, 'value) -> 'accumulator) -> 'accumulator
A *folded operation* is the most general of iterations. The folded </SyntaxTitle>
function takes two arguments: an *accumulator* and the structure <SyntaxTitle syntax="cameligo">
*element* at hand, with which it then produces a new accumulator. This val fold : ('accumulator -> ('key * 'value) -> 'accumulator) -> ('key, 'value) map -> 'accumulator -> 'accumulator
enables having a partial result that becomes complete when the </SyntaxTitle>
traversal of the data structure is over. <SyntaxTitle syntax="reasonligo">
let fold: ((('accumulator, ('key, 'value)) => 'accumulator), map('key, 'value), 'accumulator) => 'accumulator
</SyntaxTitle>
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
@ -417,3 +474,28 @@ let fold_op = (m : register) : int => {
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function size : map ('key, 'value) -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val size : ('key, 'value) map -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let size: map('key, 'value) => nat
</SyntaxTitle>
Returns the number of items in the map.
<SyntaxTitle syntax="pascaligo">
function mem : key -> map (key, value) -> bool
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val mem : 'key -> ('key, 'value) map => bool
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let mem : ('key, map('key, 'value)) => bool
</SyntaxTitle>
Checks if a key exists in the map.

View File

@ -1,20 +1,45 @@
--- ---
id: set-reference id: set-reference
title: Sets — Unordered unique collection of a type title: Set
description: Set operations
hide_table_of_contents: true
--- ---
import Syntax from '@theme/Syntax'; import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
Sets are unordered collections of values of the same type, like lists Sets are unordered collections of unique values of the same type.
are ordered collections. Like the mathematical sets and lists, sets
can be empty and, if not, elements of sets in LIGO are *unique*,
whereas they can be repeated in a *list*.
# Empty Sets <SyntaxTitle syntax="pascaligo">
type set ('value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type 'value set
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type set('value)
</SyntaxTitle>
<SyntaxTitle syntax="pascaligo">
function empty : set('value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val empty : 'value set
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let empty: set('value)
</SyntaxTitle>
Create an empty set.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=sets
const my_set : set (int) = Set.empty
```
Alternative syntax:
```pascaligo group=sets ```pascaligo group=sets
const my_set : set (int) = set [] const my_set : set (int) = set []
``` ```
@ -35,12 +60,26 @@ let my_set : set (int) = Set.empty;
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function literal : list('value) -> set('value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val literal : 'value list -> 'value set
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let literal: list('value) => set('value)
</SyntaxTitle>
# Non-empty Sets Create a non-empty set.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=sets
const my_set : set (int) = Set.literal (list [3; 2; 2; 1])
```
Or use the following syntax sugar:
```pascaligo group=sets ```pascaligo group=sets
const my_set : set (int) = set [3; 2; 2; 1] const my_set : set (int) = set [3; 2; 2; 1]
``` ```
@ -50,7 +89,7 @@ const my_set : set (int) = set [3; 2; 2; 1]
```cameligo group=sets ```cameligo group=sets
let my_set : int set = let my_set : int set =
Set.add 3 (Set.add 2 (Set.add 2 (Set.add 1 (Set.empty : int set)))) Set.literal [3; 2; 2; 1]
``` ```
</Syntax> </Syntax>
@ -58,19 +97,33 @@ let my_set : int set =
```reasonligo group=sets ```reasonligo group=sets
let my_set : set (int) = let my_set : set (int) =
Set.add (3, Set.add (2, Set.add (2, Set.add (1, Set.empty : set (int))))); Set.literal ([3, 2, 2, 1]);
``` ```
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function mem : 'value -> set('value) -> 'bool
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val mem : 'value -> 'value set -> bool
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let mem: ('value, set('value)) => bool
</SyntaxTitle>
# Set Membership Checks if a value exists in the set.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo group=sets ```pascaligo group=sets
const contains_3 : bool = my_set contains 3 const contains_3 : bool = Set.mem(3, my_set)
```
Or:
```pascaligo group=sets
const contains_3_alt : bool = my_set contains 3
``` ```
</Syntax> </Syntax>
@ -89,12 +142,17 @@ let contains_3 : bool = Set.mem (3, my_set);
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function cardinal : set('value) -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val cardinal : 'value set -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let cardinal: set('value) => nat
</SyntaxTitle>
# Cardinal of Sets Number of elements in a set.
The predefined function `Set.size` returns the number of
elements in a given set as follows.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
@ -102,7 +160,7 @@ elements in a given set as follows.
const cardinal : nat = Set.size (my_set) const cardinal : nat = Set.size (my_set)
``` ```
> Note that `size` is *deprecated*. > Note that `size` is *deprecated*. Please use `Set.size`
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -120,72 +178,41 @@ let cardinal : nat = Set.size (my_set);
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function add : 'value -> set('value) -> set('value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val add : 'value -> 'value set -> 'value set
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let add: ('value, set('value)) => set('value)
</SyntaxTitle>
# Updating Sets Add a value to a set.
There are two ways to update a set, that is to add or remove from it. <SyntaxTitle syntax="pascaligo">
function remove : 'value -> set('value) -> set('value)
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val remove : 'value -> 'value set -> 'value set
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let remove: ('value, set('value)) => set('value)
</SyntaxTitle>
Remove a value from a set.
<Syntax syntax="pascaligo"> <SyntaxTitle syntax="pascaligo">
function iter : ('a -> unit) -> set('a) -> unit
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val iter : ('a -> unit) -> 'a set -> unit
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let iter: (('a => unit), set('a)) => unit
</SyntaxTitle>
In PascaLIGO, either we create a new set from the given one, or we Iterate over values in a set.
modify it in-place. First, let us consider the former way:
```pascaligo group=sets
const larger_set : set (int) = Set.add (4, my_set)
const smaller_set : set (int) = Set.remove (3, my_set)
```
> Note that `set_add` and `set_remove` are *deprecated*.
If we are in a block, we can use an instruction to modify the set
bound to a given variable. This is called a *patch*. It is only
possible to add elements by means of a patch, not remove any: it is
the union of two sets.
```pascaligo group=sets
function update (var s : set (int)) : set (int) is block {
patch s with set [4; 7]
} with s
const new_set : set (int) = update (my_set)
```
</Syntax>
<Syntax syntax="cameligo">
```cameligo group=sets
let larger_set : int set = Set.add 4 my_set
let smaller_set : int set = Set.remove 3 my_set
```
</Syntax>
<Syntax syntax="reasonligo">
```reasonligo group=sets
let larger_set : set (int) = Set.add (4, my_set);
let smaller_set : set (int) = Set.remove (3, my_set);
```
</Syntax>
# Functional Iteration over Sets
A *functional iterator* is a function that traverses a data structure
and calls in turn a given function over the elements of that structure
to compute some value. Another approach is possible in PascaLIGO:
*loops* (see the relevant section).
There are three kinds of functional iterations over LIGO maps: the
*iterated operation*, the *mapped operation* (not to be confused with
the *map data structure*) and the *folded operation*.
## Iterated Operation
The first, the *iterated operation*, is an iteration over the map with
no return value: its only use is to produce side-effects. This can be
useful if for example you would like to check that each value inside
of a map is within a certain range, and fail with an error otherwise.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
@ -221,15 +248,17 @@ let iter_op = (s : set (int)) : unit => {
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
function fold : (('accumulator -> 'item -> 'accumulator) -> set ('item) -> 'accumulator) -> 'accumulator
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val fold : ('accumulator -> 'item -> 'accumulator) -> 'set list -> 'accumulator -> 'accumulator
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let fold: ((('accumulator, 'item) => 'accumulator), set('item), 'accumulator) => 'accumulator
</SyntaxTitle>
## Folded Operation [Fold over values in a set](../language-basics/sets-lists-tuples#folded-operation)
A *folded operation* is the most general of iterations. The folded
function takes two arguments: an *accumulator* and the structure
*element* at hand, with which it then produces a new accumulator. This
enables having a partial result that becomes complete when the
traversal of the data structure is over.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
@ -241,17 +270,6 @@ const sum_of_elements : int = Set.fold (sum, my_set, 0)
> Note that `set_fold` is *deprecated*. > Note that `set_fold` is *deprecated*.
It is possible to use a *loop* over a set as well.
```pascaligo group=sets
function loop (const s : set (int)) : int is block {
var sum : int := 0;
for element in set s block {
sum := sum + element
}
} with sum
```
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
@ -269,4 +287,3 @@ let sum_of_elements : int = Set.fold (sum, my_set, 0);
``` ```
</Syntax> </Syntax>

View File

@ -1,45 +1,77 @@
--- ---
id: string-reference id: string-reference
title: String — Manipulate string data title: String
description: Operations for strings.
hide_table_of_contents: true
--- ---
import Syntax from '@theme/Syntax'; import Syntax from '@theme/Syntax';
import SyntaxTitle from '@theme/SyntaxTitle';
## String.size(s: string) : nat <SyntaxTitle syntax="pascaligo">
type string
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
type string
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
type string
</SyntaxTitle>
Get the size of a string. [Michelson only supports ASCII strings](http://tezos.gitlab.io/whitedoc/michelson.html#constants) A sequence of characters.
<SyntaxTitle syntax="pascaligo">
function length : string -> nat
</SyntaxTitle>
<SyntaxTitle syntax="cameligo">
val length : string -> nat
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let length: string => nat
</SyntaxTitle>
Get the size of a string.
[Michelson only supports ASCII strings](http://tezos.gitlab.io/whitedoc/michelson.html#constants)
so for now you can assume that each character takes one byte of storage. so for now you can assume that each character takes one byte of storage.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo ```pascaligo
function string_size (const s: string) : nat is size(s) function string_size (const s: string) : nat is String.length(s)
``` ```
> Note that `size` and `String.size` are *deprecated*.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo ```cameligo
let size_op (s: string) : nat = String.size s let size_op (s: string) : nat = String.length s
``` ```
> Note that `String.size` is *deprecated*.
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo ```reasonligo
let size_op = (s: string): nat => String.size(s); let size_op = (s: string): nat => String.length(s);
``` ```
> Note that `String.size` is *deprecated*.
</Syntax> </Syntax>
<SyntaxTitle syntax="pascaligo">
## String.length(s: string) : nat function sub : nat -> nat -> string -> string
</SyntaxTitle>
Alias for `String.size`. <SyntaxTitle syntax="cameligo">
val sub : nat -> nat -> string -> string
## String.slice(pos1: nat, pos2: nat, s: string) : string </SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let sub: (nat, nat, string) => string
</SyntaxTitle>
Get the substring of `s` between `pos1` inclusive and `pos2` inclusive. For example Get the substring of `s` between `pos1` inclusive and `pos2` inclusive. For example
the string "tata" given to the function below would return "at". the string "tata" given to the function below would return "at".
@ -48,31 +80,41 @@ the string "tata" given to the function below would return "at".
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo ```pascaligo
function slice_op (const s : string) : string is string_slice(1n , 2n , s) function slice_op (const s : string) : string is String.sub(1n , 2n , s)
``` ```
> Note that `string_slice` is *deprecated*.
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo ```cameligo
let slice_op (s: string) : string = String.slice 1n 2n s let slice_op (s: string) : string = String.sub 1n 2n s
``` ```
> Note that `String.slice` is *deprecated*.
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo ```reasonligo
let slice_op = (s: string): string => String.slice(1n, 2n, s); let slice_op = (s: string): string => String.sub(1n, 2n, s);
``` ```
> Note that `String.slice` is *deprecated*.
</Syntax> </Syntax>
## String.sub(pos1: nat, pos2: nat, s: string) : string <SyntaxTitle syntax="pascaligo">
function concat : string -> string -> string
Alias for `String.slice`. </SyntaxTitle>
<SyntaxTitle syntax="cameligo">
## String.concat(s1: string, s2: string) : string val concat : string -> string -> string
</SyntaxTitle>
<SyntaxTitle syntax="reasonligo">
let concat: (string, string) => string
</SyntaxTitle>
Concatenate two strings and return the result. Concatenate two strings and return the result.
@ -81,21 +123,40 @@ Concatenate two strings and return the result.
<Syntax syntax="pascaligo"> <Syntax syntax="pascaligo">
```pascaligo ```pascaligo
function concat_op (const s : string) : string is s ^ "toto" function concat_op (const s : string) : string is String.concat(s, "toto")
```
Alternatively:
```pascaligo
function concat_op_alt (const s : string) : string is s ^ "toto"
``` ```
</Syntax> </Syntax>
<Syntax syntax="cameligo"> <Syntax syntax="cameligo">
```cameligo ```cameligo
let concat_syntax (s: string) = s ^ "test_literal" let concat_syntax (s: string) = String.concat s "test_literal"
``` ```
Alternatively:
```cameligo
let concat_syntax_alt (s: string) = s ^ "test_literal"
```
</Syntax> </Syntax>
<Syntax syntax="reasonligo"> <Syntax syntax="reasonligo">
```reasonligo ```reasonligo
let concat_syntax = (s: string) => s ++ "test_literal"; let concat_syntax = (s: string) => String.concat(s, "test_literal");
```
Alternatively:
```reasonligo
let concat_syntax_alt = (s: string) => s ++ "test_literal";
``` ```
</Syntax> </Syntax>

View File

@ -99,7 +99,6 @@ const siteConfig = {
},*/ },*/
// Add custom scripts here that would be placed in <script> tags. // Add custom scripts here that would be placed in <script> tags.
scripts: ['https://buttons.github.io/buttons.js'],
// On page navigation for the current documentation page. // On page navigation for the current documentation page.
// No .html extensions for paths. // No .html extensions for paths.
@ -113,10 +112,11 @@ const siteConfig = {
// You may provide arbitrary config keys to be used as needed by your // You may provide arbitrary config keys to be used as needed by your
// template. For example, if you need your repo's URL... // template. For example, if you need your repo's URL...
// repoUrl: repoUrl, // repoUrl: repoUrl,
stylesheets: [ plugins: [
'https://fonts.googleapis.com/css?family=DM+Sans:400,400i,500,500i,700,700i|Open+Sans:300,300i,400,600|Source+Code+Pro&display=swap' '@ligo/syntax', {
],
}
],
presets: [ presets: [
[ [

View File

@ -14,11 +14,18 @@
"webpack": "4.41.2" "webpack": "4.41.2"
}, },
"browserslist": { "browserslist": {
"production": [">0.2%", "not dead", "not op_mini all"], "production": [
">0.2%",
"not dead",
"not op_mini all"
],
"development": [ "development": [
"last 1 chrome version", "last 1 chrome version",
"last 1 firefox version", "last 1 firefox version",
"last 1 safari version" "last 1 safari version"
] ]
},
"dependencies": {
"@ligo/syntax": "file:src/@ligo/syntax"
} }
} }

View File

@ -21,17 +21,20 @@
"advanced/first-contract", "advanced/first-contract",
"advanced/michelson-and-ligo" "advanced/michelson-and-ligo"
], ],
"API & Reference": [ "Reference": [
"api/cli-commands", "api/cli-commands",
"api/cheat-sheet", "api/cheat-sheet"
],
"API":[
"reference/big-map-reference", "reference/big-map-reference",
"reference/bitwise-reference",
"reference/bytes-reference", "reference/bytes-reference",
"reference/crypto-reference", "reference/crypto-reference",
"reference/current-reference",
"reference/list-reference", "reference/list-reference",
"reference/map-reference", "reference/map-reference",
"reference/set-reference", "reference/set-reference",
"reference/string-reference" "reference/string-reference",
"reference/current-reference"
] ]
}, },
"contributors-docs": { "contributors-docs": {

View File

@ -0,0 +1,12 @@
const path = require('path');
module.exports = function (context, options) {
return {
name: 'ligo-syntax-plugin',
getThemePath() {
return path.resolve(__dirname, './theme');
}
};
};

View File

@ -0,0 +1,3 @@
import React from 'react';
const SyntaxContext = React.createContext('pascaligo');
export default SyntaxContext;

View File

@ -0,0 +1,18 @@
import React from 'react';
import styles from './styles.module.css';
function SyntaxSwitch(props) {
return React.createElement("select", {
className: styles.syntaxSwitch,
defaultValue: props.syntax,
onChange: e => props.onSyntaxChange(e.target.value)
}, React.createElement("option", {
value: "pascaligo"
}, "PascaLIGO"), React.createElement("option", {
value: "cameligo"
}, "CameLIGO"), React.createElement("option", {
value: "reasonligo"
}, "ReasonLIGO"));
}
export default SyntaxSwitch;

View File

@ -0,0 +1,15 @@
import React from 'react';
import SyntaxContext from './SyntaxContext';
function Syntax(props) {
return React.createElement(SyntaxContext.Consumer, null, syntax => {
if (syntax === props.syntax) {
return props.children;
} else {
return React.createElement(React.Fragment, null);
}
});
}
export default Syntax;
export { SyntaxContext };

View File

@ -0,0 +1,111 @@
function _extends() { _extends = Object.assign || function (target) { for (var i = 1; i < arguments.length; i++) { var source = arguments[i]; for (var key in source) { if (Object.prototype.hasOwnProperty.call(source, key)) { target[key] = source[key]; } } } return target; }; return _extends.apply(this, arguments); }
import React, { useEffect, useState, useRef } from 'react';
import Highlight, { defaultProps } from "prism-react-renderer"; // THE PROBLEM IS USE THEME CONTEXT ==>>>>
import useDocusaurusContext from '@docusaurus/useDocusaurusContext';
import useThemeContext from '@theme/hooks/useThemeContext';
import { SyntaxContext } from '@theme/Syntax';
import defaultTheme from 'prism-react-renderer/themes/palenight';
const {
Prism
} = require("prism-react-renderer");
Prism.languages = { ...Prism.languages,
pascaligo: {
'comment': [/\(\*[\s\S]+?\*\)/, // /\{[\s\S]+?\}/,
/\/\/.*/],
'string': {
pattern: /(?:'(?:''|[^'\r\n])*'|#[&$%]?[a-f\d]+)+|\^[a-z]/i,
greedy: true
},
'keyword': [{
// Turbo Pascal
pattern: /(^|[^&])\b(?:absolute|array|asm|begin|case|const|constructor|destructor|do|downto|else|end|file|for|function|goto|if|implementation|inherited|inline|interface|label|nil|object|of|operator|packed|procedure|program|record|reintroduce|repeat|self|set|string|then|to|type|unit|until|uses|var|while|with)\b/i,
lookbehind: true
}, {
// Free Pascal
pattern: /(^|[^&])\b(?:dispose|exit|false|new|true)\b/i,
lookbehind: true
}, {
// Object Pascal
pattern: /(^|[^&])\b(?:class|dispinterface|except|exports|finalization|finally|initialization|inline|library|on|out|packed|property|raise|resourcestring|threadvar|try)\b/i,
lookbehind: true
}, {
// Modifiers
pattern: /(^|[^&])\b(?:absolute|abstract|alias|assembler|bitpacked|break|cdecl|continue|cppdecl|cvar|default|deprecated|dynamic|enumerator|experimental|export|external|far|far16|forward|generic|helper|implements|index|interrupt|iochecks|local|message|name|near|nodefault|noreturn|nostackframe|oldfpccall|otherwise|overload|override|pascal|platform|private|protected|public|published|read|register|reintroduce|result|safecall|saveregisters|softfloat|specialize|static|stdcall|stored|strict|unaligned|unimplemented|varargs|virtual|write)\b/i,
lookbehind: true
}],
'number': [// Hexadecimal, octal and binary
/(?:[&%]\d+|\$[a-f\d]+)/i, // Decimal
/\b\d+(?:\.\d+)?(?:e[+-]?\d+)?/i],
'operator': [/\.\.|\*\*|:=|<[<=>]?|>[>=]?|[+\-*\/]=?|[@^=]/i, {
pattern: /(^|[^&])\b(?:and|as|div|exclude|in|include|is|mod|not|or|shl|shr|xor)\b/,
lookbehind: true
}],
'punctuation': /\(\.|\.\)|[()\[\]:;,.]/
},
reasonligo: { ...Prism.languages.reason,
'comment': [/(^|[^\\])\/\*[\s\S]*?\*\//, /\(\*[\s\S]*?\*\)/, /\/\/.*/]
},
cameligo: { ...Prism.languages.ocaml,
'comment': [/(^|[^\\])\/\*[\s\S]*?\*\//, /\(\*[\s\S]*?\*\)/, /\/\/.*/]
}
};
function SyntaxTitle(props) {
const {
siteConfig: {
themeConfig: {
prism = {}
}
}
} = useDocusaurusContext();
const {
isDarkTheme
} = useThemeContext();
const lightModeTheme = prism.theme || defaultTheme;
const darkModeTheme = prism.darkTheme || lightModeTheme;
const prismTheme = isDarkTheme ? darkModeTheme : lightModeTheme;
const [mounted, setMounted] = useState(false);
useEffect(() => {
setMounted(true);
}, []);
return React.createElement(SyntaxContext.Consumer, null, syntax => {
if (syntax === props.syntax) {
return React.createElement(Highlight, _extends({}, defaultProps, {
key: mounted,
language: props.syntax,
code: props.children,
theme: prismTheme
}), ({
className,
style,
tokens,
getLineProps,
getTokenProps
}) => React.createElement("pre", {
className: className,
style: {
backgroundColor: 'var(--ifm-background-color)',
fontSize: '1.1rem',
fontWeight: 'bold',
padding: 0,
whiteSpace: 'break-spaces',
marginTop: '3rem'
}
}, tokens.map((line, i) => React.createElement("div", getLineProps({
line,
key: i
}), line.map((token, key) => React.createElement("span", getTokenProps({
token,
key
})))))));
} else {
return React.createElement("div", null);
}
});
}
export default SyntaxTitle;

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,28 @@
{
"name": "@ligo/syntax",
"description": "Switch between different syntaxes",
"version": "0.0.0",
"main": "output/index.js",
"peerDependencies": {
"@docusaurus/core": "^2.0.0-alpha.43",
"@docusaurus/preset-classic": "^2.0.0-alpha.43",
"react": "^16.8.4",
"react-dom": "^16.8.4",
"webpack": "4.41.2"
},
"devDependencies": {
"@babel/cli": "^7.8.4",
"@babel/core": "^7.8.7",
"@babel/preset-env": "^7.8.7",
"@babel/preset-react": "^7.8.3",
"prism-react-renderer": "^1.0.2"
},
"babel": {
"presets": [
"@babel/preset-react"
]
},
"scripts": {
"build": "rm -rf output && mkdir output && node_modules/.bin/babel src/theme/Syntax/*.js -d output/theme/Syntax/ && node_modules/.bin/babel src/theme/SyntaxTitle/*.js -d output/theme/SyntaxTitle/ && node_modules/.bin/babel src/*.js -d output/ && cp ./src/theme/Syntax/styles.module.css output/theme/Syntax/"
}
}

View File

@ -0,0 +1,11 @@
const path = require('path');
module.exports = function(context, options) {
return {
name: 'ligo-syntax-plugin',
getThemePath() {
return path.resolve(__dirname, './theme');
}
}
}

View File

@ -3,4 +3,3 @@ import React from 'react';
const SyntaxContext = React.createContext('pascaligo'); const SyntaxContext = React.createContext('pascaligo');
export default SyntaxContext; export default SyntaxContext;

View File

@ -16,3 +16,5 @@ function Syntax(props) {
} }
export default Syntax export default Syntax
export { SyntaxContext }

View File

@ -0,0 +1,37 @@
.syntaxSwitch {
display: block;
font-size: 1rem;
font-weight: bold;
line-height: 1rem;
padding: .6em 1.4em .5em .8em;
box-sizing: border-box;
border: none;
color: var(--color-primary-text);
-moz-appearance: none;
-webkit-appearance: none;
appearance: none;
background-color: transparent;
background-image: url('data:image/svg+xml;charset=US-ASCII,%3Csvg%20xmlns%3D%22http%3A%2F%2Fwww.w3.org%2F2000%2Fsvg%22%20width%3D%22292.4%22%20height%3D%22292.4%22%3E%3Cpath%20fill%3D%22%23007CB2%22%20d%3D%22M287%2069.4a17.6%2017.6%200%200%200-13-5.4H18.4c-5%200-9.3%201.8-12.9%205.4A17.6%2017.6%200%200%200%200%2082.2c0%205%201.8%209.3%205.4%2012.9l128%20127.9c3.6%203.6%207.8%205.4%2012.8%205.4s9.2-1.8%2012.8-5.4L287%2095c3.5-3.5%205.4-7.8%205.4-12.8%200-5-1.9-9.2-5.5-12.8z%22%2F%3E%3C%2Fsvg%3E');
background-repeat: no-repeat, repeat;
background-position: right .7em top 50%, 0 0;
background-size: .65em auto, 100%;
}
.syntaxSwitch::-ms-expand {
display: none;
}
.syntaxSwitch:hover {
border-color: #888;
}
.syntaxSwitch:focus {
border-color: #aaa;
box-shadow: 0 0 1px 3px rgba(59, 153, 252, .7);
box-shadow: 0 0 0 3px -moz-mac-focusring;
color: var(--color-primary-text);
outline: none;
}
.syntaxSwitch option {
color: var(--color-primary-text);
font-weight:normal;
}

View File

@ -0,0 +1,126 @@
import React, {useEffect, useState, useRef} from 'react';
import Highlight, { defaultProps } from "prism-react-renderer";
// THE PROBLEM IS USE THEME CONTEXT ==>>>>
import useDocusaurusContext from '@docusaurus/useDocusaurusContext';
import useThemeContext from '@theme/hooks/useThemeContext';
import { SyntaxContext } from '@theme/Syntax';
import defaultTheme from 'prism-react-renderer/themes/palenight';
const {Prism} = require("prism-react-renderer");
Prism.languages = {
...Prism.languages,
pascaligo: {
'comment': [
/\(\*[\s\S]+?\*\)/,
// /\{[\s\S]+?\}/,
/\/\/.*/
],
'string': {
pattern: /(?:'(?:''|[^'\r\n])*'|#[&$%]?[a-f\d]+)+|\^[a-z]/i,
greedy: true
},
'keyword': [
{
// Turbo Pascal
pattern: /(^|[^&])\b(?:absolute|array|asm|begin|case|const|constructor|destructor|do|downto|else|end|file|for|function|goto|if|implementation|inherited|inline|interface|label|nil|object|of|operator|packed|procedure|program|record|reintroduce|repeat|self|set|string|then|to|type|unit|until|uses|var|while|with)\b/i,
lookbehind: true
},
{
// Free Pascal
pattern: /(^|[^&])\b(?:dispose|exit|false|new|true)\b/i,
lookbehind: true
},
{
// Object Pascal
pattern: /(^|[^&])\b(?:class|dispinterface|except|exports|finalization|finally|initialization|inline|library|on|out|packed|property|raise|resourcestring|threadvar|try)\b/i,
lookbehind: true
},
{
// Modifiers
pattern: /(^|[^&])\b(?:absolute|abstract|alias|assembler|bitpacked|break|cdecl|continue|cppdecl|cvar|default|deprecated|dynamic|enumerator|experimental|export|external|far|far16|forward|generic|helper|implements|index|interrupt|iochecks|local|message|name|near|nodefault|noreturn|nostackframe|oldfpccall|otherwise|overload|override|pascal|platform|private|protected|public|published|read|register|reintroduce|result|safecall|saveregisters|softfloat|specialize|static|stdcall|stored|strict|unaligned|unimplemented|varargs|virtual|write)\b/i,
lookbehind: true
}
],
'number': [
// Hexadecimal, octal and binary
/(?:[&%]\d+|\$[a-f\d]+)/i,
// Decimal
/\b\d+(?:\.\d+)?(?:e[+-]?\d+)?/i
],
'operator': [
/\.\.|\*\*|:=|<[<=>]?|>[>=]?|[+\-*\/]=?|[@^=]/i,
{
pattern: /(^|[^&])\b(?:and|as|div|exclude|in|include|is|mod|not|or|shl|shr|xor)\b/,
lookbehind: true
}
],
'punctuation': /\(\.|\.\)|[()\[\]:;,.]/
},
reasonligo:
{...Prism.languages.reason,
'comment': [
/(^|[^\\])\/\*[\s\S]*?\*\//,
/\(\*[\s\S]*?\*\)/,
/\/\/.*/
]
},
cameligo: {
...Prism.languages.ocaml,
'comment': [
/(^|[^\\])\/\*[\s\S]*?\*\//,
/\(\*[\s\S]*?\*\)/,
/\/\/.*/
]}
};
function SyntaxTitle(props) {
const {
siteConfig: {
themeConfig: {prism = {}},
}
} = useDocusaurusContext();
const {isDarkTheme} = useThemeContext();
const lightModeTheme = prism.theme || defaultTheme;
const darkModeTheme = prism.darkTheme || lightModeTheme;
const prismTheme = isDarkTheme ? darkModeTheme : lightModeTheme;
const [mounted, setMounted] = useState(false);
useEffect(() => {
setMounted(true);
}, []);
return (
<SyntaxContext.Consumer>
{(syntax => {
if (syntax === props.syntax) {
return (
<Highlight {...defaultProps} key={mounted} language={props.syntax} code={props.children} theme={prismTheme}>
{({ className, style, tokens, getLineProps, getTokenProps }) => (
<pre className={className} style={{backgroundColor: 'var(--ifm-background-color)', fontSize: '1.1rem', fontWeight: 'bold', padding: 0, whiteSpace: 'break-spaces', marginTop: '3rem' }}>
{tokens.map((line, i) => (
<div {...getLineProps({ line, key: i })}>
{line.map((token, key) => (
<span {...getTokenProps({ token, key })} />
))}
</div>
))}
</pre>
)}
</Highlight>
)
} else {
return <div></div>
}
})}
</SyntaxContext.Consumer>
);
}
export default SyntaxTitle;

View File

@ -15,7 +15,7 @@ import isInternalUrl from '@docusaurus/utils'; // eslint-disable-line import/no-
import styles from './styles.module.css'; import styles from './styles.module.css';
import SyntaxSwitch from '../Syntax/SyntaxSwitch'; import SyntaxSwitch from '@theme/Syntax/SyntaxSwitch';
const MOBILE_TOGGLE_SIZE = 24; const MOBILE_TOGGLE_SIZE = 24;

View File

@ -0,0 +1,30 @@
/**
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*/
import React from 'react';
import Layout from '@theme/Layout';
function NotFound() {
return (
<Layout title="Page Not Found">
<div className="container margin-vert--xl">
<div className="row">
<div className="col col--6 col--offset-3">
<h1 className="hero__title">Page Not Found</h1>
<p>We could not find what you were looking for.</p>
<p>
Please contact the owner of the site that linked you to the
original URL and let them know their link is broken.
</p>
</div>
</div>
</div>
</Layout>
);
}
export default NotFound;

View File

@ -94,6 +94,13 @@ let source =
info ~docv ~doc ["source"] in info ~docv ~doc ["source"] in
value @@ opt (some string) None info value @@ opt (some string) None info
let disable_michelson_typechecking =
let open Arg in
let info =
let doc = "disable Michelson typecking, this might produce ill-typed Michelson code." in
info ~doc ["disable-michelson-typechecking"] in
value @@ flag info
let predecessor_timestamp = let predecessor_timestamp =
let open Arg in let open Arg in
let info = let info =
@ -131,17 +138,16 @@ 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 disable_typecheck michelson_format =
toplevel ~display_format @@ toplevel ~display_format @@
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in let%bind typed,_ = Compile.Utils.type_file source_file syntax (Contract entry_point) in
let%bind typed,_ = Compile.Of_simplified.compile (Contract entry_point) simplified in
let%bind mini_c = Compile.Of_typed.compile typed 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 michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c entry_point in
let%bind contract = Compile.Of_michelson.build_contract michelson in let%bind contract = Compile.Of_michelson.build_contract ~disable_typecheck 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 =
Term.(const f $ source_file 0 $ entry_point 1 $ syntax $ display_format $ michelson_code_format) in Term.(const f $ source_file 0 $ entry_point 1 $ syntax $ display_format $ disable_michelson_typechecking $ michelson_code_format) in
let cmdname = "compile-contract" in let cmdname = "compile-contract" in
let doc = "Subcommand: Compile a contract." in let doc = "Subcommand: Compile a contract." in
(Term.ret term , Term.info ~doc cmdname) (Term.ret term , Term.info ~doc cmdname)
@ -161,8 +167,8 @@ let print_cst =
let print_ast = let print_ast =
let f source_file syntax display_format = ( let f source_file syntax display_format = (
toplevel ~display_format @@ toplevel ~display_format @@
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in let%bind core = Compile.Utils.to_core source_file syntax in
ok @@ Format.asprintf "%a\n" Compile.Of_simplified.pretty_print simplified ok @@ Format.asprintf "%a\n" Compile.Of_core.pretty_print core
) )
in in
let term = Term.(const f $ source_file 0 $ syntax $ display_format) in let term = Term.(const f $ source_file 0 $ syntax $ display_format) in
@ -173,8 +179,7 @@ let print_ast =
let print_typed_ast = let print_typed_ast =
let f source_file syntax display_format = ( let f source_file 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,_ = Compile.Utils.type_file source_file syntax Env in
let%bind typed,_ = Compile.Of_simplified.compile Env simplified in
ok @@ Format.asprintf "%a\n" Compile.Of_typed.pretty_print typed ok @@ Format.asprintf "%a\n" Compile.Of_typed.pretty_print typed
) )
in in
@ -186,8 +191,7 @@ let print_typed_ast =
let print_mini_c = let print_mini_c =
let f source_file syntax display_format = ( let f source_file 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,_ = Compile.Utils.type_file source_file syntax Env in
let%bind typed,_ = Compile.Of_simplified.compile Env simplified in
let%bind mini_c = Compile.Of_typed.compile typed in let%bind mini_c = Compile.Of_typed.compile typed in
ok @@ Format.asprintf "%a\n" Compile.Of_mini_c.pretty_print mini_c ok @@ Format.asprintf "%a\n" Compile.Of_mini_c.pretty_print mini_c
) )
@ -200,11 +204,7 @@ let print_mini_c =
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 simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in let%bind contract = Compile.Utils.compile_file source_file syntax entry_point in
let%bind typed,_ = Compile.Of_simplified.compile (Contract entry_point) 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_michelson.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
@ -217,8 +217,7 @@ let measure_contract =
let compile_parameter = let compile_parameter =
let f source_file entry_point expression syntax amount balance sender source predecessor_timestamp display_format michelson_format = let f source_file entry_point expression syntax amount balance sender source predecessor_timestamp display_format michelson_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.Utils.type_file source_file syntax (Contract entry_point) in
let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in
let%bind mini_c_prg = Compile.Of_typed.compile 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 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 env = Ast_typed.program_environment typed_prg in
@ -226,9 +225,7 @@ let compile_parameter =
(* fails if the given entry point is not a valid contract *) (* fails if the given entry point is not a valid contract *)
Compile.Of_michelson.build_contract michelson_prg in Compile.Of_michelson.build_contract michelson_prg in
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in let%bind (typed_param,_) = Compile.Utils.type_expression (Some source_file) syntax expression env state in
let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in
let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param 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 mini_c_param in let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in
let%bind () = Compile.Of_typed.assert_equal_contract_type Check_parameter entry_point typed_prg typed_param in let%bind () = Compile.Of_typed.assert_equal_contract_type Check_parameter entry_point typed_prg typed_param in
@ -248,16 +245,13 @@ let interpret =
toplevel ~display_format @@ toplevel ~display_format @@
let%bind (decl_list,state,env) = match init_file with let%bind (decl_list,state,env) = match init_file with
| Some init_file -> | Some init_file ->
let%bind simplified = Compile.Of_source.compile init_file (Syntax_name syntax) in let%bind typed_prg,state = Compile.Utils.type_file init_file syntax Env in
let%bind typed_prg,state = Compile.Of_simplified.compile Env simplified in
let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in
let env = Ast_typed.program_environment typed_prg in let env = Ast_typed.program_environment typed_prg in
ok (mini_c_prg,state,env) ok (mini_c_prg,state,env)
| None -> ok ([],Typer.Solver.initial_state,Ast_typed.Environment.full_empty) in | None -> ok ([],Typer.Solver.initial_state,Ast_typed.Environment.full_empty) in
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) init_file in let%bind (typed_exp,_) = Compile.Utils.type_expression init_file syntax expression env state in
let%bind simplified_exp = Compile.Of_source.compile_expression v_syntax expression in
let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_exp in
let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in
let%bind compiled_exp = Compile.Of_mini_c.aggregate_and_compile_expression decl_list mini_c_exp in let%bind compiled_exp = Compile.Of_mini_c.aggregate_and_compile_expression decl_list mini_c_exp in
let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in
@ -267,8 +261,8 @@ let interpret =
let%bind failstring = Run.failwith_to_string fail_res in let%bind failstring = Run.failwith_to_string fail_res in
ok @@ Format.asprintf "%s" failstring ok @@ Format.asprintf "%s" failstring
| Success value' -> | Success value' ->
let%bind simplified_output = Uncompile.uncompile_expression typed_exp.type_expression value' in let%bind core_output = Uncompile.uncompile_expression typed_exp.type_expression value' in
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output ok @@ Format.asprintf "%a\n" Ast_core.PP.expression core_output
in in
let term = let term =
Term.(const f $ expression "EXPRESSION" 0 $ init_file $ syntax $ amount $ balance $ sender $ source $ predecessor_timestamp $ display_format ) in Term.(const f $ expression "EXPRESSION" 0 $ init_file $ syntax $ amount $ balance $ sender $ source $ predecessor_timestamp $ display_format ) in
@ -279,8 +273,7 @@ let interpret =
let temp_ligo_interpreter = let temp_ligo_interpreter =
let f source_file syntax display_format = let f source_file 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,_ = Compile.Utils.type_file source_file syntax Env in
let%bind typed,_ = Compile.Of_simplified.compile Env simplified in
let%bind res = Compile.Of_typed.some_interpret typed in let%bind res = Compile.Of_typed.some_interpret typed in
ok @@ Format.asprintf "%s\n" res ok @@ Format.asprintf "%s\n" res
in in
@ -293,8 +286,7 @@ let temp_ligo_interpreter =
let compile_storage = let compile_storage =
let f source_file entry_point expression syntax amount balance sender source predecessor_timestamp display_format michelson_format = let f source_file entry_point expression syntax amount balance sender source predecessor_timestamp display_format michelson_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.Utils.type_file source_file syntax (Contract entry_point) in
let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in
let%bind mini_c_prg = Compile.Of_typed.compile 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 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 env = Ast_typed.program_environment typed_prg in
@ -302,9 +294,7 @@ let compile_storage =
(* fails if the given entry point is not a valid contract *) (* fails if the given entry point is not a valid contract *)
Compile.Of_michelson.build_contract michelson_prg in Compile.Of_michelson.build_contract michelson_prg in
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in let%bind (typed_param,_) = Compile.Utils.type_expression (Some source_file) syntax expression env state in
let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in
let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param 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 mini_c_param in let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in
let%bind () = Compile.Of_typed.assert_equal_contract_type Check_storage entry_point typed_prg typed_param in let%bind () = Compile.Of_typed.assert_equal_contract_type Check_storage entry_point typed_prg typed_param in
@ -322,8 +312,7 @@ let compile_storage =
let dry_run = let dry_run =
let f source_file entry_point storage input amount balance sender source predecessor_timestamp syntax display_format = let f source_file entry_point storage input amount balance sender source predecessor_timestamp 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.Utils.type_file source_file syntax (Contract entry_point) in
let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in
let env = Ast_typed.program_environment typed_prg in let env = Ast_typed.program_environment typed_prg in
let%bind mini_c_prg = Compile.Of_typed.compile 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 michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in
@ -331,11 +320,7 @@ let dry_run =
(* fails if the given entry point is not a valid contract *) (* fails if the given entry point is not a valid contract *)
Compile.Of_michelson.build_contract michelson_prg in Compile.Of_michelson.build_contract michelson_prg in
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in let%bind compiled_params = Compile.Utils.compile_storage storage input source_file syntax env state mini_c_prg in
let%bind simplified = Compile.Of_source.compile_contract_input storage input v_syntax in
let%bind typed,_ = Compile.Of_simplified.compile_expression ~env ~state simplified in
let%bind mini_c = Compile.Of_typed.compile_expression typed in
let%bind compiled_params = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c in
let%bind args_michelson = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in let%bind args_michelson = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in
let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in
@ -345,8 +330,8 @@ let dry_run =
let%bind failstring = Run.failwith_to_string fail_res in let%bind failstring = Run.failwith_to_string fail_res in
ok @@ Format.asprintf "%s" failstring ok @@ Format.asprintf "%s" failstring
| Success michelson_output -> | Success michelson_output ->
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in let%bind core_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_core.PP.expression core_output
in in
let term = let term =
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
@ -357,16 +342,17 @@ let dry_run =
let run_function = let run_function =
let f source_file entry_point parameter amount balance sender source predecessor_timestamp syntax display_format = let f source_file entry_point parameter amount balance sender source predecessor_timestamp 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 typed_prg,state = Compile.Utils.type_file source_file syntax Env in
let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed_prg,state = Compile.Of_simplified.compile Env simplified_prg in
let env = Ast_typed.program_environment typed_prg in let env = Ast_typed.program_environment typed_prg in
let%bind mini_c_prg = Compile.Of_typed.compile typed_prg 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 v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
let%bind app = Compile.Of_simplified.apply entry_point simplified_param in let%bind imperative_param = Compile.Of_source.compile_expression v_syntax parameter in
let%bind (typed_app,_) = Compile.Of_simplified.compile_expression ~env ~state app in let%bind sugar_param = Compile.Of_imperative.compile_expression imperative_param in
let%bind core_param = Compile.Of_sugar.compile_expression sugar_param in
let%bind app = Compile.Of_core.apply entry_point core_param in
let%bind (typed_app,_) = Compile.Of_core.compile_expression ~env ~state app in
let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in
let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in
@ -377,8 +363,8 @@ let run_function =
let%bind failstring = Run.failwith_to_string fail_res in let%bind failstring = Run.failwith_to_string fail_res in
ok @@ Format.asprintf "%s" failstring ok @@ Format.asprintf "%s" failstring
| Success michelson_output -> | Success michelson_output ->
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in let%bind core_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_core.PP.expression core_output
in in
let term = let term =
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
@ -389,15 +375,14 @@ let run_function =
let evaluate_value = let evaluate_value =
let f source_file entry_point amount balance sender source predecessor_timestamp syntax display_format = let f source_file entry_point amount balance sender source predecessor_timestamp 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,_ = Compile.Utils.type_file source_file syntax Env in
let%bind typed_prg,_ = Compile.Of_simplified.compile Env simplified in
let%bind mini_c = Compile.Of_typed.compile typed_prg 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 (exp,_) = Mini_c.get_entry mini_c entry_point in
let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in
let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in
let%bind michelson_output = Run.run_no_failwith ~options compiled.expr compiled.expr_ty in let%bind michelson_output = Run.run_no_failwith ~options compiled.expr compiled.expr_ty in
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in let%bind core_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_core.PP.expression core_output
in in
let term = let term =
Term.(const f $ source_file 0 $ entry_point 1 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in Term.(const f $ source_file 0 $ entry_point 1 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
@ -408,13 +393,9 @@ let evaluate_value =
let compile_expression = 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 env = Ast_typed.Environment.full_empty in let env = Ast_typed.Environment.full_empty in
let state = Typer.Solver.initial_state in let state = Typer.Solver.initial_state in
let%bind simplified = Compile.Of_source.compile_expression v_syntax expression in let%bind compiled_exp = Compile.Utils.compile_expression None syntax expression env state 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 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
@ -435,8 +416,8 @@ let dump_changelog =
let list_declarations = let list_declarations =
let f source_file syntax = let f source_file syntax =
toplevel ~display_format:(`Human_readable) @@ toplevel ~display_format:(`Human_readable) @@
let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in let%bind core_prg = Compile.Utils.to_core source_file syntax in
let json_decl = List.map (fun decl -> `String decl) @@ Compile.Of_simplified.list_declarations simplified_prg in let json_decl = List.map (fun decl -> `String decl) @@ Compile.Of_core.list_declarations core_prg in
ok @@ J.to_string @@ `Assoc [ ("source_file", `String source_file) ; ("declarations", `List json_decl) ] ok @@ J.to_string @@ `Assoc [ ("source_file", `String source_file) ; ("declarations", `List json_decl) ]
in in
let term = let term =

View File

@ -1174,7 +1174,7 @@ let%expect_test _ =
let%expect_test _ = let%expect_test _ =
run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ; run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ;
[%expect {| [%expect {|
ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * string ):Some(( nat * string ))) : None return let rhs#809 = #P in let p = rhs#809.0 in let s = rhs#809.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"} ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#654 = #P in let p = rhs#654.0 in let s = rhs#654.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
If you're not sure how to fix this error, you can If you're not sure how to fix this error, you can
@ -1187,7 +1187,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8,
run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ; run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ;
[%expect {| [%expect {|
ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * int ):Some(( nat * int ))) : None return let rhs#812 = #P in let p = rhs#812.0 in let s = rhs#812.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"} ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#657 = #P in let p = rhs#657.0 in let s = rhs#657.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
If you're not sure how to fix this error, you can If you're not sure how to fix this error, you can

View File

@ -176,6 +176,10 @@ let%expect_test _ =
SOURCE_FILE is the path to the smart contract file. SOURCE_FILE is the path to the smart contract file.
OPTIONS OPTIONS
--disable-michelson-typechecking
disable Michelson typecking, this might produce ill-typed
Michelson code.
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT --format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
(absent=human-readable) (absent=human-readable)
DISPLAY_FORMAT is the format that will be used by the CLI. DISPLAY_FORMAT is the format that will be used by the CLI.

View File

@ -53,4 +53,7 @@ let%expect_test _ =
val s = { ; 1 : int ; 2 : int ; 3 : int} val s = { ; 1 : int ; 2 : int ; 3 : int}
val set_add = { ; 0 = ({ ; 1 : int ; 2 : int ; 3 : int}) ; 1 = ({ ; 1 : int ; 2 : int ; 3 : int ; 4 : int}) ; 2 = ({ ; 1 : int}) } val set_add = { ; 0 = ({ ; 1 : int ; 2 : int ; 3 : int}) ; 1 = ({ ; 1 : int ; 2 : int ; 3 : int ; 4 : int}) ; 2 = ({ ; 1 : int}) }
val set_iter_fail = "set_iter_fail" : failure val set_iter_fail = "set_iter_fail" : failure
val set_mem = { ; 0 = (true) ; 1 = (false) ; 2 = (false) } |}] ; val set_mem = { ; 0 = (true) ; 1 = (false) ; 2 = (false) }
val recursion_let_rec_in = 55 : int
val sum_rec = <rec fun>
val top_level_recursion = 55 : int |}] ;

View File

@ -32,6 +32,19 @@ let%expect_test _ =
ligo: in file "", line 0, characters 0-0. different kinds: {"a":"( (TO_list(operation)) * sum[Add -> int , Sub -> int] )","b":"sum[Add -> int , Sub -> int]"} ligo: in file "", line 0, characters 0-0. different kinds: {"a":"( (TO_list(operation)) * sum[Add -> int , Sub -> int] )","b":"sum[Add -> int , Sub -> int]"}
If you're not sure how to fix this error, you can
do one of the following:
* Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
* Ask a question on our Discord: https://discord.gg/9rhYaEt
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
* Check the changelog by running 'ligo changelog' |}];
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_no_tail_recursive_function.mligo"; "f"];
[%expect {|
ligo: in file "error_no_tail_recursive_function.mligo", line 2, characters 14-21. Recursion must be achieved through tail-calls only: {"function":"unvalid","location":"in file \"error_no_tail_recursive_function.mligo\", line 2, characters 14-21"}
If you're not sure how to fix this error, you can If you're not sure how to fix this error, you can
do one of the following: do one of the following:

View File

@ -5,14 +5,20 @@
simple-utils simple-utils
tezos-utils tezos-utils
parser parser
simplify concrete_to_imperative
interpreter ast_imperative
ast_simplified self_ast_imperative
self_ast_simplified imperative_to_sugar
self_ast_typed ast_sugar
self_ast_sugar
sugar_to_core
ast_core
self_ast_core
typer_new typer_new
typer typer
ast_typed ast_typed
self_ast_typed
interpreter
transpiler transpiler
mini_c mini_c
self_mini_c self_mini_c

View File

@ -23,55 +23,55 @@ let parsify_pascaligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing") @@ trace (simple_error "parsing") @@
Parser.Pascaligo.parse_file source in Parser.Pascaligo.parse_file source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying") @@ trace (simple_error "abstracting") @@
Simplify.Pascaligo.simpl_program raw Concrete_to_imperative.Pascaligo.compile_program raw
in ok simplified in ok imperative
let parsify_expression_pascaligo source = let parsify_expression_pascaligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing expression") @@ trace (simple_error "parsing expression") @@
Parser.Pascaligo.parse_expression source in Parser.Pascaligo.parse_expression source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying expression") @@ trace (simple_error "abstracting expression") @@
Simplify.Pascaligo.simpl_expression raw Concrete_to_imperative.Pascaligo.compile_expression raw
in ok simplified in ok imperative
let parsify_cameligo source = let parsify_cameligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing") @@ trace (simple_error "parsing") @@
Parser.Cameligo.parse_file source in Parser.Cameligo.parse_file source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying") @@ trace (simple_error "abstracting") @@
Simplify.Cameligo.simpl_program raw Concrete_to_imperative.Cameligo.compile_program raw
in ok simplified in ok imperative
let parsify_expression_cameligo source = let parsify_expression_cameligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing expression") @@ trace (simple_error "parsing expression") @@
Parser.Cameligo.parse_expression source in Parser.Cameligo.parse_expression source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying expression") @@ trace (simple_error "abstracting expression") @@
Simplify.Cameligo.simpl_expression raw Concrete_to_imperative.Cameligo.compile_expression raw
in ok simplified in ok imperative
let parsify_reasonligo source = let parsify_reasonligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing") @@ trace (simple_error "parsing") @@
Parser.Reasonligo.parse_file source in Parser.Reasonligo.parse_file source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying") @@ trace (simple_error "abstracting") @@
Simplify.Cameligo.simpl_program raw Concrete_to_imperative.Cameligo.compile_program raw
in ok simplified in ok imperative
let parsify_expression_reasonligo source = let parsify_expression_reasonligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing expression") @@ trace (simple_error "parsing expression") @@
Parser.Reasonligo.parse_expression source in Parser.Reasonligo.parse_expression source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying expression") @@ trace (simple_error "abstracting expression") @@
Simplify.Cameligo.simpl_expression raw Concrete_to_imperative.Cameligo.compile_expression raw
in ok simplified in ok imperative
let parsify syntax source = let parsify syntax source =
let%bind parsify = let%bind parsify =
@ -80,7 +80,7 @@ let parsify syntax source =
| CameLIGO -> ok parsify_cameligo | CameLIGO -> ok parsify_cameligo
| ReasonLIGO -> ok parsify_reasonligo in | ReasonLIGO -> ok parsify_reasonligo in
let%bind parsified = parsify source in let%bind parsified = parsify source in
let%bind applied = Self_ast_simplified.all_program parsified let%bind applied = Self_ast_imperative.all_program parsified
in ok applied in ok applied
let parsify_expression syntax source = let parsify_expression syntax source =
@ -89,35 +89,35 @@ let parsify_expression syntax source =
| CameLIGO -> ok parsify_expression_cameligo | CameLIGO -> ok parsify_expression_cameligo
| ReasonLIGO -> ok parsify_expression_reasonligo in | ReasonLIGO -> ok parsify_expression_reasonligo in
let%bind parsified = parsify source in let%bind parsified = parsify source in
let%bind applied = Self_ast_simplified.all_expression parsified let%bind applied = Self_ast_imperative.all_expression parsified
in ok applied in ok applied
let parsify_string_reasonligo source = let parsify_string_reasonligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing") @@ trace (simple_error "parsing") @@
Parser.Reasonligo.parse_string source in Parser.Reasonligo.parse_string source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying") @@ trace (simple_error "abstracting") @@
Simplify.Cameligo.simpl_program raw Concrete_to_imperative.Cameligo.compile_program raw
in ok simplified in ok imperative
let parsify_string_pascaligo source = let parsify_string_pascaligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing") @@ trace (simple_error "parsing") @@
Parser.Pascaligo.parse_string source in Parser.Pascaligo.parse_string source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying") @@ trace (simple_error "abstracting") @@
Simplify.Pascaligo.simpl_program raw Concrete_to_imperative.Pascaligo.compile_program raw
in ok simplified in ok imperative
let parsify_string_cameligo source = let parsify_string_cameligo source =
let%bind raw = let%bind raw =
trace (simple_error "parsing") @@ trace (simple_error "parsing") @@
Parser.Cameligo.parse_string source in Parser.Cameligo.parse_string source in
let%bind simplified = let%bind imperative =
trace (simple_error "simplifying") @@ trace (simple_error "abstracting") @@
Simplify.Cameligo.simpl_program raw Concrete_to_imperative.Cameligo.compile_program raw
in ok simplified in ok imperative
let parsify_string syntax source = let parsify_string syntax source =
let%bind parsify = let%bind parsify =
@ -126,7 +126,7 @@ let parsify_string syntax source =
| CameLIGO -> ok parsify_string_cameligo | CameLIGO -> ok parsify_string_cameligo
| ReasonLIGO -> ok parsify_string_reasonligo in | ReasonLIGO -> ok parsify_string_reasonligo in
let%bind parsified = parsify source in let%bind parsified = parsify source in
let%bind applied = Self_ast_simplified.all_program parsified let%bind applied = Self_ast_imperative.all_program parsified
in ok applied in ok applied
let pretty_print_pascaligo source = let pretty_print_pascaligo source =

View File

@ -4,39 +4,40 @@ type form =
| Contract of string | Contract of string
| Env | Env
let compile (cform: form) (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solver.state) result = let compile (cform: form) (program : Ast_core.program) : (Ast_typed.program * Typer.Solver.state) result =
let%bind (prog_typed , state) = Typer.type_program program in let%bind (prog_typed , state) = Typer.type_program program in
let () = Typer.Solver.discard_state state in let () = Typer.Solver.discard_state state in
let%bind prog_typed' = match cform with let%bind applied = Self_ast_typed.all_program prog_typed in
| Contract entrypoint -> Self_ast_typed.all_contract entrypoint prog_typed let%bind applied' = match cform with
| Env -> ok prog_typed in | Contract entrypoint -> Self_ast_typed.all_contract entrypoint applied
ok @@ (prog_typed', state) | Env -> ok applied in
ok @@ (applied', state)
let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (e : Ast_core.expression)
: (Ast_typed.expression * Typer.Solver.state) result = : (Ast_typed.expression * Typer.Solver.state) result =
let%bind (ae_typed,state) = Typer.type_expression_subst env state ae in let%bind (ae_typed,state) = Typer.type_expression_subst env state e in
let () = Typer.Solver.discard_state state in let () = Typer.Solver.discard_state state in
let%bind ae_typed' = Self_ast_typed.all_expression ae_typed in let%bind ae_typed' = Self_ast_typed.all_expression ae_typed in
ok @@ (ae_typed',state) ok @@ (ae_typed',state)
let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simplified.expression result = let apply (entry_point : string) (param : Ast_core.expression) : Ast_core.expression result =
let name = Var.of_name entry_point in let name = Var.of_name entry_point in
let entry_point_var : Ast_simplified.expression = let entry_point_var : Ast_core.expression =
{ expression_content = Ast_simplified.E_variable name ; { expression_content = Ast_core.E_variable name ;
location = Virtual "generated entry-point variable" } in location = Virtual "generated entry-point variable" } in
let applied : Ast_simplified.expression = let applied : Ast_core.expression =
{ expression_content = Ast_simplified.E_application {expr1=entry_point_var; expr2=param} ; { expression_content = Ast_core.E_application {lamb=entry_point_var; args=param} ;
location = Virtual "generated application" } in location = Virtual "generated application" } in
ok applied ok applied
let pretty_print formatter (program : Ast_simplified.program) = let pretty_print formatter (program : Ast_core.program) =
Ast_simplified.PP.program formatter program Ast_core.PP.program formatter program
let list_declarations (program : Ast_simplified.program) : string list = let list_declarations (program : Ast_core.program) : string list =
List.fold_left List.fold_left
(fun prev el -> (fun prev el ->
let open Location in let open Location in
let open Ast_simplified in let open Ast_core in
match el.wrap_content with match el.wrap_content with
| Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
| _ -> prev) | _ -> prev)

View File

@ -0,0 +1,25 @@
open Trace
open Ast_imperative
open Imperative_to_sugar
type form =
| Contract of string
| Env
let compile (program : program) : Ast_sugar.program result =
compile_program program
let compile_expression (e : expression) : Ast_sugar.expression result =
compile_expression e
let pretty_print formatter (program : program) =
PP.program formatter program
let list_declarations (program : program) : string list =
List.fold_left
(fun prev el ->
let open Location in
match el.wrap_content with
| Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
| _ -> prev)
[] program

View File

@ -32,8 +32,8 @@ module Errors = struct
error title_type_check_msg message error title_type_check_msg message
end end
let build_contract : Compiler.compiled_expression -> Michelson.michelson result = let build_contract : ?disable_typecheck:bool -> Compiler.compiled_expression -> Michelson.michelson result =
fun compiled -> fun ?(disable_typecheck= false) compiled ->
let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_contract_inputs compiled.expr_ty in let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_contract_inputs compiled.expr_ty in
let%bind param_michelson = let%bind param_michelson =
Trace.trace_tzresult_lwt (simple_error "Could not unparse parameter") @@ Trace.trace_tzresult_lwt (simple_error "Could not unparse parameter") @@
@ -42,16 +42,19 @@ let build_contract : Compiler.compiled_expression -> Michelson.michelson result
Trace.trace_tzresult_lwt (simple_error "Could not unparse storage") @@ Trace.trace_tzresult_lwt (simple_error "Could not unparse storage") @@
Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in
let contract = Michelson.contract param_michelson storage_michelson compiled.expr in let contract = Michelson.contract param_michelson storage_michelson compiled.expr in
let%bind res = if disable_typecheck then
Trace.trace_tzresult_lwt (simple_error "Could not typecheck the code") @@ ok contract
Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in else
match res with let%bind res =
| Type_checked -> ok contract Trace.trace_tzresult_lwt (simple_error "Could not typecheck the code") @@
| Err_parameter -> fail @@ Errors.bad_parameter contract () Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
| Err_storage -> fail @@ Errors.bad_storage contract () match res with
| Err_contract -> fail @@ Errors.bad_contract contract () | Type_checked -> ok contract
| Err_gas -> fail @@ Errors.ran_out_of_gas () | Err_parameter -> fail @@ Errors.bad_parameter contract ()
| Err_unknown -> fail @@ Errors.unknown () | Err_storage -> fail @@ Errors.bad_storage contract ()
| Err_contract -> fail @@ Errors.bad_contract contract ()
| Err_gas -> fail @@ Errors.ran_out_of_gas ()
| Err_unknown -> fail @@ Errors.unknown ()
type check_type = Check_parameter | Check_storage type check_type = Check_parameter | Check_storage
let assert_equal_contract_type : check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> unit result = let assert_equal_contract_type : check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> unit result =

View File

@ -1,23 +1,23 @@
open Trace open Trace
open Helpers open Helpers
let compile (source_filename:string) syntax : Ast_simplified.program result = let compile (source_filename:string) syntax : Ast_imperative.program result =
let%bind syntax = syntax_to_variant syntax (Some source_filename) in let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind simplified = parsify syntax source_filename in let%bind abstract = parsify syntax source_filename in
ok simplified ok abstract
let compile_string (source:string) syntax : Ast_simplified.program result = let compile_string (source:string) syntax : Ast_imperative.program result =
let%bind simplified = parsify_string syntax source in let%bind abstract = parsify_string syntax source in
ok simplified ok abstract
let compile_expression : v_syntax -> string -> Ast_simplified.expression result = let compile_expression : v_syntax -> string -> Ast_imperative.expression result =
fun syntax exp -> fun syntax exp ->
parsify_expression syntax exp parsify_expression syntax exp
let compile_contract_input : string -> string -> v_syntax -> Ast_simplified.expression result = let compile_contract_input : string -> string -> v_syntax -> Ast_imperative.expression result =
fun storage parameter syntax -> fun storage parameter syntax ->
let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in
ok @@ Ast_simplified.e_pair storage parameter ok @@ Ast_imperative.e_pair storage parameter
let pretty_print source_filename syntax = let pretty_print source_filename syntax =
Helpers.pretty_print syntax source_filename Helpers.pretty_print syntax source_filename

View File

@ -0,0 +1,25 @@
open Trace
open Ast_sugar
open Sugar_to_core
type form =
| Contract of string
| Env
let compile (program : program) : Ast_core.program result =
compile_program program
let compile_expression (e : expression) : Ast_core.expression result =
compile_expression e
let pretty_print formatter (program : program) =
PP.program formatter program
let list_declarations (program : program) : string list =
List.fold_left
(fun prev el ->
let open Location in
match el.wrap_content with
| Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
| _ -> prev)
[] program

65
src/main/compile/utils.ml Normal file
View File

@ -0,0 +1,65 @@
open Trace
let to_imperatve f stx =
let%bind imperative = Of_source.compile f (Syntax_name stx) in
ok @@ imperative
let to_sugar f stx =
let%bind imperative = to_imperatve f stx in
let%bind sugar = Of_imperative.compile imperative in
ok @@ sugar
let to_core f stx =
let%bind sugar = to_sugar f stx in
let%bind core = Of_sugar.compile sugar in
ok @@ core
let type_file f stx env =
let%bind core = to_core f stx in
let%bind typed,state = Of_core.compile env core in
ok @@ (typed,state)
let to_mini_c f stx env =
let%bind typed, _ = type_file f stx env in
let%bind mini_c = Of_typed.compile typed in
ok @@ mini_c
let compile_file f stx ep =
let%bind typed, _ = type_file f stx @@ Contract ep in
let%bind mini_c = Of_typed.compile typed in
let%bind michelson = Of_mini_c.aggregate_and_compile_contract mini_c ep in
let%bind contract = Of_michelson.build_contract michelson in
ok @@ contract
let type_expression source_file syntax expression env state =
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) source_file in
let%bind imperative_exp = Of_source.compile_expression v_syntax expression in
let%bind sugar_exp = Of_imperative.compile_expression imperative_exp in
let%bind core_exp = Of_sugar.compile_expression sugar_exp in
let%bind (typed_exp,state) = Of_core.compile_expression ~env ~state core_exp in
ok @@ (typed_exp,state)
let expression_to_mini_c source_file syntax expression env state =
let%bind (typed_exp,_) = type_expression source_file syntax expression env state in
let%bind mini_c_exp = Of_typed.compile_expression typed_exp in
ok @@ mini_c_exp
let compile_expression source_file syntax expression env state =
let%bind mini_c_exp = expression_to_mini_c source_file syntax expression env state in
let%bind compiled = Of_mini_c.compile_expression mini_c_exp in
ok @@ compiled
let compile_and_aggregate_expression source_file syntax expression env state mini_c_prg =
let%bind mini_c_exp = expression_to_mini_c source_file syntax expression env state in
let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_exp in
ok @@ compiled
let compile_storage storage input source_file syntax env state mini_c_prg =
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
let%bind imperative = Of_source.compile_contract_input storage input v_syntax in
let%bind sugar = Of_imperative.compile_expression imperative in
let%bind core = Of_sugar.compile_expression sugar in
let%bind typed,_ = Of_core.compile_expression ~env ~state core in
let%bind mini_c = Of_typed.compile_expression typed in
let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c in
ok @@ compiled

View File

@ -5,8 +5,10 @@
simple-utils simple-utils
tezos-utils tezos-utils
parser parser
simplify concrete_to_imperative
ast_simplified self_ast_imperative
sugar_to_core
ast_core
typer_new typer_new
typer typer
ast_typed ast_typed

View File

@ -4,6 +4,8 @@
(libraries (libraries
simple-utils simple-utils
compiler compiler
imperative_to_sugar
sugar_to_core
typer_new typer_new
typer typer
ast_typed ast_typed

View File

@ -10,7 +10,8 @@ let uncompile_value func_or_expr program entry ex_ty_value =
ok output_type in ok output_type in
let%bind mini_c = Compiler.Uncompiler.translate_value ex_ty_value in let%bind mini_c = Compiler.Uncompiler.translate_value ex_ty_value in
let%bind typed = Transpiler.untranspile mini_c output_type in let%bind typed = Transpiler.untranspile mini_c output_type in
Typer.untype_expression typed let%bind core = Typer.untype_expression typed in
ok @@ core
let uncompile_typed_program_entry_expression_result program entry ex_ty_value = let uncompile_typed_program_entry_expression_result program entry ex_ty_value =
uncompile_value Expression program entry ex_ty_value uncompile_value Expression program entry ex_ty_value

View File

@ -30,6 +30,7 @@ type kwd_else = Region.t
type kwd_end = Region.t type kwd_end = Region.t
type kwd_false = Region.t type kwd_false = Region.t
type kwd_fun = Region.t type kwd_fun = Region.t
type kwd_rec = Region.t
type kwd_if = Region.t type kwd_if = Region.t
type kwd_in = Region.t type kwd_in = Region.t
type kwd_let = Region.t type kwd_let = Region.t
@ -134,7 +135,7 @@ and ast = t
and attributes = attribute list and attributes = attribute list
and declaration = and declaration =
Let of (kwd_let * let_binding * attributes) reg Let of (kwd_let * kwd_rec option * let_binding * attributes) reg
| TypeDecl of type_decl reg | TypeDecl of type_decl reg
(* Non-recursive values *) (* Non-recursive values *)
@ -362,6 +363,7 @@ and 'a case_clause = {
and let_in = { and let_in = {
kwd_let : kwd_let; kwd_let : kwd_let;
kwd_rec : kwd_rec option;
binding : let_binding; binding : let_binding;
kwd_in : kwd_in; kwd_in : kwd_in;
body : expr; body : expr;

View File

@ -95,6 +95,7 @@ type t =
| End of Region.t | End of Region.t
| False of Region.t | False of Region.t
| Fun of Region.t | Fun of Region.t
| Rec of Region.t
| If of Region.t | If of Region.t
| In of Region.t | In of Region.t
| Let of Region.t | Let of Region.t

View File

@ -79,6 +79,7 @@ type t =
| End of Region.t | End of Region.t
| False of Region.t | False of Region.t
| Fun of Region.t | Fun of Region.t
| Rec of Region.t
| If of Region.t | If of Region.t
| In of Region.t | In of Region.t
| Let of Region.t | Let of Region.t
@ -154,6 +155,7 @@ let proj_token = function
| End region -> region, "End" | End region -> region, "End"
| False region -> region, "False" | False region -> region, "False"
| Fun region -> region, "Fun" | Fun region -> region, "Fun"
| Rec region -> region, "Rec"
| If region -> region, "If" | If region -> region, "If"
| In region -> region, "In" | In region -> region, "In"
| Let region -> region, "Let" | Let region -> region, "Let"
@ -213,6 +215,7 @@ let to_lexeme = function
| End _ -> "end" | End _ -> "end"
| False _ -> "false" | False _ -> "false"
| Fun _ -> "fun" | Fun _ -> "fun"
| Rec _ -> "rec"
| If _ -> "if" | If _ -> "if"
| In _ -> "in" | In _ -> "in"
| Let _ -> "let" | Let _ -> "let"
@ -250,6 +253,7 @@ let keywords = [
(fun reg -> End reg); (fun reg -> End reg);
(fun reg -> False reg); (fun reg -> False reg);
(fun reg -> Fun reg); (fun reg -> Fun reg);
(fun reg -> Rec reg);
(fun reg -> If reg); (fun reg -> If reg);
(fun reg -> In reg); (fun reg -> In reg);
(fun reg -> Let reg); (fun reg -> Let reg);
@ -291,7 +295,6 @@ let reserved =
|> add "object" |> add "object"
|> add "open" |> add "open"
|> add "private" |> add "private"
|> add "rec"
|> add "sig" |> add "sig"
|> add "struct" |> add "struct"
|> add "to" |> add "to"
@ -499,6 +502,7 @@ let is_kwd = function
| End _ | End _
| False _ | False _
| Fun _ | Fun _
| Rec _
| If _ | If _
| In _ | In _
| Let _ | Let _

View File

@ -59,6 +59,7 @@
%token <Region.t> End "end" %token <Region.t> End "end"
%token <Region.t> False "false" %token <Region.t> False "false"
%token <Region.t> Fun "fun" %token <Region.t> Fun "fun"
%token <Region.t> Rec "rec"
%token <Region.t> If "if" %token <Region.t> If "if"
%token <Region.t> In "in" %token <Region.t> In "in"
%token <Region.t> Let "let" %token <Region.t> Let "let"

View File

@ -203,14 +203,15 @@ field_decl:
and value = {field_name=$1; colon=$2; field_type=$3} and value = {field_name=$1; colon=$2; field_type=$3}
in {region; value} } in {region; value} }
(* Top-level non-recursive definitions *) (* Top-level definitions *)
let_declaration: let_declaration:
"let" let_binding seq(Attr) { "let" ioption("rec") let_binding seq(Attr) {
let kwd_let = $1 in let kwd_let = $1 in
let attributes = $3 in let kwd_rec = $2 in
let binding = $2 in let attributes = $4 in
let value = kwd_let, binding, attributes in let binding = $3 in
let value = kwd_let, kwd_rec, binding, attributes in
let stop = expr_to_region binding.let_rhs in let stop = expr_to_region binding.let_rhs in
let region = cover $1 stop let region = cover $1 stop
in {region; value} } in {region; value} }
@ -453,15 +454,16 @@ case_clause(right_expr):
{pattern=$1; arrow=$2; rhs=$3} } {pattern=$1; arrow=$2; rhs=$3} }
let_expr(right_expr): let_expr(right_expr):
"let" let_binding seq(Attr) "in" right_expr { "let" ioption("rec") let_binding seq(Attr) "in" right_expr {
let kwd_let = $1 let kwd_let = $1
and binding = $2 and kwd_rec = $2
and attributes = $3 and binding = $3
and kwd_in = $4 and attributes = $4
and body = $5 in and kwd_in = $5
and body = $6 in
let stop = expr_to_region body in let stop = expr_to_region body in
let region = cover kwd_let stop let region = cover kwd_let stop
and value = {kwd_let; binding; kwd_in; body; attributes} and value = {kwd_let; kwd_rec; binding; kwd_in; body; attributes}
in ELetIn {region; value} } in ELetIn {region; value} }
fun_expr(right_expr): fun_expr(right_expr):

View File

@ -136,8 +136,9 @@ and print_attributes state attributes =
) attributes ) attributes
and print_statement state = function and print_statement state = function
Let {value=kwd_let, let_binding, attributes; _} -> Let {value=kwd_let, kwd_rec, let_binding, attributes; _} ->
print_token state kwd_let "let"; print_token state kwd_let "let";
print_token_opt state kwd_rec "rec";
print_let_binding state let_binding; print_let_binding state let_binding;
print_attributes state attributes print_attributes state attributes
| TypeDecl {value={kwd_type; name; eq; type_expr}; _} -> | TypeDecl {value={kwd_type; name; eq; type_expr}; _} ->
@ -544,8 +545,9 @@ and print_case_clause state {value; _} =
print_expr state rhs print_expr state rhs
and print_let_in state {value; _} = and print_let_in state {value; _} =
let {kwd_let; binding; kwd_in; body; attributes} = value in let {kwd_let; kwd_rec; binding; kwd_in; body; attributes} = value in
print_token state kwd_let "let"; print_token state kwd_let "let";
print_token_opt state kwd_rec "rec";
print_let_binding state binding; print_let_binding state binding;
print_attributes state attributes; print_attributes state attributes;
print_token state kwd_in "in"; print_token state kwd_in "in";
@ -616,9 +618,14 @@ let rec pp_ast state {decl; _} =
List.iteri (List.length decls |> apply) decls List.iteri (List.length decls |> apply) decls
and pp_declaration state = function and pp_declaration state = function
Let {value = (_, let_binding, attr); region} -> Let {value = (_, kwd_rec, let_binding, attr); region} ->
pp_loc_node state "Let" region; pp_loc_node state "Let" region;
(match kwd_rec with
| None -> ()
| Some (_) -> pp_node (state#pad 0 0) "rec"
);
pp_let_binding state let_binding attr; pp_let_binding state let_binding attr;
| TypeDecl {value; region} -> | TypeDecl {value; region} ->
pp_loc_node state "TypeDecl" region; pp_loc_node state "TypeDecl" region;
pp_type_decl state value pp_type_decl state value
@ -854,14 +861,21 @@ and pp_fun_expr state node =
in () in ()
and pp_let_in state node = and pp_let_in state node =
let {binding; body; attributes; _} = node in let {binding; body; attributes; kwd_rec; _} = node in
let {binders; lhs_type; let_rhs; _} = binding in let {binders; lhs_type; let_rhs; _} = binding in
let fields = if lhs_type = None then 3 else 4 in let fields = if lhs_type = None then 3 else 4 in
let fields = if kwd_rec = None then fields else fields+1 in
let fields = if attributes = [] then fields else fields+1 in let fields = if attributes = [] then fields else fields+1 in
let arity =
match kwd_rec with
None -> 0
| Some (_) ->
let state = state#pad fields 0 in
pp_node state "rec"; 0 in
let arity = let arity =
let state = state#pad fields 0 in let state = state#pad fields 0 in
pp_node state "<binders>"; pp_node state "<binders>";
pp_binders state binders; 0 in pp_binders state binders; arity in
let arity = let arity =
match lhs_type with match lhs_type with
None -> arity None -> arity

File diff suppressed because it is too large Load Diff

View File

@ -37,6 +37,7 @@ type kwd_end = Region.t
type kwd_for = Region.t type kwd_for = Region.t
type kwd_from = Region.t type kwd_from = Region.t
type kwd_function = Region.t type kwd_function = Region.t
type kwd_recursive = Region.t
type kwd_if = Region.t type kwd_if = Region.t
type kwd_in = Region.t type kwd_in = Region.t
type kwd_is = Region.t type kwd_is = Region.t
@ -201,6 +202,7 @@ and type_tuple = (type_expr, comma) nsepseq par reg
(* Function and procedure declarations *) (* Function and procedure declarations *)
and fun_expr = { and fun_expr = {
kwd_recursive: kwd_recursive option;
kwd_function : kwd_function; kwd_function : kwd_function;
param : parameters; param : parameters;
colon : colon; colon : colon;
@ -210,6 +212,7 @@ and fun_expr = {
} }
and fun_decl = { and fun_decl = {
kwd_recursive: kwd_recursive option;
kwd_function : kwd_function; kwd_function : kwd_function;
fun_name : variable; fun_name : variable;
param : parameters; param : parameters;

View File

@ -89,6 +89,7 @@ type t =
| For of Region.t (* "for" *) | For of Region.t (* "for" *)
| From of Region.t (* "from" *) | From of Region.t (* "from" *)
| Function of Region.t (* "function" *) | Function of Region.t (* "function" *)
| Recursive of Region.t (* "recursive" *)
| If of Region.t (* "if" *) | If of Region.t (* "if" *)
| In of Region.t (* "in" *) | In of Region.t (* "in" *)
| Is of Region.t (* "is" *) | Is of Region.t (* "is" *)

View File

@ -87,6 +87,7 @@ type t =
| For of Region.t (* "for" *) | For of Region.t (* "for" *)
| From of Region.t (* "from" *) | From of Region.t (* "from" *)
| Function of Region.t (* "function" *) | Function of Region.t (* "function" *)
| Recursive of Region.t (* "recursive" *)
| If of Region.t (* "if" *) | If of Region.t (* "if" *)
| In of Region.t (* "in" *) | In of Region.t (* "in" *)
| Is of Region.t (* "is" *) | Is of Region.t (* "is" *)
@ -199,6 +200,7 @@ let proj_token = function
| For region -> region, "For" | For region -> region, "For"
| From region -> region, "From" | From region -> region, "From"
| Function region -> region, "Function" | Function region -> region, "Function"
| Recursive region -> region, "Recursive"
| If region -> region, "If" | If region -> region, "If"
| In region -> region, "In" | In region -> region, "In"
| Is region -> region, "Is" | Is region -> region, "Is"
@ -289,6 +291,7 @@ let to_lexeme = function
| For _ -> "for" | For _ -> "for"
| From _ -> "from" | From _ -> "from"
| Function _ -> "function" | Function _ -> "function"
| Recursive _ -> "recursive"
| If _ -> "if" | If _ -> "if"
| In _ -> "in" | In _ -> "in"
| Is _ -> "is" | Is _ -> "is"
@ -361,6 +364,7 @@ let keywords = [
(fun reg -> Or reg); (fun reg -> Or reg);
(fun reg -> Patch reg); (fun reg -> Patch reg);
(fun reg -> Record reg); (fun reg -> Record reg);
(fun reg -> Recursive reg);
(fun reg -> Remove reg); (fun reg -> Remove reg);
(fun reg -> Set reg); (fun reg -> Set reg);
(fun reg -> Skip reg); (fun reg -> Skip reg);

View File

@ -57,6 +57,7 @@
%token <Region.t> False "False" %token <Region.t> False "False"
%token <Region.t> For "for" %token <Region.t> For "for"
%token <Region.t> Function "function" %token <Region.t> Function "function"
%token <Region.t> Recursive "recursive"
%token <Region.t> From "from" %token <Region.t> From "from"
%token <Region.t> If "if" %token <Region.t> If "if"
%token <Region.t> In "in" %token <Region.t> In "in"

View File

@ -237,49 +237,52 @@ field_decl:
fun_expr: fun_expr:
"function" parameters ":" type_expr "is" expr { | ioption ("recursive") "function" parameters ":" type_expr "is" expr {
let stop = expr_to_region $6 in let stop = expr_to_region $7 in
let region = cover $1 stop let region = cover $2 stop
and value = {kwd_function = $1; and value = {kwd_recursive= $1;
param = $2; kwd_function = $2;
colon = $3; param = $3;
ret_type = $4; colon = $4;
kwd_is = $5; ret_type = $5;
return = $6} kwd_is = $6;
return = $7}
in {region; value} } in {region; value} }
(* Function declarations *) (* Function declarations *)
open_fun_decl: open_fun_decl:
"function" fun_name parameters ":" type_expr "is" ioption ("recursive") "function" fun_name parameters ":" type_expr "is"
block "with" expr { block "with" expr {
Scoping.check_reserved_name $2; Scoping.check_reserved_name $3;
let stop = expr_to_region $9 in let stop = expr_to_region $10 in
let region = cover $1 stop let region = cover $2 stop
and value = {kwd_function = $1; and value = {kwd_recursive= $1;
fun_name = $2; kwd_function = $2;
param = $3; fun_name = $3;
colon = $4; param = $4;
ret_type = $5; colon = $5;
kwd_is = $6; ret_type = $6;
block_with = Some ($7, $8); kwd_is = $7;
return = $9; block_with = Some ($8, $9);
return = $10;
terminator = None; terminator = None;
attributes = None} attributes = None}
in {region; value} in {region; value}
} }
| "function" fun_name parameters ":" type_expr "is" expr { | ioption ("recursive") "function" fun_name parameters ":" type_expr "is" expr {
Scoping.check_reserved_name $2; Scoping.check_reserved_name $3;
let stop = expr_to_region $7 in let stop = expr_to_region $8 in
let region = cover $1 stop let region = cover $2 stop
and value = {kwd_function = $1; and value = {kwd_recursive= $1;
fun_name = $2; kwd_function = $2;
param = $3; fun_name = $3;
colon = $4; param = $4;
ret_type = $5; colon = $5;
kwd_is = $6; ret_type = $6;
kwd_is = $7;
block_with = None; block_with = None;
return = $7; return = $8;
terminator = None; terminator = None;
attributes = None} attributes = None}
in {region; value} } in {region; value} }

View File

@ -218,8 +218,9 @@ and print_fun_decl state {value; _} =
print_terminator state terminator; print_terminator state terminator;
and print_fun_expr state {value; _} = and print_fun_expr state {value; _} =
let {kwd_function; param; colon; let {kwd_recursive; kwd_function; param; colon;
ret_type; kwd_is; return} : fun_expr = value in ret_type; kwd_is; return} : fun_expr = value in
print_token_opt state kwd_recursive "recursive";
print_token state kwd_function "function"; print_token state kwd_function "function";
print_parameters state param; print_parameters state param;
print_token state colon ":"; print_token state colon ":";
@ -858,20 +859,26 @@ and pp_declaration state = function
and pp_attr_decl state = pp_ne_injection pp_string state and pp_attr_decl state = pp_ne_injection pp_string state
and pp_fun_decl state decl = and pp_fun_decl state decl =
let arity = 5 in let arity, start =
match decl.kwd_recursive with
None -> 5,0
| Some _ ->
let state = state#pad 6 0 in
let () = pp_node state "recursive"
in 6,1 in
let () = let () =
let state = state#pad arity 0 in let state = state#pad arity start in
pp_ident state decl.fun_name in pp_ident state decl.fun_name in
let () = let () =
let state = state#pad arity 1 in let state = state#pad arity (start + 1) in
pp_node state "<parameters>"; pp_node state "<parameters>";
pp_parameters state decl.param in pp_parameters state decl.param in
let () = let () =
let state = state#pad arity 2 in let state = state#pad arity (start + 2) in
pp_node state "<return type>"; pp_node state "<return type>";
pp_type_expr (state#pad 1 0) decl.ret_type in pp_type_expr (state#pad 1 0) decl.ret_type in
let () = let () =
let state = state#pad arity 3 in let state = state#pad arity (start + 3) in
pp_node state "<body>"; pp_node state "<body>";
let statements = let statements =
match decl.block_with with match decl.block_with with
@ -879,7 +886,7 @@ and pp_fun_decl state decl =
| None -> Instr (Skip Region.ghost), [] in | None -> Instr (Skip Region.ghost), [] in
pp_statements state statements in pp_statements state statements in
let () = let () =
let state = state#pad arity 4 in let state = state#pad arity (start + 4) in
pp_node state "<return>"; pp_node state "<return>";
pp_expr (state#pad 1 0) decl.return pp_expr (state#pad 1 0) decl.return
in () in ()

File diff suppressed because it is too large Load Diff

View File

@ -95,6 +95,7 @@ type t =
| False of Region.t | False of Region.t
| If of Region.t | If of Region.t
| Let of Region.t | Let of Region.t
| Rec of Region.t
| Switch of Region.t | Switch of Region.t
| Mod of Region.t | Mod of Region.t
| Or of Region.t | Or of Region.t

View File

@ -80,6 +80,7 @@ type t =
| False of Region.t | False of Region.t
| If of Region.t | If of Region.t
| Let of Region.t | Let of Region.t
| Rec of Region.t
| Switch of Region.t | Switch of Region.t
| Mod of Region.t | Mod of Region.t
| Or of Region.t | Or of Region.t
@ -146,6 +147,7 @@ let proj_token = function
| False region -> region, "False" | False region -> region, "False"
| If region -> region, "If" | If region -> region, "If"
| Let region -> region, "Let" | Let region -> region, "Let"
| Rec region -> region, "Rec"
| Switch region -> region, "Switch" | Switch region -> region, "Switch"
| Mod region -> region, "Mod" | Mod region -> region, "Mod"
| NOT region -> region, "!" | NOT region -> region, "!"
@ -197,6 +199,7 @@ let to_lexeme = function
| False _ -> "false" | False _ -> "false"
| If _ -> "if" | If _ -> "if"
| Let _ -> "let" | Let _ -> "let"
| Rec _ -> "rec"
| Mod _ -> "mod" | Mod _ -> "mod"
| NOT _ -> "!" | NOT _ -> "!"
| Or _ -> "or" | Or _ -> "or"
@ -232,6 +235,7 @@ let keywords = [
(fun reg -> False reg); (fun reg -> False reg);
(fun reg -> If reg); (fun reg -> If reg);
(fun reg -> Let reg); (fun reg -> Let reg);
(fun reg -> Rec reg);
(fun reg -> Switch reg); (fun reg -> Switch reg);
(fun reg -> Mod reg); (fun reg -> Mod reg);
(fun reg -> Or reg); (fun reg -> Or reg);
@ -273,7 +277,6 @@ let reserved =
|> add "of" |> add "of"
|> add "open" |> add "open"
|> add "private" |> add "private"
|> add "rec"
|> add "sig" |> add "sig"
|> add "struct" |> add "struct"
|> add "then" |> add "then"
@ -478,6 +481,7 @@ let is_kwd = function
| False _ | False _
| If _ | If _
| Let _ | Let _
| Rec _
| Switch _ | Switch _
| Mod _ | Mod _
| Or _ | Or _

View File

@ -59,6 +59,7 @@
%token <Region.t> False "false" %token <Region.t> False "false"
%token <Region.t> If "if" %token <Region.t> If "if"
%token <Region.t> Let "let" %token <Region.t> Let "let"
%token <Region.t> Rec "rec"
%token <Region.t> Switch "switch" %token <Region.t> Switch "switch"
%token <Region.t> Mod "mod" %token <Region.t> Mod "mod"
%token <Region.t> Or "or" %token <Region.t> Or "or"

View File

@ -247,14 +247,15 @@ field_decl:
and value = {field_name=$1; colon=$2; field_type=$3} and value = {field_name=$1; colon=$2; field_type=$3}
in {region; value} } in {region; value} }
(* Top-level non-recursive definitions *) (* Top-level definitions *)
let_declaration: let_declaration:
seq(Attr) "let" let_binding { seq(Attr) "let" ioption("rec") let_binding {
let attributes = $1 in let attributes = $1 in
let kwd_let = $2 in let kwd_let = $2 in
let binding = $3 in let kwd_rec = $3 in
let value = kwd_let, binding, attributes in let binding = $4 in
let value = kwd_let, kwd_rec, binding, attributes in
let stop = expr_to_region binding.let_rhs in let stop = expr_to_region binding.let_rhs in
let region = cover $2 stop let region = cover $2 stop
in {region; value} } in {region; value} }
@ -632,15 +633,16 @@ case_clause(right_expr):
in {region; value} } in {region; value} }
let_expr(right_expr): let_expr(right_expr):
seq(Attr) "let" let_binding ";" right_expr { seq(Attr) "let" ioption("rec") let_binding ";" right_expr {
let attributes = $1 in let attributes = $1 in
let kwd_let = $2 in let kwd_let = $2 in
let binding = $3 in let kwd_rec = $3 in
let kwd_in = $4 in let binding = $4 in
let body = $5 in let kwd_in = $5 in
let stop = expr_to_region $5 in let body = $6 in
let stop = expr_to_region $6 in
let region = cover $2 stop let region = cover $2 stop
and value = {kwd_let; binding; kwd_in; body; attributes} and value = {kwd_let; kwd_rec; binding; kwd_in; body; attributes}
in ELetIn {region; value} } in ELetIn {region; value} }
disj_expr_level: disj_expr_level:

File diff suppressed because it is too large Load Diff

View File

@ -80,8 +80,8 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
| ( C_IS_NAT , [ V_Ct (C_int a') ] ) -> | ( C_IS_NAT , [ V_Ct (C_int a') ] ) ->
if a' > 0 then return_some @@ V_Ct (C_nat a') if a' > 0 then return_some @@ V_Ct (C_nat a')
else return_none () else return_none ()
| ( C_CONTINUE , [ v ] ) -> ok @@ v_pair (v_bool true , v) | ( C_FOLD_CONTINUE , [ v ] ) -> ok @@ v_pair (v_bool true , v)
| ( C_STOP , [ v ] ) -> ok @@ v_pair (v_bool false , v) | ( C_FOLD_STOP , [ v ] ) -> ok @@ v_pair (v_bool false , v)
| ( C_ASSERTION , [ v ] ) -> | ( C_ASSERTION , [ v ] ) ->
let%bind pass = is_true v in let%bind pass = is_true v in
if pass then return_ct @@ C_unit if pass then return_ct @@ C_unit
@ -270,20 +270,25 @@ and eval_literal : Ast_typed.literal -> value result = function
and eval : Ast_typed.expression -> env -> value result and eval : Ast_typed.expression -> env -> value result
= fun term env -> = fun term env ->
match term.expression_content with match term.expression_content with
| E_application ({expr1 = f; expr2 = args}) -> ( | E_application ({lamb = f; args}) -> (
let%bind f' = eval f env in let%bind f' = eval f env in
let%bind args' = eval args env in
match f' with match f' with
| V_Func_val (arg_names, body, f_env) -> | V_Func_val (arg_names, body, f_env) ->
let%bind args' = eval args env in
let f_env' = Env.extend f_env (arg_names, args') in let f_env' = Env.extend f_env (arg_names, args') in
eval body f_env' eval body f_env'
| V_Func_rec (fun_name, arg_names, body, f_env) ->
let f_env' = Env.extend f_env (arg_names, args') in
let f_env'' = Env.extend f_env' (fun_name, f') in
eval body f_env''
| _ -> simple_fail "trying to apply on something that is not a function" | _ -> simple_fail "trying to apply on something that is not a function"
) )
| E_lambda { binder; result;} -> | E_lambda {binder; result;} ->
ok @@ V_Func_val (binder,result,env) ok @@ V_Func_val (binder,result,env)
| E_let_in { let_binder; rhs; let_result; _} -> | E_let_in {let_binder ; rhs; let_result} -> (
let%bind rhs' = eval rhs env in let%bind rhs' = eval rhs env in
eval let_result (Env.extend env (let_binder,rhs')) eval let_result (Env.extend env (let_binder,rhs'))
)
| E_map kvlist | E_big_map kvlist -> | E_map kvlist | E_big_map kvlist ->
let%bind kvlist' = bind_map_list let%bind kvlist' = bind_map_list
(fun kv -> bind_map_pair (fun (el:Ast_typed.expression) -> eval el env) kv) (fun kv -> bind_map_pair (fun (el:Ast_typed.expression) -> eval el env) kv)
@ -371,6 +376,8 @@ and eval : Ast_typed.expression -> env -> value result
| _ -> simple_fail "not yet supported case" | _ -> simple_fail "not yet supported case"
(* ((ctor,name),body) *) (* ((ctor,name),body) *)
) )
| E_recursive {fun_name; fun_type=_; lambda} ->
ok @@ V_Func_rec (fun_name, lambda.binder, lambda.result, env)
| E_look_up _ -> | E_look_up _ ->
let serr = Format.asprintf "Unsupported construct :\n %a\n" Ast_typed.PP.expression term in let serr = Format.asprintf "Unsupported construct :\n %a\n" Ast_typed.PP.expression term in
simple_fail serr simple_fail serr

View File

@ -102,6 +102,15 @@ them. please report this to the developers." in
] in ] in
error ~data title content error ~data title content
let unsupported_recursive_function expression_variable =
let title () = "unsupported recursive function yet" in
let content () = "only fuction with one variable are supported" in
let data = [
("value" , fun () -> Format.asprintf "%a" AST.PP.expression_variable expression_variable) ;
] in
error ~data title content
end end
open Errors open Errors
@ -244,9 +253,9 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
let%bind tv = transpile_environment_element_type ele in let%bind tv = transpile_environment_element_type ele in
return ~tv @@ E_variable (name) return ~tv @@ E_variable (name)
) )
| E_application {expr1;expr2} -> | E_application {lamb; args} ->
let%bind a = transpile_annotated_expression expr1 in let%bind a = transpile_annotated_expression lamb in
let%bind b = transpile_annotated_expression expr2 in let%bind b = transpile_annotated_expression args in
return @@ E_application (a, b) return @@ E_application (a, b)
| E_constructor {constructor;element} -> ( | E_constructor {constructor;element} -> (
let%bind param' = transpile_annotated_expression element in let%bind param' = transpile_annotated_expression element in
@ -379,6 +388,8 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
| E_lambda l -> | E_lambda l ->
let%bind io = AST.get_t_function ae.type_expression in let%bind io = AST.get_t_function ae.type_expression in
transpile_lambda l io transpile_lambda l io
| E_recursive r ->
transpile_recursive r
| E_list lst -> ( | E_list lst -> (
let%bind t = let%bind t =
trace_strong (corner_case ~loc:__LOC__ "not a list") @@ trace_strong (corner_case ~loc:__LOC__ "not a list") @@
@ -518,6 +529,125 @@ and transpile_lambda l (input_type , output_type) =
let closure = E_closure { binder; body = result'} in let closure = E_closure { binder; body = result'} in
ok @@ Combinators.Expression.make_tpl (closure , tv) ok @@ Combinators.Expression.make_tpl (closure , tv)
and transpile_recursive {fun_name; fun_type; lambda} =
let rec map_lambda : AST.expression_variable -> type_value -> AST.expression -> (expression * expression_variable list) result = fun fun_name loop_type e ->
match e.expression_content with
E_lambda {binder;result} ->
let%bind (body,l) = map_lambda fun_name loop_type result in
ok @@ (Expression.make (E_closure {binder;body}) loop_type, binder::l)
| _ ->
let%bind res = replace_callback fun_name loop_type false e in
ok @@ (res, [])
and replace_callback : AST.expression_variable -> type_value -> bool -> AST.expression -> expression result = fun fun_name loop_type shadowed e ->
match e.expression_content with
E_let_in li ->
let shadowed = shadowed || Var.equal li.let_binder fun_name in
let%bind let_result = replace_callback fun_name loop_type shadowed li.let_result in
let%bind rhs = transpile_annotated_expression li.rhs in
let%bind ty = transpile_type e.type_expression in
ok @@ e_let_in li.let_binder ty li.inline rhs let_result |
E_matching m ->
let%bind ty = transpile_type e.type_expression in
matching fun_name loop_type shadowed m ty |
E_application {lamb;args} -> (
match lamb.expression_content,shadowed with
E_variable name, false when Var.equal fun_name name ->
let%bind expr = transpile_annotated_expression args in
ok @@ Expression.make (E_constant {cons_name=C_LOOP_CONTINUE;arguments=[expr]}) loop_type |
_ ->
let%bind expr = transpile_annotated_expression e in
ok @@ Expression.make (E_constant {cons_name=C_LOOP_STOP;arguments=[expr]}) loop_type
) |
_ ->
let%bind expr = transpile_annotated_expression e in
ok @@ Expression.make (E_constant {cons_name=C_LOOP_STOP;arguments=[expr]}) loop_type
and matching : AST.expression_variable -> type_value -> bool -> AST.matching -> type_value -> expression result = fun fun_name loop_type shadowed m ty ->
let return ret = ok @@ Expression.make ret @@ ty in
let%bind expr = transpile_annotated_expression m.matchee in
match m.cases with
Match_bool {match_true; match_false} ->
let%bind (t , f) = bind_map_pair (replace_callback fun_name loop_type shadowed) (match_true, match_false) in
return @@ E_if_bool (expr, t, f)
| Match_option { match_none; match_some = (name, s, tv) } ->
let%bind n = replace_callback fun_name loop_type shadowed match_none in
let%bind (tv' , s') =
let%bind tv' = transpile_type tv in
let%bind s' = replace_callback fun_name loop_type shadowed s in
ok (tv' , s')
in
return @@ E_if_none (expr , n , ((name , tv') , s'))
| Match_list {
match_nil ;
match_cons = ((hd_name) , (tl_name), match_cons, ty) ;
} -> (
let%bind nil = replace_callback fun_name loop_type shadowed match_nil in
let%bind cons =
let%bind ty' = transpile_type ty in
let%bind match_cons' = replace_callback fun_name loop_type shadowed match_cons in
ok (((hd_name , ty') , (tl_name , ty')) , match_cons')
in
return @@ E_if_cons (expr , nil , cons)
)
| Match_variant (lst , variant) -> (
let%bind tree =
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@
tree_of_sum variant in
let%bind tree' = match tree with
| Empty -> fail (corner_case ~loc:__LOC__ "match empty variant")
| Full x -> ok x in
let%bind tree'' =
let rec aux t =
match (t : _ Append_tree.t') with
| Leaf (name , tv) ->
let%bind tv' = transpile_type tv in
ok (`Leaf name , tv')
| Node {a ; b} ->
let%bind a' = aux a in
let%bind b' = aux b in
let tv' = Mini_c.t_union (None, snd a') (None, snd b') in
ok (`Node (a' , b') , tv')
in aux tree'
in
let rec aux top t =
match t with
| ((`Leaf constructor_name) , tv) -> (
let%bind ((_ , name) , body) =
trace_option (corner_case ~loc:__LOC__ "missing match clause") @@
List.find_opt (fun ((constructor_name' , _) , _) -> constructor_name' = constructor_name) lst in
let%bind body' = replace_callback fun_name loop_type shadowed body in
return @@ E_let_in ((name , tv) , false , top , body')
)
| ((`Node (a , b)) , tv) ->
let%bind a' =
let%bind a_ty = get_t_left tv in
let left_var = Var.fresh ~name:"left" () in
let%bind e = aux (((Expression.make (E_variable left_var) a_ty))) a in
ok ((left_var , a_ty) , e)
in
let%bind b' =
let%bind b_ty = get_t_right tv in
let right_var = Var.fresh ~name:"right" () in
let%bind e = aux (((Expression.make (E_variable right_var) b_ty))) b in
ok ((right_var , b_ty) , e)
in
return @@ E_if_left (top , a' , b')
in
trace_strong (corner_case ~loc:__LOC__ "building constructor") @@
aux expr tree''
)
| AST.Match_tuple _ -> failwith "match_tuple not supported"
in
let%bind fun_type = transpile_type fun_type in
let%bind (input_type,output_type) = get_t_function fun_type in
let loop_type = t_union (None, input_type) (None, output_type) in
let%bind (body,binder) = map_lambda fun_name loop_type lambda.result in
let binder = lambda.binder::binder in
let%bind binder = match binder with hd::[] -> ok @@ hd | _ -> fail @@ unsupported_recursive_function fun_name in
let expr = Expression.make_tpl (E_variable binder, input_type) in
let body = Expression.make (E_iterator (C_LOOP_LEFT, ((lambda.binder, loop_type),body), expr)) output_type in
ok @@ Expression.make (E_closure {binder;body}) fun_type
let transpile_declaration env (d:AST.declaration) : toplevel_statement result = let transpile_declaration env (d:AST.declaration) : toplevel_statement result =
match d with match d with
| Declaration_constant (name,expression, inline, _) -> | Declaration_constant (name,expression, inline, _) ->

View File

@ -50,13 +50,22 @@ let rec get_operator : constant' -> type_value -> expression list -> predicate r
let%bind ty' = Mini_c.get_t_option ty in let%bind ty' = Mini_c.get_t_option ty in
let%bind m_ty = Compiler_type.type_ ty' in let%bind m_ty = Compiler_type.type_ ty' in
ok @@ simple_constant @@ prim ~children:[m_ty] I_NONE ok @@ simple_constant @@ prim ~children:[m_ty] I_NONE
) )
| C_NIL -> ( | C_NIL -> (
let%bind ty' = Mini_c.get_t_list ty in let%bind ty' = Mini_c.get_t_list ty in
let%bind m_ty = Compiler_type.type_ ty' in let%bind m_ty = Compiler_type.type_ ty' in
ok @@ simple_unary @@ prim ~children:[m_ty] I_NIL ok @@ simple_unary @@ prim ~children:[m_ty] I_NIL
) )
| C_LOOP_CONTINUE -> (
let%bind (_,ty) = get_t_or ty in
let%bind m_ty = Compiler_type.type_ ty in
ok @@ simple_unary @@ prim ~children:[m_ty] I_LEFT
)
| C_LOOP_STOP -> (
let%bind (ty, _) = get_t_or ty in
let%bind m_ty = Compiler_type.type_ ty in
ok @@ simple_unary @@ prim ~children:[m_ty] I_RIGHT
)
| C_SET_EMPTY -> ( | C_SET_EMPTY -> (
let%bind ty' = Mini_c.get_t_set ty in let%bind ty' = Mini_c.get_t_set ty in
let%bind m_ty = Compiler_type.type_ ty' in let%bind m_ty = Compiler_type.type_ ty' in
@ -397,6 +406,16 @@ and translate_expression (expr:expression) (env:environment) : michelson result
]) in ]) in
return code return code
) )
| C_LOOP_LEFT -> (
let%bind (_, ty) = get_t_or (snd v) in
let%bind m_ty = Compiler_type.type_ ty in
let%bind code = ok (seq [
expr' ;
prim ~children:[m_ty] I_LEFT;
i_loop_left body';
]) in
return code
)
| s -> ( | s -> (
let iter = Format.asprintf "iter %a" PP.constant s in let iter = Format.asprintf "iter %a" PP.constant s in
let error = error (thunk "bad iterator") (thunk iter) in let error = error (thunk "bad iterator") (thunk iter) in

View File

@ -1,7 +1,7 @@
[@@@warning "-45"] [@@@warning "-45"]
open Trace open Trace
open Ast_simplified open Ast_imperative
module Raw = Parser.Cameligo.AST module Raw = Parser.Cameligo.AST
module SMap = Map.String module SMap = Map.String
@ -70,6 +70,17 @@ module Errors = struct
fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc)] fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc)]
in error ~data title message in error ~data title message
let untyped_recursive_function var =
let title () = "" in
let message () =
Format.asprintf "\nUntyped recursive functions \
are not supported yet.\n" in
let param_loc = var.Region.region in
let data = [
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc)]
in error ~data title message
let unsupported_tuple_pattern p = let unsupported_tuple_pattern p =
let title () = "" in let title () = "" in
let message () = let message () =
@ -103,8 +114,8 @@ module Errors = struct
] in ] in
error ~data title message error ~data title message
let simplifying_expr t = let abstracting_expr t =
let title () = "Simplifying expression" in let title () = "abstracting expression" in
let message () = "" in let message () = "" in
let data = [ let data = [
("expression" , ("expression" ,
@ -145,7 +156,7 @@ end
open Errors open Errors
open Operators.Simplify.Cameligo open Operators.Concrete_to_imperative.Cameligo
let r_split = Location.r_split let r_split = Location.r_split
@ -194,7 +205,7 @@ let rec typed_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern ->
| Raw.PTyped pt -> | Raw.PTyped pt ->
let (p,t) = pt.value.pattern,pt.value.type_expr in let (p,t) = pt.value.pattern,pt.value.type_expr in
let%bind p = tuple_pattern_to_vars p in let%bind p = tuple_pattern_to_vars p in
let%bind t = simpl_type_expression t in let%bind t = compile_type_expression t in
ok @@ (p,t) ok @@ (p,t)
| other -> (fail @@ wrong_pattern "parenthetical or type annotation" other) | other -> (fail @@ wrong_pattern "parenthetical or type annotation" other)
@ -202,10 +213,10 @@ and unpar_pattern : Raw.pattern -> Raw.pattern = function
| PPar p -> unpar_pattern p.value.inside | PPar p -> unpar_pattern p.value.inside
| _ as p -> p | _ as p -> p
and simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> and compile_type_expression : Raw.type_expr -> type_expression result = fun te ->
trace (simple_info "simplifying this type expression...") @@ trace (simple_info "abstracting this type expression...") @@
match te with match te with
TPar x -> simpl_type_expression x.value.inside TPar x -> compile_type_expression x.value.inside
| TVar v -> ( | TVar v -> (
match type_constants v.value with match type_constants v.value with
| Ok (s,_) -> ok @@ make_t @@ T_constant s | Ok (s,_) -> ok @@ make_t @@ T_constant s
@ -214,8 +225,8 @@ and simpl_type_expression : Raw.type_expr -> type_expression result = fun te ->
| TFun x -> ( | TFun x -> (
let%bind (type1 , type2) = let%bind (type1 , type2) =
let (a , _ , b) = x.value in let (a , _ , b) = x.value in
let%bind a = simpl_type_expression a in let%bind a = compile_type_expression a in
let%bind b = simpl_type_expression b in let%bind b = compile_type_expression b in
ok (a , b) ok (a , b)
in in
ok @@ make_t @@ T_arrow {type1;type2} ok @@ make_t @@ T_arrow {type1;type2}
@ -223,18 +234,18 @@ and simpl_type_expression : Raw.type_expr -> type_expression result = fun te ->
| TApp x -> ( | TApp x -> (
let (name, tuple) = x.value in let (name, tuple) = x.value in
let lst = npseq_to_list tuple.value.inside in let lst = npseq_to_list tuple.value.inside in
let%bind lst' = bind_map_list simpl_type_expression lst in let%bind lst' = bind_map_list compile_type_expression lst in
let%bind cst = let%bind cst =
trace (unknown_predefined_type name) @@ trace (unknown_predefined_type name) @@
type_operators name.value in type_operators name.value in
t_operator cst lst' t_operator cst lst'
) )
| TProd p -> ( | TProd p -> (
let%bind tpl = simpl_list_type_expression @@ npseq_to_list p.value in let%bind tpl = compile_list_type_expression @@ npseq_to_list p.value in
ok tpl ok tpl
) )
| TRecord r -> | TRecord r ->
let aux = fun (x, y) -> let%bind y = simpl_type_expression y in ok (x, y) in let aux = fun (x, y) -> let%bind y = compile_type_expression y in ok (x, y) in
let apply (x:Raw.field_decl Raw.reg) = let apply (x:Raw.field_decl Raw.reg) =
(x.value.field_name.value, x.value.field_type) in (x.value.field_name.value, x.value.field_type) in
let%bind lst = let%bind lst =
@ -251,7 +262,7 @@ and simpl_type_expression : Raw.type_expr -> type_expression result = fun te ->
None -> [] None -> []
| Some (_, TProd product) -> npseq_to_list product.value | Some (_, TProd product) -> npseq_to_list product.value
| Some (_, t_expr) -> [t_expr] in | Some (_, t_expr) -> [t_expr] in
let%bind te = simpl_list_type_expression @@ args in let%bind te = compile_list_type_expression @@ args in
ok (v.value.constr.value, te) in ok (v.value.constr.value, te) in
let%bind lst = bind_list let%bind lst = bind_list
@@ List.map aux @@ List.map aux
@ -259,18 +270,18 @@ and simpl_type_expression : Raw.type_expr -> type_expression result = fun te ->
let m = List.fold_left (fun m (x, y) -> CMap.add (Constructor x) y m) CMap.empty lst in let m = List.fold_left (fun m (x, y) -> CMap.add (Constructor x) y m) CMap.empty lst in
ok @@ make_t @@ T_sum m ok @@ make_t @@ T_sum m
and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result = and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result =
match lst with match lst with
| [] -> ok @@ t_unit | [] -> ok @@ t_unit
| [hd] -> simpl_type_expression hd | [hd] -> compile_type_expression hd
| lst -> | lst ->
let%bind lst = bind_map_list simpl_type_expression lst in let%bind lst = bind_map_list compile_type_expression lst in
ok @@ t_tuple lst ok @@ t_tuple lst
let rec simpl_expression : let rec compile_expression :
Raw.expr -> expr result = fun t -> Raw.expr -> expr result = fun t ->
let return x = ok x in let return x = ok x in
let simpl_projection = fun (p:Raw.projection Region.reg) -> let compile_projection = fun (p:Raw.projection Region.reg) ->
let (p , loc) = r_split p in let (p , loc) = r_split p in
let var = let var =
let name = Var.of_name p.struct_name.value in let name = Var.of_name p.struct_name.value in
@ -285,7 +296,7 @@ let rec simpl_expression :
List.map aux @@ npseq_to_list path in List.map aux @@ npseq_to_list path in
return @@ List.fold_left (e_accessor ~loc ) var path' return @@ List.fold_left (e_accessor ~loc ) var path'
in in
let simpl_path : Raw.path -> string * label list = fun p -> let compile_path : Raw.path -> string * label list = fun p ->
match p with match p with
| Raw.Name v -> (v.value , []) | Raw.Name v -> (v.value , [])
| Raw.Path p -> ( | Raw.Path p -> (
@ -302,9 +313,9 @@ let rec simpl_expression :
(var , path') (var , path')
) )
in in
let simpl_update = fun (u:Raw.update Region.reg) -> let compile_update = fun (u:Raw.update Region.reg) ->
let (u, loc) = r_split u in let (u, loc) = r_split u in
let (name, path) = simpl_path u.record in let (name, path) = compile_path u.record in
let record = match path with let record = match path with
| [] -> e_variable (Var.of_name name) | [] -> e_variable (Var.of_name name)
| _ -> | _ ->
@ -314,7 +325,7 @@ let rec simpl_expression :
let%bind updates' = let%bind updates' =
let aux (f:Raw.field_path_assign Raw.reg) = let aux (f:Raw.field_path_assign Raw.reg) =
let (f,_) = r_split f in let (f,_) = r_split f in
let%bind expr = simpl_expression f.field_expr in let%bind expr = compile_expression f.field_expr in
ok ( List.map (fun (x: _ Raw.reg) -> x.value) (npseq_to_list f.field_path), expr) ok ( List.map (fun (x: _ Raw.reg) -> x.value) (npseq_to_list f.field_path), expr)
in in
bind_map_list aux @@ npseq_to_list updates bind_map_list aux @@ npseq_to_list updates
@ -331,30 +342,30 @@ let rec simpl_expression :
bind_fold_list aux record updates' bind_fold_list aux record updates'
in in
trace (simplifying_expr t) @@ trace (abstracting_expr t) @@
match t with match t with
Raw.ELetIn e -> Raw.ELetIn e ->
let Raw.{binding; body; attributes; _} = e.value in let Raw.{kwd_rec; binding; body; attributes; _} = e.value in
let inline = List.exists (fun (a: Raw.attribute) -> a.value = "inline") attributes in let inline = List.exists (fun (a: Raw.attribute) -> a.value = "inline") attributes in
let Raw.{binders; lhs_type; let_rhs; _} = binding in let Raw.{binders; lhs_type; let_rhs; _} = binding in
begin match binders with begin match binders with
| (p, []) -> | (p, []) ->
let%bind variables = tuple_pattern_to_typed_vars p in let%bind variables = tuple_pattern_to_typed_vars p in
let%bind ty_opt = let%bind ty_opt =
bind_map_option (fun (_,te) -> simpl_type_expression te) lhs_type in bind_map_option (fun (_,te) -> compile_type_expression te) lhs_type in
let%bind rhs = simpl_expression let_rhs in let%bind rhs = compile_expression let_rhs in
let rhs_b = Var.fresh ~name: "rhs" () in let rhs_b = Var.fresh ~name: "rhs" () in
let rhs',rhs_b_expr = let rhs',rhs_b_expr =
match ty_opt with match ty_opt with
None -> rhs, e_variable rhs_b None -> rhs, e_variable rhs_b
| Some ty -> (e_annotation rhs ty), e_annotation (e_variable rhs_b) ty in | Some ty -> (e_annotation rhs ty), e_annotation (e_variable rhs_b) ty in
let%bind body = simpl_expression body in let%bind body = compile_expression body in
let prepare_variable (ty_var: Raw.variable * Raw.type_expr option) = let prepare_variable (ty_var: Raw.variable * Raw.type_expr option) =
let variable, ty_opt = ty_var in let variable, ty_opt = ty_var in
let var_expr = Var.of_name variable.value in let var_expr = Var.of_name variable.value in
let%bind ty_expr_opt = let%bind ty_expr_opt =
match ty_opt with match ty_opt with
| Some ty -> bind_map_option simpl_type_expression (Some ty) | Some ty -> bind_map_option compile_type_expression (Some ty)
| None -> ok None | None -> ok None
in ok (var_expr, ty_expr_opt) in ok (var_expr, ty_expr_opt)
in in
@ -382,10 +393,50 @@ let rec simpl_expression :
(chain_let_in tl body) (chain_let_in tl body)
| [] -> body (* Precluded by corner case assertion above *) | [] -> body (* Precluded by corner case assertion above *)
in in
if List.length prep_vars = 1 let%bind ty_opt = match ty_opt with
then ok (chain_let_in prep_vars body) | None -> (match let_rhs with
(* Bind the right hand side so we only evaluate it once *) | EFun {value={binders;lhs_type}} ->
else ok (e_let_in (rhs_b, ty_opt) false inline rhs' (chain_let_in prep_vars body)) let f_args = nseq_to_list (binders) in
let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in
let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in
let aux acc ty = Option.map (t_function (snd ty)) acc in
ok @@ (List.fold_right' aux lhs_type' ty)
| _ -> ok None
)
| Some t -> ok @@ Some t
in
let%bind ret_expr = if List.length prep_vars = 1
then ok (chain_let_in prep_vars body)
(* Bind the right hand side so we only evaluate it once *)
else ok (e_let_in (rhs_b, ty_opt) false inline rhs' (chain_let_in prep_vars body))
in
let%bind ret_expr = match kwd_rec with
| None -> ok @@ ret_expr
| Some _ ->
match ret_expr.expression_content with
| E_let_in li -> (
let%bind lambda =
let rec aux rhs = match rhs.expression_content with
| E_lambda l -> ok @@ l
| E_ascription a -> aux a.anno_expr
| _ -> fail @@ corner_case "recursive only supported for lambda"
in
aux rhs'
in
let fun_name = fst @@ List.hd prep_vars in
let%bind fun_type = match ty_opt with
| Some t -> ok @@ t
| None -> match rhs'.expression_content with
| E_ascription a -> ok a.type_annotation
| _ -> fail @@ untyped_recursive_function e
in
let expression_content = E_recursive {fun_name;fun_type;lambda} in
let expression_content = E_let_in {li with rhs = {li.rhs with expression_content}} in
ok @@ {ret_expr with expression_content}
)
| _ -> fail @@ corner_case "impossible"
in
ok ret_expr
(* let f p1 ps... = rhs in body *) (* let f p1 ps... = rhs in body *)
| (f, p1 :: ps) -> | (f, p1 :: ps) ->
@ -393,8 +444,8 @@ let rec simpl_expression :
end end
| Raw.EAnnot a -> | Raw.EAnnot a ->
let Raw.{inside=expr, _, type_expr; _}, loc = r_split a in let Raw.{inside=expr, _, type_expr; _}, loc = r_split a in
let%bind expr' = simpl_expression expr in let%bind expr' = compile_expression expr in
let%bind type_expr' = simpl_type_expression type_expr in let%bind type_expr' = compile_type_expression type_expr in
return @@ e_annotation ~loc expr' type_expr' return @@ e_annotation ~loc expr' type_expr'
| EVar c -> | EVar c ->
let (c',loc) = r_split c in let (c',loc) = r_split c in
@ -403,7 +454,7 @@ let rec simpl_expression :
| Ok (s,_) -> return @@ e_constant s []) | Ok (s,_) -> return @@ e_constant s [])
| ECall x -> ( | ECall x -> (
let ((e1 , e2) , loc) = r_split x in let ((e1 , e2) , loc) = r_split x in
let%bind args = bind_map_list simpl_expression (nseq_to_list e2) in let%bind args = bind_map_list compile_expression (nseq_to_list e2) in
let rec chain_application (f: expression) (args: expression list) = let rec chain_application (f: expression) (args: expression list) =
match args with match args with
| hd :: tl -> chain_application (e_application ~loc f hd) tl | hd :: tl -> chain_application (e_application ~loc f hd) tl
@ -417,29 +468,29 @@ let rec simpl_expression :
| Ok (s, _) -> return @@ e_constant ~loc s args | Ok (s, _) -> return @@ e_constant ~loc s args
) )
| e1 -> | e1 ->
let%bind e1' = simpl_expression e1 in let%bind e1' = compile_expression e1 in
return @@ chain_application e1' args return @@ chain_application e1' args
) )
| EPar x -> simpl_expression x.value.inside | EPar x -> compile_expression x.value.inside
| EUnit reg -> | EUnit reg ->
let (_ , loc) = r_split reg in let (_ , loc) = r_split reg in
return @@ e_literal ~loc Literal_unit return @@ e_literal ~loc Literal_unit
| EBytes x -> | EBytes x ->
let (x , loc) = r_split x in let (x , loc) = r_split x in
return @@ e_literal ~loc (Literal_bytes (Hex.to_bytes @@ snd x)) return @@ e_literal ~loc (Literal_bytes (Hex.to_bytes @@ snd x))
| ETuple tpl -> simpl_tuple_expression @@ (npseq_to_list tpl.value) | ETuple tpl -> compile_tuple_expression @@ (npseq_to_list tpl.value)
| ERecord r -> | ERecord r ->
let (r , loc) = r_split r in let (r , loc) = r_split r in
let%bind fields = bind_list let%bind fields = bind_list
@@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = simpl_expression v in ok (k.value, v)) @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = compile_expression v in ok (k.value, v))
@@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr)) @@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
@@ npseq_to_list r.ne_elements in @@ npseq_to_list r.ne_elements in
return @@ e_record_ez ~loc fields return @@ e_record_ez ~loc fields
| EProj p -> simpl_projection p | EProj p -> compile_projection p
| EUpdate u -> simpl_update u | EUpdate u -> compile_update u
| EConstr (ESomeApp a) -> | EConstr (ESomeApp a) ->
let (_, args), loc = r_split a in let (_, args), loc = r_split a in
let%bind arg = simpl_expression args in let%bind arg = compile_expression args in
return @@ e_constant ~loc C_SOME [arg] return @@ e_constant ~loc C_SOME [arg]
| EConstr (ENone reg) -> | EConstr (ENone reg) ->
let loc = Location.lift reg in let loc = Location.lift reg in
@ -451,18 +502,18 @@ let rec simpl_expression :
match args with match args with
None -> [] None -> []
| Some arg -> [arg] in | Some arg -> [arg] in
let%bind arg = simpl_tuple_expression @@ args let%bind arg = compile_tuple_expression @@ args
in return @@ e_constructor ~loc c_name arg in return @@ e_constructor ~loc c_name arg
| EArith (Add c) -> | EArith (Add c) ->
simpl_binop "ADD" c compile_binop "ADD" c
| EArith (Sub c) -> | EArith (Sub c) ->
simpl_binop "SUB" c compile_binop "SUB" c
| EArith (Mult c) -> | EArith (Mult c) ->
simpl_binop "TIMES" c compile_binop "TIMES" c
| EArith (Div c) -> | EArith (Div c) ->
simpl_binop "DIV" c compile_binop "DIV" c
| EArith (Mod c) -> | EArith (Mod c) ->
simpl_binop "MOD" c compile_binop "MOD" c
| EArith (Int n) -> ( | EArith (Int n) -> (
let (n , loc) = r_split n in let (n , loc) = r_split n in
let n = Z.to_int @@ snd @@ n in let n = Z.to_int @@ snd @@ n in
@ -478,7 +529,7 @@ let rec simpl_expression :
let n = Z.to_int @@ snd @@ n in let n = Z.to_int @@ snd @@ n in
return @@ e_literal ~loc (Literal_mutez n) return @@ e_literal ~loc (Literal_mutez n)
) )
| EArith (Neg e) -> simpl_unop "NEG" e | EArith (Neg e) -> compile_unop "NEG" e
| EString (String s) -> ( | EString (String s) -> (
let (s , loc) = r_split s in let (s , loc) = r_split s in
let s' = let s' =
@ -489,24 +540,24 @@ let rec simpl_expression :
) )
| EString (Cat c) -> | EString (Cat c) ->
let (c, loc) = r_split c in let (c, loc) = r_split c in
let%bind string_left = simpl_expression c.arg1 in let%bind string_left = compile_expression c.arg1 in
let%bind string_right = simpl_expression c.arg2 in let%bind string_right = compile_expression c.arg2 in
return @@ e_string_cat ~loc string_left string_right return @@ e_string_cat ~loc string_left string_right
| ELogic l -> simpl_logic_expression l | ELogic l -> compile_logic_expression l
| EList l -> simpl_list_expression l | EList l -> compile_list_expression l
| ECase c -> ( | ECase c -> (
let (c , loc) = r_split c in let (c , loc) = r_split c in
let%bind e = simpl_expression c.expr in let%bind e = compile_expression c.expr in
let%bind lst = let%bind lst =
let aux (x : Raw.expr Raw.case_clause) = let aux (x : Raw.expr Raw.case_clause) =
let%bind expr = simpl_expression x.rhs in let%bind expr = compile_expression x.rhs in
ok (x.pattern, expr) in ok (x.pattern, expr) in
bind_list bind_list
@@ List.map aux @@ List.map aux
@@ List.map get_value @@ List.map get_value
@@ npseq_to_list c.cases.value in @@ npseq_to_list c.cases.value in
let default_action () = let default_action () =
let%bind cases = simpl_cases lst in let%bind cases = compile_cases lst in
return @@ e_matching ~loc e cases in return @@ e_matching ~loc e cases in
(* Hack to take care of patterns introduced by `parser/cameligo/Parser.mly` in "norm_fun_expr". TODO: Still needed? *) (* Hack to take care of patterns introduced by `parser/cameligo/Parser.mly` in "norm_fun_expr". TODO: Still needed? *)
match lst with match lst with
@ -520,7 +571,7 @@ let rec simpl_expression :
match x'.pattern with match x'.pattern with
| Raw.PVar y -> | Raw.PVar y ->
let var_name = Var.of_name y.value in let var_name = Var.of_name y.value in
let%bind type_expr = simpl_type_expression x'.type_expr in let%bind type_expr = compile_type_expression x'.type_expr in
return @@ e_let_in (var_name , Some type_expr) false false e rhs return @@ e_let_in (var_name , Some type_expr) false false e rhs
| _ -> default_action () | _ -> default_action ()
) )
@ -530,29 +581,29 @@ let rec simpl_expression :
) )
| _ -> default_action () | _ -> default_action ()
) )
| EFun lamb -> simpl_fun lamb | EFun lamb -> compile_fun lamb
| ESeq s -> ( | ESeq s -> (
let (s , loc) = r_split s in let (s , loc) = r_split s in
let items : Raw.expr list = pseq_to_list s.elements in let items : Raw.expr list = pseq_to_list s.elements in
(match items with (match items with
[] -> return @@ e_skip ~loc () [] -> return @@ e_skip ~loc ()
| expr::more -> | expr::more ->
let expr' = simpl_expression expr in let expr' = compile_expression expr in
let apply (e1: Raw.expr) (e2: expression Trace.result) = let apply (e1: Raw.expr) (e2: expression Trace.result) =
let%bind a = simpl_expression e1 in let%bind a = compile_expression e1 in
let%bind e2' = e2 in let%bind e2' = e2 in
return @@ e_sequence a e2' return @@ e_sequence a e2'
in List.fold_right apply more expr') in List.fold_right apply more expr')
) )
| ECond c -> ( | ECond c -> (
let (c , loc) = r_split c in let (c , loc) = r_split c in
let%bind expr = simpl_expression c.test in let%bind expr = compile_expression c.test in
let%bind match_true = simpl_expression c.ifso in let%bind match_true = compile_expression c.ifso in
let%bind match_false = simpl_expression c.ifnot in let%bind match_false = compile_expression c.ifnot in
return @@ e_matching ~loc expr (Match_bool {match_true; match_false}) return @@ e_matching ~loc expr (Match_bool {match_true; match_false})
) )
and simpl_fun lamb' : expr result = and compile_fun lamb' : expr result =
let return x = ok x in let return x = ok x in
let (lamb , loc) = r_split lamb' in let (lamb , loc) = r_split lamb' in
let%bind params' = let%bind params' =
@ -598,7 +649,7 @@ and simpl_fun lamb' : expr result =
| _ , None -> | _ , None ->
fail @@ untyped_fun_param var fail @@ untyped_fun_param var
| _ , Some ty -> ( | _ , Some ty -> (
let%bind ty' = simpl_type_expression ty in let%bind ty' = compile_type_expression ty in
ok (var , ty') ok (var , ty')
) )
in in
@ -630,6 +681,7 @@ and simpl_fun lamb' : expr result =
in in
let let_in: Raw.let_in = let let_in: Raw.let_in =
{kwd_let= Region.ghost; {kwd_let= Region.ghost;
kwd_rec= None;
binding= let_in_binding; binding= let_in_binding;
kwd_in= Region.ghost; kwd_in= Region.ghost;
body= lamb.body; body= lamb.body;
@ -648,8 +700,8 @@ and simpl_fun lamb' : expr result =
in in
let%bind (body , body_type) = expr_to_typed_expr body in let%bind (body , body_type) = expr_to_typed_expr body in
let%bind output_type = let%bind output_type =
bind_map_option simpl_type_expression body_type in bind_map_option compile_type_expression body_type in
let%bind body = simpl_expression body in let%bind body = compile_expression body in
let rec layer_arguments (arguments: (Raw.variable * type_expression) list) = let rec layer_arguments (arguments: (Raw.variable * type_expression) list) =
match arguments with match arguments with
| hd :: tl -> | hd :: tl ->
@ -658,10 +710,11 @@ and simpl_fun lamb' : expr result =
e_lambda ~loc (binder) (Some input_type) output_type (layer_arguments tl) e_lambda ~loc (binder) (Some input_type) output_type (layer_arguments tl)
| [] -> body | [] -> body
in in
return @@ layer_arguments params' let ret_lamb = layer_arguments params' in
return @@ ret_lamb
and simpl_logic_expression ?te_annot (t:Raw.logic_expr) : expr result = and compile_logic_expression ?te_annot (t:Raw.logic_expr) : expr result =
let return x = ok @@ make_option_typed x te_annot in let return x = ok @@ make_option_typed x te_annot in
match t with match t with
| BoolExpr (False reg) -> ( | BoolExpr (False reg) -> (
@ -673,61 +726,61 @@ and simpl_logic_expression ?te_annot (t:Raw.logic_expr) : expr result =
return @@ e_literal ~loc (Literal_bool true) return @@ e_literal ~loc (Literal_bool true)
) )
| BoolExpr (Or b) -> | BoolExpr (Or b) ->
simpl_binop "OR" b compile_binop "OR" b
| BoolExpr (And b) -> | BoolExpr (And b) ->
simpl_binop "AND" b compile_binop "AND" b
| BoolExpr (Not b) -> | BoolExpr (Not b) ->
simpl_unop "NOT" b compile_unop "NOT" b
| CompExpr (Lt c) -> | CompExpr (Lt c) ->
simpl_binop "LT" c compile_binop "LT" c
| CompExpr (Gt c) -> | CompExpr (Gt c) ->
simpl_binop "GT" c compile_binop "GT" c
| CompExpr (Leq c) -> | CompExpr (Leq c) ->
simpl_binop "LE" c compile_binop "LE" c
| CompExpr (Geq c) -> | CompExpr (Geq c) ->
simpl_binop "GE" c compile_binop "GE" c
| CompExpr (Equal c) -> | CompExpr (Equal c) ->
simpl_binop "EQ" c compile_binop "EQ" c
| CompExpr (Neq c) -> | CompExpr (Neq c) ->
simpl_binop "NEQ" c compile_binop "NEQ" c
and simpl_list_expression (t:Raw.list_expr) : expression result = and compile_list_expression (t:Raw.list_expr) : expression result =
let return x = ok @@ x in let return x = ok @@ x in
match t with match t with
ECons c -> simpl_binop "CONS" c ECons c -> compile_binop "CONS" c
| EListComp lst -> ( | EListComp lst -> (
let (lst , loc) = r_split lst in let (lst , loc) = r_split lst in
let%bind lst' = let%bind lst' =
bind_map_list simpl_expression @@ bind_map_list compile_expression @@
pseq_to_list lst.elements in pseq_to_list lst.elements in
return @@ e_list ~loc lst' return @@ e_list ~loc lst'
) )
and simpl_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result = and compile_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result =
let return x = ok @@ x in let return x = ok @@ x in
let (args , loc) = r_split t in let (args , loc) = r_split t in
let%bind a = simpl_expression args.arg1 in let%bind a = compile_expression args.arg1 in
let%bind b = simpl_expression args.arg2 in let%bind b = compile_expression args.arg2 in
let%bind name = constants name in let%bind name = constants name in
return @@ e_constant ~loc name [ a ; b ] return @@ e_constant ~loc name [ a ; b ]
and simpl_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result = and compile_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result =
let return x = ok @@ x in let return x = ok @@ x in
let (t , loc) = r_split t in let (t , loc) = r_split t in
let%bind a = simpl_expression t.arg in let%bind a = compile_expression t.arg in
let%bind name = constants name in let%bind name = constants name in
return @@ e_constant ~loc name [ a ] return @@ e_constant ~loc name [ a ]
and simpl_tuple_expression ?loc (lst:Raw.expr list) : expression result = and compile_tuple_expression ?loc (lst:Raw.expr list) : expression result =
let return x = ok @@ x in let return x = ok @@ x in
match lst with match lst with
| [] -> return @@ e_literal ?loc Literal_unit | [] -> return @@ e_literal ?loc Literal_unit
| [hd] -> simpl_expression hd | [hd] -> compile_expression hd
| lst -> | lst ->
let%bind lst = bind_list @@ List.map simpl_expression lst in let%bind lst = bind_list @@ List.map compile_expression lst in
return @@ e_tuple ?loc lst return @@ e_tuple ?loc lst
and simpl_declaration : Raw.declaration -> declaration Location.wrap list result = and compile_declaration : Raw.declaration -> declaration Location.wrap list result =
fun t -> fun t ->
let open! Raw in let open! Raw in
let loc : 'a . 'a Raw.reg -> _ -> _ = let loc : 'a . 'a Raw.reg -> _ -> _ =
@ -735,28 +788,26 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
match t with match t with
| TypeDecl x -> | TypeDecl x ->
let {name;type_expr} : Raw.type_decl = x.value in let {name;type_expr} : Raw.type_decl = x.value in
let%bind type_expression = simpl_type_expression type_expr in let%bind type_expression = compile_type_expression type_expr in
ok @@ [loc x @@ Declaration_type (Var.of_name name.value , type_expression)] ok @@ [loc x @@ Declaration_type (Var.of_name name.value , type_expression)]
| Let x -> ( | Let x -> (
let (_, let_binding, attributes), _ = r_split x in let (_, recursive, let_binding, attributes), _ = r_split x in
let inline = List.exists (fun (a: Raw.attribute) -> a.value = "inline") attributes in let inline = List.exists (fun (a: Raw.attribute) -> a.value = "inline") attributes in
let binding = let_binding in let binding = let_binding in
let {binders; lhs_type; let_rhs} = binding in let {binders; lhs_type; let_rhs} = binding in
let%bind (hd, _) = let (hd, _) = binders in
let (hd, tl) = binders in ok (hd, tl) in
match hd with match hd with
| PTuple pt -> | PTuple pt ->
let process_variable (var_pair: pattern * Raw.expr) : let process_variable (var_pair: pattern * Raw.expr) =
Ast_simplified.declaration Location.wrap result =
(let (par_var, rhs_expr) = var_pair in (let (par_var, rhs_expr) = var_pair in
let%bind (v, v_type) = pattern_to_typed_var par_var in let%bind (v, v_type) = pattern_to_typed_var par_var in
let%bind v_type_expression = let%bind v_type_expression =
match v_type with match v_type with
| Some v_type -> ok (to_option (simpl_type_expression v_type)) | Some v_type -> ok (to_option (compile_type_expression v_type))
| None -> ok None | None -> ok None
in in
let%bind simpl_rhs_expr = simpl_expression rhs_expr in let%bind compile_rhs_expr = compile_expression rhs_expr in
ok @@ loc x @@ Declaration_constant (Var.of_name v.value, v_type_expression, inline, simpl_rhs_expr) ) ok @@ loc x @@ Declaration_constant (Var.of_name v.value, v_type_expression, inline, compile_rhs_expr) )
in let%bind variables = ok @@ npseq_to_list pt.value in let%bind variables = ok @@ npseq_to_list pt.value
in let%bind expr_bind_lst = in let%bind expr_bind_lst =
match let_rhs with match let_rhs with
@ -788,18 +839,18 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
gen_access_tuple name ~i: (i + 1) ~accesses gen_access_tuple name ~i: (i + 1) ~accesses
in ok (gen_access_tuple name) in ok (gen_access_tuple name)
(* TODO: Improve this error message *) (* TODO: Improve this error message *)
| other -> fail @@ simplifying_expr other | other -> fail @@ abstracting_expr other
in let%bind decls = in let%bind decls =
(* TODO: Rewrite the gen_access_tuple so there's no List.rev *) (* TODO: Rewrite the gen_access_tuple so there's no List.rev *)
bind_map_list process_variable (List.combine variables (List.rev expr_bind_lst)) bind_map_list process_variable (List.combine variables (List.rev expr_bind_lst))
in ok @@ decls in ok @@ decls
| PPar {region = _ ; value = { lpar = _ ; inside = pt; rpar = _; } } -> | PPar {region = _ ; value = { lpar = _ ; inside = pt; rpar = _; } } ->
(* Extract parenthetical multi-bind *) (* Extract parenthetical multi-bind *)
let (wild, _, attributes) = fst @@ r_split x in let (wild, recursive, _, attributes) = fst @@ r_split x in
simpl_declaration compile_declaration
(Let { (Let {
region = x.region; region = x.region;
value = (wild, {binders = (pt, []); value = (wild, recursive, {binders = (pt, []);
lhs_type = lhs_type; lhs_type = lhs_type;
eq = Region.ghost ; eq = Region.ghost ;
let_rhs = let_rhs}, attributes)} let_rhs = let_rhs}, attributes)}
@ -811,7 +862,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
let%bind var = pattern_to_var hd in let%bind var = pattern_to_var hd in
ok (var , tl) ok (var , tl)
in in
let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in
let%bind let_rhs,lhs_type = match args with let%bind let_rhs,lhs_type = match args with
| [] -> ok (let_rhs, lhs_type') | [] -> ok (let_rhs, lhs_type')
| param1::others -> | param1::others ->
@ -827,12 +878,12 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
let aux acc ty = Option.map (t_function (snd ty)) acc in let aux acc ty = Option.map (t_function (snd ty)) acc in
ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty) ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty)
in in
let%bind rhs' = simpl_expression let_rhs in let%bind rhs' = compile_expression let_rhs in
let%bind lhs_type = match lhs_type with let%bind lhs_type = match lhs_type with
| None -> (match let_rhs with | None -> (match let_rhs with
| EFun {value={binders;lhs_type}} -> | EFun {value={binders;lhs_type}} ->
let f_args = nseq_to_list (binders) in let f_args = nseq_to_list (binders) in
let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in
let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in
let aux acc ty = Option.map (t_function (snd ty)) acc in let aux acc ty = Option.map (t_function (snd ty)) acc in
ok @@ (List.fold_right' aux lhs_type' ty) ok @@ (List.fold_right' aux lhs_type' ty)
@ -840,10 +891,22 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
) )
| Some t -> ok @@ Some t | Some t -> ok @@ Some t
in in
let binder = Var.of_name var.value in
let%bind rhs' = match recursive with
None -> ok @@ rhs'
| Some _ -> match rhs'.expression_content with
E_lambda lambda ->
(match lhs_type with
None -> fail @@ untyped_recursive_function var
| Some (lhs_type) ->
let expression_content = E_recursive {fun_name=binder;fun_type=lhs_type;lambda} in
ok @@ {rhs' with expression_content})
| _ -> ok @@ rhs'
in
ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))] ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))]
) )
and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result = and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result =
fun t -> fun t ->
let open Raw in let open Raw in
let rec get_var (t:Raw.pattern) = let rec get_var (t:Raw.pattern) =
@ -963,6 +1026,6 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content
| _ -> simple_fail "bad option pattern" | _ -> simple_fail "bad option pattern"
in bind_or (as_option () , as_variant ()) in bind_or (as_option () , as_variant ())
let simpl_program : Raw.ast -> program result = fun t -> let compile_program : Raw.ast -> program result = fun t ->
let%bind decls = bind_map_list simpl_declaration @@ nseq_to_list t.decl in let%bind decls = bind_map_list compile_declaration @@ nseq_to_list t.decl in
ok @@ List.concat @@ decls ok @@ List.concat @@ decls

View File

@ -1,8 +1,7 @@
[@@@warning "-45"] [@@@warning "-45"]
open Trace open Trace
open Ast_imperative
open Ast_simplified
module Raw = Parser.Cameligo.AST module Raw = Parser.Cameligo.AST
module SMap = Map.String module SMap = Map.String
@ -29,7 +28,7 @@ module Errors : sig
val unsupported_tuple_pattern : Raw.pattern -> unit -> error val unsupported_tuple_pattern : Raw.pattern -> unit -> error
val unsupported_cst_constr : Raw.pattern -> unit -> error val unsupported_cst_constr : Raw.pattern -> unit -> error
val unsupported_non_var_pattern : Raw.pattern -> unit -> error val unsupported_non_var_pattern : Raw.pattern -> unit -> error
val simplifying_expr : Raw.expr -> unit -> error val abstracting_expr : Raw.expr -> unit -> error
val only_constructors : Raw.pattern -> unit -> error val only_constructors : Raw.pattern -> unit -> error
val unsupported_sugared_lists : Raw.wild -> unit -> error val unsupported_sugared_lists : Raw.wild -> unit -> error
val bad_set_definition : unit -> error val bad_set_definition : unit -> error
@ -46,18 +45,18 @@ val pattern_to_var : Raw.pattern -> Raw.variable result
val pattern_to_typed_var : Raw.pattern -> ( Raw.variable * Raw.type_expr option ) result val pattern_to_typed_var : Raw.pattern -> ( Raw.variable * Raw.type_expr option ) result
val expr_to_typed_expr : Raw.expr -> ( Raw.expr * Raw.type_expr option ) result val expr_to_typed_expr : Raw.expr -> ( Raw.expr * Raw.type_expr option ) result
val patterns_to_var : Raw.pattern list -> Raw.variable result val patterns_to_var : Raw.pattern list -> Raw.variable result
val simpl_type_expression : Raw.type_expr -> type_expression result val compile_type_expression : Raw.type_expr -> type_expression result
val simpl_list_type_expression : Raw.type_expr list -> type_expression result val compile_list_type_expression : Raw.type_expr list -> type_expression result
*) *)
val simpl_expression : Raw.expr -> expr result val compile_expression : Raw.expr -> expr result
(* (*
val simpl_fun : Raw.fun_expr Raw.reg -> expr result val compile_fun : Raw.fun_expr Raw.reg -> expr result
val simpl_logic_expression : ?te_annot:type_expression -> Raw.logic_expr -> expr result val compile_logic_expression : ?te_annot:type_expression -> Raw.logic_expr -> expr result
val simpl_list_expression : Raw.list_expr -> expression result val compile_list_expression : Raw.list_expr -> expression result
val simpl_binop : string -> Raw.wild Raw.bin_op Region.reg -> expression result val compile_binop : string -> Raw.wild Raw.bin_op Region.reg -> expression result
val simpl_unop : string -> Raw.wild Raw.un_op Region.reg -> expression result val compile_unop : string -> Raw.wild Raw.un_op Region.reg -> expression result
val simpl_tuple_expression : ?loc:Location.t -> Raw.expr list -> expression result val compile_tuple_expression : ?loc:Location.t -> Raw.expr list -> expression result
val simpl_declaration : Raw.declaration -> declaration Location.wrap result val compile_declaration : Raw.declaration -> declaration Location.wrap result
val simpl_cases : (Raw.pattern * 'a) list -> 'a matching result val compile_cases : (Raw.pattern * 'a) list -> 'a matching result
*) *)
val simpl_program : Raw.ast -> program result val compile_program : Raw.ast -> program result

View File

@ -1,7 +1,7 @@
open Trace open Trace
open Function open Function
module I = Parser.Cameligo.Ast module I = Parser.Cameligo.Ast
module O = Ast_simplified module O = Ast_core
open O.Combinators open O.Combinators
let unwrap : type a . a Location.wrap -> a = Location.unwrap let unwrap : type a . a Location.wrap -> a = Location.unwrap
@ -252,7 +252,7 @@ and expression_main : I.expression_main Location.wrap -> O.expression result = f
let%bind (a' , b') = bind_map_pair expression_main ab in let%bind (a' , b') = bind_map_pair expression_main ab in
return @@ e_binop name a' b' in return @@ e_binop name a' b' in
let error_main = let error_main =
let title () = "simplifying main_expression" in let title () = "abstracting main_expression" in
let content () = Format.asprintf "%a" I.pp_expression_main (unwrap em) in let content () = Format.asprintf "%a" I.pp_expression_main (unwrap em) in
error title content error title content
in in

Some files were not shown because too many files have changed in this diff Show More