Merge remote-tracking branch 'origin/dev' into HEAD

This commit is contained in:
Georges Dupéron 2019-06-13 12:03:46 +02:00
commit 148daa32a2
87 changed files with 1787 additions and 316 deletions

1
.gitignore vendored
View File

@ -2,3 +2,4 @@
/dune-project /dune-project
*~ *~
cache/* cache/*
Version.ml

View File

@ -1,44 +0,0 @@
---
id: language-basics-entrypoints
title: Entrypoints
---
## Defining an entry point
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
function main (const p : int ; const s : int) : (list(operation) * int) is
block {skip} with ((nil : list(operation)), s + 1)
```
<!--END_DOCUSAURUS_CODE_TABS-->
## Multiple entry points
Multiple entrypoints are currently not supported in Michelson, however with Ligo, you can work that around by using variants.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
// variant defining pseudo multi-entrypoint actions
type action is
| Increment of int
| Decrement of int
function add (const a : int ; const b : int) : int is
block { skip } with a + b
function subtract (const a : int ; const b : int) : int is
block { skip } with a - b
// real entrypoint that re-routes the flow based on the action provided
function main (const p : action ; const s : int) : (list(operation) * int) is
block {skip} with ((nil : list(operation)),
case p of
| Increment n -> add(s, n)
| Decrement n -> subtract(s, n)
end)
```
<!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -1,22 +0,0 @@
---
id: language-basics-functions
title: Functions
---
## Defining a function
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
// multiply(1, 2) = 2
function multiply (const a : int ; const b : int) : int is
begin
const result : int = a * b ;
end with result
// add(1, 2) = 3
function add (const a : int ; const b : int) : int is
block { skip } with a + b
```
<!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -1,18 +0,0 @@
---
id: language-basics-variables
title: Variables
---
## Defining a variable
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
// int
const four : int = 4;
// string
const name : string = "John Doe";
```
<!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -0,0 +1,37 @@
---
id: cheat-sheet
title: Cheat Sheet
---
<!--DOCUSAURUS_CODE_TABS-->
<!--PascaLIGO-->
|Primitive |Example|
|--- |---|
|Strings | `"Tezos"`|
|Characters | `"t"`|
|Integers | `42`, `7`|
|Natural numbers | `42n`, `7n`|
|Unit| `unit`|
|Boolean|<pre><code>const hasDriversLicense: bool = False;<br/>const adult: bool = True;</code></pre> |
|Mutez (micro tez)| `42mtz`, `7mtz` |
|Address | `"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"`, `"KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD"`|
|Addition |`3 + 4`, `3n + 4n`|
|Multiplication & Division| `3 * 4`, `3n * 4n`, `10 / 5`, `10n / 5n`|
|Modulo| `10 mod 3`|
|Tuples| <pre><code>type name is (string * string);<br/>const winner: name = ("John", "Doe");<br/>const firstName: string = winner.0;<br/>const lastName: string = winner.1;</code></pre>|
|Types|`type age is int`, `type name is string` |
|Includes|```#include "library.ligo"```|
|Functions (short form)|<pre><code>function add (const a : int ; const b : int) : int is<br/>&nbsp;&nbsp;block { skip } with a + b</code></pre>|
|Functions (long form)|<pre><code>function add (const a : int ; const b : int) : int is<br/>&nbsp;&nbsp;block { <br/>&nbsp;&nbsp;&nbsp;&nbsp;const result: int = a + b;<br/>&nbsp;&nbsp;} with result</code></pre>|
|Options|<pre><code>type middleName is option(string);<br/>const middleName : middleName = Some("Foo");<br/>const middleName : middleName = None;</code></pre>|
|Assignment| ```const age: int = 5;```|
|Assignment on an existing variable <br/></br>*⚠️ This feature is not supported at the top-level scope, you can use it e.g. within functions. Works for Records and Maps as well.*| ```age := 18;```, ```p.age := 21``` |
|Annotations| ```("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address)```|
|Variants|<pre><code>type action is<br/>&#124; Increment of int<br/>&#124; Decrement of int</code></pre>|
|Variant *(pattern)* matching|<pre><code>const a: action = Increment(5);<br/>case a of<br/>&#124; Increment n -> n + 1<br/>&#124; Decrement n -> n - 1<br/>end</code></pre>|
|Records|<pre><code>type person is record<br/>&nbsp;&nbsp;age: int ;<br/>&nbsp;&nbsp;name: string ;<br/>end<br/><br/>const john : person = record<br/>&nbsp;&nbsp;age = 18;<br/>&nbsp;&nbsp;name = "John Doe";<br/>end<br/><br/>const name: string = john.name;</code></pre>|
|Maps|<pre><code>type prices is map(nat, tez);<br/><br/>const prices : prices = map<br/>&nbsp;&nbsp;10n -> 60mtz;<br/>&nbsp;&nbsp;50n -> 30mtz;<br/>&nbsp;&nbsp;100n -> 10mtz;<br/>end<br/><br/>const price: option(tez) = prices[50n];</code></pre>|
<!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -0,0 +1,46 @@
---
id: entrypoints
title: Entrypoints
---
Entrypoints serve as a gate to our smart contracts. In LIGO each entrypoint is a function that accepts two arguments - first one is the parameter used to invoke the contract, and the second is the current storage of the contract. Each entrypoint has to return a list of operations to apply as a result of the smart contract call, and a new storage value.
> If you don't want to update the storage, don't worry, just re-cycle your last storage value.
## Defining an entry point
Contract below is effectively an empty contract, that takes a `unit` as a parameter, and returns a `unit` as well.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
function main (const p : unit ; const s : unit) : (list(operation) * unit) is
block {skip} with ((nil : list(operation)), s)
```
<!--END_DOCUSAURUS_CODE_TABS-->
## Multiple entry points
Multiple entrypoints are currently not supported in Michelson yet, however with Ligo, you can work that around by using variants & pattern matching.
In the example below we have a simple counter contract, that can be either `Increment(int)`-ed, or `Decrement(int)`-ed.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
// variant defining pseudo multi-entrypoint actions
type action is
| Increment of int
| Decrement of int
// real entrypoint that re-routes the flow based on the action (parameter) provided
function main (const action: action ; const counter: int) : (list(operation) * int) is
block {skip} with ((nil : list(operation)),
case action of
| Increment number -> counter + number
| Decrement number -> counter - number
end)
```
<!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -0,0 +1,43 @@
---
id: functions
title: Functions
---
## Defining a function
Body of a function consists of two parts, the first part (**`block {}`** or **`begin ... end`**) - normally consists of logic *(flow conditions, variable declarations, etc.)*, and the second part (**`with ...`**) usually defines the return value of your function.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
const availableSupply: nat = 15n;
const totalSupply: nat = 100n;
function calculatePrice(const available: nat; const total: nat): nat is
begin
const price: nat = total / available
end with price
const price: nat = calculatePrice(availableSupply, totalSupply);
```
<!--END_DOCUSAURUS_CODE_TABS-->
### Functions without an explicit body (shorter syntax)
A short hand syntax for the same function as above can inline the price calculation directly into the return statement.
While this approach can have it's benefits, it can decrease readability.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
const availableSupply: nat = 15n;
const totalSupply: nat = 100n;
function calculatePrice(const available: nat; const total: nat): nat is
block { skip } with total / available
const price: nat = calculatePrice(availableSupply, totalSupply);
```
<!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -1,10 +1,12 @@
--- ---
id: language-basics-operators id: operators
title: Operators title: Operators
--- ---
## Available operators ## Available operators
> This list is non-exhaustive, more operators will be added in the upcoming LIGO releases.
|Michelson |Pascaligo |Description | |Michelson |Pascaligo |Description |
|--- |--- |--- | |--- |--- |--- |
| `SENDER` | `sender` | Address that initiated the current transaction | `SENDER` | `sender` | Address that initiated the current transaction

View File

@ -0,0 +1,72 @@
---
id: types
title: Types
---
## Built-in types
For the list of built-in types, please refer to the [Cheat Sheet](language-basics/cheat-sheet.md). LIGO's type system is built on top of Michelson, but offers a handful of features like type aliasing, or groupping of multiple types into a single powerful type.
## Type aliases
Type aliasing is a great choice when working towards a readable / maintainable smart contract. One well typed variable is worth a thousand words. For example we can choose to *alias* a string, as an animal breed - this will allow us to comunicate our intent with added clarity.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
type animalBreed is string;
const dogBreed: animalBreed = "Saluki";
```
<!--END_DOCUSAURUS_CODE_TABS-->
## Defining custom types
### Simple types
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
// accountBalances is a simple type, a map of address <-> tez
type accountBalances is map(address, tez);
const ledger: accountBalances = map
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> 10mtz
end
```
<!--END_DOCUSAURUS_CODE_TABS-->
### Composed types
Often our contracts will require complex data structures, which will in turn require a well-typed storage, or functions to work with. LIGO offers a simple way to compose simple types, into larger & more expressive composed types.
In the example below you can see definition of data types for a ledger, that keeps a balance & number of previous transactions for a given account.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
// alias two types
type account is address;
type numberOfTransactions is nat;
// accountData consists of a record with two fields (balance, numberOfTransactions)
type accountData is record
balance: tez;
numberOfTransactions: numberOfTransactions;
end
// our ledger / accountBalances is a map of account <-> accountData
type accountBalances is map(account, accountData);
// pseudo-JSON representation of our map
// { "tz1...": {balance: 10mtz, numberOfTransactions: 5n} }
const ledger: accountBalances = map
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> record
balance = 10mtz;
numberOfTransactions = 5n;
end
end
```
<!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -0,0 +1,40 @@
---
id: variables
title: Variables
---
## Defining a variable
Variables in LIGO can be defined in two ways - by using either the `const` or `var` keywords. `const` can be used both at global (top-level) and local scope (within functions/blocks), while `var` can be used for mutable values in the local scope.
### Imutable variables using `const`
> ⚠️ Currently const values are mutable as well, however this is something that will change in the upcoming release. For the time being think of `const` as a semantical way to indicate developer intentions.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
const four: int = 4;
```
<!--END_DOCUSAURUS_CODE_TABS-->
### Mutable variables using `var`
> ⚠️ `var` can't be used in the global scope
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```Pascal
// won't work, use const for global values instead
var four: int = 4;
// value of `number` can be mutated within local scope
function addFour(var number: int): int is
block {
number := number + 4;
} with number;
```
<!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -0,0 +1,8 @@
---
id: editor-support
title: Editor Support
---
Good editor support is the basic component of proper development experience - currently, we provide support for VSCode via an [extension](https://marketplace.visualstudio.com/items?itemName=Brice.ligo).
Currently the extension supports Pascaligo for syntax highlighting (work in progress). But it aims to support debug, gas optimization, dry run and other relevant features in the near future.

View File

@ -1,5 +1,5 @@
--- ---
id: setup-installation id: installation
title: Installation title: Installation
--- ---
@ -33,6 +33,3 @@ ligo --help
## Manual installation (advanced) ## Manual installation (advanced)
For now, please refer to the steps described in the [Dockerfile](https://gitlab.com/ligolang/ligo/blob/master/docker/Dockerfile). For now, please refer to the steps described in the [Dockerfile](https://gitlab.com/ligolang/ligo/blob/master/docker/Dockerfile).

View File

@ -1,6 +0,0 @@
---
id: first-smart-contract
title: My first LIGO smart contract
---
TODO

View File

@ -0,0 +1,23 @@
type taco_supply is record
current_stock : nat;
max_price : tez;
end
type taco_shop_storage is map(nat, taco_supply);
function buy_taco (const taco_kind_index: nat ; var taco_shop_storage : taco_shop_storage) : (list(operation) * taco_shop_storage) is
begin
// Retrieve the taco_kind from the contract's storage
const taco_kind : taco_supply = get_force(taco_kind_index, taco_shop_storage);
const current_purchase_price : tez = taco_kind.max_price / taco_kind.current_stock;
if amount =/= current_purchase_price then
// we won't sell tacos if the amount isn't correct
fail("Sorry, the taco you're trying to purchase has a different price");
else
// Decrease the stock by 1n, because we've just sold one
taco_kind.current_stock := abs(taco_kind.current_stock - 1n);
// Update the storage with the refreshed taco_kind
taco_shop_storage[taco_kind_index] := taco_kind;
end with ((nil : list(operation)), taco_shop_storage)

View File

@ -0,0 +1,335 @@
---
id: tezos-taco-shop-smart-contract
title: Taco shop smart-contract
---
<div>
Meet **Pedro**, our *artisan taco chef* who has decided to open a Taco shop on the Tezos blockchain, using a smart-contract. He sells two different kinds of tacos, the **el clásico** and the **especial del chef**.
To help Pedro open his dream taco shop, we'll implement a smart-contract, that will manage supply, pricing & sales of his tacos to the consumers.
<br/>
<img src="/img/tutorials/get-started/tezos-taco-shop-smart-contract/taco-stand.svg" width="50%" />
<div style="opacity: 0.7; text-align: center; font-size: 10px;">Made by <a href="https://www.flaticon.com/authors/smashicons" title="Smashicons">Smashicons</a> from <a href="https://www.flaticon.com/" title="Flaticon">www.flaticon.com</a> is licensed by <a href="http://creativecommons.org/licenses/by/3.0/" title="Creative Commons BY 3.0" target="_blank">CC 3.0 BY</a></div>
</div>
---
## Pricing
Pedro's tacos are a rare delicatese, so their **price goes up**, as the **stock for the day begins to deplete**.
Each taco kind, has it's own `max_price` that it sells for, and a finite supply for the current sales lifecycle.
> For the sake of simplicity, we won't implement replenishing of the supply after it runs out.
### Daily offer
|**kind** |id |**available_stock**| **max_price**|
|---|---|---|---|
|el clásico | `1n` | `50n` | `50000000mtz` |
|especial del chef | `2n` | `20n` | `75000000mtz` |
### Calculating the current purchase price
Current purchase price is calculated with the following equation:
```
current_purchase_price = max_price / available_stock
```
#### El clásico
|**available_stock**|**max_price**|**current_purchase_price**|
|---|---|---|
| `50n` | `50000000mtz` | `1tz`|
| `20n` | `50000000mtz` | `2.5tz` |
| `5n` | `50000000mtz` | `10tz` |
#### Especial del chef
|**available_stock**|**max_price**|**current_purchase_price**|
|---|---|---|
| `20n` | `75000000mtz` | `3.75tz` |
| `10n` | `75000000mtz` | `7.5tz`|
| `5n` | `75000000mtz` | `15tz` |
---
## Installing LIGO
In this tutorial, we'll use LIGO's dockerized version for the sake of simplicity. You can find the installation instructions [here](setup/installation.md#dockerized-installation-recommended).
<img src="/img/tutorials/get-started/tezos-taco-shop-smart-contract/install-ligo.png" />
<div style="opacity: 0.7; text-align: center; font-size: 12px; margin-top:-24px;">Installing the <b>next</b> version of LIGO's CLI</div>
## Implementing our first entry point
> From now on we'll get a bit more technical. If you run into something we have not covered yet - please try checking out the [LIGO cheat sheet](language-basics/cheat-sheet.md) for some extra tips & tricks.
To begin implementing our smart contract, we need an entry point. We'll call it `main` and it'll specify our contract's storage (`int`) and input parameter (`int`). Of course this is not the final storage/parameter of our contract, but it's something to get us started and test our LIGO installation as well.
### `taco-shop.ligo`
```Pascal
function main (const parameter : int; const contractStorage : int) : (list(operation) * int) is
block {skip} with ((nil : list(operation)), contractStorage + parameter)
```
Let's brake down the contract above to make sure we understand each bit of the LIGO syntax:
- **`function main`** - definition of a function that serves as an entry point
- **`(const parameter : int; const contractStorage : int)`** - parameters passed to the function
- **`const parameter : int`** - parameter provided by a transaction that invokes our contract
- **`const contractStorage : int`** - definition of our storage (`int`)
- **`(list(operation) * int)`** - return type of our function, in our case a touple with a list of operations, and an int
- **`block {skip}`** - our function has no body, so we instruct LIGO to `skip` it
- **`with ((nil : list(operation)), contractStorage + parameter)`** - essentially a return statement
- **`(nil : list(operation))`** - a `nil` value annotated as a list of operations, because that's required by our return type specified above
- **`contractStorage + parameter`** - a new storage value for our contract, sum of previous storage and a transaction parameter
### Running LIGO for the first time
To test that we've installed LIGO correctly, and that `taco-shop.ligo` is a valid contract, we'll dry-run it.
> Dry-running is a simulated execution of the smart contract, based on a mock storage value and a parameter.
Our contract has a storage of `int` and accepts a parameter that is also an `int`.
The `dry-run` command requires a few parameters:
- **contract** *(file path)*
- **entrypoint** *(name of the entrypoint function in the contract)*
- **parameter** *(parameter to execute our contract with)*
- **storage** *(starting storage before our contract's code is executed)*
And outputs what's returned from our entrypoint - in our case a touple containing an empty list (of operations to apply) and the new storage value - which in our case is the sum of the previous storage and the parameter we've used.
```zsh
# Contract: taco-shop.ligo
# Entry point: main
# Parameter: 4
# Storage: 3
ligo dry-run taco-shop.ligo --syntax pascaligo main 4 3
# tuple[ list[]
# 7
# ]
```
<img src="/img/tutorials/get-started/tezos-taco-shop-smart-contract/dry-run-1.png" />
<div style="opacity: 0.7; text-align: center; font-size: 12px; margin-top:-24px;">Simulating contract execution with the CLI</div>
<br/>
*`3 + 4 = 7` yay! Our CLI & contract work as expected, we can move onto fulfilling Pedro's on-chain dream.*
---
## Designing Taco shop's contract storage
We know that Pedro's Taco Shop serves two kinds of tacos, so we'll need to manage stock individually, per kind. Let's define a type, that will keep the `stock` & `max_price` per kind - in a record with two fields. Additionally, we'll want to combine our `taco_supply` type into a map, consisting of the entire offer of Pedro's shop.
**Taco shop's storage**
```Pascal
type taco_supply is record
current_stock : nat;
max_price : tez;
end
type taco_shop_storage is map(nat, taco_supply);
```
Next step is to update the `main` entry point to include `taco_shop_storage` as it's storage - while doing that let's set the `parameter` to `unit` as well to clear things up.
**`taco-shop.ligo`**
```Pascal
type taco_supply is record
current_stock : nat;
max_price : tez;
end
type taco_shop_storage is map(nat, taco_supply);
function main (const parameter: unit ; const taco_shop_storage : taco_shop_storage) : (list(operation) * taco_shop_storage) is
block {skip} with ((nil : list(operation)), taco_shop_storage)
```
### Populating our storage in a dry-run
When dry-running a contract, it's crucial to provide a correct initial storage value - in our case the storage is type-checked as `taco_shop_storage`. Reflecting [Pedro's daily offer](tutorials/get-started/tezos-taco-shop-smart-contract.md#daily-offer), our storage's value will be defined as following:
**Storage value**
```zsh
map
1n -> record
current_stock = 50n;
max_price = 50000000mtz;
end;
2n -> record
current_stock = 20n;
max_price = 75000000mtz;
end;
end
```
> Storage value is a map, with two items in it, both items are records identified by natural numbers `1n` & `2n`.
**Dry run command with a multi-line storage value**
```zsh
ligo dry-run taco-shop.ligo --syntax pascaligo main unit "map
1n -> record
current_stock = 50n;
max_price = 50000000mtz;
end;
2n -> record
current_stock = 20n;
max_price = 75000000mtz;
end;
end"
```
<img src="/img/tutorials/get-started/tezos-taco-shop-smart-contract/dry-run-2.png" />
<div style="opacity: 0.7; text-align: center; font-size: 12px; margin-top:-24px;">Dry-run with a complex storage value</div>
<br/>
*If everything went as expected, the `dry-run` command will return the contract's current storage, which is the map of products we've defined based on the daily offer of Pedro's taco shop.*
---
## Providing an entrypoint for buying tacos
Now that we have our stock well defined in form of storage, we can move on to the actual sales. We'll replace the `main` entrypoint with `buy_taco`, that takes an `id` - effectively a key from our `taco_shop_storage` map. This will allow us to calculate pricing, and if the sale is successful - then we can reduce our stock - because we have sold a taco!
### Selling the tacos for free
Let's start by customizing our contract a bit, we will:
- rename the entrypoint from `main` to `buy_taco`
- rename `parameter` to `taco_kind_index`
- change `taco_shop_storage` to a `var` instead of a `const`, because we'll want to modify it
**`taco-shop.ligo`**
```Pascal
type taco_supply is record
current_stock : nat;
max_price : tez;
end
type taco_shop_storage is map(nat, taco_supply);
function buy_taco (const taco_kind_index: nat ; var taco_shop_storage : taco_shop_storage) : (list(operation) * taco_shop_storage) is
block { skip } with ((nil : list(operation)), taco_shop_storage)
```
#### Decreasing `current_stock` when a taco is sold
In order to decrease the stock in our contract's storage for a specific taco kind, a few things needs to happen:
- retrieve the `taco_kind` from our storage, based on the `taco_kind_index` provided
- subtract the `taco_kind.current_stock` by `1n`
- we can find the absolute (`nat`) value of the subtraction above by using `abs`, otherwise we'd be left with an `int`
- update the storage, and return it
**`taco-shop.ligo`**
```Pascal
type taco_supply is record
current_stock : nat;
max_price : tez;
end
type taco_shop_storage is map(nat, taco_supply);
function buy_taco (const taco_kind_index: nat ; var taco_shop_storage : taco_shop_storage) : (list(operation) * taco_shop_storage) is
begin
// Retrieve the taco_kind from the contract's storage
const taco_kind : taco_supply = get_force(taco_kind_index, taco_shop_storage);
// Decrease the stock by 1n, because we've just sold one
taco_kind.current_stock := abs(taco_kind.current_stock - 1n);
// Update the storage with the refreshed taco_kind
taco_shop_storage[taco_kind_index] := taco_kind;
end with ((nil : list(operation)), taco_shop_storage)
```
<img src="/img/tutorials/get-started/tezos-taco-shop-smart-contract/dry-run-3.png" />
<div style="opacity: 0.7; text-align: center; font-size: 12px; margin-top:-24px;">Stock decreases after selling a taco</div>
<br/>
### Making sure we get paid for our tacos
In order to make Pedro's taco shop profitable, he needs to stop giving away tacos for free. When a contract is invoked via a transaction, an amount of tezzies to be sent can be specified as well. This amount is accessible within LIGO as `amount`.
To make sure we get paid, we will:
- calculate a `current_purchase_price` based on the [equation specified earlier](tutorials/get-started/tezos-taco-shop-smart-contract.md#calculating-the-current-purchase-price)
- check if the sent `amount` matches the `current_purchase_price`
- if not, then our contract will `fail` and stop executing
- if yes, stock for the given `taco_kind` will be decreased and the payment accepted
**`taco-shop.ligo`**
```Pascal
type taco_supply is record
current_stock : nat;
max_price : tez;
end
type taco_shop_storage is map(nat, taco_supply);
function buy_taco (const taco_kind_index: nat ; var taco_shop_storage : taco_shop_storage) : (list(operation) * taco_shop_storage) is
begin
// Retrieve the taco_kind from the contract's storage
const taco_kind : taco_supply = get_force(taco_kind_index, taco_shop_storage);
const current_purchase_price : tez = taco_kind.max_price / taco_kind.current_stock;
if amount =/= current_purchase_price then
// we won't sell tacos if the amount isn't correct
fail("Sorry, the taco you're trying to purchase has a different price");
else
// Decrease the stock by 1n, because we've just sold one
taco_kind.current_stock := abs(taco_kind.current_stock - 1n);
// Update the storage with the refreshed taco_kind
taco_shop_storage[taco_kind_index] := taco_kind;
end with ((nil : list(operation)), taco_shop_storage)
```
In order to test the `amount` sent, we'll use the `--amount` option of `dry-run`:
```zsh
ligo dry-run taco-shop.ligo--syntax pascaligo --amount 1 buy_taco 1n "map
1n -> record
current_stock = 50n;
max_price = 50000000mtz;
end;
2n -> record
current_stock = 20n;
max_price = 75000000mtz;
end;
end"
```
**Purchasing a taco with 1.0tz**
<img src="/img/tutorials/get-started/tezos-taco-shop-smart-contract/dry-run-4.png" />
<div style="opacity: 0.7; text-align: center; font-size: 12px; margin-top:-24px;">Stock decreases after selling a taco, if the right amount of tezzies is provided</div>
<br/>
**Attempting to purchase a taco with 0.7tz**
<img src="/img/tutorials/get-started/tezos-taco-shop-smart-contract/dry-run-5.png" />
<div style="opacity: 0.7; text-align: center; font-size: 12px; margin-top:-24px;">Stock does not decrease after a purchase attempt with a lower than required amount.</div>
<br/>
**That's it - Pedro can now sell tacos on-chain, thanks to Tezos & LIGO.**
---
## 💰 Bonus: *Accepting tips above the taco purchase price*
If you'd like to accept tips in your contract as well, simply change the following line, depending on which behavior do you prefer.
**Without tips**
```Pascal
if amount =/= current_purchase_price then
```
**With tips**
```Pascal
if amount >= current_purchase_price then
```

View File

@ -1,6 +0,0 @@
---
title: Introducing LIGO
author: Matej Sima
---
Hello LIGO

View File

@ -0,0 +1,103 @@
---
title: Public Launch of LIGO
author: Gabriel Alfour
---
# Public Launch of [LIGO](https://ligolang.org/)
---
## A Refresher: What is LIGO?
LIGO is a statically typed high-level smart-contract language that compiles down to Michelson. It seeks to be easy to use, extensible and safe.
The core language is being developed by The Marigold Project. George Dupéron and Christian Rinderknecht of Nomadic Labs help on the core language, and tooling for LIGO is being developed by Stove Labs (Granary, docs and infrastructure) and Brice Aldrich (syntax highlighting).
Our previous Medium posts about LIGO can be found [here](https://medium.com/tezos/introducing-ligo-a-new-smart-contract-language-for-tezos-233fa17f21c7) and [here](https://medium.com/tezos/ligo-becomes-polyglot-a474e2cb0c24).
## The State of LIGO
Today, we are publicly releasing LIGO in beta\*. We've focused on making the onboarding process for LIGO as painless as possible and encourage you to check out our [tutorials](/docs/tutorials/get-started/tezos-taco-shop-smart-contract) and [documentation](https://ligolang.org/docs/next/setup/installation).
We are fixing bugs and adding features to LIGO (e.g. some Michelson primitives like iterators are missing) by the day. Please submit issues about bugs and missing features you need when you encounter them, and you just might find those solved in the following week.
We have been also working to extend the capabilities of Michelson, benefitting all languages (e.g. SmartPy) in the Tezos ecosystem. These proposed changes include adding multiple entrypoints, partial application (enabling cheap closures) and new operators for fast stack access to Michelson. We will submit these improvements with Nomadic Labs and Cryptium in an amendment planned for the next proposal period.
## Sample Contract
Here are two samples equivalent contracts written in two different syntaxes. They add or substract an amount to the storage depending on the parameter.
```pascal
// Pascaligo syntax
type action is
| Increment of int
| Decrement of int
function main (const p : action ; const s : int) : (list(operation) * int) is
block {skip} with ((nil : list(operation)),
case p of
| Increment n -> s + n
| Decrement n -> s - n
end)
```
```ocaml
(* Cameligo syntax *)
type action =
| Increment of int
| Decrement of int
let main (p : action) (s : int) : (operation list * int) =
let storage =
match p with
| Increment n -> s + n
| Decrement n -> s - n in
(([] : operation list) , storage)
```
## Roadmap
### Short-Term
#### June 2019
✓ First public release (hi)
✓ PascaLIGO and CameLIGO
✓ Docs
✓ Tutorials
\- Integration testing in JS/Reason with [Granary](https://stove-labs.github.io/granary/)
#### July 2019
\- Try ligo online
\- Unit testing in LIGO
\- ReasonLIGO (ReasonML syntax)
\- Design Pattern repository
### Mid-Term
We are currently planning 3 big projects on the core language (excluding tooling).
#### Generic Front End (GFE)
The PascaLIGO and CameLIGO parsers, pretty-printers and highlighters were written by hand. The same will be done for the ReasonML syntax in July.
The Generic Front End is a project to alleviate the need to do this manually for future syntaxes. The idea of the GFE is to develop a system that can take in a syntax description, and then generate:
- A parser
- A displayer
- A transpiler between syntaxes
- A syntax highlighter
- Some documentation
(A prototoype can be found in the code base that generated a PrettyPrinter, a Parser and an AST.)
#### Super Type System (STS)
The current type system is very basic: it is structural, non-polymorphic, without subtyping, names, references, advanced inference or effects. We are planning to change that.
We are looking to develop a Super Type System that has the following features:
- A rich type system. We are planning to integrate standard features (polymorphism, names), clear error messages and intuitive type inference.
- An effect system. This is important to capture failure cases, write effects in an idiomatic yet safe style (rather than passing around the storage through function calls) or capture which contracts can be called.
- An easy-to-use API. We want people to easily build static analysis tools on top of LIGO.
#### Real-time Benchmark
The current version explicitly excludes non-essential features which can produce unexpected explosions in gas costs. To alleviate this constraint, we plan to integrate gas benchmarks on all top-level declarations with some fuzzing. This will allow developers and users to estimate the cost of their contracts in real time.
## Getting Started and Contact
Come visit [our website](ligolang.org)! You can also join our [Discord](https://discord.gg/CmTwFM), Riot (*#ligo-public:matrix.org*) or Telegram Chat (Ligo Public channel).
\* Following software release cycle conventions, it should be called a pre-alpha. But most people don't know the difference.
Get started page in docs, Matej's tutorials, contributor docs, etc.

View File

@ -49,11 +49,17 @@ class Footer extends React.Component {
rel="noreferrer noopener"> rel="noreferrer noopener">
Tezos Stack Exchange Tezos Stack Exchange
</a> </a>
<a
href="https://discord.gg/9rhYaEt"
target="_blank"
rel="noreferrer noopener">
Discord
</a>
</div> </div>
<div> <div>
<h5>More</h5> <h5>More</h5>
<a href={`${this.props.config.baseUrl}blog`}>Blog</a> <a href={`${this.props.config.baseUrl}blog`}>Blog</a>
<a href={this.docUrl('tutorials/first-smart-contract.html', this.props.language)}>Tutorials</a> <a href={this.docUrl('tutorials/get-started/tezos-taco-shop-smart-contract.html', this.props.language)}>Tutorials</a>
<a href={`${this.props.config.repoUrl}`}>Gitlab</a> <a href={`${this.props.config.repoUrl}`}>Gitlab</a>
</div> </div>
</section> </section>
@ -66,7 +72,7 @@ class Footer extends React.Component {
rel="noreferrer noopener"> rel="noreferrer noopener">
Docusaurus Docusaurus
</a> by Facebook. </a> by Facebook.
<div>Icons made by <a href="https://www.flaticon.com/authors/lucy-g" title="Lucy G">Lucy G</a> from <a href="https://www.flaticon.com/" title="Flaticon">www.flaticon.com</a> is licensed by <a href="http://creativecommons.org/licenses/by/3.0/" title="Creative Commons BY 3.0" target="_blank">CC 3.0 BY</a></div> <div>Icons made by <a href="https://www.freepik.com/" title="Freepik">Freepik</a> & <a href="https://www.flaticon.com/authors/lucy-g" title="Lucy G">Lucy G</a> from <a href="https://www.flaticon.com/" title="Flaticon">www.flaticon.com</a> is licensed by <a href="http://creativecommons.org/licenses/by/3.0/" title="Creative Commons BY 3.0" target="_blank">CC 3.0 BY</a></div>
{this.props.config.copyright} {this.props.config.copyright}
</section> </section>
</footer> </footer>

View File

@ -29,8 +29,9 @@ class HomeSplash extends React.Component {
<div className="tabs"> <div className="tabs">
<div className="nav-tabs"> <div className="nav-tabs">
<div id="tab-group-3-tab-4" className="nav-link active" data-group="group_3" <div id="tab-group-3-tab-4" className="nav-link active" data-group="group_3"
data-tab="tab-group-3-content-4">Pascaligo</div> data-tab="tab-group-3-content-4">PascaLIGO</div>
<div className="nav-link">Camligo (coming soon)</div> <div className="nav-link" data-group="group_3"
data-tab="tab-group-3-content-5">CameLIGO</div>
<div className="nav-link">Reasonligo (coming soon) </div> <div className="nav-link">Reasonligo (coming soon) </div>
{/* <div id="tab-group-3-tab-5" className="nav-link" data-group="group_3" {/* <div id="tab-group-3-tab-5" className="nav-link" data-group="group_3"
data-tab="tab-group-3-content-5">Camligo</div> */} data-tab="tab-group-3-content-5">Camligo</div> */}
@ -45,9 +46,11 @@ class HomeSplash extends React.Component {
</div> </div>
<div id="tab-group-3-content-5" className="tab-pane" data-group="group_3" tabIndex="-1"> <div id="tab-group-3-content-5" className="tab-pane" data-group="group_3" tabIndex="-1">
<div> <div>
<span> <pre>
SOON <code className="hljs css language-Pascal">
</span> type storage = int <br/><br/>(* variant defining pseudo multi-entrypoint actions *) <br/><br/>type action =<br/>| Increment of int<br/>| Decrement of int<br/><br/>let add (a: int) (b: int) : int = a + b<br/><br/>let subtract (a: int) (b: int) : int = a - b<br/><br/>(* real entrypoint that re-routes the flow based on the action provided *)<br/><br/>let%entry main (p : action) storage =<br/> let storage =<br/> match p with<br/> | Increment n -> add storage n<br/> | Decrement n -> subtract storage n<br/> in (([] : operation list), storage)<br/>
</code>
</pre>
</div> </div>
</div> </div>
</div> </div>

View File

@ -28,7 +28,7 @@ function Versions(props) {
<header className="postHeader"> <header className="postHeader">
<h1>{siteConfig.title} Versions</h1> <h1>{siteConfig.title} Versions</h1>
</header> </header>
<h3 id="latest">Current version (Stable)</h3> <h3 id="latest">Current version</h3>
<table className="versions"> <table className="versions">
<tbody> <tbody>
<tr> <tr>
@ -39,7 +39,7 @@ function Versions(props) {
<a <a
href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${ href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${
props.language ? props.language + '/' : '' props.language ? props.language + '/' : ''
}setup-installation`}> }setup/installation`}>
Documentation Documentation
</a> </a>
</td> </td>
@ -63,7 +63,7 @@ function Versions(props) {
<a <a
href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${ href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${
props.language ? props.language + '/' : '' props.language ? props.language + '/' : ''
}next/setup-installation`}> }next/setup/installation`}>
Documentation Documentation
</a> </a>
</td> </td>
@ -88,7 +88,7 @@ function Versions(props) {
<a <a
href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${ href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${
props.language ? props.language + '/' : '' props.language ? props.language + '/' : ''
}${version}/setup-installation`}> }${version}/setup/installation`}>
Documentation Documentation
</a> </a>
</td> </td>

View File

@ -1,7 +1,7 @@
{ {
"docs": { "docs": {
"Setup": ["setup-installation"], "Setup": ["setup/installation", "setup/editor-support"],
"Language Basics": ["language-basics-variables", "language-basics-functions", "language-basics-entrypoints", "language-basics-operators"], "Language Basics": ["language-basics/cheat-sheet", "language-basics/types", "language-basics/variables", "language-basics/functions", "language-basics/entrypoints", "language-basics/operators"],
"API": ["api-cli-commands"] "API": ["api-cli-commands"]
}, },
"contributors-docs": { "contributors-docs": {
@ -16,6 +16,6 @@
"Road Map": ["contributors/road-map/short-term", "contributors/road-map/long-term"] "Road Map": ["contributors/road-map/short-term", "contributors/road-map/long-term"]
}, },
"tutorials": { "tutorials": {
"Get Started": ["tutorials/first-smart-contract"] "Get Started": ["tutorials/get-started/tezos-taco-shop-smart-contract"]
} }
} }

View File

@ -41,40 +41,40 @@ const team = [
caption: 'Gabriel Alfour', caption: 'Gabriel Alfour',
// You will need to prepend the image path with your baseUrl // You will need to prepend the image path with your baseUrl
// if it is not '/', like: '/test-site/img/image.jpg'. // if it is not '/', like: '/test-site/img/image.jpg'.
image: 'https://thepowerofthedream.org/wp-content/uploads/2015/09/generic-profile-picture-600x600.jpg', image: '/img/user.png',
infoLink: '#', infoLink: 'https://gitlab.com/gabriel.alfour',
pinned: true, pinned: true,
}, },
{ {
caption: 'Georges Dupéron', caption: 'Georges Dupéron',
// You will need to prepend the image path with your baseUrl // You will need to prepend the image path with your baseUrl
// if it is not '/', like: '/test-site/img/image.jpg'. // if it is not '/', like: '/test-site/img/image.jpg'.
image: 'https://thepowerofthedream.org/wp-content/uploads/2015/09/generic-profile-picture-600x600.jpg', image: '/img/user.png',
infoLink: '#', infoLink: 'https://gitlab.com/georges.duperon',
pinned: true, pinned: true,
}, },
{ {
caption: 'Christian Rinderknecht', caption: 'Christian Rinderknecht',
// You will need to prepend the image path with your baseUrl // You will need to prepend the image path with your baseUrl
// if it is not '/', like: '/test-site/img/image.jpg'. // if it is not '/', like: '/test-site/img/image.jpg'.
image: 'https://thepowerofthedream.org/wp-content/uploads/2015/09/generic-profile-picture-600x600.jpg', image: '/img/christian.jpeg',
infoLink: '#', infoLink: 'https://github.com/rinderknecht',
pinned: true, pinned: true,
}, },
{ {
caption: 'Brice Aldrich', caption: 'Brice Aldrich',
// You will need to prepend the image path with your baseUrl // You will need to prepend the image path with your baseUrl
// if it is not '/', like: '/test-site/img/image.jpg'. // if it is not '/', like: '/test-site/img/image.jpg'.
image: 'https://thepowerofthedream.org/wp-content/uploads/2015/09/generic-profile-picture-600x600.jpg', image: '/img/brice.png',
infoLink: '#', infoLink: 'https://github.com/DefinitelyNotAGoat',
pinned: true, pinned: true,
}, },
{ {
caption: 'Matej Sima', caption: 'Matej Sima',
// You will need to prepend the image path with your baseUrl // You will need to prepend the image path with your baseUrl
// if it is not '/', like: '/test-site/img/image.jpg'. // if it is not '/', like: '/test-site/img/image.jpg'.
image: 'https://scontent-frt3-2.xx.fbcdn.net/v/t1.0-9/56644817_2276459725943174_4007605942056124416_n.jpg?_nc_cat=107&_nc_ht=scontent-frt3-2.xx&oh=e8a86a2cfe76798cbdc28a0769ebccb1&oe=5D5423F0', image: '/img/matej.jpg',
infoLink: 'https://sk.linkedin.com/in/matejsima', infoLink: 'https://github.com/maht0rz',
pinned: true, pinned: true,
}, },
]; ];
@ -97,12 +97,13 @@ const siteConfig = {
// For no header links in the top nav bar -> headerLinks: [], // For no header links in the top nav bar -> headerLinks: [],
headerLinks: [ headerLinks: [
{doc: 'setup-installation', label: 'Docs'}, {doc: 'setup/installation', label: 'Docs'},
{doc: 'api-cli-commands', label: 'CLI'}, {doc: 'tutorials/get-started/tezos-taco-shop-smart-contract', label: 'Tutorials'},
{doc: 'tutorials/first-smart-contract', label: 'Tutorials'},
{ blog: true, label: 'Blog' }, { blog: true, label: 'Blog' },
// TODO: { href: "/odoc", label: "Api" }, // TODO: { href: "/odoc", label: "Api" },
{doc: 'contributors/origin', label: 'Contribute'} {doc: 'contributors/origin', label: 'Contribute'},
{href: 'https://discord.gg/9rhYaEt', label: ''},
{ search: true },
], ],
// If you have users set above, you add it here: // If you have users set above, you add it here:
@ -163,6 +164,12 @@ 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: 'https://gitlab.com/ligolang/ligo', repoUrl: 'https://gitlab.com/ligolang/ligo',
algolia: {
apiKey: '12be98d9fd4242a5f16b70a5cc6b0158',
indexName: 'ligolang',
algoliaOptions: {} // Optional, if provided by Algolia
},
}; };
module.exports = siteConfig; module.exports = siteConfig;

View File

@ -0,0 +1 @@
pY4yiss3_bmzORHLtOPUEYaFxWxD_GkD8XZajWh0DUU.4Dc00ftieGaWDmacztwSS7euFOKPULDHjUNzikwPvao

View File

@ -29,36 +29,39 @@
background: transparent; background: transparent;
} }
.homeContainer .tabs { .tabs {
max-width: 800px; max-width: 800px;
margin: 0 auto; margin: 0 auto;
border-top: none; border-top: none;
border-bottom: 4px solid #e0e0e0; border-bottom: 4px solid #e0e0e0;
} }
.homeContainer .tabs .nav-tabs > div.active { .tabs .nav-tabs > div {
border-bottom: none;
}
.homeContainer .tabs .nav-tabs > div {
cursor: default;
color: #24292e64;
}
.homeContainer .tabs .nav-tabs > div:first-of-type {
cursor: pointer; cursor: pointer;
color: #24292e; color: #24292e;
border-bottom: none;
padding-bottom: 8px;
}
.tab-content {
padding-top: 12px;
} }
.homeContainer .tabs .nav-tabs > div.active:first-of-type { .tabs .nav-tabs > div.active {
border-bottom: 4px solid #1A1A1A; border-bottom: 4px solid #1A1A1A;
} }
.homeContainer .tab-content {
.homeContainer .tabs .nav-tabs > div:last-of-type {
cursor: default;
color: #24292e64;
border-bottom: none;
}
.tab-content {
border-top: 4px solid #e0e0e0; border-top: 4px solid #e0e0e0;
} }
.homeContainer .nav-tabs { .nav-tabs {
border: none; border: none;
position: relative; position: relative;
top: 4px; top: 4px;
@ -77,11 +80,15 @@
blockquote { blockquote {
background-color: rgba(26, 26, 26, 0.6); background-color: rgba(26, 26, 26, 0.3);
border-left: 8px solid rgba(26, 26, 26, 0.7); border-left: 8px solid rgba(26, 26, 26, 0.1);
color: rgba(255,255,255, 0.8); color: rgba(255,255,255, 1);
} }
blockquote code {
opacity: 0.5;
}
/*
blockquote a { blockquote a {
color: rgba(255,255,255, 0.8); color: rgba(255,255,255, 0.8);
border-bottom: 1px solid rgba(255,255,255, 0.8); border-bottom: 1px solid rgba(255,255,255, 0.8);
@ -90,7 +97,7 @@ blockquote a {
blockquote a:hover { blockquote a:hover {
color: rgba(255,255,255, 1); color: rgba(255,255,255, 1);
border-bottom: 1px solid rgba(255,255,255, 1); border-bottom: 1px solid rgba(255,255,255, 1);
} } */
/* /*
blockquote { blockquote {
background-color: rgba(252, 214, 0, 0.687); background-color: rgba(252, 214, 0, 0.687);
@ -99,11 +106,11 @@ blockquote {
} */ } */
a { a {
color: rgba(12, 12, 12, 0.8); color: rgba(178, 33, 12, 0.8);
} }
a:hover { a:hover {
color: rgb(12, 12, 12); color: rgba(178, 33, 12, 1);
} }
.homeContainer .homeWrapper .projectLogo { .homeContainer .homeWrapper .projectLogo {
@ -178,12 +185,49 @@ a:hover {
padding-right: 40px; padding-right: 40px;
} }
.productShowcaseSection.team .logos p { .productShowcaseSection.team .logos p {
padding-top: 0px; padding-top: 0px;
} }
.toc .toggleNav {
margin-top: 12px;
}
.mainContainer {
padding-top: 60px;
}
.tocActive .onPageNav > .toc-headings {
padding-top: 24px;
}
.docsSliderActive #tocToggler {
opacity: 0;
visibility: hidden;
}
code {
background: rgb(240, 240, 240);
color: #444;
}
body > div.fixedHeaderContainer > div > header > div > nav > ul > li:nth-child(5) {
background: url('/img/discord.svg');
background-repeat: no-repeat;
background-position: center center;
min-width: 50px;
padding-top: 5px;
opacity: 0.8;
}
body > div.fixedHeaderContainer > div > header > div > nav > ul > li:nth-child(5):hover {
opacity: 1;
}
body > div.fixedHeaderContainer > div > header > div > nav > ul > li:nth-child(5) > a:hover {
background: transparent;
}
@media only screen and (min-device-width: 360px) and (max-device-width: 736px) { @media only screen and (min-device-width: 360px) and (max-device-width: 736px) {
} }

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.2 MiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 32 KiB

View File

@ -0,0 +1 @@
<svg id="Layer_1" xmlns="http://www.w3.org/2000/svg" viewBox="0 0 245 240"><style>.st0{fill:#FFFFFF;}</style><path class="st0" d="M104.4 103.9c-5.7 0-10.2 5-10.2 11.1s4.6 11.1 10.2 11.1c5.7 0 10.2-5 10.2-11.1.1-6.1-4.5-11.1-10.2-11.1zM140.9 103.9c-5.7 0-10.2 5-10.2 11.1s4.6 11.1 10.2 11.1c5.7 0 10.2-5 10.2-11.1s-4.5-11.1-10.2-11.1z"/><path class="st0" d="M189.5 20h-134C44.2 20 35 29.2 35 40.6v135.2c0 11.4 9.2 20.6 20.5 20.6h113.4l-5.3-18.5 12.8 11.9 12.1 11.2 21.5 19V40.6c0-11.4-9.2-20.6-20.5-20.6zm-38.6 130.6s-3.6-4.3-6.6-8.1c13.1-3.7 18.1-11.9 18.1-11.9-4.1 2.7-8 4.6-11.5 5.9-5 2.1-9.8 3.5-14.5 4.3-9.6 1.8-18.4 1.3-25.9-.1-5.7-1.1-10.6-2.7-14.7-4.3-2.3-.9-4.8-2-7.3-3.4-.3-.2-.6-.3-.9-.5-.2-.1-.3-.2-.4-.3-1.8-1-2.8-1.7-2.8-1.7s4.8 8 17.5 11.8c-3 3.8-6.7 8.3-6.7 8.3-22.1-.7-30.5-15.2-30.5-15.2 0-32.2 14.4-58.3 14.4-58.3 14.4-10.8 28.1-10.5 28.1-10.5l1 1.2c-18 5.2-26.3 13.1-26.3 13.1s2.2-1.2 5.9-2.9c10.7-4.7 19.2-6 22.7-6.3.6-.1 1.1-.2 1.7-.2 6.1-.8 13-1 20.2-.2 9.5 1.1 19.7 3.9 30.1 9.6 0 0-7.9-7.5-24.9-12.7l1.4-1.6s13.7-.3 28.1 10.5c0 0 14.4 26.1 14.4 58.3 0 0-8.5 14.5-30.6 15.2z"/></svg>

After

Width:  |  Height:  |  Size: 1.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 51 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 257 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 560 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 512 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 567 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 734 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 MiB

File diff suppressed because one or more lines are too long

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

View File

@ -9,7 +9,7 @@ original_id: language-basics-entrypoints
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo--> <!--Pascaligo-->
```Pascal ```Pascal
function main (const p : int ; const s : int) : (list(operation) * unit) is function main (const p : int ; const s : int) : (list(operation) * int) is
block {skip} with ((nil : list(operation)), s + 1) block {skip} with ((nil : list(operation)), s + 1)
``` ```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->

View File

@ -1,39 +0,0 @@
---
id: version-next-setup-installation
title: Installation
original_id: setup-installation
---
There are currently two ways to get started with Ligo, both of those will allow you to use the Ligo CLI with your contracts. You can choose to use either the Docker image, or to compile & build the Ligo CLI yourself.
## Dockerized installation (recommended)
> 🐳 You can find instructions on how to install Docker [here](https://docs.docker.com/install/).
Easiest way to use LIGO is through the Docker image available at [Docker Hub](https://hub.docker.com/r/ligolang/ligo). Sources for the image can be found on [Gitlab](https://gitlab.com/ligolang/ligo/blob/master/docker/Dockerfile).
You can either run the docker image yourself, or you can setup a global ligo executable as shown below.
### Setting up a globally available `ligo` executable
> You can install additional ligo versions by replacing `next` with the required version number
```zsh
# next (pre-release)
curl https://gitlab.com/ligolang/ligo/raw/dev/scripts/installer.sh | bash "next"
# e.g. 1.0.0 (stable)
curl https://gitlab.com/ligolang/ligo/raw/master/scripts/installer.sh | bash "1.0.0"
```
**Verify your ligo installation by running:**
```zsh
ligo --help
```
## Manual installation (advanced)
For now, please refer to the steps described in the [Dockerfile](https://gitlab.com/ligolang/ligo/blob/master/docker/Dockerfile).

View File

@ -1,13 +1,16 @@
{ {
"version-next-docs": { "version-next-docs": {
"Setup": [ "Setup": [
"version-next-setup-installation" "version-next-setup/installation",
"version-next-setup/editor-support"
], ],
"Language Basics": [ "Language Basics": [
"version-next-language-basics-variables", "version-next-language-basics/cheat-sheet",
"version-next-language-basics-functions", "version-next-language-basics/types",
"version-next-language-basics-entrypoints", "version-next-language-basics/variables",
"version-next-language-basics-operators" "version-next-language-basics/functions",
"version-next-language-basics/entrypoints",
"version-next-language-basics/operators"
], ],
"API": [ "API": [
"version-next-api-cli-commands" "version-next-api-cli-commands"
@ -34,7 +37,7 @@
}, },
"version-next-tutorials": { "version-next-tutorials": {
"Get Started": [ "Get Started": [
"version-next-tutorials/first-smart-contract" "version-next-tutorials/get-started/tezos-taco-shop-smart-contract"
] ]
} }
} }

View File

@ -24,6 +24,7 @@ let literal ppf (l:literal) = match l with
| Literal_bool b -> fprintf ppf "%b" b | Literal_bool b -> fprintf ppf "%b" b
| Literal_int n -> fprintf ppf "%d" n | Literal_int n -> fprintf ppf "%d" n
| Literal_nat n -> fprintf ppf "+%d" n | Literal_nat n -> fprintf ppf "+%d" n
| Literal_timestamp n -> fprintf ppf "+%d" n
| Literal_tez n -> fprintf ppf "%dtz" n | Literal_tez n -> fprintf ppf "%dtz" n
| Literal_string s -> fprintf ppf "%S" s | Literal_string s -> fprintf ppf "%S" s
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
@ -41,6 +42,7 @@ let rec expression ppf (e:expression) = match Location.unwrap e with
| E_record m -> fprintf ppf "record[%a]" (smap_sep_d expression) m | E_record m -> fprintf ppf "record[%a]" (smap_sep_d expression) m
| E_map m -> fprintf ppf "map[%a]" (list_sep_d assoc_expression) m | E_map m -> fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
| E_list lst -> fprintf ppf "list[%a]" (list_sep_d expression) lst | E_list lst -> fprintf ppf "list[%a]" (list_sep_d expression) lst
| E_set lst -> fprintf ppf "set[%a]" (list_sep_d expression) lst
| E_look_up (ds, ind) -> fprintf ppf "(%a)[%a]" expression ds expression ind | E_look_up (ds, ind) -> fprintf ppf "(%a)[%a]" expression ds expression ind
| E_lambda {binder;input_type;output_type;result} -> | E_lambda {binder;input_type;output_type;result} ->
fprintf ppf "lambda (%a:%a) : %a return %a" fprintf ppf "lambda (%a:%a) : %a return %a"

View File

@ -1,5 +1,5 @@
include Types include Types
include Misc (* include Misc *)
include Combinators include Combinators
module Types = Types module Types = Types

View File

@ -4,6 +4,17 @@ module Option = Simple_utils.Option
module SMap = Map.String module SMap = Map.String
module Errors = struct
let bad_kind expected location =
let title () = Format.asprintf "a %s was expected" expected in
let message () = "" in
let data = [
("location" , fun () -> Format.asprintf "%a" Location.pp location) ;
] in
error ~data title message
end
open Errors
let t_bool : type_expression = T_constant ("bool", []) let t_bool : type_expression = T_constant ("bool", [])
let t_string : type_expression = T_constant ("string", []) let t_string : type_expression = T_constant ("string", [])
let t_bytes : type_expression = T_constant ("bytes", []) let t_bytes : type_expression = T_constant ("bytes", [])
@ -32,6 +43,7 @@ let ez_t_sum (lst:(string * type_expression) list) : type_expression =
let t_function param result : type_expression = T_function (param, result) let t_function param result : type_expression = T_function (param, result)
let t_map key value = (T_constant ("map", [key ; value])) let t_map key value = (T_constant ("map", [key ; value]))
let t_set key = (T_constant ("set", [key]))
let make_name (s : string) : name = s let make_name (s : string) : name = s
@ -40,6 +52,7 @@ let e_literal ?loc l : expression = Location.wrap ?loc @@ E_literal l
let e_unit ?loc () : expression = Location.wrap ?loc @@ E_literal (Literal_unit) let e_unit ?loc () : expression = Location.wrap ?loc @@ E_literal (Literal_unit)
let e_int ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_int n) let e_int ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_int n)
let e_nat ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_nat n) let e_nat ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_nat n)
let e_timestamp ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_timestamp n)
let e_bool ?loc b : expression = Location.wrap ?loc @@ E_literal (Literal_bool b) let e_bool ?loc b : expression = Location.wrap ?loc @@ E_literal (Literal_bool b)
let e_string ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_string s) let e_string ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_string s)
let e_address ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_address s) let e_address ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_address s)
@ -51,6 +64,7 @@ let e_some ?loc s : expression = Location.wrap ?loc @@ E_constant ("SOME", [s])
let e_none ?loc () : expression = Location.wrap ?loc @@ E_constant ("NONE", []) let e_none ?loc () : expression = Location.wrap ?loc @@ E_constant ("NONE", [])
let e_map_add ?loc k v old : expression = Location.wrap ?loc @@ E_constant ("MAP_ADD" , [k ; v ; old]) let e_map_add ?loc k v old : expression = Location.wrap ?loc @@ E_constant ("MAP_ADD" , [k ; v ; old])
let e_map ?loc lst : expression = Location.wrap ?loc @@ E_map lst let e_map ?loc lst : expression = Location.wrap ?loc @@ E_map lst
let e_set ?loc lst : expression = Location.wrap ?loc @@ E_set lst
let e_list ?loc lst : expression = Location.wrap ?loc @@ E_list lst let e_list ?loc lst : expression = Location.wrap ?loc @@ E_list lst
let e_pair ?loc a b : expression = Location.wrap ?loc @@ E_tuple [a; b] let e_pair ?loc a b : expression = Location.wrap ?loc @@ E_tuple [a; b]
let e_constructor ?loc s a : expression = Location.wrap ?loc @@ E_constructor (s , a) let e_constructor ?loc s a : expression = Location.wrap ?loc @@ E_constructor (s , a)
@ -91,6 +105,8 @@ let e_typed_list ?loc lst t =
let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v) let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v)
let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k)
let e_lambda ?loc (binder : string) let e_lambda ?loc (binder : string)
(input_type : type_expression option) (input_type : type_expression option)
(output_type : type_expression option) (output_type : type_expression option)
@ -140,3 +156,23 @@ let get_e_failwith = fun e ->
| _ -> simple_fail "not a failwith" | _ -> simple_fail "not a failwith"
let is_e_failwith e = to_bool @@ get_e_failwith e let is_e_failwith e = to_bool @@ get_e_failwith e
let extract_pair : expression -> (expression * expression) result = fun e ->
match Location.unwrap e with
| E_tuple [ a ; b ] -> ok (a , b)
| _ -> fail @@ bad_kind "pair" e.location
let extract_list : expression -> (expression list) result = fun e ->
match Location.unwrap e with
| E_list lst -> ok lst
| _ -> fail @@ bad_kind "list" e.location
let extract_record : expression -> (string * expression) list result = fun e ->
match Location.unwrap e with
| E_record lst -> ok @@ SMap.to_kv_list lst
| _ -> fail @@ bad_kind "record" e.location
let extract_map : expression -> (expression * expression) list result = fun e ->
match Location.unwrap e with
| E_map lst -> ok lst
| _ -> fail @@ bad_kind "map" e.location

View File

@ -42,6 +42,9 @@ let assert_literal_eq (a, b : literal * literal) : unit result =
| Literal_nat a, Literal_nat b when a = b -> ok () | Literal_nat a, Literal_nat b when a = b -> ok ()
| Literal_nat _, Literal_nat _ -> fail @@ different_literals "different nats" a b | Literal_nat _, Literal_nat _ -> fail @@ different_literals "different nats" a b
| Literal_nat _, _ -> fail @@ different_literals_because_different_types "nat vs non-nat" a b | Literal_nat _, _ -> fail @@ different_literals_because_different_types "nat vs non-nat" a b
| Literal_timestamp a, Literal_timestamp b when a = b -> ok ()
| Literal_timestamp _, Literal_timestamp _ -> fail @@ different_literals "different timestamps" a b
| Literal_timestamp _, _ -> fail @@ different_literals_because_different_types "timestamp vs non-timestamp" a b
| Literal_tez a, Literal_tez b when a = b -> ok () | Literal_tez a, Literal_tez b when a = b -> ok ()
| Literal_tez _, Literal_tez _ -> fail @@ different_literals "different tezs" a b | Literal_tez _, Literal_tez _ -> fail @@ different_literals "different tezs" a b
| Literal_tez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b | Literal_tez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b
@ -59,7 +62,6 @@ let assert_literal_eq (a, b : literal * literal) : unit result =
| Literal_operation _, Literal_operation _ -> fail @@ error_uncomparable_literals "can't compare operations" a b | Literal_operation _, Literal_operation _ -> fail @@ error_uncomparable_literals "can't compare operations" a b
| Literal_operation _, _ -> fail @@ different_literals_because_different_types "operation vs non-operation" a b | Literal_operation _, _ -> fail @@ different_literals_because_different_types "operation vs non-operation" a b
let rec assert_value_eq (a, b: (expression * expression )) : unit result = let rec assert_value_eq (a, b: (expression * expression )) : unit result =
let error_content () = let error_content () =
Format.asprintf "\n@[<v>- %a@;- %a]" PP.expression a PP.expression b Format.asprintf "\n@[<v>- %a@;- %a]" PP.expression a PP.expression b
@ -143,6 +145,19 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
) )
| E_list _, _ -> | E_list _, _ ->
simple_fail "comparing list with other stuff" simple_fail "comparing list with other stuff"
| E_set lsta, E_set lstb -> (
let lsta' = List.sort (compare) lsta in
let lstb' = List.sort (compare) lstb in
let%bind lst =
generic_try (simple_error "set of different lengths")
(fun () -> List.combine lsta' lstb') in
let%bind _all = bind_map_list assert_value_eq lst in
ok ()
)
| E_set _, _ ->
simple_fail "comparing set with other stuff"
| (E_annotation (a , _) , _b') -> assert_value_eq (a , b) | (E_annotation (a , _) , _b') -> assert_value_eq (a , b)
| (_a' , E_annotation (b , _)) -> assert_value_eq (a , b) | (_a' , E_annotation (b , _)) -> assert_value_eq (a , b)
| (E_variable _, _) | (E_lambda _, _) | (E_variable _, _) | (E_lambda _, _)
@ -151,6 +166,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
| (E_look_up _, _) | (E_matching _, _) | (E_failwith _, _) | (E_sequence _, _) | (E_look_up _, _) | (E_matching _, _) | (E_failwith _, _) | (E_sequence _, _)
| (E_loop _, _) | (E_assign _, _) | (E_skip, _) -> simple_fail "comparing not a value" | (E_loop _, _) | (E_assign _, _) | (E_skip, _) -> simple_fail "comparing not a value"
let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)
(* module Rename = struct (* module Rename = struct
* open Trace * open Trace

View File

@ -60,6 +60,7 @@ and expression' =
(* Data Structures *) (* Data Structures *)
| E_map of (expr * expr) list | E_map of (expr * expr) list
| E_list of expr list | E_list of expr list
| E_set of expr list
| E_look_up of (expr * expr) | E_look_up of (expr * expr)
(* Matching *) (* Matching *)
| E_matching of (expr * matching_expr) | E_matching of (expr * matching_expr)
@ -90,6 +91,7 @@ and literal =
| Literal_string of string | Literal_string of string
| Literal_bytes of bytes | Literal_bytes of bytes
| Literal_address of string | Literal_address of string
| Literal_timestamp of int
| Literal_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation | Literal_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation
and 'a matching = and 'a matching =

View File

@ -43,6 +43,7 @@ and expression ppf (e:expression) : unit =
| E_record m -> fprintf ppf "record[%a]" (smap_sep_d annotated_expression) m | E_record m -> fprintf ppf "record[%a]" (smap_sep_d annotated_expression) m
| E_map m -> fprintf ppf "map[@; @[<v>%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m | E_map m -> fprintf ppf "map[@; @[<v>%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m
| E_list m -> fprintf ppf "list[@; @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) m | E_list m -> fprintf ppf "list[@; @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) m
| E_set m -> fprintf ppf "set[@; @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) m
| E_look_up (ds, i) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression i | E_look_up (ds, i) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression i
| E_matching (ae, m) -> | E_matching (ae, m) ->
fprintf ppf "match %a with %a" annotated_expression ae (matching annotated_expression) m fprintf ppf "match %a with %a" annotated_expression ae (matching annotated_expression) m
@ -68,6 +69,7 @@ and literal ppf (l:literal) : unit =
| Literal_bool b -> fprintf ppf "%b" b | Literal_bool b -> fprintf ppf "%b" b
| Literal_int n -> fprintf ppf "%d" n | Literal_int n -> fprintf ppf "%d" n
| Literal_nat n -> fprintf ppf "+%d" n | Literal_nat n -> fprintf ppf "+%d" n
| Literal_timestamp n -> fprintf ppf "+%d" n
| Literal_tez n -> fprintf ppf "%dtz" n | Literal_tez n -> fprintf ppf "%dtz" n
| Literal_string s -> fprintf ppf "%s" s | Literal_string s -> fprintf ppf "%s" s
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b

View File

@ -15,6 +15,8 @@ let make_n_t type_name type_value = { type_name ; type_value }
let t_bool ?s () : type_value = make_t (T_constant ("bool", [])) s let t_bool ?s () : type_value = make_t (T_constant ("bool", [])) s
let t_string ?s () : type_value = make_t (T_constant ("string", [])) s let t_string ?s () : type_value = make_t (T_constant ("string", [])) s
let t_bytes ?s () : type_value = make_t (T_constant ("bytes", [])) s let t_bytes ?s () : type_value = make_t (T_constant ("bytes", [])) s
let t_key ?s () : type_value = make_t (T_constant ("key", [])) s
let t_key_hash ?s () : type_value = make_t (T_constant ("key_hash", [])) s
let t_int ?s () : type_value = make_t (T_constant ("int", [])) s let t_int ?s () : type_value = make_t (T_constant ("int", [])) s
let t_address ?s () : type_value = make_t (T_constant ("address", [])) s let t_address ?s () : type_value = make_t (T_constant ("address", [])) s
let t_operation ?s () : type_value = make_t (T_constant ("operation", [])) s let t_operation ?s () : type_value = make_t (T_constant ("operation", [])) s
@ -25,6 +27,7 @@ let t_unit ?s () : type_value = make_t (T_constant ("unit", [])) s
let t_option o ?s () : type_value = make_t (T_constant ("option", [o])) s let t_option o ?s () : type_value = make_t (T_constant ("option", [o])) s
let t_tuple lst ?s () : type_value = make_t (T_tuple lst) s let t_tuple lst ?s () : type_value = make_t (T_tuple lst) s
let t_list t ?s () : type_value = make_t (T_constant ("list", [t])) s let t_list t ?s () : type_value = make_t (T_constant ("list", [t])) s
let t_set t ?s () : type_value = make_t (T_constant ("set", [t])) s
let t_contract t ?s () : type_value = make_t (T_constant ("contract", [t])) s let t_contract t ?s () : type_value = make_t (T_constant ("contract", [t])) s
let t_pair a b ?s () = t_tuple [a ; b] ?s () let t_pair a b ?s () = t_tuple [a ; b] ?s ()
@ -93,6 +96,22 @@ let get_t_list (t:type_value) : type_value result = match t.type_value' with
| T_constant ("list", [o]) -> ok o | T_constant ("list", [o]) -> ok o
| _ -> simple_fail "not a list" | _ -> simple_fail "not a list"
let get_t_set (t:type_value) : type_value result = match t.type_value' with
| T_constant ("set", [o]) -> ok o
| _ -> simple_fail "not a set"
let get_t_key (t:type_value) : unit result = match t.type_value' with
| T_constant ("key", []) -> ok ()
| _ -> simple_fail "not a key"
let get_t_signature (t:type_value) : unit result = match t.type_value' with
| T_constant ("signature", []) -> ok ()
| _ -> simple_fail "not a signature"
let get_t_key_hash (t:type_value) : unit result = match t.type_value' with
| T_constant ("key_hash", []) -> ok ()
| _ -> simple_fail "not a key_hash"
let get_t_tuple (t:type_value) : type_value list result = match t.type_value' with let get_t_tuple (t:type_value) : type_value list result = match t.type_value' with
| T_tuple lst -> ok lst | T_tuple lst -> ok lst
| _ -> simple_fail "not a tuple" | _ -> simple_fail "not a tuple"
@ -136,7 +155,10 @@ let assert_t_map = fun t ->
let is_t_map = Function.compose to_bool get_t_map let is_t_map = Function.compose to_bool get_t_map
let assert_t_tez :type_value -> unit result = get_t_tez let assert_t_tez : type_value -> unit result = get_t_tez
let assert_t_key = get_t_key
let assert_t_signature = get_t_signature
let assert_t_key_hash = get_t_key_hash
let assert_t_list t = let assert_t_list t =
let%bind _ = get_t_list t in let%bind _ = get_t_list t in

View File

@ -155,6 +155,7 @@ module Free_variables = struct
| E_record_accessor (a, _) -> self a | E_record_accessor (a, _) -> self a
| E_tuple_accessor (a, _) -> self a | E_tuple_accessor (a, _) -> self a
| E_list lst -> unions @@ List.map self lst | E_list lst -> unions @@ List.map self lst
| E_set lst -> unions @@ List.map self lst
| E_map m -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m | E_map m -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
| E_look_up (a , b) -> unions @@ List.map self [ a ; b ] | E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
| E_matching (a , cs) -> union (self a) (matching_expression b cs) | E_matching (a , cs) -> union (self a) (matching_expression b cs)
@ -344,6 +345,9 @@ let assert_literal_eq (a, b : literal * literal) : unit result =
| Literal_nat a, Literal_nat b when a = b -> ok () | Literal_nat a, Literal_nat b when a = b -> ok ()
| Literal_nat _, Literal_nat _ -> fail @@ different_literals "different nats" a b | Literal_nat _, Literal_nat _ -> fail @@ different_literals "different nats" a b
| Literal_nat _, _ -> fail @@ different_literals_because_different_types "nat vs non-nat" a b | Literal_nat _, _ -> fail @@ different_literals_because_different_types "nat vs non-nat" a b
| Literal_timestamp a, Literal_timestamp b when a = b -> ok ()
| Literal_timestamp _, Literal_timestamp _ -> fail @@ different_literals "different timestamps" a b
| Literal_timestamp _, _ -> fail @@ different_literals_because_different_types "timestamp vs non-timestamp" a b
| Literal_tez a, Literal_tez b when a = b -> ok () | Literal_tez a, Literal_tez b when a = b -> ok ()
| Literal_tez _, Literal_tez _ -> fail @@ different_literals "different tezs" a b | Literal_tez _, Literal_tez _ -> fail @@ different_literals "different tezs" a b
| Literal_tez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b | Literal_tez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b
@ -443,6 +447,15 @@ let rec assert_value_eq (a, b: (value*value)) : unit result =
) )
| E_list _, _ -> | E_list _, _ ->
fail @@ different_values_because_different_types "list vs. non-list" a b fail @@ different_values_because_different_types "list vs. non-list" a b
| E_set lsta, E_set lstb -> (
let%bind lst =
generic_try (different_size_values "sets of different lengths" a b)
(fun () -> List.combine lsta lstb) in
let%bind _all = bind_map_list assert_value_eq lst in
ok ()
)
| E_set _, _ ->
fail @@ different_values_because_different_types "set vs. non-set" a b
| (E_literal _, _) | (E_variable _, _) | (E_application _, _) | (E_literal _, _) | (E_variable _, _) | (E_application _, _)
| (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _) | (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _)
| (E_record_accessor _, _) | (E_record_accessor _, _)

View File

@ -77,6 +77,9 @@ module Captured_variables = struct
| E_list lst -> | E_list lst ->
let%bind lst' = bind_map_list self lst in let%bind lst' = bind_map_list self lst in
ok @@ unions lst' ok @@ unions lst'
| E_set lst ->
let%bind lst' = bind_map_list self lst in
ok @@ unions lst'
| E_map m -> | E_map m ->
let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in
ok @@ unions lst' ok @@ unions lst'

View File

@ -100,6 +100,7 @@ and expression =
(* Data Structures *) (* Data Structures *)
| E_map of (ae * ae) list | E_map of (ae * ae) list
| E_list of ae list | E_list of ae list
| E_set of ae list
| E_look_up of (ae * ae) | E_look_up of (ae * ae)
(* Advanced *) (* Advanced *)
| E_matching of (ae * matching_expr) | E_matching of (ae * matching_expr)
@ -116,6 +117,7 @@ and literal =
| Literal_bool of bool | Literal_bool of bool
| Literal_int of int | Literal_int of int
| Literal_nat of int | Literal_nat of int
| Literal_timestamp of int
| Literal_tez of int | Literal_tez of int
| Literal_string of string | Literal_string of string
| Literal_bytes of bytes | Literal_bytes of bytes

View File

@ -41,48 +41,56 @@ let main =
let term = Term.(const print_endline $ const "Ligo needs a command. Do ligo --help") in let term = Term.(const print_endline $ const "Ligo needs a command. Do ligo --help") in
(term , Term.info "ligo") (term , Term.info "ligo")
let source = let source n =
let open Arg in let open Arg in
let info = let info =
let docv = "SOURCE_FILE" in let docv = "SOURCE_FILE" in
let doc = "$(docv) is the path to the .ligo file of the contract." in let doc = "$(docv) is the path to the .ligo or .mligo file of the contract." in
info ~docv ~doc [] in info ~docv ~doc [] in
required @@ pos 0 (some string) None info required @@ pos n (some string) None info
let entry_point = let entry_point n =
let open Arg in let open Arg in
let info = let info =
let docv = "ENTRY_POINT" in let docv = "ENTRY_POINT" in
let doc = "$(docv) is entry-point that will be compiled." in let doc = "$(docv) is entry-point that will be compiled." in
info ~docv ~doc [] in info ~docv ~doc [] in
required @@ pos 1 (some string) (Some "main") info required @@ pos n (some string) (Some "main") info
let expression = let expression purpose n =
let open Arg in let open Arg in
let docv = "EXPRESSION" in let docv = purpose ^ "_EXPRESSION" in
let doc = "$(docv) is the expression that will be compiled." in let doc = "$(docv) is the expression that will be compiled." in
let info = info ~docv ~doc [] in let info = info ~docv ~doc [] in
required @@ pos 2 (some string) None info required @@ pos n (some string) None info
let syntax = let syntax =
let open Arg in let open Arg in
let info = let info =
let docv = "SYNTAX" in let docv = "SYNTAX" in
let doc = "$(docv) is the syntax that will be used. Currently supported syntaxes are \"pascaligo\" and \"cameligo\". \"pascaligo\" is the default." in let doc = "$(docv) is the syntax that will be used. Currently supported syntaxes are \"pascaligo\" and \"cameligo\". By default, the syntax is guessed from the extension (.ligo and .mligo, respectively)." in
info ~docv ~doc ["syntax" ; "s"] in info ~docv ~doc ["syntax" ; "s"] in
value @@ opt string "pascaligo" info value @@ opt string "auto" info
let amount =
let open Arg in
let info =
let docv = "AMOUNT" in
let doc = "$(docv) is the amount the dry-run transaction will use." in
info ~docv ~doc ["amount"] in
value @@ opt string "0" info
let compile_file = let compile_file =
let f source entry_point syntax = let f source entry_point syntax =
toplevel @@ toplevel @@
let%bind contract = let%bind contract =
trace (simple_info "compiling contract to michelson") @@ trace (simple_info "compiling contract to michelson") @@
Ligo.Run.compile_contract_file source entry_point syntax in Ligo.Run.compile_contract_file source entry_point (Syntax_name syntax) in
Format.printf "%s\n" contract ; Format.printf "%s\n" contract ;
ok () ok ()
in in
let term = let term =
Term.(const f $ source $ entry_point $ syntax) in Term.(const f $ source 0 $ entry_point 1 $ syntax) in
let cmdname = "compile-contract" in let cmdname = "compile-contract" in
let docs = "Subcommand: compile a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in let docs = "Subcommand: compile a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
(term , Term.info ~docs cmdname) (term , Term.info ~docs cmdname)
@ -92,12 +100,12 @@ let compile_parameter =
toplevel @@ toplevel @@
let%bind value = let%bind value =
trace (simple_error "compile-input") @@ trace (simple_error "compile-input") @@
Ligo.Run.compile_contract_parameter source entry_point expression syntax in Ligo.Run.compile_contract_parameter source entry_point expression (Syntax_name syntax) in
Format.printf "%s\n" value; Format.printf "%s\n" value;
ok () ok ()
in in
let term = let term =
Term.(const f $ source $ entry_point $ expression $ syntax) in Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax) in
let cmdname = "compile-parameter" in let cmdname = "compile-parameter" in
let docs = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in let docs = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
(term , Term.info ~docs cmdname) (term , Term.info ~docs cmdname)
@ -107,15 +115,64 @@ let compile_storage =
toplevel @@ toplevel @@
let%bind value = let%bind value =
trace (simple_error "compile-storage") @@ trace (simple_error "compile-storage") @@
Ligo.Run.compile_contract_storage source entry_point expression syntax in Ligo.Run.compile_contract_storage source entry_point expression (Syntax_name syntax) in
Format.printf "%s\n" value; Format.printf "%s\n" value;
ok () ok ()
in in
let term = let term =
Term.(const f $ source $ entry_point $ expression $ syntax) in Term.(const f $ source 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax) in
let cmdname = "compile-storage" in let cmdname = "compile-storage" in
let docs = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in let docs = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
(term , Term.info ~docs cmdname) (term , Term.info ~docs cmdname)
let dry_run =
let f source entry_point storage input amount syntax =
toplevel @@
let%bind output =
Ligo.Run.run_contract ~amount source entry_point storage input (Syntax_name syntax) in
Format.printf "%a\n" Ast_simplified.PP.expression output ;
ok ()
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ syntax) in
let cmdname = "dry-run" in
let docs = "Subcommand: run a smart-contract with the given storage and input." in
(term , Term.info ~docs cmdname)
let () = Term.exit @@ Term.eval_choice main [compile_file ; compile_parameter ; compile_storage] let run_function =
let f source entry_point parameter amount syntax =
toplevel @@
let%bind output =
Ligo.Run.run_function ~amount source entry_point parameter (Syntax_name syntax) in
Format.printf "%a\n" Ast_simplified.PP.expression output ;
ok ()
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ syntax) in
let cmdname = "run-function" in
let docs = "Subcommand: run a function with the given parameter." in
(term , Term.info ~docs cmdname)
let evaluate_value =
let f source entry_point amount syntax =
toplevel @@
let%bind output =
Ligo.Run.evaluate_value ~amount source entry_point (Syntax_name syntax) in
Format.printf "%a\n" Ast_simplified.PP.expression output ;
ok ()
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ amount $ syntax) in
let cmdname = "evaluate-value" in
let docs = "Subcommand: evaluate a given definition." in
(term , Term.info ~docs cmdname)
let () = Term.exit @@ Term.eval_choice main [
compile_file ;
compile_parameter ;
compile_storage ;
dry_run ;
run_function ;
evaluate_value ;
]

View File

@ -16,6 +16,16 @@ let get_predicate : string -> type_value -> expression list -> predicate result
| Some x -> ok x | Some x -> ok x
| None -> ( | None -> (
match s with match s with
| "NONE" -> (
let%bind ty' = Mini_c.get_t_option ty in
let%bind m_ty = Compiler_type.type_ ty' in
ok @@ simple_unary @@ prim ~children:[m_ty] I_NONE
)
| "UNPACK" -> (
let%bind ty' = Mini_c.get_t_option ty in
let%bind m_ty = Compiler_type.type_ ty' in
ok @@ simple_unary @@ prim ~children:[m_ty] I_UNPACK
)
| "MAP_REMOVE" -> | "MAP_REMOVE" ->
let%bind v = match lst with let%bind v = match lst with
| [ _ ; expr ] -> | [ _ ; expr ] ->
@ -52,6 +62,7 @@ let rec translate_value (v:value) : michelson result = match v with
| D_bool b -> ok @@ prim (if b then D_True else D_False) | D_bool b -> ok @@ prim (if b then D_True else D_False)
| D_int n -> ok @@ int (Z.of_int n) | D_int n -> ok @@ int (Z.of_int n)
| D_nat n -> ok @@ int (Z.of_int n) | D_nat n -> ok @@ int (Z.of_int n)
| D_timestamp n -> ok @@ int (Z.of_int n)
| D_tez n -> ok @@ int (Z.of_int n) | D_tez n -> ok @@ int (Z.of_int n)
| D_string s -> ok @@ string s | D_string s -> ok @@ string s
| D_bytes s -> ok @@ bytes (Tezos_stdlib.MBytes.of_bytes s) | D_bytes s -> ok @@ bytes (Tezos_stdlib.MBytes.of_bytes s)
@ -75,6 +86,9 @@ let rec translate_value (v:value) : michelson result = match v with
| D_list lst -> | D_list lst ->
let%bind lst' = bind_map_list translate_value lst in let%bind lst' = bind_map_list translate_value lst in
ok @@ seq lst' ok @@ seq lst'
| D_set lst ->
let%bind lst' = bind_map_list translate_value lst in
ok @@ seq lst'
| D_operation _ -> | D_operation _ ->
simple_fail "can't compile an operation" simple_fail "can't compile an operation"
@ -216,14 +230,6 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
i_drop ; i_drop ;
b' ; b' ;
] ]
(* | E_sequence_drop (a , b) ->
* let%bind (a' , env_a) = translate_expression a env in
* let%bind (b' , env_b) = translate_expression b env_a in
* return ~end_env:env_b @@ seq [
* a' ;
* i_drop ;
* b' ;
* ] *)
| E_constant(str, lst) -> | E_constant(str, lst) ->
let module L = Logger.Stateful() in let module L = Logger.Stateful() in
let%bind lst' = let%bind lst' =
@ -269,6 +275,9 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
| E_make_empty_list t -> | E_make_empty_list t ->
let%bind t' = Compiler_type.type_ t in let%bind t' = Compiler_type.type_ t in
return @@ i_nil t' return @@ i_nil t'
| E_make_empty_set t ->
let%bind t' = Compiler_type.type_ t in
return @@ i_empty_set t'
| E_make_none o -> | E_make_none o ->
let%bind o' = Compiler_type.type_ o in let%bind o' = Compiler_type.type_ o in
return @@ i_none o' return @@ i_none o'

View File

@ -35,6 +35,7 @@ module Ty = struct
| T_pair _ -> fail (not_comparable "pair") | T_pair _ -> fail (not_comparable "pair")
| T_map _ -> fail (not_comparable "map") | T_map _ -> fail (not_comparable "map")
| T_list _ -> fail (not_comparable "list") | T_list _ -> fail (not_comparable "list")
| T_set _ -> fail (not_comparable "set")
| T_option _ -> fail (not_comparable "option") | T_option _ -> fail (not_comparable "option")
| T_contract _ -> fail (not_comparable "contract") | T_contract _ -> fail (not_comparable "contract")
@ -82,6 +83,10 @@ module Ty = struct
| T_list t -> | T_list t ->
let%bind (Ex_ty t') = type_ t in let%bind (Ex_ty t') = type_ t in
ok @@ Ex_ty Contract_types.(list t') ok @@ Ex_ty Contract_types.(list t')
| T_set t -> (
let%bind (Ex_comparable_ty t') = comparable_type t in
ok @@ Ex_ty Contract_types.(set t')
)
| T_option t -> | T_option t ->
let%bind (Ex_ty t') = type_ t in let%bind (Ex_ty t') = type_ t in
ok @@ Ex_ty Contract_types.(option t') ok @@ Ex_ty Contract_types.(option t')
@ -142,6 +147,9 @@ let rec type_ : type_value -> O.michelson result =
| T_list t -> | T_list t ->
let%bind t' = type_ t in let%bind t' = type_ t in
ok @@ O.prim ~children:[t'] O.T_list ok @@ O.prim ~children:[t'] O.T_list
| T_set t ->
let%bind t' = type_ t in
ok @@ O.prim ~children:[t'] O.T_set
| T_option o -> | T_option o ->
let%bind o' = type_ o in let%bind o' = type_ o in
ok @@ O.prim ~children:[o'] O.T_option ok @@ O.prim ~children:[o'] O.T_option

View File

@ -29,6 +29,11 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result =
trace_option (simple_error "too big to fit an int") @@ trace_option (simple_error "too big to fit an int") @@
Alpha_context.Script_int.to_int n in Alpha_context.Script_int.to_int n in
ok @@ D_nat n ok @@ D_nat n
| (Timestamp_t _), n ->
let n =
Z.to_int @@
Alpha_context.Script_timestamp.to_zint n in
ok @@ D_timestamp n
| (Mutez_t _), n -> | (Mutez_t _), n ->
let%bind n = let%bind n =
generic_try (simple_error "too big to fit an int") @@ generic_try (simple_error "too big to fit an int") @@
@ -72,6 +77,18 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result =
bind_map_list aux lst' bind_map_list aux lst'
in in
ok @@ D_list lst'' ok @@ D_list lst''
| (Set_t (ty, _)), (module S) -> (
let lst = S.OPS.elements S.boxed in
let lst' =
let aux acc cur = cur :: acc in
let lst = List.fold_left aux lst [] in
List.rev lst in
let%bind lst'' =
let aux = fun t -> translate_value (Ex_typed_value (ty_of_comparable_ty ty, t)) in
bind_map_list aux lst'
in
ok @@ D_set lst''
)
| (Operation_t _) , op -> | (Operation_t _) , op ->
ok @@ D_operation op ok @@ D_operation op
| ty, v -> | ty, v ->

View File

@ -0,0 +1 @@
let check = if Current.amount > 100tz then 42 else 0

View File

@ -0,0 +1,10 @@
type action =
| Increment of int
| Decrement of int
let main (p : action) (s : int) : (operation list * int) =
let storage =
match p with
| Increment n -> s + n
| Decrement n -> s - n in
(([] : operation list) , storage)

55
src/contracts/vote.mligo Normal file
View File

@ -0,0 +1,55 @@
type storage = {
title : string ;
candidates : (string , int) map ;
voters : address set ;
beginning_time : timestamp ;
finish_time : timestamp ;
}
type init_action = {
title : string ;
beginning_time : timestamp ;
finish_time : timestamp ;
}
type action =
| Vote of string
| Init of init_action
let init (init_params : init_action) (_ : storage) =
let candidates = Map [
("Yes" , 0) ;
("No" , 0)
] in
(
([] : operation list),
{
title = init_params.title ;
candidates = candidates ;
voters = (Set [] : address set) ;
beginning_time = init_params.beginning_time ;
finish_time = init_params.finish_time ;
}
)
let vote (parameter : string) (storage : storage) =
let now = Current.time in
(* let _ = assert (now >= storage.beginning_time && storage.finish_time > now) in *)
let addr = Current.source in
(* let _ = assert (not Set.mem addr storage.voters) in *)
let x = Map.find parameter storage.candidates in
(
([] : operation list),
{
title = storage.title ;
candidates = Map.update parameter (Some (x + 1)) storage.candidates ;
voters = Set.add addr storage.voters ;
beginning_time = storage.beginning_time ;
finish_time = storage.finish_time ;
}
)
let main (action : action) (storage : storage) =
match action with
| Vote p -> vote p storage
| Init ps -> init ps storage

View File

@ -17,8 +17,8 @@ let run_simplityped
let%bind annotated_result = Typer.untype_expression typed_result in let%bind annotated_result = Typer.untype_expression typed_result in
ok annotated_result ok annotated_result
let evaluate_simplityped (program : Ast_typed.program) (entry : string) let evaluate_simplityped ?options (program : Ast_typed.program) (entry : string)
: Ast_simplified.expression result = : Ast_simplified.expression result =
let%bind typed_result = Run_typed.evaluate_typed entry program in let%bind typed_result = Run_typed.evaluate_typed ?options entry program in
let%bind annotated_result = Typer.untype_expression typed_result in let%bind annotated_result = Typer.untype_expression typed_result in
ok annotated_result ok annotated_result

View File

@ -95,24 +95,54 @@ let parsify_expression_ligodity = fun source ->
Simplify.Ligodity.simpl_expression raw in Simplify.Ligodity.simpl_expression raw in
ok simplified ok simplified
let parsify = fun syntax source -> type s_syntax = Syntax_name of string
let%bind parsify = match syntax with type v_syntax = [`pascaligo | `cameligo ]
| "pascaligo" -> ok parsify_pascaligo
| "cameligo" -> ok parsify_ligodity let syntax_to_variant : s_syntax -> string option -> v_syntax result =
| _ -> simple_fail "unrecognized parser" fun syntax source_filename ->
let subr s n =
String.sub s (String.length s - n) n in
let endswith s suffix =
let suffixlen = String.length suffix in
( String.length s >= suffixlen
&& String.equal (subr s suffixlen) suffix)
in in
parsify source match syntax with
Syntax_name syntax ->
begin
if String.equal syntax "auto" then
begin
match source_filename with
| Some source_filename
when endswith source_filename ".ligo"
-> ok `pascaligo
| Some source_filename
when endswith source_filename ".mligo"
-> ok `cameligo
| _ -> simple_fail "cannot auto-detect syntax, pleas use -s name_of_syntax"
end
else if String.equal syntax "pascaligo" then ok `pascaligo
else if String.equal syntax "cameligo" then ok `cameligo
else simple_fail "unrecognized parser"
end
let parsify = fun (syntax : v_syntax) source_filename ->
let%bind parsify = match syntax with
| `pascaligo -> ok parsify_pascaligo
| `cameligo -> ok parsify_ligodity
in
parsify source_filename
let parsify_expression = fun syntax source -> let parsify_expression = fun syntax source ->
let%bind parsify = match syntax with let%bind parsify = match syntax with
| "pascaligo" -> ok parsify_expression_pascaligo | `pascaligo -> ok parsify_expression_pascaligo
| "cameligo" -> ok parsify_expression_ligodity | `cameligo -> ok parsify_expression_ligodity
| _ -> simple_fail "unrecognized parser"
in in
parsify source parsify source
let compile_contract_file : string -> string -> string -> string result = fun source entry_point syntax -> let compile_contract_file : string -> string -> s_syntax -> string result = fun source_filename entry_point syntax ->
let%bind simplified = parsify syntax source in let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind simplified = parsify syntax source_filename in
let%bind () = let%bind () =
assert_entry_point_defined simplified entry_point in assert_entry_point_defined simplified entry_point in
let%bind typed = let%bind typed =
@ -128,9 +158,10 @@ let compile_contract_file : string -> string -> string -> string result = fun so
Format.asprintf "%a" Michelson.pp_stripped michelson in Format.asprintf "%a" Michelson.pp_stripped michelson in
ok str ok str
let compile_contract_parameter : string -> string -> string -> string -> string result = fun source entry_point expression syntax -> let compile_contract_parameter : string -> string -> string -> s_syntax -> string result = fun source_filename entry_point expression syntax ->
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind (program , parameter_tv) = let%bind (program , parameter_tv) =
let%bind simplified = parsify syntax source in let%bind simplified = parsify syntax source_filename in
let%bind () = let%bind () =
assert_entry_point_defined simplified entry_point in assert_entry_point_defined simplified entry_point in
let%bind typed = let%bind typed =
@ -166,9 +197,10 @@ let compile_contract_parameter : string -> string -> string -> string -> string
ok expr ok expr
let compile_contract_storage : string -> string -> string -> string -> string result = fun source entry_point expression syntax -> let compile_contract_storage : string -> string -> string -> s_syntax -> string result = fun source_filename entry_point expression syntax ->
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind (program , storage_tv) = let%bind (program , storage_tv) =
let%bind simplified = parsify syntax source in let%bind simplified = parsify syntax source_filename in
let%bind () = let%bind () =
assert_entry_point_defined simplified entry_point in assert_entry_point_defined simplified entry_point in
let%bind typed = let%bind typed =
@ -204,8 +236,8 @@ let compile_contract_storage : string -> string -> string -> string -> string re
ok expr ok expr
let type_file ?(debug_simplify = false) ?(debug_typed = false) let type_file ?(debug_simplify = false) ?(debug_typed = false)
syntax (path:string) : Ast_typed.program result = syntax (source_filename:string) : Ast_typed.program result =
let%bind simpl = parsify syntax path in let%bind simpl = parsify syntax source_filename in
(if debug_simplify then (if debug_simplify then
Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl) Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl)
) ; ) ;
@ -216,3 +248,39 @@ let type_file ?(debug_simplify = false) ?(debug_typed = false)
Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed) Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed)
)) ; )) ;
ok typed ok typed
let run_contract ?amount source_filename entry_point storage input syntax =
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind typed =
type_file syntax source_filename in
let%bind storage_simpl =
parsify_expression syntax storage in
let%bind input_simpl =
parsify_expression syntax input in
let options =
let open Proto_alpha_utils.Memory_proto_alpha in
let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
(make_options ?amount ()) in
Run_simplified.run_simplityped ~options typed entry_point (Ast_simplified.e_pair storage_simpl input_simpl)
let run_function ?amount source_filename entry_point parameter syntax =
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind typed =
type_file syntax source_filename in
let%bind parameter' =
parsify_expression syntax parameter in
let options =
let open Proto_alpha_utils.Memory_proto_alpha in
let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
(make_options ?amount ()) in
Run_simplified.run_simplityped ~options typed entry_point parameter'
let evaluate_value ?amount source_filename entry_point syntax =
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind typed =
type_file syntax source_filename in
let options =
let open Proto_alpha_utils.Memory_proto_alpha in
let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
(make_options ?amount ()) in
Run_simplified.evaluate_simplityped ~options typed entry_point

View File

@ -13,12 +13,12 @@ let transpile_value
let%bind r = Run_mini_c.run_entry f input in let%bind r = Run_mini_c.run_entry f input in
ok r ok r
let evaluate_typed (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result = let evaluate_typed ?options (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result =
trace (simple_error "easy evaluate typed") @@ trace (simple_error "easy evaluate typed") @@
let%bind result = let%bind result =
let%bind mini_c_main = let%bind mini_c_main =
Transpiler.translate_entry program entry in Transpiler.translate_entry program entry in
Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in Run_mini_c.run_entry ?options mini_c_main (Mini_c.Combinators.d_unit) in
let%bind typed_result = let%bind typed_result =
let%bind typed_main = Ast_typed.get_entry program entry in let%bind typed_main = Ast_typed.get_entry program entry in
Transpiler.untranspile result typed_main.type_annotation in Transpiler.untranspile result typed_main.type_annotation in

View File

@ -267,6 +267,7 @@ module Types = struct
let key = Key_t None let key = Key_t None
let list a = List_t (a, None) let list a = List_t (a, None)
let set a = Set_t (a, None)
let assert_list = function let assert_list = function
| List_t (a, _) -> a | List_t (a, _) -> a
| _ -> assert false | _ -> assert false

View File

@ -27,6 +27,7 @@ let rec type_ ppf : type_value -> _ = function
| T_function(a, b) -> fprintf ppf "(%a) -> (%a)" type_ a type_ b | T_function(a, b) -> fprintf ppf "(%a) -> (%a)" type_ a type_ b
| T_map(k, v) -> fprintf ppf "map(%a -> %a)" type_ k type_ v | T_map(k, v) -> fprintf ppf "map(%a -> %a)" type_ k type_ v
| T_list(t) -> fprintf ppf "list(%a)" type_ t | T_list(t) -> fprintf ppf "list(%a)" type_ t
| T_set(t) -> fprintf ppf "set(%a)" type_ t
| T_option(o) -> fprintf ppf "option(%a)" type_ o | T_option(o) -> fprintf ppf "option(%a)" type_ o
| T_contract(t) -> fprintf ppf "contract(%a)" type_ t | T_contract(t) -> fprintf ppf "contract(%a)" type_ t
| T_deep_closure(c, arg, ret) -> | T_deep_closure(c, arg, ret) ->
@ -45,6 +46,7 @@ let rec value ppf : value -> unit = function
| D_operation _ -> fprintf ppf "operation[...bytes]" | D_operation _ -> fprintf ppf "operation[...bytes]"
| D_int n -> fprintf ppf "%d" n | D_int n -> fprintf ppf "%d" n
| D_nat n -> fprintf ppf "+%d" n | D_nat n -> fprintf ppf "+%d" n
| D_timestamp n -> fprintf ppf "+%d" n
| D_tez n -> fprintf ppf "%dtz" n | D_tez n -> fprintf ppf "%dtz" n
| D_unit -> fprintf ppf " " | D_unit -> fprintf ppf " "
| D_string s -> fprintf ppf "\"%s\"" s | D_string s -> fprintf ppf "\"%s\"" s
@ -57,6 +59,7 @@ let rec value ppf : value -> unit = function
| D_some s -> fprintf ppf "Some (%a)" value s | D_some s -> fprintf ppf "Some (%a)" value s
| D_map m -> fprintf ppf "Map[%a]" (list_sep_d value_assoc) m | D_map m -> fprintf ppf "Map[%a]" (list_sep_d value_assoc) m
| D_list lst -> fprintf ppf "List[%a]" (list_sep_d value) lst | D_list lst -> fprintf ppf "List[%a]" (list_sep_d value) lst
| D_set lst -> fprintf ppf "Set[%a]" (list_sep_d value) lst
and value_assoc ppf : (value * value) -> unit = fun (a, b) -> and value_assoc ppf : (value * value) -> unit = fun (a, b) ->
fprintf ppf "%a -> %a" value a value b fprintf ppf "%a -> %a" value a value b
@ -73,6 +76,7 @@ and expression' ppf (e:expression') = match e with
| E_literal v -> fprintf ppf "%a" value v | E_literal v -> fprintf ppf "%a" value v
| E_make_empty_map _ -> fprintf ppf "map[]" | E_make_empty_map _ -> fprintf ppf "map[]"
| E_make_empty_list _ -> fprintf ppf "list[]" | E_make_empty_list _ -> fprintf ppf "list[]"
| E_make_empty_set _ -> fprintf ppf "set[]"
| E_make_none _ -> fprintf ppf "none" | E_make_none _ -> fprintf ppf "none"
| E_if_bool (c, a, b) -> fprintf ppf "%a ? %a : %a" expression c expression a expression b | E_if_bool (c, a, b) -> fprintf ppf "%a ? %a : %a" expression c expression a expression b
| E_if_none (c, n, ((name, _) , s)) -> fprintf ppf "%a ?? %a : %s -> %a" expression c expression n name expression s | E_if_none (c, n, ((name, _) , s)) -> fprintf ppf "%a ?? %a : %s -> %a" expression c expression n name expression s

View File

@ -37,6 +37,10 @@ let get_nat (v:value) = match v with
| D_nat n -> ok n | D_nat n -> ok n
| _ -> simple_fail "not a nat" | _ -> simple_fail "not a nat"
let get_timestamp (v:value) = match v with
| D_timestamp n -> ok n
| _ -> simple_fail "not a timestamp"
let get_string (v:value) = match v with let get_string (v:value) = match v with
| D_string s -> ok s | D_string s -> ok s
| _ -> simple_fail "not a string" | _ -> simple_fail "not a string"
@ -62,6 +66,10 @@ let get_list (v:value) = match v with
| D_list lst -> ok lst | D_list lst -> ok lst
| _ -> simple_fail "not a list" | _ -> simple_fail "not a list"
let get_set (v:value) = match v with
| D_set lst -> ok lst
| _ -> simple_fail "not a set"
let get_t_option (v:type_value) = match v with let get_t_option (v:type_value) = match v with
| T_option t -> ok t | T_option t -> ok t
| _ -> simple_fail "not an option" | _ -> simple_fail "not an option"
@ -82,6 +90,10 @@ let get_t_list (t:type_value) = match t with
| T_list t -> ok t | T_list t -> ok t
| _ -> simple_fail "not a type list" | _ -> simple_fail "not a type list"
let get_t_set (t:type_value) = match t with
| T_set t -> ok t
| _ -> simple_fail "not a type set"
let get_left (v:value) = match v with let get_left (v:value) = match v with
| D_left b -> ok b | D_left b -> ok b
| _ -> simple_fail "not a left" | _ -> simple_fail "not a left"

View File

@ -16,6 +16,7 @@ type type_value =
| T_base of type_base | T_base of type_base
| T_map of (type_value * type_value) | T_map of (type_value * type_value)
| T_list of type_value | T_list of type_value
| T_set of type_value
| T_contract of type_value | T_contract of type_value
| T_option of type_value | T_option of type_value
@ -35,6 +36,7 @@ type value =
| D_unit | D_unit
| D_bool of bool | D_bool of bool
| D_nat of int | D_nat of int
| D_timestamp of int
| D_tez of int | D_tez of int
| D_int of int | D_int of int
| D_string of string | D_string of string
@ -46,6 +48,7 @@ type value =
| D_none | D_none
| D_map of (value * value) list | D_map of (value * value) list
| D_list of value list | D_list of value list
| D_set of value list
(* | `Macro of anon_macro ... The future. *) (* | `Macro of anon_macro ... The future. *)
| D_function of anon_function | D_function of anon_function
| D_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation | D_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation
@ -64,6 +67,7 @@ and expression' =
| E_variable of var_name | E_variable of var_name
| E_make_empty_map of (type_value * type_value) | E_make_empty_map of (type_value * type_value)
| E_make_empty_list of type_value | E_make_empty_list of type_value
| E_make_empty_set of type_value
| E_make_none of type_value | E_make_none of type_value
| E_if_bool of expression * expression * expression | E_if_bool of expression * expression * expression
| E_if_none of expression * expression * ((var_name * type_value) * expression) | E_if_none of expression * expression * ((var_name * type_value) * expression)

View File

@ -88,6 +88,7 @@ module Typer = struct
t_string () ; t_string () ;
t_bytes () ; t_bytes () ;
t_address () ; t_address () ;
t_timestamp () ;
] in ] in
ok @@ t_bool () ok @@ t_bool ()

View File

@ -42,6 +42,9 @@ module Simplify = struct
("bool" , "bool") ; ("bool" , "bool") ;
("operation" , "operation") ; ("operation" , "operation") ;
("address" , "address") ; ("address" , "address") ;
("key" , "key") ;
("key_hash" , "key_hash") ;
("signature" , "signature") ;
("timestamp" , "timestamp") ; ("timestamp" , "timestamp") ;
("contract" , "contract") ; ("contract" , "contract") ;
("list" , "list") ; ("list" , "list") ;
@ -76,7 +79,7 @@ module Simplify = struct
("Bytes.pack" , "PACK") ; ("Bytes.pack" , "PACK") ;
("Crypto.hash" , "HASH") ; ("Crypto.hash" , "HASH") ;
("Operation.transaction" , "CALL") ; ("Operation.transaction" , "CALL") ;
("Operation.get_contract" , "GET_CONTRACT") ; ("Operation.get_contract" , "CONTRACT") ;
("sender" , "SENDER") ; ("sender" , "SENDER") ;
("unit" , "UNIT") ; ("unit" , "UNIT") ;
("source" , "SOURCE") ; ("source" , "SOURCE") ;
@ -87,6 +90,8 @@ module Simplify = struct
module Ligodity = struct module Ligodity = struct
let constants = [ let constants = [
("assert" , "ASSERT") ;
("Current.balance", "BALANCE") ; ("Current.balance", "BALANCE") ;
("balance", "BALANCE") ; ("balance", "BALANCE") ;
("Current.time", "NOW") ; ("Current.time", "NOW") ;
@ -97,6 +102,8 @@ module Simplify = struct
("gas", "STEPS_TO_QUOTA") ; ("gas", "STEPS_TO_QUOTA") ;
("Current.sender" , "SENDER") ; ("Current.sender" , "SENDER") ;
("sender", "SENDER") ; ("sender", "SENDER") ;
("Current.source" , "SOURCE") ;
("source", "SOURCE") ;
("Current.failwith", "FAILWITH") ; ("Current.failwith", "FAILWITH") ;
("failwith" , "FAILWITH") ; ("failwith" , "FAILWITH") ;
@ -115,6 +122,17 @@ module Simplify = struct
("Bytes.slice", "SLICE") ; ("Bytes.slice", "SLICE") ;
("Bytes.sub", "SLICE") ; ("Bytes.sub", "SLICE") ;
("Set.mem" , "SET_MEM") ;
("Set.empty" , "SET_EMPTY") ;
("Set.add" , "SET_ADD") ;
("Set.remove" , "SET_REMOVE") ;
("Map.find_opt" , "MAP_FIND_OPT") ;
("Map.find" , "MAP_FIND") ;
("Map.update" , "MAP_UPDATE") ;
("Map.add" , "MAP_ADD") ;
("Map.remove" , "MAP_REMOVE") ;
("String.length", "SIZE") ; ("String.length", "SIZE") ;
("String.size", "SIZE") ; ("String.size", "SIZE") ;
("String.slice", "SLICE") ; ("String.slice", "SLICE") ;
@ -126,7 +144,7 @@ module Simplify = struct
("List.iter", "ITER") ; ("List.iter", "ITER") ;
("Operation.transaction" , "CALL") ; ("Operation.transaction" , "CALL") ;
("Operation.get_contract" , "GET_CONTRACT") ; ("Operation.get_contract" , "CONTRACT") ;
("int" , "INT") ; ("int" , "INT") ;
("abs" , "ABS") ; ("abs" , "ABS") ;
("unit" , "UNIT") ; ("unit" , "UNIT") ;
@ -195,7 +213,7 @@ module Typer = struct
let%bind () = assert_type_value_eq (dst, v) in let%bind () = assert_type_value_eq (dst, v) in
ok m ok m
let map_update : typer = typer_3 "MAP_UPDATE_TODO" @@ fun k v m -> let map_update : typer = typer_3 "MAP_UPDATE" @@ fun k v m ->
let%bind (src, dst) = get_t_map m in let%bind (src, dst) = get_t_map m in
let%bind () = assert_type_value_eq (src, k) in let%bind () = assert_type_value_eq (src, k) in
let%bind v' = get_t_option v in let%bind v' = get_t_option v in
@ -207,7 +225,12 @@ module Typer = struct
let%bind () = assert_type_value_eq (src, k) in let%bind () = assert_type_value_eq (src, k) in
ok @@ t_bool () ok @@ t_bool ()
let map_find : typer = typer_2 "MAP_FIND_TODO" @@ fun k m -> let map_find : typer = typer_2 "MAP_FIND" @@ fun k m ->
let%bind (src, dst) = get_t_map m in
let%bind () = assert_type_value_eq (src, k) in
ok @@ dst
let map_find_opt : typer = typer_2 "MAP_FIND_OPT" @@ fun k m ->
let%bind (src, dst) = get_t_map m in let%bind (src, dst) = get_t_map m in
let%bind () = assert_type_value_eq (src, k) in let%bind () = assert_type_value_eq (src, k) in
ok @@ t_option dst () ok @@ t_option dst ()
@ -243,9 +266,15 @@ module Typer = struct
let size = typer_1 "SIZE" @@ fun t -> let size = typer_1 "SIZE" @@ fun t ->
let%bind () = let%bind () =
Assert.assert_true @@ Assert.assert_true @@
(is_t_map t || is_t_list t) in (is_t_map t || is_t_list t || is_t_string t) in
ok @@ t_nat () ok @@ t_nat ()
let slice = typer_3 "SLICE" @@ fun i j s ->
let%bind () =
Assert.assert_true @@
(is_t_nat i && is_t_nat j && is_t_string s) in
ok @@ t_string ()
let failwith_ = typer_1 "FAILWITH" @@ fun t -> let failwith_ = typer_1 "FAILWITH" @@ fun t ->
let%bind () = let%bind () =
Assert.assert_true @@ Assert.assert_true @@
@ -269,10 +298,28 @@ module Typer = struct
trace_option (simple_error "untyped UNPACK") @@ trace_option (simple_error "untyped UNPACK") @@
output_opt output_opt
let crypto_hash = typer_1 "HASH" @@ fun t -> let hash256 = typer_1 "SHA256" @@ fun t ->
let%bind () = assert_t_bytes t in let%bind () = assert_t_bytes t in
ok @@ t_bytes () ok @@ t_bytes ()
let hash512 = typer_1 "SHA512" @@ fun t ->
let%bind () = assert_t_bytes t in
ok @@ t_bytes ()
let blake2b = typer_1 "BLAKE2b" @@ fun t ->
let%bind () = assert_t_bytes t in
ok @@ t_bytes ()
let hash_key = typer_1 "HASH_KEY" @@ fun t ->
let%bind () = assert_t_key t in
ok @@ t_key_hash ()
let check_signature = typer_3 "CHECK_SIGNATURE" @@ fun k s b ->
let%bind () = assert_t_key k in
let%bind () = assert_t_signature s in
let%bind () = assert_t_bytes b in
ok @@ t_bool ()
let sender = constant "SENDER" @@ t_address () let sender = constant "SENDER" @@ t_address ()
let source = constant "SOURCE" @@ t_address () let source = constant "SOURCE" @@ t_address ()
@ -281,6 +328,8 @@ module Typer = struct
let amount = constant "AMOUNT" @@ t_tez () let amount = constant "AMOUNT" @@ t_tez ()
let address = constant "ADDRESS" @@ t_address ()
let now = constant "NOW" @@ t_timestamp () let now = constant "NOW" @@ t_timestamp ()
let transaction = typer_3 "CALL" @@ fun param amount contract -> let transaction = typer_3 "CALL" @@ fun param amount contract ->
@ -301,6 +350,11 @@ module Typer = struct
let%bind () = assert_t_int t in let%bind () = assert_t_int t in
ok @@ t_nat () ok @@ t_nat ()
let assertion = typer_1 "ASSERT" @@ fun a ->
if eq_1 a (t_bool ())
then ok @@ t_unit ()
else simple_fail "Asserting a non-bool"
let times = typer_2 "TIMES" @@ fun a b -> let times = typer_2 "TIMES" @@ fun a b ->
if eq_2 (a , b) (t_nat ()) if eq_2 (a , b) (t_nat ())
then ok @@ t_nat () else then ok @@ t_nat () else
@ -335,6 +389,29 @@ module Typer = struct
then ok @@ t_int () else then ok @@ t_int () else
simple_fail "Adding with wrong types. Expected nat, int or tez." simple_fail "Adding with wrong types. Expected nat, int or tez."
let set_mem = typer_2 "SET_MEM" @@ fun elt set ->
let%bind key = get_t_set set in
if eq_1 elt key
then ok @@ t_bool ()
else simple_fail "Set_mem: elt and set don't match"
let set_add = typer_2 "SET_ADD" @@ fun elt set ->
let%bind key = get_t_set set in
if eq_1 elt key
then ok set
else simple_fail "Set_add: elt and set don't match"
let set_remove = typer_2 "SET_REMOVE" @@ fun elt set ->
let%bind key = get_t_set set in
if eq_1 elt key
then ok set
else simple_fail "Set_remove: elt and set don't match"
let not_ = typer_1 "NOT" @@ fun elt ->
if eq_1 elt (t_bool ())
then ok @@ t_bool ()
else simple_fail "bad parameter to not"
let constant_typers = Map.String.of_list [ let constant_typers = Map.String.of_list [
add ; add ;
times ; times ;
@ -351,6 +428,7 @@ module Typer = struct
comparator "GE" ; comparator "GE" ;
boolean_operator_2 "OR" ; boolean_operator_2 "OR" ;
boolean_operator_2 "AND" ; boolean_operator_2 "AND" ;
not_ ;
map_remove ; map_remove ;
map_add ; map_add ;
map_update ; map_update ;
@ -360,6 +438,9 @@ module Typer = struct
map_map ; map_map ;
map_fold ; map_fold ;
map_iter ; map_iter ;
set_mem ;
set_add ;
set_remove ;
(* map_size ; (* use size *) *) (* map_size ; (* use size *) *)
int ; int ;
size ; size ;
@ -367,7 +448,11 @@ module Typer = struct
get_force ; get_force ;
bytes_pack ; bytes_pack ;
bytes_unpack ; bytes_unpack ;
crypto_hash ; hash256 ;
hash512 ;
blake2b ;
hash_key ;
check_signature ;
sender ; sender ;
source ; source ;
unit ; unit ;
@ -376,6 +461,9 @@ module Typer = struct
get_contract ; get_contract ;
abs ; abs ;
now ; now ;
slice ;
address ;
assertion ;
] ]
end end
@ -407,6 +495,8 @@ module Compiler = struct
("NEG" , simple_unary @@ prim I_NEG) ; ("NEG" , simple_unary @@ prim I_NEG) ;
("OR" , simple_binary @@ prim I_OR) ; ("OR" , simple_binary @@ prim I_OR) ;
("AND" , simple_binary @@ prim I_AND) ; ("AND" , simple_binary @@ prim I_AND) ;
("XOR" , simple_binary @@ prim I_XOR) ;
("NOT" , simple_unary @@ prim I_NOT) ;
("PAIR" , simple_binary @@ prim I_PAIR) ; ("PAIR" , simple_binary @@ prim I_PAIR) ;
("CAR" , simple_unary @@ prim I_CAR) ; ("CAR" , simple_unary @@ prim I_CAR) ;
("CDR" , simple_unary @@ prim I_CDR) ; ("CDR" , simple_unary @@ prim I_CDR) ;
@ -419,21 +509,35 @@ module Compiler = struct
("UPDATE" , simple_ternary @@ prim I_UPDATE) ; ("UPDATE" , simple_ternary @@ prim I_UPDATE) ;
("SOME" , simple_unary @@ prim I_SOME) ; ("SOME" , simple_unary @@ prim I_SOME) ;
("MAP_GET_FORCE" , simple_binary @@ seq [prim I_GET ; i_assert_some_msg (i_push_string "GET_FORCE")]) ; ("MAP_GET_FORCE" , simple_binary @@ seq [prim I_GET ; i_assert_some_msg (i_push_string "GET_FORCE")]) ;
("MAP_FIND" , simple_binary @@ seq [prim I_GET ; i_assert_some_msg (i_push_string "MAP FIND")]) ;
("MAP_GET" , simple_binary @@ prim I_GET) ; ("MAP_GET" , simple_binary @@ prim I_GET) ;
("SIZE" , simple_unary @@ prim I_SIZE) ; ("SIZE" , simple_unary @@ prim I_SIZE) ;
("FAILWITH" , simple_unary @@ prim I_FAILWITH) ; ("FAILWITH" , simple_unary @@ prim I_FAILWITH) ;
("ASSERT" , simple_binary @@ i_if (seq [i_failwith]) (seq [i_drop ; i_push_unit])) ; ("ASSERT_INFERRED" , simple_binary @@ i_if (seq [i_failwith]) (seq [i_drop ; i_push_unit])) ;
("ASSERT" , simple_unary @@ i_if (seq [i_push_unit ; i_failwith]) (seq [i_push_unit])) ;
("INT" , simple_unary @@ prim I_INT) ; ("INT" , simple_unary @@ prim I_INT) ;
("ABS" , simple_unary @@ prim I_ABS) ; ("ABS" , simple_unary @@ prim I_ABS) ;
("CONS" , simple_binary @@ prim I_CONS) ; ("CONS" , simple_binary @@ prim I_CONS) ;
("UNIT" , simple_constant @@ prim I_UNIT) ; ("UNIT" , simple_constant @@ prim I_UNIT) ;
("AMOUNT" , simple_constant @@ prim I_AMOUNT) ; ("AMOUNT" , simple_constant @@ prim I_AMOUNT) ;
("ADDRESS" , simple_constant @@ prim I_ADDRESS) ;
("NOW" , simple_constant @@ prim I_NOW) ; ("NOW" , simple_constant @@ prim I_NOW) ;
("CALL" , simple_ternary @@ prim I_TRANSFER_TOKENS) ; ("CALL" , simple_ternary @@ prim I_TRANSFER_TOKENS) ;
("SOURCE" , simple_constant @@ prim I_SOURCE) ; ("SOURCE" , simple_constant @@ prim I_SOURCE) ;
("SENDER" , simple_constant @@ prim I_SENDER) ; ("SENDER" , simple_constant @@ prim I_SENDER) ;
( "MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]) ; ("MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]) ;
( "MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ; ("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ;
("SET_MEM" , simple_binary @@ prim I_MEM) ;
("SET_ADD" , simple_binary @@ seq [dip (i_push (prim T_bool) (prim D_True)) ; prim I_UPDATE]) ;
("SLICE" , simple_ternary @@ prim I_SLICE) ;
("SHA256" , simple_unary @@ prim I_SHA256) ;
("SHA512" , simple_unary @@ prim I_SHA512) ;
("BLAKE2B" , simple_unary @@ prim I_BLAKE2B) ;
("CHECK_SIGNATURE" , simple_ternary @@ prim I_CHECK_SIGNATURE) ;
("HASH_KEY" , simple_unary @@ prim I_HASH_KEY) ;
("PACK" , simple_unary @@ prim I_PACK) ;
] ]
(* Some complex predicates will need to be added in compiler/compiler_program *)
end end

View File

@ -34,6 +34,19 @@ let parse_file (source: string) : AST.t result =
in in
simple_error str simple_error str
) )
| Lexer.Error err -> (
let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in
let str = Format.sprintf
"Lexer error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
(err.value)
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
start.pos_fname source
in
simple_error str
)
| exn -> | exn ->
let start = Lexing.lexeme_start_p lexbuf in let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in

View File

@ -104,7 +104,7 @@ let keywords = Token.[
"and", None; "and", None;
"as", None; "as", None;
"asr", None; "asr", None;
"assert", None; (* "assert", None;*)
"class", None; "class", None;
"constraint", None; "constraint", None;
"do", None; "do", None;

View File

@ -179,11 +179,18 @@ tuple(item):
(* Possibly empty semicolon-separated values between brackets *) (* Possibly empty semicolon-separated values between brackets *)
list_of(item): list_of(item):
lbracket sepseq(item,semi) rbracket { lbracket sep_or_term_list(item,semi) rbracket {
let elements, terminator = $2 in {
opening = LBracket $1;
elements = Some elements;
terminator;
closing = RBracket $3}
}
| lbracket rbracket {
{opening = LBracket $1; {opening = LBracket $1;
elements = $2; elements = None;
terminator = None; terminator = None;
closing = RBracket $3} } closing = RBracket $2} }
(* Main *) (* Main *)

View File

@ -1 +0,0 @@
let version = "UNKNOWN"

View File

@ -597,7 +597,7 @@ and nil = kwd_nil
and constr_expr = and constr_expr =
SomeApp of (c_Some * arguments) reg SomeApp of (c_Some * arguments) reg
| NoneExpr of none_expr | NoneExpr of none_expr
| ConstrApp of (constr * arguments) reg | ConstrApp of (constr * arguments option) reg
and record_expr = field_assign reg injection reg and record_expr = field_assign reg injection reg

View File

@ -581,7 +581,7 @@ and nil = kwd_nil
and constr_expr = and constr_expr =
SomeApp of (c_Some * arguments) reg SomeApp of (c_Some * arguments) reg
| NoneExpr of none_expr | NoneExpr of none_expr
| ConstrApp of (constr * arguments) reg | ConstrApp of (constr * arguments option) reg
and record_expr = field_assign reg injection reg and record_expr = field_assign reg injection reg

View File

@ -956,7 +956,10 @@ core_expr:
| projection { EProj $1 } | projection { EProj $1 }
| Constr arguments { | Constr arguments {
let region = cover $1.region $2.region in let region = cover $1.region $2.region in
EConstr (ConstrApp {region; value = $1,$2}) EConstr (ConstrApp {region; value = $1, Some $2})
}
| Constr {
EConstr (ConstrApp {region=$1.region; value = $1,None})
} }
| C_Some arguments { | C_Some arguments {
let region = cover $1 $2.region in let region = cover $1 $2.region in

View File

@ -648,7 +648,9 @@ and print_fun_call {value; _} =
and print_constr_app {value; _} = and print_constr_app {value; _} =
let constr, arguments = value in let constr, arguments = value in
print_constr constr; print_constr constr;
print_tuple_inj arguments match arguments with
None -> ()
| Some args -> print_tuple_inj args
and print_some_app {value; _} = and print_some_app {value; _} =
let c_Some, arguments = value in let c_Some, arguments = value in

View File

@ -147,6 +147,22 @@ module Errors = struct
] in ] in
error ~data title message error ~data title message
let bad_set_definition =
let title () = "bad set definition" in
let message () = "a set definition is a list" in
info title message
let bad_list_definition =
let title () = "bad list definition" in
let message () = "a list definition is a list" in
info title message
let bad_map_definition =
let title () = "bad map definition" in
let message () = "a map definition is a list of pairs" in
info title message
let corner_case ~loc message = let corner_case ~loc message =
let title () = "corner case" in let title () = "corner case" in
let content () = "We don't have a good error message for this case. \ let content () = "We don't have a good error message for this case. \
@ -158,6 +174,7 @@ module Errors = struct
("message" , fun () -> message) ; ("message" , fun () -> message) ;
] in ] in
error ~data title content error ~data title content
end end
open Errors open Errors
@ -170,6 +187,7 @@ let rec pattern_to_var : Raw.pattern -> _ = fun p ->
match p with match p with
| Raw.PPar p -> pattern_to_var p.value.inside | Raw.PPar p -> pattern_to_var p.value.inside
| Raw.PVar v -> ok v | Raw.PVar v -> ok v
| Raw.PWild r -> ok @@ ({ region = r ; value = "_" } : Raw.variable)
| _ -> fail @@ wrong_pattern "var" p | _ -> fail @@ wrong_pattern "var" p
let rec pattern_to_typed_var : Raw.pattern -> _ = fun p -> let rec pattern_to_typed_var : Raw.pattern -> _ = fun p ->
@ -181,6 +199,7 @@ let rec pattern_to_typed_var : Raw.pattern -> _ = fun p ->
ok (v , Some tp.type_expr) ok (v , Some tp.type_expr)
) )
| Raw.PVar v -> ok (v , None) | Raw.PVar v -> ok (v , None)
| Raw.PWild r -> ok (({ region = r ; value = "_" } : Raw.variable) , None)
| _ -> fail @@ wrong_pattern "typed variable" p | _ -> fail @@ wrong_pattern "typed variable" p
let rec expr_to_typed_expr : Raw.expr -> _ = fun e -> let rec expr_to_typed_expr : Raw.expr -> _ = fun e ->
@ -358,11 +377,38 @@ let rec simpl_expression :
let (c_name , _c_loc) = r_split c_name in let (c_name , _c_loc) = r_split c_name in
let args = let args =
match args with match args with
None -> [] | None -> []
| Some arg -> [arg] in | Some arg -> [arg] in
let%bind arg = simpl_tuple_expression @@ args in let%bind arg = simpl_tuple_expression @@ args in
match c_name with
| "Set" -> (
let%bind args' =
trace bad_set_definition @@
extract_list arg in
return @@ e_set ~loc args'
)
| "List" -> (
let%bind args' =
trace bad_list_definition @@
extract_list arg in
return @@ e_list ~loc args'
)
| "Map" -> (
let%bind args' =
trace bad_map_definition @@
extract_list arg in
let%bind pairs =
trace bad_map_definition @@
bind_map_list extract_pair args' in
return @@ e_map ~loc pairs
)
| "Some" -> (
return @@ e_some ~loc arg
)
| _ -> (
return @@ e_constructor ~loc c_name arg return @@ e_constructor ~loc c_name arg
) )
)
| EArith (Add c) -> | EArith (Add c) ->
simpl_binop "ADD" c simpl_binop "ADD" c
| EArith (Sub c) -> | EArith (Sub c) ->

View File

@ -416,7 +416,10 @@ let rec simpl_expression (t:Raw.expr) : expr result =
| EProj p -> simpl_projection p | EProj p -> simpl_projection p
| EConstr (ConstrApp c) -> ( | EConstr (ConstrApp c) -> (
let ((c, args) , loc) = r_split c in let ((c, args) , loc) = r_split c in
let (args , args_loc) = r_split args in match args with
None -> simpl_tuple_expression []
| Some args ->
let args, args_loc = r_split args in
let%bind arg = let%bind arg =
simpl_tuple_expression ~loc:args_loc simpl_tuple_expression ~loc:args_loc
@@ npseq_to_list args.inside in @@ npseq_to_list args.inside in

View File

@ -4,7 +4,7 @@ open Test_helpers
let compile_contract_basic () : unit result = let compile_contract_basic () : unit result =
let%bind _ = let%bind _ =
compile_contract_file "./contracts/dispatch-counter.ligo" "main" "pascaligo" compile_contract_file "./contracts/dispatch-counter.ligo" "main" (Syntax_name "pascaligo")
in in
ok () ok ()

View File

@ -4,7 +4,7 @@ open Trace
open Ligo.Run open Ligo.Run
open Test_helpers open Test_helpers
let type_file = type_file "pascaligo" let type_file = type_file `pascaligo
let get_program = let get_program =
let s = ref None in let s = ref None in
@ -217,7 +217,7 @@ let sell () =
let expected_storage = let expected_storage =
let cards = List.hds @@ cards_ez first_owner n in let cards = List.hds @@ cards_ez first_owner n in
basic 99 1000 cards (2 * n) in basic 99 1000 cards (2 * n) in
Ast_simplified.assert_value_eq (expected_storage , storage) Ast_simplified.Misc.assert_value_eq (expected_storage , storage)
in in
let%bind () = let%bind () =
let amount = Memory_proto_alpha.Alpha_context.Tez.zero in let amount = Memory_proto_alpha.Alpha_context.Tez.zero in

View File

@ -2,7 +2,7 @@ open Trace
open Ligo.Run open Ligo.Run
open Test_helpers open Test_helpers
let type_file = type_file "pascaligo" let type_file = type_file `pascaligo
let get_program = let get_program =
let s = ref None in let s = ref None in

View File

@ -4,8 +4,8 @@ open Test_helpers
open Ast_simplified.Combinators open Ast_simplified.Combinators
let mtype_file ?debug_simplify ?debug_typed = type_file ?debug_simplify ?debug_typed "cameligo" let mtype_file ?debug_simplify ?debug_typed = type_file ?debug_simplify ?debug_typed `cameligo
let type_file = type_file "pascaligo" let type_file = type_file `pascaligo
let type_alias () : unit result = let type_alias () : unit result =
let%bind program = type_file "./contracts/type-alias.ligo" in let%bind program = type_file "./contracts/type-alias.ligo" in
@ -429,6 +429,16 @@ let super_counter_contract () : unit result =
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected expect_eq_n program "main" make_input make_expected
let super_counter_contract_mligo () : unit result =
let%bind program = mtype_file "./contracts/super-counter.mligo" in
let make_input = fun n ->
let action = if n mod 2 = 0 then "Increment" else "Decrement" in
e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected
let dispatch_counter_contract () : unit result = let dispatch_counter_contract () : unit result =
let%bind program = type_file "./contracts/dispatch-counter.ligo" in let%bind program = type_file "./contracts/dispatch-counter.ligo" in
let make_input = fun n -> let make_input = fun n ->
@ -566,6 +576,7 @@ let main = test_suite "Integration (End to End)" [
test "#include directives" include_ ; test "#include directives" include_ ;
test "counter contract" counter_contract ; test "counter contract" counter_contract ;
test "super counter contract" super_counter_contract ; test "super counter contract" super_counter_contract ;
test "super counter contract" super_counter_contract_mligo ;
test "dispatch counter contract" dispatch_counter_contract ; test "dispatch counter contract" dispatch_counter_contract ;
test "closure" closure ; test "closure" closure ;
test "shared function" shared_function ; test "shared function" shared_function ;

View File

@ -51,6 +51,7 @@ let () =
Typer_tests.main ; Typer_tests.main ;
Heap_tests.main ; Heap_tests.main ;
Coase_tests.main ; Coase_tests.main ;
Vote_tests.main ;
Bin_tests.main ; Bin_tests.main ;
] ; ] ;
() ()

View File

@ -5,7 +5,7 @@ type test =
| Test_suite of (string * test list) | Test_suite of (string * test list)
| Test of test_case | Test of test_case
let error_pp out (e : error) = let rec error_pp out (e : error) =
let open JSON_string_utils in let open JSON_string_utils in
let message = let message =
let opt = e |> member "message" |> string in let opt = e |> member "message" |> string in
@ -30,6 +30,7 @@ let error_pp out (e : error) =
let infos = e |> member "infos" in let infos = e |> member "infos" in
match infos with match infos with
| `Null -> "" | `Null -> ""
| `List lst -> Format.asprintf "@[<v2>%a@]" PP_helpers.(list_sep error_pp (tag "@,")) lst
| _ -> " " ^ (J.to_string infos) ^ "\n" in | _ -> " " ^ (J.to_string infos) ^ "\n" in
Format.fprintf out "%s%s%s.\n%s%s" title error_code message data infos Format.fprintf out "%s%s%s.\n%s%s" title error_code message data infos
@ -70,7 +71,7 @@ let expect_eq ?options program entry_point input expected =
Ast_simplified.PP.expression result in Ast_simplified.PP.expression result in
error title content in error title content in
trace expect_error @@ trace expect_error @@
Ast_simplified.assert_value_eq (expected , result) in Ast_simplified.Misc.assert_value_eq (expected , result) in
expect ?options program entry_point input expecter expect ?options program entry_point input expecter
let expect_evaluate program entry_point expecter = let expect_evaluate program entry_point expecter =
@ -84,7 +85,7 @@ let expect_evaluate program entry_point expecter =
let expect_eq_evaluate program entry_point expected = let expect_eq_evaluate program entry_point expected =
let expecter = fun result -> let expecter = fun result ->
Ast_simplified.assert_value_eq (expected , result) in Ast_simplified.Misc.assert_value_eq (expected , result) in
expect_evaluate program entry_point expecter expect_evaluate program entry_point expecter
let expect_n_aux ?options lst program entry_point make_input make_expecter = let expect_n_aux ?options lst program entry_point make_input make_expecter =

55
src/test/vote_tests.ml Normal file
View File

@ -0,0 +1,55 @@
open Trace
open Ligo.Run
open Test_helpers
let get_program =
let s = ref None in
fun () -> match !s with
| Some s -> ok s
| None -> (
let%bind program = type_file `cameligo "./contracts/vote.mligo" in
s := Some program ;
ok program
)
open Ast_simplified
let init_storage name = ez_e_record [
("title" , e_string name) ;
("candidates" , e_map [
(e_string "Yes" , e_int 0) ;
(e_string "No" , e_int 0) ;
]) ;
("voters" , e_typed_set [] t_address) ;
("beginning_time" , e_timestamp 0) ;
("finish_time" , e_timestamp 1000000000) ;
]
let init title beginning_time finish_time =
let init_action = ez_e_record [
("title" , e_string title) ;
("beginning_time" , e_timestamp beginning_time) ;
("finish_time" , e_timestamp finish_time) ;
] in
e_constructor "Init" init_action
let vote str =
let vote = e_string str in
e_constructor "Vote" vote
let init_vote () =
let%bind program = get_program () in
let%bind result = Ligo.Run.run_simplityped program "main" (e_pair (vote "Yes") (init_storage "basic")) in
let%bind (_ , storage) = extract_pair result in
let%bind storage' = extract_record storage in
let votes = List.assoc "candidates" storage' in
let%bind votes' = extract_map votes in
let%bind (_ , yess) =
trace_option (simple_error "") @@
List.find_opt (fun (k , _) -> Ast_simplified.Misc.is_value_eq (k , e_string "Yes")) votes' in
let%bind () = Ast_simplified.Misc.assert_value_eq (yess , e_int 1) in
ok ()
let main = test_suite "Vote" [
test "type" init_vote ;
]

View File

@ -105,6 +105,9 @@ let rec translate_type (t:AST.type_value) : type_value result =
| T_constant ("list", [t]) -> | T_constant ("list", [t]) ->
let%bind t' = translate_type t in let%bind t' = translate_type t in
ok (T_list t') ok (T_list t')
| T_constant ("set", [t]) ->
let%bind t' = translate_type t in
ok (T_set t')
| T_constant ("option", [o]) -> | T_constant ("option", [o]) ->
let%bind o' = translate_type o in let%bind o' = translate_type o in
ok (T_option o') ok (T_option o')
@ -181,6 +184,7 @@ let rec translate_literal : AST.literal -> value = fun l -> match l with
| Literal_bool b -> D_bool b | Literal_bool b -> D_bool b
| Literal_int n -> D_int n | Literal_int n -> D_int n
| Literal_nat n -> D_nat n | Literal_nat n -> D_nat n
| Literal_timestamp n -> D_timestamp n
| Literal_tez n -> D_tez n | Literal_tez n -> D_tez n
| Literal_bytes s -> D_bytes s | Literal_bytes s -> D_bytes s
| Literal_string s -> D_string s | Literal_string s -> D_string s
@ -362,6 +366,16 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re
let%bind (init : expression) = return @@ E_make_empty_list t in let%bind (init : expression) = return @@ E_make_empty_list t in
bind_fold_list aux init lst' bind_fold_list aux init lst'
) )
| E_set lst -> (
let%bind t =
trace_strong (corner_case ~loc:__LOC__ "not a set") @@
Mini_c.Combinators.get_t_set tv in
let%bind lst' = bind_map_list (translate_annotated_expression) lst in
let aux : expression -> expression -> expression result = fun prev cur ->
return @@ E_constant ("CONS", [cur ; prev]) in
let%bind (init : expression) = return @@ E_make_empty_set t in
bind_fold_list aux init lst'
)
| E_map m -> ( | E_map m -> (
let%bind (src, dst) = let%bind (src, dst) =
trace_strong (corner_case ~loc:__LOC__ "not a map") @@ trace_strong (corner_case ~loc:__LOC__ "not a map") @@
@ -663,6 +677,12 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
get_nat v in get_nat v in
return (E_literal (Literal_nat n)) return (E_literal (Literal_nat n))
) )
| T_constant ("timestamp", []) -> (
let%bind n =
trace_strong (wrong_mini_c_value "timestamp" v) @@
get_timestamp v in
return (E_literal (Literal_timestamp n))
)
| T_constant ("tez", []) -> ( | T_constant ("tez", []) -> (
let%bind n = let%bind n =
trace_strong (wrong_mini_c_value "tez" v) @@ trace_strong (wrong_mini_c_value "tez" v) @@
@ -712,6 +732,15 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
bind_map_list aux lst in bind_map_list aux lst in
return (E_list lst') return (E_list lst')
) )
| T_constant ("set", [ty]) -> (
let%bind lst =
trace_strong (wrong_mini_c_value "set" v) @@
get_set v in
let%bind lst' =
let aux = fun e -> untranspile e ty in
bind_map_list aux lst in
return (E_set lst')
)
| T_constant ("contract" , [_ty]) -> | T_constant ("contract" , [_ty]) ->
fail @@ bad_untranspile "contract" v fail @@ bad_untranspile "contract" v
| T_constant ("operation" , []) -> ( | T_constant ("operation" , []) -> (

View File

@ -206,11 +206,13 @@ module Errors = struct
] in ] in
error ~data title message () error ~data title message ()
let constant_error loc = let constant_error loc lst tv_opt =
let title () = "typing constant" in let title () = "typing constant" in
let message () = "" in let message () = "" in
let data = [ let data = [
("location" , fun () -> Format.asprintf "%a" Location.pp loc ) ; ("location" , fun () -> Format.asprintf "%a" Location.pp loc ) ;
("argument_types" , fun () -> Format.asprintf "%a" PP_helpers.(list_sep Ast_typed.PP.type_value (const " , ")) lst) ;
("type_opt" , fun () -> Format.asprintf "%a" PP_helpers.(option Ast_typed.PP.type_value) tv_opt) ;
] in ] in
error ~data title message error ~data title message
end end
@ -416,6 +418,8 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
return (E_literal (Literal_int n)) (t_int ()) return (E_literal (Literal_int n)) (t_int ())
| E_literal (Literal_nat n) -> | E_literal (Literal_nat n) ->
return (E_literal (Literal_nat n)) (t_nat ()) return (E_literal (Literal_nat n)) (t_nat ())
| E_literal (Literal_timestamp n) ->
return (E_literal (Literal_timestamp n)) (t_timestamp ())
| E_literal (Literal_tez n) -> | E_literal (Literal_tez n) ->
return (E_literal (Literal_tez n)) (t_tez ()) return (E_literal (Literal_tez n)) (t_tez ())
| E_literal (Literal_address s) -> | E_literal (Literal_address s) ->
@ -501,6 +505,27 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
ok (t_list ty ()) ok (t_list ty ())
in in
return (E_list lst') tv return (E_list lst') tv
| E_set lst ->
let%bind lst' = bind_map_list (type_expression e) lst in
let%bind tv =
let aux opt c =
match opt with
| None -> ok (Some c)
| Some c' ->
let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
ok (Some c') in
let%bind init = match tv_opt with
| None -> ok None
| Some ty ->
let%bind ty' = get_t_set ty in
ok (Some ty') in
let%bind ty =
let%bind opt = bind_fold_list aux init
@@ List.map get_type_annotation lst' in
trace_option (needs_annotation ae "empty set") opt in
ok (t_set ty ())
in
return (E_set lst') tv
| E_map lst -> | E_map lst ->
let%bind lst' = bind_map_list (bind_map_pair (type_expression e)) lst in let%bind lst' = bind_map_list (bind_map_pair (type_expression e)) lst in
let%bind tv = let%bind tv =
@ -613,7 +638,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
ae.location) ae.location)
@@ assert_t_unit (get_type_annotation mf') in @@ assert_t_unit (get_type_annotation mf') in
let mt' = make_a_e let mt' = make_a_e
(E_constant ("ASSERT" , [ex' ; fw'])) (E_constant ("ASSERT_INFERRED" , [ex' ; fw']))
(t_unit ()) (t_unit ())
e e
in in
@ -738,7 +763,7 @@ and type_constant (name:string) (lst:O.type_value list) (tv_opt:O.type_value opt
let%bind typer = let%bind typer =
trace_option (unrecognized_constant name loc) @@ trace_option (unrecognized_constant name loc) @@
Map.String.find_opt name ct in Map.String.find_opt name ct in
trace (constant_error loc) @@ trace (constant_error loc lst tv_opt) @@
typer lst tv_opt typer lst tv_opt
let untype_type_value (t:O.type_value) : (I.type_expression) result = let untype_type_value (t:O.type_value) : (I.type_expression) result =
@ -752,6 +777,7 @@ let untype_literal (l:O.literal) : I.literal result =
| Literal_unit -> ok Literal_unit | Literal_unit -> ok Literal_unit
| Literal_bool b -> ok (Literal_bool b) | Literal_bool b -> ok (Literal_bool b)
| Literal_nat n -> ok (Literal_nat n) | Literal_nat n -> ok (Literal_nat n)
| Literal_timestamp n -> ok (Literal_timestamp n)
| Literal_tez n -> ok (Literal_tez n) | Literal_tez n -> ok (Literal_tez n)
| Literal_int n -> ok (Literal_int n) | Literal_int n -> ok (Literal_int n)
| Literal_string s -> ok (Literal_string s) | Literal_string s -> ok (Literal_string s)
@ -803,6 +829,9 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
| E_list lst -> | E_list lst ->
let%bind lst' = bind_map_list untype_expression lst in let%bind lst' = bind_map_list untype_expression lst in
return (e_list lst') return (e_list lst')
| E_set lst ->
let%bind lst' = bind_map_list untype_expression lst in
return (e_set lst')
| E_look_up dsi -> | E_look_up dsi ->
let%bind (a , b) = bind_map_pair untype_expression dsi in let%bind (a , b) = bind_map_pair untype_expression dsi in
return (e_look_up a b) return (e_look_up a b)

View File

@ -1,6 +1,8 @@
(library (library
(name simple_utils) (name simple_utils)
(public_name simple-utils) (public_name simple-utils)
(preprocess
(pps simple-utils.ppx_let_generalized))
(libraries (libraries
yojson yojson
unix unix

View File

@ -1,3 +1,213 @@
(** Trace tutorial
The module below guides the reader through the writing of a
simplified version of the trace monad (`result`), and the
definition of a few operations that make it easier to work with
`result`.
*)
module Trace_tutorial = struct
(** The trace monad is fairly similar to the option type: *)
type 'a option =
Some of 'a (* Ok also stores a list of annotations *)
| None;; (* Errors also stores a list of messages *)
type annotation = string;;
type error = string;;
type 'a result =
Ok of 'a * annotation list
| Errors of error list;;
(** When applying a partial function on a result, it can return a valid result
(Some v), or indicate failure (None). *)
let divide a b =
if b = 0
then None
else Some (a/b);;
(** With the trace monad, the Errors case also indicates some information about
the failure, to ease debugging. *)
let divide_trace a b =
if b = 0
then (Errors [Printf.sprintf "division by zero: %d / %d" a b])
else Ok ((a/b) , []);;
(** when composing two functions, the error case is propagated. *)
let divide_three a b c =
let maybe_a_div_b = divide_trace a b in
match maybe_a_div_b with
Ok (a_div_b , _) -> divide_trace a_div_b c
| (Errors _) as e -> e;;
(** If both calls are successful, the lists of annotations are concatenated. *)
let divide_three_annots a b c =
let maybe_a_div_b = divide_trace a b in
match maybe_a_div_b with
Ok (a_div_b , annots1) ->
let maybe_a_div_b_div_c = divide_trace a_div_b c in
begin
match maybe_a_div_b_div_c with
Ok (a_div_b_div_c , annots2)
-> Ok (a_div_b_div_c , annots2 @ annots1)
| (Errors _) as e2 -> e2
end
| (Errors _) as e1 -> e1;;
(** This incurs quite a lot of noise, so we define a `bind` operator which
takes a function ('x -> ('y result)) and applies it to an existing
('x result).
* If the existing result is Errors, `bind` returns that error without
calling the function
* Otherwise `bind` unwraps the Ok and calls the function
* That function may itself return an error
* Otherwise `bind` combines the annotations and returns the second
result. *)
let bind f = function
| Ok (x, annotations) ->
(match f x with
Ok (x', annotations') -> Ok (x', annotations' @ annotations)
| Errors _ as e' -> ignore annotations; e')
| Errors _ as e -> e;;
(** The following function divide_three_bind is equivalent to the verbose
divide_three. *)
let divide_three_bind a b c =
let maybe_a_div_b = divide_trace a b in
let continuation a_div_b = divide_trace a_div_b c in
bind continuation maybe_a_div_b;;
(** This made the code shorter, but the reading order is a bit awkward.
We define an operator symbol for `bind`: *)
let (>>?) x f = bind f x;;
let divide_three_bind_symbol a b c =
let maybe_a_div_b = divide_trace a b in
let continuation a_div_b = divide_trace a_div_b c in
maybe_a_div_b >>? continuation;;
(** and we inline the two temporary let definitions: *)
let divide_three_bind_symbol' a b c =
divide_trace a b >>? (fun a_div_b -> divide_trace a_div_b c);;
(** This is now fairly legible, but chaining many such functions is
not the usual way of writing code. We use ppx_let to add some
syntactic sugar.
The ppx is enabled by adding the following lines inside the
section (library ) or (executable ) of the dune file for
the project that uses ppx_let.
(preprocess
(pps simple-utils.ppx_let_generalized))
*)
module Let_syntax = struct
let bind m ~f = m >>? f
module Open_on_rhs_bind = struct end
end;;
(** divide_three_bind_ppx_let is equivalent to divide_three_bind_symbol'.
Strictly speaking, the only difference is that the module
Open_on_rhs_bind is opened around the expression on the righ-hand side
of the `=` sign, namely `divide_trace a b` *)
let divide_three_bind_ppx_let a b c =
let%bind a_div_b = divide_trace a b in
divide_trace a_div_b c;;
(** This notation scales fairly well: *)
let divide_many_bind_ppx_let a b c d e f =
let x = a in
let%bind x = divide_trace x b in
let%bind x = divide_trace x c in
let%bind x = divide_trace x d in
let%bind x = divide_trace x e in
let%bind x = divide_trace x f in
Ok (x , []);;
(** We define a couple of shorthands for common use cases.
`ok` lifts a ('foo) value to a ('foo result): *)
let ok x = Ok (x, []);;
(** `map` lifts a regular ('foo -> 'bar) function on values
to a function on results, with type ('foo result -> 'bar result): *)
let map f = function
| Ok (x, annotations) -> Ok (f x, annotations)
| Errors _ as e -> e;;
(** `bind_list` turns a (('foo result) list) into a (('foo list) result).
If the list only contains Ok values, it strips the Ok returns that list
wrapped with Ok.
Otherwise, when one or more of the elements of the original list is
Errors, `bind_list` returns the first error in the list. *)
let rec bind_list = function
| [] -> ok []
| hd :: tl -> (
hd >>? fun hd ->
bind_list tl >>? fun tl ->
ok @@ hd :: tl
);;
(**
A major feature of Trace is that it enables having a stack of errors (that
should act as a simplified stack frame), rather than a unique error.
It is done by using the function `trace`.
For instance, let's say that you have a function that can trigger two errors,
and you want to pass their data along with an other error, what you would
usually do is:
```
let foobarer ... =
... in
let value =
try ( get key map )
with
| Bad_key _ -> raise (Foobar_error ("bad key" , key , map))
| Missing_value _ -> raise (Foobar_error ("missing index" , key , map))
in ...
```
With Trace, you would instead:
```
let foobarer ... =
... in
let%bind value =
trace (simple_error "error getting key") @@
get key map
in ...
```
And this will pass along the error triggered by "get key map".
*)
let trace err = function
| Ok _ as o -> o
| Errors errs -> Errors (err :: errs);;
(** The real trace monad is very similar to the one that we have
defined above. The main difference is that the errors and
annotations are structured data (instead of plain strings) and are
lazily-generated. *)
let the_end = "End of the tutorial.";;
end (* end Trace_tutorial. *)
module J = Yojson.Basic module J = Yojson.Basic
module JSON_string_utils = struct module JSON_string_utils = struct
@ -208,34 +418,6 @@ let internal_assertion_failure str = simple_error ("assertion failed: " ^ str)
*) *)
let dummy_fail = simple_fail "dummy" let dummy_fail = simple_fail "dummy"
(**
A major feature of Trace is that it enables having a stack of errors (that
should act as a simplified stack frame), rather than a unique error.
It is done by using the function `trace`.
For instance, let's say that you have a function that can trigger two errors,
and you want to pass their data along with an other error, what you would
usually do is:
```
let foobarer ... =
... in
let value =
try ( get key map )
with
| Bad_key _ -> raise (Foobar_error ("bad key" , key , map))
| Missing_value _ -> raise (Foobar_error ("missing index" , key , map))
in ...
```
With Trace, you would instead:
```
let foobarer ... =
... in
let%bind value =
trace (simple_error "error getting key") @@
get key map
in ...
```
And this will pass along the error triggered by "get key map".
*)
let trace info = function let trace info = function
| Ok _ as o -> o | Ok _ as o -> o
| Error err -> Error (fun () -> prepend_info (info ()) (err ())) | Error err -> Error (fun () -> prepend_info (info ()) (err ()))

View File

@ -47,6 +47,7 @@ let i_push_unit = i_push t_unit d_unit
let i_push_string str = i_push t_string (string str) let i_push_string str = i_push t_string (string str)
let i_none ty = prim ~children:[ty] I_NONE let i_none ty = prim ~children:[ty] I_NONE
let i_nil ty = prim ~children:[ty] I_NIL let i_nil ty = prim ~children:[ty] I_NIL
let i_empty_set ty = prim ~children:[ty] I_EMPTY_SET
let i_some = prim I_SOME let i_some = prim I_SOME
let i_lambda arg ret body = prim ~children:[arg;ret;body] I_LAMBDA let i_lambda arg ret body = prim ~children:[arg;ret;body] I_LAMBDA
let i_empty_map src dst = prim ~children:[src;dst] I_EMPTY_MAP let i_empty_map src dst = prim ~children:[src;dst] I_EMPTY_MAP