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

Merge branch 'dev' of gitlab.com:ligolang/ligo into test/cameligo-test-parity

Browse Source
This commit is contained in:
John David Pressman 2019-10-29 22:06:42 -07:00
commit 750605cee4
78 changed files with 978 additions and 263 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gitlab-pages/docs/language-basics/cheat-sheet.md
View File

@ -17,7 +17,7 @@ title: Cheat Sheet
|Unit| `unit`|
|Boolean|<pre><code>const hasDriversLicense: bool = False;<br/>const adult: bool = True;</code></pre> |
|Boolean Logic|<pre><code>(not True) == False == (False and True) == (False or False)</code></pre>|
|Mutez (micro tez)| `42mtz`, `7mtz` |
|Mutez (micro tez)| `42mutez`, `7mutez` |
|Address | `"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"`, `"KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD"`|
|Addition |`3 + 4`, `3n + 4n`|
|Multiplication & Division| `3 * 4`, `3n * 4n`, `10 / 5`, `10n / 5n`|
@ -35,11 +35,12 @@ title: Cheat Sheet
|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];<br/><br/>prices[200n] := 5mtz;</code></pre>|
|Maps|<pre><code>type prices is map(nat, tez);<br/><br/>const prices : prices = map<br/>&nbsp;&nbsp;10n -> 60mutez;<br/>&nbsp;&nbsp;50n -> 30mutez;<br/>&nbsp;&nbsp;100n -> 10mutez;<br/>end<br/><br/>const price: option(tez) = prices[50n];<br/><br/>prices[200n] := 5mutez;</code></pre>|
|Contracts & Accounts|<pre><code>const destinationAddress : address = "tz1...";<br/>const contract : contract(unit) = get_contract(destinationAddress);</code></pre>|
|Transactions|<pre><code>const payment : operation = transaction(unit, amount, receiver);</code></pre>|
|Exception/Failure|`fail("Your descriptive error message for the user goes here.")`|
<!--END_DOCUSAURUS_CODE_TABS-->
</div>
</div>

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

@ -31,7 +31,7 @@ const dogBreed: animalBreed = "Saluki";
type accountBalances is map(address, tez);
const ledger: accountBalances = map
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> 10mtz
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> 10mutez
end
```
@ -60,10 +60,10 @@ end
type accountBalances is map(account, accountData);
// pseudo-JSON representation of our map
// { "tz1...": {balance: 10mtz, numberOfTransactions: 5n} }
// { "tz1...": {balance: 10mutez, numberOfTransactions: 5n} }
const ledger: accountBalances = map
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> record
balance = 10mtz;
balance = 10mutez;
numberOfTransactions = 5n;
end
end

4
gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md
View File

@ -134,11 +134,11 @@ To confirm that our contract is valid, we can dry run it. As a result we see a *
ligo dry-run taco-shop.ligo --syntax pascaligo --amount 1 buy_taco 1n "map
1n -> record
current_stock = 50n;
max_price = 50000000mtz;
max_price = 50000000mutez;
end;
2n -> record
current_stock = 20n;
max_price = 75000000mtz;
max_price = 75000000mutez;
end;
end"
```

28
gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-smart-contract.md
View File

@ -28,8 +28,8 @@ Each taco kind, has its own `max_price` that it sells for, and a finite supply f
|**kind** |id |**available_stock**| **max_price**|
|---|---|---|---|
|el clásico | `1n` | `50n` | `50000000mtz` |
|especial del chef | `2n` | `20n` | `75000000mtz` |
|el clásico | `1n` | `50n` | `50000000mutez` |
|especial del chef | `2n` | `20n` | `75000000mutez` |
### Calculating the current purchase price
@ -42,16 +42,16 @@ 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` |
| `50n` | `50000000mutez` | `1tz`|
| `20n` | `50000000mutez` | `2.5tz` |
| `5n` | `50000000mutez` | `10tz` |
#### Especial del chef
|**available_stock**|**max_price**|**current_purchase_price**|
|---|---|---|
| `20n` | `75000000mtz` | `3.75tz` |
| `10n` | `75000000mtz` | `7.5tz`|
| `5n` | `75000000mtz` | `15tz` |
| `20n` | `75000000mutez` | `3.75tz` |
| `10n` | `75000000mutez` | `7.5tz`|
| `5n` | `75000000mutez` | `15tz` |
---
@ -161,11 +161,11 @@ When dry-running a contract, it's crucial to provide a correct initial storage v
map
1n -> record
current_stock = 50n;
max_price = 50000000mtz;
max_price = 50000000mutez;
end;
2n -> record
current_stock = 20n;
max_price = 75000000mtz;
max_price = 75000000mutez;
end;
end
```
@ -177,11 +177,11 @@ end
ligo dry-run taco-shop.ligo --syntax pascaligo main unit "map
1n -> record
current_stock = 50n;
max_price = 50000000mtz;
max_price = 50000000mutez;
end;
2n -> record
current_stock = 20n;
max_price = 75000000mtz;
max_price = 75000000mutez;
end;
end"
```
@ -298,11 +298,11 @@ In order to test the `amount` sent, we'll use the `--amount` option of `dry-run`
ligo dry-run taco-shop.ligo --syntax pascaligo --amount 1 buy_taco 1n "map
1n -> record
current_stock = 50n;
max_price = 50000000mtz;
max_price = 50000000mutez;
end;
2n -> record
current_stock = 20n;
max_price = 75000000mtz;
max_price = 75000000mutez;
end;
end"
```

2
gitlab-pages/website/pages/en/index.js
View File

@ -190,7 +190,7 @@ class HomeSplash extends React.Component {
<h4 className="tagline-text">{siteConfig.tagline}</h4>
<p className="body">{siteConfig.taglineSub}</p>
<LinkButton
href="https://ligolang.gitlab.io/ligo-web-ide/"
href="https://ide.ligolang.org/"
className="large-primary-button"
>
Try Online

84
scripts/install_build_environment.sh
View File

@ -18,50 +18,76 @@ then
fi
fi
echo "Installing dependencies.."
if [ -n "`uname -a | grep -i arch`" ]
then
sudo pacman -Sy --noconfirm \
make \
m4 \
gcc \
patch \
bubblewrap \
rsync \
curl
fi
if [ -n "`uname -a | grep -i ubuntu`" ]
then
sudo apt-get install -y make \
m4 \
gcc \
patch \
bubblewrap \
rsync \
curl \
curl
fi
if [ -n "`uname -a | grep -i ubuntu`" ]
then
echo "ubuntu"
sudo add-apt-repository -y ppa:avsm/ppa
sudo apt-get update
sudo apt-get install opam
else
# I'm going to assume here that we're on x86_64, 32-bit users should be basically
# extinct at this point right?
curl -L https://github.com/ocaml/opam/releases/download/2.0.4/opam-2.0.4-x86_64-linux \
--output opam_temp_version_2_0_4.bin
if [ "`openssl sha256 -r opam_temp_version_2_0_4.bin`" = "373e34f92f282273d482537f8103caad0d17b6f2699ff504bed77f474cb0c951 *opam_temp_version_2_0_4.bin" ]
if [ -n "`uname -a | grep -i arch`" ]
then
# Stay paranoid, in case other checks fail don't want to overrwrite
# user's opam on accident
chmod +x opam_temp_version_2_0_4.bin # Set execute so we can get version
if [ -e /usr/local/bin/opam ]
then
opam_old_v=`/usr/local/bin/opam --version`
opam_new_v=`opam_temp_version_2_0_4.bin --version`
read -p "This will overrwrite the opam you have in /usr/local/bin (version $opam_old_v) with version $opam_new_v, do you actually want to do that? Type yes. (yes/n)" choice2
else
choice2="yes"
fi
if [ $choice2 = "yes" ]
then
sudo mv opam_temp_version_2_0_4.bin /usr/local/bin/opam
else
rm opam_temp_version_2_0_4.bin
exit
fi
echo "arch"
sudo pacman -Sy --noconfirm opam
else
echo "opam file hash doesn't match what was recorded at time of signature verification!"
echo "(If you actually get this message, you should probably file an issue)"
echo "https://gitlab.com/ligolang/ligo/issues"
exit 1
fi
echo "unknown distro"
#I'm going to assume here that we're on x86_64, 32-bit users should be basically
#extinct at this point right?
curl -L https://github.com/ocaml/opam/releases/download/2.0.4/opam-2.0.4-x86_64-linux \
--output opam_temp_version_2_0_4.bin
if [ "`openssl sha256 -r opam_temp_version_2_0_4.bin`" = "373e34f92f282273d482537f8103caad0d17b6f2699ff504bed77f474cb0c951 *opam_temp_version_2_0_4.bin" ]
then
# Stay paranoid, in case other checks fail don't want to overrwrite
# user's opam on accident
chmod +x opam_temp_version_2_0_4.bin # Set execute so we can get version
if [ -e /usr/local/bin/opam ]
then
opam_old_v=`/usr/local/bin/opam --version`
opam_new_v=`opam_temp_version_2_0_4.bin --version`
read -p "This will overrwrite the opam you have in /usr/local/bin (version $opam_old_v) with version $opam_new_v, do you actually want to do that? Type yes. (yes/n)" choice2
else
choice2="yes"
fi
if [ $choice2 = "yes" ]
then
sudo mv opam_temp_version_2_0_4.bin /usr/local/bin/opam
else
rm opam_temp_version_2_0_4.bin
exit
fi
else
echo "opam file hash doesn't match what was recorded at time of signature verification!"
echo "(If you actually get this message, you should probably file an issue)"
echo "https://gitlab.com/ligolang/ligo/issues"
exit 1
fi
fi
fi
opam init -a --bare

39
scripts/install_native_dependencies.sh
View File

@ -1,14 +1,31 @@
#!/bin/sh
set -e
. /etc/os-release
apt-get update -qq
apt-get -y -qq install \
libev-dev \
perl \
pkg-config \
libgmp-dev \
libhidapi-dev \
m4 \
libcap-dev \
bubblewrap \
rsync
if [ $ID = arch ]
then
pacman -Sy
sudo pacman -S --noconfirm \
libevdev \
perl \
pkg-config \
gmp \
hidapi \
m4 \
libcap \
bubblewrap \
rsync
else
apt-get update -qq
apt-get -y -qq install \
libev-dev \
perl \
pkg-config \
libgmp-dev \
libhidapi-dev \
m4 \
libcap-dev \
bubblewrap \
rsync
fi

2
scripts/setup_switch.sh
View File

@ -2,5 +2,5 @@
set -e
set -x
printf '' | opam switch create . 4.07.1 # toto ocaml-base-compiler.4.06.1
printf '' | opam switch create . ocaml-base-compiler.4.07.1 # toto ocaml-base-compiler.4.06.1
eval $(opam config env)

4
src/passes/1-parser/ligodity/AST.ml
View File

@ -260,7 +260,7 @@ and arith_expr =
| Neg of minus un_op reg
| Int of (string * Z.t) reg
| Nat of (string * Z.t) reg
| Mtz of (string * Z.t) reg
| Mutez of (string * Z.t) reg
and logic_expr =
BoolExpr of bool_expr
@ -391,7 +391,7 @@ let logic_expr_to_region = function
let arith_expr_to_region = function
Add {region;_} | Sub {region;_} | Mult {region;_}
| Div {region;_} | Mod {region;_} | Neg {region;_}
| Int {region;_} | Mtz {region; _}
| Int {region;_} | Mutez {region; _}
| Nat {region; _} -> region
let string_expr_to_region = function

2
src/passes/1-parser/ligodity/AST.mli
View File

@ -265,7 +265,7 @@ and arith_expr =
| Neg of minus un_op reg (* -e *)
| Int of (string * Z.t) reg (* 12345 *)
| Nat of (string * Z.t) reg (* 3p *)
| Mtz of (string * Z.t) reg (* 1.00tz 3tz *)
| Mutez of (string * Z.t) reg (* 1.00tz 3tz *)
and logic_expr =
BoolExpr of bool_expr

4
src/passes/1-parser/ligodity/LexToken.mli
View File

@ -82,7 +82,7 @@ type t =
| Constr of string Region.reg
| Int of (string * Z.t) Region.reg
| Nat of (string * Z.t) Region.reg
| Mtz of (string * Z.t) Region.reg
| Mutez of (string * Z.t) Region.reg
| Str of string Region.reg
| Bytes of (string * Hex.t) Region.reg
@ -145,7 +145,7 @@ type sym_err = Invalid_symbol
val mk_int : lexeme -> Region.t -> (token, int_err) result
val mk_nat : lexeme -> Region.t -> (token, nat_err) result
val mk_mtz : lexeme -> Region.t -> (token, int_err) result
val mk_mutez : lexeme -> Region.t -> (token, int_err) result
val mk_ident : lexeme -> Region.t -> (token, ident_err) result
val mk_sym : lexeme -> Region.t -> (token, sym_err) result
val mk_string : lexeme -> Region.t -> token

19
src/passes/1-parser/ligodity/LexToken.mll
View File

@ -64,7 +64,7 @@ type t =
| Constr of string Region.reg
| Int of (string * Z.t) Region.reg
| Nat of (string * Z.t) Region.reg
| Mtz of (string * Z.t) Region.reg
| Mutez of (string * Z.t) Region.reg
| Str of string Region.reg
| Bytes of (string * Hex.t) Region.reg
@ -141,8 +141,8 @@ let proj_token = function
region, sprintf "Int (\"%s\", %s)" s (Z.to_string n)
| Nat Region.{region; value = s,n} ->
region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n)
| Mtz Region.{region; value = s,n} ->
region, sprintf "Mtz (\"%s\", %s)" s (Z.to_string n)
| Mutez Region.{region; value = s,n} ->
region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n)
| Str Region.{region; value} ->
region, sprintf "Str %s" value
| Bytes Region.{region; value = s,b} ->
@ -202,7 +202,7 @@ let to_lexeme = function
| Constr id -> id.Region.value
| Int i
| Nat i
| Mtz i -> fst i.Region.value
| Mutez i -> fst i.Region.value
| Str s -> s.Region.value
| Bytes b -> fst b.Region.value
| Begin _ -> "begin"
@ -280,12 +280,9 @@ let reserved =
|> add "functor"
|> add "inherit"
|> add "initializer"
|> add "land"
|> add "lazy"
|> add "lor"
|> add "lsl"
|> add "lsr"
|> add "lxor"
|> add "method"
|> add "module"
|> add "mutable"
@ -396,14 +393,14 @@ let mk_nat lexeme region =
else Ok (Nat Region.{region; value = lexeme, z})
)
let mk_mtz lexeme region =
let mk_mutez lexeme region =
let z =
Str.(global_replace (regexp "_") "" lexeme) |>
Str.(global_replace (regexp "mtz") "") |>
Str.(global_replace (regexp "mutez") "") |>
Z.of_string in
if Z.equal z Z.zero && lexeme <> "0mtz"
if Z.equal z Z.zero && lexeme <> "0mutez"
then Error Non_canonical_zero
else Ok (Mtz Region.{region; value = lexeme, z})
else Ok (Mutez Region.{region; value = lexeme, z})
let eof region = EOF region

2
src/passes/1-parser/ligodity/ParToken.mly
View File

@ -42,7 +42,7 @@
%token <(string * Z.t) Region.reg> Int
%token <(string * Z.t) Region.reg> Nat
%token <(string * Z.t) Region.reg> Mtz
%token <(string * Z.t) Region.reg> Mutez
(*%token And*)
%token <Region.t> Begin

2
src/passes/1-parser/ligodity/Parser.mly
View File

@ -761,7 +761,7 @@ call_expr:
core_expr:
Int { EArith (Int $1) }
| Mtz { EArith (Mtz $1) }
| Mutez { EArith (Mutez $1) }
| Nat { EArith (Nat $1) }
| Ident | module_field { EVar $1 }
| projection { EProj $1 }

4
src/passes/1-parser/ligodity/ParserLog.ml
View File

@ -321,8 +321,8 @@ and print_arith_expr buffer = function
| Int {region; value=lex,z} ->
let line = sprintf "Int %s (%s)" lex (Z.to_string z)
in print_token buffer region line
| Mtz {region; value=lex,z} ->
let line = sprintf "Mtz %s (%s)" lex (Z.to_string z)
| Mutez {region; value=lex,z} ->
let line = sprintf "Mutez %s (%s)" lex (Z.to_string z)
in print_token buffer region line
| Nat {region; value=lex,z} ->
let line = sprintf "Nat %s (%s)" lex (Z.to_string z)

8
src/passes/1-parser/pascaligo/AST.ml
View File

@ -284,7 +284,7 @@ and var_decl = {
and instruction =
Cond of conditional reg
| CaseInstr of instruction case reg
| CaseInstr of if_clause case reg
| Assign of assignment reg
| Loop of loop
| ProcCall of fun_call
@ -497,6 +497,7 @@ and closing =
and map_expr =
MapLookUp of map_lookup reg
| MapInj of binding reg injection reg
| BigMapInj of binding reg injection reg
and map_lookup = {
path : path;
@ -546,7 +547,7 @@ and arith_expr =
| Neg of minus un_op reg
| Int of (Lexer.lexeme * Z.t) reg
| Nat of (Lexer.lexeme * Z.t) reg
| Mtz of (Lexer.lexeme * Z.t) reg
| Mutez of (Lexer.lexeme * Z.t) reg
and string_expr =
Cat of cat bin_op reg
@ -654,6 +655,7 @@ and tuple_expr_to_region {region; _} = region
and map_expr_to_region = function
MapLookUp {region; _}
| MapInj {region; _} -> region
| BigMapInj {region; _} -> region
and set_expr_to_region = function
SetInj {region; _}
@ -687,7 +689,7 @@ and arith_expr_to_region = function
| Neg {region; _}
| Int {region; _}
| Nat {region; _}
| Mtz {region; _} -> region
| Mutez {region; _} -> region
and string_expr_to_region = function
Cat {region; _}

5
src/passes/1-parser/pascaligo/AST.mli
View File

@ -275,7 +275,7 @@ and var_decl = {
and instruction =
Cond of conditional reg
| CaseInstr of instruction case reg
| CaseInstr of if_clause case reg
| Assign of assignment reg
| Loop of loop
| ProcCall of fun_call
@ -488,6 +488,7 @@ and closing =
and map_expr =
MapLookUp of map_lookup reg
| MapInj of binding reg injection reg
| BigMapInj of binding reg injection reg
and map_lookup = {
path : path;
@ -537,7 +538,7 @@ and arith_expr =
| Neg of minus un_op reg
| Int of (Lexer.lexeme * Z.t) reg
| Nat of (Lexer.lexeme * Z.t) reg
| Mtz of (Lexer.lexeme * Z.t) reg
| Mutez of (Lexer.lexeme * Z.t) reg
and string_expr =
Cat of cat bin_op reg

10
src/passes/1-parser/pascaligo/Doc/pascaligo.md
View File

@ -340,10 +340,10 @@ and the canonical form of zero is `0n`.
* The last kind of native numerical type is `tez`, which is a unit of
measure of the amounts (fees, accounts). Beware: the literals of the
type `tez` are annotated with the suffix `mtz`, which stands for
millionth of Tez, for instance, `0mtz` or `1200000mtz`. The same handy
use of underscores as in natural literals help in the writing, like
`1_200_000mtz`.
type `tez` are annotated with the suffix `mutez`, which stands for
millionth of Tez, for instance, `0mutez` or `1200000mutez`. The same
handy use of underscores as in natural literals help in the writing,
like `1_200_000mutez`.
To see how numerical types can be used in expressions see the sections
"Predefined operators" and "Predefined values".
@ -832,7 +832,7 @@ example, in verbose style:
A value of that type could be
record
goal = 10mtz;
goal = 10mutez;
deadline = "...";
backers = map end;
funded = False

2
src/passes/1-parser/pascaligo/Doc/pascaligo_01.bnf
View File

@ -331,7 +331,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| var
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_02.bnf
View File

@ -337,7 +337,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| var
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_03.bnf
View File

@ -317,7 +317,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_04.bnf
View File

@ -295,7 +295,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_05.bnf
View File

@ -289,7 +289,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_06.bnf
View File

@ -292,7 +292,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_07.bnf
View File

@ -279,7 +279,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_08.bnf
View File

@ -284,7 +284,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_09.bnf
View File

@ -288,7 +288,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_10.bnf
View File

@ -283,7 +283,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_11.bnf
View File

@ -281,7 +281,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) brackets(expr) (* lookup *)

2
src/passes/1-parser/pascaligo/Doc/pascaligo_12.bnf
View File

@ -285,7 +285,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_13.bnf
View File

@ -285,7 +285,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_14.bnf
View File

@ -285,7 +285,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_15.bnf
View File

@ -285,7 +285,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_16.bnf
View File

@ -285,7 +285,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_17.bnf
View File

@ -285,7 +285,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_18.bnf
View File

@ -285,7 +285,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_19.bnf
View File

@ -285,7 +285,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_20.bnf
View File

@ -270,7 +270,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident (* var *)
| Ident (* var *) brackets(expr) (* lookup *)
| Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr))

2
src/passes/1-parser/pascaligo/Doc/pascaligo_21.bnf
View File

@ -291,7 +291,7 @@ unary_expr ::=
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident option(core_suffix)
| String
| Bytes

2
src/passes/1-parser/pascaligo/Doc/pascaligo_22.bnf
View File

@ -349,7 +349,7 @@ XXX
core_expr ::=
Int
| Nat
| Mtz
| Mutez
| Ident option(core_suffix)
| String
| Bytes

4
src/passes/1-parser/pascaligo/LexToken.mli
View File

@ -35,7 +35,7 @@ type t =
| Bytes of (lexeme * Hex.t) Region.reg
| Int of (lexeme * Z.t) Region.reg
| Nat of (lexeme * Z.t) Region.reg
| Mtz of (lexeme * Z.t) Region.reg
| Mutez of (lexeme * Z.t) Region.reg
| Ident of lexeme Region.reg
| Constr of lexeme Region.reg
@ -145,7 +145,7 @@ type sym_err = Invalid_symbol
val mk_int : lexeme -> Region.t -> (token, int_err) result
val mk_nat : lexeme -> Region.t -> (token, nat_err) result
val mk_mtz : lexeme -> Region.t -> (token, int_err) result
val mk_mutez : lexeme -> Region.t -> (token, int_err) result
val mk_ident : lexeme -> Region.t -> (token, ident_err) result
val mk_sym : lexeme -> Region.t -> (token, sym_err) result
val mk_string : lexeme -> Region.t -> token

16
src/passes/1-parser/pascaligo/LexToken.mll
View File

@ -33,7 +33,7 @@ type t =
| Bytes of (lexeme * Hex.t) Region.reg
| Int of (lexeme * Z.t) Region.reg
| Nat of (lexeme * Z.t) Region.reg
| Mtz of (lexeme * Z.t) Region.reg
| Mutez of (lexeme * Z.t) Region.reg
| Ident of lexeme Region.reg
| Constr of lexeme Region.reg
@ -160,8 +160,8 @@ let proj_token = function
| Nat Region.{region; value = s,n} ->
region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n)
| Mtz Region.{region; value = s,n} ->
region, sprintf "Mtz (\"%s\", %s)" s (Z.to_string n)
| Mutez Region.{region; value = s,n} ->
region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n)
| Ident Region.{region; value} ->
region, sprintf "Ident \"%s\"" value
@ -258,7 +258,7 @@ let to_lexeme = function
| Bytes b -> fst b.Region.value
| Int i
| Nat i
| Mtz i -> fst i.Region.value
| Mutez i -> fst i.Region.value
| Ident id
| Constr id -> id.Region.value
@ -497,14 +497,14 @@ let mk_nat lexeme region =
else Ok (Nat Region.{region; value = lexeme, z})
)
let mk_mtz lexeme region =
let mk_mutez lexeme region =
let z =
Str.(global_replace (regexp "_") "" lexeme) |>
Str.(global_replace (regexp "mtz") "") |>
Str.(global_replace (regexp "mutez") "") |>
Z.of_string in
if Z.equal z Z.zero && lexeme <> "0mtz"
if Z.equal z Z.zero && lexeme <> "0mutez"
then Error Non_canonical_zero
else Ok (Mtz Region.{region; value = lexeme, z})
else Ok (Mutez Region.{region; value = lexeme, z})
let eof region = EOF region

2
src/passes/1-parser/pascaligo/ParToken.mly
View File

@ -9,7 +9,7 @@
%token <(LexToken.lexeme * Hex.t) Region.reg> Bytes
%token <(LexToken.lexeme * Z.t) Region.reg> Int
%token <(LexToken.lexeme * Z.t) Region.reg> Nat
%token <(LexToken.lexeme * Z.t) Region.reg> Mtz
%token <(LexToken.lexeme * Z.t) Region.reg> Mutez
%token <LexToken.lexeme Region.reg> Ident
%token <LexToken.lexeme Region.reg> Constr

5
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -566,7 +566,7 @@ clause_block:
ShortBlock {value; region} }
case_instr:
case(instruction) { $1 instr_to_region }
case(if_clause) { $1 if_clause_to_region }
case(rhs):
Case expr Of option(VBAR) cases(rhs) End {
@ -856,7 +856,7 @@ unary_expr:
core_expr:
Int { EArith (Int $1) }
| Nat { EArith (Nat $1) }
| Mtz { EArith (Mtz $1) }
| Mutez { EArith (Mutez $1) }
| var { EVar $1 }
| String { EString (String $1) }
| Bytes { EBytes $1 }
@ -899,6 +899,7 @@ set_expr:
map_expr:
map_lookup { MapLookUp $1 }
| injection(Map,binding) { MapInj $1 }
| injection(BigMap,binding) { BigMapInj $1 }
map_lookup:
path brackets(expr) {

19
src/passes/1-parser/pascaligo/ParserLog.ml
View File

@ -295,7 +295,7 @@ and print_clause_block buffer = function
print_terminator buffer terminator;
print_token buffer rbrace "}"
and print_case_instr buffer (node : instruction case) =
and print_case_instr buffer (node : if_clause case) =
let {kwd_case; expr; opening;
lead_vbar; cases; closing} = node in
print_token buffer kwd_case "case";
@ -314,9 +314,9 @@ and print_cases_instr buffer {value; _} =
and print_case_clause_instr buffer {value; _} =
let {pattern; arrow; rhs} = value in
print_pattern buffer pattern;
print_token buffer arrow "->";
print_instruction buffer rhs
print_pattern buffer pattern;
print_token buffer arrow "->";
print_if_clause buffer rhs
and print_assignment buffer {value; _} =
let {lhs; assign; rhs} = value in
@ -431,6 +431,7 @@ and print_case_clause_expr buffer {value; _} =
and print_map_expr buffer = function
MapLookUp {value; _} -> print_map_lookup buffer value
| MapInj inj -> print_injection buffer "map" print_binding inj
| BigMapInj inj -> print_injection buffer "big_map" print_binding inj
and print_set_expr buffer = function
SetInj inj -> print_injection buffer "set" print_expr inj
@ -526,7 +527,7 @@ and print_arith_expr buffer = function
print_expr buffer arg
| Int i
| Nat i
| Mtz i -> print_int buffer i
| Mutez i -> print_int buffer i
and print_string_expr buffer = function
Cat {value = {arg1; op; arg2}; _} ->
@ -921,7 +922,7 @@ and pp_instruction buffer ~pad:(_,pc as pad) = function
pp_conditional buffer ~pad value
| CaseInstr {value; _} ->
pp_node buffer ~pad "CaseInstr";
pp_case pp_instruction buffer ~pad value
pp_case pp_if_clause buffer ~pad value
| Assign {value; _} ->
pp_node buffer ~pad "Assign";
pp_assignment buffer ~pad value
@ -1390,8 +1391,8 @@ and pp_arith_expr buffer ~pad:(_,pc as pad) = function
| Nat {value; _} ->
pp_node buffer ~pad "Nat";
pp_int buffer ~pad value
| Mtz {value; _} ->
pp_node buffer ~pad "Mtz";
| Mutez {value; _} ->
pp_node buffer ~pad "Mutez";
pp_int buffer ~pad value
and pp_set_expr buffer ~pad:(_,pc as pad) = function
@ -1461,7 +1462,7 @@ and pp_map_expr buffer ~pad = function
MapLookUp {value; _} ->
pp_node buffer ~pad "MapLookUp";
pp_map_lookup buffer ~pad value
| MapInj {value; _} ->
| MapInj {value; _} | BigMapInj {value; _} ->
pp_node buffer ~pad "MapInj";
pp_injection pp_binding buffer ~pad value

2
src/passes/1-parser/pascaligo/SParser.ml
View File

@ -312,7 +312,7 @@ and unary_expr = parser
and core_expr = parser
[< 'Int _ >] -> ()
| [< 'Nat _ >] -> ()
| [< 'Mtz _ >] -> ()
| [< 'Mutez _ >] -> ()
| [< 'Ident _; _ = opt core_suffix >] -> ()
| [< 'String _ >] -> ()
| [< 'Bytes _ >] -> ()

2
src/passes/1-parser/shared/Lexer.mli
View File

@ -70,7 +70,7 @@ module type TOKEN =
val mk_int : lexeme -> Region.t -> (token, int_err) result
val mk_nat : lexeme -> Region.t -> (token, nat_err) result
val mk_mtz : lexeme -> Region.t -> (token, int_err) result
val mk_mutez : lexeme -> Region.t -> (token, int_err) result
val mk_ident : lexeme -> Region.t -> (token, ident_err) result
val mk_sym : lexeme -> Region.t -> (token, sym_err) result
val mk_string : lexeme -> Region.t -> token

18
src/passes/1-parser/shared/Lexer.mll
View File

@ -111,7 +111,7 @@ module type TOKEN =
val mk_int : lexeme -> Region.t -> (token, int_err) result
val mk_nat : lexeme -> Region.t -> (token, nat_err) result
val mk_mtz : lexeme -> Region.t -> (token, int_err) result
val mk_mutez : lexeme -> Region.t -> (token, int_err) result
val mk_ident : lexeme -> Region.t -> (token, ident_err) result
val mk_sym : lexeme -> Region.t -> (token, sym_err) result
val mk_string : lexeme -> Region.t -> token
@ -436,9 +436,9 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
| Error Token.Invalid_natural ->
fail region Invalid_natural
let mk_mtz state buffer =
let mk_mutez state buffer =
let region, lexeme, state = sync state buffer in
match Token.mk_mtz lexeme region with
match Token.mk_mutez lexeme region with
Ok token -> token, state
| Error Token.Non_canonical_zero ->
fail region Non_canonical_zero
@ -447,7 +447,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
let region, lexeme, state = sync state buffer in
let lexeme = Str.string_before lexeme (String.index lexeme 't') in
let lexeme = Z.mul (Z.of_int 1_000_000) (Z.of_string lexeme) in
match Token.mk_mtz (Z.to_string lexeme ^ "mtz") region with
match Token.mk_mutez (Z.to_string lexeme ^ "mutez") region with
Ok token -> token, state
| Error Token.Non_canonical_zero ->
fail region Non_canonical_zero
@ -461,9 +461,9 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
let num = Z.of_string (integral ^ fractional)
and den = Z.of_string ("1" ^ String.make (len-index-1) '0')
and million = Q.of_string "1000000" in
let mtz = Q.make num den |> Q.mul million in
let should_be_1 = Q.den mtz in
if Z.equal Z.one should_be_1 then Some (Q.num mtz) else None
let mutez = Q.make num den |> Q.mul million in
let should_be_1 = Q.den mutez in
if Z.equal Z.one should_be_1 then Some (Q.num mutez) else None
| exception Not_found -> assert false
let mk_tz_decimal state buffer =
@ -471,7 +471,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
let lexeme = Str.string_before lexeme (String.index lexeme 't') in
match format_tz lexeme with
| Some tz -> (
match Token.mk_mtz (Z.to_string tz ^ "mtz") region with
match Token.mk_mutez (Z.to_string tz ^ "mutez") region with
Ok token ->
token, state
| Error Token.Non_canonical_zero ->
@ -559,7 +559,7 @@ and scan state = parse
| bytes { (mk_bytes seq) state lexbuf |> enqueue }
| natural 'n' { mk_nat state lexbuf |> enqueue }
| natural 'p' { mk_nat state lexbuf |> enqueue }
| natural "mtz" { mk_mtz state lexbuf |> enqueue }
| natural "mutez" { mk_mutez state lexbuf |> enqueue }
| natural "tz" { mk_tz state lexbuf |> enqueue }
| decimal "tz" { mk_tz_decimal state lexbuf |> enqueue }
| natural { mk_int state lexbuf |> enqueue }

1
src/passes/2-simplify/dune
View File

@ -6,6 +6,7 @@
tezos-utils
parser
ast_simplified
self_ast_simplified
operators)
(modules ligodity pascaligo simplify)
(preprocess

16
src/passes/2-simplify/ligodity.ml
View File

@ -49,17 +49,6 @@ module Errors = struct
] in
error ~data title message
let unsupported_arith_op expr =
let title () = "arithmetic expressions" in
let message () =
Format.asprintf "this arithmetic operator is not supported yet" in
let expr_loc = Raw.expr_to_region expr in
let data = [
("expr_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ expr_loc)
] in
error ~data title message
let untyped_fun_param var =
let title () = "function parameter" in
let message () =
@ -420,13 +409,12 @@ let rec simpl_expression :
let n = Z.to_int @@ snd @@ n in
return @@ e_literal ~loc (Literal_nat n)
)
| EArith (Mtz n) -> (
| EArith (Mutez n) -> (
let (n , loc) = r_split n in
let n = Z.to_int @@ snd @@ n in
return @@ e_literal ~loc (Literal_mutez n)
)
| EArith _ as e ->
fail @@ unsupported_arith_op e
| EArith (Neg e) -> simpl_unop "NEG" e
| EString (String s) -> (
let (s , loc) = r_split s in
let s' =

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

@ -68,16 +68,6 @@ module Errors = struct
] in
error ~data title message
let unsupported_for_loops region =
let title () = "bounded iterators" in
let message () =
Format.asprintf "only simple for loops are supported for now" in
let data = [
("loop_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
] in
error ~data title message
let unsupported_non_var_pattern p =
let title () = "pattern is not a variable" in
let message () =
@ -137,6 +127,17 @@ module Errors = struct
] in
error ~data title message
let unsupported_deep_access_for_collection for_col =
let title () = "deep access in loop over collection" in
let message () =
Format.asprintf "currently, we do not support deep \
accesses in loops over collection" in
let data = [
("pattern_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ for_col.Region.region)
] in
error ~data title message
(* Logging *)
let simplifying_instruction t =
@ -348,7 +349,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
let n = Z.to_int @@ snd @@ n in
return @@ e_literal ~loc (Literal_nat n)
)
| EArith (Mtz n) -> (
| EArith (Mutez n) -> (
let (n , loc) = r_split n in
let n = Z.to_int @@ snd @@ n in
return @@ e_literal ~loc (Literal_mutez n)
@ -389,7 +390,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
let%bind cases = simpl_cases lst in
return @@ e_matching ~loc e cases
)
| EMap (MapInj mi) -> (
| EMap (MapInj mi) -> (
let (mi , loc) = r_split mi in
let%bind lst =
let lst = List.map get_value @@ pseq_to_list mi.elements in
@ -401,6 +402,18 @@ let rec simpl_expression (t:Raw.expr) : expr result =
bind_map_list aux lst in
return @@ e_map ~loc lst
)
| EMap (BigMapInj mi) -> (
let (mi , loc) = r_split mi in
let%bind lst =
let lst = List.map get_value @@ pseq_to_list mi.elements in
let aux : Raw.binding -> (expression * expression) result =
fun b ->
let%bind src = simpl_expression b.source in
let%bind dst = simpl_expression b.image in
ok (src, dst) in
bind_map_list aux lst in
return @@ e_big_map ~loc lst
)
| EMap (MapLookUp lu) -> (
let (lu , loc) = r_split lu in
let%bind path = match lu.path with
@ -655,8 +668,14 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
let%bind body = simpl_block l.block.value in
let%bind body = body None in
return_statement @@ e_loop cond body
| Loop (For (ForInt {region; _} | ForCollect {region ; _})) ->
fail @@ unsupported_for_loops region
| Loop (For (ForInt fi)) ->
let%bind loop = simpl_for_int fi.value in
let%bind loop = loop None in
return_statement @@ loop
| Loop (For (ForCollect fc)) ->
let%bind loop = simpl_for_collect fc.value in
let%bind loop = loop None in
return_statement @@ loop
| Cond c -> (
let (c , loc) = r_split c in
let%bind expr = simpl_expression c.test in
@ -708,10 +727,19 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
let (c , loc) = r_split c in
let%bind expr = simpl_expression c.expr in
let%bind cases =
let aux (x : Raw.instruction Raw.case_clause Raw.reg) =
let%bind i = simpl_instruction x.value.rhs in
let%bind i = i None in
ok (x.value.pattern, i) in
let aux (x : Raw.if_clause Raw.case_clause Raw.reg) =
let%bind case_clause =
match x.value.rhs with
ClauseInstr i ->
simpl_single_instruction i
| ClauseBlock b ->
match b with
LongBlock {value; _} ->
simpl_block value
| ShortBlock {value; _} ->
simpl_statements @@ fst value.inside in
let%bind case_clause = case_clause None in
ok (x.value.pattern, case_clause) in
bind_list
@@ List.map aux
@@ npseq_to_list c.cases.value in
@ -940,5 +968,206 @@ and simpl_statements : Raw.statements -> (_ -> expression result) result =
and simpl_block : Raw.block -> (_ -> expression result) result = fun t ->
simpl_statements t.statements
and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
(* cond part *)
let var = e_variable fi.assign.value.name.value in
let%bind value = simpl_expression fi.assign.value.expr in
let%bind bound = simpl_expression fi.bound in
let comp = e_annotation (e_constant "LE" [var ; bound]) t_bool
in
(* body part *)
let%bind body = simpl_block fi.block.value in
let%bind body = body None in
let step = e_int 1 in
let ctrl = e_assign
fi.assign.value.name.value [] (e_constant "ADD" [ var ; step ]) in
let rec add_to_seq expr = match expr.expression with
| E_sequence (_,a) -> add_to_seq a
| _ -> e_sequence body ctrl in
let body' = add_to_seq body in
let loop = e_loop comp body' in
return_statement @@ e_let_in (fi.assign.value.name.value, Some t_int) value loop
(** simpl_for_collect
For loops over collections, like
``` concrete syntax :
for x : int in set myset
begin
myint := myint + x ;
myst := myst ^ "to" ;
end
```
are implemented using a MAP_FOLD, LIST_FOLD or SET_FOLD:
``` pseudo Ast_simplified
let #COMPILER#folded_record = list_fold( mylist ,
record st = st; acc = acc; end;
lamby = fun arguments -> (
let #COMPILER#acc = arguments.0 in
let #COMPILER#elt = arguments.1 in
#COMPILER#acc.myint := #COMPILER#acc.myint + #COMPILER#elt ;
#COMPILER#acc.myst := #COMPILER#acc.myst ^ "to" ;
#COMPILER#acc
)
) in
{
myst := #COMPILER#folded_record.myst ;
myint := #COMPILER#folded_record.myint ;
}
```
We are performing the following steps:
1) Simplifying the for body using ̀simpl_block`
2) Detect the free variables and build a list of their names
(myint and myst in the previous example)
3) Build the initial record (later passed as 2nd argument of
`MAP/SET/LIST_FOLD`) capturing the environment using the
free variables list of (2)
4) In the filtered body of (1), replace occurences:
- free variable of name X as rhs ==> accessor `#COMPILER#acc.X`
- free variable of name X as lhs ==> accessor `#COMPILER#acc.X`
And, in the case of a map:
- references to the iterated key ==> variable `#COMPILER#elt_key`
- references to the iterated value ==> variable `#COMPILER#elt_value`
in the case of a set/list:
- references to the iterated value ==> variable `#COMPILER#elt`
5) Append the return value to the body
6) Prepend the declaration of the lambda arguments to the body which
is a serie of `let .. in`'s
Note that the parameter of the lambda ̀arguments` is a tree of
tuple holding:
* In the case of `list` or ̀set`:
( folding record , current list/set element ) as
( #COMPILER#acc , #COMPILER#elt )
* In the case of `map`:
( folding record , current map key , current map value ) as
( #COMPILER#acc , #COMPILER#elt_key , #COMPILER#elt_value )
7) Build the lambda using the final body of (6)
8) Build a sequence of assignments for all the captured variables
to their new value, namely an access to the folded record
(#COMPILER#folded_record)
9) Attach the sequence of 8 to the ̀let .. in` declaration
of #COMPILER#folded_record
**)
and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc ->
(* STEP 1 *)
let%bind for_body = simpl_block fc.block.value in
let%bind for_body = for_body None in
(* STEP 2 *)
let%bind captured_name_list = Self_ast_simplified.fold_expression
(fun (prev : type_name list) (ass_exp : expression) ->
match ass_exp.expression with
| E_assign ( name , _ , _ ) ->
if (String.contains name '#') then
ok prev
else
ok (name::prev)
| _ -> ok prev )
[]
for_body in
(* STEP 3 *)
let add_to_record (prev: expression type_name_map) (captured_name: string) =
SMap.add captured_name (e_variable captured_name) prev in
let init_record = e_record (List.fold_left add_to_record SMap.empty captured_name_list) in
(* STEP 4 *)
let replace exp =
match exp.expression with
(* replace references to fold accumulator as rhs *)
| E_assign ( name , path , expr ) -> (
match path with
| [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr
(* This fails for deep accesses, see LIGO-131 LIGO-134 *)
| _ ->
(* ok @@ e_assign "#COMPILER#acc" ((Access_record name)::path) expr) *)
fail @@ unsupported_deep_access_for_collection fc.block )
| E_variable name -> (
if (List.mem name captured_name_list) then
(* replace references to fold accumulator as lhs *)
ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name]
else match fc.collection with
(* loop on map *)
| Map _ ->
let k' = e_variable "#COMPILER#collec_elt_k" in
if ( name = fc.var.value ) then
ok @@ k' (* replace references to the the key *)
else (
match fc.bind_to with
| Some (_,v) ->
let v' = e_variable "#COMPILER#collec_elt_v" in
if ( name = v.value ) then
ok @@ v' (* replace references to the the value *)
else ok @@ exp
| None -> ok @@ exp
)
(* loop on set or list *)
| (Set _ | List _) ->
if (name = fc.var.value ) then
(* replace references to the collection element *)
ok @@ (e_variable "#COMPILER#collec_elt")
else ok @@ exp
)
| _ -> ok @@ exp in
let%bind for_body = Self_ast_simplified.map_expression replace for_body in
(* STEP 5 *)
let rec add_return (expr : expression) = match expr.expression with
| E_sequence (a,b) -> e_sequence a (add_return b)
| _ -> e_sequence expr (e_variable "#COMPILER#acc") in
let for_body = add_return for_body in
(* STEP 6 *)
let for_body =
let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in
( match fc.collection with
| Map _ ->
(* let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in
let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in
let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in *)
(* The above should work, but not yet (see LIGO-131) *)
let temp_kv = arg_access [Access_tuple 1] in
let acc = arg_access [Access_tuple 0] in
let collec_elt_v = e_accessor (e_variable "#COMPILER#temp_kv") [Access_tuple 0] in
let collec_elt_k = e_accessor (e_variable "#COMPILER#temp_kv") [Access_tuple 1] in
e_let_in ("#COMPILER#acc", None) acc @@
e_let_in ("#COMPILER#temp_kv", None) temp_kv @@
e_let_in ("#COMPILER#collec_elt_k", None) collec_elt_v @@
e_let_in ("#COMPILER#collec_elt_v", None) collec_elt_k (for_body)
| _ ->
let acc = arg_access [Access_tuple 0] in
let collec_elt = arg_access [Access_tuple 1] in
e_let_in ("#COMPILER#acc", None) acc @@
e_let_in ("#COMPILER#collec_elt", None) collec_elt (for_body)
) in
(* STEP 7 *)
let%bind collect = simpl_expression fc.expr in
let lambda = e_lambda "arguments" None None for_body in
let op_name = match fc.collection with
| Map _ -> "MAP_FOLD" | Set _ -> "SET_FOLD" | List _ -> "LIST_FOLD" in
let fold = e_constant op_name [collect ; init_record ; lambda] in
(* STEP 8 *)
let assign_back (prev : expression option) (captured_varname : string) : expression option =
let access = e_accessor (e_variable "#COMPILER#folded_record")
[Access_record captured_varname] in
let assign = e_assign captured_varname [] access in
match prev with
| None -> Some assign
| Some p -> Some (e_sequence p assign) in
let reassign_sequence = List.fold_left assign_back None captured_name_list in
(* STEP 9 *)
let final_sequence = match reassign_sequence with
(* None case means that no variables were captured *)
| None -> e_skip ()
| Some seq -> e_let_in ("#COMPILER#folded_record", None) fold seq in
return_statement @@ final_sequence
let simpl_program : Raw.ast -> program result = fun t ->
bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl
bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl

87
src/passes/3-self_ast_simplified/helpers.ml
View File

@ -1,8 +1,93 @@
open Ast_simplified
open Trace
type mapper = expression -> expression result
type 'a folder = 'a -> expression -> 'a result
let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e ->
let self = fold_expression f in
let%bind init' = f init e in
match e.expression with
| E_literal _ | E_variable _ | E_skip -> ok init'
| E_list lst | E_set lst | E_tuple lst | E_constant (_ , lst) -> (
let%bind res' = bind_fold_list self init' lst in
ok res'
)
| E_map lst | E_big_map lst -> (
let%bind res' = bind_fold_list (bind_fold_pair self) init' lst in
ok res'
)
| E_look_up ab | E_sequence ab | E_loop ab | E_application ab -> (
let%bind res' = bind_fold_pair self init' ab in
ok res'
)
| E_lambda { binder = _ ; input_type = _ ; output_type = _ ; result = e }
| E_annotation (e , _) | E_constructor (_ , e) -> (
let%bind res' = self init' e in
ok res'
)
| E_assign (_ , path , e) | E_accessor (e , path) -> (
let%bind res' = fold_path f init' path in
let%bind res' = self res' e in
ok res'
)
| E_matching (e , cases) -> (
let%bind res = self init' e in
let%bind res = fold_cases f res cases in
ok res
)
| E_record m -> (
let aux init'' _ expr =
let%bind res' = fold_expression self init'' expr in
ok res'
in
let%bind res = bind_fold_smap aux (ok init') m in
ok res
)
| E_let_in { binder = _ ; rhs ; result } -> (
let%bind res = self init' rhs in
let%bind res = self res result in
ok res
)
and fold_path : 'a folder -> 'a -> access_path -> 'a result = fun f init p -> bind_fold_list (fold_access f) init p
and fold_access : 'a folder -> 'a -> access -> 'a result = fun f init a ->
match a with
| Access_map e -> (
let%bind e' = fold_expression f init e in
ok e'
)
| _ -> ok init
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
match m with
| Match_bool { match_true ; match_false } -> (
let%bind res = fold_expression f init match_true in
let%bind res = fold_expression f res match_false in
ok res
)
| Match_list { match_nil ; match_cons = (_ , _ , cons) } -> (
let%bind res = fold_expression f init match_nil in
let%bind res = fold_expression f res cons in
ok res
)
| Match_option { match_none ; match_some = (_ , some) } -> (
let%bind res = fold_expression f init match_none in
let%bind res = fold_expression f res some in
ok res
)
| Match_tuple (_ , e) -> (
let%bind res = fold_expression f init e in
ok res
)
| Match_variant lst -> (
let aux init' ((_ , _) , e) =
let%bind res' = fold_expression f init' e in
ok res' in
let%bind res = bind_fold_list aux init lst in
ok res
)
type mapper = expression -> expression result
let rec map_expression : mapper -> expression -> expression result = fun f e ->
let self = map_expression f in
let%bind e' = f e in

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

@ -4,6 +4,27 @@ open Trace
let peephole_expression : expression -> expression result = fun e ->
let return expression = ok { e with expression } in
match e.expression with
| E_constant ("BIG_MAP_LITERAL" , lst) -> (
let%bind elt =
trace_option (simple_error "big_map literal expects a single parameter") @@
List.to_singleton lst
in
let%bind lst =
trace (simple_error "big_map literal expects a list as parameter") @@
get_e_list elt.expression
in
let aux = fun (e : expression) ->
trace (simple_error "big_map literal expects a list of pairs as parameter") @@
let%bind tpl = get_e_tuple e.expression in
let%bind (a , b) =
trace_option (simple_error "of pairs") @@
List.to_pair tpl
in
ok (a , b)
in
let%bind pairs = bind_map_list aux lst in
return @@ E_big_map pairs
)
| E_constant ("MAP_LITERAL" , lst) -> (
let%bind elt =
trace_option (simple_error "map literal expects a single parameter") @@
@ -25,6 +46,13 @@ let peephole_expression : expression -> expression result = fun e ->
let%bind pairs = bind_map_list aux lst in
return @@ E_map pairs
)
| E_constant ("BIG_MAP_EMPTY" , lst) -> (
let%bind () =
trace_strong (simple_error "BIG_MAP_EMPTY expects no parameter") @@
Assert.assert_list_empty lst
in
return @@ E_big_map []
)
| E_constant ("MAP_EMPTY" , lst) -> (
let%bind () =
trace_strong (simple_error "MAP_EMPTY expects no parameter") @@

4
src/passes/3-self_ast_simplified/self_ast_simplified.ml
View File

@ -21,3 +21,7 @@ let all_program =
let all_expression =
let all_p = List.map Helpers.map_expression all in
bind_chain all_p
let map_expression = Helpers.map_expression
let fold_expression = Helpers.fold_expression

30
src/passes/4-typer/typer.ml
View File

@ -615,6 +615,36 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
let output_type = body.type_annotation in
return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ())
)
| E_constant ( ("LIST_FOLD"|"MAP_FOLD"|"SET_FOLD") as opname ,
[ collect ;
init_record ;
( { expression = (I.E_lambda { binder = (lname, None) ;
input_type = None ;
output_type = None ;
result }) ;
location = _ }) as _lambda
] ) ->
(* this special case is here force annotation of the untyped lambda
generated by pascaligo's for_collect loop *)
let%bind (v_col , v_initr ) = bind_map_pair (type_expression e) (collect , init_record ) in
let tv_col = get_type_annotation v_col in (* this is the type of the collection *)
let tv_out = get_type_annotation v_initr in (* this is the output type of the lambda*)
let%bind input_type = match tv_col.type_value' with
| O.T_constant ( ("list"|"set") , t) -> ok @@ t_tuple (tv_out::t) ()
| O.T_constant ( "map" , t) -> ok @@ t_tuple (tv_out::[(t_tuple t ())]) ()
| _ ->
let wtype = Format.asprintf
"Loops over collections expect lists, sets or maps, got type %a" O.PP.type_value tv_col in
fail @@ simple_error wtype in
let e' = Environment.add_ez_binder lname input_type e in
let%bind body = type_expression ?tv_opt:(Some tv_out) e' result in
let output_type = body.type_annotation in
let lambda' = make_a_e (E_lambda {binder = lname ; body}) (t_function input_type output_type ()) e in
let lst' = [v_col; v_initr ; lambda'] in
let tv_lst = List.map get_type_annotation lst' in
let%bind (opname', tv) =
type_constant opname tv_lst tv_opt ae.location in
return (E_constant (opname' , lst')) tv
| E_constant (name, lst) ->
let%bind lst' = bind_list @@ List.map (type_expression e) lst in
let tv_lst = List.map get_type_annotation lst' in

18
src/passes/operators/operators.ml
View File

@ -85,6 +85,7 @@ module Simplify = struct
("list_iter" , "LIST_ITER") ;
("list_fold" , "LIST_FOLD") ;
("list_map" , "LIST_MAP") ;
(*ici*)
("map_iter" , "MAP_ITER") ;
("map_map" , "MAP_MAP") ;
("map_fold" , "MAP_FOLD") ;
@ -168,6 +169,18 @@ module Simplify = struct
("Map.literal" , "MAP_LITERAL" ) ;
("Map.size" , "SIZE" ) ;
("Big_map.find_opt" , "MAP_FIND_OPT") ;
("Big_map.find" , "MAP_FIND") ;
("Big_map.update" , "MAP_UPDATE") ;
("Big_map.add" , "MAP_ADD") ;
("Big_map.remove" , "MAP_REMOVE") ;
("Big_map.literal" , "BIG_MAP_LITERAL" ) ;
("Big_map.empty" , "BIG_MAP_EMPTY" ) ;
("Bitwise.lor" , "OR") ;
("Bitwise.land" , "AND") ;
("Bitwise.lxor" , "XOR") ;
("String.length", "SIZE") ;
("String.size", "SIZE") ;
("String.slice", "SLICE") ;
@ -398,7 +411,10 @@ module Typer = struct
let%bind () = assert_eq_1 op_lst (t_list (t_operation ()) ()) in
ok @@ (t_pair (t_operation ()) (t_address ()) ())
let get_contract = typer_1_opt "CONTRACT" @@ fun _ tv_opt ->
let get_contract = typer_1_opt "CONTRACT" @@ fun addr_tv tv_opt ->
if not (type_value_eq (addr_tv, t_address ()))
then fail @@ simple_error (Format.asprintf "get_contract expects an address, got %a" PP.type_value addr_tv)
else
let%bind tv =
trace_option (simple_error "get_contract needs a type annotation") tv_opt in
let%bind tv' =

2
src/stages/ast_simplified/PP.ml
View File

@ -25,7 +25,7 @@ let literal ppf (l:literal) = match l with
| Literal_int n -> fprintf ppf "%d" n
| Literal_nat n -> fprintf ppf "+%d" n
| Literal_timestamp n -> fprintf ppf "+%d" n
| Literal_mutez n -> fprintf ppf "%dmtz" n
| Literal_mutez n -> fprintf ppf "%dmutez" n
| Literal_string s -> fprintf ppf "%S" s
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
| Literal_address s -> fprintf ppf "@%S" s

2
src/stages/ast_typed/PP.ml
View File

@ -69,7 +69,7 @@ and literal ppf (l:literal) : unit =
| Literal_int n -> fprintf ppf "%d" n
| Literal_nat n -> fprintf ppf "+%d" n
| Literal_timestamp n -> fprintf ppf "+%d" n
| Literal_mutez n -> fprintf ppf "%dmtz" n
| Literal_mutez n -> fprintf ppf "%dmutez" n
| Literal_string s -> fprintf ppf "%s" s
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
| Literal_address s -> fprintf ppf "@%s" s

2
src/stages/mini_c/PP.ml
View File

@ -53,7 +53,7 @@ let rec value ppf : value -> unit = function
| D_int n -> fprintf ppf "%d" n
| D_nat n -> fprintf ppf "+%d" n
| D_timestamp n -> fprintf ppf "+%d" n
| D_mutez n -> fprintf ppf "%dmtz" n
| D_mutez n -> fprintf ppf "%dmutez" n
| D_unit -> fprintf ppf "unit"
| D_string s -> fprintf ppf "\"%s\"" s
| D_bytes x ->

6
src/test/contracts/arithmetic.mligo
View File

@ -22,9 +22,9 @@ let int_op (n : nat) : int =
*)
(* TODO: Support negative operator
let neg_op (n : int) : int =
-n
*)
let foo (n : int) : int = n + 10
let neg_op_2 (b: int) : int = -(foo b)

40
src/test/contracts/big_map.ligo
View File

@ -1,30 +1,36 @@
type storage_ is big_map(int, int) * unit
type foo is big_map(int, int)
function main(const p : unit; const s : storage_) : list(operation) * storage_ is
var r : big_map(int, int) := s.0 ;
var toto : option (int) := Some(0);
block {
toto := r[23];
r[2] := 444;
s.0 := r;
toto := s.0[23];
s.0[2] := 444;
}
with ((nil: list(operation)), s)
function set_ (var n : int ; var m : storage_) : storage_ is block {
var tmp : big_map(int,int) := m.0 ;
tmp[23] := n ;
m.0 := tmp ;
function set_ (var n : int ; var m : foo) : foo is block {
m[23] := n ;
} with m
function rm (var m : storage_) : storage_ is block {
var tmp : big_map(int,int) := m.0 ;
remove 42 from map tmp;
m.0 := tmp;
function rm (var m : foo) : foo is block {
remove 42 from map m;
} with m
function gf (const m : storage_) : int is begin skip end with get_force(23, m.0)
function gf (const m : foo) : int is begin skip end with get_force(23, m)
function get (const m : storage_) : option(int) is
begin
skip
end with m.0[42]
function get (const m : foo) : option(int) is begin skip end with m[42]
const empty_big_map : big_map(int,int) = big_map end
const big_map1 : big_map(int,int) = big_map
23 -> 0 ;
42 -> 0 ;
end
function mutimaps (const m : foo ; const n : foo) : foo is block
{
var bar : foo := m ;
bar[42] := 0 ;
n[42] := get_force(42, bar) ;
} with n

25
src/test/contracts/big_map.mligo
View File

@ -1,12 +1,21 @@
type storage_ = ((int, int) big_map * unit)
type foo = (int, int) big_map
let set_ (n : int) (m : storage_) : storage_ =
(Map.update 23 (Some(n)) m.(0), ())
let set_ (n : int) (m : foo) : foo = Big_map.update 23 (Some(n)) m
let rm (m : storage_) : storage_ =
(Map.remove 42 m.(0), ())
let rm (m : foo) : foo = Big_map.remove 42 m
let gf (m : storage_) : int = Map.find 23 m.(0)
let gf (m : foo) : int = Big_map.find 23 m
let get (m: storage_): int option =
Map.find_opt 42 m.(0)
let get (m: foo): int option = Big_map.find_opt 42 m
let empty_map : foo = Big_map.empty
let map1 : foo = Big_map.literal
[ (23 , 0) ; (42, 0) ]
let map1 : foo = Big_map.literal
[ (23 , 0) ; (42, 0) ]
let mutimaps (m : foo) (n : foo) : foo =
let bar : foo = Big_map.update 42 (Some(0)) m in
Big_map.update 42 (get(bar)) n

10
src/test/contracts/bitwise_arithmetic.mligo Normal file
View File

@ -0,0 +1,10 @@
(* Test CameLIGO bitwise operators *)
let or_op (n : nat) : nat =
Bitwise.lor n 4p
let and_op (n : nat) : nat =
Bitwise.land n 7p
let xor_op (n : nat) : nat =
Bitwise.lxor n 7p

5
src/test/contracts/condition-annot.mligo Normal file
View File

@ -0,0 +1,5 @@
let%entry main (i : int) =
if (i = 2 : bool) then
(42 : int)
else
(0 : int)

9
src/test/contracts/condition-shadowing.mligo Normal file
View File

@ -0,0 +1,9 @@
(* TODO : make a test using mutation, not shadowing *)
let%entry main (i : int) =
let result = 0 in
if i = 2 then
let result = 42 in
result
else
let result = 0 in
result

12
src/test/contracts/condition.mligo
View File

@ -1,9 +1,7 @@
// Test if conditional in CameLIGO
let main (i : int) : int =
let result : int = 23 in
if i = 2 then 42 else 0
let foo (b : bool) : int =
let x : int = 41 in
let x : int = 1 + (if b then x else main(x)) in x
let%entry main (i : int) =
if i = 2 then
42
else
0

8
src/test/contracts/fibo.mligo Normal file
View File

@ -0,0 +1,8 @@
type storage = unit
let%entry main (p:unit) storage =
(fun (f : (int * int) -> int) (x : int) (y : int) -> f (y, x))
(fun (x : int) (y : int) -> x + y)
0
1

7
src/test/contracts/fibo2.mligo Normal file
View File

@ -0,0 +1,7 @@
type storage = unit
let%entry main (p:unit) storage =
(fun (f : int -> int) (x : int) (y : int) -> (f y))
(fun (x : int) -> x)
0
1

7
src/test/contracts/fibo3.mligo Normal file
View File

@ -0,0 +1,7 @@
type storage = unit
let%entry main (p:unit) storage =
(fun (f : int -> int -> int) (x : int) (y : int) -> (f y) (x + y))
(fun (x : int) (y : int) -> x + y)
0
1

6
src/test/contracts/fibo4.mligo Normal file
View File

@ -0,0 +1,6 @@
type storage = unit
let%entry main (p:unit) storage =
(fun (f : int -> int) (x : int) -> (f x))
(fun (x : int) -> x)
1

0
src/contracts/for_fail.ligo → src/test/contracts/for_fail.ligo
View File

0
src/contracts/incr_decr.mligo → src/test/contracts/incr_decr.mligo
View File

138
src/test/contracts/loop.ligo
View File

@ -16,12 +16,140 @@ function while_sum (var n : nat) : nat is block {
}
} with r
(* function for_sum (var n : nat) : nat is block {
for i := 1 to 100
function for_sum (var n : nat) : int is block {
var acc : int := 0 ;
for i := 1 to int(n)
begin
n := n + 1;
end }
with n *)
acc := acc + i ;
end
} with acc
function for_collection_list (var nee : unit) : (int * string) is block {
var acc : int := 0 ;
var st : string := "to" ;
var mylist : list(int) := list 1 ; 1 ; 1 end ;
for x : int in list mylist
begin
acc := acc + x ;
st := st^"to" ;
end
} with (acc, st)
function for_collection_set (var nee : unit) : (int * string) is block {
var acc : int := 0 ;
var st : string := "to" ;
var myset : set(int) := set 1 ; 2 ; 3 end ;
for x : int in set myset
begin
acc := acc + x ;
st := st^"to" ;
end
} with (acc, st)
function for_collection_if_and_local_var (var nee : unit) : int is block {
var acc : int := 0 ;
const theone : int = 1 ;
var myset : set(int) := set 1 ; 2 ; 3 end ;
for x : int in set myset
begin
const thetwo : int = 2 ;
if (x=theone) then
acc := acc + x ;
else if (x=thetwo) then
acc := acc + thetwo ;
else
acc := acc + 10 ;
end
} with acc
function for_collection_rhs_capture (var nee : unit) : int is block {
var acc : int := 0 ;
const mybigint : int = 1000 ;
var myset : set(int) := set 1 ; 2 ; 3 end ;
for x : int in set myset
begin
if (x=1) then
acc := acc + mybigint ;
else
acc := acc + 10 ;
end
} with acc
function for_collection_proc_call (var nee : unit) : int is block {
var acc : int := 0 ;
var myset : set(int) := set 1 ; 2 ; 3 end ;
for x : int in set myset
begin
if (x=1) then
acc := acc + for_collection_rhs_capture(unit) ;
else
acc := acc + 10 ;
end
} with acc
function for_collection_comp_with_acc (var nee : unit) : int is block {
var myint : int := 0 ;
var mylist : list(int) := list 1 ; 10 ; 15 end;
for x : int in list mylist
begin
if (x < myint) then skip ;
else myint := myint + 10 ;
end
} with myint
function for_collection_with_patches (var nee : unit) : map(string,int) is block {
var myint : int := 12 ;
var mylist : list(string) := list "I" ; "am" ; "foo" end;
var mymap : map(string,int) := map end;
for x : string in list mylist
begin
patch mymap with map [ x -> myint ];
end
} with mymap
function for_collection_empty (var nee : unit) : int is block {
var acc : int := 0 ;
var myset : set(int) := set 1 ; 2 ; 3 end ;
for x : int in set myset
begin
skip ;
end
} with acc
function for_collection_map_kv (var nee : unit) : (int * string) is block {
var acc : int := 0 ;
var st : string := "" ;
var mymap : map(string,int) := map "1" -> 1 ; "2" -> 2 ; "3" -> 3 end ;
for k -> v : (string * int) in map mymap
begin
acc := acc + v ;
st := st^k ;
end
} with (acc, st)
function for_collection_map_k (var nee : unit) : string is block {
var st : string := "" ;
var mymap : map(string,int) := map "1" -> 1 ; "2" -> 2 ; "3" -> 3 end ;
for k : string in map mymap
begin
st := st^k ;
end
} with st
// function nested_for_collection (var nee : unit) : (int*string) is block {
// var myint : int := 0;
// var myst : string := "";
// var mylist : list(int) := list 1 ; 2 ; 3 end ;
// for i : int in list mylist
// begin
// myint := myint + i ;
// var myset : set(string) := set "1" ; "2" ; "3" end ;
// for st : string in set myset
// begin
// myst := myst ^ st ;
// end
// end
// } with (myint,myst)
function dummy (const n : nat) : nat is block {
while (False) block { skip }

0
src/contracts/procedure.ligo → src/test/contracts/procedure.ligo
View File

22
src/test/contracts/tez.ligo
View File

@ -1,16 +1,16 @@
const add_tez : tez = 21mtz + 0.000021tz;
const sub_tez : tez = 21mtz - 20mtz;
const add_tez : tez = 21mutez + 0.000021tz;
const sub_tez : tez = 21mutez - 20mutez;
(* This is not enough. *)
const not_enough_tez : tez = 4611686018427387903mtz;
const not_enough_tez : tez = 4611686018427387903mutez;
const nat_mul_tez : tez = 1n * 100mtz;
const tez_mul_nat : tez = 100mtz * 10n;
const nat_mul_tez : tez = 1n * 100mutez;
const tez_mul_nat : tez = 100mutez * 10n;
const tez_div_tez1 : nat = 100mtz / 1mtz;
const tez_div_tez2 : nat = 100mtz / 90mtz;
const tez_div_tez3 : nat = 100mtz / 110mtz;
const tez_div_tez1 : nat = 100mutez / 1mutez;
const tez_div_tez2 : nat = 100mutez / 90mutez;
const tez_div_tez3 : nat = 100mutez / 110mutez;
const tez_mod_tez1 : tez = 100mtz mod 1mtz;
const tez_mod_tez2 : tez = 100mtz mod 90mtz;
const tez_mod_tez3 : tez = 100mtz mod 110mtz;
const tez_mod_tez1 : tez = 100mutez mod 1mutez;
const tez_mod_tez2 : tez = 100mutez mod 90mutez;
const tez_mod_tez3 : tez = 100mutez mod 110mutez;

2
src/test/contracts/tez.mligo
View File

@ -1,4 +1,4 @@
let add_tez : tez = 21mtz + 0.000021tz
let add_tez : tez = 21mutez + 0.000021tz
let sub_tez : tez = 0.000021tz - 0.000020tz
let not_enough_tez : tez = 4611686018427.387903tz

20
src/test/contracts/website2.mligo Normal file
View File

@ -0,0 +1,20 @@
type storage = int
(* variant defining pseudo multi-entrypoint actions *)
type action =
| Increment of int
| Decrement of int
let add (a: int) (b: int) : int = a + b
let subtract (a: int) (b: int) : int = a - b
(* real entrypoint that re-routes the flow based on the action provided *)
let%entry main (p : action) storage =
let storage =
match p with
| Increment n -> add storage n
| Decrement n -> subtract storage n
in (([] : operation list), storage)

123
src/test/integration_tests.ml
View File

@ -207,6 +207,8 @@ let arithmetic_mligo () : unit result =
("plus_op", fun n -> (n + 42)) ;
("minus_op", fun n -> (n - 42)) ;
("times_op", fun n -> (n * 42)) ;
("neg_op", fun n -> (-n)) ;
("neg_op_2", fun n -> -(n + 10)) ;
] in
let%bind () = expect_eq_n_pos program "mod_op" e_int (fun n -> e_nat (n mod 42)) in
let%bind () = expect_eq_n_pos program "div_op" e_int (fun n -> e_int (n / 2)) in
@ -228,6 +230,22 @@ let bitwise_arithmetic () : unit result =
let%bind () = expect_eq program "xor_op" (e_nat 7) (e_nat 0) in
ok ()
let bitwise_arithmetic_mligo () : unit result =
let%bind program = mtype_file "./contracts/bitwise_arithmetic.mligo" in
let%bind () = expect_eq program "or_op" (e_nat 7) (e_nat 7) in
let%bind () = expect_eq program "or_op" (e_nat 3) (e_nat 7) in
let%bind () = expect_eq program "or_op" (e_nat 2) (e_nat 6) in
let%bind () = expect_eq program "or_op" (e_nat 14) (e_nat 14) in
let%bind () = expect_eq program "or_op" (e_nat 10) (e_nat 14) in
let%bind () = expect_eq program "and_op" (e_nat 7) (e_nat 7) in
let%bind () = expect_eq program "and_op" (e_nat 3) (e_nat 3) in
let%bind () = expect_eq program "and_op" (e_nat 2) (e_nat 2) in
let%bind () = expect_eq program "and_op" (e_nat 14) (e_nat 6) in
let%bind () = expect_eq program "and_op" (e_nat 10) (e_nat 2) in
let%bind () = expect_eq program "xor_op" (e_nat 0) (e_nat 7) in
let%bind () = expect_eq program "xor_op" (e_nat 7) (e_nat 0) in
ok ()
let string_arithmetic () : unit result =
let%bind program = type_file "./contracts/string_arithmetic.ligo" in
let%bind () = expect_eq program "concat_op" (e_string "foo") (e_string "foototo") in
@ -616,7 +634,7 @@ let big_map_ type_f path : unit result =
let ez lst =
let open Ast_simplified.Combinators in
let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in
e_pair (e_typed_big_map lst' t_int t_int) (e_unit ())
(e_typed_big_map lst' t_int t_int)
in
let%bind () =
let make_input = fun n -> ez [(23, n) ; (42, 4)] in
@ -703,16 +721,17 @@ let condition () : unit result =
ok ()
let condition_mligo () : unit result =
let%bind program = mtype_file "./contracts/condition.mligo" in
let%bind _ =
let make_input = e_int in
let make_expected = fun n -> e_int (if n = 2 then 42 else 0) in
expect_eq_n program "main" make_input make_expected
in
let%bind _ =
let make_expected = fun b -> e_int (if b then 42 else 1) in
expect_eq_b program "foo" make_expected
in
let aux file =
let%bind program = mtype_file file in
let make_input = e_int in
let make_expected = fun n -> e_int (if n = 2 then 42 else 0) in
expect_eq_n program "main" make_input make_expected in
bind_map_list aux [
"./contracts/condition.mligo";
"./contracts/condition-shadowing.mligo";
"./contracts/condition-annot.mligo";
] in
ok ()
let condition_simple () : unit result =
@ -726,24 +745,58 @@ let loop () : unit result =
let%bind () =
let make_input = e_nat in
let make_expected = e_nat in
expect_eq_n_pos program "dummy" make_input make_expected
in
expect_eq_n_pos program "dummy" make_input make_expected in
let%bind () =
let make_input = e_nat in
let make_expected = e_nat in
expect_eq_n_pos_mid program "counter" make_input make_expected
in
expect_eq_n_pos_mid program "counter" make_input make_expected in
let%bind () =
let make_input = e_nat in
let make_expected = fun n -> e_nat (n * (n + 1) / 2) in
expect_eq_n_pos_mid program "while_sum" make_input make_expected
in(* For loop is currently unsupported
let%bind () =
expect_eq_n_pos_mid program "while_sum" make_input make_expected in
let%bind () =
let make_input = e_nat in
let make_expected = fun n -> e_nat (n * (n + 1) / 2) in
expect_eq_n_pos_mid program "for_sum" make_input make_expected
in *)
let make_expected = fun n -> e_int (n * (n + 1) / 2) in
expect_eq_n_pos_mid program "for_sum" make_input make_expected in
let input = e_unit () in
let%bind () =
let expected = e_pair (e_int 3) (e_string "totototo") in
expect_eq program "for_collection_list" input expected in
let%bind () =
let expected = e_pair (e_int 6) (e_string "totototo") in
expect_eq program "for_collection_set" input expected in
let%bind () =
let expected = e_pair (e_int 6) (e_string "123") in
expect_eq program "for_collection_map_kv" input expected in
let%bind () =
let expected = (e_string "123") in
expect_eq program "for_collection_map_k" input expected in
let%bind () =
let expected = (e_int 0) in
expect_eq program "for_collection_empty" input expected in
let%bind () =
let expected = (e_int 13) in
expect_eq program "for_collection_if_and_local_var" input expected in
let%bind () =
let expected = (e_int 1020) in
expect_eq program "for_collection_rhs_capture" input expected in
let%bind () =
let expected = (e_int 1040) in
expect_eq program "for_collection_proc_call" input expected in
let%bind () =
let expected = (e_int 20) in
expect_eq program "for_collection_comp_with_acc" input expected in
(* let%bind () =
let expected = e_pair (e_int 6) (e_string "123123123") in
expect_eq program "nested_for_collection" input expected in *)
let%bind () =
let ez lst =
let open Ast_simplified.Combinators in
let lst' = List.map (fun (x, y) -> e_string x, e_int y) lst in
e_typed_map lst' t_string t_int
in
let expected = ez [ ("I" , 12) ; ("am" , 12) ; ("foo" , 12) ] in
expect_eq program "for_collection_with_patches" input expected in
ok ()
(* Don't know how to assert parse error happens in this test framework
@ -998,6 +1051,12 @@ let lambda2_mligo () : unit result =
let make_expected = (e_unit ()) in
expect_eq program "main" make_input make_expected
let fibo_mligo () : unit result =
let%bind program = mtype_file "./contracts/fibo.mligo" in
let make_input = e_pair (e_unit ()) (e_unit ()) in
let make_expected = (e_int 42) in
expect_eq program "main" make_input make_expected
let website1_ligo () : unit result =
let%bind program = type_file "./contracts/website1.ligo" in
let make_input = fun n-> e_pair (e_int n) (e_int 42) in
@ -1037,6 +1096,16 @@ let tez_mligo () : unit result =
let%bind _ = expect_eq_evaluate program "add_more_tez" (e_mutez 111111000) in
ok ()
let website2_mligo () : unit result =
let%bind program = mtype_file "./contracts/website2.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 main = test_suite "Integration (End to End)" [
test "type alias" type_alias ;
test "function" function_ ;
@ -1056,7 +1125,7 @@ let main = test_suite "Integration (End to End)" [
test "tuple (mligo)" tuple_mligo ;
test "record" record ;
test "condition simple" condition_simple ;
test "condition" condition ;
test "condition (ligo)" condition ;
test "condition (mligo)" condition_mligo ;
test "shadow" shadow ;
test "annotation" annotation ;
@ -1066,7 +1135,8 @@ let main = test_suite "Integration (End to End)" [
test "bool (mligo)" bool_expression_mligo ;
test "arithmetic" arithmetic ;
test "arithmetic (mligo)" arithmetic_mligo ;
test "bitiwse_arithmetic" bitwise_arithmetic ;
test "bitwise_arithmetic" bitwise_arithmetic ;
test "bitwise_arithmetic (mligo)" bitwise_arithmetic_mligo;
test "string_arithmetic" string_arithmetic ;
test "string_arithmetic (mligo)" string_arithmetic_mligo ;
test "bytes_arithmetic" bytes_arithmetic ;
@ -1104,9 +1174,14 @@ let main = test_suite "Integration (End to End)" [
(* test "guess string mligo" guess_string_mligo ; WIP? *)
test "lambda mligo" lambda_mligo ;
test "lambda ligo" lambda_ligo ;
(* test "lambda2 mligo" lambda2_mligo ; *)
test "tez (ligo)" tez_ligo ;
test "tez (mligo)" tez_mligo ;
test "lambda2 mligo" lambda2_mligo ;
(* test "fibo (mligo)" fibo_mligo ; *)
(* test "fibo2 (mligo)" fibo2_mligo ; *)
(* test "fibo3 (mligo)" fibo3_mligo ; *)
(* test "fibo4 (mligo)" fibo4_mligo ; *)
test "website1 ligo" website1_ligo ;
test "website2 ligo" website2_ligo ;
test "website2 (mligo)" website2_mligo ;
]