diff --git a/gitlab-pages/docs/api/cheat-sheet.md b/gitlab-pages/docs/api/cheat-sheet.md index 712055cfe..2d7303138 100644 --- a/gitlab-pages/docs/api/cheat-sheet.md +++ b/gitlab-pages/docs/api/cheat-sheet.md @@ -7,116 +7,1071 @@ import Syntax from '@theme/Syntax';
- - - -|Primitive |Example| -|--- |---| -|Strings | `"Tezos"`| -|Characters | `"t"`| -|Integers | `42`, `7`| -|Natural numbers | `42n`, `7n`| -|Unit| `unit`| -|Boolean|
const hasDriversLicense: bool = False;
const adult: bool = True;
| -|Boolean Logic|
(not True) == False == (False and True) == (False or False)
| -|Tez | `3tez`, `3_000tez`, `3.5tez`| -|Mutez (millionth of a tez)| `42000mutez`, `70_000mutez` | -|Address | `"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"`, `"KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD"`| -|Addition |`3 + 4`, `3n + 4n`| -|Multiplication & Division| `3 * 4`, `3n * 4n`, `10 / 5`, `10n / 5n`| -|Modulo| `10 mod 3`| -|Tuples| 
type name is (string * string);
const winner: name = ("John", "Doe");
const firstName: string = winner.0;
const lastName: string = winner.1;
| -|Types|`type age is int`, `type name is string` | -|Includes|```#include "library.ligo"```| -|Functions (short form)|
function add (const a : int ; const b : int) : int is
  block { skip } with a + b
| -|Functions (long form)|
function add (const a : int ; const b : int) : int is
  block { 
    const result: int = a + b;
  } with result
| -| If Statement | 
if age < 16 
then failwith ("Too young to drive."); 
else const new_id: int = prev_id + 1;
| -|Options|
type middleName is option(string);
const middleName : middleName = Some("Foo");
const middleName : middleName = None;
| -|Assignment| ```const age: int = 5;```| -|Assignment on an existing variable
*⚠️ 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``` | -|Type Annotations| ```("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address)```| -|Variants|
type action is
| Increment of int
| Decrement of int
| -|Variant *(pattern)* matching|
const a: action = Increment(5);
case a of
| Increment(n) -> n + 1
| Decrement(n) -> n - 1
end
| -|Records|
type person is record
  age: int ;
  name: string ;
end

const john : person = record
  age = 18;
  name = "John Doe";
end

const name: string = john.name;
| -|Maps|
type prices is map(nat, tez);

const prices : prices = map
  10n -> 60mutez;
  50n -> 30mutez;
  100n -> 10mutez;
end

const price: option(tez) = prices[50n];

prices[200n] := 5mutez;
| -|Contracts & Accounts|
const destinationAddress : address = "tz1...";
const contract : contract(unit) = get_contract(destinationAddress);
| -|Transactions|
const payment : operation = transaction(unit, amount, receiver);
| -|Exception/Failure|`failwith ("Your descriptive error message for the user goes here.")`| +
+
Strings
+
+ +```pascaligo +const name: string = "Tezos"; +``` + +
+
+Characters +
+
+ +```pascaligo +const t: string = "t"; +``` + +
+
+Integers +
+
+ +```pascaligo +const i: int = 42; +``` + +
+
+Natural numbers +
+
+ +```pascaligo +const n: nat = 7n; +``` + +
+
+Unit +
+
+ +```pascaligo +const u: unit = unit; +``` + +
+
+Boolean +
+
+ +```pascaligo +const hasDriversLicense: bool = False; +const adult: bool = True; +``` + +
+
+Boolean Logic +
+
+ +```pascaligo +const booleanLogic: bool = + (not True) = + False = + (False and True) = + (False or False); +``` + +
+
+Mutez (micro tez) +
+
+ +```pascaligo +const tez: tez = 42tez; +``` + +
+
+Address +
+
+ +```pascaligo +const tz1address: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address); +const kt1address: address = + ("KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD": address); +``` + +
+
+Addition +
+
+ +```pascaligo +const add_int: int = 3 + 4; +const add_nat: nat = 3n + 4n; +``` + +
+
+Multiplication & Division +
+
+ +```pascaligo +const mul_int: int = 3 + 4; +const mul_nat: nat = 3n + 4n; + +const div_int: int = 10 / 5; +const div_nat: nat = 10n / 5n; +``` + +
+
+Modulo +
+
+ +```pascaligo +const mod_nat: nat = 10 mod 3; +``` + +
+
+Tuples +
+
+ +```pascaligo +type name is (string * string); + +const winner: name = ("John", "Doe"); + +const firstName: string = winner.0; +const lastName: string = winner.1; +``` + +
+
+Types +
+
+ +```pascaligo +type age is int; +type name is string +``` + +
+
+Includes +
+
+ +```#include "library.ligo"``` + +
+
+Functions (short form) +
+
+ +```pascaligo +function add (const a : int ; const b : int) : int is + a + b +``` + +
+
+Functions (long form) +
+
+ +```pascaligo +function add (const a : int ; const b : int) : int is + block { + const result: int = a + b; + } with result +``` + +
+
+If Statement +
+
+ +```pascaligo +function if_statement (const age : int) : int is + block { + var id: int := -1; + if age < 16 then { + failwith ("Too young to drive"); + } else { + id := 1; + } + } with id +``` + +
+
+Options +
+
+ +```pascaligo +type middleName is option(string); +const middleName : middleName = Some("Foo"); +const middleName : middleName = None; +``` + +
+
+Assignment +
+
+ +```pascaligo +const age: int = 5; +``` + +
+
+Assignment on an existing variable +
+
+ +:::caution +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. +::: + +```pascaligo +function assignment_existing (const age : int) : int is + block { + var x : int := 2; + x := 3; + } with x +``` + +
+
+Type Annotations +
+
+ +```pascaligo +const someAddress: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address); +``` + +
+
+Variants +
+
+ +```pascaligo group=variants +type action is +| Increment of int +| Decrement of int; +``` + +
+
+Variant *(pattern)* matching +
+
+ +```pascaligo group=variants +function main + (const action : action; const input : int) : int is + (case action of + Increment (n) -> input + 1 + | Decrement (n) -> input - 1 + end) +``` + +
+
+Records +
+
+ +```pascaligo +type person is record + age: int; + name: string; +end + +const john : person = record + age = 18; + name = "john doe"; +end + +const name: string = john.name; +``` + +
+
+Maps +
+
+ +```pascaligo +type prices is map(nat, tez); + +const prices: prices = map + 10n -> 60mutez; + 50n -> 30mutez; + 100n -> 10mutez; +end + +const price: option(tez) = prices[50n]; + +function mutate (const u: unit) : unit is block { + prices[200n] := 10mutez; +} with unit; +``` + +
+
+Contracts & Accounts +
+
+ +```pascaligo group=tezos_specific +const destinationAddress: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address); + +const contract : contract (unit) = ( + case (Tezos.get_contract_opt (Tezos.sender) : option(contract(unit))) of + Some (contract) -> contract + | None -> + (failwith ("No contract.") + : contract (unit)) + end); + +``` + +
+
+Transactions +
+
+ +```pascaligo group=tezos_specific + +const payment: operation = + Tezos.transaction(unit, 100mutez, contract); + +``` + +
+
+Exception/Failure +
+
+ +```pascaligo +function fail (const u: unit) : unit is + failwith("a failure message") +``` + +
+
 -|Primitive |Example| -|--- |---| -|Strings | `"Tezos"`| -|Characters | `"t"`| -|Integers | `42`, `7`| -|Natural numbers | `42n`, `7n`| -|Unit| `unit`| -|Boolean|
let has_drivers_license: bool = false
let adult: bool = true
| -|Boolean Logic|
(not true) = false = (false && true) = (false || false)
| -|Tez | `3tez`, `3_000tez`, `3.5tez`| -|Mutez (millionth of a tez)| `42000mutez`, `70_000mutez` | -|Address | `("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address)`, `("KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD": address)`| -|Addition |`3 + 4`, `3n + 4n`| -|Multiplication & Division| `3 * 4`, `3n * 4n`, `10 / 5`, `10n / 5n`| -|Modulo| `10 mod 3`| -|Tuples| 
type name = (string * string)
let winner: name = "John", "Doe"
let first_name: string = winner.0
let last_name: string = winner.1
| -|Types|`type age = int`, `type name = string` | -|Includes|```#include "library.mligo"```| -|Functions |
let add (a : int) (b : int) : int = a + b
| -| If Statement | 
let new_id: int = if age < 16 
 then failwith ("Too young to drive.") 
 else prev_id + 1
| -|Options|
type middle_name = string option
let middle_name : middle_name = Some "Foo"
let middle_name : middle_name = None
| -|Variable Binding | ```let age: int = 5```| -|Type Annotations| ```("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address)```| -|Variants|
type action =
| Increment of int
| Decrement of int
| -|Variant *(pattern)* matching|
let a: action = Increment 5
match a with
| Increment n -> n + 1
| Decrement n -> n - 1
| -|Records|
type person = {
  age: int ;
  name: string ;
}

let john : person = {
  age = 18;
  name = "John Doe";
}

let name: string = john.name
| -|Maps|
type prices = (nat, tez) map

let prices : prices = Map.literal [
  (10n, 60mutez);
  (50n, 30mutez);
  (100n, 10mutez)
]

let price: tez option = Map.find_opt 50n prices

let prices: prices = Map.update 200n (Some 5mutez) prices
| -|Contracts & Accounts|
let destination_address : address = "tz1..."
let contract : unit contract = 
 Tezos.get_contract destination_address
| -|Transactions|
let payment : operation = 
 Tezos.transaction unit amount receiver
| -|Exception/Failure|`failwith ("Your descriptive error message for the user goes here.")`| +
+
Strings
+
+ +```cameligo +let name: string = "Tezos" +``` + +
+
+Characters +
+
+ +```cameligo +let t: string = "t" +``` + +
+
+Integers +
+
+ +```cameligo +let i: int = 42 +``` + +
+
+Natural numbers +
+
+ +```cameligo +let n: nat = 7n +``` + +
+
+Unit +
+
+ +```cameligo +let u: unit = unit +``` + +
+
+Boolean +
+
+ +```cameligo +let has_drivers_license: bool = false +let adult: bool = true +``` + +
+
+Boolean Logic +
+
+ +```cameligo +let booleanLogic: bool = + (not true) = + false = + (false && true) = + (false || false) +``` + +
+
+Mutez (micro tez) +
+
+ +```cameligo +let tez: tez = 42tez +let tez: tez = 7mutez +``` + +
+
+Address +
+
+ +```cameligo +let tz1address: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) +let kt1address: address = + ("KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD": address) +``` + +
+
+Addition +
+
+ +```cameligo +let add_int: int = 3 + 4 +let add_nat: nat = 3n + 4n +``` + +
+
+Multiplication & Division +
+
+ +```cameligo +let mul_int: int = 3 + 4 +let mul_nat: nat = 3n + 4n + +let div_int: int = 10 / 5 +let div_nat: nat = 10n / 5n +``` + +
+
+Modulo +
+
+ +```cameligo +let mod_nat: nat = 10 mod 3 +``` + +
+
+Tuples +
+
+ +```cameligo +type name = (string * string) + +let winner: name = "John", "Doe" + +let firstName: string = winner.0 +let lastName: string = winner.1 +``` + +
+
+Types +
+
+ +```cameligo +type age = int +type name = string +``` + +
+
+Includes +
+
+ +```#include "library.mligo"``` + +
+
+Functions +
+
+ +```cameligo +let add (a : int) (b : int) : int = + a + b +``` + +
+ +
+If Statement +
+
+ +```cameligo +let if_statement (age : int) : int = + if age < 16 then + (failwith ("Too young to drive"): int) + else + 1 +``` + +
+
+Options +
+
+ +```cameligo +type middle_name = string option +let middle_name : middle_name = Some "Foo" +let middle_name : middle_name = None +``` + +
+
+Variable Binding +
+
+ +```cameligo +let age: int = 5 +``` + +
+
+Type Annotations +
+
+ +```cameligo +let someAddress: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) +``` + +
+
+Variants +
+
+ +```cameligo group=variants +type action = +| Increment of int +| Decrement of int +``` + +
+
+Variant *(pattern)* matching +
+
+ +```cameligo group=variants +let a: action = Increment 5 +let result: int = match a with +| Increment n -> n + 1 +| Decrement n -> n - 1 +``` + +
+
+Records +
+
+ +```cameligo +type person = { + age: int; + name: string; +} + +let john : person = { + age = 18; + name = "john doe"; +} + +let name: string = john.name +``` + +
+
+Maps +
+
+ +```cameligo +type prices = (nat, tez) map + +let prices: prices = Map.literal [ + (10n, 60mutez); + (50n, 30mutez); + (100n, 10mutez); +] + +let price: tez option = Map.find_opt 50n prices + +let prices : prices = Map.update 200n (Some 5mutez) prices +``` + +
+
+Contracts & Accounts +
+
+ +```cameligo group=tezos_specific +let destinationAddress: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) + +let contract : unit contract = + match (Tezos.get_contract_opt Tezos.sender : unit contract option) with + Some contract -> contract + | None -> (failwith "no contract" : unit contract) +``` + +
+
+Transactions +
+
+ +```cameligo group=tezos_specific + +let payment: operation = + Tezos.transaction unit 100mutez contract + +``` + +
+
+Exception/Failure +
+
+ +```cameligo +let fail (u: unit) : unit = + failwith "a failure message" +``` + +
+
 -|Primitive |Example| -|--- |---| -|Strings | `"Tezos"`| -|Characters | `"t"`| -|Integers | `42`, `7`| -|Natural numbers | `42n`, `7n`| -|Unit| `unit`| -|Boolean|
let has_drivers_license: bool = false;
let adult: bool = true;
| -|Boolean Logic|
(not true) = false = (false && true) = (false || false)
| -|Tez | `3tez`, `3_000tez`, `3.5tez`| -|Mutez (millionth of a tez)| `42000mutez`, `70_000mutez` | -|Address | `("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address)`, `("KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD": address)`| -|Addition |`3 + 4`, `3n + 4n`| -|Multiplication & Division| `3 * 4`, `3n * 4n`, `10 / 5`, `10n / 5n`| -|Modulo| `10 mod 3`| -|Tuples| 
type name = (string, string);
let winner: name = ("John", "Doe");
let first_name: string = winner[0];
let last_name: string = winner[1];
| -|Types|`type age = int;`, `type name = string;` | -|Includes|```#include "library.mligo"```| -|Functions |
let add = (a: int, b: int) : int => a + b;
| -| If Statement | 
let new_id: int = if (age < 16) {
  failwith ("Too young to drive."); 
 } else { prev_id + 1; }
| -|Options|
type middle_name = option(string);
let middle_name : middle_name = Some("Foo");
let middle_name : middle_name = None;
| -|Variable Binding | ```let age: int = 5;```| -|Type Annotations| ```("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address)```| -|Variants|
type action =
| Increment(int)
| Decrement(int);
| -|Variant *(pattern)* matching|
let a: action = Increment(5);
switch(a) {
| Increment(n) => n + 1
| Decrement(n) => n - 1;
 }
| -|Records|
type person = {
  age: int,
  name: string
}

let john : person = {
  age: 18,
  name: "John Doe"
};

let name: string = john.name;
| -|Maps|
type prices = map(nat, tez);

let prices : prices = Map.literal([
  (10n, 60mutez),
  (50n, 30mutez),
  (100n, 10mutez)
]);

let price: option(tez) = Map.find_opt(50n, prices);

let prices: prices = Map.update(200n, Some (5mutez), prices);
| -|Contracts & Accounts|
let destination_address : address = "tz1...";
let contract : contract(unit) = 
 Tezos.get_contract(destination_address);
| -|Transactions|
let payment : operation = 
 Tezos.transaction (unit, amount, receiver);
| -|Exception/Failure|`failwith ("Your descriptive error message for the user goes here.");`| +
+
Strings
+
+ +```reasonligo +let name: string = "Tezos" +``` + +
+
+Characters +
+
+ +```reasonligo +let t: string = "t" +``` + +
+
+Integers +
+
+ +```reasonligo +let i: int = 42 +``` + +
+
+Natural numbers +
+
+ +```reasonligo +let n: nat = 7n +``` + +
+
+Unit +
+
+ +```reasonligo +let u: unit = unit +``` + +
+
+Boolean +
+
+ +```reasonligo +let has_drivers_license: bool = false +let adult: bool = true +``` + +
+
+Boolean Logic +
+
+ +```reasonligo +let booleanLogic: bool = + (!true) == + false == + (false && true) == + (false || false) +``` + +
+
+Mutez (micro tez) +
+
+ +```reasonligo +let tez: tez = 42tez +let tez: tez = 7mutez +``` + +
+
+Address +
+
+ +```reasonligo +let tz1address: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) +let kt1address: address = + ("KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD": address) +``` + +
+
+Addition +
+
+ +```reasonligo +let add_int: int = 3 + 4 +let add_nat: nat = 3n + 4n +``` + +
+
+Multiplication & Division +
+
+ +```reasonligo +let mul_int: int = 3 + 4 +let mul_nat: nat = 3n + 4n + +let div_int: int = 10 / 5 +let div_nat: nat = 10n / 5n +``` + +
+
+Modulo +
+
+ +```reasonligo +let mod_nat: nat = 10 mod 3 +``` + +
+
+Tuples +
+
+ +```reasonligo +type name = (string, string) + +let winner: name = ("John", "Doe") + +let firstName: string = winner[0] +let lastName: string = winner[1] +``` + +
+
+Types +
+
+ +```reasonligo +type age = int +type name = string +``` + +
+
+Includes +
+
+ +```#include "library.religo"``` + +
+
+Functions (short form) +
+
+ +```reasonligo +let add = (a: int, b: int): int => + a + b +``` + +
+
+Functions (long form) +
+
+ +```reasonligo +let add = (a: int, b: int): int => { + let c = a; + let d = b; + c + d +}; +``` + +
+
+If Statement +
+
+ +```reasonligo +let if_statement = (age : int) : int => + if (age < 16) { + (failwith ("Too young to drive"): int) + } else { + 1 + } +``` + +
+
+Options +
+
+ +```reasonligo +type middle_name = option(string); +let middle_name : middle_name = Some ("Foo"); +let middle_name : middle_name = None; +``` + +
+
+Variable Binding +
+
+ +```reasonligo +let age: int = 5 +``` + +
+
+Type Annotations +
+
+ +```reasonligo +let someAddress: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) +``` + +
+
+Variants +
+
+ +```reasonligo group=variants +type action = +| Increment (int) +| Decrement (int) +``` + +
+
+Variant *(pattern)* matching +
+
+ +```reasonligo group=variants +let a: action = Increment(5) +let result: int = switch (a) { +| Increment(n) => n + 1 +| Decrement(n) => n - 1 +} +``` + +
+
+Records +
+
+ +```reasonligo +type person = { + age: int, + name: string +} + +let john : person = { + age: 18, + name: "john doe" +} + +let name: string = john.name +``` + +
+
+Maps +
+
+ +```reasonligo +type prices = map (nat, tez) + +let prices: prices = Map.literal ([ + (10n, 60mutez), + (50n, 30mutez), + (100n, 10mutez), +]) + +let price: option(tez) = Map.find_opt(50n, prices) + +let prices : prices = Map.update(200n, (Some 5mutez), prices) +``` + +
+
+Contracts & Accounts +
+
+ +```reasonligo group=tezos_specific +let destinationAddress: address = + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) + +let contract : contract(unit) = + switch (Tezos.get_contract_opt(Tezos.sender) : option(contract(unit))) { + | Some(contract) => contract + | None => (failwith("no contract") : contract(unit)) + } +``` + +
+
+Transactions +
+
+ +```reasonligo group=tezos_specific + +let payment: operation = + Tezos.transaction(unit, 100mutez, contract); + +``` + +
+
+Exception/Failure +
+
+ +```reasonligo +let fail = (u: unit) : unit => + failwith("a failure message") +``` + +
+
 -
diff --git a/gitlab-pages/docs/contributors/big-picture/front-end.md b/gitlab-pages/docs/contributors/big-picture/front-end.md index d4bcfb9e7..d23fe884e 100644 --- a/gitlab-pages/docs/contributors/big-picture/front-end.md +++ b/gitlab-pages/docs/contributors/big-picture/front-end.md @@ -10,6 +10,6 @@ Its files are in `parser/parser_name`. ## Concrete Syntax Tree The CST is the aforementioned structured representation of the program. Is is structurally very close to the source code, and is mostly an intermediary there because manipulating string is not practical. Its files are in `parser/parser_name`. -## Simplifier -A Simplifier is a function that takes a CST and outputs the corresponding Common AST. This is the actual bridge between a given syntax and LIGO. +## Sugar_to_core +A Sugar_to_core is a function that takes a CST and outputs the corresponding Common AST. This is the actual bridge between a given syntax and LIGO. Its files are in `simplify/parser_name`. diff --git a/gitlab-pages/docs/contributors/big-picture/middle-end.md b/gitlab-pages/docs/contributors/big-picture/middle-end.md index 6dac7f5ec..f7cd04a8b 100644 --- a/gitlab-pages/docs/contributors/big-picture/middle-end.md +++ b/gitlab-pages/docs/contributors/big-picture/middle-end.md @@ -6,7 +6,7 @@ title: Middle End The Middle-End is the core of LIGO. It is also composed of three parts. ## Common AST The Common AST is the closest thing to what could be called “LIGO lang”. As such, it should be as simple as possible. Collapsing particular cases in more general constructs is encouraged. Documenting it is crucial for people who’ll write new parsers or editor support for Front-end related things. -Its files are in `ast_simplified/`, of interest is the definition of the AST itself in `ast_simplified/types.ml`. +Its files are in `ast_core/`, of interest is the definition of the AST itself in `ast_core/types.ml`. ## Type Checker The Type Checker, among other things, checks that a given AST is valid with regard to type-safety. It also annotates expressions with their types, free-variables and local environments. As time passes, we want to make the type-system stronger, to encode arbitrarily complex properties in an extensible manner. diff --git a/gitlab-pages/docs/contributors/ligo_test_guide.md b/gitlab-pages/docs/contributors/ligo_test_guide.md index eea05d77d..f8be06001 100644 --- a/gitlab-pages/docs/contributors/ligo_test_guide.md +++ b/gitlab-pages/docs/contributors/ligo_test_guide.md @@ -102,7 +102,7 @@ What's going on is similar to the last program: `expect_eq_evaluate` runs a prog For example, once the program stops running the value of `address` is `"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"`. The *comparison*, however, is made to a constructed expression. -Remember that we're testing from OCaml, but the program is written and evaluated as LIGO. In order to provide a proper comparison, we convert our expected test values into LIGO expressions and data. Constructors such as `e_list` and `e_address` provide a bridge between LIGO and OCaml. Their definitions can be found in files such as [src/stages/ast_simplified/combinators.ml](https://gitlab.com/ligolang/ligo/blob/dev/src/stages/ast_simplified/combinators.ml), or using [Merlin's definition point finder](https://github.com/ocaml/merlin/wiki). These same functions are used during the simplification stage of LIGO compilation, so becoming familiar with them will help prepare you to work on the [front end](contributors/big-picture/front-end/). +Remember that we're testing from OCaml, but the program is written and evaluated as LIGO. In order to provide a proper comparison, we convert our expected test values into LIGO expressions and data. Constructors such as `e_list` and `e_address` provide a bridge between LIGO and OCaml. Their definitions can be found in files such as [src/stages/ast_core/combinators.ml](https://gitlab.com/ligolang/ligo/blob/dev/src/stages/ast_core/combinators.ml), or using [Merlin's definition point finder](https://github.com/ocaml/merlin/wiki). These same functions are used during the simplification stage of LIGO compilation, so becoming familiar with them will help prepare you to work on the [front end](contributors/big-picture/front-end/). ## How To Write A Test For LIGO diff --git a/gitlab-pages/docs/intro/FAQ.md b/gitlab-pages/docs/intro/FAQ.md new file mode 100644 index 000000000..33501af46 --- /dev/null +++ b/gitlab-pages/docs/intro/FAQ.md @@ -0,0 +1,11 @@ +--- +id: faq +title: FAQ +--- + +# Frequently Asked Questions + +Before you ask... + +## Question One +Answer. diff --git a/gitlab-pages/docs/language-basics/functions.md b/gitlab-pages/docs/language-basics/functions.md index 5d34a5e74..f8fc729a6 100644 --- a/gitlab-pages/docs/language-basics/functions.md +++ b/gitlab-pages/docs/language-basics/functions.md @@ -299,6 +299,41 @@ gitlab-pages/docs/language-basics/src/functions/incr_map.religo incr_map + +## Nested functions (also known as closures) +It's possible to place functions inside other functions. These functions +have access to variables in the same scope. + + + +```pascaligo +function closure_example (const i : int) : int is + block { + function closure (const j : int) : int is i + j + } with closure (i) +``` + + + + +```cameligo +let closure_example (i : int) : int = + let closure : int -> int = fun (j : int) -> i + j in + closure i +``` + + + + +```reasonligo +let closure_example = (i : int) : int => { + let closure = (j: int): int => i + j; + closure(i); +}; +``` + + + ## Recursive function LIGO functions are not recursive by default, the user need to indicate that the function is recursive. diff --git a/gitlab-pages/docs/reference/big_map.md b/gitlab-pages/docs/reference/big_map.md index c122e0270..104751667 100644 --- a/gitlab-pages/docs/reference/big_map.md +++ b/gitlab-pages/docs/reference/big_map.md @@ -8,12 +8,16 @@ hide_table_of_contents: true import Syntax from '@theme/Syntax'; import SyntaxTitle from '@theme/SyntaxTitle'; -A lazily deserialized map that's intended to store large amounts of data. +A lazily deserialized map that's intended to store large amounts of data. +Lazily means that storage is read or written per key on demand. Therefore +there are no `map`, `fold`, and `iter` operations as in +[Map](./map-reference). -The gast costs of deserialized maps are higher than standard maps as data is lazily deserialized. +The gast costs of big maps are higher than standard maps as data is lazily +deserialized. -type big_map (key, value) +type big_map ('key, 'value) type ('key, 'value) big_map @@ -45,24 +49,27 @@ type register = (address, move) big_map + The type of a big map from values of type `key` to -values of type `value` is `big_map (key, value)`. +values of type `value` is `big_map(key, value)`. ```reasonligo group=big_map type move = (int, int); -type register = big_map (address, move); +type register = big_map(address, move); ``` +Be aware that a `big_map` cannot appear inside another `big_map`. + -function empty : big_map (key, value) +function empty : big_map ('key, 'value) val empty : ('key, 'value) big_map -let empty: big_map ('key, 'value) +let empty: big_map('key, 'value) Create an empty big_map. @@ -90,14 +97,14 @@ let empty : register = Big_map.empty ```reasonligo group=big_map -let empty : register = Big_map.empty +let empty: register = Big_map.empty ``` -function literal : list (key * value) -> big_map (key, value) +function literal : list ('key * 'value) -> big_map ('key, 'value) val literal : ('key * 'value) list -> ('key, 'value) big_map @@ -140,7 +147,7 @@ let moves : register = ```reasonligo group=big_map -let moves : register = +let moves: register = Big_map.literal ([ ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address, (1,2)), ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address, (0,3))]); @@ -149,13 +156,13 @@ let moves : register = -function find_opt : key -> big_map (key, value) -> option value +function find_opt : 'key -> big_map ('key, 'value) -> option 'value val find_opt : 'key -> ('key, 'value) big_map -> 'value option -let find_opt : ('key, big_map ('key, 'value)) => option ('value) +let find_opt: ('key, big_map ('key, 'value)) => option ('value) Retrieve a value from a big map with the given key. @@ -190,20 +197,20 @@ let my_balance : move option = ```reasonligo group=big_map -let my_balance : option (move) = - Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address, moves); +let my_balance: option (move) = + Big_map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); ``` -function update : key -> option value -> big_map (key, value) -> big_map (key, value) +function update : 'key -> option 'value -> big_map ('key, 'value) -> big_map ('key, 'value) val update: 'key -> 'value option -> ('key, 'value) big_map -> ('key, 'value) big_map -let update: ('key, option('value), big_map ('key, 'value)) => big_map ('key, 'value) +let update: ('key, option('value), big_map('key, 'value)) => big_map('key, 'value) Note: when `None` is used as a value, the value is removed from the big_map. @@ -254,15 +261,15 @@ let updated_map : register = ```reasonligo group=big_map -let updated_map : register = +let updated_map: register = Big_map.update - (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some ((4,9)), moves); + (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some((4,9)), moves); ``` -function add : key -> value -> big_map (key, value) -> big_map (key, value) +function add : 'key -> 'value -> big_map ('key, 'value) -> big_map ('key, 'value) val add : 'key -> 'value -> ('key, 'value) big_map -> ('key, 'value) big_map @@ -291,20 +298,20 @@ let add (m : register) : register = ```reasonligo group=big_map let add = (m: register): register => Big_map.add - (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (4,9), m); + (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), (4,9), m); ``` -function remove: key -> big_map (key, value) -> big_map (key, value) +function remove: 'key -> big_map ('key, 'value) -> big_map ('key, 'value) val remove: 'key -> ('key, 'value) big_map -> ('key, 'value) big_map -let remove: (key, big_map ('key, 'value)) => big_map ('key, 'value) +let remove: ('key, big_map('key, 'value)) => big_map('key, 'value) @@ -339,8 +346,8 @@ let updated_map : register = ```reasonligo group=big_map -let updated_map : register = - Big_map.remove (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves) +let updated_map: register = + Big_map.remove(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves) ``` diff --git a/gitlab-pages/docs/reference/bitwise.md b/gitlab-pages/docs/reference/bitwise.md new file mode 100644 index 000000000..85d6bde86 --- /dev/null +++ b/gitlab-pages/docs/reference/bitwise.md @@ -0,0 +1,69 @@ +--- +id: bitwise-reference +title: Bitwise +description: Operations on bytes +hide_table_of_contents: true +--- + +import Syntax from '@theme/Syntax'; +import SyntaxTitle from '@theme/SyntaxTitle'; + + +function and : nat -> nat -> nat + + +val and : nat -> nat -> nat + + +let and: (nat, nat) -> nat + + +A bitwise `and` operation. + + +function or : nat -> nat -> nat + + +val or : nat -> nat -> nat + + +let or: (nat, nat) -> nat + + +A bitwise `or` operation. + + +function xor : nat -> nat -> nat + + +val xor : nat -> nat -> nat + + +let xor: (nat, nat) -> nat + + +A bitwise `xor` operation. + + +function shift_left : nat -> nat -> nat + + +val shift_left : nat -> nat -> nat + + +let shift_left: (nat, nat) -> nat + + +A bitwise shift left operation. + + +function shift_right : nat -> nat -> nat + + +val shift_right : nat -> nat -> nat + + +let shift_right: (nat, nat) -> nat + + +A bitwise shift right operation. diff --git a/gitlab-pages/docs/reference/bytes.md b/gitlab-pages/docs/reference/bytes.md index dc8dc1aec..68e61d8cd 100644 --- a/gitlab-pages/docs/reference/bytes.md +++ b/gitlab-pages/docs/reference/bytes.md @@ -1,21 +1,43 @@ --- id: bytes-reference -title: Bytes — Manipulate bytes data +title: Bytes +description: Operations on bytes +hide_table_of_contents: true --- import Syntax from '@theme/Syntax'; +import SyntaxTitle from '@theme/SyntaxTitle'; -## Bytes.concat(b1: bytes, b2: bytes) : bytes + +type bytes + + +type bytes + + +type bytes + + + +function concat : bytes -> bytes -> bytes + + +val concat : bytes -> bytes -> bytes + + +let concat: (bytes, bytes) => bytes + Concatenate together two `bytes` arguments and return the result. ```pascaligo -function concat_op (const s : bytes) : bytes is - begin skip end with bytes_concat(s , 0x7070) +function concat_op (const s : bytes) : bytes is Bytes.concat(s , 0x7070) ``` +> Note that `bytes_concat` is *deprecated*. + @@ -33,41 +55,58 @@ let concat_op = (s: bytes): bytes => Bytes.concat(s, 0x7070); -## Bytes.slice(pos1: nat, pos2: nat, data: bytes) : bytes + +function sub : nat -> nat -> bytes -> bytes + + +val sub : nat -> nat -> bytes -> bytes + + +let sub : (nat, nat, bytes) => bytes + Extract the bytes between `pos1` and `pos2`. **Positions are zero indexed and inclusive**. For example if you gave the input "ff7a7aff" to the following: - - ```pascaligo -function slice_op (const s : bytes) : bytes is - begin skip end with bytes_slice(1n , 2n , s) +function slice_op (const s : bytes) : bytes is Bytes.sub(1n , 2n , s) ``` +> Note that `bytes_slice` is *deprecated*. + ```cameligo -let slice_op (s : bytes) : bytes = - Bytes.slice 1n 2n s +let slice_op (s : bytes) : bytes = Bytes.sub 1n 2n s ``` +> Note that `Bytes.slice` is *deprecated*. + ``` -let slice_op = (s: bytes): bytes => Bytes.slice(1n, 2n, s); +let slice_op = (s: bytes): bytes => Bytes.sub(1n, 2n, s); ``` +> Note that `Bytes.slice` is *deprecated*. + - It would return "7a7a" rather than "ff7a" or "ff" or "7a". -## Bytes.pack(data: a') : bytes + +function pack : 'a -> bytes + + +val pack : 'a -> bytes + + +let pack : 'a => bytes + Converts Michelson data structures to a binary format for serialization. @@ -105,10 +144,19 @@ let id_string = (p: string) : option(string) => { -## Bytes.unpack(packed: bytes) : a' + +function unpack : bytes -> option 'a + + +val unpack : bytes -> 'a option + + +let unpack: bytes => option('a) + -Reverses the result of using `unpack` on data, going from Michelson's binary -serialization format to the `option` type annotated on the call. +Reverses the result of using `pack` on data. + +As the conversion might fail an option type is returned. > ⚠️ `PACK` and `UNPACK` are features of Michelson that are intended to be used by people that really know what they're doing. There are several failure cases (such as `UNPACK`ing a lambda from an untrusted source), most of which are beyond the scope of this document. Don't use these functions without doing your homework first. @@ -143,3 +191,12 @@ let id_string = (p: string) : option(string) => { + +function length : bytes -> nat + + +val length : bytes -> nat + + +let length: bytes => nat + diff --git a/gitlab-pages/docs/reference/crypto.md b/gitlab-pages/docs/reference/crypto.md index 49f5a9f02..ba8d146fd 100644 --- a/gitlab-pages/docs/reference/crypto.md +++ b/gitlab-pages/docs/reference/crypto.md @@ -1,11 +1,58 @@ --- id: crypto-reference -title: Crypto — Cryptographic functions +title: Crypto +description: Cryptographic operations +hide_table_of_contents: true --- import Syntax from '@theme/Syntax'; +import SyntaxTitle from '@theme/SyntaxTitle'; -## Crypto.blake2b(data: bytes): bytes + +type key + + +type key + + +type key + + +A public cryptographic key. + + +type key_hash + + +type key_hash + + +type key_hash + + +The hash of a public cryptographic key. + + +type signature + + +type signature + + +type signature + + +A cryptographic signature. + + +function blake2b : bytes -> bytes + + +val blake2b : bytes -> bytes + + +let blake2b: bytes => bytes + Runs the [blake2b hash algorithm](https://en.wikipedia.org/wiki/BLAKE_(hash_function)#BLAKE2) over the given `bytes` data and returns a `bytes` representing the hash. @@ -15,9 +62,11 @@ over the given `bytes` data and returns a `bytes` representing the hash. ```pascaligo -function hasherman_blake (const s: bytes) : bytes is blake2b(s) +function hasherman_blake (const s: bytes) : bytes is Crypto.blake2b(s) ``` +> Note that `blake2b` is *deprecated*. Please use `Crypto.blake2b`. + @@ -25,6 +74,8 @@ function hasherman_blake (const s: bytes) : bytes is blake2b(s) let hasherman_blake (s: bytes) : bytes = Crypto.blake2b s ``` + + @@ -34,8 +85,15 @@ let hasherman_blake = (s: bytes) => Crypto.blake2b(s); - -## Crypto.sha256(data: bytes) : bytes + +function sha256 : bytes -> bytes + + +val sha256 : bytes -> bytes + + +let sha256: bytes => bytes + Runs the [sha256 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the given `bytes` data and returns a `bytes` representing the hash. @@ -45,10 +103,11 @@ Runs the [sha256 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the g ```pascaligo -function hasherman (const s : bytes) : bytes is - begin skip end with sha_256(s) +function hasherman (const s : bytes) : bytes is Crypto.sha256(s) ``` +> Note that `sha_256` is *deprecated*. Please use `Crypto.sha256`. + @@ -66,8 +125,15 @@ let hasherman = (s: bytes): bytes => Crypto.sha256(s); - -## Crypto.sha512(data: bytes) : bytes + +function sha512 : bytes -> bytes + + +val sha512 : bytes -> bytes + + +let sha512: bytes => bytes + Runs the [sha512 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the given `bytes` data and returns a `bytes` representing the hash. @@ -77,9 +143,11 @@ Runs the [sha512 hash algorithm](https://en.wikipedia.org/wiki/SHA-2) over the g ```pascaligo -function hasherman512 (const s: bytes) : bytes is sha_512(s) +function hasherman512 (const s: bytes) : bytes is Crypto.sha512(s) ``` +> Note that `sha_512` is *deprecated*. Please use `Crypto.sha512`. + @@ -96,8 +164,15 @@ let hasherman512 = (s: bytes) => Crypto.sha512(s); - -## Crypto.hash_key(k: key) : key_hash + +function hash_key : key -> key_hash + + +val hash_key : key -> key_hash + + +let hash_key: key => key_hash + Hashes a key for easy comparison and storage. @@ -108,11 +183,13 @@ Hashes a key for easy comparison and storage. ```pascaligo function check_hash_key (const kh1 : key_hash; const k2 : key) : bool * key_hash is block { var ret : bool := False ; - var kh2 : key_hash := crypto_hash_key(k2) ; + var kh2 : key_hash := Crypto.hash_key(k2) ; if kh1 = kh2 then ret := True else skip; } with (ret, kh2) ``` +> Note that `hash_key` is *deprecated*. Please use `Crypto.hash_key`. + @@ -141,8 +218,15 @@ let check_hash_key = ((kh1, k2): (key_hash, key)) : (bool, key_hash) => { - -## Crypto.check(pk: key, signed: signature, data: bytes) : bool + +function check : key -> signature -> bytes -> bool + + +val check : key -> signature -> bytes -> bool + + +let check: (key, signature, bytes) => bool + Check that a message has been signed by a particular key. @@ -157,9 +241,11 @@ function check_signature (const pk: key; const signed: signature; const msg: bytes) : bool - is crypto_check(pk, signed, msg) + is Crypto.check(pk, signed, msg) ``` +> Note that `crypto_check` is *deprecated*. Please use `Crypto.check`. + diff --git a/gitlab-pages/docs/reference/current.md b/gitlab-pages/docs/reference/current.md index 642bbb6fe..56c719630 100644 --- a/gitlab-pages/docs/reference/current.md +++ b/gitlab-pages/docs/reference/current.md @@ -1,11 +1,96 @@ --- id: current-reference -title: Tezos - Things relating to the current execution context +title: Tezos +description: General operations for Tezos +hide_table_of_contents: true --- import Syntax from '@theme/Syntax'; +import SyntaxTitle from '@theme/SyntaxTitle'; -# Tezos.balance + +type timestamp + + +type timestamp + + +type timestamp + + +A date in the real world. + + +type mutez + + +type mutez + + +type mutez + + +A specific type for tokens. + + +type address + + +type address + + +type address + + +An untyped address which can refer to a smart contract or account. + + +type contract('parameter) + + +type 'parameter contract + + +type contract('parameter) + + +A typed contract. + +Use `unit` as `parameter` to indicate an implicit account. + + +type operation + + +type operation + + +type operation + + +An operation emitted by the contract + + +type chain_id + + +type chain_id + + +type chain_id + + +The identifier of a chain, used to indicate test or main chains. + + +function balance : mutez + + +val balance : mutez + + +let balance: mutez + Get the balance for the contract. @@ -18,7 +103,7 @@ function main (const p : unit; const s: tez) : list (operation) * tez is ((nil : list (operation)), Tezos.balance) ``` -> Note that `balance` and `Current.balance` are *deprecated*. +> Note that `balance` and `Current.balance` are *deprecated*. @@ -42,7 +127,15 @@ let main = ((p,s) : (unit, tez)) => -## Tezos.now + +function now : timestamp + + +val now : timestamp + + +let now: timestamp + Returns the current time as a [unix timestamp](https://en.wikipedia.org/wiki/Unix_time). @@ -64,7 +157,7 @@ const some_date: timestamp = ("2000-01-01T10:10:10Z" : timestamp); const one_day_later: timestamp = some_date + one_day; ``` -> Note that `now` is *deprecated*. +> Note that `now` is *deprecated*. Please use `Tezos.now`. @@ -106,7 +199,7 @@ const one_day: int = 86_400; const in_24_hrs: timestamp = today - one_day; ``` -> Note that `now` is *deprecated*. +> Note that `now` is *deprecated*. Please use `Tezos.now`. @@ -145,7 +238,7 @@ for numbers const not_tommorow: bool = (Tezos.now = in_24_hrs) ``` -> Note that `now` is *deprecated*. +> Note that `now` is *deprecated*. Please use `Tezos.now`. @@ -169,7 +262,15 @@ let not_tomorrow: bool = (Tezos.now == in_24_hrs); -## Amount + +function amount : mutez + + +val amount : mutez + + +let amount: mutez + Get the amount of tez provided by the sender to complete this transaction. @@ -207,7 +308,15 @@ let threshold = (p : unit) : int => -## Sender + +function sender : address + + +val sender : address + + +let sender: address + Get the address that initiated the current transaction. @@ -219,7 +328,7 @@ Get the address that initiated the current transaction. function main (const p : unit) : address is Tezos.sender ``` -> Note that `sender` is *deprecated*. +> Note that `sender` is *deprecated*. Please use `Tezos.sender`. @@ -243,7 +352,15 @@ let main = (p : unit) : address => Tezos.sender; -## Address + +function address : contract 'a -> address + + +val address : 'a contract -> address + + +let address: contract('a) => address + Get the address associated with a value of type `contract`. @@ -257,7 +374,7 @@ function main (const p : key_hash) : address is block { } with Tezos.address(c) ``` -> Note that `implicit_account` and `address` are *deprecated*. +> Note that `implicit_account` and `address` are *deprecated*. Please use `Tezos.implicit_account` and `Tezos.address` instead. @@ -287,7 +404,15 @@ let main = (p : key_hash) : address => { -## Self Address + +function self_address : address + + +val self_address : address + + +let self_address: address + Get the address of the currently running contract. @@ -299,7 +424,7 @@ Get the address of the currently running contract. function main (const p : unit) : address is Tezos.self_address ``` -> Note that `self_address` is *deprecated*. +> Note that `self_address` is *deprecated*. Please use `Tezos.self_address`. @@ -320,8 +445,15 @@ let main = (p : unit) : address => Tezos.self_address; > Note that `Current.self_address` is *deprecated*. - -## Self + +function self : string -> contract 'a + + +val self : string -> 'a contract + + +let self: string => contract('a) + Typecast the currently running contract with an entrypoint annotation. If your are using entrypoints: use "%bar" for constructor Bar @@ -353,13 +485,21 @@ let main = (p: unit) : contract(unit) => -## Implicit Account + +function implicit_account : key_hash -> contract 'a + + +val implicit_account : key_hash -> 'a contract + + +let implicit_account: key_hash => contract('a) + Get the default contract associated with an on-chain key-pair. This contract does not execute code, instead it exists to receive tokens on behalf of a key's owner. - +See also: http://tezos.gitlab.io/user/glossary.html#implicit-account @@ -368,7 +508,7 @@ function main (const kh: key_hash) : contract (unit) is Tezos.implicit_account (kh) ``` -> Note that `implicit_account` is *deprecated*. +> Note that `implicit_account` is *deprecated*. Please use `Tezos.implicit_account`. @@ -392,7 +532,15 @@ let main = (kh : key_hash): contract (unit) => -## Source + +function source : address + + +val source : address + + +let source: address + Get the _originator_ (address) of the current transaction. That is, if a chain of transactions led to the current execution get the address @@ -426,7 +574,7 @@ current transaction. function main (const p: unit) : address is Tezos.source ``` -> Note that `source` is *deprecated*. +> Note that `source` is *deprecated*. Please use `Tezos.source`. @@ -449,7 +597,15 @@ let main = (p : unit) : address => Tezos.source; -## Failwith + +function failwith : string -> unit + + +function failwith : string -> unit + + +function failwith : string -> unit + Cause the contract to fail with an error message. @@ -485,3 +641,125 @@ let main = ((p,s) : (int, unit)) => + +function chain_id : chain_id + + +val chain_id : chain_id + + +let chain_id: chain_id + + +Get the identifier of the chain to distinguish between main and test chains. + +This is mainly intended to avoid replay attacks between the chains, and can currently +only be used together with `Bytes.pack` and `Bytes.unpack`. + + + +```pascaligo +type storage is bytes + +function main (const ignore : unit; const storage: storage) : + (list(operation) * storage) is block { + const packed : bytes = Bytes.pack (Tezos.chain_id); + if (storage =/= packed) then { + failwith("wrong chain") + } else + skip; +} with ((nil: list(operation)), packed) +``` + + + + +```cameligo +type storage = bytes + +let main ((ignore, storage): (unit * storage)) = + let packed = Bytes.pack Tezos.chain_id in + if (storage <> packed) then + (failwith "wrong chain" : (operation list * storage)) + else + (([]: operation list), (packed: storage)) +``` + + + + +```reasonligo +type storage = bytes; + +let main = ((ignore, storage): (unit, storage)) => { + let packed = Bytes.pack(Tezos.chain_id); + if (storage != packed) { + (failwith("wrong chain"): (list(operation), storage)); + } else { + ([]: list(operation), packed); + } +}; +``` + + + + +function transaction : 'parameter -> mutez -> contract('parameter) -> operation + + +val transaction : 'parameter -> mutez -> 'parameter contract -> operation + + +let transaction: 'parameter -> mutez -> contract('parameter) -> operation + + +Create a transaction to a contract or account. + +To indicate an account, use `unit` as `parameter`. + + + +function set_delegate : option(key_hash) -> operation + + +val set_delegate : key_hash option -> operation + + +let set_delegate: option(key_hash) => operation + + +Create a delegation. + +See also: http://tezos.gitlab.io/user/glossary.html?highlight=delegate#delegate + + +function get_contract_opt : address -> option(contract('parameter)) + + +val get_contract_opt : address -> 'parameter contract option + + +let get_contract_opt : address => option(contract('parameter)) + + +Get a contract from an address. + +When no contract is found or the contract doesn't match the type, +`None` is returned. + + +function get_entrypoint_opt : string -> address -> option(contract('parameter)) + + +function get_entrypoint_opt : string -> address -> 'parameter contract option + + +function get_entrypoint_opt: (string, address) => option(contract('parameter)) + + +Get a contract from an address and entrypoint. + +Entrypoints are written in the form of: `%entrypoint`. + +When no contract is found or the contract doesn't match the type, +`None` is returned. diff --git a/gitlab-pages/docs/reference/list.md b/gitlab-pages/docs/reference/list.md index cbded72e6..e85e5b543 100644 --- a/gitlab-pages/docs/reference/list.md +++ b/gitlab-pages/docs/reference/list.md @@ -1,96 +1,62 @@ --- id: list-reference -title: Lists — Linear Collections +title: List +description: List operations +hide_table_of_contents: true --- import Syntax from '@theme/Syntax'; +import SyntaxTitle from '@theme/SyntaxTitle'; -Lists are linear collections of elements of the same type. Linear -means that, in order to reach an element in a list, we must visit all -the elements before (sequential access). Elements can be repeated, as -only their order in the collection matters. The first element is -called the *head*, and the sub-list after the head is called the -*tail*. For those familiar with algorithmic data structure, you can -think of a list a *stack*, where the top is written on the left. + +type list ('t) + + +type 't list + + +type list('t) + -# Defining Lists +A sequence of elements of the same type. + +function length : nat + + +val length : nat + + +let length: nat + - +Get the number of elements in a list. -```pascaligo group=lists -const empty_list : list (int) = nil // Or list [] -const my_list : list (int) = list [1; 2; 2] // The head is 1 -``` + +function size : nat + + +val size : nat + + +let size: nat + - - +Get the number of elements in a list. -```cameligo group=lists -let empty_list : int list = [] -let my_list : int list = [1; 2; 2] // The head is 1 -``` - - - - -```reasonligo group=lists -let empty_list : list (int) = []; -let my_list : list (int) = [1, 2, 2]; // The head is 1 -``` - - - - -# Adding to Lists - -Lists can be augmented by adding an element before the head (or, in -terms of stack, by *pushing an element on top*). - - - - - -```pascaligo group=lists -const larger_list : list (int) = 5 # my_list // [5;1;2;2] -``` - - - - -```cameligo group=lists -let larger_list : int list = 5 :: my_list // [5;1;2;2] -``` - - - - -```reasonligo group=lists -let larger_list : list (int) = [5, ...my_list]; // [5,1,2,2] -``` - - - - - -# Functional Iteration over Lists - -A *functional iterator* is a function that traverses a data structure -and calls in turn a given function over the elements of that structure -to compute some value. Another approach is possible in PascaLIGO: -*loops* (see the relevant section). - -There are three kinds of functional iterations over LIGO lists: the -*iterated operation*, the *map operation* (not to be confused with the -*map data structure*) and the *fold operation*. - -## Iterated Operation over Lists - -The first, the *iterated operation*, is an iteration over the list -with a unit return value. It is useful to enforce certain invariants -on the element of a list, or fail. +Synonym for `List.length`. + +function iter : ('a -> unit) -> list('a) -> unit + + +val iter : ('a -> unit) -> 'a list -> unit + + +let iter: (('a => unit), list('a)) => unit + +Iterate over items in a list. @@ -104,6 +70,8 @@ function iter_op (const l : list (int)) : unit is > Note that `list_iter` is *deprecated*. +Alternatively it's also possible to use [loops](../language-basics/loops.md). + @@ -126,17 +94,23 @@ let iter_op = (l : list (int)) : unit => { -## Mapped Operation over Lists - -We may want to change all the elements of a given list by applying to -them a function. This is called a *map operation*, not to be confused -with the map data structure. - + +function map : ('a -> 'b) -> list('a) -> list('b) + + +val map : ('a -> 'b) -> 'a list -> 'b list + + +let map: (('a => 'b), list('a)) => list('b) + +Apply a function to items of a list to create a new list. ```pascaligo group=lists +const larger_list: list(int) = list [1; 2; 3] + function increment (const i : int): int is i + 1 // Creates a new list with all elements incremented by 1 @@ -149,6 +123,8 @@ const plus_one : list (int) = List.map (increment, larger_list) ```cameligo group=lists +let larger_list: int list = [1; 2; 3] + let increment (i : int) : int = i + 1 // Creates a new list with all elements incremented by 1 @@ -159,6 +135,8 @@ let plus_one : int list = List.map increment larger_list ```reasonligo group=lists +let larger_list: list(int) = [1, 2, 3]; + let increment = (i : int) : int => i + 1; // Creates a new list with all elements incremented by 1 @@ -167,22 +145,25 @@ let plus_one : list (int) = List.map (increment, larger_list); + +function fold : (('accumulator -> 'item -> 'accumulator) -> list('item) -> 'accumulator) -> 'accumulator + + +val fold : ('accumulator -> 'item -> 'accumulator) -> 'item list -> 'accumulator -> 'accumulator + + +let fold: ((('accumulator, 'item) => 'accumulator), list('item), 'accumulator) => 'accumulator + - -## Folded Operation over Lists - -A *folded operation* is the most general of iterations. The folded -function takes two arguments: an *accumulator* and the structure -*element* at hand, with which it then produces a new accumulator. This -enables having a partial result that becomes complete when the -traversal of the data structure is over. - - +[Fold over items in a list](../language-basics/sets-lists-tuples#folded-operation-over-lists); ```pascaligo group=lists +const my_list: list(int) = list [1; 2; 3] + function sum (const acc : int; const i : int): int is acc + i + const sum_of_elements : int = List.fold (sum, my_list, 0) ``` @@ -192,7 +173,10 @@ const sum_of_elements : int = List.fold (sum, my_list, 0) ```cameligo group=lists -let sum (acc, i: int * int) : int = acc + i +let my_list : int list = [1; 2; 3] + +let sum (acc, i : int * int) : int = acc + i + let sum_of_elements : int = List.fold sum my_list 0 ``` @@ -200,40 +184,11 @@ let sum_of_elements : int = List.fold sum my_list 0 ```reasonligo group=lists +let my_list : list(int) = [1, 2, 3]; + let sum = ((result, i): (int, int)): int => result + i; + let sum_of_elements : int = List.fold (sum, my_list, 0); ``` - - -# List Length - -Get the number of elements in a list. - - - - - -```pascaligo -function size_of (const l : list (int)) : nat is List.length (l) -``` - -> Note that `size` is *deprecated*. - - - - -```cameligo -let size_of (l : int list) : nat = List.length l -``` - - - - -```reasonligo -let size_of = (l : list (int)) : nat => List.length (l); -``` - - - diff --git a/gitlab-pages/docs/reference/map.md b/gitlab-pages/docs/reference/map.md index b359380eb..bf26f6bcf 100644 --- a/gitlab-pages/docs/reference/map.md +++ b/gitlab-pages/docs/reference/map.md @@ -1,22 +1,28 @@ --- id: map-reference -title: Maps +title: Map +description: Map operations +hide_table_of_contents: true --- import Syntax from '@theme/Syntax'; +import SyntaxTitle from '@theme/SyntaxTitle'; -*Maps* are a data structure which associate values of the same type to -values of the same type. The former are called *key* and the latter -*values*. Together they make up a *binding*. An additional requirement -is that the type of the keys must be *comparable*, in the Michelson -sense. - -# Declaring a Map - - + +type map ('key, 'value) + + +type ('key, 'value) map + + +type map ('key, 'value) + +The type of a map from values of type `key` to +values of type `value` is `map (key, value)`. + ```pascaligo group=maps type move is int * int type register is map (address, move) @@ -25,6 +31,9 @@ type register is map (address, move) +The type of a map from values of type `key` to values +of type `value` is `(key, value) map`. + ```cameligo group=maps type move = int * int type register = (address, move) map @@ -33,6 +42,9 @@ type register = (address, move) map +The type of a map from values of type `key` to +values of type `value` is `map (key, value)`. + ```reasonligo group=maps type move = (int, int); type register = map (address, move); @@ -40,13 +52,26 @@ type register = map (address, move); + +function empty : map ('key, 'value) + + +val empty : ('key, 'value) map + + +let empty: map('key, 'value) + -# Creating an Empty Map - - +Create an empty map. +```pascaligo group=maps +const empty : register = Map.empty +``` + +Or + ```pascaligo group=maps const empty : register = map [] ``` @@ -68,16 +93,34 @@ let empty : register = Map.empty -# Creating a Non-empty Map + +function literal : list ('key * 'value) -> map ('key, 'value) + + +val literal : ('key * 'value) list -> ('key, 'value) map + + +let literal: list(('key, 'value)) => map('key, 'value) + +Create a non-empty map. ```pascaligo group=maps const moves : register = + Map.literal (list [ + (("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address), (1,2)); + (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (0,3))]); +``` + +Alternative way of creating an empty map: + +```pascaligo group=maps +const moves_alternative : register = map [ ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) -> (1,2); - ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) -> (0,3)] + ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) -> (0,3)]; ``` @@ -103,14 +146,32 @@ let moves : register = -# Accessing Map Bindings + +function find_opt : 'key -> map ('key, 'value) -> option 'value + + +val find_opt : 'key -> ('key, 'value) map -> 'value option + + +let find_opt : ('key, map ('key, 'value)) => option ('value) + + +Retrieve a (option) value from a map with the given key. Returns `None` if the +key is missing and the value otherwise. ```pascaligo group=maps const my_balance : option (move) = - moves [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address)] + Map.find_opt (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), moves) +``` + +Alternatively: + +```pascaligo group=maps +const my_balance_alternative : option (move) = + moves [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address)]; ``` @@ -126,67 +187,40 @@ let my_balance : move option = ```reasonligo group=maps let my_balance : option (move) = - Map.find_opt (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), moves); + Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address, moves); ``` -Notice how the value we read is an optional value: this is to force -the reader to account for a missing key in the map. This requires -*pattern matching*. - + +function update : 'key -> option 'value -> map ('key, 'value) -> map ('key, 'value) + + +val update: 'key -> 'value option -> ('key, 'value) map -> ('key, 'value) map + + +let update: ('key, option('value), map('key, 'value)) => map ('key, 'value) + +Note: when `None` is used as a value, the key and associated value is removed +from the map. ```pascaligo group=maps -function force_access (const key : address; const moves : register) : move is - case moves[key] of - Some (move) -> move - | None -> (failwith ("No move.") : move) - end + const updated_map : register = Map.update(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some (4,9), moves); ``` - - - -```cameligo group=maps -let force_access (key, moves : address * register) : move = - match Map.find_opt key moves with - Some move -> move - | None -> (failwith "No move." : move) -``` - - - - -```reasonligo group=maps -let force_access = ((key, moves) : (address, register)) : move => { - switch (Map.find_opt (key, moves)) { - | Some (move) => move - | None => failwith ("No move.") : move - } -}; -``` - - - - -# Updating a Map - -Given a map, we may want to add a new binding, remove one, or modify -one by changing the value associated to an already existing key. All -those operations are called *updates*. - - - +Alternatively: ```pascaligo group=maps -function assign (var m : register) : register is + +function update (var m : register) : register is block { - m [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9) + m [("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9); } with m + ``` If multiple bindings need to be updated, PascaLIGO offers a *patch @@ -206,14 +240,40 @@ function assignments (var m : register) : register is ```cameligo group=maps -let assign (m : register) : register = +let updated_map : register = Map.update - ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) (Some (4,9)) m + ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address) (Some (4,9)) moves ``` -Notice the optional value `Some (4,9)` instead of `(4,9)`. If we had -use `None` instead, that would have meant that the binding is removed. -As a particular case, we can only add a key and its associated value. + + + +```reasonligo group=maps +let updated_map : register = + Map.update + (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), Some ((4,9)), moves); +``` + + + + + +function add : 'key -> 'value -> map ('key, 'value) -> map ('key, 'value) + + +val add : 'key -> 'value -> ('key, 'value) map -> ('key, 'value) map + + +let add: ('key, 'value, map('key, 'value)) => map('key, 'value) + + + +```pascaligo group=maps +const added_item : register = Map.add (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (4, 9), moves) +``` + + + ```cameligo group=maps let add (m : register) : register = @@ -225,18 +285,7 @@ let add (m : register) : register = ```reasonligo group=maps -let assign = (m : register) : register => - Map.update - (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), Some ((4,9)), m); -``` - -Notice the optional value `Some (4,9)` instead of `(4,9)`. If we had -use `None` instead, that would have meant that the binding is removed. - -As a particular case, we can only add a key and its associated value. - -```reasonligo group=maps -let add = (m : register) : register => +let add = (m: register): register => Map.add (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN" : address), (4,9), m); ``` @@ -244,57 +293,63 @@ let add = (m : register) : register => -To remove a binding from a map, we need its key. - - + +function remove : 'key -> map ('key, 'value) -> map ('key, 'value) + + +val remove : 'key -> ('key, 'value) map -> ('key, 'value) map + + +let remove: (key, map('key, 'value)) => map('key, 'value) + ```pascaligo group=maps -function delete (const key : address; var moves : register) : register is + const updated_map : register = + Map.remove (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves) +``` + +Alternatively, the instruction `remove key from map m` removes the key +`key` from the map `m`. + +```pascaligo group=maps +function rem (var m : register) : register is block { - remove key from map moves - } with moves + remove ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) from map moves + } with m + +const updated_map : register = rem (moves) ``` ```cameligo group=maps -let delete (key, moves : address * register) : register = - Map.remove key moves +let updated_map : register = + Map.remove ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves ``` ```reasonligo group=maps -let delete = ((key, moves) : (address, register)) : register => - Map.remove (key, moves); +let updated_map : register = + Map.remove (("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves) ``` - -# Functional Iteration over Maps - -A *functional iterator* is a function that traverses a data structure -and calls in turn a given function over the elements of that structure -to compute some value. Another approach is possible in PascaLIGO: -*loops* (see the relevant section). - -There are three kinds of functional iterations over LIGO maps: the -*iterated operation*, the *map operation* (not to be confused with the -*map data structure*) and the *fold operation*. - -## Iterated Operation over Maps - -The first, the *iterated operation*, is an iteration over the map with -no return value: its only use is to produce side-effects. This can be -useful if for example you would like to check that each value inside -of a map is within a certain range, and fail with an error otherwise. - + +function iter : ((key, value) -> unit) -> map (key, value) -> unit + + +val iter : (('key * 'value) -> unit) -> ('key, 'value) map -> unit + + +let iter: ((('key, 'value)) => unit, map('key, 'value)) => unit + @@ -330,14 +385,15 @@ let iter_op = (m : register) : unit => { - -## Map Operations over Maps - -We may want to change all the bindings of a map by applying to them a -function. This is called a *map operation*, not to be confused with -the map data structure. The predefined functional iterator -implementing the map operation over maps is called `Map.map`. - + +function map : (('key, 'value) -> ('mapped_key, 'mapped_item)) -> map ('key, 'value) -> map ('mapped_key, 'mapped_value) + + +val map : (('key * 'value) -> ('mapped_key * 'mapped_item)) -> (key, value) map -> (mapped_key, mapped_value) map + + +let map: ((('key, 'value)) => ('mapped_key, 'mapped_item), map(key, value)) => map(mapped_key, mapped_value) + @@ -374,14 +430,15 @@ let map_op = (m : register) : register => { -## Folded Operations over Maps - -A *folded operation* is the most general of iterations. The folded -function takes two arguments: an *accumulator* and the structure -*element* at hand, with which it then produces a new accumulator. This -enables having a partial result that becomes complete when the -traversal of the data structure is over. - + +function fold : (('accumulator -> ('key, 'value) -> 'accumulator) -> map ('key, 'value) -> 'accumulator) -> 'accumulator + + +val fold : ('accumulator -> ('key * 'value) -> 'accumulator) -> ('key, 'value) map -> 'accumulator -> 'accumulator + + +let fold: ((('accumulator, ('key, 'value)) => 'accumulator), map('key, 'value), 'accumulator) => 'accumulator + @@ -417,3 +474,28 @@ let fold_op = (m : register) : int => { + +function size : map ('key, 'value) -> nat + + +val size : ('key, 'value) map -> nat + + +let size: map('key, 'value) => nat + + +Returns the number of items in the map. + + + +function mem : key -> map (key, value) -> bool + + +val mem : 'key -> ('key, 'value) map => bool + + +let mem : ('key, map('key, 'value)) => bool + + +Checks if a key exists in the map. + diff --git a/gitlab-pages/docs/reference/set.md b/gitlab-pages/docs/reference/set.md index eca62a741..9478a2048 100644 --- a/gitlab-pages/docs/reference/set.md +++ b/gitlab-pages/docs/reference/set.md @@ -1,20 +1,45 @@ --- id: set-reference -title: Sets — Unordered unique collection of a type +title: Set +description: Set operations +hide_table_of_contents: true --- import Syntax from '@theme/Syntax'; +import SyntaxTitle from '@theme/SyntaxTitle'; -Sets are unordered collections of values of the same type, like lists -are ordered collections. Like the mathematical sets and lists, sets -can be empty and, if not, elements of sets in LIGO are *unique*, -whereas they can be repeated in a *list*. +Sets are unordered collections of unique values of the same type. -# Empty Sets + +type set ('value) + + +type 'value set + + +type set('value) + + +function empty : set('value) + + +val empty : 'value set + + +let empty: set('value) + + +Create an empty set. +```pascaligo group=sets +const my_set : set (int) = Set.empty +``` + +Alternative syntax: + ```pascaligo group=sets const my_set : set (int) = set [] ``` @@ -35,12 +60,26 @@ let my_set : set (int) = Set.empty; + +function literal : list('value) -> set('value) + + +val literal : 'value list -> 'value set + + +let literal: list('value) => set('value) + -# Non-empty Sets - +Create a non-empty set. +```pascaligo group=sets +const my_set : set (int) = Set.literal (list [3; 2; 2; 1]) +``` + +Or use the following syntax sugar: + ```pascaligo group=sets const my_set : set (int) = set [3; 2; 2; 1] ``` @@ -50,7 +89,7 @@ const my_set : set (int) = set [3; 2; 2; 1] ```cameligo group=sets let my_set : int set = - Set.add 3 (Set.add 2 (Set.add 2 (Set.add 1 (Set.empty : int set)))) + Set.literal [3; 2; 2; 1] ``` @@ -58,19 +97,33 @@ let my_set : int set = ```reasonligo group=sets let my_set : set (int) = - Set.add (3, Set.add (2, Set.add (2, Set.add (1, Set.empty : set (int))))); + Set.literal ([3, 2, 2, 1]); ``` + +function mem : 'value -> set('value) -> 'bool + + +val mem : 'value -> 'value set -> bool + + +let mem: ('value, set('value)) => bool + -# Set Membership - +Checks if a value exists in the set. ```pascaligo group=sets -const contains_3 : bool = my_set contains 3 +const contains_3 : bool = Set.mem(3, my_set) +``` + +Or: + +```pascaligo group=sets +const contains_3_alt : bool = my_set contains 3 ``` @@ -89,12 +142,17 @@ let contains_3 : bool = Set.mem (3, my_set); + +function cardinal : set('value) -> nat + + +val cardinal : 'value set -> nat + + +let cardinal: set('value) => nat + -# Cardinal of Sets - -The predefined function `Set.size` returns the number of -elements in a given set as follows. - +Number of elements in a set. @@ -102,7 +160,7 @@ elements in a given set as follows. const cardinal : nat = Set.size (my_set) ``` -> Note that `size` is *deprecated*. +> Note that `size` is *deprecated*. Please use `Set.size` @@ -120,72 +178,41 @@ let cardinal : nat = Set.size (my_set); + +function add : 'value -> set('value) -> set('value) + + +val add : 'value -> 'value set -> 'value set + + +let add: ('value, set('value)) => set('value) + -# Updating Sets +Add a value to a set. -There are two ways to update a set, that is to add or remove from it. + +function remove : 'value -> set('value) -> set('value) + + +val remove : 'value -> 'value set -> 'value set + + +let remove: ('value, set('value)) => set('value) + +Remove a value from a set. - + +function iter : ('a -> unit) -> set('a) -> unit + + +val iter : ('a -> unit) -> 'a set -> unit + + +let iter: (('a => unit), set('a)) => unit + -In PascaLIGO, either we create a new set from the given one, or we -modify it in-place. First, let us consider the former way: -```pascaligo group=sets -const larger_set : set (int) = Set.add (4, my_set) -const smaller_set : set (int) = Set.remove (3, my_set) -``` - -> Note that `set_add` and `set_remove` are *deprecated*. - -If we are in a block, we can use an instruction to modify the set -bound to a given variable. This is called a *patch*. It is only -possible to add elements by means of a patch, not remove any: it is -the union of two sets. - -```pascaligo group=sets -function update (var s : set (int)) : set (int) is block { - patch s with set [4; 7] -} with s - -const new_set : set (int) = update (my_set) -``` - - - - -```cameligo group=sets -let larger_set : int set = Set.add 4 my_set -let smaller_set : int set = Set.remove 3 my_set -``` - - - - -```reasonligo group=sets -let larger_set : set (int) = Set.add (4, my_set); -let smaller_set : set (int) = Set.remove (3, my_set); -``` - - - - -# Functional Iteration over Sets - -A *functional iterator* is a function that traverses a data structure -and calls in turn a given function over the elements of that structure -to compute some value. Another approach is possible in PascaLIGO: -*loops* (see the relevant section). - -There are three kinds of functional iterations over LIGO maps: the -*iterated operation*, the *mapped operation* (not to be confused with -the *map data structure*) and the *folded operation*. - -## Iterated Operation - -The first, the *iterated operation*, is an iteration over the map with -no return value: its only use is to produce side-effects. This can be -useful if for example you would like to check that each value inside -of a map is within a certain range, and fail with an error otherwise. +Iterate over values in a set. @@ -221,15 +248,17 @@ let iter_op = (s : set (int)) : unit => { + +function fold : (('accumulator -> 'item -> 'accumulator) -> set ('item) -> 'accumulator) -> 'accumulator + + +val fold : ('accumulator -> 'item -> 'accumulator) -> 'set list -> 'accumulator -> 'accumulator + + +let fold: ((('accumulator, 'item) => 'accumulator), set('item), 'accumulator) => 'accumulator + -## Folded Operation - -A *folded operation* is the most general of iterations. The folded -function takes two arguments: an *accumulator* and the structure -*element* at hand, with which it then produces a new accumulator. This -enables having a partial result that becomes complete when the -traversal of the data structure is over. - +[Fold over values in a set](../language-basics/sets-lists-tuples#folded-operation) @@ -241,17 +270,6 @@ const sum_of_elements : int = Set.fold (sum, my_set, 0) > Note that `set_fold` is *deprecated*. -It is possible to use a *loop* over a set as well. - -```pascaligo group=sets -function loop (const s : set (int)) : int is block { - var sum : int := 0; - for element in set s block { - sum := sum + element - } -} with sum -``` - @@ -269,4 +287,3 @@ let sum_of_elements : int = Set.fold (sum, my_set, 0); ``` - diff --git a/gitlab-pages/docs/reference/string.md b/gitlab-pages/docs/reference/string.md index c75e850a4..afe9ebaa3 100644 --- a/gitlab-pages/docs/reference/string.md +++ b/gitlab-pages/docs/reference/string.md @@ -1,78 +1,120 @@ --- id: string-reference -title: String — Manipulate string data +title: String +description: Operations for strings. +hide_table_of_contents: true --- import Syntax from '@theme/Syntax'; +import SyntaxTitle from '@theme/SyntaxTitle'; -## String.size(s: string) : nat + +type string + + +type string + + +type string + -Get the size of a string. [Michelson only supports ASCII strings](http://tezos.gitlab.io/whitedoc/michelson.html#constants) +A sequence of characters. + + +function length : string -> nat + + +val length : string -> nat + + +let length: string => nat + + +Get the size of a string. + +[Michelson only supports ASCII strings](http://tezos.gitlab.io/whitedoc/michelson.html#constants) so for now you can assume that each character takes one byte of storage. - - ```pascaligo -function string_size (const s: string) : nat is size(s) +function string_size (const s: string) : nat is String.length(s) ``` +> Note that `size` and `String.size` are *deprecated*. + ```cameligo -let size_op (s: string) : nat = String.size s +let size_op (s: string) : nat = String.length s ``` +> Note that `String.size` is *deprecated*. + ```reasonligo -let size_op = (s: string): nat => String.size(s); +let size_op = (s: string): nat => String.length(s); ``` +> Note that `String.size` is *deprecated*. + + +function sub : nat -> nat -> string -> string + + +val sub : nat -> nat -> string -> string + + +let sub: (nat, nat, string) => string + -## String.length(s: string) : nat - -Alias for `String.size`. - -## String.slice(pos1: nat, pos2: nat, s: string) : string - -Get the substring of `s` between `pos1` inclusive and `pos2` inclusive. For example -the string "tata" given to the function below would return "at". +Extract a substring from a string based on the given offset and length. For +example the string "abcd" given to the function below would return "bc". ```pascaligo -function slice_op (const s : string) : string is string_slice(1n , 2n , s) +function slice_op (const s : string) : string is String.sub(1n , 2n , s) ``` +> Note that `string_slice` is *deprecated*. + ```cameligo -let slice_op (s: string) : string = String.slice 1n 2n s +let slice_op (s: string) : string = String.sub 1n 2n s ``` +> Note that `String.slice` is *deprecated*. + ```reasonligo -let slice_op = (s: string): string => String.slice(1n, 2n, s); +let slice_op = (s: string): string => String.sub(1n, 2n, s); ``` +> Note that `String.slice` is *deprecated*. + -## String.sub(pos1: nat, pos2: nat, s: string) : string - -Alias for `String.slice`. - -## String.concat(s1: string, s2: string) : string + +function concat : string -> string -> string + + +val concat : string -> string -> string + + +let concat: (string, string) => string + Concatenate two strings and return the result. @@ -81,21 +123,40 @@ Concatenate two strings and return the result. ```pascaligo -function concat_op (const s : string) : string is s ^ "toto" +function concat_op (const s : string) : string is String.concat(s, "toto") +``` + +Alternatively: + +```pascaligo +function concat_op_alt (const s : string) : string is s ^ "toto" ``` ```cameligo -let concat_syntax (s: string) = s ^ "test_literal" +let concat_syntax (s: string) = String.concat s "test_literal" ``` +Alternatively: + +```cameligo +let concat_syntax_alt (s: string) = s ^ "test_literal" +``` + + ```reasonligo -let concat_syntax = (s: string) => s ++ "test_literal"; +let concat_syntax = (s: string) => String.concat(s, "test_literal"); +``` + +Alternatively: + +```reasonligo +let concat_syntax_alt = (s: string) => s ++ "test_literal"; ``` diff --git a/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md b/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md index 3d9330894..9207f7817 100644 --- a/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md +++ b/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md @@ -169,7 +169,7 @@ function buy_taco (const taco_kind_index : nat ; var taco_shop_storage : taco_sh const receiver : contract(unit) = get_contract (ownerAddress); const payoutOperation : operation = transaction (unit, amount, receiver); const operations : list(operation) = list [payoutOperation] - } with ((nil : list (operation)), taco_shop_storage) + } with ((operations : list (operation)), taco_shop_storage) ``` ### Dry-run the Contract diff --git a/gitlab-pages/website/sidebars.json b/gitlab-pages/website/sidebars.json index bde7acba5..36cff21e1 100644 --- a/gitlab-pages/website/sidebars.json +++ b/gitlab-pages/website/sidebars.json @@ -21,17 +21,20 @@ "advanced/first-contract", "advanced/michelson-and-ligo" ], - "API & Reference": [ + "Reference": [ "api/cli-commands", - "api/cheat-sheet", + "api/cheat-sheet" + ], + "API":[ "reference/big-map-reference", + "reference/bitwise-reference", "reference/bytes-reference", - "reference/crypto-reference", - "reference/current-reference", + "reference/crypto-reference", "reference/list-reference", "reference/map-reference", "reference/set-reference", - "reference/string-reference" + "reference/string-reference", + "reference/current-reference" ] }, "contributors-docs": { diff --git a/gitlab-pages/website/src/theme/CodeBlock/index.js b/gitlab-pages/website/src/theme/CodeBlock/index.js index ca90f0cb0..4c705b717 100644 --- a/gitlab-pages/website/src/theme/CodeBlock/index.js +++ b/gitlab-pages/website/src/theme/CodeBlock/index.js @@ -166,7 +166,7 @@ export default ({children, className: languageClassName, metastring}) => { {showCopied ? 'Copied' : 'Copy'} - + {tokens.map((line, i) => { if (line.length === 1 && line[0].content === '') { line[0].content = '\n'; // eslint-disable-line no-param-reassign diff --git a/gitlab-pages/website/static/css/custom.css b/gitlab-pages/website/static/css/custom.css index b779c2e69..476f1da98 100644 --- a/gitlab-pages/website/static/css/custom.css +++ b/gitlab-pages/website/static/css/custom.css @@ -989,21 +989,43 @@ a:hover { } } - -/* ReasonLIGO specific syntax highlighting */ -.language-reasonligo .hljs-operator { - color: #a626a4; -} -.language-reasonligo .hljs-character { - color: #50a14f; -} -.language-reasonligo .hljs-module-identifier { - color: #00f; -} -.language-reasonligo .hljs-constructor { - color: #a31515; -} - .badge { display: none; } + +.codeTable { + display: grid; + grid-template-columns: 30% 70%; + align-items: center; +} + +.codeTable > .primitive { + width: 100%; + height: 100%; + display: flex; + justify-content: right; + text-align: right; + align-items: center; + font-weight: bold; + padding-right: 1rem; +} + + +.codeTable > div:nth-child(4n+1) { + background-color: var(--ifm-table-stripe-background); +} + +.codeTable > div:nth-child(4n+2) { + background-color: var(--ifm-table-stripe-background); +} + + +.codeTable > .example { + padding-top: var(--ifm-leading); +} + +.codeTable > .example pre, +.codeTable > .example .codeBlockLines_src-theme-CodeBlock- { + background-color: transparent; +} + diff --git a/src/bin/cli.ml b/src/bin/cli.ml index ad36e987c..246524f1c 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -140,8 +140,7 @@ module Run = Ligo.Run.Of_michelson let compile_file = let f source_file entry_point syntax display_format disable_typecheck michelson_format = toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile (Contract entry_point) simplified in + let%bind typed,_ = Compile.Utils.type_file source_file syntax (Contract entry_point) in let%bind mini_c = Compile.Of_typed.compile typed in let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c entry_point in let%bind contract = Compile.Of_michelson.build_contract ~disable_typecheck michelson in @@ -168,8 +167,8 @@ let print_cst = let print_ast = let f source_file syntax display_format = ( toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - ok @@ Format.asprintf "%a\n" Compile.Of_simplified.pretty_print simplified + let%bind imperative = Compile.Utils.to_imperatve source_file syntax in + ok @@ Format.asprintf "%a\n" Compile.Of_imperative.pretty_print imperative ) in let term = Term.(const f $ source_file 0 $ syntax $ display_format) in @@ -177,24 +176,46 @@ let print_ast = let doc = "Subcommand: Print the AST.\n Warning: Intended for development of LIGO and can break at any time." in (Term.ret term, Term.info ~doc cmdname) -let print_typed_ast = +let print_ast_sugar = let f source_file syntax display_format = ( toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile Env simplified in + let%bind sugar = Compile.Utils.to_sugar source_file syntax in + ok @@ Format.asprintf "%a\n" Compile.Of_sugar.pretty_print sugar + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-ast-sugar" in + let doc = "Subcommand: Print the AST.\n Warning: Intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + +let print_ast_core = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind core = Compile.Utils.to_core source_file syntax in + ok @@ Format.asprintf "%a\n" Compile.Of_core.pretty_print core + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-ast-core" in + let doc = "Subcommand: Print the AST.\n Warning: Intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + +let print_ast_typed = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind typed,_ = Compile.Utils.type_file source_file syntax Env in ok @@ Format.asprintf "%a\n" Compile.Of_typed.pretty_print typed ) in let term = Term.(const f $ source_file 0 $ syntax $ display_format) in - let cmdname = "print-typed-ast" in + let cmdname = "print-ast-typed" in let doc = "Subcommand: Print the typed AST.\n Warning: Intended for development of LIGO and can break at any time." in (Term.ret term, Term.info ~doc cmdname) let print_mini_c = let f source_file syntax display_format = ( toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile Env simplified in + let%bind typed,_ = Compile.Utils.type_file source_file syntax Env in let%bind mini_c = Compile.Of_typed.compile typed in ok @@ Format.asprintf "%a\n" Compile.Of_mini_c.pretty_print mini_c ) @@ -207,11 +228,7 @@ let print_mini_c = let measure_contract = let f source_file entry_point syntax display_format = toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile (Contract entry_point) simplified in - let%bind mini_c = Compile.Of_typed.compile typed in - let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c entry_point in - let%bind contract = Compile.Of_michelson.build_contract michelson in + let%bind contract = Compile.Utils.compile_file source_file syntax entry_point in let open Tezos_utils in ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract) in @@ -224,8 +241,7 @@ let measure_contract = let compile_parameter = let f source_file entry_point expression syntax amount balance sender source predecessor_timestamp display_format michelson_format = toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in + let%bind typed_prg,state = Compile.Utils.type_file source_file syntax (Contract entry_point) in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in let env = Ast_typed.program_environment typed_prg in @@ -233,9 +249,7 @@ let compile_parameter = (* fails if the given entry point is not a valid contract *) Compile.Of_michelson.build_contract michelson_prg in - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in - let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in - let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in + let%bind (typed_param,_) = Compile.Utils.type_expression (Some source_file) syntax expression env state in let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in let%bind () = Compile.Of_typed.assert_equal_contract_type Check_parameter entry_point typed_prg typed_param in @@ -255,16 +269,13 @@ let interpret = toplevel ~display_format @@ let%bind (decl_list,state,env) = match init_file with | Some init_file -> - let%bind simplified = Compile.Of_source.compile init_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile Env simplified in + let%bind typed_prg,state = Compile.Utils.type_file init_file syntax Env in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let env = Ast_typed.program_environment typed_prg in ok (mini_c_prg,state,env) | None -> ok ([],Typer.Solver.initial_state,Ast_typed.Environment.full_empty) in - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) init_file in - let%bind simplified_exp = Compile.Of_source.compile_expression v_syntax expression in - let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_exp in + let%bind (typed_exp,_) = Compile.Utils.type_expression init_file syntax expression env state in let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in let%bind compiled_exp = Compile.Of_mini_c.aggregate_and_compile_expression decl_list mini_c_exp in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in @@ -274,8 +285,8 @@ let interpret = let%bind failstring = Run.failwith_to_string fail_res in ok @@ Format.asprintf "%s" failstring | Success value' -> - let%bind simplified_output = Uncompile.uncompile_expression typed_exp.type_expression value' in - ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output + let%bind core_output = Uncompile.uncompile_expression typed_exp.type_expression value' in + ok @@ Format.asprintf "%a\n" Ast_core.PP.expression core_output in let term = Term.(const f $ expression "EXPRESSION" 0 $ init_file $ syntax $ amount $ balance $ sender $ source $ predecessor_timestamp $ display_format ) in @@ -286,8 +297,7 @@ let interpret = let temp_ligo_interpreter = let f source_file syntax display_format = toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile Env simplified in + let%bind typed,_ = Compile.Utils.type_file source_file syntax Env in let%bind res = Compile.Of_typed.some_interpret typed in ok @@ Format.asprintf "%s\n" res in @@ -300,8 +310,7 @@ let temp_ligo_interpreter = let compile_storage = let f source_file entry_point expression syntax amount balance sender source predecessor_timestamp display_format michelson_format = toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in + let%bind typed_prg,state = Compile.Utils.type_file source_file syntax (Contract entry_point) in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in let env = Ast_typed.program_environment typed_prg in @@ -309,9 +318,7 @@ let compile_storage = (* fails if the given entry point is not a valid contract *) Compile.Of_michelson.build_contract michelson_prg in - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in - let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in - let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in + let%bind (typed_param,_) = Compile.Utils.type_expression (Some source_file) syntax expression env state in let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in let%bind () = Compile.Of_typed.assert_equal_contract_type Check_storage entry_point typed_prg typed_param in @@ -329,8 +336,7 @@ let compile_storage = let dry_run = let f source_file entry_point storage input amount balance sender source predecessor_timestamp syntax display_format = toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in + let%bind typed_prg,state = Compile.Utils.type_file source_file syntax (Contract entry_point) in let env = Ast_typed.program_environment typed_prg in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in @@ -338,11 +344,7 @@ let dry_run = (* fails if the given entry point is not a valid contract *) Compile.Of_michelson.build_contract michelson_prg in - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in - let%bind simplified = Compile.Of_source.compile_contract_input storage input v_syntax in - let%bind typed,_ = Compile.Of_simplified.compile_expression ~env ~state simplified in - let%bind mini_c = Compile.Of_typed.compile_expression typed in - let%bind compiled_params = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c in + let%bind compiled_params = Compile.Utils.compile_storage storage input source_file syntax env state mini_c_prg in let%bind args_michelson = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in @@ -352,8 +354,8 @@ let dry_run = let%bind failstring = Run.failwith_to_string fail_res in ok @@ Format.asprintf "%s" failstring | Success michelson_output -> - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in - ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output + let%bind core_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in + ok @@ Format.asprintf "%a\n" Ast_core.PP.expression core_output in let term = Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in @@ -364,16 +366,17 @@ let dry_run = let run_function = let f source_file entry_point parameter amount balance sender source predecessor_timestamp syntax display_format = toplevel ~display_format @@ - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in - let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile Env simplified_prg in + let%bind typed_prg,state = Compile.Utils.type_file source_file syntax Env in let env = Ast_typed.program_environment typed_prg in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in - let%bind simplified_param = Compile.Of_source.compile_expression v_syntax parameter in - let%bind app = Compile.Of_simplified.apply entry_point simplified_param in - let%bind (typed_app,_) = Compile.Of_simplified.compile_expression ~env ~state app in + let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in + let%bind imperative_param = Compile.Of_source.compile_expression v_syntax parameter in + let%bind sugar_param = Compile.Of_imperative.compile_expression imperative_param in + let%bind core_param = Compile.Of_sugar.compile_expression sugar_param in + let%bind app = Compile.Of_core.apply entry_point core_param in + let%bind (typed_app,_) = Compile.Of_core.compile_expression ~env ~state app in let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in @@ -384,8 +387,8 @@ let run_function = let%bind failstring = Run.failwith_to_string fail_res in ok @@ Format.asprintf "%s" failstring | Success michelson_output -> - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in - ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output + let%bind core_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in + ok @@ Format.asprintf "%a\n" Ast_core.PP.expression core_output in let term = Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in @@ -396,15 +399,14 @@ let run_function = let evaluate_value = let f source_file entry_point amount balance sender source predecessor_timestamp syntax display_format = toplevel ~display_format @@ - let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,_ = Compile.Of_simplified.compile Env simplified in + let%bind typed_prg,_ = Compile.Utils.type_file source_file syntax Env in let%bind mini_c = Compile.Of_typed.compile typed_prg in let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in let%bind michelson_output = Run.run_no_failwith ~options compiled.expr compiled.expr_ty in - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in - ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output + let%bind core_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in + ok @@ Format.asprintf "%a\n" Ast_core.PP.expression core_output in let term = Term.(const f $ source_file 0 $ entry_point 1 $ amount $ balance $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in @@ -415,13 +417,9 @@ let evaluate_value = let compile_expression = let f expression syntax display_format michelson_format = toplevel ~display_format @@ - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (None) in let env = Ast_typed.Environment.full_empty in let state = Typer.Solver.initial_state in - let%bind simplified = Compile.Of_source.compile_expression v_syntax expression in - let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified in - let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in - let%bind compiled_exp = Compile.Of_mini_c.compile_expression mini_c_exp in + let%bind compiled_exp = Compile.Utils.compile_expression None syntax expression env state in let%bind value = Run.evaluate_expression compiled_exp.expr compiled_exp.expr_ty in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in @@ -442,8 +440,8 @@ let dump_changelog = let list_declarations = let f source_file syntax = toplevel ~display_format:(`Human_readable) @@ - let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in - let json_decl = List.map (fun decl -> `String decl) @@ Compile.Of_simplified.list_declarations simplified_prg in + let%bind core_prg = Compile.Utils.to_core source_file syntax in + let json_decl = List.map (fun decl -> `String decl) @@ Compile.Of_core.list_declarations core_prg in ok @@ J.to_string @@ `Assoc [ ("source_file", `String source_file) ; ("declarations", `List json_decl) ] in let term = @@ -467,7 +465,9 @@ let run ?argv () = dump_changelog ; print_cst ; print_ast ; - print_typed_ast ; + print_ast_sugar ; + print_ast_core ; + print_ast_typed ; print_mini_c ; list_declarations ; ] diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 3bcb48aa0..984a0163b 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -1174,7 +1174,7 @@ let%expect_test _ = let%expect_test _ = run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ; [%expect {| -ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#812 = #P in let p = rhs#812.0 in let s = rhs#812.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"} +ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#654 = #P in let p = rhs#654.0 in let s = rhs#654.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"} If you're not sure how to fix this error, you can @@ -1187,7 +1187,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ; [%expect {| -ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#815 = #P in let p = rhs#815.0 in let s = rhs#815.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"} +ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#657 = #P in let p = rhs#657.0 in let s = rhs#657.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"} If you're not sure how to fix this error, you can @@ -1344,4 +1344,56 @@ let%expect_test _ = * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ * Ask a question on our Discord: https://discord.gg/9rhYaEt * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new - * Check the changelog by running 'ligo changelog' |}] + * Check the changelog by running 'ligo changelog' |}]; + + run_ligo_bad ["compile-contract"; bad_contract "nested_bigmap_1.religo"; "main"]; + [%expect {| + ligo: It looks like you have nested a big map inside another big map. This is not supported. : {} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}]; + + run_ligo_bad ["compile-contract"; bad_contract "nested_bigmap_2.religo"; "main"]; + [%expect {| + ligo: It looks like you have nested a big map inside another big map. This is not supported. : {} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}]; + + run_ligo_bad ["compile-contract"; bad_contract "nested_bigmap_3.religo"; "main"]; + [%expect {| + ligo: It looks like you have nested a big map inside another big map. This is not supported. : {} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}]; + + run_ligo_bad ["compile-contract"; bad_contract "nested_bigmap_4.religo"; "main"]; + [%expect {| + ligo: It looks like you have nested a big map inside another big map. This is not supported. : {} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}] \ No newline at end of file diff --git a/src/bin/expect_tests/help_tests.ml b/src/bin/expect_tests/help_tests.ml index d1028bfab..f960cc6b9 100644 --- a/src/bin/expect_tests/help_tests.ml +++ b/src/bin/expect_tests/help_tests.ml @@ -57,6 +57,18 @@ let%expect_test _ = Subcommand: Print the AST. Warning: Intended for development of LIGO and can break at any time. + print-ast-core + Subcommand: Print the AST. Warning: Intended for development of + LIGO and can break at any time. + + print-ast-sugar + Subcommand: Print the AST. Warning: Intended for development of + LIGO and can break at any time. + + print-ast-typed + Subcommand: Print the typed AST. Warning: Intended for development + of LIGO and can break at any time. + print-cst Subcommand: Print the CST. Warning: Intended for development of LIGO and can break at any time. @@ -65,10 +77,6 @@ let%expect_test _ = Subcommand: Print Mini-C. Warning: Intended for development of LIGO and can break at any time. - print-typed-ast - Subcommand: Print the typed AST. Warning: Intended for development - of LIGO and can break at any time. - run-function Subcommand: Run a function with the given parameter. @@ -136,6 +144,18 @@ let%expect_test _ = Subcommand: Print the AST. Warning: Intended for development of LIGO and can break at any time. + print-ast-core + Subcommand: Print the AST. Warning: Intended for development of + LIGO and can break at any time. + + print-ast-sugar + Subcommand: Print the AST. Warning: Intended for development of + LIGO and can break at any time. + + print-ast-typed + Subcommand: Print the typed AST. Warning: Intended for development + of LIGO and can break at any time. + print-cst Subcommand: Print the CST. Warning: Intended for development of LIGO and can break at any time. @@ -144,10 +164,6 @@ let%expect_test _ = Subcommand: Print Mini-C. Warning: Intended for development of LIGO and can break at any time. - print-typed-ast - Subcommand: Print the typed AST. Warning: Intended for development - of LIGO and can break at any time. - run-function Subcommand: Run a function with the given parameter. diff --git a/src/main/compile/dune b/src/main/compile/dune index 98ff34494..6a900909f 100644 --- a/src/main/compile/dune +++ b/src/main/compile/dune @@ -5,14 +5,20 @@ simple-utils tezos-utils parser - simplify - interpreter - ast_simplified - self_ast_simplified + concrete_to_imperative + ast_imperative + self_ast_imperative + imperative_to_sugar + ast_sugar + self_ast_sugar + sugar_to_core + ast_core + self_ast_core typer_new typer ast_typed self_ast_typed + interpreter transpiler mini_c self_mini_c diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 95038a5b9..1b8b390fc 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -23,55 +23,55 @@ let parsify_pascaligo source = let%bind raw = trace (simple_error "parsing") @@ Parser.Pascaligo.parse_file source in - let%bind simplified = - trace (simple_error "simplifying") @@ - Simplify.Pascaligo.simpl_program raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting") @@ + Concrete_to_imperative.Pascaligo.compile_program raw + in ok imperative let parsify_expression_pascaligo source = let%bind raw = trace (simple_error "parsing expression") @@ Parser.Pascaligo.parse_expression source in - let%bind simplified = - trace (simple_error "simplifying expression") @@ - Simplify.Pascaligo.simpl_expression raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting expression") @@ + Concrete_to_imperative.Pascaligo.compile_expression raw + in ok imperative let parsify_cameligo source = let%bind raw = trace (simple_error "parsing") @@ Parser.Cameligo.parse_file source in - let%bind simplified = - trace (simple_error "simplifying") @@ - Simplify.Cameligo.simpl_program raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting") @@ + Concrete_to_imperative.Cameligo.compile_program raw + in ok imperative let parsify_expression_cameligo source = let%bind raw = trace (simple_error "parsing expression") @@ Parser.Cameligo.parse_expression source in - let%bind simplified = - trace (simple_error "simplifying expression") @@ - Simplify.Cameligo.simpl_expression raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting expression") @@ + Concrete_to_imperative.Cameligo.compile_expression raw + in ok imperative let parsify_reasonligo source = let%bind raw = trace (simple_error "parsing") @@ Parser.Reasonligo.parse_file source in - let%bind simplified = - trace (simple_error "simplifying") @@ - Simplify.Cameligo.simpl_program raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting") @@ + Concrete_to_imperative.Cameligo.compile_program raw + in ok imperative let parsify_expression_reasonligo source = let%bind raw = trace (simple_error "parsing expression") @@ Parser.Reasonligo.parse_expression source in - let%bind simplified = - trace (simple_error "simplifying expression") @@ - Simplify.Cameligo.simpl_expression raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting expression") @@ + Concrete_to_imperative.Cameligo.compile_expression raw + in ok imperative let parsify syntax source = let%bind parsify = @@ -80,7 +80,7 @@ let parsify syntax source = | CameLIGO -> ok parsify_cameligo | ReasonLIGO -> ok parsify_reasonligo in let%bind parsified = parsify source in - let%bind applied = Self_ast_simplified.all_program parsified + let%bind applied = Self_ast_imperative.all_program parsified in ok applied let parsify_expression syntax source = @@ -89,35 +89,35 @@ let parsify_expression syntax source = | CameLIGO -> ok parsify_expression_cameligo | ReasonLIGO -> ok parsify_expression_reasonligo in let%bind parsified = parsify source in - let%bind applied = Self_ast_simplified.all_expression parsified + let%bind applied = Self_ast_imperative.all_expression parsified in ok applied let parsify_string_reasonligo source = let%bind raw = trace (simple_error "parsing") @@ Parser.Reasonligo.parse_string source in - let%bind simplified = - trace (simple_error "simplifying") @@ - Simplify.Cameligo.simpl_program raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting") @@ + Concrete_to_imperative.Cameligo.compile_program raw + in ok imperative let parsify_string_pascaligo source = let%bind raw = trace (simple_error "parsing") @@ Parser.Pascaligo.parse_string source in - let%bind simplified = - trace (simple_error "simplifying") @@ - Simplify.Pascaligo.simpl_program raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting") @@ + Concrete_to_imperative.Pascaligo.compile_program raw + in ok imperative let parsify_string_cameligo source = let%bind raw = trace (simple_error "parsing") @@ Parser.Cameligo.parse_string source in - let%bind simplified = - trace (simple_error "simplifying") @@ - Simplify.Cameligo.simpl_program raw - in ok simplified + let%bind imperative = + trace (simple_error "abstracting") @@ + Concrete_to_imperative.Cameligo.compile_program raw + in ok imperative let parsify_string syntax source = let%bind parsify = @@ -126,7 +126,7 @@ let parsify_string syntax source = | CameLIGO -> ok parsify_string_cameligo | ReasonLIGO -> ok parsify_string_reasonligo in let%bind parsified = parsify source in - let%bind applied = Self_ast_simplified.all_program parsified + let%bind applied = Self_ast_imperative.all_program parsified in ok applied let pretty_print_pascaligo source = diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_core.ml similarity index 59% rename from src/main/compile/of_simplified.ml rename to src/main/compile/of_core.ml index 433321da4..e6f0dfbba 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_core.ml @@ -4,7 +4,7 @@ type form = | Contract of string | Env -let compile (cform: form) (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solver.state) result = +let compile (cform: form) (program : Ast_core.program) : (Ast_typed.program * Typer.Solver.state) result = let%bind (prog_typed , state) = Typer.type_program program in let () = Typer.Solver.discard_state state in let%bind applied = Self_ast_typed.all_program prog_typed in @@ -13,31 +13,31 @@ let compile (cform: form) (program : Ast_simplified.program) : (Ast_typed.progra | Env -> ok applied in ok @@ (applied', state) -let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) +let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (e : Ast_core.expression) : (Ast_typed.expression * Typer.Solver.state) result = - let%bind (ae_typed,state) = Typer.type_expression_subst env state ae in + let%bind (ae_typed,state) = Typer.type_expression_subst env state e in let () = Typer.Solver.discard_state state in let%bind ae_typed' = Self_ast_typed.all_expression ae_typed in ok @@ (ae_typed',state) -let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simplified.expression result = +let apply (entry_point : string) (param : Ast_core.expression) : Ast_core.expression result = let name = Var.of_name entry_point in - let entry_point_var : Ast_simplified.expression = - { expression_content = Ast_simplified.E_variable name ; + let entry_point_var : Ast_core.expression = + { expression_content = Ast_core.E_variable name ; location = Virtual "generated entry-point variable" } in - let applied : Ast_simplified.expression = - { expression_content = Ast_simplified.E_application {expr1=entry_point_var; expr2=param} ; + let applied : Ast_core.expression = + { expression_content = Ast_core.E_application {lamb=entry_point_var; args=param} ; location = Virtual "generated application" } in ok applied -let pretty_print formatter (program : Ast_simplified.program) = - Ast_simplified.PP.program formatter program +let pretty_print formatter (program : Ast_core.program) = + Ast_core.PP.program formatter program -let list_declarations (program : Ast_simplified.program) : string list = +let list_declarations (program : Ast_core.program) : string list = List.fold_left (fun prev el -> let open Location in - let open Ast_simplified in + let open Ast_core in match el.wrap_content with | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev | _ -> prev) diff --git a/src/main/compile/of_imperative.ml b/src/main/compile/of_imperative.ml new file mode 100644 index 000000000..ed12a128e --- /dev/null +++ b/src/main/compile/of_imperative.ml @@ -0,0 +1,25 @@ +open Trace +open Ast_imperative +open Imperative_to_sugar + +type form = + | Contract of string + | Env + +let compile (program : program) : Ast_sugar.program result = + compile_program program + +let compile_expression (e : expression) : Ast_sugar.expression result = + compile_expression e + +let pretty_print formatter (program : program) = + PP.program formatter program + +let list_declarations (program : program) : string list = + List.fold_left + (fun prev el -> + let open Location in + match el.wrap_content with + | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev + | _ -> prev) + [] program diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index 3a075ac9e..8b737237b 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -1,23 +1,23 @@ open Trace open Helpers -let compile (source_filename:string) syntax : Ast_simplified.program result = +let compile (source_filename:string) syntax : Ast_imperative.program result = let%bind syntax = syntax_to_variant syntax (Some source_filename) in - let%bind simplified = parsify syntax source_filename in - ok simplified + let%bind abstract = parsify syntax source_filename in + ok abstract -let compile_string (source:string) syntax : Ast_simplified.program result = - let%bind simplified = parsify_string syntax source in - ok simplified +let compile_string (source:string) syntax : Ast_imperative.program result = + let%bind abstract = parsify_string syntax source in + ok abstract -let compile_expression : v_syntax -> string -> Ast_simplified.expression result = +let compile_expression : v_syntax -> string -> Ast_imperative.expression result = fun syntax exp -> parsify_expression syntax exp -let compile_contract_input : string -> string -> v_syntax -> Ast_simplified.expression result = +let compile_contract_input : string -> string -> v_syntax -> Ast_imperative.expression result = fun storage parameter syntax -> let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in - ok @@ Ast_simplified.e_pair storage parameter + ok @@ Ast_imperative.e_pair storage parameter let pretty_print source_filename syntax = - Helpers.pretty_print syntax source_filename \ No newline at end of file + Helpers.pretty_print syntax source_filename diff --git a/src/main/compile/of_sugar.ml b/src/main/compile/of_sugar.ml new file mode 100644 index 000000000..b52607af7 --- /dev/null +++ b/src/main/compile/of_sugar.ml @@ -0,0 +1,25 @@ +open Trace +open Ast_sugar +open Sugar_to_core + +type form = + | Contract of string + | Env + +let compile (program : program) : Ast_core.program result = + compile_program program + +let compile_expression (e : expression) : Ast_core.expression result = + compile_expression e + +let pretty_print formatter (program : program) = + PP.program formatter program + +let list_declarations (program : program) : string list = + List.fold_left + (fun prev el -> + let open Location in + match el.wrap_content with + | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev + | _ -> prev) + [] program diff --git a/src/main/compile/utils.ml b/src/main/compile/utils.ml new file mode 100644 index 000000000..ab8ac6503 --- /dev/null +++ b/src/main/compile/utils.ml @@ -0,0 +1,65 @@ +open Trace + +let to_imperatve f stx = + let%bind imperative = Of_source.compile f (Syntax_name stx) in + ok @@ imperative + +let to_sugar f stx = + let%bind imperative = to_imperatve f stx in + let%bind sugar = Of_imperative.compile imperative in + ok @@ sugar + +let to_core f stx = + let%bind sugar = to_sugar f stx in + let%bind core = Of_sugar.compile sugar in + ok @@ core + +let type_file f stx env = + let%bind core = to_core f stx in + let%bind typed,state = Of_core.compile env core in + ok @@ (typed,state) + +let to_mini_c f stx env = + let%bind typed, _ = type_file f stx env in + let%bind mini_c = Of_typed.compile typed in + ok @@ mini_c + +let compile_file f stx ep = + let%bind typed, _ = type_file f stx @@ Contract ep in + let%bind mini_c = Of_typed.compile typed in + let%bind michelson = Of_mini_c.aggregate_and_compile_contract mini_c ep in + let%bind contract = Of_michelson.build_contract michelson in + ok @@ contract + +let type_expression source_file syntax expression env state = + let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) source_file in + let%bind imperative_exp = Of_source.compile_expression v_syntax expression in + let%bind sugar_exp = Of_imperative.compile_expression imperative_exp in + let%bind core_exp = Of_sugar.compile_expression sugar_exp in + let%bind (typed_exp,state) = Of_core.compile_expression ~env ~state core_exp in + ok @@ (typed_exp,state) + +let expression_to_mini_c source_file syntax expression env state = + let%bind (typed_exp,_) = type_expression source_file syntax expression env state in + let%bind mini_c_exp = Of_typed.compile_expression typed_exp in + ok @@ mini_c_exp + +let compile_expression source_file syntax expression env state = + let%bind mini_c_exp = expression_to_mini_c source_file syntax expression env state in + let%bind compiled = Of_mini_c.compile_expression mini_c_exp in + ok @@ compiled + +let compile_and_aggregate_expression source_file syntax expression env state mini_c_prg = + let%bind mini_c_exp = expression_to_mini_c source_file syntax expression env state in + let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_exp in + ok @@ compiled + +let compile_storage storage input source_file syntax env state mini_c_prg = + let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in + let%bind imperative = Of_source.compile_contract_input storage input v_syntax in + let%bind sugar = Of_imperative.compile_expression imperative in + let%bind core = Of_sugar.compile_expression sugar in + let%bind typed,_ = Of_core.compile_expression ~env ~state core in + let%bind mini_c = Of_typed.compile_expression typed in + let%bind compiled = Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c in + ok @@ compiled diff --git a/src/main/run/dune b/src/main/run/dune index faaedeab4..c5179a3e6 100644 --- a/src/main/run/dune +++ b/src/main/run/dune @@ -5,8 +5,10 @@ simple-utils tezos-utils parser - simplify - ast_simplified + concrete_to_imperative + self_ast_imperative + sugar_to_core + ast_core typer_new typer ast_typed diff --git a/src/main/uncompile/dune b/src/main/uncompile/dune index bf039deb8..8762c6abf 100644 --- a/src/main/uncompile/dune +++ b/src/main/uncompile/dune @@ -4,6 +4,8 @@ (libraries simple-utils compiler + imperative_to_sugar + sugar_to_core typer_new typer ast_typed diff --git a/src/main/uncompile/uncompile.ml b/src/main/uncompile/uncompile.ml index 6d43fba15..3adf7445e 100644 --- a/src/main/uncompile/uncompile.ml +++ b/src/main/uncompile/uncompile.ml @@ -10,7 +10,8 @@ let uncompile_value func_or_expr program entry ex_ty_value = ok output_type in let%bind mini_c = Compiler.Uncompiler.translate_value ex_ty_value in let%bind typed = Transpiler.untranspile mini_c output_type in - Typer.untype_expression typed + let%bind core = Typer.untype_expression typed in + ok @@ core let uncompile_typed_program_entry_expression_result program entry ex_ty_value = uncompile_value Expression program entry ex_ty_value diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index f487e306e..5b6a09dfc 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -24,23 +24,21 @@ type 'a sequence_or_record = let (<@) f g x = f (g x) -(** - Covert nsepseq to a chain of TFun's. +(* + Convert a nsepseq to a chain of TFun's. Necessary to handle cases like: - `type foo = (int, int) => int;` + [type foo = (int, int) => int;] *) -let rec nsepseq_to_curry hd rest = - match hd, rest with - | hd, (sep, item) :: rest -> - let start = type_expr_to_region hd in - let stop = nsepseq_to_region type_expr_to_region (hd, rest) in - let region = cover start stop in - TFun { - value = hd, sep, (nsepseq_to_curry item rest); - region - } - | hd, [] -> hd + +let rec curry hd = function + (sep, item)::rest -> + let stop = nsepseq_to_region type_expr_to_region (hd, rest) + and start = type_expr_to_region hd in + let region = cover start stop + and value = hd, sep, curry item rest + in TFun {value; region} +| [] -> hd (* END HEADER *) %} @@ -58,6 +56,7 @@ let rec nsepseq_to_curry hd rest = can be reduced to [expr -> Ident], but also to [field_assignment -> Ident]. *) + %nonassoc Ident %nonassoc COLON @@ -175,42 +174,32 @@ type_decl: in {region; value} } type_expr: - cartesian | sum_type | record_type { $1 } + fun_type | sum_type | record_type { $1 } -type_expr_func: - "=>" cartesian { - $1, $2 +fun_type: + type_name "=>" fun_type { + let region = cover $1.region (type_expr_to_region $3) + in TFun {region; value = TVar $1, $2, $3} } +| "(" fun_type ")" "=>" fun_type { + let region = cover $1 (type_expr_to_region $5) + in TFun {region; value = $2,$4,$5} + } +| "(" tuple(fun_type) ")" "=>" fun_type { + let hd, rest = $2 in curry hd (rest @ [($4,$5)]) + } +| "(" tuple(fun_type) ")" { + TProd {region = cover $1 $3; value = $2} + } +| core_type { $1 } -cartesian: - core_type { $1 } -| type_name type_expr_func { - let (arrow, c) = $2 in - let value = TVar $1, arrow, c in - let region = cover $1.region (type_expr_to_region c) in - TFun { region; value } -} -| "(" cartesian ")" type_expr_func { - let (arrow, c) = $4 in - let value = $2, arrow, c in - let region = cover $1 (type_expr_to_region c) in - TFun { region; value } -} -| "(" cartesian "," nsepseq(cartesian,",") ")" type_expr_func? { - match $6 with - | Some (arrow, c) -> - let (hd, rest) = Utils.nsepseq_cons $2 $3 $4 in - let rest = rest @ [(arrow, c)] in - nsepseq_to_curry hd rest - | None -> - let value = Utils.nsepseq_cons $2 $3 $4 in - let region = cover $1 $5 in - TProd {region; value} - } +type_args: + tuple(fun_type) { $1 } +| fun_type { $1, [] } core_type: type_name { TVar $1 } -| par(cartesian) { TPar $1 } +| par(fun_type) { TPar $1 } | module_name "." type_name { let module_name = $1.value in let type_name = $3.value in @@ -218,12 +207,9 @@ core_type: let region = cover $1.region $3.region in TVar {region; value} } -| type_name par(nsepseq(core_type,",") { $1 }) { - let constr, arg = $1, $2 in - let start = constr.region - and stop = arg.region in - let region = cover start stop - in TApp {region; value = constr,arg} } +| type_name par(type_args) { + let region = cover $1.region $2.region + in TApp {region; value = $1,$2} } sum_type: ioption("|") nsepseq(variant,"|") { @@ -233,7 +219,7 @@ sum_type: variant: "" { {$1 with value={constr=$1; arg=None}} } -| "" "(" cartesian ")" { +| "" "(" fun_type ")" { let region = cover $1.region $4 and value = {constr=$1; arg = Some (ghost,$3)} in {region; value} } @@ -274,9 +260,6 @@ let_declaration: let region = cover $2 stop in {region; value} } -es6_func: - "=>" expr { $1,$2 } - let_binding: "" type_annotation? "=" expr { Scoping.check_reserved_name $1; @@ -452,13 +435,12 @@ type_expr_simple: type_annotation_simple: ":" type_expr_simple { $1,$2 } - fun_expr: - disj_expr_level es6_func { - let arrow, body = $2 in - let kwd_fun = ghost in - let start = expr_to_region $1 in - let stop = expr_to_region body in + disj_expr_level "=>" expr { + let arrow, body = $2, $3 + and kwd_fun = ghost in + let start = expr_to_region $1 + and stop = expr_to_region body in let region = cover start stop in let rec arg_to_pattern = function @@ -525,8 +507,8 @@ fun_expr: match type_expr with | TProd {value; _} -> let (hd, rest) = value in - let rest = rest @ [(arrow, expr_to_type body)] in - nsepseq_to_curry hd rest + let rest = rest @ [(arrow, expr_to_type body)] + in curry hd rest | e -> TFun { value = e, arrow, expr_to_type body; diff --git a/src/passes/1-parser/reasonligo/error.messages.checked-in b/src/passes/1-parser/reasonligo/error.messages.checked-in index a00aed226..f075a2d1d 100644 --- a/src/passes/1-parser/reasonligo/error.messages.checked-in +++ b/src/passes/1-parser/reasonligo/error.messages.checked-in @@ -143,7 +143,7 @@ interactive_expr: Ident WILD interactive_expr: If LBRACE True VBAR ## -## Ends in an error in state: 228. +## Ends in an error in state: 227. ## ## parenthesized_expr -> LBRACE expr . RBRACE [ LBRACE ] ## @@ -173,7 +173,7 @@ interactive_expr: If LBRACE True VBAR interactive_expr: If LBRACE WILD ## -## Ends in an error in state: 227. +## Ends in an error in state: 226. ## ## parenthesized_expr -> LBRACE . expr RBRACE [ LBRACE ] ## @@ -185,7 +185,7 @@ interactive_expr: If LBRACE WILD interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True ARROW Bytes VBAR ## -## Ends in an error in state: 408. +## Ends in an error in state: 407. ## ## if_then_else(closed_if) -> If parenthesized_expr LBRACE closed_if . option(SEMI) RBRACE Else LBRACE closed_if option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -209,18 +209,17 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True ARROW ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 215, spurious reduction of production es6_func -> ARROW expr -## In state 223, spurious reduction of production fun_expr -> disj_expr_level es6_func -## In state 406, spurious reduction of production base_expr(closed_if) -> fun_expr -## In state 417, spurious reduction of production base_if_then_else__open(closed_if) -> base_expr(closed_if) -## In state 416, spurious reduction of production closed_if -> base_if_then_else__open(closed_if) +## In state 215, spurious reduction of production fun_expr -> disj_expr_level ARROW expr +## In state 405, spurious reduction of production base_expr(closed_if) -> fun_expr +## In state 416, spurious reduction of production base_if_then_else__open(closed_if) -> base_expr(closed_if) +## In state 415, spurious reduction of production closed_if -> base_if_then_else__open(closed_if) ## interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE Else LBRACE True ARROW Bytes VBAR ## -## Ends in an error in state: 413. +## Ends in an error in state: 412. ## ## if_then_else(closed_if) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE closed_if . option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -244,18 +243,17 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 215, spurious reduction of production es6_func -> ARROW expr -## In state 223, spurious reduction of production fun_expr -> disj_expr_level es6_func -## In state 406, spurious reduction of production base_expr(closed_if) -> fun_expr -## In state 417, spurious reduction of production base_if_then_else__open(closed_if) -> base_expr(closed_if) -## In state 416, spurious reduction of production closed_if -> base_if_then_else__open(closed_if) +## In state 215, spurious reduction of production fun_expr -> disj_expr_level ARROW expr +## In state 405, spurious reduction of production base_expr(closed_if) -> fun_expr +## In state 416, spurious reduction of production base_if_then_else__open(closed_if) -> base_expr(closed_if) +## In state 415, spurious reduction of production closed_if -> base_if_then_else__open(closed_if) ## interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE Else LBRACE True SEMI PLUS ## -## Ends in an error in state: 414. +## Ends in an error in state: 413. ## ## if_then_else(closed_if) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE closed_if option(SEMI) . RBRACE [ SEMI RBRACE ] ## @@ -267,7 +265,7 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE Else LBRACE WILD ## -## Ends in an error in state: 412. +## Ends in an error in state: 411. ## ## if_then_else(closed_if) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE . closed_if option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -279,7 +277,7 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE Else WILD ## -## Ends in an error in state: 411. +## Ends in an error in state: 410. ## ## if_then_else(closed_if) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else . LBRACE closed_if option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -291,7 +289,7 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE WILD ## -## Ends in an error in state: 410. +## Ends in an error in state: 409. ## ## if_then_else(closed_if) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE . Else LBRACE closed_if option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -303,7 +301,7 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True RBRACE interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True SEMI PLUS ## -## Ends in an error in state: 409. +## Ends in an error in state: 408. ## ## if_then_else(closed_if) -> If parenthesized_expr LBRACE closed_if option(SEMI) . RBRACE Else LBRACE closed_if option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -315,7 +313,7 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE True SEMI P interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE WILD ## -## Ends in an error in state: 350. +## Ends in an error in state: 349. ## ## if_then_else(closed_if) -> If parenthesized_expr LBRACE . closed_if option(SEMI) RBRACE Else LBRACE closed_if option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -327,7 +325,7 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR LBRACE WILD interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR WILD ## -## Ends in an error in state: 349. +## Ends in an error in state: 348. ## ## if_then_else(closed_if) -> If parenthesized_expr . LBRACE closed_if option(SEMI) RBRACE Else LBRACE closed_if option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -339,7 +337,7 @@ interactive_expr: If LPAR True RPAR LBRACE If LPAR Bytes RPAR WILD interactive_expr: If LPAR True RPAR LBRACE If WILD ## -## Ends in an error in state: 348. +## Ends in an error in state: 347. ## ## if_then_else(closed_if) -> If . parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE closed_if option(SEMI) RBRACE [ SEMI RBRACE ] ## @@ -351,7 +349,7 @@ interactive_expr: If LPAR True RPAR LBRACE If WILD interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR VBAR ## -## Ends in an error in state: 275. +## Ends in an error in state: 274. ## ## case_clause(base_if_then_else) -> VBAR . pattern ARROW base_if_then_else option(SEMI) [ VBAR RBRACE ] ## @@ -363,7 +361,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR VBAR interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW Bytes SEMI WILD ## -## Ends in an error in state: 437. +## Ends in an error in state: 436. ## ## nseq(case_clause(base_if_then_else)) -> case_clause(base_if_then_else) . seq(case_clause(base_if_then_else)) [ RBRACE ] ## @@ -375,7 +373,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW By interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW Bytes VBAR Bytes ARROW Bytes SEMI WILD ## -## Ends in an error in state: 439. +## Ends in an error in state: 438. ## ## seq(case_clause(base_if_then_else)) -> case_clause(base_if_then_else) . seq(case_clause(base_if_then_else)) [ RBRACE ] ## @@ -387,7 +385,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW By interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR LBRACE True ARROW Bytes VBAR ## -## Ends in an error in state: 418. +## Ends in an error in state: 417. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr LBRACE closed_if . option(SEMI) RBRACE Else LBRACE base_if_then_else option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -411,18 +409,17 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 215, spurious reduction of production es6_func -> ARROW expr -## In state 223, spurious reduction of production fun_expr -> disj_expr_level es6_func -## In state 406, spurious reduction of production base_expr(closed_if) -> fun_expr -## In state 417, spurious reduction of production base_if_then_else__open(closed_if) -> base_expr(closed_if) -## In state 416, spurious reduction of production closed_if -> base_if_then_else__open(closed_if) +## In state 215, spurious reduction of production fun_expr -> disj_expr_level ARROW expr +## In state 405, spurious reduction of production base_expr(closed_if) -> fun_expr +## In state 416, spurious reduction of production base_if_then_else__open(closed_if) -> base_expr(closed_if) +## In state 415, spurious reduction of production closed_if -> base_if_then_else__open(closed_if) ## interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR LBRACE True RBRACE Else LBRACE True SEMI PLUS ## -## Ends in an error in state: 428. +## Ends in an error in state: 427. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE base_if_then_else option(SEMI) . RBRACE [ VBAR SEMI RBRACE ] ## @@ -434,7 +431,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR LBRACE True RBRACE Else LBRACE True VBAR ## -## Ends in an error in state: 427. +## Ends in an error in state: 426. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE base_if_then_else . option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -455,16 +452,16 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If ## In state 203, spurious reduction of production comp_expr_level -> cat_expr_level ## In state 210, spurious reduction of production conj_expr_level -> comp_expr_level ## In state 217, spurious reduction of production disj_expr_level -> conj_expr_level -## In state 425, spurious reduction of production base_expr(base_if_then_else) -> disj_expr_level -## In state 430, spurious reduction of production base_if_then_else__open(base_if_then_else) -> base_expr(base_if_then_else) -## In state 426, spurious reduction of production base_if_then_else -> base_if_then_else__open(base_if_then_else) +## In state 424, spurious reduction of production base_expr(base_if_then_else) -> disj_expr_level +## In state 429, spurious reduction of production base_if_then_else__open(base_if_then_else) -> base_expr(base_if_then_else) +## In state 425, spurious reduction of production base_if_then_else -> base_if_then_else__open(base_if_then_else) ## interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR LBRACE True RBRACE Else LBRACE WILD ## -## Ends in an error in state: 422. +## Ends in an error in state: 421. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE . base_if_then_else option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -476,7 +473,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR LBRACE True RBRACE Else WILD ## -## Ends in an error in state: 421. +## Ends in an error in state: 420. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else . LBRACE base_if_then_else option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -488,7 +485,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR LBRACE True RBRACE WILD ## -## Ends in an error in state: 420. +## Ends in an error in state: 419. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE . Else LBRACE base_if_then_else option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -500,7 +497,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR LBRACE True SEMI PLUS ## -## Ends in an error in state: 419. +## Ends in an error in state: 418. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr LBRACE closed_if option(SEMI) . RBRACE Else LBRACE base_if_then_else option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -512,7 +509,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR LBRACE WILD ## -## Ends in an error in state: 347. +## Ends in an error in state: 346. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr LBRACE . closed_if option(SEMI) RBRACE Else LBRACE base_if_then_else option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -524,7 +521,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If LPAR Bytes RPAR WILD ## -## Ends in an error in state: 346. +## Ends in an error in state: 345. ## ## if_then_else(base_if_then_else) -> If parenthesized_expr . LBRACE closed_if option(SEMI) RBRACE Else LBRACE base_if_then_else option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -536,7 +533,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If WILD ## -## Ends in an error in state: 345. +## Ends in an error in state: 344. ## ## if_then_else(base_if_then_else) -> If . parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE base_if_then_else option(SEMI) RBRACE [ VBAR SEMI RBRACE ] ## @@ -548,7 +545,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW If interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW True ARROW Bytes Type ## -## Ends in an error in state: 431. +## Ends in an error in state: 430. ## ## case_clause(base_if_then_else) -> VBAR pattern ARROW base_if_then_else . option(SEMI) [ VBAR RBRACE ] ## @@ -572,23 +569,22 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW Tr ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 215, spurious reduction of production es6_func -> ARROW expr -## In state 223, spurious reduction of production fun_expr -> disj_expr_level es6_func -## In state 424, spurious reduction of production base_expr(base_if_then_else) -> fun_expr -## In state 430, spurious reduction of production base_if_then_else__open(base_if_then_else) -> base_expr(base_if_then_else) -## In state 426, spurious reduction of production base_if_then_else -> base_if_then_else__open(base_if_then_else) +## In state 215, spurious reduction of production fun_expr -> disj_expr_level ARROW expr +## In state 423, spurious reduction of production base_expr(base_if_then_else) -> fun_expr +## In state 429, spurious reduction of production base_if_then_else__open(base_if_then_else) -> base_expr(base_if_then_else) +## In state 425, spurious reduction of production base_if_then_else -> base_if_then_else__open(base_if_then_else) ## interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW True Type ## -## Ends in an error in state: 425. +## Ends in an error in state: 424. ## ## base_expr(base_if_then_else) -> disj_expr_level . [ VBAR SEMI RBRACE ] ## bin_op(disj_expr_level,BOOL_OR,conj_expr_level) -> disj_expr_level . BOOL_OR conj_expr_level [ VBAR SEMI RBRACE Or BOOL_OR ARROW ] ## bin_op(disj_expr_level,Or,conj_expr_level) -> disj_expr_level . Or conj_expr_level [ VBAR SEMI RBRACE Or BOOL_OR ARROW ] -## fun_expr -> disj_expr_level . es6_func [ VBAR SEMI RBRACE ] +## fun_expr -> disj_expr_level . ARROW expr [ VBAR SEMI RBRACE ] ## ## The known suffix of the stack is as follows: ## disj_expr_level @@ -613,7 +609,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW Tr interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW WILD ## -## Ends in an error in state: 344. +## Ends in an error in state: 343. ## ## case_clause(base_if_then_else) -> VBAR pattern ARROW . base_if_then_else option(SEMI) [ VBAR RBRACE ] ## @@ -625,7 +621,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD ARROW WI interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD COMMA Bytes RPAR ## -## Ends in an error in state: 343. +## Ends in an error in state: 342. ## ## case_clause(base_if_then_else) -> VBAR pattern . ARROW base_if_then_else option(SEMI) [ VBAR RBRACE ] ## @@ -636,16 +632,16 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE VBAR WILD COMMA By ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 329, spurious reduction of production nsepseq(sub_pattern,COMMA) -> sub_pattern -## In state 332, spurious reduction of production tuple(sub_pattern) -> sub_pattern COMMA nsepseq(sub_pattern,COMMA) -## In state 341, spurious reduction of production pattern -> tuple(sub_pattern) +## In state 328, spurious reduction of production nsepseq(sub_pattern,COMMA) -> sub_pattern +## In state 331, spurious reduction of production tuple(sub_pattern) -> sub_pattern COMMA nsepseq(sub_pattern,COMMA) +## In state 340, spurious reduction of production pattern -> tuple(sub_pattern) ## interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE WILD ## -## Ends in an error in state: 274. +## Ends in an error in state: 273. ## ## switch_expr(base_if_then_else) -> Switch switch_expr_ LBRACE . cases(base_if_then_else) RBRACE [ SEMI RBRACE ] ## @@ -657,7 +653,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True LBRACE WILD interactive_expr: If LPAR True RPAR LBRACE Switch True WILD ## -## Ends in an error in state: 273. +## Ends in an error in state: 272. ## ## switch_expr(base_if_then_else) -> Switch switch_expr_ . LBRACE cases(base_if_then_else) RBRACE [ SEMI RBRACE ] ## @@ -669,7 +665,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch True WILD interactive_expr: If LPAR True RPAR LBRACE Switch WILD ## -## Ends in an error in state: 232. +## Ends in an error in state: 231. ## ## switch_expr(base_if_then_else) -> Switch . switch_expr_ LBRACE cases(base_if_then_else) RBRACE [ SEMI RBRACE ] ## @@ -681,7 +677,7 @@ interactive_expr: If LPAR True RPAR LBRACE Switch WILD interactive_expr: If LPAR True RPAR LBRACE True ARROW Bytes VBAR ## -## Ends in an error in state: 445. +## Ends in an error in state: 444. ## ## if_then(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if . option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## if_then_else(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if . option(SEMI) RBRACE Else LBRACE expr_with_let_expr option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] @@ -706,18 +702,17 @@ interactive_expr: If LPAR True RPAR LBRACE True ARROW Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 215, spurious reduction of production es6_func -> ARROW expr -## In state 223, spurious reduction of production fun_expr -> disj_expr_level es6_func -## In state 406, spurious reduction of production base_expr(closed_if) -> fun_expr -## In state 417, spurious reduction of production base_if_then_else__open(closed_if) -> base_expr(closed_if) -## In state 416, spurious reduction of production closed_if -> base_if_then_else__open(closed_if) +## In state 215, spurious reduction of production fun_expr -> disj_expr_level ARROW expr +## In state 405, spurious reduction of production base_expr(closed_if) -> fun_expr +## In state 416, spurious reduction of production base_if_then_else__open(closed_if) -> base_expr(closed_if) +## In state 415, spurious reduction of production closed_if -> base_if_then_else__open(closed_if) ## interactive_expr: If LPAR True RPAR LBRACE True RBRACE Else LBRACE True SEMI PLUS ## -## Ends in an error in state: 451. +## Ends in an error in state: 450. ## ## if_then_else(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE expr_with_let_expr option(SEMI) . RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## @@ -729,7 +724,7 @@ interactive_expr: If LPAR True RPAR LBRACE True RBRACE Else LBRACE True SEMI PLU interactive_expr: If LPAR True RPAR LBRACE True RBRACE Else LBRACE True VBAR ## -## Ends in an error in state: 450. +## Ends in an error in state: 449. ## ## if_then_else(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE expr_with_let_expr . option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## @@ -753,14 +748,14 @@ interactive_expr: If LPAR True RPAR LBRACE True RBRACE Else LBRACE True VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 400, spurious reduction of production expr_with_let_expr -> expr +## In state 399, spurious reduction of production expr_with_let_expr -> expr ## interactive_expr: If LPAR True RPAR LBRACE True RBRACE Else LBRACE WILD ## -## Ends in an error in state: 449. +## Ends in an error in state: 448. ## ## if_then_else(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else LBRACE . expr_with_let_expr option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## @@ -772,7 +767,7 @@ interactive_expr: If LPAR True RPAR LBRACE True RBRACE Else LBRACE WILD interactive_expr: If LPAR True RPAR LBRACE True RBRACE Else WILD ## -## Ends in an error in state: 448. +## Ends in an error in state: 447. ## ## if_then_else(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE Else . LBRACE expr_with_let_expr option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## @@ -784,7 +779,7 @@ interactive_expr: If LPAR True RPAR LBRACE True RBRACE Else WILD interactive_expr: If LPAR True RPAR LBRACE True RBRACE WILD ## -## Ends in an error in state: 447. +## Ends in an error in state: 446. ## ## if_then(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE . [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## if_then_else(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if option(SEMI) RBRACE . Else LBRACE expr_with_let_expr option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] @@ -797,7 +792,7 @@ interactive_expr: If LPAR True RPAR LBRACE True RBRACE WILD interactive_expr: If LPAR True RPAR LBRACE True SEMI PLUS ## -## Ends in an error in state: 446. +## Ends in an error in state: 445. ## ## if_then(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if option(SEMI) . RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## if_then_else(expr_with_let_expr) -> If parenthesized_expr LBRACE closed_if option(SEMI) . RBRACE Else LBRACE expr_with_let_expr option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] @@ -810,12 +805,12 @@ interactive_expr: If LPAR True RPAR LBRACE True SEMI PLUS interactive_expr: If LPAR True RPAR LBRACE True VBAR ## -## Ends in an error in state: 407. +## Ends in an error in state: 406. ## ## base_expr(closed_if) -> disj_expr_level . [ SEMI RBRACE ] ## bin_op(disj_expr_level,BOOL_OR,conj_expr_level) -> disj_expr_level . BOOL_OR conj_expr_level [ SEMI RBRACE Or BOOL_OR ARROW ] ## bin_op(disj_expr_level,Or,conj_expr_level) -> disj_expr_level . Or conj_expr_level [ SEMI RBRACE Or BOOL_OR ARROW ] -## fun_expr -> disj_expr_level . es6_func [ SEMI RBRACE ] +## fun_expr -> disj_expr_level . ARROW expr [ SEMI RBRACE ] ## ## The known suffix of the stack is as follows: ## disj_expr_level @@ -840,7 +835,7 @@ interactive_expr: If LPAR True RPAR LBRACE True VBAR interactive_expr: If LPAR True RPAR LBRACE WILD ## -## Ends in an error in state: 231. +## Ends in an error in state: 230. ## ## if_then(expr_with_let_expr) -> If parenthesized_expr LBRACE . closed_if option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## if_then_else(expr_with_let_expr) -> If parenthesized_expr LBRACE . closed_if option(SEMI) RBRACE Else LBRACE expr_with_let_expr option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] @@ -853,7 +848,7 @@ interactive_expr: If LPAR True RPAR LBRACE WILD interactive_expr: If LPAR True RPAR WILD ## -## Ends in an error in state: 230. +## Ends in an error in state: 229. ## ## if_then(expr_with_let_expr) -> If parenthesized_expr . LBRACE closed_if option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## if_then_else(expr_with_let_expr) -> If parenthesized_expr . LBRACE closed_if option(SEMI) RBRACE Else LBRACE expr_with_let_expr option(SEMI) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] @@ -866,7 +861,7 @@ interactive_expr: If LPAR True RPAR WILD interactive_expr: If LPAR True VBAR ## -## Ends in an error in state: 225. +## Ends in an error in state: 224. ## ## parenthesized_expr -> LPAR expr . RPAR [ LBRACE ] ## @@ -921,7 +916,7 @@ interactive_expr: If WILD interactive_expr: LBRACE ELLIPSIS Constr DOT Ident WILD ## -## Ends in an error in state: 251. +## Ends in an error in state: 250. ## ## projection -> Constr DOT Ident . selection [ COMMA ] ## @@ -933,7 +928,7 @@ interactive_expr: LBRACE ELLIPSIS Constr DOT Ident WILD interactive_expr: LBRACE ELLIPSIS Constr DOT WILD ## -## Ends in an error in state: 250. +## Ends in an error in state: 249. ## ## projection -> Constr DOT . Ident selection [ COMMA ] ## @@ -945,7 +940,7 @@ interactive_expr: LBRACE ELLIPSIS Constr DOT WILD interactive_expr: LBRACE ELLIPSIS Constr WILD ## -## Ends in an error in state: 249. +## Ends in an error in state: 248. ## ## projection -> Constr . DOT Ident selection [ COMMA ] ## @@ -957,7 +952,7 @@ interactive_expr: LBRACE ELLIPSIS Constr WILD interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COLON Bytes VBAR ## -## Ends in an error in state: 266. +## Ends in an error in state: 265. ## ## nsepseq(field_path_assignment,COMMA) -> field_path_assignment . [ RBRACE ] ## nsepseq(field_path_assignment,COMMA) -> field_path_assignment . COMMA nsepseq(field_path_assignment,COMMA) [ RBRACE ] @@ -983,14 +978,14 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COLON Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 265, spurious reduction of production field_path_assignment -> nsepseq(field_name,DOT) COLON expr +## In state 264, spurious reduction of production field_path_assignment -> nsepseq(field_name,DOT) COLON expr ## interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COLON WILD ## -## Ends in an error in state: 264. +## Ends in an error in state: 263. ## ## field_path_assignment -> nsepseq(field_name,DOT) COLON . expr [ RBRACE COMMA ] ## @@ -1002,7 +997,7 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COLON WILD interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COMMA Ident COLON Bytes VBAR ## -## Ends in an error in state: 270. +## Ends in an error in state: 269. ## ## nsepseq(field_path_assignment,COMMA) -> field_path_assignment . [ RBRACE ] ## nsepseq(field_path_assignment,COMMA) -> field_path_assignment . COMMA nsepseq(field_path_assignment,COMMA) [ RBRACE ] @@ -1028,14 +1023,14 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COMMA Ident COLON Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 265, spurious reduction of production field_path_assignment -> nsepseq(field_name,DOT) COLON expr +## In state 264, spurious reduction of production field_path_assignment -> nsepseq(field_name,DOT) COLON expr ## interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COMMA Ident COMMA WILD ## -## Ends in an error in state: 271. +## Ends in an error in state: 270. ## ## nsepseq(field_path_assignment,COMMA) -> field_path_assignment COMMA . nsepseq(field_path_assignment,COMMA) [ RBRACE ] ## seq(__anonymous_0(field_path_assignment,COMMA)) -> field_path_assignment COMMA . seq(__anonymous_0(field_path_assignment,COMMA)) [ RBRACE ] @@ -1048,7 +1043,7 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COMMA Ident COMMA WILD interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COMMA WILD ## -## Ends in an error in state: 267. +## Ends in an error in state: 266. ## ## nsepseq(field_path_assignment,COMMA) -> field_path_assignment COMMA . nsepseq(field_path_assignment,COMMA) [ RBRACE ] ## nseq(__anonymous_0(field_path_assignment,COMMA)) -> field_path_assignment COMMA . seq(__anonymous_0(field_path_assignment,COMMA)) [ RBRACE ] @@ -1061,7 +1056,7 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident COMMA WILD interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident DOT Ident WILD ## -## Ends in an error in state: 257. +## Ends in an error in state: 256. ## ## nsepseq(field_name,DOT) -> Ident . [ COLON ] ## nsepseq(field_name,DOT) -> Ident . DOT nsepseq(field_name,DOT) [ COLON ] @@ -1074,7 +1069,7 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident DOT Ident WILD interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident DOT WILD ## -## Ends in an error in state: 256. +## Ends in an error in state: 255. ## ## nsepseq(field_name,DOT) -> Ident DOT . nsepseq(field_name,DOT) [ COLON ] ## @@ -1086,7 +1081,7 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident DOT WILD interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident WILD ## -## Ends in an error in state: 255. +## Ends in an error in state: 254. ## ## field_path_assignment -> Ident . [ RBRACE COMMA ] ## nsepseq(field_name,DOT) -> Ident . [ COLON ] @@ -1100,7 +1095,7 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA Ident WILD interactive_expr: LBRACE ELLIPSIS Ident COMMA WILD ## -## Ends in an error in state: 254. +## Ends in an error in state: 253. ## ## update_record -> LBRACE ELLIPSIS path COMMA . sep_or_term_list(field_path_assignment,COMMA) RBRACE [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE LBRACE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] ## @@ -1112,7 +1107,7 @@ interactive_expr: LBRACE ELLIPSIS Ident COMMA WILD interactive_expr: LBRACE ELLIPSIS Ident DOT Ident VBAR ## -## Ends in an error in state: 253. +## Ends in an error in state: 252. ## ## update_record -> LBRACE ELLIPSIS path . COMMA sep_or_term_list(field_path_assignment,COMMA) RBRACE [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE LBRACE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] ## @@ -1125,14 +1120,14 @@ interactive_expr: LBRACE ELLIPSIS Ident DOT Ident VBAR ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 102, spurious reduction of production selection -> DOT Ident ## In state 105, spurious reduction of production projection -> Ident selection -## In state 252, spurious reduction of production path -> projection +## In state 251, spurious reduction of production path -> projection ## interactive_expr: LBRACE ELLIPSIS Ident WILD ## -## Ends in an error in state: 248. +## Ends in an error in state: 247. ## ## path -> Ident . [ COMMA ] ## projection -> Ident . selection [ COMMA ] @@ -1145,7 +1140,7 @@ interactive_expr: LBRACE ELLIPSIS Ident WILD interactive_expr: LBRACE ELLIPSIS WILD ## -## Ends in an error in state: 247. +## Ends in an error in state: 246. ## ## update_record -> LBRACE ELLIPSIS . path COMMA sep_or_term_list(field_path_assignment,COMMA) RBRACE [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE LBRACE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] ## @@ -1157,7 +1152,7 @@ interactive_expr: LBRACE ELLIPSIS WILD interactive_expr: LBRACE Ident COLON Bytes VBAR ## -## Ends in an error in state: 468. +## Ends in an error in state: 467. ## ## sequence_or_record_in -> field_assignment . COMMA sep_or_term_list(field_assignment,COMMA) [ RBRACE ] ## @@ -1181,14 +1176,14 @@ interactive_expr: LBRACE Ident COLON Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 465, spurious reduction of production field_assignment -> Ident COLON expr +## In state 464, spurious reduction of production field_assignment -> Ident COLON expr ## interactive_expr: LBRACE Ident COLON WILD ## -## Ends in an error in state: 464. +## Ends in an error in state: 463. ## ## field_assignment -> Ident COLON . expr [ RBRACE COMMA ] ## @@ -1200,7 +1195,7 @@ interactive_expr: LBRACE Ident COLON WILD interactive_expr: LBRACE Ident COMMA Ident COLON Bytes VBAR ## -## Ends in an error in state: 474. +## Ends in an error in state: 473. ## ## nsepseq(field_assignment,COMMA) -> field_assignment . [ RBRACE ] ## nsepseq(field_assignment,COMMA) -> field_assignment . COMMA nsepseq(field_assignment,COMMA) [ RBRACE ] @@ -1226,14 +1221,14 @@ interactive_expr: LBRACE Ident COMMA Ident COLON Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 465, spurious reduction of production field_assignment -> Ident COLON expr +## In state 464, spurious reduction of production field_assignment -> Ident COLON expr ## interactive_expr: LBRACE Ident COMMA Ident COMMA Ident COLON Bytes VBAR ## -## Ends in an error in state: 478. +## Ends in an error in state: 477. ## ## nsepseq(field_assignment,COMMA) -> field_assignment . [ RBRACE ] ## nsepseq(field_assignment,COMMA) -> field_assignment . COMMA nsepseq(field_assignment,COMMA) [ RBRACE ] @@ -1259,14 +1254,14 @@ interactive_expr: LBRACE Ident COMMA Ident COMMA Ident COLON Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 465, spurious reduction of production field_assignment -> Ident COLON expr +## In state 464, spurious reduction of production field_assignment -> Ident COLON expr ## interactive_expr: LBRACE Ident COMMA Ident COMMA Ident COMMA WILD ## -## Ends in an error in state: 479. +## Ends in an error in state: 478. ## ## nsepseq(field_assignment,COMMA) -> field_assignment COMMA . nsepseq(field_assignment,COMMA) [ RBRACE ] ## seq(__anonymous_0(field_assignment,COMMA)) -> field_assignment COMMA . seq(__anonymous_0(field_assignment,COMMA)) [ RBRACE ] @@ -1279,7 +1274,7 @@ interactive_expr: LBRACE Ident COMMA Ident COMMA Ident COMMA WILD interactive_expr: LBRACE Ident COMMA Ident COMMA WILD ## -## Ends in an error in state: 475. +## Ends in an error in state: 474. ## ## nsepseq(field_assignment,COMMA) -> field_assignment COMMA . nsepseq(field_assignment,COMMA) [ RBRACE ] ## nseq(__anonymous_0(field_assignment,COMMA)) -> field_assignment COMMA . seq(__anonymous_0(field_assignment,COMMA)) [ RBRACE ] @@ -1292,7 +1287,7 @@ interactive_expr: LBRACE Ident COMMA Ident COMMA WILD interactive_expr: LBRACE Ident COMMA Ident WILD ## -## Ends in an error in state: 470. +## Ends in an error in state: 469. ## ## field_assignment -> Ident . [ RBRACE COMMA ] ## field_assignment -> Ident . COLON expr [ RBRACE COMMA ] @@ -1305,7 +1300,7 @@ interactive_expr: LBRACE Ident COMMA Ident WILD interactive_expr: LBRACE Ident COMMA WILD ## -## Ends in an error in state: 469. +## Ends in an error in state: 468. ## ## sequence_or_record_in -> field_assignment COMMA . sep_or_term_list(field_assignment,COMMA) [ RBRACE ] ## @@ -1317,7 +1312,7 @@ interactive_expr: LBRACE Ident COMMA WILD interactive_expr: LBRACE Ident WILD ## -## Ends in an error in state: 463. +## Ends in an error in state: 462. ## ## common_expr -> Ident . [ TIMES SLASH SEMI RBRACE PLUS Or NE Mod MINUS LT LPAR LE GT GE EQEQ COLON CAT BOOL_OR BOOL_AND ARROW ] ## field_assignment -> Ident . [ COMMA ] @@ -1332,7 +1327,7 @@ interactive_expr: LBRACE Ident WILD interactive_expr: LBRACE True SEMI True SEMI True SEMI WILD ## -## Ends in an error in state: 491. +## Ends in an error in state: 490. ## ## nsepseq(expr_with_let_expr,SEMI) -> expr_with_let_expr SEMI . nsepseq(expr_with_let_expr,SEMI) [ RBRACE ] ## seq(__anonymous_0(expr_with_let_expr,SEMI)) -> expr_with_let_expr SEMI . seq(__anonymous_0(expr_with_let_expr,SEMI)) [ RBRACE ] @@ -1345,7 +1340,7 @@ interactive_expr: LBRACE True SEMI True SEMI True SEMI WILD interactive_expr: LBRACE True SEMI True SEMI True VBAR ## -## Ends in an error in state: 490. +## Ends in an error in state: 489. ## ## nsepseq(expr_with_let_expr,SEMI) -> expr_with_let_expr . [ RBRACE ] ## nsepseq(expr_with_let_expr,SEMI) -> expr_with_let_expr . SEMI nsepseq(expr_with_let_expr,SEMI) [ RBRACE ] @@ -1371,14 +1366,14 @@ interactive_expr: LBRACE True SEMI True SEMI True VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 400, spurious reduction of production expr_with_let_expr -> expr +## In state 399, spurious reduction of production expr_with_let_expr -> expr ## interactive_expr: LBRACE True SEMI True SEMI WILD ## -## Ends in an error in state: 487. +## Ends in an error in state: 486. ## ## nsepseq(expr_with_let_expr,SEMI) -> expr_with_let_expr SEMI . nsepseq(expr_with_let_expr,SEMI) [ RBRACE ] ## nseq(__anonymous_0(expr_with_let_expr,SEMI)) -> expr_with_let_expr SEMI . seq(__anonymous_0(expr_with_let_expr,SEMI)) [ RBRACE ] @@ -1391,7 +1386,7 @@ interactive_expr: LBRACE True SEMI True SEMI WILD interactive_expr: LBRACE True SEMI True VBAR ## -## Ends in an error in state: 486. +## Ends in an error in state: 485. ## ## nsepseq(expr_with_let_expr,SEMI) -> expr_with_let_expr . [ RBRACE ] ## nsepseq(expr_with_let_expr,SEMI) -> expr_with_let_expr . SEMI nsepseq(expr_with_let_expr,SEMI) [ RBRACE ] @@ -1417,14 +1412,14 @@ interactive_expr: LBRACE True SEMI True VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 400, spurious reduction of production expr_with_let_expr -> expr +## In state 399, spurious reduction of production expr_with_let_expr -> expr ## interactive_expr: LBRACE True SEMI WILD ## -## Ends in an error in state: 482. +## Ends in an error in state: 481. ## ## option(SEMI) -> SEMI . [ RBRACE ] ## sequence_or_record_in -> expr_with_let_expr SEMI . sep_or_term_list(expr_with_let_expr,SEMI) [ RBRACE ] @@ -1437,7 +1432,7 @@ interactive_expr: LBRACE True SEMI WILD interactive_expr: LBRACE True VBAR ## -## Ends in an error in state: 481. +## Ends in an error in state: 480. ## ## sequence_or_record_in -> expr_with_let_expr . SEMI sep_or_term_list(expr_with_let_expr,SEMI) [ RBRACE ] ## sequence_or_record_in -> expr_with_let_expr . option(SEMI) [ RBRACE ] @@ -1462,7 +1457,7 @@ interactive_expr: LBRACE True VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 400, spurious reduction of production expr_with_let_expr -> expr +## In state 399, spurious reduction of production expr_with_let_expr -> expr ## @@ -1482,7 +1477,7 @@ interactive_expr: LBRACE WILD interactive_expr: LBRACKET True COMMA ELLIPSIS True VBAR ## -## Ends in an error in state: 500. +## Ends in an error in state: 499. ## ## list_or_spread -> LBRACKET expr COMMA ELLIPSIS expr . RBRACKET [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] ## @@ -1512,7 +1507,7 @@ interactive_expr: LBRACKET True COMMA ELLIPSIS True VBAR interactive_expr: LBRACKET True COMMA ELLIPSIS WILD ## -## Ends in an error in state: 499. +## Ends in an error in state: 498. ## ## list_or_spread -> LBRACKET expr COMMA ELLIPSIS . expr RBRACKET [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] ## @@ -1524,7 +1519,7 @@ interactive_expr: LBRACKET True COMMA ELLIPSIS WILD interactive_expr: LBRACKET True COMMA True COMMA True COMMA WILD ## -## Ends in an error in state: 510. +## Ends in an error in state: 509. ## ## nsepseq(expr,COMMA) -> expr COMMA . nsepseq(expr,COMMA) [ RBRACKET ] ## seq(__anonymous_0(expr,COMMA)) -> expr COMMA . seq(__anonymous_0(expr,COMMA)) [ RBRACKET ] @@ -1537,7 +1532,7 @@ interactive_expr: LBRACKET True COMMA True COMMA True COMMA WILD interactive_expr: LBRACKET True COMMA True COMMA True VBAR ## -## Ends in an error in state: 509. +## Ends in an error in state: 508. ## ## nsepseq(expr,COMMA) -> expr . [ RBRACKET ] ## nsepseq(expr,COMMA) -> expr . COMMA nsepseq(expr,COMMA) [ RBRACKET ] @@ -1569,7 +1564,7 @@ interactive_expr: LBRACKET True COMMA True COMMA True VBAR interactive_expr: LBRACKET True COMMA True COMMA WILD ## -## Ends in an error in state: 507. +## Ends in an error in state: 506. ## ## nsepseq(expr,COMMA) -> expr COMMA . nsepseq(expr,COMMA) [ RBRACKET ] ## nseq(__anonymous_0(expr,COMMA)) -> expr COMMA . seq(__anonymous_0(expr,COMMA)) [ RBRACKET ] @@ -1582,7 +1577,7 @@ interactive_expr: LBRACKET True COMMA True COMMA WILD interactive_expr: LBRACKET True COMMA True VBAR ## -## Ends in an error in state: 506. +## Ends in an error in state: 505. ## ## nsepseq(expr,COMMA) -> expr . [ RBRACKET ] ## nsepseq(expr,COMMA) -> expr . COMMA nsepseq(expr,COMMA) [ RBRACKET ] @@ -1614,7 +1609,7 @@ interactive_expr: LBRACKET True COMMA True VBAR interactive_expr: LBRACKET True COMMA WILD ## -## Ends in an error in state: 498. +## Ends in an error in state: 497. ## ## list_or_spread -> LBRACKET expr COMMA . sep_or_term_list(expr,COMMA) RBRACKET [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] ## list_or_spread -> LBRACKET expr COMMA . ELLIPSIS expr RBRACKET [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] @@ -1627,7 +1622,7 @@ interactive_expr: LBRACKET True COMMA WILD interactive_expr: LBRACKET True VBAR ## -## Ends in an error in state: 497. +## Ends in an error in state: 496. ## ## list_or_spread -> LBRACKET expr . COMMA sep_or_term_list(expr,COMMA) RBRACKET [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] ## list_or_spread -> LBRACKET expr . COMMA ELLIPSIS expr RBRACKET [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] @@ -1678,7 +1673,7 @@ interactive_expr: LPAR True COMMA Bytes RPAR COLON Ident TIMES ## base_expr(expr) -> disj_expr_level . [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## bin_op(disj_expr_level,BOOL_OR,conj_expr_level) -> disj_expr_level . BOOL_OR conj_expr_level [ VBAR Type SEMI RPAR RBRACKET RBRACE Or Let EOF COMMA BOOL_OR Attr ARROW ] ## bin_op(disj_expr_level,Or,conj_expr_level) -> disj_expr_level . Or conj_expr_level [ VBAR Type SEMI RPAR RBRACKET RBRACE Or Let EOF COMMA BOOL_OR Attr ARROW ] -## fun_expr -> disj_expr_level . es6_func [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] +## fun_expr -> disj_expr_level . ARROW expr [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: ## disj_expr_level @@ -1710,7 +1705,7 @@ interactive_expr: LPAR True COMMA Bytes RPAR WILD interactive_expr: LPAR True COMMA True COMMA WILD ## -## Ends in an error in state: 461. +## Ends in an error in state: 460. ## ## nsepseq(disj_expr_level,COMMA) -> disj_expr_level COMMA . nsepseq(disj_expr_level,COMMA) [ RPAR ] ## @@ -1722,7 +1717,7 @@ interactive_expr: LPAR True COMMA True COMMA WILD interactive_expr: LPAR True COMMA True VBAR ## -## Ends in an error in state: 460. +## Ends in an error in state: 459. ## ## bin_op(disj_expr_level,BOOL_OR,conj_expr_level) -> disj_expr_level . BOOL_OR conj_expr_level [ RPAR Or COMMA BOOL_OR ] ## bin_op(disj_expr_level,Or,conj_expr_level) -> disj_expr_level . Or conj_expr_level [ RPAR Or COMMA BOOL_OR ] @@ -1752,7 +1747,7 @@ interactive_expr: LPAR True COMMA True VBAR interactive_expr: LPAR True COMMA WILD ## -## Ends in an error in state: 458. +## Ends in an error in state: 457. ## ## tuple(disj_expr_level) -> disj_expr_level COMMA . nsepseq(disj_expr_level,COMMA) [ RPAR ] ## @@ -1764,12 +1759,12 @@ interactive_expr: LPAR True COMMA WILD interactive_expr: LPAR True VBAR ## -## Ends in an error in state: 457. +## Ends in an error in state: 456. ## ## base_expr(expr) -> disj_expr_level . [ RPAR ] ## bin_op(disj_expr_level,BOOL_OR,conj_expr_level) -> disj_expr_level . BOOL_OR conj_expr_level [ RPAR Or COMMA BOOL_OR ARROW ] ## bin_op(disj_expr_level,Or,conj_expr_level) -> disj_expr_level . Or conj_expr_level [ RPAR Or COMMA BOOL_OR ARROW ] -## fun_expr -> disj_expr_level . es6_func [ RPAR ] +## fun_expr -> disj_expr_level . ARROW expr [ RPAR ] ## tuple(disj_expr_level) -> disj_expr_level . COMMA nsepseq(disj_expr_level,COMMA) [ RPAR ] ## ## The known suffix of the stack is as follows: @@ -1809,7 +1804,7 @@ interactive_expr: LPAR WILD interactive_expr: Let Rec VBAR ## -## Ends in an error in state: 354. +## Ends in an error in state: 353. ## ## let_expr(expr_with_let_expr) -> seq(Attr) Let Rec . let_binding SEMI expr_with_let_expr [ SEMI RBRACE EOF ] ## @@ -1821,7 +1816,7 @@ interactive_expr: Let Rec VBAR interactive_expr: Let Rec WILD EQ Bytes SEMI WILD ## -## Ends in an error in state: 397. +## Ends in an error in state: 396. ## ## let_expr(expr_with_let_expr) -> seq(Attr) Let Rec let_binding SEMI . expr_with_let_expr [ SEMI RBRACE EOF ] ## @@ -1833,7 +1828,7 @@ interactive_expr: Let Rec WILD EQ Bytes SEMI WILD interactive_expr: Let Rec WILD EQ Bytes VBAR ## -## Ends in an error in state: 396. +## Ends in an error in state: 395. ## ## let_expr(expr_with_let_expr) -> seq(Attr) Let Rec let_binding . SEMI expr_with_let_expr [ SEMI RBRACE EOF ] ## @@ -1857,14 +1852,14 @@ interactive_expr: Let Rec WILD EQ Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 532, spurious reduction of production let_binding -> WILD option(type_annotation) EQ expr +## In state 531, spurious reduction of production let_binding -> WILD option(type_annotation) EQ expr ## interactive_expr: Let VBAR ## -## Ends in an error in state: 353. +## Ends in an error in state: 352. ## ## let_expr(expr_with_let_expr) -> seq(Attr) Let . let_binding SEMI expr_with_let_expr [ SEMI RBRACE EOF ] ## let_expr(expr_with_let_expr) -> seq(Attr) Let . Rec let_binding SEMI expr_with_let_expr [ SEMI RBRACE EOF ] @@ -1877,7 +1872,7 @@ interactive_expr: Let VBAR interactive_expr: Let WILD EQ Bytes SEMI WILD ## -## Ends in an error in state: 402. +## Ends in an error in state: 401. ## ## let_expr(expr_with_let_expr) -> seq(Attr) Let let_binding SEMI . expr_with_let_expr [ SEMI RBRACE EOF ] ## @@ -1889,7 +1884,7 @@ interactive_expr: Let WILD EQ Bytes SEMI WILD interactive_expr: Let WILD EQ Bytes VBAR ## -## Ends in an error in state: 401. +## Ends in an error in state: 400. ## ## let_expr(expr_with_let_expr) -> seq(Attr) Let let_binding . SEMI expr_with_let_expr [ SEMI RBRACE EOF ] ## @@ -1913,7 +1908,7 @@ interactive_expr: Let WILD EQ Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 532, spurious reduction of production let_binding -> WILD option(type_annotation) EQ expr +## In state 531, spurious reduction of production let_binding -> WILD option(type_annotation) EQ expr ## @@ -1957,7 +1952,7 @@ interactive_expr: Switch Constr WILD interactive_expr: Switch LBRACE WILD ## -## Ends in an error in state: 246. +## Ends in an error in state: 245. ## ## update_record -> LBRACE . ELLIPSIS path COMMA sep_or_term_list(field_path_assignment,COMMA) RBRACE [ LBRACE ] ## @@ -1969,7 +1964,7 @@ interactive_expr: Switch LBRACE WILD interactive_expr: Switch LBRACKET True SEMI True SEMI WILD ## -## Ends in an error in state: 244. +## Ends in an error in state: 243. ## ## nsepseq(expr,SEMI) -> expr SEMI . nsepseq(expr,SEMI) [ RBRACKET ] ## seq(__anonymous_0(expr,SEMI)) -> expr SEMI . seq(__anonymous_0(expr,SEMI)) [ RBRACKET ] @@ -1982,7 +1977,7 @@ interactive_expr: Switch LBRACKET True SEMI True SEMI WILD interactive_expr: Switch LBRACKET True SEMI True VBAR ## -## Ends in an error in state: 243. +## Ends in an error in state: 242. ## ## nsepseq(expr,SEMI) -> expr . [ RBRACKET ] ## nsepseq(expr,SEMI) -> expr . SEMI nsepseq(expr,SEMI) [ RBRACKET ] @@ -2014,7 +2009,7 @@ interactive_expr: Switch LBRACKET True SEMI True VBAR interactive_expr: Switch LBRACKET True SEMI WILD ## -## Ends in an error in state: 240. +## Ends in an error in state: 239. ## ## nsepseq(expr,SEMI) -> expr SEMI . nsepseq(expr,SEMI) [ RBRACKET ] ## nseq(__anonymous_0(expr,SEMI)) -> expr SEMI . seq(__anonymous_0(expr,SEMI)) [ RBRACKET ] @@ -2027,7 +2022,7 @@ interactive_expr: Switch LBRACKET True SEMI WILD interactive_expr: Switch LBRACKET True VBAR ## -## Ends in an error in state: 239. +## Ends in an error in state: 238. ## ## nsepseq(expr,SEMI) -> expr . [ RBRACKET ] ## nsepseq(expr,SEMI) -> expr . SEMI nsepseq(expr,SEMI) [ RBRACKET ] @@ -2059,7 +2054,7 @@ interactive_expr: Switch LBRACKET True VBAR interactive_expr: Switch LBRACKET WILD ## -## Ends in an error in state: 233. +## Ends in an error in state: 232. ## ## list__(expr) -> LBRACKET . option(sep_or_term_list(expr,SEMI)) RBRACKET [ LBRACE ] ## @@ -2071,7 +2066,7 @@ interactive_expr: Switch LBRACKET WILD interactive_expr: Switch LPAR True VBAR ## -## Ends in an error in state: 455. +## Ends in an error in state: 454. ## ## par(expr) -> LPAR expr . RPAR [ VBAR Type TIMES SLASH SEMI RPAR RBRACKET RBRACE PLUS Or NE Mod MINUS Let LT LPAR LE LBRACE GT GE EQEQ EOF COMMA COLON CAT BOOL_OR BOOL_AND Attr ARROW ] ## @@ -2114,7 +2109,7 @@ interactive_expr: Switch LPAR WILD interactive_expr: Switch True LBRACE VBAR LBRACKET VBAR ## -## Ends in an error in state: 335. +## Ends in an error in state: 334. ## ## list__(sub_pattern) -> LBRACKET . option(sep_or_term_list(sub_pattern,SEMI)) RBRACKET [ COMMA ARROW ] ## pattern -> LBRACKET . sub_pattern COMMA ELLIPSIS sub_pattern RBRACKET [ ARROW ] @@ -2127,7 +2122,7 @@ interactive_expr: Switch True LBRACE VBAR LBRACKET VBAR interactive_expr: Switch True LBRACE VBAR LBRACKET WILD COMMA ELLIPSIS VBAR ## -## Ends in an error in state: 338. +## Ends in an error in state: 337. ## ## pattern -> LBRACKET sub_pattern COMMA ELLIPSIS . sub_pattern RBRACKET [ ARROW ] ## @@ -2139,7 +2134,7 @@ interactive_expr: Switch True LBRACE VBAR LBRACKET WILD COMMA ELLIPSIS VBAR interactive_expr: Switch True LBRACE VBAR LBRACKET WILD COMMA ELLIPSIS WILD WILD ## -## Ends in an error in state: 339. +## Ends in an error in state: 338. ## ## pattern -> LBRACKET sub_pattern COMMA ELLIPSIS sub_pattern . RBRACKET [ ARROW ] ## @@ -2151,7 +2146,7 @@ interactive_expr: Switch True LBRACE VBAR LBRACKET WILD COMMA ELLIPSIS WILD WILD interactive_expr: Switch True LBRACE VBAR LBRACKET WILD COMMA WILD ## -## Ends in an error in state: 337. +## Ends in an error in state: 336. ## ## pattern -> LBRACKET sub_pattern COMMA . ELLIPSIS sub_pattern RBRACKET [ ARROW ] ## @@ -2163,7 +2158,7 @@ interactive_expr: Switch True LBRACE VBAR LBRACKET WILD COMMA WILD interactive_expr: Switch True LBRACE VBAR LBRACKET WILD WILD ## -## Ends in an error in state: 336. +## Ends in an error in state: 335. ## ## nsepseq(sub_pattern,SEMI) -> sub_pattern . [ RBRACKET ] ## nsepseq(sub_pattern,SEMI) -> sub_pattern . SEMI nsepseq(sub_pattern,SEMI) [ RBRACKET ] @@ -2178,7 +2173,7 @@ interactive_expr: Switch True LBRACE VBAR LBRACKET WILD WILD interactive_expr: Switch True LBRACE VBAR LPAR Bytes RPAR WILD ## -## Ends in an error in state: 342. +## Ends in an error in state: 341. ## ## tuple(sub_pattern) -> sub_pattern . COMMA nsepseq(sub_pattern,COMMA) [ ARROW ] ## @@ -2190,7 +2185,7 @@ interactive_expr: Switch True LBRACE VBAR LPAR Bytes RPAR WILD interactive_expr: Switch True LBRACE VBAR VBAR ## -## Ends in an error in state: 515. +## Ends in an error in state: 514. ## ## case_clause(base_cond) -> VBAR . pattern ARROW base_cond option(SEMI) [ VBAR RBRACE ] ## @@ -2202,7 +2197,7 @@ interactive_expr: Switch True LBRACE VBAR VBAR interactive_expr: Switch True LBRACE VBAR WILD ARROW Bytes SEMI WILD ## -## Ends in an error in state: 528. +## Ends in an error in state: 527. ## ## nseq(case_clause(base_cond)) -> case_clause(base_cond) . seq(case_clause(base_cond)) [ RBRACE ] ## @@ -2214,7 +2209,7 @@ interactive_expr: Switch True LBRACE VBAR WILD ARROW Bytes SEMI WILD interactive_expr: Switch True LBRACE VBAR WILD ARROW Bytes VBAR Bytes ARROW Bytes SEMI WILD ## -## Ends in an error in state: 530. +## Ends in an error in state: 529. ## ## seq(case_clause(base_cond)) -> case_clause(base_cond) . seq(case_clause(base_cond)) [ RBRACE ] ## @@ -2226,7 +2221,7 @@ interactive_expr: Switch True LBRACE VBAR WILD ARROW Bytes VBAR Bytes ARROW Byte interactive_expr: Switch True LBRACE VBAR WILD ARROW True ARROW Bytes Type ## -## Ends in an error in state: 523. +## Ends in an error in state: 522. ## ## case_clause(base_cond) -> VBAR pattern ARROW base_cond . option(SEMI) [ VBAR RBRACE ] ## @@ -2250,23 +2245,22 @@ interactive_expr: Switch True LBRACE VBAR WILD ARROW True ARROW Bytes Type ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 215, spurious reduction of production es6_func -> ARROW expr -## In state 223, spurious reduction of production fun_expr -> disj_expr_level es6_func -## In state 518, spurious reduction of production base_expr(base_cond) -> fun_expr -## In state 521, spurious reduction of production base_cond__open(base_cond) -> base_expr(base_cond) -## In state 522, spurious reduction of production base_cond -> base_cond__open(base_cond) +## In state 215, spurious reduction of production fun_expr -> disj_expr_level ARROW expr +## In state 517, spurious reduction of production base_expr(base_cond) -> fun_expr +## In state 520, spurious reduction of production base_cond__open(base_cond) -> base_expr(base_cond) +## In state 521, spurious reduction of production base_cond -> base_cond__open(base_cond) ## interactive_expr: Switch True LBRACE VBAR WILD ARROW True Type ## -## Ends in an error in state: 519. +## Ends in an error in state: 518. ## ## base_expr(base_cond) -> disj_expr_level . [ VBAR SEMI RBRACE ] ## bin_op(disj_expr_level,BOOL_OR,conj_expr_level) -> disj_expr_level . BOOL_OR conj_expr_level [ VBAR SEMI RBRACE Or BOOL_OR ARROW ] ## bin_op(disj_expr_level,Or,conj_expr_level) -> disj_expr_level . Or conj_expr_level [ VBAR SEMI RBRACE Or BOOL_OR ARROW ] -## fun_expr -> disj_expr_level . es6_func [ VBAR SEMI RBRACE ] +## fun_expr -> disj_expr_level . ARROW expr [ VBAR SEMI RBRACE ] ## ## The known suffix of the stack is as follows: ## disj_expr_level @@ -2291,7 +2285,7 @@ interactive_expr: Switch True LBRACE VBAR WILD ARROW True Type interactive_expr: Switch True LBRACE VBAR WILD ARROW WILD ## -## Ends in an error in state: 517. +## Ends in an error in state: 516. ## ## case_clause(base_cond) -> VBAR pattern ARROW . base_cond option(SEMI) [ VBAR RBRACE ] ## @@ -2303,7 +2297,7 @@ interactive_expr: Switch True LBRACE VBAR WILD ARROW WILD interactive_expr: Switch True LBRACE VBAR WILD COMMA Bytes RPAR ## -## Ends in an error in state: 516. +## Ends in an error in state: 515. ## ## case_clause(base_cond) -> VBAR pattern . ARROW base_cond option(SEMI) [ VBAR RBRACE ] ## @@ -2314,16 +2308,16 @@ interactive_expr: Switch True LBRACE VBAR WILD COMMA Bytes RPAR ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 329, spurious reduction of production nsepseq(sub_pattern,COMMA) -> sub_pattern -## In state 332, spurious reduction of production tuple(sub_pattern) -> sub_pattern COMMA nsepseq(sub_pattern,COMMA) -## In state 341, spurious reduction of production pattern -> tuple(sub_pattern) +## In state 328, spurious reduction of production nsepseq(sub_pattern,COMMA) -> sub_pattern +## In state 331, spurious reduction of production tuple(sub_pattern) -> sub_pattern COMMA nsepseq(sub_pattern,COMMA) +## In state 340, spurious reduction of production pattern -> tuple(sub_pattern) ## interactive_expr: Switch True LBRACE VBAR WILD COMMA VBAR ## -## Ends in an error in state: 328. +## Ends in an error in state: 327. ## ## tuple(sub_pattern) -> sub_pattern COMMA . nsepseq(sub_pattern,COMMA) [ RPAR ARROW ] ## @@ -2335,7 +2329,7 @@ interactive_expr: Switch True LBRACE VBAR WILD COMMA VBAR interactive_expr: Switch True LBRACE VBAR WILD COMMA WILD COMMA VBAR ## -## Ends in an error in state: 330. +## Ends in an error in state: 329. ## ## nsepseq(sub_pattern,COMMA) -> sub_pattern COMMA . nsepseq(sub_pattern,COMMA) [ RPAR ARROW ] ## @@ -2347,7 +2341,7 @@ interactive_expr: Switch True LBRACE VBAR WILD COMMA WILD COMMA VBAR interactive_expr: Switch True LBRACE VBAR WILD COMMA WILD WILD ## -## Ends in an error in state: 329. +## Ends in an error in state: 328. ## ## nsepseq(sub_pattern,COMMA) -> sub_pattern . [ RPAR ARROW ] ## nsepseq(sub_pattern,COMMA) -> sub_pattern . COMMA nsepseq(sub_pattern,COMMA) [ RPAR ARROW ] @@ -2360,7 +2354,7 @@ interactive_expr: Switch True LBRACE VBAR WILD COMMA WILD WILD interactive_expr: Switch True LBRACE VBAR WILD WILD ## -## Ends in an error in state: 433. +## Ends in an error in state: 432. ## ## pattern -> core_pattern . [ ARROW ] ## sub_pattern -> core_pattern . [ COMMA ] @@ -2373,7 +2367,7 @@ interactive_expr: Switch True LBRACE VBAR WILD WILD interactive_expr: Switch True LBRACE WILD ## -## Ends in an error in state: 514. +## Ends in an error in state: 513. ## ## switch_expr(base_cond) -> Switch switch_expr_ LBRACE . cases(base_cond) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## @@ -2385,7 +2379,7 @@ interactive_expr: Switch True LBRACE WILD interactive_expr: Switch True WILD ## -## Ends in an error in state: 513. +## Ends in an error in state: 512. ## ## switch_expr(base_cond) -> Switch switch_expr_ . LBRACE cases(base_cond) RBRACE [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## @@ -2411,10 +2405,10 @@ interactive_expr: True ARROW WILD ## ## Ends in an error in state: 214. ## -## es6_func -> ARROW . expr [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] +## fun_expr -> disj_expr_level ARROW . expr [ VBAR Type SEMI RPAR RBRACKET RBRACE Let EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: -## ARROW +## disj_expr_level ARROW ## @@ -2835,7 +2829,7 @@ interactive_expr: True TIMES WILD interactive_expr: True VBAR ## -## Ends in an error in state: 545. +## Ends in an error in state: 544. ## ## interactive_expr -> expr_with_let_expr . EOF [ # ] ## @@ -2859,7 +2853,7 @@ interactive_expr: True VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 400, spurious reduction of production expr_with_let_expr -> expr +## In state 399, spurious reduction of production expr_with_let_expr -> expr ## @@ -2880,7 +2874,7 @@ interactive_expr: True WILD interactive_expr: WILD ## -## Ends in an error in state: 543. +## Ends in an error in state: 542. ## ## interactive_expr' -> . interactive_expr [ # ] ## @@ -2904,7 +2898,7 @@ contract: Attr WILD contract: Let Ident COLON Constr Type ## -## Ends in an error in state: 376. +## Ends in an error in state: 375. ## ## let_binding -> Ident option(type_annotation) . EQ expr [ Type SEMI Let EOF Attr ] ## @@ -2916,7 +2910,7 @@ contract: Let Ident COLON Constr Type ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 48, spurious reduction of production variant -> Constr -## In state 41, spurious reduction of production nsepseq(variant,VBAR) -> variant +## In state 37, spurious reduction of production nsepseq(variant,VBAR) -> variant ## In state 52, spurious reduction of production sum_type -> nsepseq(variant,VBAR) ## In state 66, spurious reduction of production type_expr -> sum_type ## In state 78, spurious reduction of production type_annotation -> COLON type_expr @@ -2927,7 +2921,7 @@ contract: Let Ident COLON Constr Type contract: Let Ident EQ WILD ## -## Ends in an error in state: 377. +## Ends in an error in state: 376. ## ## let_binding -> Ident option(type_annotation) EQ . expr [ Type SEMI Let EOF Attr ] ## @@ -2944,7 +2938,7 @@ let func = (a: int, b: int) => a + b; contract: Let Ident WILD ## -## Ends in an error in state: 375. +## Ends in an error in state: 374. ## ## let_binding -> Ident . option(type_annotation) EQ expr [ Type SEMI Let EOF Attr ] ## sub_irrefutable -> Ident . [ COMMA ] @@ -2957,7 +2951,7 @@ contract: Let Ident WILD contract: Let LBRACE Ident EQ Bytes COMMA Ident EQ Bytes COMMA WILD ## -## Ends in an error in state: 311. +## Ends in an error in state: 310. ## ## nsepseq(field_pattern,COMMA) -> field_pattern COMMA . nsepseq(field_pattern,COMMA) [ RBRACE ] ## seq(__anonymous_0(field_pattern,COMMA)) -> field_pattern COMMA . seq(__anonymous_0(field_pattern,COMMA)) [ RBRACE ] @@ -2970,7 +2964,7 @@ contract: Let LBRACE Ident EQ Bytes COMMA Ident EQ Bytes COMMA WILD contract: Let LBRACE Ident EQ Bytes COMMA Ident EQ Bytes WILD ## -## Ends in an error in state: 310. +## Ends in an error in state: 309. ## ## nsepseq(field_pattern,COMMA) -> field_pattern . [ RBRACE ] ## nsepseq(field_pattern,COMMA) -> field_pattern . COMMA nsepseq(field_pattern,COMMA) [ RBRACE ] @@ -2984,7 +2978,7 @@ contract: Let LBRACE Ident EQ Bytes COMMA Ident EQ Bytes WILD contract: Let LBRACE Ident EQ Bytes COMMA WILD ## -## Ends in an error in state: 307. +## Ends in an error in state: 306. ## ## nsepseq(field_pattern,COMMA) -> field_pattern COMMA . nsepseq(field_pattern,COMMA) [ RBRACE ] ## nseq(__anonymous_0(field_pattern,COMMA)) -> field_pattern COMMA . seq(__anonymous_0(field_pattern,COMMA)) [ RBRACE ] @@ -2997,7 +2991,7 @@ contract: Let LBRACE Ident EQ Bytes COMMA WILD contract: Let LBRACE Ident EQ Bytes RBRACE COLON Constr Type ## -## Ends in an error in state: 389. +## Ends in an error in state: 388. ## ## let_binding -> record_pattern option(type_annotation) . EQ expr [ Type SEMI Let EOF Attr ] ## @@ -3009,7 +3003,7 @@ contract: Let LBRACE Ident EQ Bytes RBRACE COLON Constr Type ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 48, spurious reduction of production variant -> Constr -## In state 41, spurious reduction of production nsepseq(variant,VBAR) -> variant +## In state 37, spurious reduction of production nsepseq(variant,VBAR) -> variant ## In state 52, spurious reduction of production sum_type -> nsepseq(variant,VBAR) ## In state 66, spurious reduction of production type_expr -> sum_type ## In state 78, spurious reduction of production type_annotation -> COLON type_expr @@ -3020,7 +3014,7 @@ contract: Let LBRACE Ident EQ Bytes RBRACE COLON Constr Type contract: Let LBRACE Ident EQ Bytes RBRACE EQ WILD ## -## Ends in an error in state: 390. +## Ends in an error in state: 389. ## ## let_binding -> record_pattern option(type_annotation) EQ . expr [ Type SEMI Let EOF Attr ] ## @@ -3032,7 +3026,7 @@ contract: Let LBRACE Ident EQ Bytes RBRACE EQ WILD contract: Let LBRACE Ident EQ Bytes RBRACE WILD ## -## Ends in an error in state: 388. +## Ends in an error in state: 387. ## ## let_binding -> record_pattern . option(type_annotation) EQ expr [ Type SEMI Let EOF Attr ] ## sub_irrefutable -> record_pattern . [ COMMA ] @@ -3045,7 +3039,7 @@ contract: Let LBRACE Ident EQ Bytes RBRACE WILD contract: Let LBRACE Ident EQ Bytes WILD ## -## Ends in an error in state: 306. +## Ends in an error in state: 305. ## ## nsepseq(field_pattern,COMMA) -> field_pattern . [ RBRACE ] ## nsepseq(field_pattern,COMMA) -> field_pattern . COMMA nsepseq(field_pattern,COMMA) [ RBRACE ] @@ -3059,7 +3053,7 @@ contract: Let LBRACE Ident EQ Bytes WILD contract: Let LBRACE Ident EQ VBAR ## -## Ends in an error in state: 284. +## Ends in an error in state: 283. ## ## field_pattern -> Ident EQ . sub_pattern [ RBRACE COMMA ] ## @@ -3071,7 +3065,7 @@ contract: Let LBRACE Ident EQ VBAR contract: Let LBRACE Ident WILD ## -## Ends in an error in state: 283. +## Ends in an error in state: 282. ## ## field_pattern -> Ident . EQ sub_pattern [ RBRACE COMMA ] ## @@ -3083,7 +3077,7 @@ contract: Let LBRACE Ident WILD contract: Let LBRACE WILD ## -## Ends in an error in state: 282. +## Ends in an error in state: 281. ## ## record_pattern -> LBRACE . sep_or_term_list(field_pattern,COMMA) RBRACE [ SEMI RPAR RBRACKET RBRACE EQ COMMA COLON ARROW ] ## @@ -3095,7 +3089,7 @@ contract: Let LBRACE WILD contract: Let LPAR C_Some VBAR ## -## Ends in an error in state: 289. +## Ends in an error in state: 288. ## ## constr_pattern -> C_Some . sub_pattern [ SEMI RPAR RBRACKET RBRACE COMMA ARROW ] ## @@ -3107,7 +3101,7 @@ contract: Let LPAR C_Some VBAR contract: Let LPAR Constr LBRACKET VBAR ## -## Ends in an error in state: 281. +## Ends in an error in state: 280. ## ## list__(sub_pattern) -> LBRACKET . option(sep_or_term_list(sub_pattern,SEMI)) RBRACKET [ SEMI RPAR RBRACKET RBRACE COMMA ARROW ] ## @@ -3119,7 +3113,7 @@ contract: Let LPAR Constr LBRACKET VBAR contract: Let LPAR Constr LBRACKET WILD SEMI VBAR ## -## Ends in an error in state: 314. +## Ends in an error in state: 313. ## ## nsepseq(sub_pattern,SEMI) -> sub_pattern SEMI . nsepseq(sub_pattern,SEMI) [ RBRACKET ] ## nseq(__anonymous_0(sub_pattern,SEMI)) -> sub_pattern SEMI . seq(__anonymous_0(sub_pattern,SEMI)) [ RBRACKET ] @@ -3132,7 +3126,7 @@ contract: Let LPAR Constr LBRACKET WILD SEMI VBAR contract: Let LPAR Constr LBRACKET WILD SEMI WILD SEMI VBAR ## -## Ends in an error in state: 316. +## Ends in an error in state: 315. ## ## nsepseq(sub_pattern,SEMI) -> sub_pattern SEMI . nsepseq(sub_pattern,SEMI) [ RBRACKET ] ## seq(__anonymous_0(sub_pattern,SEMI)) -> sub_pattern SEMI . seq(__anonymous_0(sub_pattern,SEMI)) [ RBRACKET ] @@ -3145,7 +3139,7 @@ contract: Let LPAR Constr LBRACKET WILD SEMI WILD SEMI VBAR contract: Let LPAR Constr LBRACKET WILD SEMI WILD WILD ## -## Ends in an error in state: 315. +## Ends in an error in state: 314. ## ## nsepseq(sub_pattern,SEMI) -> sub_pattern . [ RBRACKET ] ## nsepseq(sub_pattern,SEMI) -> sub_pattern . SEMI nsepseq(sub_pattern,SEMI) [ RBRACKET ] @@ -3159,7 +3153,7 @@ contract: Let LPAR Constr LBRACKET WILD SEMI WILD WILD contract: Let LPAR Constr LBRACKET WILD WILD ## -## Ends in an error in state: 313. +## Ends in an error in state: 312. ## ## nsepseq(sub_pattern,SEMI) -> sub_pattern . [ RBRACKET ] ## nsepseq(sub_pattern,SEMI) -> sub_pattern . SEMI nsepseq(sub_pattern,SEMI) [ RBRACKET ] @@ -3173,7 +3167,7 @@ contract: Let LPAR Constr LBRACKET WILD WILD contract: Let LPAR Constr LPAR VBAR ## -## Ends in an error in state: 280. +## Ends in an error in state: 279. ## ## par(ptuple) -> LPAR . ptuple RPAR [ SEMI RPAR RBRACKET RBRACE COMMA ARROW ] ## par(sub_pattern) -> LPAR . sub_pattern RPAR [ SEMI RPAR RBRACKET RBRACE COMMA ARROW ] @@ -3187,7 +3181,7 @@ contract: Let LPAR Constr LPAR VBAR contract: Let LPAR Constr LPAR WILD COMMA Bytes ARROW ## -## Ends in an error in state: 333. +## Ends in an error in state: 332. ## ## par(ptuple) -> LPAR ptuple . RPAR [ SEMI RPAR RBRACKET RBRACE COMMA ARROW ] ## @@ -3198,16 +3192,16 @@ contract: Let LPAR Constr LPAR WILD COMMA Bytes ARROW ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 329, spurious reduction of production nsepseq(sub_pattern,COMMA) -> sub_pattern -## In state 332, spurious reduction of production tuple(sub_pattern) -> sub_pattern COMMA nsepseq(sub_pattern,COMMA) -## In state 325, spurious reduction of production ptuple -> tuple(sub_pattern) +## In state 328, spurious reduction of production nsepseq(sub_pattern,COMMA) -> sub_pattern +## In state 331, spurious reduction of production tuple(sub_pattern) -> sub_pattern COMMA nsepseq(sub_pattern,COMMA) +## In state 324, spurious reduction of production ptuple -> tuple(sub_pattern) ## contract: Let LPAR Constr LPAR WILD WILD ## -## Ends in an error in state: 326. +## Ends in an error in state: 325. ## ## par(sub_pattern) -> LPAR sub_pattern . RPAR [ SEMI RPAR RBRACKET RBRACE COMMA ARROW ] ## tuple(sub_pattern) -> sub_pattern . COMMA nsepseq(sub_pattern,COMMA) [ RPAR ] @@ -3220,7 +3214,7 @@ contract: Let LPAR Constr LPAR WILD WILD contract: Let LPAR Constr SEMI ## -## Ends in an error in state: 373. +## Ends in an error in state: 372. ## ## par(closed_irrefutable) -> LPAR closed_irrefutable . RPAR [ RPAR EQ COMMA COLON ] ## @@ -3231,15 +3225,15 @@ contract: Let LPAR Constr SEMI ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 288, spurious reduction of production constr_pattern -> Constr -## In state 372, spurious reduction of production closed_irrefutable -> constr_pattern +## In state 287, spurious reduction of production constr_pattern -> Constr +## In state 371, spurious reduction of production closed_irrefutable -> constr_pattern ## contract: Let LPAR Constr VBAR ## -## Ends in an error in state: 288. +## Ends in an error in state: 287. ## ## constr_pattern -> Constr . sub_pattern [ SEMI RPAR RBRACKET RBRACE COMMA ARROW ] ## constr_pattern -> Constr . [ SEMI RPAR RBRACKET RBRACE COMMA ARROW ] @@ -3252,7 +3246,7 @@ contract: Let LPAR Constr VBAR contract: Let LPAR RPAR COLON Constr Type ## -## Ends in an error in state: 380. +## Ends in an error in state: 379. ## ## let_binding -> unit option(type_annotation) . EQ expr [ Type SEMI Let EOF Attr ] ## @@ -3264,7 +3258,7 @@ contract: Let LPAR RPAR COLON Constr Type ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 48, spurious reduction of production variant -> Constr -## In state 41, spurious reduction of production nsepseq(variant,VBAR) -> variant +## In state 37, spurious reduction of production nsepseq(variant,VBAR) -> variant ## In state 52, spurious reduction of production sum_type -> nsepseq(variant,VBAR) ## In state 66, spurious reduction of production type_expr -> sum_type ## In state 78, spurious reduction of production type_annotation -> COLON type_expr @@ -3275,7 +3269,7 @@ contract: Let LPAR RPAR COLON Constr Type contract: Let LPAR RPAR EQ WILD ## -## Ends in an error in state: 381. +## Ends in an error in state: 380. ## ## let_binding -> unit option(type_annotation) EQ . expr [ Type SEMI Let EOF Attr ] ## @@ -3287,7 +3281,7 @@ contract: Let LPAR RPAR EQ WILD contract: Let LPAR RPAR WILD ## -## Ends in an error in state: 379. +## Ends in an error in state: 378. ## ## let_binding -> unit . option(type_annotation) EQ expr [ Type SEMI Let EOF Attr ] ## sub_irrefutable -> unit . [ COMMA ] @@ -3300,7 +3294,7 @@ contract: Let LPAR RPAR WILD contract: Let LPAR VBAR ## -## Ends in an error in state: 355. +## Ends in an error in state: 354. ## ## par(closed_irrefutable) -> LPAR . closed_irrefutable RPAR [ RPAR EQ COMMA COLON ] ## unit -> LPAR . RPAR [ RPAR EQ COMMA COLON ] @@ -3313,7 +3307,7 @@ contract: Let LPAR VBAR contract: Let LPAR WILD COLON WILD ## -## Ends in an error in state: 370. +## Ends in an error in state: 369. ## ## typed_pattern -> irrefutable COLON . type_expr [ RPAR ] ## @@ -3325,7 +3319,7 @@ contract: Let LPAR WILD COLON WILD contract: Let LPAR WILD COMMA Ident EQ ## -## Ends in an error in state: 369. +## Ends in an error in state: 368. ## ## closed_irrefutable -> irrefutable . [ RPAR ] ## typed_pattern -> irrefutable . COLON type_expr [ RPAR ] @@ -3337,16 +3331,16 @@ contract: Let LPAR WILD COMMA Ident EQ ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 363, spurious reduction of production nsepseq(sub_irrefutable,COMMA) -> sub_irrefutable -## In state 368, spurious reduction of production tuple(sub_irrefutable) -> sub_irrefutable COMMA nsepseq(sub_irrefutable,COMMA) -## In state 360, spurious reduction of production irrefutable -> tuple(sub_irrefutable) +## In state 362, spurious reduction of production nsepseq(sub_irrefutable,COMMA) -> sub_irrefutable +## In state 367, spurious reduction of production tuple(sub_irrefutable) -> sub_irrefutable COMMA nsepseq(sub_irrefutable,COMMA) +## In state 359, spurious reduction of production irrefutable -> tuple(sub_irrefutable) ## contract: Let LPAR WILD RPAR COLON Constr Type ## -## Ends in an error in state: 393. +## Ends in an error in state: 392. ## ## let_binding -> par(closed_irrefutable) option(type_annotation) . EQ expr [ Type SEMI Let EOF Attr ] ## @@ -3358,7 +3352,7 @@ contract: Let LPAR WILD RPAR COLON Constr Type ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 48, spurious reduction of production variant -> Constr -## In state 41, spurious reduction of production nsepseq(variant,VBAR) -> variant +## In state 37, spurious reduction of production nsepseq(variant,VBAR) -> variant ## In state 52, spurious reduction of production sum_type -> nsepseq(variant,VBAR) ## In state 66, spurious reduction of production type_expr -> sum_type ## In state 78, spurious reduction of production type_annotation -> COLON type_expr @@ -3369,7 +3363,7 @@ contract: Let LPAR WILD RPAR COLON Constr Type contract: Let LPAR WILD RPAR EQ WILD ## -## Ends in an error in state: 394. +## Ends in an error in state: 393. ## ## let_binding -> par(closed_irrefutable) option(type_annotation) EQ . expr [ Type SEMI Let EOF Attr ] ## @@ -3381,7 +3375,7 @@ contract: Let LPAR WILD RPAR EQ WILD contract: Let LPAR WILD RPAR WILD ## -## Ends in an error in state: 392. +## Ends in an error in state: 391. ## ## let_binding -> par(closed_irrefutable) . option(type_annotation) EQ expr [ Type SEMI Let EOF Attr ] ## sub_irrefutable -> par(closed_irrefutable) . [ COMMA ] @@ -3394,7 +3388,7 @@ contract: Let LPAR WILD RPAR WILD contract: Let LPAR WILD WILD ## -## Ends in an error in state: 361. +## Ends in an error in state: 360. ## ## irrefutable -> sub_irrefutable . [ RPAR COLON ] ## tuple(sub_irrefutable) -> sub_irrefutable . COMMA nsepseq(sub_irrefutable,COMMA) [ RPAR COLON ] @@ -3407,7 +3401,7 @@ contract: Let LPAR WILD WILD contract: Let Rec VBAR ## -## Ends in an error in state: 533. +## Ends in an error in state: 532. ## ## let_declaration -> seq(Attr) Let Rec . let_binding [ Type SEMI Let EOF Attr ] ## @@ -3444,8 +3438,8 @@ contract: Let WILD COLON Ident Type ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 8, spurious reduction of production core_type -> Ident -## In state 15, spurious reduction of production cartesian -> core_type -## In state 68, spurious reduction of production type_expr -> cartesian +## In state 23, spurious reduction of production fun_type -> core_type +## In state 68, spurious reduction of production type_expr -> fun_type ## In state 78, spurious reduction of production type_annotation -> COLON type_expr ## In state 79, spurious reduction of production option(type_annotation) -> type_annotation ## @@ -3466,7 +3460,7 @@ contract: Let WILD COLON WILD contract: Let WILD COMMA Ident COLON Constr Type ## -## Ends in an error in state: 384. +## Ends in an error in state: 383. ## ## let_binding -> tuple(sub_irrefutable) option(type_annotation) . EQ expr [ Type SEMI Let EOF Attr ] ## @@ -3478,7 +3472,7 @@ contract: Let WILD COMMA Ident COLON Constr Type ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 48, spurious reduction of production variant -> Constr -## In state 41, spurious reduction of production nsepseq(variant,VBAR) -> variant +## In state 37, spurious reduction of production nsepseq(variant,VBAR) -> variant ## In state 52, spurious reduction of production sum_type -> nsepseq(variant,VBAR) ## In state 66, spurious reduction of production type_expr -> sum_type ## In state 78, spurious reduction of production type_annotation -> COLON type_expr @@ -3489,7 +3483,7 @@ contract: Let WILD COMMA Ident COLON Constr Type contract: Let WILD COMMA Ident EQ WILD ## -## Ends in an error in state: 385. +## Ends in an error in state: 384. ## ## let_binding -> tuple(sub_irrefutable) option(type_annotation) EQ . expr [ Type SEMI Let EOF Attr ] ## @@ -3501,7 +3495,7 @@ contract: Let WILD COMMA Ident EQ WILD contract: Let WILD COMMA Ident RPAR ## -## Ends in an error in state: 383. +## Ends in an error in state: 382. ## ## let_binding -> tuple(sub_irrefutable) . option(type_annotation) EQ expr [ Type SEMI Let EOF Attr ] ## @@ -3512,15 +3506,15 @@ contract: Let WILD COMMA Ident RPAR ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 363, spurious reduction of production nsepseq(sub_irrefutable,COMMA) -> sub_irrefutable -## In state 368, spurious reduction of production tuple(sub_irrefutable) -> sub_irrefutable COMMA nsepseq(sub_irrefutable,COMMA) +## In state 362, spurious reduction of production nsepseq(sub_irrefutable,COMMA) -> sub_irrefutable +## In state 367, spurious reduction of production tuple(sub_irrefutable) -> sub_irrefutable COMMA nsepseq(sub_irrefutable,COMMA) ## contract: Let WILD COMMA VBAR ## -## Ends in an error in state: 362. +## Ends in an error in state: 361. ## ## tuple(sub_irrefutable) -> sub_irrefutable COMMA . nsepseq(sub_irrefutable,COMMA) [ RPAR EQ COLON ] ## @@ -3532,7 +3526,7 @@ contract: Let WILD COMMA VBAR contract: Let WILD COMMA WILD COMMA VBAR ## -## Ends in an error in state: 364. +## Ends in an error in state: 363. ## ## nsepseq(sub_irrefutable,COMMA) -> sub_irrefutable COMMA . nsepseq(sub_irrefutable,COMMA) [ RPAR EQ COLON ] ## @@ -3544,7 +3538,7 @@ contract: Let WILD COMMA WILD COMMA VBAR contract: Let WILD COMMA WILD WILD ## -## Ends in an error in state: 363. +## Ends in an error in state: 362. ## ## nsepseq(sub_irrefutable,COMMA) -> sub_irrefutable . [ RPAR EQ COLON ] ## nsepseq(sub_irrefutable,COMMA) -> sub_irrefutable . COMMA nsepseq(sub_irrefutable,COMMA) [ RPAR EQ COLON ] @@ -3557,7 +3551,7 @@ contract: Let WILD COMMA WILD WILD contract: Let WILD EQ Bytes VBAR ## -## Ends in an error in state: 536. +## Ends in an error in state: 535. ## ## declaration -> let_declaration . option(SEMI) [ Type Let EOF Attr ] ## @@ -3581,8 +3575,8 @@ contract: Let WILD EQ Bytes VBAR ## In state 164, spurious reduction of production base_expr(expr) -> disj_expr_level ## In state 221, spurious reduction of production base_cond__open(expr) -> base_expr(expr) ## In state 222, spurious reduction of production expr -> base_cond__open(expr) -## In state 532, spurious reduction of production let_binding -> WILD option(type_annotation) EQ expr -## In state 535, spurious reduction of production let_declaration -> seq(Attr) Let let_binding +## In state 531, spurious reduction of production let_binding -> WILD option(type_annotation) EQ expr +## In state 534, spurious reduction of production let_declaration -> seq(Attr) Let let_binding ## @@ -3614,7 +3608,7 @@ contract: Let WILD WILD contract: Type Ident EQ Constr DOT WILD ## -## Ends in an error in state: 12. +## Ends in an error in state: 11. ## ## core_type -> Constr DOT . Ident [ Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## @@ -3626,7 +3620,7 @@ contract: Type Ident EQ Constr DOT WILD contract: Type Ident EQ Constr LPAR Ident RPAR WILD ## -## Ends in an error in state: 41. +## Ends in an error in state: 37. ## ## nsepseq(variant,VBAR) -> variant . [ Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## nsepseq(variant,VBAR) -> variant . VBAR nsepseq(variant,VBAR) [ Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] @@ -3639,19 +3633,19 @@ contract: Type Ident EQ Constr LPAR Ident RPAR WILD contract: Type Ident EQ Constr LPAR Ident Type ## -## Ends in an error in state: 39. +## Ends in an error in state: 35. ## -## variant -> Constr LPAR cartesian . RPAR [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] +## variant -> Constr LPAR fun_type . RPAR [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: -## Constr LPAR cartesian +## Constr LPAR fun_type ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 8, spurious reduction of production core_type -> Ident -## In state 15, spurious reduction of production cartesian -> core_type +## In state 23, spurious reduction of production fun_type -> core_type ## @@ -3660,7 +3654,7 @@ contract: Type Ident EQ Constr LPAR WILD ## ## Ends in an error in state: 6. ## -## variant -> Constr LPAR . cartesian RPAR [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] +## variant -> Constr LPAR . fun_type RPAR [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: ## Constr LPAR @@ -3682,7 +3676,7 @@ contract: Type Ident EQ Constr RPAR ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 48, spurious reduction of production variant -> Constr -## In state 41, spurious reduction of production nsepseq(variant,VBAR) -> variant +## In state 37, spurious reduction of production nsepseq(variant,VBAR) -> variant ## In state 52, spurious reduction of production sum_type -> nsepseq(variant,VBAR) ## In state 66, spurious reduction of production type_expr -> sum_type ## In state 65, spurious reduction of production type_decl -> Type Ident EQ type_expr @@ -3692,7 +3686,7 @@ contract: Type Ident EQ Constr RPAR contract: Type Ident EQ Constr SEMI WILD ## -## Ends in an error in state: 540. +## Ends in an error in state: 539. ## ## declarations -> declaration . [ EOF ] ## declarations -> declaration . declarations [ EOF ] @@ -3705,7 +3699,7 @@ contract: Type Ident EQ Constr SEMI WILD contract: Type Ident EQ Constr VBAR WILD ## -## Ends in an error in state: 42. +## Ends in an error in state: 38. ## ## nsepseq(variant,VBAR) -> variant VBAR . nsepseq(variant,VBAR) [ Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## @@ -3721,7 +3715,7 @@ contract: Type Ident EQ Constr WILD ## ## core_type -> Constr . DOT Ident [ Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## variant -> Constr . [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] -## variant -> Constr . LPAR cartesian RPAR [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] +## variant -> Constr . LPAR fun_type RPAR [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: ## Constr @@ -3731,87 +3725,32 @@ contract: Type Ident EQ Constr WILD contract: Type Ident EQ Ident ARROW WILD ## -## Ends in an error in state: 25. +## Ends in an error in state: 24. ## -## type_expr_func -> ARROW . cartesian [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> Ident ARROW . fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: -## ARROW +## Ident ARROW ## -contract: Type Ident EQ Ident LPAR Ident COMMA WILD +contract: Type Ident EQ Ident LPAR Ident Type ## -## Ends in an error in state: 23. +## Ends in an error in state: 17. ## -## nsepseq(core_type,COMMA) -> core_type COMMA . nsepseq(core_type,COMMA) [ RPAR ] +## tuple(fun_type) -> fun_type . COMMA nsepseq(fun_type,COMMA) [ RPAR ] +## type_args -> fun_type . [ RPAR ] ## ## The known suffix of the stack is as follows: -## core_type COMMA -## - - - -contract: Type Ident EQ Ident LPAR Ident RBRACE -## -## Ends in an error in state: 22. -## -## nsepseq(core_type,COMMA) -> core_type . [ RPAR ] -## nsepseq(core_type,COMMA) -> core_type . COMMA nsepseq(core_type,COMMA) [ RPAR ] -## -## The known suffix of the stack is as follows: -## core_type -## -## WARNING: This example involves spurious reductions. -## This implies that, although the LR(1) items shown above provide an -## accurate view of the past (what has been recognized so far), they -## may provide an INCOMPLETE view of the future (what was expected next). -## In state 18, spurious reduction of production core_type -> Ident -## - - - -contract: Type Ident EQ Ident LPAR Ident WILD -## -## Ends in an error in state: 18. -## -## core_type -> Ident . [ RPAR RBRACE COMMA ] -## core_type -> Ident . par(__anonymous_1) [ RPAR RBRACE COMMA ] -## -## The known suffix of the stack is as follows: -## Ident -## - - - -contract: Type Ident EQ Ident LPAR LPAR Ident Type -## -## Ends in an error in state: 16. -## -## par(cartesian) -> LPAR cartesian . RPAR [ RPAR RBRACE COMMA ] -## -## The known suffix of the stack is as follows: -## LPAR cartesian +## fun_type ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 8, spurious reduction of production core_type -> Ident -## In state 15, spurious reduction of production cartesian -> core_type -## - - - -contract: Type Ident EQ Ident LPAR LPAR WILD -## -## Ends in an error in state: 10. -## -## par(cartesian) -> LPAR . cartesian RPAR [ RPAR RBRACE COMMA ] -## -## The known suffix of the stack is as follows: -## LPAR +## In state 23, spurious reduction of production fun_type -> core_type ## @@ -3820,7 +3759,7 @@ contract: Type Ident EQ Ident LPAR WILD ## ## Ends in an error in state: 9. ## -## par(__anonymous_1) -> LPAR . nsepseq(core_type,COMMA) RPAR [ Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] +## par(type_args) -> LPAR . type_args RPAR [ Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: ## LPAR @@ -3832,9 +3771,9 @@ contract: Type Ident EQ Ident WILD ## ## Ends in an error in state: 8. ## -## cartesian -> Ident . type_expr_func [ Type SEMI RPAR Let EQ EOF COMMA Attr ] ## core_type -> Ident . [ Type SEMI RPAR Let EQ EOF COMMA Attr ] -## core_type -> Ident . par(__anonymous_1) [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## core_type -> Ident . par(type_args) [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> Ident . ARROW fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: ## Ident @@ -3858,7 +3797,7 @@ contract: Type Ident EQ LBRACE Ident COLON Constr Type ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 48, spurious reduction of production variant -> Constr -## In state 41, spurious reduction of production nsepseq(variant,VBAR) -> variant +## In state 37, spurious reduction of production nsepseq(variant,VBAR) -> variant ## In state 52, spurious reduction of production sum_type -> nsepseq(variant,VBAR) ## In state 50, spurious reduction of production type_expr_field -> sum_type ## In state 49, spurious reduction of production field_decl -> Ident COLON type_expr_field @@ -3866,10 +3805,54 @@ contract: Type Ident EQ LBRACE Ident COLON Constr Type -contract: Type Ident EQ LBRACE Ident COLON WILD +contract: Type Ident EQ LBRACE Ident COLON Ident WILD ## ## Ends in an error in state: 47. ## +## core_type -> Ident . [ RBRACE COMMA ] +## core_type -> Ident . par(type_args) [ RBRACE COMMA ] +## +## The known suffix of the stack is as follows: +## Ident +## + + + +contract: Type Ident EQ LBRACE Ident COLON LPAR Ident Type +## +## Ends in an error in state: 45. +## +## par(fun_type) -> LPAR fun_type . RPAR [ RBRACE COMMA ] +## +## The known suffix of the stack is as follows: +## LPAR fun_type +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 8, spurious reduction of production core_type -> Ident +## In state 23, spurious reduction of production fun_type -> core_type +## + + + +contract: Type Ident EQ LBRACE Ident COLON LPAR WILD +## +## Ends in an error in state: 44. +## +## par(fun_type) -> LPAR . fun_type RPAR [ RBRACE COMMA ] +## +## The known suffix of the stack is as follows: +## LPAR +## + + + +contract: Type Ident EQ LBRACE Ident COLON WILD +## +## Ends in an error in state: 43. +## ## field_decl -> Ident COLON . type_expr_field [ RBRACE COMMA ] ## ## The known suffix of the stack is as follows: @@ -3894,7 +3877,7 @@ contract: Type Ident EQ LBRACE Ident COMMA Ident COLON Constr Type ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 48, spurious reduction of production variant -> Constr -## In state 41, spurious reduction of production nsepseq(variant,VBAR) -> variant +## In state 37, spurious reduction of production nsepseq(variant,VBAR) -> variant ## In state 52, spurious reduction of production sum_type -> nsepseq(variant,VBAR) ## In state 50, spurious reduction of production type_expr_field -> sum_type ## In state 49, spurious reduction of production field_decl -> Ident COLON type_expr_field @@ -3930,7 +3913,7 @@ contract: Type Ident EQ LBRACE Ident COMMA WILD contract: Type Ident EQ LBRACE Ident WILD ## -## Ends in an error in state: 46. +## Ends in an error in state: 42. ## ## field_decl -> Ident . [ RBRACE COMMA ] ## field_decl -> Ident . COLON type_expr_field [ RBRACE COMMA ] @@ -3943,7 +3926,7 @@ contract: Type Ident EQ LBRACE Ident WILD contract: Type Ident EQ LBRACE WILD ## -## Ends in an error in state: 45. +## Ends in an error in state: 41. ## ## record_type -> LBRACE . sep_or_term_list(field_decl,COMMA) RBRACE [ Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## @@ -3955,7 +3938,7 @@ contract: Type Ident EQ LBRACE WILD contract: Type Ident EQ LPAR Constr WILD ## -## Ends in an error in state: 11. +## Ends in an error in state: 10. ## ## core_type -> Constr . DOT Ident [ Type SEMI RPAR Let EQ EOF COMMA Attr ] ## @@ -3967,90 +3950,115 @@ contract: Type Ident EQ LPAR Constr WILD contract: Type Ident EQ LPAR Ident COMMA Ident COMMA WILD ## -## Ends in an error in state: 37. +## Ends in an error in state: 21. ## -## nsepseq(cartesian,COMMA) -> cartesian COMMA . nsepseq(cartesian,COMMA) [ RPAR ] +## nsepseq(fun_type,COMMA) -> fun_type COMMA . nsepseq(fun_type,COMMA) [ RPAR ] ## ## The known suffix of the stack is as follows: -## cartesian COMMA +## fun_type COMMA +## + + + +contract: Type Ident EQ LPAR Ident COMMA Ident RPAR ARROW WILD +## +## Ends in an error in state: 29. +## +## fun_type -> LPAR tuple(fun_type) RPAR ARROW . fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## +## The known suffix of the stack is as follows: +## LPAR tuple(fun_type) RPAR ARROW ## contract: Type Ident EQ LPAR Ident COMMA Ident RPAR WILD ## -## Ends in an error in state: 33. +## Ends in an error in state: 28. ## -## cartesian -> LPAR cartesian COMMA nsepseq(cartesian,COMMA) RPAR . option(type_expr_func) [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> LPAR tuple(fun_type) RPAR . ARROW fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> LPAR tuple(fun_type) RPAR . [ Type SEMI RPAR Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: -## LPAR cartesian COMMA nsepseq(cartesian,COMMA) RPAR +## LPAR tuple(fun_type) RPAR ## contract: Type Ident EQ LPAR Ident COMMA Ident Type ## -## Ends in an error in state: 36. +## Ends in an error in state: 20. ## -## nsepseq(cartesian,COMMA) -> cartesian . [ RPAR ] -## nsepseq(cartesian,COMMA) -> cartesian . COMMA nsepseq(cartesian,COMMA) [ RPAR ] +## nsepseq(fun_type,COMMA) -> fun_type . [ RPAR ] +## nsepseq(fun_type,COMMA) -> fun_type . COMMA nsepseq(fun_type,COMMA) [ RPAR ] ## ## The known suffix of the stack is as follows: -## cartesian +## fun_type ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 8, spurious reduction of production core_type -> Ident -## In state 15, spurious reduction of production cartesian -> core_type +## In state 23, spurious reduction of production fun_type -> core_type ## contract: Type Ident EQ LPAR Ident COMMA WILD ## -## Ends in an error in state: 31. +## Ends in an error in state: 18. ## -## cartesian -> LPAR cartesian COMMA . nsepseq(cartesian,COMMA) RPAR option(type_expr_func) [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## tuple(fun_type) -> fun_type COMMA . nsepseq(fun_type,COMMA) [ RPAR ] ## ## The known suffix of the stack is as follows: -## LPAR cartesian COMMA +## fun_type COMMA +## + + + +contract: Type Ident EQ LPAR Ident RPAR ARROW WILD +## +## Ends in an error in state: 33. +## +## fun_type -> LPAR fun_type RPAR ARROW . fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## +## The known suffix of the stack is as follows: +## LPAR fun_type RPAR ARROW ## contract: Type Ident EQ LPAR Ident RPAR WILD ## -## Ends in an error in state: 29. +## Ends in an error in state: 32. ## -## cartesian -> LPAR cartesian RPAR . type_expr_func [ Type SEMI RPAR Let EQ EOF COMMA Attr ] -## par(cartesian) -> LPAR cartesian RPAR . [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> LPAR fun_type RPAR . ARROW fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## par(fun_type) -> LPAR fun_type RPAR . [ Type SEMI RPAR Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: -## LPAR cartesian RPAR +## LPAR fun_type RPAR ## contract: Type Ident EQ LPAR Ident Type ## -## Ends in an error in state: 28. +## Ends in an error in state: 31. ## -## cartesian -> LPAR cartesian . RPAR type_expr_func [ Type SEMI RPAR Let EQ EOF COMMA Attr ] -## cartesian -> LPAR cartesian . COMMA nsepseq(cartesian,COMMA) RPAR option(type_expr_func) [ Type SEMI RPAR Let EQ EOF COMMA Attr ] -## par(cartesian) -> LPAR cartesian . RPAR [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> LPAR fun_type . RPAR ARROW fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## par(fun_type) -> LPAR fun_type . RPAR [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## tuple(fun_type) -> fun_type . COMMA nsepseq(fun_type,COMMA) [ RPAR ] ## ## The known suffix of the stack is as follows: -## LPAR cartesian +## LPAR fun_type ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 8, spurious reduction of production core_type -> Ident -## In state 15, spurious reduction of production cartesian -> core_type +## In state 23, spurious reduction of production fun_type -> core_type ## @@ -4059,9 +4067,10 @@ contract: Type Ident EQ LPAR WILD ## ## Ends in an error in state: 7. ## -## cartesian -> LPAR . cartesian RPAR type_expr_func [ Type SEMI RPAR Let EQ EOF COMMA Attr ] -## cartesian -> LPAR . cartesian COMMA nsepseq(cartesian,COMMA) RPAR option(type_expr_func) [ Type SEMI RPAR Let EQ EOF COMMA Attr ] -## par(cartesian) -> LPAR . cartesian RPAR [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> LPAR . fun_type RPAR ARROW fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> LPAR . tuple(fun_type) RPAR ARROW fun_type [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## fun_type -> LPAR . tuple(fun_type) RPAR [ Type SEMI RPAR Let EQ EOF COMMA Attr ] +## par(fun_type) -> LPAR . fun_type RPAR [ Type SEMI RPAR Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: ## LPAR @@ -4074,7 +4083,7 @@ contract: Type Ident EQ VBAR Constr WILD ## Ends in an error in state: 5. ## ## variant -> Constr . [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] -## variant -> Constr . LPAR cartesian RPAR [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] +## variant -> Constr . LPAR fun_type RPAR [ VBAR Type SEMI RPAR RBRACE Let EQ EOF COMMA Attr ] ## ## The known suffix of the stack is as follows: ## Constr diff --git a/src/passes/6-interpreter/dune b/src/passes/10-interpreter/dune similarity index 100% rename from src/passes/6-interpreter/dune rename to src/passes/10-interpreter/dune diff --git a/src/passes/6-interpreter/interpreter.ml b/src/passes/10-interpreter/interpreter.ml similarity index 99% rename from src/passes/6-interpreter/interpreter.ml rename to src/passes/10-interpreter/interpreter.ml index cdbee239c..1a04d35c4 100644 --- a/src/passes/6-interpreter/interpreter.ml +++ b/src/passes/10-interpreter/interpreter.ml @@ -270,7 +270,7 @@ and eval_literal : Ast_typed.literal -> value result = function and eval : Ast_typed.expression -> env -> value result = fun term env -> match term.expression_content with - | E_application ({expr1 = f; expr2 = args}) -> ( + | E_application ({lamb = f; args}) -> ( let%bind f' = eval f env in let%bind args' = eval args env in match f' with diff --git a/src/passes/6-interpreter/interpreter.mli b/src/passes/10-interpreter/interpreter.mli similarity index 100% rename from src/passes/6-interpreter/interpreter.mli rename to src/passes/10-interpreter/interpreter.mli diff --git a/src/passes/6-transpiler/dune b/src/passes/10-transpiler/dune similarity index 100% rename from src/passes/6-transpiler/dune rename to src/passes/10-transpiler/dune diff --git a/src/passes/6-transpiler/helpers.ml b/src/passes/10-transpiler/helpers.ml similarity index 100% rename from src/passes/6-transpiler/helpers.ml rename to src/passes/10-transpiler/helpers.ml diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/10-transpiler/transpiler.ml similarity index 99% rename from src/passes/6-transpiler/transpiler.ml rename to src/passes/10-transpiler/transpiler.ml index 3cf73747e..2d726d2df 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/10-transpiler/transpiler.ml @@ -253,9 +253,9 @@ and transpile_annotated_expression (ae:AST.expression) : expression result = let%bind tv = transpile_environment_element_type ele in return ~tv @@ E_variable (name) ) - | E_application {expr1;expr2} -> - let%bind a = transpile_annotated_expression expr1 in - let%bind b = transpile_annotated_expression expr2 in + | E_application {lamb; args} -> + let%bind a = transpile_annotated_expression lamb in + let%bind b = transpile_annotated_expression args in return @@ E_application (a, b) | E_constructor {constructor;element} -> ( let%bind param' = transpile_annotated_expression element in @@ -550,10 +550,10 @@ and transpile_recursive {fun_name; fun_type; lambda} = E_matching m -> let%bind ty = transpile_type e.type_expression in matching fun_name loop_type shadowed m ty | - E_application {expr1;expr2} -> ( - match expr1.expression_content,shadowed with + E_application {lamb;args} -> ( + match lamb.expression_content,shadowed with E_variable name, false when Var.equal fun_name name -> - let%bind expr = transpile_annotated_expression expr2 in + let%bind expr = transpile_annotated_expression args in ok @@ Expression.make (E_constant {cons_name=C_LOOP_CONTINUE;arguments=[expr]}) loop_type | _ -> let%bind expr = transpile_annotated_expression e in diff --git a/src/passes/6-transpiler/transpiler.mli b/src/passes/10-transpiler/transpiler.mli similarity index 100% rename from src/passes/6-transpiler/transpiler.mli rename to src/passes/10-transpiler/transpiler.mli diff --git a/src/passes/6-transpiler/untranspiler.ml b/src/passes/10-transpiler/untranspiler.ml similarity index 100% rename from src/passes/6-transpiler/untranspiler.ml rename to src/passes/10-transpiler/untranspiler.ml diff --git a/src/passes/7-self_mini_c/dune b/src/passes/11-self_mini_c/dune similarity index 100% rename from src/passes/7-self_mini_c/dune rename to src/passes/11-self_mini_c/dune diff --git a/src/passes/7-self_mini_c/helpers.ml b/src/passes/11-self_mini_c/helpers.ml similarity index 100% rename from src/passes/7-self_mini_c/helpers.ml rename to src/passes/11-self_mini_c/helpers.ml diff --git a/src/passes/7-self_mini_c/michelson_restrictions.ml b/src/passes/11-self_mini_c/michelson_restrictions.ml similarity index 100% rename from src/passes/7-self_mini_c/michelson_restrictions.ml rename to src/passes/11-self_mini_c/michelson_restrictions.ml diff --git a/src/passes/7-self_mini_c/self_mini_c.ml b/src/passes/11-self_mini_c/self_mini_c.ml similarity index 100% rename from src/passes/7-self_mini_c/self_mini_c.ml rename to src/passes/11-self_mini_c/self_mini_c.ml diff --git a/src/passes/7-self_mini_c/subst.ml b/src/passes/11-self_mini_c/subst.ml similarity index 100% rename from src/passes/7-self_mini_c/subst.ml rename to src/passes/11-self_mini_c/subst.ml diff --git a/src/passes/8-compiler/compiler.ml b/src/passes/12-compiler/compiler.ml similarity index 100% rename from src/passes/8-compiler/compiler.ml rename to src/passes/12-compiler/compiler.ml diff --git a/src/passes/8-compiler/compiler_environment.ml b/src/passes/12-compiler/compiler_environment.ml similarity index 100% rename from src/passes/8-compiler/compiler_environment.ml rename to src/passes/12-compiler/compiler_environment.ml diff --git a/src/passes/8-compiler/compiler_environment.mli b/src/passes/12-compiler/compiler_environment.mli similarity index 100% rename from src/passes/8-compiler/compiler_environment.mli rename to src/passes/12-compiler/compiler_environment.mli diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/12-compiler/compiler_program.ml similarity index 100% rename from src/passes/8-compiler/compiler_program.ml rename to src/passes/12-compiler/compiler_program.ml diff --git a/src/passes/8-compiler/compiler_program.mli b/src/passes/12-compiler/compiler_program.mli similarity index 100% rename from src/passes/8-compiler/compiler_program.mli rename to src/passes/12-compiler/compiler_program.mli diff --git a/src/passes/8-compiler/compiler_type.ml b/src/passes/12-compiler/compiler_type.ml similarity index 100% rename from src/passes/8-compiler/compiler_type.ml rename to src/passes/12-compiler/compiler_type.ml diff --git a/src/passes/8-compiler/compiler_type.mli b/src/passes/12-compiler/compiler_type.mli similarity index 100% rename from src/passes/8-compiler/compiler_type.mli rename to src/passes/12-compiler/compiler_type.mli diff --git a/src/passes/8-compiler/dune b/src/passes/12-compiler/dune similarity index 100% rename from src/passes/8-compiler/dune rename to src/passes/12-compiler/dune diff --git a/src/passes/8-compiler/uncompiler.ml b/src/passes/12-compiler/uncompiler.ml similarity index 100% rename from src/passes/8-compiler/uncompiler.ml rename to src/passes/12-compiler/uncompiler.ml diff --git a/src/passes/8-compiler/uncompiler.mli b/src/passes/12-compiler/uncompiler.mli similarity index 100% rename from src/passes/8-compiler/uncompiler.mli rename to src/passes/12-compiler/uncompiler.mli diff --git a/src/passes/9-self_michelson/dune b/src/passes/13-self_michelson/dune similarity index 100% rename from src/passes/9-self_michelson/dune rename to src/passes/13-self_michelson/dune diff --git a/src/passes/9-self_michelson/helpers.ml b/src/passes/13-self_michelson/helpers.ml similarity index 100% rename from src/passes/9-self_michelson/helpers.ml rename to src/passes/13-self_michelson/helpers.ml diff --git a/src/passes/3-self_ast_simplified/main.ml b/src/passes/13-self_michelson/main.ml similarity index 100% rename from src/passes/3-self_ast_simplified/main.ml rename to src/passes/13-self_michelson/main.ml diff --git a/src/passes/9-self_michelson/self_michelson.ml b/src/passes/13-self_michelson/self_michelson.ml similarity index 100% rename from src/passes/9-self_michelson/self_michelson.ml rename to src/passes/13-self_michelson/self_michelson.ml diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-concrete_to_imperative/cameligo.ml similarity index 86% rename from src/passes/2-simplify/cameligo.ml rename to src/passes/2-concrete_to_imperative/cameligo.ml index 4e82b9d11..f6b2ef165 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-concrete_to_imperative/cameligo.ml @@ -1,7 +1,7 @@ [@@@warning "-45"] open Trace -open Ast_simplified +open Ast_imperative module Raw = Parser.Cameligo.AST module SMap = Map.String @@ -114,8 +114,8 @@ module Errors = struct ] in error ~data title message - let simplifying_expr t = - let title () = "Simplifying expression" in + let abstracting_expr t = + let title () = "abstracting expression" in let message () = "" in let data = [ ("expression" , @@ -156,7 +156,7 @@ end open Errors -open Operators.Simplify.Cameligo +open Operators.Concrete_to_imperative.Cameligo let r_split = Location.r_split @@ -205,7 +205,7 @@ let rec typed_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern -> | Raw.PTyped pt -> let (p,t) = pt.value.pattern,pt.value.type_expr in let%bind p = tuple_pattern_to_vars p in - let%bind t = simpl_type_expression t in + let%bind t = compile_type_expression t in ok @@ (p,t) | other -> (fail @@ wrong_pattern "parenthetical or type annotation" other) @@ -213,10 +213,10 @@ and unpar_pattern : Raw.pattern -> Raw.pattern = function | PPar p -> unpar_pattern p.value.inside | _ as p -> p -and simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> - trace (simple_info "simplifying this type expression...") @@ +and compile_type_expression : Raw.type_expr -> type_expression result = fun te -> + trace (simple_info "abstracting this type expression...") @@ match te with - TPar x -> simpl_type_expression x.value.inside + TPar x -> compile_type_expression x.value.inside | TVar v -> ( match type_constants v.value with | Ok (s,_) -> ok @@ make_t @@ T_constant s @@ -225,8 +225,8 @@ and simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> | TFun x -> ( let%bind (type1 , type2) = let (a , _ , b) = x.value in - let%bind a = simpl_type_expression a in - let%bind b = simpl_type_expression b in + let%bind a = compile_type_expression a in + let%bind b = compile_type_expression b in ok (a , b) in ok @@ make_t @@ T_arrow {type1;type2} @@ -234,18 +234,18 @@ and simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> | TApp x -> ( let (name, tuple) = x.value in let lst = npseq_to_list tuple.value.inside in - let%bind lst' = bind_map_list simpl_type_expression lst in + let%bind lst' = bind_map_list compile_type_expression lst in let%bind cst = trace (unknown_predefined_type name) @@ type_operators name.value in t_operator cst lst' ) | TProd p -> ( - let%bind tpl = simpl_list_type_expression @@ npseq_to_list p.value in + let%bind tpl = compile_list_type_expression @@ npseq_to_list p.value in ok tpl ) | TRecord r -> - let aux = fun (x, y) -> let%bind y = simpl_type_expression y in ok (x, y) in + let aux = fun (x, y) -> let%bind y = compile_type_expression y in ok (x, y) in let apply (x:Raw.field_decl Raw.reg) = (x.value.field_name.value, x.value.field_type) in let%bind lst = @@ -262,7 +262,7 @@ and simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> None -> [] | Some (_, TProd product) -> npseq_to_list product.value | Some (_, t_expr) -> [t_expr] in - let%bind te = simpl_list_type_expression @@ args in + let%bind te = compile_list_type_expression @@ args in ok (v.value.constr.value, te) in let%bind lst = bind_list @@ List.map aux @@ -270,18 +270,18 @@ and simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> let m = List.fold_left (fun m (x, y) -> CMap.add (Constructor x) y m) CMap.empty lst in ok @@ make_t @@ T_sum m -and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result = +and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result = match lst with | [] -> ok @@ t_unit - | [hd] -> simpl_type_expression hd + | [hd] -> compile_type_expression hd | lst -> - let%bind lst = bind_map_list simpl_type_expression lst in + let%bind lst = bind_map_list compile_type_expression lst in ok @@ t_tuple lst -let rec simpl_expression : +let rec compile_expression : Raw.expr -> expr result = fun t -> let return x = ok x in - let simpl_projection = fun (p:Raw.projection Region.reg) -> + let compile_projection = fun (p:Raw.projection Region.reg) -> let (p , loc) = r_split p in let var = let name = Var.of_name p.struct_name.value in @@ -296,7 +296,7 @@ let rec simpl_expression : List.map aux @@ npseq_to_list path in return @@ List.fold_left (e_accessor ~loc ) var path' in - let simpl_path : Raw.path -> string * label list = fun p -> + let compile_path : Raw.path -> string * label list = fun p -> match p with | Raw.Name v -> (v.value , []) | Raw.Path p -> ( @@ -313,9 +313,9 @@ let rec simpl_expression : (var , path') ) in - let simpl_update = fun (u:Raw.update Region.reg) -> + let compile_update = fun (u:Raw.update Region.reg) -> let (u, loc) = r_split u in - let (name, path) = simpl_path u.record in + let (name, path) = compile_path u.record in let record = match path with | [] -> e_variable (Var.of_name name) | _ -> @@ -325,7 +325,7 @@ let rec simpl_expression : let%bind updates' = let aux (f:Raw.field_path_assign Raw.reg) = let (f,_) = r_split f in - let%bind expr = simpl_expression f.field_expr in + let%bind expr = compile_expression f.field_expr in ok ( List.map (fun (x: _ Raw.reg) -> x.value) (npseq_to_list f.field_path), expr) in bind_map_list aux @@ npseq_to_list updates @@ -342,7 +342,7 @@ let rec simpl_expression : bind_fold_list aux record updates' in - trace (simplifying_expr t) @@ + trace (abstracting_expr t) @@ match t with Raw.ELetIn e -> let Raw.{kwd_rec; binding; body; attributes; _} = e.value in @@ -352,20 +352,20 @@ let rec simpl_expression : | (p, []) -> let%bind variables = tuple_pattern_to_typed_vars p in let%bind ty_opt = - bind_map_option (fun (_,te) -> simpl_type_expression te) lhs_type in - let%bind rhs = simpl_expression let_rhs in + bind_map_option (fun (_,te) -> compile_type_expression te) lhs_type in + let%bind rhs = compile_expression let_rhs in let rhs_b = Var.fresh ~name: "rhs" () in let rhs',rhs_b_expr = match ty_opt with None -> rhs, e_variable rhs_b | Some ty -> (e_annotation rhs ty), e_annotation (e_variable rhs_b) ty in - let%bind body = simpl_expression body in + let%bind body = compile_expression body in let prepare_variable (ty_var: Raw.variable * Raw.type_expr option) = let variable, ty_opt = ty_var in let var_expr = Var.of_name variable.value in let%bind ty_expr_opt = match ty_opt with - | Some ty -> bind_map_option simpl_type_expression (Some ty) + | Some ty -> bind_map_option compile_type_expression (Some ty) | None -> ok None in ok (var_expr, ty_expr_opt) in @@ -397,7 +397,7 @@ let rec simpl_expression : | None -> (match let_rhs with | EFun {value={binders;lhs_type}} -> let f_args = nseq_to_list (binders) in - let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in + let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in let aux acc ty = Option.map (t_function (snd ty)) acc in ok @@ (List.fold_right' aux lhs_type' ty) @@ -444,8 +444,8 @@ let rec simpl_expression : end | Raw.EAnnot a -> let Raw.{inside=expr, _, type_expr; _}, loc = r_split a in - let%bind expr' = simpl_expression expr in - let%bind type_expr' = simpl_type_expression type_expr in + let%bind expr' = compile_expression expr in + let%bind type_expr' = compile_type_expression type_expr in return @@ e_annotation ~loc expr' type_expr' | EVar c -> let (c',loc) = r_split c in @@ -454,7 +454,7 @@ let rec simpl_expression : | Ok (s,_) -> return @@ e_constant s []) | ECall x -> ( let ((e1 , e2) , loc) = r_split x in - let%bind args = bind_map_list simpl_expression (nseq_to_list e2) in + let%bind args = bind_map_list compile_expression (nseq_to_list e2) in let rec chain_application (f: expression) (args: expression list) = match args with | hd :: tl -> chain_application (e_application ~loc f hd) tl @@ -468,29 +468,29 @@ let rec simpl_expression : | Ok (s, _) -> return @@ e_constant ~loc s args ) | e1 -> - let%bind e1' = simpl_expression e1 in + let%bind e1' = compile_expression e1 in return @@ chain_application e1' args ) - | EPar x -> simpl_expression x.value.inside + | EPar x -> compile_expression x.value.inside | EUnit reg -> let (_ , loc) = r_split reg in return @@ e_literal ~loc Literal_unit | EBytes x -> let (x , loc) = r_split x in return @@ e_literal ~loc (Literal_bytes (Hex.to_bytes @@ snd x)) - | ETuple tpl -> simpl_tuple_expression @@ (npseq_to_list tpl.value) + | ETuple tpl -> compile_tuple_expression @@ (npseq_to_list tpl.value) | ERecord r -> let (r , loc) = r_split r in let%bind fields = bind_list - @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = simpl_expression v in ok (k.value, v)) + @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = compile_expression v in ok (k.value, v)) @@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr)) @@ npseq_to_list r.ne_elements in return @@ e_record_ez ~loc fields - | EProj p -> simpl_projection p - | EUpdate u -> simpl_update u + | EProj p -> compile_projection p + | EUpdate u -> compile_update u | EConstr (ESomeApp a) -> let (_, args), loc = r_split a in - let%bind arg = simpl_expression args in + let%bind arg = compile_expression args in return @@ e_constant ~loc C_SOME [arg] | EConstr (ENone reg) -> let loc = Location.lift reg in @@ -502,18 +502,18 @@ let rec simpl_expression : match args with None -> [] | Some arg -> [arg] in - let%bind arg = simpl_tuple_expression @@ args + let%bind arg = compile_tuple_expression @@ args in return @@ e_constructor ~loc c_name arg | EArith (Add c) -> - simpl_binop "ADD" c + compile_binop "ADD" c | EArith (Sub c) -> - simpl_binop "SUB" c + compile_binop "SUB" c | EArith (Mult c) -> - simpl_binop "TIMES" c + compile_binop "TIMES" c | EArith (Div c) -> - simpl_binop "DIV" c + compile_binop "DIV" c | EArith (Mod c) -> - simpl_binop "MOD" c + compile_binop "MOD" c | EArith (Int n) -> ( let (n , loc) = r_split n in let n = Z.to_int @@ snd @@ n in @@ -529,7 +529,7 @@ let rec simpl_expression : let n = Z.to_int @@ snd @@ n in return @@ e_literal ~loc (Literal_mutez n) ) - | EArith (Neg e) -> simpl_unop "NEG" e + | EArith (Neg e) -> compile_unop "NEG" e | EString (String s) -> ( let (s , loc) = r_split s in let s' = @@ -540,24 +540,24 @@ let rec simpl_expression : ) | EString (Cat c) -> let (c, loc) = r_split c in - let%bind string_left = simpl_expression c.arg1 in - let%bind string_right = simpl_expression c.arg2 in + let%bind string_left = compile_expression c.arg1 in + let%bind string_right = compile_expression c.arg2 in return @@ e_string_cat ~loc string_left string_right - | ELogic l -> simpl_logic_expression l - | EList l -> simpl_list_expression l + | ELogic l -> compile_logic_expression l + | EList l -> compile_list_expression l | ECase c -> ( let (c , loc) = r_split c in - let%bind e = simpl_expression c.expr in + let%bind e = compile_expression c.expr in let%bind lst = let aux (x : Raw.expr Raw.case_clause) = - let%bind expr = simpl_expression x.rhs in + let%bind expr = compile_expression x.rhs in ok (x.pattern, expr) in bind_list @@ List.map aux @@ List.map get_value @@ npseq_to_list c.cases.value in let default_action () = - let%bind cases = simpl_cases lst in + let%bind cases = compile_cases lst in return @@ e_matching ~loc e cases in (* Hack to take care of patterns introduced by `parser/cameligo/Parser.mly` in "norm_fun_expr". TODO: Still needed? *) match lst with @@ -571,7 +571,7 @@ let rec simpl_expression : match x'.pattern with | Raw.PVar y -> let var_name = Var.of_name y.value in - let%bind type_expr = simpl_type_expression x'.type_expr in + let%bind type_expr = compile_type_expression x'.type_expr in return @@ e_let_in (var_name , Some type_expr) false false e rhs | _ -> default_action () ) @@ -581,29 +581,29 @@ let rec simpl_expression : ) | _ -> default_action () ) - | EFun lamb -> simpl_fun lamb + | EFun lamb -> compile_fun lamb | ESeq s -> ( let (s , loc) = r_split s in let items : Raw.expr list = pseq_to_list s.elements in (match items with [] -> return @@ e_skip ~loc () | expr::more -> - let expr' = simpl_expression expr in + let expr' = compile_expression expr in let apply (e1: Raw.expr) (e2: expression Trace.result) = - let%bind a = simpl_expression e1 in + let%bind a = compile_expression e1 in let%bind e2' = e2 in return @@ e_sequence a e2' in List.fold_right apply more expr') ) | ECond c -> ( let (c , loc) = r_split c in - let%bind expr = simpl_expression c.test in - let%bind match_true = simpl_expression c.ifso in - let%bind match_false = simpl_expression c.ifnot in + let%bind expr = compile_expression c.test in + let%bind match_true = compile_expression c.ifso in + let%bind match_false = compile_expression c.ifnot in return @@ e_matching ~loc expr (Match_bool {match_true; match_false}) ) -and simpl_fun lamb' : expr result = +and compile_fun lamb' : expr result = let return x = ok x in let (lamb , loc) = r_split lamb' in let%bind params' = @@ -649,7 +649,7 @@ and simpl_fun lamb' : expr result = | _ , None -> fail @@ untyped_fun_param var | _ , Some ty -> ( - let%bind ty' = simpl_type_expression ty in + let%bind ty' = compile_type_expression ty in ok (var , ty') ) in @@ -700,8 +700,8 @@ and simpl_fun lamb' : expr result = in let%bind (body , body_type) = expr_to_typed_expr body in let%bind output_type = - bind_map_option simpl_type_expression body_type in - let%bind body = simpl_expression body in + bind_map_option compile_type_expression body_type in + let%bind body = compile_expression body in let rec layer_arguments (arguments: (Raw.variable * type_expression) list) = match arguments with | hd :: tl -> @@ -714,7 +714,7 @@ and simpl_fun lamb' : expr result = return @@ ret_lamb -and simpl_logic_expression ?te_annot (t:Raw.logic_expr) : expr result = +and compile_logic_expression ?te_annot (t:Raw.logic_expr) : expr result = let return x = ok @@ make_option_typed x te_annot in match t with | BoolExpr (False reg) -> ( @@ -726,61 +726,61 @@ and simpl_logic_expression ?te_annot (t:Raw.logic_expr) : expr result = return @@ e_literal ~loc (Literal_bool true) ) | BoolExpr (Or b) -> - simpl_binop "OR" b + compile_binop "OR" b | BoolExpr (And b) -> - simpl_binop "AND" b + compile_binop "AND" b | BoolExpr (Not b) -> - simpl_unop "NOT" b + compile_unop "NOT" b | CompExpr (Lt c) -> - simpl_binop "LT" c + compile_binop "LT" c | CompExpr (Gt c) -> - simpl_binop "GT" c + compile_binop "GT" c | CompExpr (Leq c) -> - simpl_binop "LE" c + compile_binop "LE" c | CompExpr (Geq c) -> - simpl_binop "GE" c + compile_binop "GE" c | CompExpr (Equal c) -> - simpl_binop "EQ" c + compile_binop "EQ" c | CompExpr (Neq c) -> - simpl_binop "NEQ" c + compile_binop "NEQ" c -and simpl_list_expression (t:Raw.list_expr) : expression result = +and compile_list_expression (t:Raw.list_expr) : expression result = let return x = ok @@ x in match t with - ECons c -> simpl_binop "CONS" c + ECons c -> compile_binop "CONS" c | EListComp lst -> ( let (lst , loc) = r_split lst in let%bind lst' = - bind_map_list simpl_expression @@ + bind_map_list compile_expression @@ pseq_to_list lst.elements in return @@ e_list ~loc lst' ) -and simpl_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result = +and compile_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result = let return x = ok @@ x in let (args , loc) = r_split t in - let%bind a = simpl_expression args.arg1 in - let%bind b = simpl_expression args.arg2 in + let%bind a = compile_expression args.arg1 in + let%bind b = compile_expression args.arg2 in let%bind name = constants name in return @@ e_constant ~loc name [ a ; b ] -and simpl_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result = +and compile_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result = let return x = ok @@ x in let (t , loc) = r_split t in - let%bind a = simpl_expression t.arg in + let%bind a = compile_expression t.arg in let%bind name = constants name in return @@ e_constant ~loc name [ a ] -and simpl_tuple_expression ?loc (lst:Raw.expr list) : expression result = +and compile_tuple_expression ?loc (lst:Raw.expr list) : expression result = let return x = ok @@ x in match lst with | [] -> return @@ e_literal ?loc Literal_unit - | [hd] -> simpl_expression hd + | [hd] -> compile_expression hd | lst -> - let%bind lst = bind_list @@ List.map simpl_expression lst in + let%bind lst = bind_list @@ List.map compile_expression lst in return @@ e_tuple ?loc lst -and simpl_declaration : Raw.declaration -> declaration Location.wrap list result = +and compile_declaration : Raw.declaration -> declaration Location.wrap list result = fun t -> let open! Raw in let loc : 'a . 'a Raw.reg -> _ -> _ = @@ -788,7 +788,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result match t with | TypeDecl x -> let {name;type_expr} : Raw.type_decl = x.value in - let%bind type_expression = simpl_type_expression type_expr in + let%bind type_expression = compile_type_expression type_expr in ok @@ [loc x @@ Declaration_type (Var.of_name name.value , type_expression)] | Let x -> ( let (_, recursive, let_binding, attributes), _ = r_split x in @@ -798,17 +798,16 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result let (hd, _) = binders in match hd with | PTuple pt -> - let process_variable (var_pair: pattern * Raw.expr) : - Ast_simplified.declaration Location.wrap result = + let process_variable (var_pair: pattern * Raw.expr) = (let (par_var, rhs_expr) = var_pair in let%bind (v, v_type) = pattern_to_typed_var par_var in let%bind v_type_expression = match v_type with - | Some v_type -> ok (to_option (simpl_type_expression v_type)) + | Some v_type -> ok (to_option (compile_type_expression v_type)) | None -> ok None in - let%bind simpl_rhs_expr = simpl_expression rhs_expr in - ok @@ loc x @@ Declaration_constant (Var.of_name v.value, v_type_expression, inline, simpl_rhs_expr) ) + let%bind compile_rhs_expr = compile_expression rhs_expr in + ok @@ loc x @@ Declaration_constant (Var.of_name v.value, v_type_expression, inline, compile_rhs_expr) ) in let%bind variables = ok @@ npseq_to_list pt.value in let%bind expr_bind_lst = match let_rhs with @@ -840,7 +839,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result gen_access_tuple name ~i: (i + 1) ~accesses in ok (gen_access_tuple name) (* TODO: Improve this error message *) - | other -> fail @@ simplifying_expr other + | other -> fail @@ abstracting_expr other in let%bind decls = (* TODO: Rewrite the gen_access_tuple so there's no List.rev *) bind_map_list process_variable (List.combine variables (List.rev expr_bind_lst)) @@ -848,7 +847,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result | PPar {region = _ ; value = { lpar = _ ; inside = pt; rpar = _; } } -> (* Extract parenthetical multi-bind *) let (wild, recursive, _, attributes) = fst @@ r_split x in - simpl_declaration + compile_declaration (Let { region = x.region; value = (wild, recursive, {binders = (pt, []); @@ -863,7 +862,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result let%bind var = pattern_to_var hd in ok (var , tl) in - let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in + let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in let%bind let_rhs,lhs_type = match args with | [] -> ok (let_rhs, lhs_type') | param1::others -> @@ -879,12 +878,12 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result let aux acc ty = Option.map (t_function (snd ty)) acc in ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty) in - let%bind rhs' = simpl_expression let_rhs in + let%bind rhs' = compile_expression let_rhs in let%bind lhs_type = match lhs_type with | None -> (match let_rhs with | EFun {value={binders;lhs_type}} -> let f_args = nseq_to_list (binders) in - let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in + let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in let aux acc ty = Option.map (t_function (snd ty)) acc in ok @@ (List.fold_right' aux lhs_type' ty) @@ -907,7 +906,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))] ) -and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result = +and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result = fun t -> let open Raw in let rec get_var (t:Raw.pattern) = @@ -1027,6 +1026,6 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content | _ -> simple_fail "bad option pattern" in bind_or (as_option () , as_variant ()) -let simpl_program : Raw.ast -> program result = fun t -> - let%bind decls = bind_map_list simpl_declaration @@ nseq_to_list t.decl in +let compile_program : Raw.ast -> program result = fun t -> + let%bind decls = bind_map_list compile_declaration @@ nseq_to_list t.decl in ok @@ List.concat @@ decls diff --git a/src/passes/2-simplify/cameligo.mli b/src/passes/2-concrete_to_imperative/cameligo.mli similarity index 63% rename from src/passes/2-simplify/cameligo.mli rename to src/passes/2-concrete_to_imperative/cameligo.mli index a69583d73..f9e4b852a 100644 --- a/src/passes/2-simplify/cameligo.mli +++ b/src/passes/2-concrete_to_imperative/cameligo.mli @@ -1,8 +1,7 @@ [@@@warning "-45"] open Trace - -open Ast_simplified +open Ast_imperative module Raw = Parser.Cameligo.AST module SMap = Map.String @@ -29,7 +28,7 @@ module Errors : sig val unsupported_tuple_pattern : Raw.pattern -> unit -> error val unsupported_cst_constr : Raw.pattern -> unit -> error val unsupported_non_var_pattern : Raw.pattern -> unit -> error - val simplifying_expr : Raw.expr -> unit -> error + val abstracting_expr : Raw.expr -> unit -> error val only_constructors : Raw.pattern -> unit -> error val unsupported_sugared_lists : Raw.wild -> unit -> error val bad_set_definition : unit -> error @@ -46,18 +45,18 @@ val pattern_to_var : Raw.pattern -> Raw.variable result val pattern_to_typed_var : Raw.pattern -> ( Raw.variable * Raw.type_expr option ) result val expr_to_typed_expr : Raw.expr -> ( Raw.expr * Raw.type_expr option ) result val patterns_to_var : Raw.pattern list -> Raw.variable result -val simpl_type_expression : Raw.type_expr -> type_expression result -val simpl_list_type_expression : Raw.type_expr list -> type_expression result +val compile_type_expression : Raw.type_expr -> type_expression result +val compile_list_type_expression : Raw.type_expr list -> type_expression result *) -val simpl_expression : Raw.expr -> expr result +val compile_expression : Raw.expr -> expr result (* -val simpl_fun : Raw.fun_expr Raw.reg -> expr result -val simpl_logic_expression : ?te_annot:type_expression -> Raw.logic_expr -> expr result -val simpl_list_expression : Raw.list_expr -> expression result -val simpl_binop : string -> Raw.wild Raw.bin_op Region.reg -> expression result -val simpl_unop : string -> Raw.wild Raw.un_op Region.reg -> expression result -val simpl_tuple_expression : ?loc:Location.t -> Raw.expr list -> expression result -val simpl_declaration : Raw.declaration -> declaration Location.wrap result -val simpl_cases : (Raw.pattern * 'a) list -> 'a matching result +val compile_fun : Raw.fun_expr Raw.reg -> expr result +val compile_logic_expression : ?te_annot:type_expression -> Raw.logic_expr -> expr result +val compile_list_expression : Raw.list_expr -> expression result +val compile_binop : string -> Raw.wild Raw.bin_op Region.reg -> expression result +val compile_unop : string -> Raw.wild Raw.un_op Region.reg -> expression result +val compile_tuple_expression : ?loc:Location.t -> Raw.expr list -> expression result +val compile_declaration : Raw.declaration -> declaration Location.wrap result +val compile_cases : (Raw.pattern * 'a) list -> 'a matching result *) -val simpl_program : Raw.ast -> program result +val compile_program : Raw.ast -> program result diff --git a/src/passes/2-simplify/camligo.ml.old b/src/passes/2-concrete_to_imperative/camligo.ml.old similarity index 99% rename from src/passes/2-simplify/camligo.ml.old rename to src/passes/2-concrete_to_imperative/camligo.ml.old index 64c0ebd10..7789d796d 100644 --- a/src/passes/2-simplify/camligo.ml.old +++ b/src/passes/2-concrete_to_imperative/camligo.ml.old @@ -1,7 +1,7 @@ open Trace open Function module I = Parser.Cameligo.Ast -module O = Ast_simplified +module O = Ast_core open O.Combinators let unwrap : type a . a Location.wrap -> a = Location.unwrap @@ -252,7 +252,7 @@ and expression_main : I.expression_main Location.wrap -> O.expression result = f let%bind (a' , b') = bind_map_pair expression_main ab in return @@ e_binop name a' b' in let error_main = - let title () = "simplifying main_expression" in + let title () = "abstracting main_expression" in let content () = Format.asprintf "%a" I.pp_expression_main (unwrap em) in error title content in diff --git a/src/passes/2-simplify/simplify.ml b/src/passes/2-concrete_to_imperative/concrete_to_imperative.ml similarity index 100% rename from src/passes/2-simplify/simplify.ml rename to src/passes/2-concrete_to_imperative/concrete_to_imperative.ml diff --git a/src/passes/2-simplify/dune b/src/passes/2-concrete_to_imperative/dune similarity index 56% rename from src/passes/2-simplify/dune rename to src/passes/2-concrete_to_imperative/dune index 8e506cebc..c3f316ce4 100644 --- a/src/passes/2-simplify/dune +++ b/src/passes/2-concrete_to_imperative/dune @@ -1,14 +1,14 @@ (library - (name simplify) - (public_name ligo.simplify) + (name concrete_to_imperative) + (public_name ligo.concrete_to_imperative) (libraries simple-utils tezos-utils parser - ast_simplified - self_ast_simplified + ast_imperative + self_ast_imperative operators) - (modules cameligo pascaligo simplify) + (modules cameligo pascaligo concrete_to_imperative) (preprocess (pps ppx_let diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-concrete_to_imperative/pascaligo.ml similarity index 82% rename from src/passes/2-simplify/pascaligo.ml rename to src/passes/2-concrete_to_imperative/pascaligo.ml index a0c051f28..7823cfb4e 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-concrete_to_imperative/pascaligo.ml @@ -1,5 +1,5 @@ open Trace -open Ast_simplified +open Ast_imperative module Raw = Parser.Pascaligo.AST module SMap = Map.String @@ -15,7 +15,7 @@ let pseq_to_list = function let get_value : 'a Raw.reg -> 'a = fun x -> x.value and repair_mutable_variable_in_matching (for_body : expression) (element_names : expression_variable list) (env : expression_variable) = - let%bind captured_names = Self_ast_simplified.fold_map_expression + let%bind captured_names = Self_ast_imperative.fold_map_expression (* TODO : these should use Variables sets *) (fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) -> match ass_exp.expression_content with @@ -47,7 +47,7 @@ and repair_mutable_variable_in_matching (for_body : expression) (element_names : ok @@ captured_names and repair_mutable_variable_in_loops (for_body : expression) (element_names : expression_variable list) (env : expression_variable) = - let%bind captured_names = Self_ast_simplified.fold_map_expression + let%bind captured_names = Self_ast_imperative.fold_map_expression (* TODO : these should use Variables sets *) (fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) -> match ass_exp.expression_content with @@ -186,7 +186,7 @@ module Errors = struct (* Logging *) - let simplifying_instruction t = + let abstracting_instruction t = let title () = "\nSimplifiying instruction" in let message () = "" in (** TODO: The labelled arguments should be flowing from the CLI. *) @@ -199,14 +199,14 @@ module Errors = struct end open Errors -open Operators.Simplify.Pascaligo +open Operators.Concrete_to_imperative.Pascaligo let r_split = Location.r_split (* Statements can't be simplified in isolation. [a ; b ; c] can get simplified either as [let x = expr in (b ; c)] if [a] is a [const x = expr] declaration or as [sequence(a, sequence(b, c))] for - everything else. Because of this, simplifying sequences depend on + everything else. Because of this, abstracting sequences depend on their contents. To avoid peeking in their contents, we instead simplify sequences elements as functions from their next elements to the actual result. @@ -229,9 +229,9 @@ let return_statement expr = ok @@ fun expr'_opt -> | Some expr' -> ok @@ e_sequence expr expr' -let rec simpl_type_expression (t:Raw.type_expr) : type_expression result = +let rec compile_type_expression (t:Raw.type_expr) : type_expression result = match t with - TPar x -> simpl_type_expression x.value.inside + TPar x -> compile_type_expression x.value.inside | TVar v -> ( match type_constants v.value with | Ok (s,_) -> ok @@ make_t @@ T_constant s @@ -240,25 +240,25 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result = | TFun x -> ( let%bind (a , b) = let (a , _ , b) = x.value in - bind_map_pair simpl_type_expression (a , b) in + bind_map_pair compile_type_expression (a , b) in ok @@ make_t @@ T_arrow {type1=a;type2=b} ) | TApp x -> let (name, tuple) = x.value in let lst = npseq_to_list tuple.value.inside in let%bind lst = - bind_list @@ List.map simpl_type_expression lst in (** TODO: fix constant and operator*) + bind_list @@ List.map compile_type_expression lst in (** TODO: fix constant and operator*) let%bind cst = trace (unknown_predefined_type name) @@ type_operators name.value in t_operator cst lst | TProd p -> - let%bind tpl = simpl_list_type_expression + let%bind tpl = compile_list_type_expression @@ npseq_to_list p.value in ok tpl | TRecord r -> let aux = fun (x, y) -> - let%bind y = simpl_type_expression y in + let%bind y = compile_type_expression y in ok (x, y) in let apply = @@ -276,7 +276,7 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result = None -> [] | Some (_, TProd product) -> npseq_to_list product.value | Some (_, t_expr) -> [t_expr] in - let%bind te = simpl_list_type_expression @@ args in + let%bind te = compile_list_type_expression @@ args in ok (v.value.constr.value, te) in let%bind lst = bind_list @@ -285,15 +285,15 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result = let m = List.fold_left (fun m (x, y) -> CMap.add (Constructor x) y m) CMap.empty lst in ok @@ make_t @@ T_sum m -and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result = +and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result = match lst with | [] -> ok @@ t_unit - | [hd] -> simpl_type_expression hd + | [hd] -> compile_type_expression hd | lst -> - let%bind lst = bind_list @@ List.map simpl_type_expression lst in + let%bind lst = bind_list @@ List.map compile_type_expression lst in ok @@ t_tuple lst -let simpl_projection : Raw.projection Region.reg -> _ = fun p -> +let compile_projection : Raw.projection Region.reg -> _ = fun p -> let (p' , loc) = r_split p in let var = let name = Var.of_name p'.struct_name.value in @@ -309,13 +309,13 @@ let simpl_projection : Raw.projection Region.reg -> _ = fun p -> ok @@ List.fold_left (e_accessor ~loc) var path' -let rec simpl_expression (t:Raw.expr) : expr result = +let rec compile_expression (t:Raw.expr) : expr result = let return x = ok x in match t with | EAnnot a -> ( let ((expr , type_expr) , loc) = r_split a in - let%bind expr' = simpl_expression expr in - let%bind type_expr' = simpl_type_expression type_expr in + let%bind expr' = compile_expression expr in + let%bind type_expr' = compile_type_expression type_expr in return @@ e_annotation ~loc expr' type_expr' ) | EVar c -> ( @@ -333,19 +333,19 @@ let rec simpl_expression (t:Raw.expr) : expr result = let (f_name , f_loc) = r_split name in match constants f_name with | Error _ -> - let%bind arg = simpl_tuple_expression ~loc:args_loc args' in + let%bind arg = compile_tuple_expression ~loc:args_loc args' in return @@ e_application ~loc (e_variable ~loc:f_loc (Var.of_name f_name)) arg | Ok (s,_) -> - let%bind lst = bind_map_list simpl_expression args' in + let%bind lst = bind_map_list compile_expression args' in return @@ e_constant ~loc s lst ) | f -> ( - let%bind f' = simpl_expression f in - let%bind arg = simpl_tuple_expression ~loc:args_loc args' in + let%bind f' = compile_expression f in + let%bind arg = compile_tuple_expression ~loc:args_loc args' in return @@ e_application ~loc f' arg ) ) - | EPar x -> simpl_expression x.value.inside + | EPar x -> compile_expression x.value.inside | EUnit reg -> let loc = Location.lift reg in return @@ e_literal ~loc Literal_unit @@ -354,16 +354,16 @@ let rec simpl_expression (t:Raw.expr) : expr result = return @@ e_literal ~loc (Literal_bytes (Hex.to_bytes @@ snd x')) | ETuple tpl -> let (tpl' , loc) = r_split tpl in - simpl_tuple_expression ~loc @@ npseq_to_list tpl'.inside + compile_tuple_expression ~loc @@ npseq_to_list tpl'.inside | ERecord r -> let%bind fields = bind_list - @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = simpl_expression v in ok (k.value, v)) + @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = compile_expression v in ok (k.value, v)) @@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr)) @@ npseq_to_list r.value.ne_elements in let aux prev (k, v) = SMap.add k v prev in return @@ e_record (List.fold_left aux SMap.empty fields) - | EProj p -> simpl_projection p - | EUpdate u -> simpl_update u + | EProj p -> compile_projection p + | EUpdate u -> compile_update u | EConstr (ConstrApp c) -> ( let ((c, args) , loc) = r_split c in match args with @@ -372,7 +372,7 @@ let rec simpl_expression (t:Raw.expr) : expr result = | Some args -> let args, args_loc = r_split args in let%bind arg = - simpl_tuple_expression ~loc:args_loc + compile_tuple_expression ~loc:args_loc @@ npseq_to_list args.inside in return @@ e_constructor ~loc c.value arg ) @@ -380,7 +380,7 @@ let rec simpl_expression (t:Raw.expr) : expr result = let ((_, args) , loc) = r_split a in let (args , args_loc) = r_split args in let%bind arg = - simpl_tuple_expression ~loc:args_loc + compile_tuple_expression ~loc:args_loc @@ npseq_to_list args.inside in return @@ e_constant ~loc C_SOME [arg] | EConstr (NoneExpr reg) -> ( @@ -388,15 +388,15 @@ let rec simpl_expression (t:Raw.expr) : expr result = return @@ e_none ~loc () ) | EArith (Add c) -> - simpl_binop "ADD" c + compile_binop "ADD" c | EArith (Sub c) -> - simpl_binop "SUB" c + compile_binop "SUB" c | EArith (Mult c) -> - simpl_binop "TIMES" c + compile_binop "TIMES" c | EArith (Div c) -> - simpl_binop "DIV" c + compile_binop "DIV" c | EArith (Mod c) -> - simpl_binop "MOD" c + compile_binop "MOD" c | EArith (Int n) -> ( let (n , loc) = r_split n in let n = Z.to_int @@ snd n in @@ -412,7 +412,7 @@ let rec simpl_expression (t:Raw.expr) : expr result = let n = Z.to_int @@ snd @@ n in return @@ e_literal ~loc (Literal_mutez n) ) - | EArith (Neg e) -> simpl_unop "NEG" e + | EArith (Neg e) -> compile_unop "NEG" e | EString (String s) -> let (s , loc) = r_split s in let s' = @@ -422,17 +422,17 @@ let rec simpl_expression (t:Raw.expr) : expr result = return @@ e_literal ~loc (Literal_string s') | EString (Cat bo) -> let (bo , loc) = r_split bo in - let%bind sl = simpl_expression bo.arg1 in - let%bind sr = simpl_expression bo.arg2 in + let%bind sl = compile_expression bo.arg1 in + let%bind sr = compile_expression bo.arg2 in return @@ e_string_cat ~loc sl sr - | ELogic l -> simpl_logic_expression l - | EList l -> simpl_list_expression l - | ESet s -> simpl_set_expression s + | ELogic l -> compile_logic_expression l + | EList l -> compile_list_expression l + | ESet s -> compile_set_expression s | ECond c -> let (c , loc) = r_split c in - let%bind expr = simpl_expression c.test in - let%bind match_true = simpl_expression c.ifso in - let%bind match_false = simpl_expression c.ifnot in + let%bind expr = compile_expression c.test in + let%bind match_true = compile_expression c.ifso in + let%bind match_false = compile_expression c.ifnot in let match_expr = e_matching expr ~loc (Match_bool {match_true; match_false}) in let env = Var.fresh () in let%bind (_, match_expr) = repair_mutable_variable_in_matching match_expr [] env in @@ -440,16 +440,16 @@ let rec simpl_expression (t:Raw.expr) : expr result = | ECase c -> ( let (c , loc) = r_split c in - let%bind e = simpl_expression c.expr in + let%bind e = compile_expression c.expr in let%bind lst = let aux (x : Raw.expr Raw.case_clause) = - let%bind expr = simpl_expression x.rhs in + let%bind expr = compile_expression x.rhs in ok (x.pattern, expr) in bind_list @@ List.map aux @@ List.map get_value @@ npseq_to_list c.cases.value in - let%bind cases = simpl_cases lst in + let%bind cases = compile_cases lst in let match_expr = e_matching ~loc e cases in let env = Var.fresh () in let%bind (_, match_expr) = repair_mutable_variable_in_matching match_expr [] env in @@ -461,8 +461,8 @@ let rec simpl_expression (t:Raw.expr) : expr result = 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 + let%bind src = compile_expression b.source in + let%bind dst = compile_expression b.image in ok (src, dst) in bind_map_list aux lst in return @@ e_map ~loc lst @@ -473,8 +473,8 @@ let rec simpl_expression (t:Raw.expr) : expr result = 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 + let%bind src = compile_expression b.source in + let%bind dst = compile_expression b.image in ok (src, dst) in bind_map_list aux lst in return @@ e_big_map ~loc lst @@ -486,20 +486,20 @@ let rec simpl_expression (t:Raw.expr) : expr result = let (v , loc) = r_split v in return @@ e_variable ~loc (Var.of_name v) ) - | Path p -> simpl_projection p + | Path p -> compile_projection p in - let%bind index = simpl_expression lu.index.value.inside in + let%bind index = compile_expression lu.index.value.inside in return @@ e_look_up ~loc path index ) | EFun f -> let (f , loc) = r_split f in - let%bind (_ty_opt, f') = simpl_fun_expression ~loc f + let%bind (_ty_opt, f') = compile_fun_expression ~loc f in return @@ f' -and simpl_update = fun (u:Raw.update Region.reg) -> +and compile_update = fun (u:Raw.update Region.reg) -> let (u, loc) = r_split u in - let (name, path) = simpl_path u.record in + let (name, path) = compile_path u.record in let record = match path with | [] -> e_variable (Var.of_name name) | _ -> e_accessor_list (e_variable (Var.of_name name)) path in @@ -507,7 +507,7 @@ and simpl_update = fun (u:Raw.update Region.reg) -> let%bind updates' = let aux (f:Raw.field_path_assign Raw.reg) = let (f,_) = r_split f in - let%bind expr = simpl_expression f.field_expr in + let%bind expr = compile_expression f.field_expr in ok ( List.map (fun (x: _ Raw.reg) -> x.value) (npseq_to_list f.field_path), expr) in bind_map_list aux @@ npseq_to_list updates @@ -523,7 +523,7 @@ and simpl_update = fun (u:Raw.update Region.reg) -> aux ur path in bind_fold_list aux record updates' -and simpl_logic_expression (t:Raw.logic_expr) : expression result = +and compile_logic_expression (t:Raw.logic_expr) : expression result = let return x = ok x in match t with | BoolExpr (False reg) -> ( @@ -535,92 +535,92 @@ and simpl_logic_expression (t:Raw.logic_expr) : expression result = return @@ e_literal ~loc (Literal_bool true) ) | BoolExpr (Or b) -> - simpl_binop "OR" b + compile_binop "OR" b | BoolExpr (And b) -> - simpl_binop "AND" b + compile_binop "AND" b | BoolExpr (Not b) -> - simpl_unop "NOT" b + compile_unop "NOT" b | CompExpr (Lt c) -> - simpl_binop "LT" c + compile_binop "LT" c | CompExpr (Gt c) -> - simpl_binop "GT" c + compile_binop "GT" c | CompExpr (Leq c) -> - simpl_binop "LE" c + compile_binop "LE" c | CompExpr (Geq c) -> - simpl_binop "GE" c + compile_binop "GE" c | CompExpr (Equal c) -> - simpl_binop "EQ" c + compile_binop "EQ" c | CompExpr (Neq c) -> - simpl_binop "NEQ" c + compile_binop "NEQ" c -and simpl_list_expression (t:Raw.list_expr) : expression result = +and compile_list_expression (t:Raw.list_expr) : expression result = let return x = ok x in match t with ECons c -> - simpl_binop "CONS" c + compile_binop "CONS" c | EListComp lst -> let (lst , loc) = r_split lst in let%bind lst' = - bind_map_list simpl_expression @@ + bind_map_list compile_expression @@ pseq_to_list lst.elements in return @@ e_list ~loc lst' | ENil reg -> let loc = Location.lift reg in return @@ e_list ~loc [] -and simpl_set_expression (t:Raw.set_expr) : expression result = +and compile_set_expression (t:Raw.set_expr) : expression result = match t with | SetMem x -> ( let (x' , loc) = r_split x in - let%bind set' = simpl_expression x'.set in - let%bind element' = simpl_expression x'.element in + let%bind set' = compile_expression x'.set in + let%bind element' = compile_expression x'.element in ok @@ e_constant ~loc C_SET_MEM [ element' ; set' ] ) | SetInj x -> ( let (x' , loc) = r_split x in let elements = pseq_to_list x'.elements in - let%bind elements' = bind_map_list simpl_expression elements in + let%bind elements' = bind_map_list compile_expression elements in ok @@ e_set ~loc elements' ) -and simpl_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result = +and compile_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result = let return x = ok x in let (t , loc) = r_split t in - let%bind a = simpl_expression t.arg1 in - let%bind b = simpl_expression t.arg2 in + let%bind a = compile_expression t.arg1 in + let%bind b = compile_expression t.arg2 in let%bind name = constants name in return @@ e_constant ~loc name [ a ; b ] -and simpl_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result = +and compile_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result = let return x = ok x in let (t , loc) = r_split t in - let%bind a = simpl_expression t.arg in + let%bind a = compile_expression t.arg in let%bind name = constants name in return @@ e_constant ~loc name [ a ] -and simpl_tuple_expression ?loc (lst:Raw.expr list) : expression result = +and compile_tuple_expression ?loc (lst:Raw.expr list) : expression result = let return x = ok x in match lst with | [] -> return @@ e_literal Literal_unit - | [hd] -> simpl_expression hd + | [hd] -> compile_expression hd | lst -> - let%bind lst = bind_list @@ List.map simpl_expression lst + let%bind lst = bind_list @@ List.map compile_expression lst in return @@ e_tuple ?loc lst -and simpl_data_declaration : Raw.data_decl -> _ result = +and compile_data_declaration : Raw.data_decl -> _ result = fun t -> match t with | LocalVar x -> let (x , loc) = r_split x in let name = x.name.value in - let%bind t = simpl_type_expression x.var_type in - let%bind expression = simpl_expression x.init in + let%bind t = compile_type_expression x.var_type in + let%bind expression = compile_expression x.init in return_let_in ~loc (Var.of_name name, Some t) false false expression | LocalConst x -> let (x , loc) = r_split x in let name = x.name.value in - let%bind t = simpl_type_expression x.const_type in - let%bind expression = simpl_expression x.init in + let%bind t = compile_type_expression x.const_type in + let%bind expression = compile_expression x.init in let inline = match x.attributes with None -> false @@ -630,7 +630,7 @@ and simpl_data_declaration : Raw.data_decl -> _ result = in return_let_in ~loc (Var.of_name name, Some t) false inline expression | LocalFun f -> let (f , loc) = r_split f in - let%bind (binder, expr) = simpl_fun_decl ~loc f in + let%bind (binder, expr) = compile_fun_decl ~loc f in let inline = match f.attributes with None -> false @@ -639,22 +639,22 @@ and simpl_data_declaration : Raw.data_decl -> _ result = |> List.exists (fun Region.{value; _} -> value = "\"inline\"") in return_let_in ~loc binder false inline expr -and simpl_param : +and compile_param : Raw.param_decl -> (string * type_expression) result = fun t -> match t with | ParamConst c -> let c = c.value in let param_name = c.var.value in - let%bind type_expression = simpl_type_expression c.param_type in + let%bind type_expression = compile_type_expression c.param_type in ok (param_name , type_expression) | ParamVar v -> let c = v.value in let param_name = c.var.value in - let%bind type_expression = simpl_type_expression c.param_type in + let%bind type_expression = compile_type_expression c.param_type in ok (param_name , type_expression) -and simpl_fun_decl : +and compile_fun_decl : loc:_ -> Raw.fun_decl -> ((expression_variable * type_expression option) * expression) result = fun ~loc x -> @@ -674,11 +674,11 @@ and simpl_fun_decl : in (match param.value.inside with a, [] -> ( - let%bind input = simpl_param a in + let%bind input = compile_param a in let (binder , input_type) = input in - let%bind instructions = simpl_statement_list statements in - let%bind result = simpl_expression return in - let%bind output_type = simpl_type_expression ret_type in + let%bind instructions = compile_statement_list statements in + let%bind result = compile_expression return in + let%bind output_type = compile_type_expression ret_type in let body = instructions in let%bind result = let aux prec cur = cur (Some prec) in @@ -699,7 +699,7 @@ and simpl_fun_decl : let lst = npseq_to_list lst in (* TODO wrong, should be fresh? *) let arguments_name = Var.of_name "arguments" in - let%bind params = bind_map_list simpl_param lst in + let%bind params = bind_map_list compile_param lst in let (binder , input_type) = let type_expression = t_tuple (List.map snd params) in (arguments_name , type_expression) in @@ -712,9 +712,9 @@ and simpl_fun_decl : ass in bind_list @@ List.mapi aux params in - let%bind instructions = simpl_statement_list statements in - let%bind result = simpl_expression return in - let%bind output_type = simpl_type_expression ret_type in + let%bind instructions = compile_statement_list statements in + let%bind result = compile_expression return in + let%bind output_type = compile_type_expression ret_type in let body = tpl_declarations @ instructions in let%bind result = let aux prec cur = cur (Some prec) in @@ -732,7 +732,7 @@ and simpl_fun_decl : ) ) -and simpl_fun_expression : +and compile_fun_expression : loc:_ -> Raw.fun_expr -> (type_expression option * expression) result = fun ~loc x -> let open! Raw in @@ -740,11 +740,12 @@ and simpl_fun_expression : let statements = [] in (match param.value.inside with a, [] -> ( - let%bind input = simpl_param a in + let%bind input = compile_param a in let (binder , input_type) = input in - let%bind instructions = simpl_statement_list statements in - let%bind result = simpl_expression return in - let%bind output_type = simpl_type_expression ret_type in + let%bind instructions = compile_statement_list statements in + let%bind result = compile_expression return in + let%bind output_type = compile_type_expression ret_type in + let body = instructions in let%bind result = let aux prec cur = cur (Some prec) in @@ -762,7 +763,7 @@ and simpl_fun_expression : let lst = npseq_to_list lst in (* TODO wrong, should be fresh? *) let arguments_name = Var.of_name "arguments" in - let%bind params = bind_map_list simpl_param lst in + let%bind params = bind_map_list compile_param lst in let (binder , input_type) = let type_expression = t_tuple (List.map snd params) in (arguments_name , type_expression) in @@ -774,9 +775,9 @@ and simpl_fun_expression : ass in bind_list @@ List.mapi aux params in - let%bind instructions = simpl_statement_list statements in - let%bind result = simpl_expression return in - let%bind output_type = simpl_type_expression ret_type in + let%bind instructions = compile_statement_list statements in + let%bind result = compile_expression return in + let%bind output_type = compile_type_expression ret_type in let body = tpl_declarations @ instructions in let%bind result = let aux prec cur = cur (Some prec) in @@ -791,7 +792,7 @@ and simpl_fun_expression : ) ) -and simpl_statement_list statements = +and compile_statement_list statements = let open Raw in let rec hook acc = function [] -> acc @@ -813,9 +814,9 @@ and simpl_statement_list statements = (* Detached attributes are erased. TODO: Warning. *) hook acc statements | Instr i :: statements -> - hook (simpl_instruction i :: acc) statements + hook (compile_instruction i :: acc) statements | Data d :: statements -> - hook (simpl_data_declaration d :: acc) statements + hook (compile_data_declaration d :: acc) statements in bind_list @@ hook [] (List.rev statements) and get_case_variables (t:Raw.pattern) : expression_variable list result = @@ -847,7 +848,7 @@ and get_case_variables (t:Raw.pattern) : expression_variable list result = | PVar v -> ok @@ [Var.of_name v.value] | p -> fail @@ unsupported_cst_constr p -and simpl_single_instruction : Raw.instruction -> (_ -> expression result) result = +and compile_single_instruction : Raw.instruction -> (_ -> expression result) result = fun t -> match t with | ProcCall x -> ( @@ -859,15 +860,15 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let (f_name , f_loc) = r_split name in match constants f_name with | Error _ -> - let%bind arg = simpl_tuple_expression ~loc:args_loc args' in + let%bind arg = compile_tuple_expression ~loc:args_loc args' in return_statement @@ e_application ~loc (e_variable ~loc:f_loc (Var.of_name f_name)) arg | Ok (s,_) -> - let%bind lst = bind_map_list simpl_expression args' in + let%bind lst = bind_map_list compile_expression args' in return_statement @@ e_constant ~loc s lst ) | f -> ( - let%bind f' = simpl_expression f in - let%bind arg = simpl_tuple_expression ~loc:args_loc args' in + let%bind f' = compile_expression f in + let%bind arg = compile_tuple_expression ~loc:args_loc args' in return_statement @@ e_application ~loc f' arg ) ) @@ -876,35 +877,35 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul return_statement @@ e_skip ~loc () ) | Loop (While l) -> - simpl_while_loop l.value + compile_while_loop l.value | Loop (For (ForInt fi)) -> ( - let%bind loop = simpl_for_int fi.value in + let%bind loop = compile_for_int fi.value in ok loop ) | Loop (For (ForCollect fc)) -> - let%bind loop = simpl_for_collect fc.value in + let%bind loop = compile_for_collect fc.value in ok loop | Cond c -> ( let (c , loc) = r_split c in - let%bind expr = simpl_expression c.test in + let%bind expr = compile_expression c.test in let%bind match_true = match c.ifso with ClauseInstr i -> - simpl_single_instruction i + compile_single_instruction i | ClauseBlock b -> match b with LongBlock {value; _} -> - simpl_block value + compile_block value | ShortBlock {value; _} -> - simpl_statements @@ fst value.inside in + compile_statements @@ fst value.inside in let%bind match_false = match c.ifnot with ClauseInstr i -> - simpl_single_instruction i + compile_single_instruction i | ClauseBlock b -> match b with LongBlock {value; _} -> - simpl_block value + compile_block value | ShortBlock {value; _} -> - simpl_statements @@ fst value.inside in + compile_statements @@ fst value.inside in let env = Var.fresh () in let%bind match_true' = match_true None in @@ -928,10 +929,10 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul ) | Assign a -> ( let (a , loc) = r_split a in - let%bind value_expr = simpl_expression a.rhs in + let%bind value_expr = compile_expression a.rhs in match a.lhs with | Path path -> ( - let (name , path') = simpl_path path in + let (name , path') = compile_path path in let (let_binder, mut, rhs, inline) = e_assign_with_let ~loc name path' value_expr in return_let_in let_binder mut inline rhs ) @@ -940,11 +941,11 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let%bind (varname,map,path) = match v'.path with | Name name -> ok (name.value , e_variable (Var.of_name name.value), []) | Path p -> - let (name,p') = simpl_path v'.path in - let%bind accessor = simpl_projection p in + let (name,p') = compile_path v'.path in + let%bind accessor = compile_projection p in ok @@ (name , accessor , p') in - let%bind key_expr = simpl_expression v'.index.value.inside in + let%bind key_expr = compile_expression v'.index.value.inside in let expr' = e_map_add key_expr value_expr map in let (let_binder, mut, rhs, inline) = e_assign_with_let ~loc varname path expr' in return_let_in let_binder mut inline rhs @@ -952,20 +953,20 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul ) | CaseInstr c -> ( let (c , loc) = r_split c in - let%bind expr = simpl_expression c.expr in + let%bind expr = compile_expression c.expr in let env = Var.fresh () in let%bind (fv,cases) = let aux fv (x : Raw.if_clause Raw.case_clause Raw.reg) = let%bind case_clause = match x.value.rhs with ClauseInstr i -> - simpl_single_instruction i + compile_single_instruction i | ClauseBlock b -> match b with LongBlock {value; _} -> - simpl_block value + compile_block value | ShortBlock {value; _} -> - simpl_statements @@ fst value.inside in + compile_statements @@ fst value.inside in let%bind case_clause'= case_clause @@ None in let%bind case_clause = case_clause @@ Some(e_variable env) in let%bind case_vars = get_case_variables x.value.pattern in @@ -975,11 +976,11 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let free_vars = List.concat fv in if (List.length free_vars == 0) then ( let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in - let%bind m = simpl_cases cases in + let%bind m = compile_cases cases in return_statement @@ e_matching ~loc expr m ) else ( let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in - let%bind m = simpl_cases cases in + let%bind m = compile_cases cases in let match_expr = e_matching ~loc expr m in let return_expr = fun expr -> e_let_in (env,None) false false (store_mutable_variable free_vars) @@ @@ -1001,8 +1002,8 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul region=r.record_inj.region } in let u : Raw.update = {record=r.path;kwd_with=r.kwd_with; updates=update} in - let%bind expr = simpl_update {value=u;region=reg} in - let (name , access_path) = simpl_path r.path in + let%bind expr = compile_update {value=u;region=reg} in + let (name , access_path) = compile_path r.path in let loc = Some loc in let (binder, mut, rhs, inline) = e_assign_with_let ?loc name access_path expr in return_let_in binder mut inline rhs @@ -1010,13 +1011,13 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul ) | MapPatch patch -> ( let (map_p, loc) = r_split patch in - let (name, access_path) = simpl_path map_p.path in + let (name, access_path) = compile_path map_p.path in let%bind inj = bind_list @@ List.map (fun (x:Raw.binding Region.reg) -> let x = x.value in let (key, value) = x.source, x.image in - let%bind key' = simpl_expression key in - let%bind value' = simpl_expression value + let%bind key' = compile_expression key in + let%bind value' = compile_expression value in ok @@ (key', value') ) @@ npseq_to_list map_p.map_inj.value.ne_elements in @@ -1033,10 +1034,10 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul ) | SetPatch patch -> ( let (setp, loc) = r_split patch in - let (name , access_path) = simpl_path setp.path in + let (name , access_path) = compile_path setp.path in let%bind inj = bind_list @@ - List.map simpl_expression @@ + List.map compile_expression @@ npseq_to_list setp.set_inj.value.ne_elements in match inj with | [] -> return_statement @@ e_skip ~loc () @@ -1053,11 +1054,11 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let%bind (varname,map,path) = match v.map with | Name v -> ok (v.value , e_variable (Var.of_name v.value) , []) | Path p -> - let (name,p') = simpl_path v.map in - let%bind accessor = simpl_projection p in + let (name,p') = compile_path v.map in + let%bind accessor = compile_projection p in ok @@ (name , accessor , p') in - let%bind key' = simpl_expression key in + let%bind key' = compile_expression key in let expr = e_constant ~loc C_MAP_REMOVE [key' ; map] in let (binder, mut, rhs, inline) = e_assign_with_let ~loc varname path expr in return_let_in binder mut inline rhs @@ -1067,17 +1068,17 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let%bind (varname, set, path) = match set_rm.set with | Name v -> ok (v.value, e_variable (Var.of_name v.value), []) | Path path -> - let(name, p') = simpl_path set_rm.set in - let%bind accessor = simpl_projection path in + let(name, p') = compile_path set_rm.set in + let%bind accessor = compile_projection path in ok @@ (name, accessor, p') in - let%bind removed' = simpl_expression set_rm.element in + let%bind removed' = compile_expression set_rm.element in let expr = e_constant ~loc C_SET_REMOVE [removed' ; set] in let (binder, mut, rhs, inline) = e_assign_with_let ~loc varname path expr in return_let_in binder mut inline rhs ) -and simpl_path : Raw.path -> string * string list = fun p -> +and compile_path : Raw.path -> string * string list = fun p -> match p with | Raw.Name v -> (v.value , []) | Raw.Path p -> ( @@ -1094,7 +1095,7 @@ and simpl_path : Raw.path -> string * string list = fun p -> (var , path') ) -and simpl_cases : (Raw.pattern * expression) list -> matching_expr result = fun t -> +and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fun t -> let open Raw in let get_var (t:Raw.pattern) = match t with @@ -1185,13 +1186,13 @@ and simpl_cases : (Raw.pattern * expression) list -> matching_expr result = fun bind_map_list aux lst in ok @@ ez_match_variant constrs -and simpl_instruction : Raw.instruction -> (_ -> expression result) result = - fun t -> trace (simplifying_instruction t) @@ simpl_single_instruction t +and compile_instruction : Raw.instruction -> (_ -> expression result) result = + fun t -> trace (abstracting_instruction t) @@ compile_single_instruction t -and simpl_statements : Raw.statements -> (_ -> expression result) result = +and compile_statements : Raw.statements -> (_ -> expression result) result = fun statements -> let lst = npseq_to_list statements in - let%bind fs = simpl_statement_list lst in + let%bind fs = compile_statement_list lst in let aux : _ -> (expression option -> expression result) -> _ = fun prec cur -> let%bind res = cur prec @@ -1200,19 +1201,19 @@ and simpl_statements : Raw.statements -> (_ -> expression result) result = let%bind ret = bind_fold_right_list aux expr' fs in ok @@ Option.unopt_exn ret -and simpl_block : Raw.block -> (_ -> expression result) result = - fun t -> simpl_statements t.statements +and compile_block : Raw.block -> (_ -> expression result) result = + fun t -> compile_statements t.statements -and simpl_while_loop : Raw.while_loop -> (_ -> expression result) result = fun wl -> +and compile_while_loop : Raw.while_loop -> (_ -> expression result) result = fun wl -> let env_rec = Var.fresh () in let binder = Var.fresh () in - let%bind cond = simpl_expression wl.cond in + let%bind cond = compile_expression wl.cond in let ctrl = (e_variable binder) in - let%bind for_body = simpl_block wl.block.value in + let%bind for_body = compile_block wl.block.value in let%bind for_body = for_body @@ Some( ctrl ) in let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [] binder in @@ -1237,15 +1238,15 @@ and simpl_while_loop : Raw.while_loop -> (_ -> expression result) result = fun w restore_mutable_variable return_expr captured_name_list env_rec -and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> +and compile_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> let env_rec = Var.fresh () in let binder = Var.fresh () in let name = fi.assign.value.name.value in let it = Var.of_name name in let var = e_variable it in (*Make the cond and the step *) - let%bind value = simpl_expression fi.assign.value.expr in - let%bind bound = simpl_expression fi.bound in + let%bind value = compile_expression fi.assign.value.expr in + let%bind bound = compile_expression fi.bound in let cond = e_annotation (e_constant C_LE [var ; bound]) t_bool in let step = e_int 1 in let continue_expr = e_constant C_FOLD_CONTINUE [(e_variable binder)] in @@ -1255,7 +1256,7 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> continue_expr in (* Modify the body loop*) - let%bind for_body = simpl_block fi.block.value in + let%bind for_body = compile_block fi.block.value in let%bind for_body = for_body @@ Some ctrl in let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [it] binder in @@ -1285,19 +1286,19 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> in restore_mutable_variable return_expr captured_name_list env_rec -and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> +and compile_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> let binder = Var.of_name "arguments" in let%bind element_names = ok @@ match fc.bind_to with | Some v -> [Var.of_name fc.var.value;Var.of_name (snd v).value] | None -> [Var.of_name fc.var.value] in let env = Var.fresh () in - let%bind for_body = simpl_block fc.block.value in + let%bind for_body = compile_block fc.block.value in let%bind for_body = for_body @@ Some (e_accessor (e_variable binder) "0") in let%bind ((_,free_vars), for_body) = repair_mutable_variable_in_loops for_body element_names binder in let init_record = store_mutable_variable free_vars in - let%bind collect = simpl_expression fc.expr in + let%bind collect = compile_expression fc.expr in let aux name expr= e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr in @@ -1319,8 +1320,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun in restore_mutable_variable fold free_vars env -and simpl_declaration_list declarations : - Ast_simplified.declaration Location.wrap list result = +and compile_declaration_list declarations : declaration Location.wrap list result = let open Raw in let rec hook acc = function [] -> acc @@ -1344,16 +1344,16 @@ and simpl_declaration_list declarations : | TypeDecl decl :: declarations -> let decl, loc = r_split decl in let {name; type_expr} : Raw.type_decl = decl in - let%bind type_expression = simpl_type_expression type_expr in + let%bind type_expression = compile_type_expression type_expr in let new_decl = Declaration_type (Var.of_name name.value, type_expression) in let res = Location.wrap ~loc new_decl in hook (bind_list_cons res acc) declarations | ConstDecl decl :: declarations -> - let simpl_const_decl = + let compile_const_decl = fun {name;const_type; init; attributes} -> - let%bind expression = simpl_expression init in - let%bind t = simpl_type_expression const_type in + let%bind expression = compile_expression init in + let%bind t = compile_type_expression const_type in let type_annotation = Some t in let inline = match attributes with @@ -1366,11 +1366,11 @@ and simpl_declaration_list declarations : (Var.of_name name.value, type_annotation, inline, expression) in ok new_decl in let%bind res = - bind_map_location simpl_const_decl (Location.lift_region decl) + bind_map_location compile_const_decl (Location.lift_region decl) in hook (bind_list_cons res acc) declarations | FunDecl fun_decl :: declarations -> let decl, loc = r_split fun_decl in - let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in + let%bind ((name, ty_opt), expr) = compile_fun_decl ~loc decl in let inline = match fun_decl.value.attributes with None -> false @@ -1383,5 +1383,5 @@ and simpl_declaration_list declarations : hook (bind_list_cons res acc) declarations in hook (ok @@ []) (List.rev declarations) -let simpl_program : Raw.ast -> program result = - fun t -> simpl_declaration_list @@ nseq_to_list t.decl +let compile_program : Raw.ast -> program result = + fun t -> compile_declaration_list @@ nseq_to_list t.decl diff --git a/src/passes/2-concrete_to_imperative/pascaligo.mli b/src/passes/2-concrete_to_imperative/pascaligo.mli new file mode 100644 index 000000000..cfa945fb9 --- /dev/null +++ b/src/passes/2-concrete_to_imperative/pascaligo.mli @@ -0,0 +1,15 @@ +(** Converts PascaLIGO programs to the Simplified Abstract Syntax Tree. *) + +open Trace +open Ast_imperative + +module Raw = Parser.Pascaligo.AST +module SMap = Map.String + +(** Convert a concrete PascaLIGO expression AST to the imperative + expression AST used by the compiler. *) +val compile_expression : Raw.expr -> expr result + +(** Convert a concrete PascaLIGO program AST to the miperative program + AST used by the compiler. *) +val compile_program : Raw.ast -> program result diff --git a/src/passes/2-simplify/pascaligo.mli b/src/passes/2-simplify/pascaligo.mli deleted file mode 100644 index 42e5e4afe..000000000 --- a/src/passes/2-simplify/pascaligo.mli +++ /dev/null @@ -1,15 +0,0 @@ -(** Converts PascaLIGO programs to the Simplified Abstract Syntax Tree. *) - -open Trace -open Ast_simplified - -module Raw = Parser.Pascaligo.AST -module SMap = Map.String - -(** Convert a concrete PascaLIGO expression AST to the simplified - expression AST used by the compiler. *) -val simpl_expression : Raw.expr -> expr result - -(** Convert a concrete PascaLIGO program AST to the simplified program - AST used by the compiler. *) -val simpl_program : Raw.ast -> program result diff --git a/src/passes/3-self_ast_simplified/dune b/src/passes/3-self_ast_imperative/dune similarity index 69% rename from src/passes/3-self_ast_simplified/dune rename to src/passes/3-self_ast_imperative/dune index aef575249..2b1e5f8b5 100644 --- a/src/passes/3-self_ast_simplified/dune +++ b/src/passes/3-self_ast_imperative/dune @@ -1,9 +1,9 @@ (library - (name self_ast_simplified) - (public_name ligo.self_ast_simplified) + (name self_ast_imperative) + (public_name ligo.self_ast_imperative) (libraries simple-utils - ast_simplified + ast_imperative proto-alpha-utils ) (preprocess diff --git a/src/passes/3-self_ast_simplified/entrypoints_lenght_limit.ml b/src/passes/3-self_ast_imperative/entrypoints_length_limit.ml similarity index 97% rename from src/passes/3-self_ast_simplified/entrypoints_lenght_limit.ml rename to src/passes/3-self_ast_imperative/entrypoints_length_limit.ml index a64007b4a..f2d5fc202 100644 --- a/src/passes/3-self_ast_simplified/entrypoints_lenght_limit.ml +++ b/src/passes/3-self_ast_imperative/entrypoints_length_limit.ml @@ -1,4 +1,4 @@ -open Ast_simplified +open Ast_imperative open Trace open Stage_common.Helpers diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_imperative/helpers.ml similarity index 93% rename from src/passes/3-self_ast_simplified/helpers.ml rename to src/passes/3-self_ast_imperative/helpers.ml index 101f8d9ab..fc15f29e1 100644 --- a/src/passes/3-self_ast_simplified/helpers.ml +++ b/src/passes/3-self_ast_imperative/helpers.ml @@ -1,4 +1,4 @@ -open Ast_simplified +open Ast_imperative open Trace open Stage_common.Helpers @@ -19,8 +19,8 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini | E_look_up ab -> let%bind res = bind_fold_pair self init' ab in ok res - | E_application {expr1;expr2} -> ( - let ab = (expr1,expr2) in + | E_application {lamb;args} -> ( + let ab = (lamb,args) in let%bind res = bind_fold_pair self init' ab in ok res ) @@ -59,6 +59,11 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini | E_recursive { lambda={result=e;_}; _} -> let%bind res = self init' e in ok res + | E_sequence {expr1;expr2} -> + let ab = (expr1,expr2) in + let%bind res = bind_fold_pair self init' ab in + ok res + and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m -> match m with @@ -145,10 +150,10 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e let%bind e' = self c.element in return @@ E_constructor {c with element = e'} ) - | E_application {expr1;expr2} -> ( - let ab = (expr1,expr2) in - let%bind (a,b) = bind_map_pair self ab in - return @@ E_application {expr1=a;expr2=b} + | E_application {lamb;args} -> ( + let ab = (lamb,args) in + let%bind (lamb,args) = bind_map_pair self ab in + return @@ E_application {lamb;args} ) | E_let_in { let_binder ; mut; rhs ; let_result; inline } -> ( let%bind rhs = self rhs in @@ -167,6 +172,10 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e let%bind args = bind_map_list self c.arguments in return @@ E_constant {c with arguments=args} ) + | E_sequence {expr1;expr2} -> ( + let%bind (expr1,expr2) = bind_map_pair self (expr1,expr2) in + return @@ E_sequence {expr1;expr2} + ) | E_literal _ | E_variable _ | E_skip as e' -> return e' and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te -> @@ -288,10 +297,10 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres let%bind (res,e') = self init' c.element in ok (res, return @@ E_constructor {c with element = e'}) ) - | E_application {expr1;expr2} -> ( - let ab = (expr1,expr2) in + | E_application {lamb;args} -> ( + let ab = (lamb,args) in let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in - ok (res, return @@ E_application {expr1=a;expr2=b}) + ok (res, return @@ E_application {lamb=a;args=b}) ) | E_let_in { let_binder ; mut; rhs ; let_result; inline } -> ( let%bind (res,rhs) = self init' rhs in @@ -310,6 +319,10 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres let%bind (res,args) = bind_fold_map_list self init' c.arguments in ok (res, return @@ E_constant {c with arguments=args}) ) + | E_sequence {expr1;expr2} -> ( + let%bind (res,(expr1,expr2)) = bind_fold_map_pair self init' (expr1,expr2) in + ok (res, return @@ E_sequence {expr1;expr2}) + ) | E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e') and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m -> diff --git a/src/passes/3-self_ast_simplified/literals.ml b/src/passes/3-self_ast_imperative/literals.ml similarity index 98% rename from src/passes/3-self_ast_simplified/literals.ml rename to src/passes/3-self_ast_imperative/literals.ml index 367e9787f..96914359a 100644 --- a/src/passes/3-self_ast_simplified/literals.ml +++ b/src/passes/3-self_ast_imperative/literals.ml @@ -1,4 +1,4 @@ -open Ast_simplified +open Ast_imperative open Trace open Proto_alpha_utils @@ -6,7 +6,7 @@ module Errors = struct let bad_format e () = let title = (thunk ("Badly formatted literal")) in - let message () = Format.asprintf "%a" Ast_simplified.PP.expression e in + let message () = Format.asprintf "%a" PP.expression e in let data = [ ("location" , fun () -> Format.asprintf "%a" Location.pp e.location) ] in diff --git a/src/passes/3-self_ast_simplified/none_variant.ml b/src/passes/3-self_ast_imperative/none_variant.ml similarity index 95% rename from src/passes/3-self_ast_simplified/none_variant.ml rename to src/passes/3-self_ast_imperative/none_variant.ml index 416142f0f..894d55830 100644 --- a/src/passes/3-self_ast_simplified/none_variant.ml +++ b/src/passes/3-self_ast_imperative/none_variant.ml @@ -1,4 +1,4 @@ -open Ast_simplified +open Ast_imperative open Trace let peephole_expression : expression -> expression result = fun e -> diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_imperative/self_ast_imperative.ml similarity index 93% rename from src/passes/3-self_ast_simplified/self_ast_simplified.ml rename to src/passes/3-self_ast_imperative/self_ast_imperative.ml index a10968c0c..b0270ebd0 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_imperative/self_ast_imperative.ml @@ -6,7 +6,7 @@ let all_expression_mapper = [ Literals.peephole_expression ; ] let all_type_expression_mapper = [ - Entrypoints_lenght_limit.peephole_type_expression ; + Entrypoints_length_limit.peephole_type_expression ; ] let all_exp = List.map (fun el -> Helpers.Expression el) all_expression_mapper diff --git a/src/passes/3-self_ast_simplified/tezos_type_annotation.ml b/src/passes/3-self_ast_imperative/tezos_type_annotation.ml similarity index 98% rename from src/passes/3-self_ast_simplified/tezos_type_annotation.ml rename to src/passes/3-self_ast_imperative/tezos_type_annotation.ml index cc6557ae2..19118f125 100644 --- a/src/passes/3-self_ast_simplified/tezos_type_annotation.ml +++ b/src/passes/3-self_ast_imperative/tezos_type_annotation.ml @@ -1,4 +1,4 @@ -open Ast_simplified +open Ast_imperative open Trace module Errors = struct diff --git a/src/passes/4-imperative_to_sugar/dune b/src/passes/4-imperative_to_sugar/dune new file mode 100644 index 000000000..445998b90 --- /dev/null +++ b/src/passes/4-imperative_to_sugar/dune @@ -0,0 +1,14 @@ +(library + (name imperative_to_sugar) + (public_name ligo.imperative_to_sugar) + (libraries + simple-utils + ast_imperative + ast_sugar + proto-alpha-utils + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils )) +) diff --git a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml new file mode 100644 index 000000000..9cdfed78e --- /dev/null +++ b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml @@ -0,0 +1,363 @@ +module I = Ast_imperative +module O = Ast_sugar +open Trace + +let rec compile_type_expression : I.type_expression -> O.type_expression result = + fun te -> + let return te = ok @@ O.make_t te in + match te.type_content with + | I.T_sum sum -> + let sum = I.CMap.to_kv_list sum in + let%bind sum = + bind_map_list (fun (k,v) -> + let%bind v = compile_type_expression v in + ok @@ (k,v) + ) sum + in + return @@ O.T_sum (O.CMap.of_list sum) + | I.T_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = compile_type_expression v in + ok @@ (k,v) + ) record + in + return @@ O.T_record (O.LMap.of_list record) + | I.T_arrow {type1;type2} -> + let%bind type1 = compile_type_expression type1 in + let%bind type2 = compile_type_expression type2 in + return @@ T_arrow {type1;type2} + | I.T_variable type_variable -> return @@ T_variable type_variable + | I.T_constant type_constant -> return @@ T_constant type_constant + | I.T_operator type_operator -> + let%bind type_operator = compile_type_operator type_operator in + return @@ T_operator type_operator + +and compile_type_operator : I.type_operator -> O.type_operator result = + fun t_o -> + match t_o with + | TC_contract c -> + let%bind c = compile_type_expression c in + ok @@ O.TC_contract c + | TC_option o -> + let%bind o = compile_type_expression o in + ok @@ O.TC_option o + | TC_list l -> + let%bind l = compile_type_expression l in + ok @@ O.TC_list l + | TC_set s -> + let%bind s = compile_type_expression s in + ok @@ O.TC_set s + | TC_map (k,v) -> + let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in + ok @@ O.TC_map (k,v) + | TC_big_map (k,v) -> + let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in + ok @@ O.TC_big_map (k,v) + | TC_arrow (i,o) -> + let%bind (i,o) = bind_map_pair compile_type_expression (i,o) in + ok @@ O.TC_arrow (i,o) + +let rec compile_expression : I.expression -> O.expression result = + fun e -> + let return expr = ok @@ O.make_expr ~loc:e.location expr in + match e.expression_content with + | I.E_literal literal -> return @@ O.E_literal literal + | I.E_constant {cons_name;arguments} -> + let%bind arguments = bind_map_list compile_expression arguments in + return @@ O.E_constant {cons_name;arguments} + | I.E_variable name -> return @@ O.E_variable name + | I.E_application {lamb;args} -> + let%bind lamb = compile_expression lamb in + let%bind args = compile_expression args in + return @@ O.E_application {lamb;args} + | I.E_lambda lambda -> + let%bind lambda = compile_lambda lambda in + return @@ O.E_lambda lambda + | I.E_recursive {fun_name;fun_type;lambda} -> + let%bind fun_type = compile_type_expression fun_type in + let%bind lambda = compile_lambda lambda in + return @@ O.E_recursive {fun_name;fun_type;lambda} + | I.E_let_in {let_binder;mut=_;inline;rhs;let_result} -> + let (binder,ty_opt) = let_binder in + let%bind ty_opt = bind_map_option compile_type_expression ty_opt in + let%bind rhs = compile_expression rhs in + let%bind let_result = compile_expression let_result in + return @@ O.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result} + | I.E_constructor {constructor;element} -> + let%bind element = compile_expression element in + return @@ O.E_constructor {constructor;element} + | I.E_matching {matchee; cases} -> + let%bind matchee = compile_expression matchee in + let%bind cases = compile_matching cases in + return @@ O.E_matching {matchee;cases} + | I.E_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v =compile_expression v in + ok @@ (k,v) + ) record + in + return @@ O.E_record (O.LMap.of_list record) + | I.E_record_accessor {expr;label} -> + let%bind expr = compile_expression expr in + return @@ O.E_record_accessor {expr;label} + | I.E_record_update {record;path;update} -> + let%bind record = compile_expression record in + let%bind update = compile_expression update in + return @@ O.E_record_update {record;path;update} + | I.E_map map -> + let%bind map = bind_map_list ( + bind_map_pair compile_expression + ) map + in + return @@ O.E_map map + | I.E_big_map big_map -> + let%bind big_map = bind_map_list ( + bind_map_pair compile_expression + ) big_map + in + return @@ O.E_big_map big_map + | I.E_list lst -> + let%bind lst = bind_map_list compile_expression lst in + return @@ O.E_list lst + | I.E_set set -> + let%bind set = bind_map_list compile_expression set in + return @@ O.E_set set + | I.E_look_up look_up -> + let%bind look_up = bind_map_pair compile_expression look_up in + return @@ O.E_look_up look_up + | I.E_ascription {anno_expr; type_annotation} -> + let%bind anno_expr = compile_expression anno_expr in + let%bind type_annotation = compile_type_expression type_annotation in + return @@ O.E_ascription {anno_expr; type_annotation} + | I.E_sequence {expr1; expr2} -> + let%bind expr1 = compile_expression expr1 in + let%bind expr2 = compile_expression expr2 in + return @@ O.E_sequence {expr1; expr2} + | I.E_skip -> return @@ O.E_skip +and compile_lambda : I.lambda -> O.lambda result = + fun {binder;input_type;output_type;result}-> + let%bind input_type = bind_map_option compile_type_expression input_type in + let%bind output_type = bind_map_option compile_type_expression output_type in + let%bind result = compile_expression result in + ok @@ O.{binder;input_type;output_type;result} +and compile_matching : I.matching_expr -> O.matching_expr result = + fun m -> + match m with + | I.Match_bool {match_true;match_false} -> + let%bind match_true = compile_expression match_true in + let%bind match_false = compile_expression match_false in + ok @@ O.Match_bool {match_true;match_false} + | I.Match_list {match_nil;match_cons} -> + let%bind match_nil = compile_expression match_nil in + let (hd,tl,expr,tv) = match_cons in + let%bind expr = compile_expression expr in + ok @@ O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)} + | I.Match_option {match_none;match_some} -> + let%bind match_none = compile_expression match_none in + let (n,expr,tv) = match_some in + let%bind expr = compile_expression expr in + ok @@ O.Match_option {match_none; match_some=(n,expr,tv)} + | I.Match_tuple ((lst,expr), tv) -> + let%bind expr = compile_expression expr in + ok @@ O.Match_tuple ((lst,expr), tv) + | I.Match_variant (lst,tv) -> + let%bind lst = bind_map_list ( + fun ((c,n),expr) -> + let%bind expr = compile_expression expr in + ok @@ ((c,n),expr) + ) lst + in + ok @@ O.Match_variant (lst,tv) + +let compile_declaration : I.declaration Location.wrap -> _ = + fun {wrap_content=declaration;location} -> + let return decl = ok @@ Location.wrap ~loc:location decl in + match declaration with + | I.Declaration_constant (n, te_opt, inline, expr) -> + let%bind expr = compile_expression expr in + let%bind te_opt = bind_map_option compile_type_expression te_opt in + return @@ O.Declaration_constant (n, te_opt, inline, expr) + | I.Declaration_type (n, te) -> + let%bind te = compile_type_expression te in + return @@ O.Declaration_type (n,te) + +let compile_program : I.program -> O.program result = + fun p -> + bind_map_list compile_declaration p + +(* uncompiling *) +let rec uncompile_type_expression : O.type_expression -> I.type_expression result = + fun te -> + let return te = ok @@ I.make_t te in + match te.type_content with + | O.T_sum sum -> + let sum = I.CMap.to_kv_list sum in + let%bind sum = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_type_expression v in + ok @@ (k,v) + ) sum + in + return @@ I.T_sum (O.CMap.of_list sum) + | O.T_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_type_expression v in + ok @@ (k,v) + ) record + in + return @@ I.T_record (O.LMap.of_list record) + | O.T_arrow {type1;type2} -> + let%bind type1 = uncompile_type_expression type1 in + let%bind type2 = uncompile_type_expression type2 in + return @@ T_arrow {type1;type2} + | O.T_variable type_variable -> return @@ T_variable type_variable + | O.T_constant type_constant -> return @@ T_constant type_constant + | O.T_operator type_operator -> + let%bind type_operator = uncompile_type_operator type_operator in + return @@ T_operator type_operator + +and uncompile_type_operator : O.type_operator -> I.type_operator result = + fun t_o -> + match t_o with + | TC_contract c -> + let%bind c = uncompile_type_expression c in + ok @@ I.TC_contract c + | TC_option o -> + let%bind o = uncompile_type_expression o in + ok @@ I.TC_option o + | TC_list l -> + let%bind l = uncompile_type_expression l in + ok @@ I.TC_list l + | TC_set s -> + let%bind s = uncompile_type_expression s in + ok @@ I.TC_set s + | TC_map (k,v) -> + let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in + ok @@ I.TC_map (k,v) + | TC_big_map (k,v) -> + let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in + ok @@ I.TC_big_map (k,v) + | TC_arrow (i,o) -> + let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in + ok @@ I.TC_arrow (i,o) + +let rec uncompile_expression : O.expression -> I.expression result = + fun e -> + let return expr = ok @@ I.make_expr ~loc:e.location expr in + match e.expression_content with + O.E_literal lit -> return @@ I.E_literal lit + | O.E_constant {cons_name;arguments} -> + let%bind arguments = bind_map_list uncompile_expression arguments in + return @@ I.E_constant {cons_name;arguments} + | O.E_variable name -> return @@ I.E_variable name + | O.E_application {lamb; args} -> + let%bind lamb = uncompile_expression lamb in + let%bind args = uncompile_expression args in + return @@ I.E_application {lamb; args} + | O.E_lambda lambda -> + let%bind lambda = uncompile_lambda lambda in + return @@ I.E_lambda lambda + | O.E_recursive {fun_name;fun_type;lambda} -> + let%bind fun_type = uncompile_type_expression fun_type in + let%bind lambda = uncompile_lambda lambda in + return @@ I.E_recursive {fun_name;fun_type;lambda} + | O.E_let_in {let_binder;inline;rhs;let_result} -> + let (binder,ty_opt) = let_binder in + let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in + let%bind rhs = uncompile_expression rhs in + let%bind let_result = uncompile_expression let_result in + return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result} + | O.E_constructor {constructor;element} -> + let%bind element = uncompile_expression element in + return @@ I.E_constructor {constructor;element} + | O.E_matching {matchee; cases} -> + let%bind matchee = uncompile_expression matchee in + let%bind cases = uncompile_matching cases in + return @@ I.E_matching {matchee;cases} + | O.E_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_expression v in + ok @@ (k,v) + ) record + in + return @@ I.E_record (O.LMap.of_list record) + | O.E_record_accessor {expr;label} -> + let%bind expr = uncompile_expression expr in + return @@ I.E_record_accessor {expr;label} + | O.E_record_update {record;path;update} -> + let%bind record = uncompile_expression record in + let%bind update = uncompile_expression update in + return @@ I.E_record_update {record;path;update} + | O.E_map map -> + let%bind map = bind_map_list ( + bind_map_pair uncompile_expression + ) map + in + return @@ I.E_map map + | O.E_big_map big_map -> + let%bind big_map = bind_map_list ( + bind_map_pair uncompile_expression + ) big_map + in + return @@ I.E_big_map big_map + | O.E_list lst -> + let%bind lst = bind_map_list uncompile_expression lst in + return @@ I.E_list lst + | O.E_set set -> + let%bind set = bind_map_list uncompile_expression set in + return @@ I.E_set set + | O.E_look_up look_up -> + let%bind look_up = bind_map_pair uncompile_expression look_up in + return @@ I.E_look_up look_up + | O.E_ascription {anno_expr; type_annotation} -> + let%bind anno_expr = uncompile_expression anno_expr in + let%bind type_annotation = uncompile_type_expression type_annotation in + return @@ I.E_ascription {anno_expr; type_annotation} + | O.E_sequence {expr1; expr2} -> + let%bind expr1 = uncompile_expression expr1 in + let%bind expr2 = uncompile_expression expr2 in + return @@ I.E_sequence {expr1; expr2} + | O.E_skip -> return @@ I.E_skip + +and uncompile_lambda : O.lambda -> I.lambda result = + fun {binder;input_type;output_type;result}-> + let%bind input_type = bind_map_option uncompile_type_expression input_type in + let%bind output_type = bind_map_option uncompile_type_expression output_type in + let%bind result = uncompile_expression result in + ok @@ I.{binder;input_type;output_type;result} +and uncompile_matching : O.matching_expr -> I.matching_expr result = + fun m -> + match m with + | O.Match_bool {match_true;match_false} -> + let%bind match_true = uncompile_expression match_true in + let%bind match_false = uncompile_expression match_false in + ok @@ I.Match_bool {match_true;match_false} + | O.Match_list {match_nil;match_cons} -> + let%bind match_nil = uncompile_expression match_nil in + let (hd,tl,expr,tv) = match_cons in + let%bind expr = uncompile_expression expr in + ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)} + | O.Match_option {match_none;match_some} -> + let%bind match_none = uncompile_expression match_none in + let (n,expr,tv) = match_some in + let%bind expr = uncompile_expression expr in + ok @@ I.Match_option {match_none; match_some=(n,expr,tv)} + | O.Match_tuple ((lst,expr), tv) -> + let%bind expr = uncompile_expression expr in + ok @@ O.Match_tuple ((lst,expr), tv) + | O.Match_variant (lst,tv) -> + let%bind lst = bind_map_list ( + fun ((c,n),expr) -> + let%bind expr = uncompile_expression expr in + ok @@ ((c,n),expr) + ) lst + in + ok @@ I.Match_variant (lst,tv) diff --git a/src/passes/5-self_ast_sugar/dune b/src/passes/5-self_ast_sugar/dune new file mode 100644 index 000000000..33b51be08 --- /dev/null +++ b/src/passes/5-self_ast_sugar/dune @@ -0,0 +1,13 @@ +(library + (name self_ast_sugar) + (public_name ligo.self_ast_sugar) + (libraries + simple-utils + ast_sugar + proto-alpha-utils + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils )) +) diff --git a/src/passes/5-self_ast_typed/main.ml b/src/passes/5-self_ast_typed/main.ml deleted file mode 100644 index e69de29bb..000000000 diff --git a/src/passes/6-sugar_to_core/dune b/src/passes/6-sugar_to_core/dune new file mode 100644 index 000000000..4f4bb92e9 --- /dev/null +++ b/src/passes/6-sugar_to_core/dune @@ -0,0 +1,14 @@ +(library + (name sugar_to_core) + (public_name ligo.sugar_to_core) + (libraries + simple-utils + ast_sugar + ast_core + proto-alpha-utils + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils )) +) diff --git a/src/passes/6-sugar_to_core/sugar_to_core.ml b/src/passes/6-sugar_to_core/sugar_to_core.ml new file mode 100644 index 000000000..261bb1e81 --- /dev/null +++ b/src/passes/6-sugar_to_core/sugar_to_core.ml @@ -0,0 +1,363 @@ +module I = Ast_sugar +module O = Ast_core +open Trace + +let rec idle_type_expression : I.type_expression -> O.type_expression result = + fun te -> + let return te = ok @@ O.make_t te in + match te.type_content with + | I.T_sum sum -> + let sum = I.CMap.to_kv_list sum in + let%bind sum = + bind_map_list (fun (k,v) -> + let%bind v = idle_type_expression v in + ok @@ (k,v) + ) sum + in + return @@ O.T_sum (O.CMap.of_list sum) + | I.T_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = idle_type_expression v in + ok @@ (k,v) + ) record + in + return @@ O.T_record (O.LMap.of_list record) + | I.T_arrow {type1;type2} -> + let%bind type1 = idle_type_expression type1 in + let%bind type2 = idle_type_expression type2 in + return @@ T_arrow {type1;type2} + | I.T_variable type_variable -> return @@ T_variable type_variable + | I.T_constant type_constant -> return @@ T_constant type_constant + | I.T_operator type_operator -> + let%bind type_operator = idle_type_operator type_operator in + return @@ T_operator type_operator + +and idle_type_operator : I.type_operator -> O.type_operator result = + fun t_o -> + match t_o with + | TC_contract c -> + let%bind c = idle_type_expression c in + ok @@ O.TC_contract c + | TC_option o -> + let%bind o = idle_type_expression o in + ok @@ O.TC_option o + | TC_list l -> + let%bind l = idle_type_expression l in + ok @@ O.TC_list l + | TC_set s -> + let%bind s = idle_type_expression s in + ok @@ O.TC_set s + | TC_map (k,v) -> + let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in + ok @@ O.TC_map (k,v) + | TC_big_map (k,v) -> + let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in + ok @@ O.TC_big_map (k,v) + | TC_arrow (i,o) -> + let%bind (i,o) = bind_map_pair idle_type_expression (i,o) in + ok @@ O.TC_arrow (i,o) + +let rec compile_expression : I.expression -> O.expression result = + fun e -> + let return expr = ok @@ O.make_expr ~loc:e.location expr in + match e.expression_content with + | I.E_literal literal -> return @@ O.E_literal literal + | I.E_constant {cons_name;arguments} -> + let%bind arguments = bind_map_list compile_expression arguments in + return @@ O.E_constant {cons_name;arguments} + | I.E_variable name -> return @@ O.E_variable name + | I.E_application {lamb;args} -> + let%bind lamb = compile_expression lamb in + let%bind args = compile_expression args in + return @@ O.E_application {lamb; args} + | I.E_lambda lambda -> + let%bind lambda = compile_lambda lambda in + return @@ O.E_lambda lambda + | I.E_recursive {fun_name;fun_type;lambda} -> + let%bind fun_type = idle_type_expression fun_type in + let%bind lambda = compile_lambda lambda in + return @@ O.E_recursive {fun_name;fun_type;lambda} + | I.E_let_in {let_binder;inline;rhs;let_result} -> + let (binder,ty_opt) = let_binder in + let%bind ty_opt = bind_map_option idle_type_expression ty_opt in + let%bind rhs = compile_expression rhs in + let%bind let_result = compile_expression let_result in + return @@ O.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result} + | I.E_constructor {constructor;element} -> + let%bind element = compile_expression element in + return @@ O.E_constructor {constructor;element} + | I.E_matching {matchee; cases} -> + let%bind matchee = compile_expression matchee in + let%bind cases = compile_matching cases in + return @@ O.E_matching {matchee;cases} + | I.E_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v =compile_expression v in + ok @@ (k,v) + ) record + in + return @@ O.E_record (O.LMap.of_list record) + | I.E_record_accessor {expr;label} -> + let%bind expr = compile_expression expr in + return @@ O.E_record_accessor {expr;label} + | I.E_record_update {record;path;update} -> + let%bind record = compile_expression record in + let%bind update = compile_expression update in + return @@ O.E_record_update {record;path;update} + | I.E_map map -> + let%bind map = bind_map_list ( + bind_map_pair compile_expression + ) map + in + return @@ O.E_map map + | I.E_big_map big_map -> + let%bind big_map = bind_map_list ( + bind_map_pair compile_expression + ) big_map + in + return @@ O.E_big_map big_map + | I.E_list lst -> + let%bind lst = bind_map_list compile_expression lst in + return @@ O.E_list lst + | I.E_set set -> + let%bind set = bind_map_list compile_expression set in + return @@ O.E_set set + | I.E_look_up look_up -> + let%bind look_up = bind_map_pair compile_expression look_up in + return @@ O.E_look_up look_up + | I.E_ascription {anno_expr; type_annotation} -> + let%bind anno_expr = compile_expression anno_expr in + let%bind type_annotation = idle_type_expression type_annotation in + return @@ O.E_ascription {anno_expr; type_annotation} + | I.E_sequence {expr1; expr2} -> + let%bind expr1 = compile_expression expr1 in + let%bind expr2 = compile_expression expr2 in + return @@ O.E_let_in {let_binder=(Var.of_name "_", Some O.t_unit); rhs=expr1;let_result=expr2; inline=false} + | I.E_skip -> ok @@ O.e_unit ~loc:e.location () + +and compile_lambda : I.lambda -> O.lambda result = + fun {binder;input_type;output_type;result}-> + let%bind input_type = bind_map_option idle_type_expression input_type in + let%bind output_type = bind_map_option idle_type_expression output_type in + let%bind result = compile_expression result in + ok @@ O.{binder;input_type;output_type;result} +and compile_matching : I.matching_expr -> O.matching_expr result = + fun m -> + match m with + | I.Match_bool {match_true;match_false} -> + let%bind match_true = compile_expression match_true in + let%bind match_false = compile_expression match_false in + ok @@ O.Match_bool {match_true;match_false} + | I.Match_list {match_nil;match_cons} -> + let%bind match_nil = compile_expression match_nil in + let (hd,tl,expr,tv) = match_cons in + let%bind expr = compile_expression expr in + ok @@ O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)} + | I.Match_option {match_none;match_some} -> + let%bind match_none = compile_expression match_none in + let (n,expr,tv) = match_some in + let%bind expr = compile_expression expr in + ok @@ O.Match_option {match_none; match_some=(n,expr,tv)} + | I.Match_tuple ((lst,expr), tv) -> + let%bind expr = compile_expression expr in + ok @@ O.Match_tuple ((lst,expr), tv) + | I.Match_variant (lst,tv) -> + let%bind lst = bind_map_list ( + fun ((c,n),expr) -> + let%bind expr = compile_expression expr in + ok @@ ((c,n),expr) + ) lst + in + ok @@ O.Match_variant (lst,tv) + +let compile_declaration : I.declaration Location.wrap -> _ = + fun {wrap_content=declaration;location} -> + let return decl = ok @@ Location.wrap ~loc:location decl in + match declaration with + | I.Declaration_constant (n, te_opt, inline, expr) -> + let%bind expr = compile_expression expr in + let%bind te_opt = bind_map_option idle_type_expression te_opt in + return @@ O.Declaration_constant (n, te_opt, inline, expr) + | I.Declaration_type (n, te) -> + let%bind te = idle_type_expression te in + return @@ O.Declaration_type (n,te) + +let compile_program : I.program -> O.program result = + fun p -> + bind_map_list compile_declaration p + +(* uncompiling *) +let rec uncompile_type_expression : O.type_expression -> I.type_expression result = + fun te -> + let return te = ok @@ I.make_t te in + match te.type_content with + | O.T_sum sum -> + let sum = I.CMap.to_kv_list sum in + let%bind sum = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_type_expression v in + ok @@ (k,v) + ) sum + in + return @@ I.T_sum (O.CMap.of_list sum) + | O.T_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_type_expression v in + ok @@ (k,v) + ) record + in + return @@ I.T_record (O.LMap.of_list record) + | O.T_arrow {type1;type2} -> + let%bind type1 = uncompile_type_expression type1 in + let%bind type2 = uncompile_type_expression type2 in + return @@ T_arrow {type1;type2} + | O.T_variable type_variable -> return @@ T_variable type_variable + | O.T_constant type_constant -> return @@ T_constant type_constant + | O.T_operator type_operator -> + let%bind type_operator = uncompile_type_operator type_operator in + return @@ T_operator type_operator + +and uncompile_type_operator : O.type_operator -> I.type_operator result = + fun t_o -> + match t_o with + | TC_contract c -> + let%bind c = uncompile_type_expression c in + ok @@ I.TC_contract c + | TC_option o -> + let%bind o = uncompile_type_expression o in + ok @@ I.TC_option o + | TC_list l -> + let%bind l = uncompile_type_expression l in + ok @@ I.TC_list l + | TC_set s -> + let%bind s = uncompile_type_expression s in + ok @@ I.TC_set s + | TC_map (k,v) -> + let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in + ok @@ I.TC_map (k,v) + | TC_big_map (k,v) -> + let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in + ok @@ I.TC_big_map (k,v) + | TC_arrow (i,o) -> + let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in + ok @@ I.TC_arrow (i,o) + +let rec uncompile_expression : O.expression -> I.expression result = + fun e -> + let return expr = ok @@ I.make_expr ~loc:e.location expr in + match e.expression_content with + O.E_literal lit -> return @@ I.E_literal lit + | O.E_constant {cons_name;arguments} -> + let%bind arguments = bind_map_list uncompile_expression arguments in + return @@ I.E_constant {cons_name;arguments} + | O.E_variable name -> return @@ I.E_variable name + | O.E_application {lamb; args} -> + let%bind lamb = uncompile_expression lamb in + let%bind args = uncompile_expression args in + return @@ I.E_application {lamb; args} + | O.E_lambda lambda -> + let%bind lambda = uncompile_lambda lambda in + return @@ I.E_lambda lambda + | O.E_recursive {fun_name;fun_type;lambda} -> + let%bind fun_type = uncompile_type_expression fun_type in + let%bind lambda = uncompile_lambda lambda in + return @@ I.E_recursive {fun_name;fun_type;lambda} + | O.E_let_in {let_binder;inline=false;rhs=expr1;let_result=expr2} when let_binder = (Var.of_name "_", Some O.t_unit) -> + let%bind expr1 = uncompile_expression expr1 in + let%bind expr2 = uncompile_expression expr2 in + return @@ I.E_sequence {expr1;expr2} + | O.E_let_in {let_binder;inline;rhs;let_result} -> + let (binder,ty_opt) = let_binder in + let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in + let%bind rhs = uncompile_expression rhs in + let%bind let_result = uncompile_expression let_result in + return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result} + | O.E_constructor {constructor;element} -> + let%bind element = uncompile_expression element in + return @@ I.E_constructor {constructor;element} + | O.E_matching {matchee; cases} -> + let%bind matchee = uncompile_expression matchee in + let%bind cases = uncompile_matching cases in + return @@ I.E_matching {matchee;cases} + | O.E_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_expression v in + ok @@ (k,v) + ) record + in + return @@ I.E_record (O.LMap.of_list record) + | O.E_record_accessor {expr;label} -> + let%bind expr = uncompile_expression expr in + return @@ I.E_record_accessor {expr;label} + | O.E_record_update {record;path;update} -> + let%bind record = uncompile_expression record in + let%bind update = uncompile_expression update in + return @@ I.E_record_update {record;path;update} + | O.E_map map -> + let%bind map = bind_map_list ( + bind_map_pair uncompile_expression + ) map + in + return @@ I.E_map map + | O.E_big_map big_map -> + let%bind big_map = bind_map_list ( + bind_map_pair uncompile_expression + ) big_map + in + return @@ I.E_big_map big_map + | O.E_list lst -> + let%bind lst = bind_map_list uncompile_expression lst in + return @@ I.E_list lst + | O.E_set set -> + let%bind set = bind_map_list uncompile_expression set in + return @@ I.E_set set + | O.E_look_up look_up -> + let%bind look_up = bind_map_pair uncompile_expression look_up in + return @@ I.E_look_up look_up + | O.E_ascription {anno_expr; type_annotation} -> + let%bind anno_expr = uncompile_expression anno_expr in + let%bind type_annotation = uncompile_type_expression type_annotation in + return @@ I.E_ascription {anno_expr; type_annotation} + +and uncompile_lambda : O.lambda -> I.lambda result = + fun {binder;input_type;output_type;result}-> + let%bind input_type = bind_map_option uncompile_type_expression input_type in + let%bind output_type = bind_map_option uncompile_type_expression output_type in + let%bind result = uncompile_expression result in + ok @@ I.{binder;input_type;output_type;result} +and uncompile_matching : O.matching_expr -> I.matching_expr result = + fun m -> + match m with + | O.Match_bool {match_true;match_false} -> + let%bind match_true = uncompile_expression match_true in + let%bind match_false = uncompile_expression match_false in + ok @@ I.Match_bool {match_true;match_false} + | O.Match_list {match_nil;match_cons} -> + let%bind match_nil = uncompile_expression match_nil in + let (hd,tl,expr,tv) = match_cons in + let%bind expr = uncompile_expression expr in + ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)} + | O.Match_option {match_none;match_some} -> + let%bind match_none = uncompile_expression match_none in + let (n,expr,tv) = match_some in + let%bind expr = uncompile_expression expr in + ok @@ I.Match_option {match_none; match_some=(n,expr,tv)} + | O.Match_tuple ((lst,expr), tv) -> + let%bind expr = uncompile_expression expr in + ok @@ O.Match_tuple ((lst,expr), tv) + | O.Match_variant (lst,tv) -> + let%bind lst = bind_map_list ( + fun ((c,n),expr) -> + let%bind expr = uncompile_expression expr in + ok @@ ((c,n),expr) + ) lst + in + ok @@ I.Match_variant (lst,tv) diff --git a/src/passes/7-self_ast_core/dune b/src/passes/7-self_ast_core/dune new file mode 100644 index 000000000..e51afd86e --- /dev/null +++ b/src/passes/7-self_ast_core/dune @@ -0,0 +1,13 @@ +(library + (name self_ast_core) + (public_name ligo.self_ast_core) + (libraries + simple-utils + ast_core + proto-alpha-utils + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils )) +) diff --git a/src/passes/4-typer-new/PP.ml b/src/passes/8-typer-new/PP.ml similarity index 100% rename from src/passes/4-typer-new/PP.ml rename to src/passes/8-typer-new/PP.ml diff --git a/src/passes/4-typer-new/dune b/src/passes/8-typer-new/dune similarity index 93% rename from src/passes/4-typer-new/dune rename to src/passes/8-typer-new/dune index 645a7053f..b7bbee5f4 100644 --- a/src/passes/4-typer-new/dune +++ b/src/passes/8-typer-new/dune @@ -4,7 +4,7 @@ (libraries simple-utils tezos-utils - ast_simplified + ast_core ast_typed operators UnionFind diff --git a/src/passes/4-typer-new/solver.ml b/src/passes/8-typer-new/solver.ml similarity index 99% rename from src/passes/4-typer-new/solver.ml rename to src/passes/8-typer-new/solver.ml index aad418cb5..328cfe015 100644 --- a/src/passes/4-typer-new/solver.ml +++ b/src/passes/8-typer-new/solver.ml @@ -3,7 +3,7 @@ open Trace module Core = Typesystem.Core module Wrap = struct - module I = Ast_simplified + module I = Ast_core module T = Ast_typed module O = Core diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/8-typer-new/typer.ml similarity index 97% rename from src/passes/4-typer-new/typer.ml rename to src/passes/8-typer-new/typer.ml index decd197fc..0dcae68d0 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/8-typer-new/typer.ml @@ -1,6 +1,6 @@ open Trace -module I = Ast_simplified +module I = Ast_core module O = Ast_typed open O.Combinators @@ -446,10 +446,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression - | E_literal (Literal_void) -> ( failwith "TODO: missing implementation for literal void" ) - | E_skip -> ( - (* E_skip just returns unit *) - return_wrapped (e_unit ()) state @@ Wrap.literal (t_unit ()) - ) (* | E_literal (Literal_string s) -> ( * L.log (Format.asprintf "literal_string option type: %a" PP_helpers.(option O.PP.type_expression) tv_opt) ; * match Option.map Ast_typed.get_type' tv_opt with @@ -683,11 +679,11 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression - * let%bind (name', tv) = * type_constant name tv_lst tv_opt ae.location in * return (E_constant (name' , lst')) tv *) - | E_application {expr1;expr2} -> - let%bind (f' , state') = type_expression e state expr1 in - let%bind (arg , state'') = type_expression e state' expr2 in - let wrapped = Wrap.application f'.type_expression arg.type_expression in - return_wrapped (E_application {expr1=f';expr2=arg}) state'' wrapped + | E_application {lamb;args} -> + let%bind (f' , state') = type_expression e state lamb in + let%bind (args , state'') = type_expression e state' args in + let wrapped = Wrap.application f'.type_expression args.type_expression in + return_wrapped (E_application {lamb=f';args}) state'' wrapped (* | E_look_up dsi -> * let%bind (ds, ind) = bind_map_pair (type_expression e) dsi in @@ -872,7 +868,7 @@ let untype_type_value (t:O.type_expression) : (I.type_expression) result = (* TODO: we ended up with two versions of type_program… ??? *) (* -Apply type_declaration on all the node of the AST_simplified from the root p +Apply type_declaration on all the node of the AST_core from the root p *) let type_program_returns_state ((env, state, p) : environment * Solver.state * I.program) : (environment * Solver.state * O.program) result = let aux ((e : environment), (s : Solver.state) , (ds : O.declaration Location.wrap list)) (d:I.declaration Location.wrap) = @@ -950,10 +946,10 @@ let type_program' : I.program -> O.program result = fun p -> ok p' (* - Tranform a Ast_typed type_expression into an ast_simplified type_expression + Tranform a Ast_typed type_expression into an ast_core type_expression *) let rec untype_type_expression (t:O.type_expression) : (I.type_expression) result = - (* TODO: or should we use t.simplified if present? *) + (* TODO: or should we use t.core if present? *) let%bind t = match t.type_content with | O.T_sum x -> let%bind x' = Stage_common.Helpers.bind_map_cmap untype_type_expression x in @@ -999,13 +995,13 @@ let rec untype_type_expression (t:O.type_expression) : (I.type_expression) resul in ok @@ I.make_t t -(* match t.simplified with *) +(* match t.core with *) (* | Some s -> ok s *) (* | _ -> fail @@ internal_assertion_failure "trying to untype generated type" *) (* - Tranform a Ast_typed literal into an ast_simplified literal + Tranform a Ast_typed literal into an ast_core literal *) let untype_literal (l:O.literal) : I.literal result = let open I in @@ -1027,7 +1023,7 @@ let untype_literal (l:O.literal) : I.literal result = | Literal_operation s -> ok (Literal_operation s) (* - Tranform a Ast_typed expression into an ast_simplified matching + Tranform a Ast_typed expression into an ast_core matching *) let rec untype_expression (e:O.expression) : (I.expression) result = let open I in @@ -1041,9 +1037,9 @@ let rec untype_expression (e:O.expression) : (I.expression) result = return (e_constant cons_name lst') | E_variable (n) -> return (e_variable (n)) - | E_application {expr1;expr2} -> - let%bind f' = untype_expression expr1 in - let%bind arg' = untype_expression expr2 in + | E_application {lamb;args} -> + let%bind f' = untype_expression lamb in + let%bind arg' = untype_expression args in return (e_application f' arg') | E_lambda lambda -> let%bind lambda = untype_lambda e.type_expression lambda in @@ -1094,7 +1090,7 @@ let rec untype_expression (e:O.expression) : (I.expression) result = let%bind tv = untype_type_value rhs.type_expression in let%bind rhs = untype_expression rhs in let%bind result = untype_expression let_result in - return (e_let_in (let_binder , (Some tv)) false inline rhs result) + return (e_let_in (let_binder , (Some tv)) inline rhs result) | E_recursive {fun_name; fun_type; lambda} -> let%bind lambda = untype_lambda fun_type lambda in let%bind fun_type = untype_type_expression fun_type in @@ -1107,7 +1103,7 @@ and untype_lambda ty {binder; result} : I.lambda result = ok ({binder;input_type = Some input_type; output_type = Some output_type; result}: I.lambda) (* - Tranform a Ast_typed matching into an ast_simplified matching + Tranform a Ast_typed matching into an ast_core matching *) and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m -> let open I in diff --git a/src/passes/4-typer-new/typer.ml.old b/src/passes/8-typer-new/typer.ml.old similarity index 99% rename from src/passes/4-typer-new/typer.ml.old rename to src/passes/8-typer-new/typer.ml.old index db842716a..66b918235 100644 --- a/src/passes/4-typer-new/typer.ml.old +++ b/src/passes/8-typer-new/typer.ml.old @@ -1,6 +1,6 @@ open Trace -module I = Ast_simplified +module I = Ast_core module O = Ast_typed open O.Combinators @@ -736,7 +736,7 @@ and type_constant (name:string) (lst:O.type_expression list) (tv_opt:O.type_expr typer lst tv_opt let untype_type_expression (t:O.type_expression) : (I.type_expression) result = - match t.simplified with + match t.core with | Some s -> ok s | _ -> fail @@ internal_assertion_failure "trying to untype generated type" diff --git a/src/passes/4-typer-new/typer.mli b/src/passes/8-typer-new/typer.mli similarity index 99% rename from src/passes/4-typer-new/typer.mli rename to src/passes/8-typer-new/typer.mli index 29b7cad08..6e24e7359 100644 --- a/src/passes/4-typer-new/typer.mli +++ b/src/passes/8-typer-new/typer.mli @@ -1,6 +1,6 @@ open Trace -module I = Ast_simplified +module I = Ast_core module O = Ast_typed module Environment = O.Environment diff --git a/src/passes/4-typer-new/typer_new.ml b/src/passes/8-typer-new/typer_new.ml similarity index 100% rename from src/passes/4-typer-new/typer_new.ml rename to src/passes/8-typer-new/typer_new.ml diff --git a/src/passes/4-typer-old/dune b/src/passes/8-typer-old/dune similarity index 93% rename from src/passes/4-typer-old/dune rename to src/passes/8-typer-old/dune index 29e48c79e..faec4e901 100644 --- a/src/passes/4-typer-old/dune +++ b/src/passes/8-typer-old/dune @@ -4,7 +4,7 @@ (libraries simple-utils tezos-utils - ast_simplified + ast_core ast_typed typer_new operators diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/8-typer-old/typer.ml similarity index 98% rename from src/passes/4-typer-old/typer.ml rename to src/passes/8-typer-old/typer.ml index 448f7be08..5a11d6184 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/8-typer-old/typer.ml @@ -1,6 +1,6 @@ open Trace -module I = Ast_simplified +module I = Ast_core module O = Ast_typed open O.Combinators @@ -423,7 +423,7 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression return (E_variable name) tv'.type_value | E_literal (Literal_bool b) -> return (E_literal (Literal_bool b)) (t_bool ()) - | E_literal Literal_unit | E_skip -> + | E_literal Literal_unit -> return (E_literal (Literal_unit)) (t_unit ()) | E_literal Literal_void -> return (E_literal (Literal_void)) (t_unit ()) (* TODO : IS this really a t_unit ?*) | E_literal (Literal_string s) -> @@ -688,21 +688,21 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression let%bind (name', tv) = type_constant cons_name tv_lst tv_opt in return (E_constant {cons_name=name';arguments=lst'}) tv - | E_application {expr1;expr2} -> - let%bind expr1' = type_expression' e expr1 in - let%bind expr2 = type_expression' e expr2 in - let%bind tv = match expr1'.type_expression.type_content with + | E_application {lamb; args} -> + let%bind lamb' = type_expression' e lamb in + let%bind args' = type_expression' e args in + let%bind tv = match lamb'.type_expression.type_content with | T_arrow {type1;type2} -> - let%bind _ = O.assert_type_expression_eq (type1, expr2.type_expression) in + let%bind _ = O.assert_type_expression_eq (type1, args'.type_expression) in ok type2 | _ -> fail @@ type_error_approximate ~expected:"should be a function type" - ~expression:expr1 - ~actual:expr1'.type_expression - expr1'.location + ~expression:lamb + ~actual:lamb'.type_expression + lamb'.location in - return (E_application {expr1=expr1';expr2}) tv + return (E_application {lamb=lamb'; args=args'}) tv | E_look_up dsi -> let%bind (ds, ind) = bind_map_pair (type_expression' e) dsi in let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) ds.type_expression in @@ -841,9 +841,9 @@ let rec untype_expression (e:O.expression) : (I.expression) result = return (e_constant cons_name lst') | E_variable n -> return (e_variable (n)) - | E_application {expr1;expr2} -> - let%bind f' = untype_expression expr1 in - let%bind arg' = untype_expression expr2 in + | E_application {lamb;args} -> + let%bind f' = untype_expression lamb in + let%bind arg' = untype_expression args in return (e_application f' arg') | E_lambda {binder ; result} -> ( let%bind io = get_t_function ty in @@ -893,7 +893,7 @@ let rec untype_expression (e:O.expression) : (I.expression) result = let%bind tv = untype_type_expression rhs.type_expression in let%bind rhs = untype_expression rhs in let%bind result = untype_expression let_result in - return (e_let_in (let_binder , (Some tv)) false inline rhs result) + return (e_let_in (let_binder , (Some tv)) inline rhs result) | E_recursive {fun_name;fun_type; lambda} -> let%bind fun_type = untype_type_expression fun_type in let%bind unty_expr= untype_expression_content ty @@ E_lambda lambda in diff --git a/src/passes/4-typer-old/typer.mli b/src/passes/8-typer-old/typer.mli similarity index 99% rename from src/passes/4-typer-old/typer.mli rename to src/passes/8-typer-old/typer.mli index 9b1e986da..d1bf21393 100644 --- a/src/passes/4-typer-old/typer.mli +++ b/src/passes/8-typer-old/typer.mli @@ -1,6 +1,6 @@ open Trace -module I = Ast_simplified +module I = Ast_core module O = Ast_typed module Environment = O.Environment diff --git a/src/passes/4-typer-old/typer_old.ml b/src/passes/8-typer-old/typer_old.ml similarity index 100% rename from src/passes/4-typer-old/typer_old.ml rename to src/passes/8-typer-old/typer_old.ml diff --git a/src/passes/4-typer/dune b/src/passes/8-typer/dune similarity index 93% rename from src/passes/4-typer/dune rename to src/passes/8-typer/dune index 35c5e807d..f6072da39 100644 --- a/src/passes/4-typer/dune +++ b/src/passes/8-typer/dune @@ -4,7 +4,7 @@ (libraries simple-utils tezos-utils - ast_simplified + ast_core ast_typed typer_old typer_new diff --git a/src/passes/4-typer/typer.ml b/src/passes/8-typer/typer.ml similarity index 96% rename from src/passes/4-typer/typer.ml rename to src/passes/8-typer/typer.ml index 8ab5576a0..48f1ac011 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/8-typer/typer.ml @@ -1,6 +1,6 @@ let use_new_typer = false -module I = Ast_simplified +module I = Ast_core module O = Ast_typed module Environment = O.Environment diff --git a/src/passes/4-typer/typer.mli b/src/passes/8-typer/typer.mli similarity index 94% rename from src/passes/4-typer/typer.mli rename to src/passes/8-typer/typer.mli index bb8ac3094..bf4c11f4d 100644 --- a/src/passes/4-typer/typer.mli +++ b/src/passes/8-typer/typer.mli @@ -2,7 +2,7 @@ val use_new_typer : bool open Trace -module I = Ast_simplified +module I = Ast_core module O = Ast_typed module Environment = O.Environment diff --git a/src/passes/5-self_ast_typed/contract_passes.ml b/src/passes/9-self_ast_typed/contract_passes.ml similarity index 100% rename from src/passes/5-self_ast_typed/contract_passes.ml rename to src/passes/9-self_ast_typed/contract_passes.ml diff --git a/src/passes/5-self_ast_typed/dune b/src/passes/9-self_ast_typed/dune similarity index 100% rename from src/passes/5-self_ast_typed/dune rename to src/passes/9-self_ast_typed/dune diff --git a/src/passes/5-self_ast_typed/helpers.ml b/src/passes/9-self_ast_typed/helpers.ml similarity index 97% rename from src/passes/5-self_ast_typed/helpers.ml rename to src/passes/9-self_ast_typed/helpers.ml index 818cdccf5..2da8a766e 100644 --- a/src/passes/5-self_ast_typed/helpers.ml +++ b/src/passes/9-self_ast_typed/helpers.ml @@ -19,8 +19,8 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini | E_look_up ab -> let%bind res = bind_fold_pair self init' ab in ok res - | E_application {expr1;expr2} -> ( - let ab = (expr1,expr2) in + | E_application {lamb; args} -> ( + let ab = (lamb, args) in let%bind res = bind_fold_pair self init' ab in ok res ) @@ -135,10 +135,10 @@ let rec map_expression : mapper -> expression -> expression result = fun f e -> let%bind e' = self c.element in return @@ E_constructor {c with element = e'} ) - | E_application {expr1;expr2} -> ( - let ab = (expr1,expr2) in + | E_application {lamb; args} -> ( + let ab = (lamb, args) in let%bind (a,b) = bind_map_pair self ab in - return @@ E_application {expr1=a;expr2=b} + return @@ E_application {lamb=a;args=b} ) | E_let_in { let_binder ; rhs ; let_result; inline } -> ( let%bind rhs = self rhs in @@ -251,10 +251,10 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres let%bind (res,e') = self init' c.element in ok (res, return @@ E_constructor {c with element = e'}) ) - | E_application {expr1;expr2} -> ( - let ab = (expr1,expr2) in + | E_application {lamb;args} -> ( + let ab = (lamb, args) in let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in - ok (res, return @@ E_application {expr1=a;expr2=b}) + ok (res, return @@ E_application {lamb=a;args=b}) ) | E_let_in { let_binder ; rhs ; let_result; inline } -> ( let%bind (res,rhs) = self init' rhs in diff --git a/src/passes/9-self_ast_typed/no_nested_big_map.ml b/src/passes/9-self_ast_typed/no_nested_big_map.ml new file mode 100644 index 000000000..e1a130ce9 --- /dev/null +++ b/src/passes/9-self_ast_typed/no_nested_big_map.ml @@ -0,0 +1,56 @@ +open Ast_typed +open Trace + +type contract_pass_data = Contract_passes.contract_pass_data + +module Errors = struct + let no_nested_bigmap () = + let title = (thunk ("It looks like you have nested a big map inside another big map. This is not supported. ")) in + let message () = "" in + let data = [ + (* ("location" , fun () -> Format.asprintf "%a" Location.pp loc) TODO once types have an actual location *) + ] in + error ~data title message () +end + +let rec check_no_nested_bigmap is_in_bigmap e = + match e.type_content with + | T_operator (TC_big_map (_, _)) when is_in_bigmap -> + fail @@ Errors.no_nested_bigmap + | T_operator (TC_big_map (key, value)) -> + let%bind _ = check_no_nested_bigmap false key in + let%bind _ = check_no_nested_bigmap true value in + ok () + | T_operator (TC_contract t) + | T_operator (TC_option t) + | T_operator (TC_list t) + | T_operator (TC_set t) -> + let%bind _ = check_no_nested_bigmap is_in_bigmap t in + ok () + | T_operator (TC_map (a, b)) -> + let%bind _ = check_no_nested_bigmap is_in_bigmap a in + let%bind _ = check_no_nested_bigmap is_in_bigmap b in + ok () + | T_operator (TC_arrow (a, b)) -> + let%bind _ = check_no_nested_bigmap false a in + let%bind _ = check_no_nested_bigmap false b in + ok () + | T_sum s -> + let es = CMap.to_list s in + let%bind _ = bind_map_list (fun l -> check_no_nested_bigmap is_in_bigmap l) es in + ok () + | T_record elm -> + let es = LMap.to_list elm in + let%bind _ = bind_map_list (fun l -> check_no_nested_bigmap is_in_bigmap l) es in + ok () + | T_arrow { type1; type2 } -> + let%bind _ = check_no_nested_bigmap false type1 in + let%bind _ = check_no_nested_bigmap false type2 in + ok () + | T_variable _ + | T_constant _ -> + ok () + +let self_typing : contract_pass_data -> expression -> (bool * contract_pass_data * expression) result = fun dat el -> + let%bind _ = check_no_nested_bigmap false el.type_expression in + ok (true, dat, el) diff --git a/src/passes/5-self_ast_typed/self_ast_typed.ml b/src/passes/9-self_ast_typed/self_ast_typed.ml similarity index 96% rename from src/passes/5-self_ast_typed/self_ast_typed.ml rename to src/passes/9-self_ast_typed/self_ast_typed.ml index 76bfbdf90..e8dfefdce 100644 --- a/src/passes/5-self_ast_typed/self_ast_typed.ml +++ b/src/passes/9-self_ast_typed/self_ast_typed.ml @@ -6,6 +6,7 @@ let all_passes = [ let contract_passes = [ Contract_passes.self_typing ; + No_nested_big_map.self_typing ; ] let all_program = diff --git a/src/passes/5-self_ast_typed/tail_recursion.ml b/src/passes/9-self_ast_typed/tail_recursion.ml similarity index 96% rename from src/passes/5-self_ast_typed/tail_recursion.ml rename to src/passes/9-self_ast_typed/tail_recursion.ml index 3e971c79e..610484a38 100644 --- a/src/passes/5-self_ast_typed/tail_recursion.ml +++ b/src/passes/9-self_ast_typed/tail_recursion.ml @@ -24,9 +24,9 @@ let rec check_recursive_call : expression_variable -> bool -> expression -> unit Assert.assert_true (final_path || n <> v) in ok () ) - | E_application {expr1;expr2} -> - let%bind _ = check_recursive_call n final_path expr1 in - let%bind _ = check_recursive_call n false expr2 in + | E_application {lamb;args} -> + let%bind _ = check_recursive_call n final_path lamb in + let%bind _ = check_recursive_call n false args in ok () | E_lambda {result;_} -> let%bind _ = check_recursive_call n final_path result in diff --git a/src/passes/9-self_michelson/main.ml b/src/passes/9-self_michelson/main.ml deleted file mode 100644 index e69de29bb..000000000 diff --git a/src/passes/operators/dune b/src/passes/operators/dune index 64222a117..fa69f6257 100644 --- a/src/passes/operators/dune +++ b/src/passes/operators/dune @@ -4,6 +4,9 @@ (libraries simple-utils tezos-utils + ast_imperative + ast_sugar + ast_core ast_typed typesystem mini_c diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 7d2807b44..472b67506 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -9,15 +9,15 @@ open Trace a new constructor at all those places. *) -module Simplify = struct +module Concrete_to_imperative = struct - open Ast_simplified + open Ast_imperative (* Each front-end has its owns constants. Constants are special names that have their own case in the AST. E_constant for regular constants, and T_constant for type constants. Both types are - defined in `Ast_simplified/types.ml`. + defined in `Ast_core/types.ml`. For instance, "2 + 2" in Pascaligo is translated to `E_constant ("ADD" , [ E_literal (Literal_int 2) ; E_literal (Literal_int 2) ; @@ -151,8 +151,8 @@ module Simplify = struct (* String module *) | "String.length" -> ok C_SIZE - | "String.size" -> ok C_SIZE - | "String.slice" -> ok C_SLICE + | "String.size" -> ok C_SIZE (* Deprecated *) + | "String.slice" -> ok C_SLICE (* Deprecated *) | "String.sub" -> ok C_SLICE | "String.concat" -> ok C_CONCAT diff --git a/src/passes/operators/operators.mli b/src/passes/operators/operators.mli index 77ce53196..15176ff8c 100644 --- a/src/passes/operators/operators.mli +++ b/src/passes/operators/operators.mli @@ -1,6 +1,6 @@ -module Simplify : sig - open Ast_simplified +module Concrete_to_imperative : sig + open Ast_imperative open Trace module Pascaligo : sig diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/1-ast_imperative/PP.ml similarity index 95% rename from src/stages/ast_simplified/PP.ml rename to src/stages/1-ast_imperative/PP.ml index f27d9ed70..ebb4bd83e 100644 --- a/src/stages/ast_simplified/PP.ml +++ b/src/stages/1-ast_imperative/PP.ml @@ -4,7 +4,7 @@ open Format open PP_helpers include Stage_common.PP -include Ast_PP_type(Ast_simplified_parameter) +include Ast_PP_type(Ast_imperative_parameter) let expression_variable ppf (ev : expression_variable) : unit = fprintf ppf "%a" Var.pp ev @@ -18,8 +18,8 @@ and expression_content ppf (ec : expression_content) = literal ppf l | E_variable n -> fprintf ppf "%a" expression_variable n - | E_application app -> - fprintf ppf "(%a)@(%a)" expression app.expr1 expression app.expr2 + | E_application {lamb;args} -> + fprintf ppf "(%a)@(%a)" expression lamb expression args | E_constructor c -> fprintf ppf "%a(%a)" constructor c.constructor expression c.element | E_constant c -> @@ -52,18 +52,20 @@ and expression_content ppf (ec : expression_content) = fprintf ppf "match %a with %a" expression matchee (matching expression) cases - | E_let_in { let_binder ; mut; rhs ; let_result; inline } -> - fprintf ppf "let %a%a = %a%a in %a" option_mut mut option_type_name let_binder expression rhs option_inline inline expression let_result | E_recursive { fun_name; fun_type; lambda} -> fprintf ppf "rec (%a:%a => %a )" expression_variable fun_name type_expression fun_type expression_content (E_lambda lambda) - | E_skip -> - fprintf ppf "skip" + | E_let_in { let_binder ; mut; rhs ; let_result; inline } -> + fprintf ppf "let %a%a = %a%a in %a" option_mut mut option_type_name let_binder expression rhs option_inline inline expression let_result | E_ascription {anno_expr; type_annotation} -> fprintf ppf "%a : %a" expression anno_expr type_expression type_annotation + | E_sequence {expr1;expr2} -> + fprintf ppf "%a;\n%a" expression expr1 expression expr2 + | E_skip -> + fprintf ppf "skip" and option_type_name ppf ((n, ty_opt) : expression_variable * type_expression option) = diff --git a/src/stages/ast_simplified/ast_simplified.ml b/src/stages/1-ast_imperative/ast_imperative.ml similarity index 100% rename from src/stages/ast_simplified/ast_simplified.ml rename to src/stages/1-ast_imperative/ast_imperative.ml diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/1-ast_imperative/combinators.ml similarity index 69% rename from src/stages/ast_simplified/combinators.ml rename to src/stages/1-ast_imperative/combinators.ml index 24b292c4f..92a1dbe73 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/1-ast_imperative/combinators.ml @@ -79,57 +79,57 @@ let t_operator op lst: type_expression result = | TC_contract _ , [t] -> ok @@ t_contract t | _ , _ -> fail @@ bad_type_operator op -let location_wrap ?(loc = Location.generated) expression_content = +let make_expr ?(loc = Location.generated) expression_content = let location = loc in { expression_content; location } -let e_var ?loc (n: string) : expression = location_wrap ?loc @@ E_variable (Var.of_name n) -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_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_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_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_mutez ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_mutez s) -let e_signature ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_signature s) -let e_key ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_key s) -let e_key_hash ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_key_hash s) -let e_chain_id ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_chain_id s) +let e_var ?loc (n: string) : expression = make_expr ?loc @@ E_variable (Var.of_name n) +let e_literal ?loc l : expression = make_expr ?loc @@ E_literal l +let e_unit ?loc () : expression = make_expr ?loc @@ E_literal (Literal_unit) +let e_int ?loc n : expression = make_expr ?loc @@ E_literal (Literal_int n) +let e_nat ?loc n : expression = make_expr ?loc @@ E_literal (Literal_nat n) +let e_timestamp ?loc n : expression = make_expr ?loc @@ E_literal (Literal_timestamp n) +let e_bool ?loc b : expression = make_expr ?loc @@ E_literal (Literal_bool b) +let e_string ?loc s : expression = make_expr ?loc @@ E_literal (Literal_string s) +let e_address ?loc s : expression = make_expr ?loc @@ E_literal (Literal_address s) +let e_mutez ?loc s : expression = make_expr ?loc @@ E_literal (Literal_mutez s) +let e_signature ?loc s : expression = make_expr ?loc @@ E_literal (Literal_signature s) +let e_key ?loc s : expression = make_expr ?loc @@ E_literal (Literal_key s) +let e_key_hash ?loc s : expression = make_expr ?loc @@ E_literal (Literal_key_hash s) +let e_chain_id ?loc s : expression = make_expr ?loc @@ E_literal (Literal_chain_id s) let e'_bytes b : expression_content result = let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in ok @@ E_literal (Literal_bytes bytes) let e_bytes_hex ?loc b : expression result = let%bind e' = e'_bytes b in - ok @@ location_wrap ?loc e' + ok @@ make_expr ?loc e' let e_bytes_raw ?loc (b: bytes) : expression = - location_wrap ?loc @@ E_literal (Literal_bytes b) + make_expr ?loc @@ E_literal (Literal_bytes b) let e_bytes_string ?loc (s: string) : expression = - location_wrap ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s))) -let e_big_map ?loc lst : expression = location_wrap ?loc @@ E_big_map lst -let e_some ?loc s : expression = location_wrap ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]} -let e_none ?loc () : expression = location_wrap ?loc @@ E_constant {cons_name = C_NONE; arguments = []} -let e_string_cat ?loc sl sr : expression = location_wrap ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]} -let e_map_add ?loc k v old : expression = location_wrap ?loc @@ E_constant {cons_name = C_MAP_ADD; arguments = [k ; v ; old]} -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_constructor ?loc s a : expression = location_wrap ?loc @@ E_constructor { constructor = Constructor s; element = a} -let e_matching ?loc a b : expression = location_wrap ?loc @@ E_matching {matchee=a;cases=b} + make_expr ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s))) +let e_big_map ?loc lst : expression = make_expr ?loc @@ E_big_map lst +let e_some ?loc s : expression = make_expr ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]} +let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NONE; arguments = []} +let e_string_cat ?loc sl sr : expression = make_expr ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]} +let e_map_add ?loc k v old : expression = make_expr ?loc @@ E_constant {cons_name = C_MAP_ADD; arguments = [k ; v ; old]} +let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst +let e_set ?loc lst : expression = make_expr ?loc @@ E_set lst +let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst +let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a} +let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b} let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c}) -let e_accessor ?loc a b = location_wrap ?loc @@ E_record_accessor {expr = a; label= Label b} +let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {expr = a; label= Label b} let e_accessor_list ?loc a b = List.fold_left (fun a b -> e_accessor ?loc a b) a b -let e_variable ?loc v = location_wrap ?loc @@ E_variable v -let e_skip ?loc () = location_wrap ?loc @@ E_skip +let e_variable ?loc v = make_expr ?loc @@ E_variable v +let e_skip ?loc () = make_expr ?loc @@ E_skip let e_let_in ?loc (binder, ascr) mut inline rhs let_result = - location_wrap ?loc @@ E_let_in { let_binder = (binder, ascr) ; mut; rhs ; let_result; inline } -let e_annotation ?loc anno_expr ty = location_wrap ?loc @@ E_ascription {anno_expr; type_annotation = ty} -let e_application ?loc a b = location_wrap ?loc @@ E_application {expr1=a ; expr2=b} -let e_binop ?loc name a b = location_wrap ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]} -let e_constant ?loc name lst = location_wrap ?loc @@ E_constant {cons_name=name ; arguments = lst} -let e_look_up ?loc x y = location_wrap ?loc @@ E_look_up (x , y) -let e_sequence ?loc expr1 expr2 = e_let_in ?loc (Var.fresh (), Some t_unit) false false expr1 expr2 + make_expr ?loc @@ E_let_in { let_binder = (binder, ascr) ; mut; rhs ; let_result; inline } +let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty} +let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b} +let e_binop ?loc name a b = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]} +let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst} +let e_look_up ?loc x y = make_expr ?loc @@ E_look_up (x , y) +let e_sequence ?loc expr1 expr2 = make_expr ?loc @@ E_sequence {expr1; expr2} let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false}) (* let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*) @@ -141,14 +141,14 @@ let e_matching_variant ?loc a (lst : ((string * string)* 'a) list) = e_matching ?loc a (ez_match_variant lst) let e_record_ez ?loc (lst : (string * expr) list) : expression = let map = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in - location_wrap ?loc @@ E_record map + make_expr ?loc @@ E_record map let e_record ?loc map = let lst = Map.String.to_kv_list map in e_record_ez ?loc lst let e_update ?loc record path update = let path = Label path in - location_wrap ?loc @@ E_record_update {record; path; update} + make_expr ?loc @@ E_record_update {record; path; update} let e_tuple ?loc lst : expression = e_record_ez ?loc (tuple_to_record lst) let e_pair ?loc a b : expression = e_tuple ?loc [a;b] @@ -177,13 +177,13 @@ let e_lambda ?loc (binder : expression_variable) (output_type : type_expression option) (result : expression) : expression = - location_wrap ?loc @@ E_lambda { - binder = binder; + make_expr ?loc @@ E_lambda { + binder = binder ; input_type = input_type ; output_type = output_type ; result ; } -let e_recursive ?loc fun_name fun_type lambda = location_wrap ?loc @@ E_recursive {fun_name; fun_type; lambda} +let e_recursive ?loc fun_name fun_type lambda = make_expr ?loc @@ E_recursive {fun_name; fun_type; lambda} let e_assign_with_let ?loc var access_path expr = @@ -237,7 +237,7 @@ let tuple_of_record (m: _ LMap.t) = let get_e_tuple = fun t -> match t with | E_record r -> ok @@ tuple_of_record r - | _ -> simple_fail "ast_simplified: get_e_tuple: not a tuple" + | _ -> simple_fail "ast_core: get_e_tuple: not a tuple" (* Same as get_e_pair *) let extract_pair : expression -> (expression * expression) result = fun e -> diff --git a/src/stages/ast_simplified/combinators.mli b/src/stages/1-ast_imperative/combinators.mli similarity index 98% rename from src/stages/ast_simplified/combinators.mli rename to src/stages/1-ast_imperative/combinators.mli index 5dc0af74c..ca2f2d552 100644 --- a/src/stages/ast_simplified/combinators.mli +++ b/src/stages/1-ast_imperative/combinators.mli @@ -46,6 +46,7 @@ val t_map : type_expression -> type_expression -> type_expression val t_operator : type_operator -> type_expression list -> type_expression result val t_set : type_expression -> type_expression +val make_expr : ?loc:Location.t -> expression_content -> expression val e_var : ?loc:Location.t -> string -> expression val e_literal : ?loc:Location.t -> literal -> expression val e_unit : ?loc:Location.t -> unit -> expression diff --git a/src/stages/1-ast_imperative/dune b/src/stages/1-ast_imperative/dune new file mode 100644 index 000000000..8966ca542 --- /dev/null +++ b/src/stages/1-ast_imperative/dune @@ -0,0 +1,13 @@ +(library + (name ast_imperative) + (public_name ligo.ast_impretative) + (libraries + simple-utils + tezos-utils + stage_common + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -open Simple_utils )) +) diff --git a/src/stages/1-ast_imperative/misc.ml b/src/stages/1-ast_imperative/misc.ml new file mode 100644 index 000000000..324529525 --- /dev/null +++ b/src/stages/1-ast_imperative/misc.ml @@ -0,0 +1,331 @@ +open Trace +open Types + +open Stage_common.Helpers +module Errors = struct + let different_literals_because_different_types name a b () = + let title () = "literals have different types: " ^ name in + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "%a" PP.literal a) ; + ("b" , fun () -> Format.asprintf "%a" PP.literal b ) + ] in + error ~data title message () + + let different_literals name a b () = + let title () = name ^ " are different" in + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "%a" PP.literal a) ; + ("b" , fun () -> Format.asprintf "%a" PP.literal b ) + ] in + error ~data title message () + + let error_uncomparable_literals name a b () = + let title () = name ^ " are not comparable" in + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "%a" PP.literal a) ; + ("b" , fun () -> Format.asprintf "%a" PP.literal b ) + ] in + error ~data title message () +end +open Errors + +let assert_literal_eq (a, b : literal * literal) : unit result = + match (a, b) with + | Literal_bool a, Literal_bool b when a = b -> ok () + | Literal_bool _, Literal_bool _ -> fail @@ different_literals "different bools" a b + | Literal_bool _, _ -> fail @@ different_literals_because_different_types "bool vs non-bool" a b + | Literal_int a, Literal_int b when a = b -> ok () + | Literal_int _, Literal_int _ -> fail @@ different_literals "different ints" a b + | Literal_int _, _ -> fail @@ different_literals_because_different_types "int vs non-int" a b + | Literal_nat a, Literal_nat b when a = b -> ok () + | 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_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_mutez a, Literal_mutez b when a = b -> ok () + | Literal_mutez _, Literal_mutez _ -> fail @@ different_literals "different tezs" a b + | Literal_mutez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b + | Literal_string a, Literal_string b when a = b -> ok () + | Literal_string _, Literal_string _ -> fail @@ different_literals "different strings" a b + | Literal_string _, _ -> fail @@ different_literals_because_different_types "string vs non-string" a b + | Literal_bytes a, Literal_bytes b when a = b -> ok () + | Literal_bytes _, Literal_bytes _ -> fail @@ different_literals "different bytess" a b + | Literal_bytes _, _ -> fail @@ different_literals_because_different_types "bytes vs non-bytes" a b + | Literal_void, Literal_void -> ok () + | Literal_void, _ -> fail @@ different_literals_because_different_types "void vs non-void" a b + | Literal_unit, Literal_unit -> ok () + | Literal_unit, _ -> fail @@ different_literals_because_different_types "unit vs non-unit" a b + | Literal_address a, Literal_address b when a = b -> ok () + | Literal_address _, Literal_address _ -> fail @@ different_literals "different addresss" a b + | Literal_address _, _ -> fail @@ different_literals_because_different_types "address vs non-address" 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_signature a, Literal_signature b when a = b -> ok () + | Literal_signature _, Literal_signature _ -> fail @@ different_literals "different signature" a b + | Literal_signature _, _ -> fail @@ different_literals_because_different_types "signature vs non-signature" a b + | Literal_key a, Literal_key b when a = b -> ok () + | Literal_key _, Literal_key _ -> fail @@ different_literals "different key" a b + | Literal_key _, _ -> fail @@ different_literals_because_different_types "key vs non-key" a b + | Literal_key_hash a, Literal_key_hash b when a = b -> ok () + | Literal_key_hash _, Literal_key_hash _ -> fail @@ different_literals "different key_hash" a b + | Literal_key_hash _, _ -> fail @@ different_literals_because_different_types "key_hash vs non-key_hash" a b + | Literal_chain_id a, Literal_chain_id b when a = b -> ok () + | Literal_chain_id _, Literal_chain_id _ -> fail @@ different_literals "different chain_id" a b + | Literal_chain_id _, _ -> fail @@ different_literals_because_different_types "chain_id vs non-chain_id" a b + +let rec assert_value_eq (a, b: (expression * expression )) : unit result = + Format.printf "in assert_value_eq %a %a\n%!" PP.expression a PP.expression b; + let error_content () = + Format.asprintf "\n@[- %a@;- %a]" PP.expression a PP.expression b + in + trace (fun () -> error (thunk "not equal") error_content ()) @@ + match (a.expression_content , b.expression_content) with + | E_literal a , E_literal b -> + assert_literal_eq (a, b) + | E_literal _ , _ -> + simple_fail "comparing a literal with not a literal" + | E_constant (ca) , E_constant (cb) when ca.cons_name = cb.cons_name -> ( + let%bind lst = + generic_try (simple_error "constants with different number of elements") + (fun () -> List.combine ca.arguments cb.arguments) in + let%bind _all = bind_list @@ List.map assert_value_eq lst in + ok () + ) + | E_constant _ , E_constant _ -> + simple_fail "different constants" + | E_constant _ , _ -> + let error_content () = + Format.asprintf "%a vs %a" + PP.expression a + PP.expression b + in + fail @@ (fun () -> error (thunk "comparing constant with other expression") error_content ()) + + | E_constructor (ca), E_constructor (cb) when ca.constructor = cb.constructor -> ( + let%bind _eq = assert_value_eq (ca.element, cb.element) in + ok () + ) + | E_constructor _, E_constructor _ -> + simple_fail "different constructors" + | E_constructor _, _ -> + simple_fail "comparing constructor with other expression" + + + | E_record sma, E_record smb -> ( + let aux _ a b = + match a, b with + | Some a, Some b -> Some (assert_value_eq (a, b)) + | _ -> Some (simple_fail "different record keys") + in + let%bind _all = bind_lmap @@ LMap.merge aux sma smb in + ok () + ) + | E_record _, _ -> + simple_fail "comparing record with other expression" + + | E_record_update ura, E_record_update urb -> + let _ = + generic_try (simple_error "Updating different record") @@ + fun () -> assert_value_eq (ura.record, urb.record) in + let aux (Label a,Label b) = + assert (String.equal a b) + in + let () = aux (ura.path, urb.path) in + let%bind () = assert_value_eq (ura.update,urb.update) in + ok () + | E_record_update _, _ -> + simple_fail "comparing record update with other expression" + + | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> ( + let%bind lst = generic_try (simple_error "maps of different lengths") + (fun () -> + let lsta' = List.sort compare lsta in + let lstb' = List.sort compare lstb in + List.combine lsta' lstb') in + let aux = fun ((ka, va), (kb, vb)) -> + let%bind _ = assert_value_eq (ka, kb) in + let%bind _ = assert_value_eq (va, vb) in + ok () in + let%bind _all = bind_map_list aux lst in + ok () + ) + | (E_map _ | E_big_map _), _ -> + simple_fail "comparing map with other expression" + + | E_list lsta, E_list lstb -> ( + let%bind lst = + generic_try (simple_error "list of different lengths") + (fun () -> List.combine lsta lstb) in + let%bind _all = bind_map_list assert_value_eq lst in + ok () + ) + | E_list _, _ -> + simple_fail "comparing list with other expression" + + | 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 expression" + + | (E_ascription a , _b') -> assert_value_eq (a.anno_expr , b) + | (_a' , E_ascription b) -> assert_value_eq (a , b.anno_expr) + | (E_variable _, _) | (E_lambda _, _) + | (E_application _, _) | (E_let_in _, _) + | (E_recursive _,_) | (E_record_accessor _, _) + | (E_look_up _, _) | (E_matching _, _) + | (E_sequence _, _) | (E_skip, _) -> simple_fail "comparing not a value" + +let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b) + +(* module Rename = struct + * open Trace + * + * module Type = struct + * (\* Type renaming, not needed. Yet. *\) + * end + * + * module Value = struct + * type renaming = string * (string * access_path) (\* src -> dst *\) + * type renamings = renaming list + * let filter (r:renamings) (s:string) : renamings = + * List.filter (fun (x, _) -> not (x = s)) r + * let filters (r:renamings) (ss:string list) : renamings = + * List.filter (fun (x, _) -> not (List.mem x ss)) r + * + * let rec rename_instruction (r:renamings) (i:instruction) : instruction result = + * match i with + * | I_assignment ({name;annotated_expression = e} as a) -> ( + * match List.assoc_opt name r with + * | None -> + * let%bind annotated_expression = rename_annotated_expression (filter r name) e in + * ok (I_assignment {a with annotated_expression}) + * | Some (name', lst) -> ( + * let%bind annotated_expression = rename_annotated_expression r e in + * match lst with + * | [] -> ok (I_assignment {name = name' ; annotated_expression}) + * | lst -> + * let (hds, tl) = + * let open List in + * let r = rev lst in + * rev @@ tl r, hd r + * in + * let%bind tl' = match tl with + * | Access_record n -> ok n + * | Access_tuple _ -> simple_fail "no support for renaming into tuples yet" in + * ok (I_record_patch (name', hds, [tl', annotated_expression])) + * ) + * ) + * | I_skip -> ok I_skip + * | I_fail e -> + * let%bind e' = rename_annotated_expression r e in + * ok (I_fail e') + * | I_loop (cond, body) -> + * let%bind cond' = rename_annotated_expression r cond in + * let%bind body' = rename_block r body in + * ok (I_loop (cond', body')) + * | I_matching (ae, m) -> + * let%bind ae' = rename_annotated_expression r ae in + * let%bind m' = rename_matching rename_block r m in + * ok (I_matching (ae', m')) + * | I_record_patch (v, path, lst) -> + * let aux (x, y) = + * let%bind y' = rename_annotated_expression (filter r v) y in + * ok (x, y') in + * let%bind lst' = bind_map_list aux lst in + * match List.assoc_opt v r with + * | None -> ( + * ok (I_record_patch (v, path, lst')) + * ) + * | Some (v', path') -> ( + * ok (I_record_patch (v', path' @ path, lst')) + * ) + * and rename_block (r:renamings) (bl:block) : block result = + * bind_map_list (rename_instruction r) bl + * + * and rename_matching : type a . (renamings -> a -> a result) -> renamings -> a matching -> a matching result = + * fun f r m -> + * match m with + * | Match_bool { match_true = mt ; match_false = mf } -> + * let%bind match_true = f r mt in + * let%bind match_false = f r mf in + * ok (Match_bool {match_true ; match_false}) + * | Match_option { match_none = mn ; match_some = (some, ms) } -> + * let%bind match_none = f r mn in + * let%bind ms' = f (filter r some) ms in + * ok (Match_option {match_none ; match_some = (some, ms')}) + * | Match_list { match_nil = mn ; match_cons = (hd, tl, mc) } -> + * let%bind match_nil = f r mn in + * let%bind mc' = f (filters r [hd;tl]) mc in + * ok (Match_list {match_nil ; match_cons = (hd, tl, mc')}) + * | Match_tuple (lst, body) -> + * let%bind body' = f (filters r lst) body in + * ok (Match_tuple (lst, body')) + * + * and rename_matching_instruction = fun x -> rename_matching rename_block x + * + * and rename_matching_expr = fun x -> rename_matching rename_expression x + * + * and rename_annotated_expression (r:renamings) (ae:annotated_expression) : annotated_expression result = + * let%bind expression = rename_expression r ae.expression in + * ok {ae with expression} + * + * and rename_expression : renamings -> expression -> expression result = fun r e -> + * match e with + * | E_literal _ as l -> ok l + * | E_constant (name, lst) -> + * let%bind lst' = bind_map_list (rename_annotated_expression r) lst in + * ok (E_constant (name, lst')) + * | E_constructor (name, ae) -> + * let%bind ae' = rename_annotated_expression r ae in + * ok (E_constructor (name, ae')) + * | E_variable v -> ( + * match List.assoc_opt v r with + * | None -> ok (E_variable v) + * | Some (name, path) -> ok (E_accessor (ae (E_variable (name)), path)) + * ) + * | E_lambda ({binder;body;result} as l) -> + * let r' = filter r binder in + * let%bind body = rename_block r' body in + * let%bind result = rename_annotated_expression r' result in + * ok (E_lambda {l with body ; result}) + * | E_application (f, arg) -> + * let%bind f' = rename_annotated_expression r f in + * let%bind arg' = rename_annotated_expression r arg in + * ok (E_application (f', arg')) + * | E_tuple lst -> + * let%bind lst' = bind_map_list (rename_annotated_expression r) lst in + * ok (E_tuple lst') + * | E_accessor (ae, p) -> + * let%bind ae' = rename_annotated_expression r ae in + * ok (E_accessor (ae', p)) + * | E_record sm -> + * let%bind sm' = bind_smap + * @@ SMap.map (rename_annotated_expression r) sm in + * ok (E_record sm') + * | E_map m -> + * let%bind m' = bind_map_list + * (fun (x, y) -> bind_map_pair (rename_annotated_expression r) (x, y)) m in + * ok (E_map m') + * | E_list lst -> + * let%bind lst' = bind_map_list (rename_annotated_expression r) lst in + * ok (E_list lst') + * | E_look_up m -> + * let%bind m' = bind_map_pair (rename_annotated_expression r) m in + * ok (E_look_up m') + * | E_matching (ae, m) -> + * let%bind ae' = rename_annotated_expression r ae in + * let%bind m' = rename_matching rename_annotated_expression r m in + * ok (E_matching (ae', m')) + * end + * end *) diff --git a/src/stages/ast_simplified/misc.mli b/src/stages/1-ast_imperative/misc.mli similarity index 100% rename from src/stages/ast_simplified/misc.mli rename to src/stages/1-ast_imperative/misc.mli diff --git a/src/stages/1-ast_imperative/types.ml b/src/stages/1-ast_imperative/types.ml new file mode 100644 index 000000000..4d0d0bd68 --- /dev/null +++ b/src/stages/1-ast_imperative/types.ml @@ -0,0 +1,126 @@ +[@@@warning "-30"] + +module Location = Simple_utils.Location + +module Ast_imperative_parameter = struct + type type_meta = unit +end + +include Stage_common.Types + +(*include Ast_generic_type(Ast_core_parameter) +*) +include Ast_generic_type (Ast_imperative_parameter) + +type inline = bool +type program = declaration Location.wrap list +and declaration = + | Declaration_type of (type_variable * type_expression) + + (* A Declaration_constant is described by + * a name + * an optional type annotation + * a boolean indicating whether it should be inlined + * an expression *) + | Declaration_constant of (expression_variable * type_expression option * inline * expression) + +(* | Macro_declaration of macro_declaration *) +and expression = {expression_content: expression_content; location: Location.t} + +and expression_content = + (* Base *) + | E_literal of literal + | E_constant of constant (* For language constants, like (Cons hd tl) or (plus i j) *) + | E_variable of expression_variable + | E_application of application + | E_lambda of lambda + | E_recursive of recursive + | E_let_in of let_in + (* Variant *) + | E_constructor of constructor (* For user defined constructors *) + | E_matching of matching + (* Record *) + | E_record of expression label_map + | E_record_accessor of accessor + | E_record_update of update + (* Advanced *) + | E_ascription of ascription + (* Sugar *) + | E_sequence of sequence + | E_skip + (* Data Structures *) + | E_map of (expression * expression) list + | E_big_map of (expression * expression) list + | E_list of expression list + | E_set of expression list + | E_look_up of (expression * expression) + +and constant = + { cons_name: constant' (* this is at the end because it is huge *) + ; arguments: expression list } + +and application = { + lamb: expression ; + args: expression ; + } + +and lambda = + { binder: expression_variable + ; input_type: type_expression option + ; output_type: type_expression option + ; result: expression } + +and recursive = { + fun_name : expression_variable; + fun_type : type_expression; + lambda : lambda; +} + +and let_in = + { let_binder: expression_variable * type_expression option + ; mut: bool + ; rhs: expression + ; let_result: expression + ; inline: bool } + +and constructor = {constructor: constructor'; element: expression} + +and accessor = {expr: expression; label: label} + +and update = {record: expression; path: label ; update: expression} + +and matching_expr = (expr,unit) matching_content +and matching = + { matchee: expression + ; cases: matching_expr + } + +and ascription = {anno_expr: expression; type_annotation: type_expression} +and sequence = { + expr1: expression ; + expr2: expression ; + } + +and environment_element_definition = + | ED_binder + | ED_declaration of (expression * free_variables) + +and free_variables = expression_variable list + +and environment_element = + { type_value: type_expression + ; source_environment: full_environment + ; definition: environment_element_definition } + +and environment = (expression_variable * environment_element) list + +and type_environment = (type_variable * type_expression) list + +(* SUBST ??? *) +and small_environment = environment * type_environment + +and full_environment = small_environment List.Ne.t + +and expr = expression + +and texpr = type_expression diff --git a/src/stages/2-ast_sugar/PP.ml b/src/stages/2-ast_sugar/PP.ml new file mode 100644 index 000000000..d4a4ead08 --- /dev/null +++ b/src/stages/2-ast_sugar/PP.ml @@ -0,0 +1,139 @@ +[@@@coverage exclude_file] +open Types +open Format +open PP_helpers + +include Stage_common.PP +include Ast_PP_type(Ast_sugar_parameter) + +let expression_variable ppf (ev : expression_variable) : unit = + fprintf ppf "%a" Var.pp ev + + +let rec expression ppf (e : expression) = + expression_content ppf e.expression_content +and expression_content ppf (ec : expression_content) = + match ec with + | E_literal l -> + literal ppf l + | E_variable n -> + fprintf ppf "%a" expression_variable n + | E_application {lamb;args} -> + fprintf ppf "(%a)@(%a)" expression lamb expression args + | E_constructor c -> + fprintf ppf "%a(%a)" constructor c.constructor expression c.element + | E_constant c -> + fprintf ppf "%a(%a)" constant c.cons_name (list_sep_d expression) + c.arguments + | E_record m -> + fprintf ppf "%a" (tuple_or_record_sep_expr expression) m + | E_record_accessor ra -> + fprintf ppf "%a.%a" expression ra.expr label ra.label + | E_record_update {record; path; update} -> + fprintf ppf "{ %a with { %a = %a } }" expression record label path expression update + | E_map m -> + fprintf ppf "map[%a]" (list_sep_d assoc_expression) m + | E_big_map m -> + fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m + | 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_lambda {binder; input_type; output_type; result} -> + fprintf ppf "lambda (%a:%a) : %a return %a" + expression_variable binder + (PP_helpers.option type_expression) + input_type + (PP_helpers.option type_expression) + output_type expression result + | E_recursive { fun_name; fun_type; lambda} -> + fprintf ppf "rec (%a:%a => %a )" + expression_variable fun_name + type_expression fun_type + expression_content (E_lambda lambda) + | E_matching {matchee; cases; _} -> + fprintf ppf "match %a with %a" expression matchee (matching expression) + cases + | E_let_in { let_binder ; rhs ; let_result; inline } -> + fprintf ppf "let %a = %a%a in %a" option_type_name let_binder expression rhs option_inline inline expression let_result + | E_sequence {expr1;expr2} -> + fprintf ppf "%a;\n%a" expression expr1 expression expr2 + | E_ascription {anno_expr; type_annotation} -> + fprintf ppf "%a : %a" expression anno_expr type_expression type_annotation + | E_skip -> + fprintf ppf "skip" + +and option_type_name ppf + ((n, ty_opt) : expression_variable * type_expression option) = + match ty_opt with + | None -> + fprintf ppf "%a" expression_variable n + | Some ty -> + fprintf ppf "%a : %a" expression_variable n type_expression ty + +and assoc_expression ppf : expr * expr -> unit = + fun (a, b) -> fprintf ppf "%a -> %a" expression a expression b + +and single_record_patch ppf ((p, expr) : label * expr) = + fprintf ppf "%a <- %a" label p expression expr + +and matching_variant_case : type a . (_ -> a -> unit) -> _ -> (constructor' * expression_variable) * a -> unit = + fun f ppf ((c,n),a) -> + fprintf ppf "| %a %a -> %a" constructor c expression_variable n f a + +and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matching_content -> unit = + fun f ppf m -> match m with + | Match_tuple ((lst, b), _) -> + fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b + | Match_variant (lst, _) -> + fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst + | Match_bool {match_true ; match_false} -> + fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false + | Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} -> + fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons + | Match_option {match_none ; match_some = (some, match_some, _)} -> + fprintf ppf "| None -> %a @.| Some %a -> %a" f match_none expression_variable some f match_some + +(* Shows the type expected for the matched value *) +and matching_type ppf m = match m with + | Match_tuple _ -> + fprintf ppf "tuple" + | Match_variant (lst, _) -> + fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst + | Match_bool _ -> + fprintf ppf "boolean" + | Match_list _ -> + fprintf ppf "list" + | Match_option _ -> + fprintf ppf "option" + +and matching_variant_case_type ppf ((c,n),_a) = + fprintf ppf "| %a %a" constructor c expression_variable n + +and option_mut ppf mut = + if mut then + fprintf ppf "[@mut]" + else + fprintf ppf "" + +and option_inline ppf inline = + if inline then + fprintf ppf "[@inline]" + else + fprintf ppf "" + +let declaration ppf (d : declaration) = + match d with + | Declaration_type (type_name, te) -> + fprintf ppf "type %a = %a" type_variable type_name type_expression te + | Declaration_constant (name, ty_opt, i, expr) -> + fprintf ppf "const %a = %a%a" option_type_name (name, ty_opt) expression + expr + option_inline i + +let program ppf (p : program) = + fprintf ppf "@[%a@]" + (list_sep declaration (tag "@;")) + (List.map Location.unwrap p) diff --git a/src/stages/2-ast_sugar/ast_sugar.ml b/src/stages/2-ast_sugar/ast_sugar.ml new file mode 100644 index 000000000..e9614490a --- /dev/null +++ b/src/stages/2-ast_sugar/ast_sugar.ml @@ -0,0 +1,8 @@ +include Types + +(* include Misc *) +include Combinators +module Types = Types +module Misc = Misc +module PP=PP +module Combinators = Combinators diff --git a/src/stages/2-ast_sugar/combinators.ml b/src/stages/2-ast_sugar/combinators.ml new file mode 100644 index 000000000..759d6fc55 --- /dev/null +++ b/src/stages/2-ast_sugar/combinators.ml @@ -0,0 +1,268 @@ +open Types +open Simple_utils.Trace +module Option = Simple_utils.Option + +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 + let bad_type_operator type_op = + let title () = Format.asprintf "bad type operator %a" (PP.type_operator PP.type_expression) type_op in + let message () = "" in + error title message +end +open Errors + +let make_t type_content = {type_content; type_meta = ()} + + +let tuple_to_record lst = + let aux (i,acc) el = (i+1,(string_of_int i, el)::acc) in + let (_, lst ) = List.fold_left aux (0,[]) lst in + lst + +let t_bool : type_expression = make_t @@ T_constant (TC_bool) +let t_string : type_expression = make_t @@ T_constant (TC_string) +let t_bytes : type_expression = make_t @@ T_constant (TC_bytes) +let t_int : type_expression = make_t @@ T_constant (TC_int) +let t_operation : type_expression = make_t @@ T_constant (TC_operation) +let t_nat : type_expression = make_t @@ T_constant (TC_nat) +let t_tez : type_expression = make_t @@ T_constant (TC_mutez) +let t_unit : type_expression = make_t @@ T_constant (TC_unit) +let t_address : type_expression = make_t @@ T_constant (TC_address) +let t_signature : type_expression = make_t @@ T_constant (TC_signature) +let t_key : type_expression = make_t @@ T_constant (TC_key) +let t_key_hash : type_expression = make_t @@ T_constant (TC_key_hash) +let t_timestamp : type_expression = make_t @@ T_constant (TC_timestamp) +let t_option o : type_expression = make_t @@ T_operator (TC_option o) +let t_list t : type_expression = make_t @@ T_operator (TC_list t) +let t_variable n : type_expression = make_t @@ T_variable (Var.of_name n) +let t_record_ez lst = + let lst = List.map (fun (k, v) -> (Label k, v)) lst in + let m = LMap.of_list lst in + make_t @@ T_record m +let t_record m : type_expression = + let lst = Map.String.to_kv_list m in + t_record_ez lst + +let t_pair (a , b) : type_expression = t_record_ez [("0",a) ; ("1",b)] +let t_tuple lst : type_expression = t_record_ez (tuple_to_record lst) + +let ez_t_sum (lst:(string * type_expression) list) : type_expression = + let aux prev (k, v) = CMap.add (Constructor k) v prev in + let map = List.fold_left aux CMap.empty lst in + make_t @@ T_sum map +let t_sum m : type_expression = + let lst = Map.String.to_kv_list m in + ez_t_sum lst + +let t_function type1 type2 : type_expression = make_t @@ T_arrow {type1; type2} +let t_map key value : type_expression = make_t @@ T_operator (TC_map (key, value)) +let t_big_map key value : type_expression = make_t @@ T_operator (TC_big_map (key , value)) +let t_set key : type_expression = make_t @@ T_operator (TC_set key) +let t_contract contract : type_expression = make_t @@ T_operator (TC_contract contract) + +(* TODO find a better way than using list*) +let t_operator op lst: type_expression result = + match op,lst with + | TC_set _ , [t] -> ok @@ t_set t + | TC_list _ , [t] -> ok @@ t_list t + | TC_option _ , [t] -> ok @@ t_option t + | TC_map (_,_) , [kt;vt] -> ok @@ t_map kt vt + | TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map kt vt + | TC_contract _ , [t] -> ok @@ t_contract t + | _ , _ -> fail @@ bad_type_operator op + +let make_expr ?(loc = Location.generated) expression_content = + let location = loc in + { expression_content; location } + +let e_var ?loc (n: string) : expression = make_expr ?loc @@ E_variable (Var.of_name n) +let e_literal ?loc l : expression = make_expr ?loc @@ E_literal l +let e_unit ?loc () : expression = make_expr ?loc @@ E_literal (Literal_unit) +let e_int ?loc n : expression = make_expr ?loc @@ E_literal (Literal_int n) +let e_nat ?loc n : expression = make_expr ?loc @@ E_literal (Literal_nat n) +let e_timestamp ?loc n : expression = make_expr ?loc @@ E_literal (Literal_timestamp n) +let e_bool ?loc b : expression = make_expr ?loc @@ E_literal (Literal_bool b) +let e_string ?loc s : expression = make_expr ?loc @@ E_literal (Literal_string s) +let e_address ?loc s : expression = make_expr ?loc @@ E_literal (Literal_address s) +let e_mutez ?loc s : expression = make_expr ?loc @@ E_literal (Literal_mutez s) +let e_signature ?loc s : expression = make_expr ?loc @@ E_literal (Literal_signature s) +let e_key ?loc s : expression = make_expr ?loc @@ E_literal (Literal_key s) +let e_key_hash ?loc s : expression = make_expr ?loc @@ E_literal (Literal_key_hash s) +let e_chain_id ?loc s : expression = make_expr ?loc @@ E_literal (Literal_chain_id s) +let e'_bytes b : expression_content result = + let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in + ok @@ E_literal (Literal_bytes bytes) +let e_bytes_hex ?loc b : expression result = + let%bind e' = e'_bytes b in + ok @@ make_expr ?loc e' +let e_bytes_raw ?loc (b: bytes) : expression = + make_expr ?loc @@ E_literal (Literal_bytes b) +let e_bytes_string ?loc (s: string) : expression = + make_expr ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s))) +let e_big_map ?loc lst : expression = make_expr ?loc @@ E_big_map lst +let e_some ?loc s : expression = make_expr ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]} +let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NONE; arguments = []} +let e_string_cat ?loc sl sr : expression = make_expr ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]} +let e_map_add ?loc k v old : expression = make_expr ?loc @@ E_constant {cons_name = C_MAP_ADD; arguments = [k ; v ; old]} +let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst +let e_set ?loc lst : expression = make_expr ?loc @@ E_set lst +let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst +let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a} +let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b} +let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c}) +let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {expr = a; label= Label b} +let e_accessor_list ?loc a b = List.fold_left (fun a b -> e_accessor ?loc a b) a b +let e_variable ?loc v = make_expr ?loc @@ E_variable v +let e_skip ?loc () = make_expr ?loc @@ E_skip +let e_let_in ?loc (binder, ascr) inline rhs let_result = + make_expr ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline } +let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty} +let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b} +let e_binop ?loc name a b = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]} +let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst} +let e_look_up ?loc x y = make_expr ?loc @@ E_look_up (x , y) +let e_sequence ?loc expr1 expr2 = make_expr ?loc @@ E_sequence {expr1; expr2} +let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false}) +(* +let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*) +*) +let ez_match_variant (lst : ((string * string) * 'a) list) = + let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in + Match_variant (lst,()) +let e_matching_variant ?loc a (lst : ((string * string)* 'a) list) = + e_matching ?loc a (ez_match_variant lst) +let e_record_ez ?loc (lst : (string * expr) list) : expression = + let map = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in + make_expr ?loc @@ E_record map +let e_record ?loc map = + let lst = Map.String.to_kv_list map in + e_record_ez ?loc lst + +let e_update ?loc record path update = + let path = Label path in + make_expr ?loc @@ E_record_update {record; path; update} + +let e_tuple ?loc lst : expression = e_record_ez ?loc (tuple_to_record lst) +let e_pair ?loc a b : expression = e_tuple ?loc [a;b] + +let make_option_typed ?loc e t_opt = + match t_opt with + | None -> e + | Some t -> e_annotation ?loc e t + + +let e_typed_none ?loc t_opt = + let type_annotation = t_option t_opt in + e_annotation ?loc (e_none ?loc ()) type_annotation + +let e_typed_list ?loc lst t = + e_annotation ?loc (e_list lst) (t_list t) + +let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v) +let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v) + +let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k) + + +let e_lambda ?loc (binder : expression_variable) + (input_type : type_expression option) + (output_type : type_expression option) + (result : expression) + : expression = + make_expr ?loc @@ E_lambda { + binder = binder ; + input_type = input_type ; + output_type = output_type ; + result ; + } +let e_recursive ?loc fun_name fun_type lambda = make_expr ?loc @@ E_recursive {fun_name; fun_type; lambda} + + +let e_assign_with_let ?loc var access_path expr = + let var = Var.of_name (var) in + match access_path with + | [] -> (var, None), true, expr, false + + | lst -> + let rec aux path record= match path with + | [] -> failwith "acces_path cannot be empty" + | [e] -> e_update ?loc record e expr + | elem::tail -> + let next_record = e_accessor record elem in + e_update ?loc record elem (aux tail next_record ) + in + (var, None), true, (aux lst (e_variable var)), false + +let get_e_accessor = fun t -> + match t with + | E_record_accessor {expr; label} -> ok (expr , label) + | _ -> simple_fail "not an accessor" + +let assert_e_accessor = fun t -> + let%bind _ = get_e_accessor t in + ok () + +let get_e_pair = fun t -> + match t with + | E_record r -> ( + let lst = LMap.to_kv_list r in + match lst with + | [(Label "O",a);(Label "1",b)] + | [(Label "1",b);(Label "0",a)] -> + ok (a , b) + | _ -> simple_fail "not a pair" + ) + | _ -> simple_fail "not a pair" + +let get_e_list = fun t -> + match t with + | E_list lst -> ok lst + | _ -> simple_fail "not a list" + +let tuple_of_record (m: _ LMap.t) = + let aux i = + let opt = LMap.find_opt (Label (string_of_int i)) m in + Option.bind (fun opt -> Some (opt,i+1)) opt + in + Base.Sequence.to_list @@ Base.Sequence.unfold ~init:0 ~f:aux + +let get_e_tuple = fun t -> + match t with + | E_record r -> ok @@ tuple_of_record r + | _ -> simple_fail "ast_core: get_e_tuple: not a tuple" + +(* Same as get_e_pair *) +let extract_pair : expression -> (expression * expression) result = fun e -> + match e.expression_content with + | E_record r -> ( + let lst = LMap.to_kv_list r in + match lst with + | [(Label "O",a);(Label "1",b)] + | [(Label "1",b);(Label "0",a)] -> + ok (a , b) + | _ -> fail @@ bad_kind "pair" e.location + ) + | _ -> fail @@ bad_kind "pair" e.location + +let extract_list : expression -> (expression list) result = fun e -> + match e.expression_content with + | E_list lst -> ok lst + | _ -> fail @@ bad_kind "list" e.location + +let extract_record : expression -> (label * expression) list result = fun e -> + match e.expression_content with + | E_record lst -> ok @@ LMap.to_kv_list lst + | _ -> fail @@ bad_kind "record" e.location + +let extract_map : expression -> (expression * expression) list result = fun e -> + match e.expression_content with + | E_map lst -> ok lst + | _ -> fail @@ bad_kind "map" e.location diff --git a/src/stages/2-ast_sugar/combinators.mli b/src/stages/2-ast_sugar/combinators.mli new file mode 100644 index 000000000..e9d3dd144 --- /dev/null +++ b/src/stages/2-ast_sugar/combinators.mli @@ -0,0 +1,135 @@ +open Types +open Simple_utils.Trace +(* +module Option = Simple_utils.Option + +module SMap = Map.String + +module Errors : sig + val bad_kind : name -> Location.t -> unit -> error +end +*) +val make_t : type_content -> type_expression +val t_bool : type_expression +val t_string : type_expression +val t_bytes : type_expression +val t_int : type_expression +val t_operation : type_expression +val t_nat : type_expression +val t_tez : type_expression +val t_unit : type_expression +val t_address : type_expression +val t_key : type_expression +val t_key_hash : type_expression +val t_timestamp : type_expression +val t_signature : type_expression +(* +val t_option : type_expression -> type_expression +*) +val t_list : type_expression -> type_expression +val t_variable : string -> type_expression +(* +val t_record : te_map -> type_expression +*) +val t_pair : ( type_expression * type_expression ) -> type_expression +val t_tuple : type_expression list -> type_expression + +val t_record : type_expression Map.String.t -> type_expression +val t_record_ez : (string * type_expression) list -> type_expression + +val t_sum : type_expression Map.String.t -> type_expression +val ez_t_sum : ( string * type_expression ) list -> type_expression + +val t_function : type_expression -> type_expression -> type_expression +val t_map : type_expression -> type_expression -> type_expression + +val t_operator : type_operator -> type_expression list -> type_expression result +val t_set : type_expression -> type_expression + +val make_expr : ?loc:Location.t -> expression_content -> expression +val e_var : ?loc:Location.t -> string -> expression +val e_literal : ?loc:Location.t -> literal -> expression +val e_unit : ?loc:Location.t -> unit -> expression +val e_int : ?loc:Location.t -> int -> expression +val e_nat : ?loc:Location.t -> int -> expression +val e_timestamp : ?loc:Location.t -> int -> expression +val e_bool : ?loc:Location.t -> bool -> expression +val e_string : ?loc:Location.t -> string -> expression +val e_address : ?loc:Location.t -> string -> expression +val e_signature : ?loc:Location.t -> string -> expression +val e_key : ?loc:Location.t -> string -> expression +val e_key_hash : ?loc:Location.t -> string -> expression +val e_chain_id : ?loc:Location.t -> string -> expression +val e_mutez : ?loc:Location.t -> int -> expression +val e'_bytes : string -> expression_content result +val e_bytes_hex : ?loc:Location.t -> string -> expression result +val e_bytes_raw : ?loc:Location.t -> bytes -> expression +val e_bytes_string : ?loc:Location.t -> string -> expression +val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression + +val e_record_ez : ?loc:Location.t -> ( string * expr ) list -> expression +val e_tuple : ?loc:Location.t -> expression list -> expression +val e_some : ?loc:Location.t -> expression -> expression +val e_none : ?loc:Location.t -> unit -> expression +val e_string_cat : ?loc:Location.t -> expression -> expression -> expression +val e_map_add : ?loc:Location.t -> expression -> expression -> expression -> expression +val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression +val e_set : ?loc:Location.t -> expression list -> expression +val e_list : ?loc:Location.t -> expression list -> expression +val e_pair : ?loc:Location.t -> expression -> expression -> expression +val e_constructor : ?loc:Location.t -> string -> expression -> expression +val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression +val e_matching_bool : ?loc:Location.t -> expression -> expression -> expression -> expression +val e_accessor : ?loc:Location.t -> expression -> string -> expression +val e_accessor_list : ?loc:Location.t -> expression -> string list -> expression +val e_variable : ?loc:Location.t -> expression_variable -> expression +val e_skip : ?loc:Location.t -> unit -> expression +val e_sequence : ?loc:Location.t -> expression -> expression -> expression +val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression +val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression +val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression +val e_application : ?loc:Location.t -> expression -> expression -> expression +val e_binop : ?loc:Location.t -> constant' -> expression -> expression -> expression +val e_constant : ?loc:Location.t -> constant' -> expression list -> expression +val e_look_up : ?loc:Location.t -> expression -> expression -> expression +val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content +val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression + +val make_option_typed : ?loc:Location.t -> expression -> type_expression option -> expression + +val e_typed_none : ?loc:Location.t -> type_expression -> expression + +val e_typed_list : ?loc:Location.t -> expression list -> type_expression -> expression + +val e_typed_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression +val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression + +val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression + +val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression +val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression +val e_record : ?loc:Location.t -> expr Map.String.t -> expression +val e_update : ?loc:Location.t -> expression -> string -> expression -> expression +val e_assign_with_let : ?loc:Location.t -> string -> string list -> expression -> ((expression_variable*type_expression option)*bool*expression*bool) + +(* +val get_e_accessor : expression' -> ( expression * access_path ) result +*) + +val assert_e_accessor : expression_content -> unit result + +val get_e_pair : expression_content -> ( expression * expression ) result + +val get_e_list : expression_content -> ( expression list ) result +val get_e_tuple : expression_content -> ( expression list ) result +(* +val get_e_failwith : expression -> expression result +val is_e_failwith : expression -> bool +*) +val extract_pair : expression -> ( expression * expression ) result + +val extract_list : expression -> (expression list) result + +val extract_record : expression -> (label * expression) list result + +val extract_map : expression -> (expression * expression) list result diff --git a/src/stages/ast_simplified/dune b/src/stages/2-ast_sugar/dune similarity index 75% rename from src/stages/ast_simplified/dune rename to src/stages/2-ast_sugar/dune index f6c961536..6f1ca6fef 100644 --- a/src/stages/ast_simplified/dune +++ b/src/stages/2-ast_sugar/dune @@ -1,6 +1,6 @@ (library - (name ast_simplified) - (public_name ligo.ast_simplified) + (name ast_sugar) + (public_name ligo.ast_sugar) (libraries simple-utils tezos-utils diff --git a/src/stages/2-ast_sugar/misc.ml b/src/stages/2-ast_sugar/misc.ml new file mode 100644 index 000000000..324529525 --- /dev/null +++ b/src/stages/2-ast_sugar/misc.ml @@ -0,0 +1,331 @@ +open Trace +open Types + +open Stage_common.Helpers +module Errors = struct + let different_literals_because_different_types name a b () = + let title () = "literals have different types: " ^ name in + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "%a" PP.literal a) ; + ("b" , fun () -> Format.asprintf "%a" PP.literal b ) + ] in + error ~data title message () + + let different_literals name a b () = + let title () = name ^ " are different" in + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "%a" PP.literal a) ; + ("b" , fun () -> Format.asprintf "%a" PP.literal b ) + ] in + error ~data title message () + + let error_uncomparable_literals name a b () = + let title () = name ^ " are not comparable" in + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "%a" PP.literal a) ; + ("b" , fun () -> Format.asprintf "%a" PP.literal b ) + ] in + error ~data title message () +end +open Errors + +let assert_literal_eq (a, b : literal * literal) : unit result = + match (a, b) with + | Literal_bool a, Literal_bool b when a = b -> ok () + | Literal_bool _, Literal_bool _ -> fail @@ different_literals "different bools" a b + | Literal_bool _, _ -> fail @@ different_literals_because_different_types "bool vs non-bool" a b + | Literal_int a, Literal_int b when a = b -> ok () + | Literal_int _, Literal_int _ -> fail @@ different_literals "different ints" a b + | Literal_int _, _ -> fail @@ different_literals_because_different_types "int vs non-int" a b + | Literal_nat a, Literal_nat b when a = b -> ok () + | 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_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_mutez a, Literal_mutez b when a = b -> ok () + | Literal_mutez _, Literal_mutez _ -> fail @@ different_literals "different tezs" a b + | Literal_mutez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b + | Literal_string a, Literal_string b when a = b -> ok () + | Literal_string _, Literal_string _ -> fail @@ different_literals "different strings" a b + | Literal_string _, _ -> fail @@ different_literals_because_different_types "string vs non-string" a b + | Literal_bytes a, Literal_bytes b when a = b -> ok () + | Literal_bytes _, Literal_bytes _ -> fail @@ different_literals "different bytess" a b + | Literal_bytes _, _ -> fail @@ different_literals_because_different_types "bytes vs non-bytes" a b + | Literal_void, Literal_void -> ok () + | Literal_void, _ -> fail @@ different_literals_because_different_types "void vs non-void" a b + | Literal_unit, Literal_unit -> ok () + | Literal_unit, _ -> fail @@ different_literals_because_different_types "unit vs non-unit" a b + | Literal_address a, Literal_address b when a = b -> ok () + | Literal_address _, Literal_address _ -> fail @@ different_literals "different addresss" a b + | Literal_address _, _ -> fail @@ different_literals_because_different_types "address vs non-address" 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_signature a, Literal_signature b when a = b -> ok () + | Literal_signature _, Literal_signature _ -> fail @@ different_literals "different signature" a b + | Literal_signature _, _ -> fail @@ different_literals_because_different_types "signature vs non-signature" a b + | Literal_key a, Literal_key b when a = b -> ok () + | Literal_key _, Literal_key _ -> fail @@ different_literals "different key" a b + | Literal_key _, _ -> fail @@ different_literals_because_different_types "key vs non-key" a b + | Literal_key_hash a, Literal_key_hash b when a = b -> ok () + | Literal_key_hash _, Literal_key_hash _ -> fail @@ different_literals "different key_hash" a b + | Literal_key_hash _, _ -> fail @@ different_literals_because_different_types "key_hash vs non-key_hash" a b + | Literal_chain_id a, Literal_chain_id b when a = b -> ok () + | Literal_chain_id _, Literal_chain_id _ -> fail @@ different_literals "different chain_id" a b + | Literal_chain_id _, _ -> fail @@ different_literals_because_different_types "chain_id vs non-chain_id" a b + +let rec assert_value_eq (a, b: (expression * expression )) : unit result = + Format.printf "in assert_value_eq %a %a\n%!" PP.expression a PP.expression b; + let error_content () = + Format.asprintf "\n@[- %a@;- %a]" PP.expression a PP.expression b + in + trace (fun () -> error (thunk "not equal") error_content ()) @@ + match (a.expression_content , b.expression_content) with + | E_literal a , E_literal b -> + assert_literal_eq (a, b) + | E_literal _ , _ -> + simple_fail "comparing a literal with not a literal" + | E_constant (ca) , E_constant (cb) when ca.cons_name = cb.cons_name -> ( + let%bind lst = + generic_try (simple_error "constants with different number of elements") + (fun () -> List.combine ca.arguments cb.arguments) in + let%bind _all = bind_list @@ List.map assert_value_eq lst in + ok () + ) + | E_constant _ , E_constant _ -> + simple_fail "different constants" + | E_constant _ , _ -> + let error_content () = + Format.asprintf "%a vs %a" + PP.expression a + PP.expression b + in + fail @@ (fun () -> error (thunk "comparing constant with other expression") error_content ()) + + | E_constructor (ca), E_constructor (cb) when ca.constructor = cb.constructor -> ( + let%bind _eq = assert_value_eq (ca.element, cb.element) in + ok () + ) + | E_constructor _, E_constructor _ -> + simple_fail "different constructors" + | E_constructor _, _ -> + simple_fail "comparing constructor with other expression" + + + | E_record sma, E_record smb -> ( + let aux _ a b = + match a, b with + | Some a, Some b -> Some (assert_value_eq (a, b)) + | _ -> Some (simple_fail "different record keys") + in + let%bind _all = bind_lmap @@ LMap.merge aux sma smb in + ok () + ) + | E_record _, _ -> + simple_fail "comparing record with other expression" + + | E_record_update ura, E_record_update urb -> + let _ = + generic_try (simple_error "Updating different record") @@ + fun () -> assert_value_eq (ura.record, urb.record) in + let aux (Label a,Label b) = + assert (String.equal a b) + in + let () = aux (ura.path, urb.path) in + let%bind () = assert_value_eq (ura.update,urb.update) in + ok () + | E_record_update _, _ -> + simple_fail "comparing record update with other expression" + + | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> ( + let%bind lst = generic_try (simple_error "maps of different lengths") + (fun () -> + let lsta' = List.sort compare lsta in + let lstb' = List.sort compare lstb in + List.combine lsta' lstb') in + let aux = fun ((ka, va), (kb, vb)) -> + let%bind _ = assert_value_eq (ka, kb) in + let%bind _ = assert_value_eq (va, vb) in + ok () in + let%bind _all = bind_map_list aux lst in + ok () + ) + | (E_map _ | E_big_map _), _ -> + simple_fail "comparing map with other expression" + + | E_list lsta, E_list lstb -> ( + let%bind lst = + generic_try (simple_error "list of different lengths") + (fun () -> List.combine lsta lstb) in + let%bind _all = bind_map_list assert_value_eq lst in + ok () + ) + | E_list _, _ -> + simple_fail "comparing list with other expression" + + | 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 expression" + + | (E_ascription a , _b') -> assert_value_eq (a.anno_expr , b) + | (_a' , E_ascription b) -> assert_value_eq (a , b.anno_expr) + | (E_variable _, _) | (E_lambda _, _) + | (E_application _, _) | (E_let_in _, _) + | (E_recursive _,_) | (E_record_accessor _, _) + | (E_look_up _, _) | (E_matching _, _) + | (E_sequence _, _) | (E_skip, _) -> simple_fail "comparing not a value" + +let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b) + +(* module Rename = struct + * open Trace + * + * module Type = struct + * (\* Type renaming, not needed. Yet. *\) + * end + * + * module Value = struct + * type renaming = string * (string * access_path) (\* src -> dst *\) + * type renamings = renaming list + * let filter (r:renamings) (s:string) : renamings = + * List.filter (fun (x, _) -> not (x = s)) r + * let filters (r:renamings) (ss:string list) : renamings = + * List.filter (fun (x, _) -> not (List.mem x ss)) r + * + * let rec rename_instruction (r:renamings) (i:instruction) : instruction result = + * match i with + * | I_assignment ({name;annotated_expression = e} as a) -> ( + * match List.assoc_opt name r with + * | None -> + * let%bind annotated_expression = rename_annotated_expression (filter r name) e in + * ok (I_assignment {a with annotated_expression}) + * | Some (name', lst) -> ( + * let%bind annotated_expression = rename_annotated_expression r e in + * match lst with + * | [] -> ok (I_assignment {name = name' ; annotated_expression}) + * | lst -> + * let (hds, tl) = + * let open List in + * let r = rev lst in + * rev @@ tl r, hd r + * in + * let%bind tl' = match tl with + * | Access_record n -> ok n + * | Access_tuple _ -> simple_fail "no support for renaming into tuples yet" in + * ok (I_record_patch (name', hds, [tl', annotated_expression])) + * ) + * ) + * | I_skip -> ok I_skip + * | I_fail e -> + * let%bind e' = rename_annotated_expression r e in + * ok (I_fail e') + * | I_loop (cond, body) -> + * let%bind cond' = rename_annotated_expression r cond in + * let%bind body' = rename_block r body in + * ok (I_loop (cond', body')) + * | I_matching (ae, m) -> + * let%bind ae' = rename_annotated_expression r ae in + * let%bind m' = rename_matching rename_block r m in + * ok (I_matching (ae', m')) + * | I_record_patch (v, path, lst) -> + * let aux (x, y) = + * let%bind y' = rename_annotated_expression (filter r v) y in + * ok (x, y') in + * let%bind lst' = bind_map_list aux lst in + * match List.assoc_opt v r with + * | None -> ( + * ok (I_record_patch (v, path, lst')) + * ) + * | Some (v', path') -> ( + * ok (I_record_patch (v', path' @ path, lst')) + * ) + * and rename_block (r:renamings) (bl:block) : block result = + * bind_map_list (rename_instruction r) bl + * + * and rename_matching : type a . (renamings -> a -> a result) -> renamings -> a matching -> a matching result = + * fun f r m -> + * match m with + * | Match_bool { match_true = mt ; match_false = mf } -> + * let%bind match_true = f r mt in + * let%bind match_false = f r mf in + * ok (Match_bool {match_true ; match_false}) + * | Match_option { match_none = mn ; match_some = (some, ms) } -> + * let%bind match_none = f r mn in + * let%bind ms' = f (filter r some) ms in + * ok (Match_option {match_none ; match_some = (some, ms')}) + * | Match_list { match_nil = mn ; match_cons = (hd, tl, mc) } -> + * let%bind match_nil = f r mn in + * let%bind mc' = f (filters r [hd;tl]) mc in + * ok (Match_list {match_nil ; match_cons = (hd, tl, mc')}) + * | Match_tuple (lst, body) -> + * let%bind body' = f (filters r lst) body in + * ok (Match_tuple (lst, body')) + * + * and rename_matching_instruction = fun x -> rename_matching rename_block x + * + * and rename_matching_expr = fun x -> rename_matching rename_expression x + * + * and rename_annotated_expression (r:renamings) (ae:annotated_expression) : annotated_expression result = + * let%bind expression = rename_expression r ae.expression in + * ok {ae with expression} + * + * and rename_expression : renamings -> expression -> expression result = fun r e -> + * match e with + * | E_literal _ as l -> ok l + * | E_constant (name, lst) -> + * let%bind lst' = bind_map_list (rename_annotated_expression r) lst in + * ok (E_constant (name, lst')) + * | E_constructor (name, ae) -> + * let%bind ae' = rename_annotated_expression r ae in + * ok (E_constructor (name, ae')) + * | E_variable v -> ( + * match List.assoc_opt v r with + * | None -> ok (E_variable v) + * | Some (name, path) -> ok (E_accessor (ae (E_variable (name)), path)) + * ) + * | E_lambda ({binder;body;result} as l) -> + * let r' = filter r binder in + * let%bind body = rename_block r' body in + * let%bind result = rename_annotated_expression r' result in + * ok (E_lambda {l with body ; result}) + * | E_application (f, arg) -> + * let%bind f' = rename_annotated_expression r f in + * let%bind arg' = rename_annotated_expression r arg in + * ok (E_application (f', arg')) + * | E_tuple lst -> + * let%bind lst' = bind_map_list (rename_annotated_expression r) lst in + * ok (E_tuple lst') + * | E_accessor (ae, p) -> + * let%bind ae' = rename_annotated_expression r ae in + * ok (E_accessor (ae', p)) + * | E_record sm -> + * let%bind sm' = bind_smap + * @@ SMap.map (rename_annotated_expression r) sm in + * ok (E_record sm') + * | E_map m -> + * let%bind m' = bind_map_list + * (fun (x, y) -> bind_map_pair (rename_annotated_expression r) (x, y)) m in + * ok (E_map m') + * | E_list lst -> + * let%bind lst' = bind_map_list (rename_annotated_expression r) lst in + * ok (E_list lst') + * | E_look_up m -> + * let%bind m' = bind_map_pair (rename_annotated_expression r) m in + * ok (E_look_up m') + * | E_matching (ae, m) -> + * let%bind ae' = rename_annotated_expression r ae in + * let%bind m' = rename_matching rename_annotated_expression r m in + * ok (E_matching (ae', m')) + * end + * end *) diff --git a/src/stages/2-ast_sugar/misc.mli b/src/stages/2-ast_sugar/misc.mli new file mode 100644 index 000000000..0784d109c --- /dev/null +++ b/src/stages/2-ast_sugar/misc.mli @@ -0,0 +1,20 @@ +open Trace +open Types + + +(* + +module Errors : sig + val different_literals_because_different_types : name -> literal -> literal -> unit -> error + + val different_literals : name -> literal -> literal -> unit -> error + + val error_uncomparable_literals : name -> literal -> literal -> unit -> error +end + +val assert_literal_eq : ( literal * literal ) -> unit result +*) + +val assert_value_eq : ( expression * expression ) -> unit result + +val is_value_eq : ( expression * expression ) -> bool diff --git a/src/stages/2-ast_sugar/types.ml b/src/stages/2-ast_sugar/types.ml new file mode 100644 index 000000000..81091dea7 --- /dev/null +++ b/src/stages/2-ast_sugar/types.ml @@ -0,0 +1,125 @@ +[@@@warning "-30"] + +module Location = Simple_utils.Location + +module Ast_sugar_parameter = struct + type type_meta = unit +end + +include Stage_common.Types + +(*include Ast_generic_type(Ast_core_parameter) +*) +include Ast_generic_type (Ast_sugar_parameter) + +type inline = bool +type program = declaration Location.wrap list +and declaration = + | Declaration_type of (type_variable * type_expression) + + (* A Declaration_constant is described by + * a name + * an optional type annotation + * a boolean indicating whether it should be inlined + * an expression *) + | Declaration_constant of (expression_variable * type_expression option * inline * expression) + +(* | Macro_declaration of macro_declaration *) +and expression = {expression_content: expression_content; location: Location.t} + +and expression_content = + (* Base *) + | E_literal of literal + | E_constant of constant (* For language constants, like (Cons hd tl) or (plus i j) *) + | E_variable of expression_variable + | E_application of application + | E_lambda of lambda + | E_recursive of recursive + | E_let_in of let_in + (* Variant *) + | E_constructor of constructor (* For user defined constructors *) + | E_matching of matching + (* Record *) + | E_record of expression label_map + | E_record_accessor of accessor + | E_record_update of update + (* Advanced *) + | E_ascription of ascription + (* Sugar *) + | E_sequence of sequence + | E_skip + (* Data Structures *) + | E_map of (expression * expression) list + | E_big_map of (expression * expression) list + | E_list of expression list + | E_set of expression list + | E_look_up of (expression * expression) + +and constant = + { cons_name: constant' (* this is at the end because it is huge *) + ; arguments: expression list } + +and application = { + lamb: expression ; + args: expression ; + } + +and lambda = + { binder: expression_variable + ; input_type: type_expression option + ; output_type: type_expression option + ; result: expression } + +and recursive = { + fun_name : expression_variable; + fun_type : type_expression; + lambda : lambda; +} + +and let_in = + { let_binder: expression_variable * type_expression option + ; rhs: expression + ; let_result: expression + ; inline: bool } + +and constructor = {constructor: constructor'; element: expression} + +and accessor = {expr: expression; label: label} + +and update = {record: expression; path: label ; update: expression} + +and matching_expr = (expr,unit) matching_content +and matching = + { matchee: expression + ; cases: matching_expr + } + +and ascription = {anno_expr: expression; type_annotation: type_expression} +and sequence = { + expr1: expression ; + expr2: expression ; + } + +and environment_element_definition = + | ED_binder + | ED_declaration of (expression * free_variables) + +and free_variables = expression_variable list + +and environment_element = + { type_value: type_expression + ; source_environment: full_environment + ; definition: environment_element_definition } + +and environment = (expression_variable * environment_element) list + +and type_environment = (type_variable * type_expression) list + +(* SUBST ??? *) +and small_environment = environment * type_environment + +and full_environment = small_environment List.Ne.t + +and expr = expression + +and texpr = type_expression diff --git a/src/stages/3-ast_core/PP.ml b/src/stages/3-ast_core/PP.ml new file mode 100644 index 000000000..3410a96fb --- /dev/null +++ b/src/stages/3-ast_core/PP.ml @@ -0,0 +1,136 @@ +[@@@coverage exclude_file] +open Types +open Format +open PP_helpers + +include Stage_common.PP +include Ast_PP_type(Ast_core_parameter) + +let expression_variable ppf (ev : expression_variable) : unit = + fprintf ppf "%a" Var.pp ev + + +let rec expression ppf (e : expression) = + expression_content ppf e.expression_content +and expression_content ppf (ec : expression_content) = + match ec with + | E_literal l -> + literal ppf l + | E_variable n -> + fprintf ppf "%a" expression_variable n + | E_application {lamb;args} -> + fprintf ppf "(%a)@(%a)" expression lamb expression args + | E_constructor c -> + fprintf ppf "%a(%a)" constructor c.constructor expression c.element + | E_constant c -> + fprintf ppf "%a(%a)" constant c.cons_name (list_sep_d expression) + c.arguments + | E_record m -> + fprintf ppf "%a" (tuple_or_record_sep_expr expression) m + | E_record_accessor ra -> + fprintf ppf "%a.%a" expression ra.expr label ra.label + | E_record_update {record; path; update} -> + fprintf ppf "{ %a with { %a = %a } }" expression record label path expression update + | E_map m -> + fprintf ppf "map[%a]" (list_sep_d assoc_expression) m + | E_big_map m -> + fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m + | 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_lambda {binder; input_type; output_type; result} -> + fprintf ppf "lambda (%a:%a) : %a return %a" + expression_variable binder + (PP_helpers.option type_expression) + input_type + (PP_helpers.option type_expression) + output_type expression result + | E_recursive { fun_name; fun_type; lambda} -> + fprintf ppf "rec (%a:%a => %a )" + expression_variable fun_name + type_expression fun_type + expression_content (E_lambda lambda) + | E_matching {matchee; cases; _} -> + fprintf ppf "match %a with %a" expression matchee (matching expression) + cases + | E_let_in { let_binder ;rhs ; let_result; inline } -> + fprintf ppf "let %a = %a%a in %a" option_type_name let_binder expression rhs option_inline inline expression let_result + | E_ascription {anno_expr; type_annotation} -> + fprintf ppf "%a : %a" expression anno_expr type_expression + type_annotation + +and option_type_name ppf + ((n, ty_opt) : expression_variable * type_expression option) = + match ty_opt with + | None -> + fprintf ppf "%a" expression_variable n + | Some ty -> + fprintf ppf "%a : %a" expression_variable n type_expression ty + +and assoc_expression ppf : expr * expr -> unit = + fun (a, b) -> fprintf ppf "%a -> %a" expression a expression b + +and single_record_patch ppf ((p, expr) : label * expr) = + fprintf ppf "%a <- %a" label p expression expr + +and matching_variant_case : type a . (_ -> a -> unit) -> _ -> (constructor' * expression_variable) * a -> unit = + fun f ppf ((c,n),a) -> + fprintf ppf "| %a %a -> %a" constructor c expression_variable n f a + +and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matching_content -> unit = + fun f ppf m -> match m with + | Match_tuple ((lst, b), _) -> + fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b + | Match_variant (lst, _) -> + fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst + | Match_bool {match_true ; match_false} -> + fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false + | Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} -> + fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons + | Match_option {match_none ; match_some = (some, match_some, _)} -> + fprintf ppf "| None -> %a @.| Some %a -> %a" f match_none expression_variable some f match_some + +(* Shows the type expected for the matched value *) +and matching_type ppf m = match m with + | Match_tuple _ -> + fprintf ppf "tuple" + | Match_variant (lst, _) -> + fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst + | Match_bool _ -> + fprintf ppf "boolean" + | Match_list _ -> + fprintf ppf "list" + | Match_option _ -> + fprintf ppf "option" + +and matching_variant_case_type ppf ((c,n),_a) = + fprintf ppf "| %a %a" constructor c expression_variable n + +and option_mut ppf mut = + if mut then + fprintf ppf "[@mut]" + else + fprintf ppf "" + +and option_inline ppf inline = + if inline then + fprintf ppf "[@inline]" + else + fprintf ppf "" + +let declaration ppf (d : declaration) = + match d with + | Declaration_type (type_name, te) -> + fprintf ppf "type %a = %a" type_variable type_name type_expression te + | Declaration_constant (name, ty_opt, i, expr) -> + fprintf ppf "const %a = %a%a" option_type_name (name, ty_opt) expression + expr + option_inline i + +let program ppf (p : program) = + fprintf ppf "@[%a@]" + (list_sep declaration (tag "@;")) + (List.map Location.unwrap p) diff --git a/src/stages/3-ast_core/ast_core.ml b/src/stages/3-ast_core/ast_core.ml new file mode 100644 index 000000000..e9614490a --- /dev/null +++ b/src/stages/3-ast_core/ast_core.ml @@ -0,0 +1,8 @@ +include Types + +(* include Misc *) +include Combinators +module Types = Types +module Misc = Misc +module PP=PP +module Combinators = Combinators diff --git a/src/stages/3-ast_core/combinators.ml b/src/stages/3-ast_core/combinators.ml new file mode 100644 index 000000000..db2417902 --- /dev/null +++ b/src/stages/3-ast_core/combinators.ml @@ -0,0 +1,266 @@ +open Types +open Simple_utils.Trace +module Option = Simple_utils.Option + +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 + let bad_type_operator type_op = + let title () = Format.asprintf "bad type operator %a" (PP.type_operator PP.type_expression) type_op in + let message () = "" in + error title message +end +open Errors + +let make_t type_content = {type_content; type_meta = ()} + + +let tuple_to_record lst = + let aux (i,acc) el = (i+1,(string_of_int i, el)::acc) in + let (_, lst ) = List.fold_left aux (0,[]) lst in + lst + +let t_bool : type_expression = make_t @@ T_constant (TC_bool) +let t_string : type_expression = make_t @@ T_constant (TC_string) +let t_bytes : type_expression = make_t @@ T_constant (TC_bytes) +let t_int : type_expression = make_t @@ T_constant (TC_int) +let t_operation : type_expression = make_t @@ T_constant (TC_operation) +let t_nat : type_expression = make_t @@ T_constant (TC_nat) +let t_tez : type_expression = make_t @@ T_constant (TC_mutez) +let t_unit : type_expression = make_t @@ T_constant (TC_unit) +let t_address : type_expression = make_t @@ T_constant (TC_address) +let t_signature : type_expression = make_t @@ T_constant (TC_signature) +let t_key : type_expression = make_t @@ T_constant (TC_key) +let t_key_hash : type_expression = make_t @@ T_constant (TC_key_hash) +let t_timestamp : type_expression = make_t @@ T_constant (TC_timestamp) +let t_option o : type_expression = make_t @@ T_operator (TC_option o) +let t_list t : type_expression = make_t @@ T_operator (TC_list t) +let t_variable n : type_expression = make_t @@ T_variable (Var.of_name n) +let t_record_ez lst = + let lst = List.map (fun (k, v) -> (Label k, v)) lst in + let m = LMap.of_list lst in + make_t @@ T_record m +let t_record m : type_expression = + let lst = Map.String.to_kv_list m in + t_record_ez lst + +let t_pair (a , b) : type_expression = t_record_ez [("0",a) ; ("1",b)] +let t_tuple lst : type_expression = t_record_ez (tuple_to_record lst) + +let ez_t_sum (lst:(string * type_expression) list) : type_expression = + let aux prev (k, v) = CMap.add (Constructor k) v prev in + let map = List.fold_left aux CMap.empty lst in + make_t @@ T_sum map +let t_sum m : type_expression = + let lst = Map.String.to_kv_list m in + ez_t_sum lst + +let t_function type1 type2 : type_expression = make_t @@ T_arrow {type1; type2} +let t_map key value : type_expression = make_t @@ T_operator (TC_map (key, value)) +let t_big_map key value : type_expression = make_t @@ T_operator (TC_big_map (key , value)) +let t_set key : type_expression = make_t @@ T_operator (TC_set key) +let t_contract contract : type_expression = make_t @@ T_operator (TC_contract contract) + +(* TODO find a better way than using list*) +let t_operator op lst: type_expression result = + match op,lst with + | TC_set _ , [t] -> ok @@ t_set t + | TC_list _ , [t] -> ok @@ t_list t + | TC_option _ , [t] -> ok @@ t_option t + | TC_map (_,_) , [kt;vt] -> ok @@ t_map kt vt + | TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map kt vt + | TC_contract _ , [t] -> ok @@ t_contract t + | _ , _ -> fail @@ bad_type_operator op + +let make_expr ?(loc = Location.generated) expression_content = + let location = loc in + { expression_content; location } + +let e_var ?loc (n: string) : expression = make_expr ?loc @@ E_variable (Var.of_name n) +let e_literal ?loc l : expression = make_expr ?loc @@ E_literal l +let e_unit ?loc () : expression = make_expr ?loc @@ E_literal (Literal_unit) +let e_int ?loc n : expression = make_expr ?loc @@ E_literal (Literal_int n) +let e_nat ?loc n : expression = make_expr ?loc @@ E_literal (Literal_nat n) +let e_timestamp ?loc n : expression = make_expr ?loc @@ E_literal (Literal_timestamp n) +let e_bool ?loc b : expression = make_expr ?loc @@ E_literal (Literal_bool b) +let e_string ?loc s : expression = make_expr ?loc @@ E_literal (Literal_string s) +let e_address ?loc s : expression = make_expr ?loc @@ E_literal (Literal_address s) +let e_mutez ?loc s : expression = make_expr ?loc @@ E_literal (Literal_mutez s) +let e_signature ?loc s : expression = make_expr ?loc @@ E_literal (Literal_signature s) +let e_key ?loc s : expression = make_expr ?loc @@ E_literal (Literal_key s) +let e_key_hash ?loc s : expression = make_expr ?loc @@ E_literal (Literal_key_hash s) +let e_chain_id ?loc s : expression = make_expr ?loc @@ E_literal (Literal_chain_id s) +let e'_bytes b : expression_content result = + let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in + ok @@ E_literal (Literal_bytes bytes) +let e_bytes_hex ?loc b : expression result = + let%bind e' = e'_bytes b in + ok @@ make_expr ?loc e' +let e_bytes_raw ?loc (b: bytes) : expression = + make_expr ?loc @@ E_literal (Literal_bytes b) +let e_bytes_string ?loc (s: string) : expression = + make_expr ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s))) +let e_big_map ?loc lst : expression = make_expr ?loc @@ E_big_map lst +let e_some ?loc s : expression = make_expr ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]} +let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NONE; arguments = []} +let e_string_cat ?loc sl sr : expression = make_expr ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]} +let e_map_add ?loc k v old : expression = make_expr ?loc @@ E_constant {cons_name = C_MAP_ADD; arguments = [k ; v ; old]} +let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst +let e_set ?loc lst : expression = make_expr ?loc @@ E_set lst +let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst +let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a} +let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b} +let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c}) +let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {expr = a; label= Label b} +let e_accessor_list ?loc a b = List.fold_left (fun a b -> e_accessor ?loc a b) a b +let e_variable ?loc v = make_expr ?loc @@ E_variable v +let e_let_in ?loc (binder, ascr) inline rhs let_result = + make_expr ?loc @@ E_let_in { let_binder = (binder,ascr) ; rhs ; let_result; inline } +let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty} +let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b} +let e_binop ?loc name a b = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]} +let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst} +let e_look_up ?loc x y = make_expr ?loc @@ E_look_up (x , y) +let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false}) +(* +let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*) +*) +let ez_match_variant (lst : ((string * string) * 'a) list) = + let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in + Match_variant (lst,()) +let e_matching_variant ?loc a (lst : ((string * string)* 'a) list) = + e_matching ?loc a (ez_match_variant lst) +let e_record_ez ?loc (lst : (string * expr) list) : expression = + let map = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in + make_expr ?loc @@ E_record map +let e_record ?loc map = + let lst = Map.String.to_kv_list map in + e_record_ez ?loc lst + +let e_update ?loc record path update = + let path = Label path in + make_expr ?loc @@ E_record_update {record; path; update} + +let e_tuple ?loc lst : expression = e_record_ez ?loc (tuple_to_record lst) +let e_pair ?loc a b : expression = e_tuple ?loc [a;b] + +let make_option_typed ?loc e t_opt = + match t_opt with + | None -> e + | Some t -> e_annotation ?loc e t + + +let e_typed_none ?loc t_opt = + let type_annotation = t_option t_opt in + e_annotation ?loc (e_none ?loc ()) type_annotation + +let e_typed_list ?loc lst t = + e_annotation ?loc (e_list lst) (t_list t) + +let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v) +let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v) + +let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k) + + +let e_lambda ?loc (binder : expression_variable) + (input_type : type_expression option) + (output_type : type_expression option) + (result : expression) + : expression = + make_expr ?loc @@ E_lambda { + binder = binder ; + input_type = input_type ; + output_type = output_type ; + result ; + } +let e_recursive ?loc fun_name fun_type lambda = make_expr ?loc @@ E_recursive {fun_name; fun_type; lambda} + + +let e_assign_with_let ?loc var access_path expr = + let var = Var.of_name (var) in + match access_path with + | [] -> (var, None), true, expr, false + + | lst -> + let rec aux path record= match path with + | [] -> failwith "acces_path cannot be empty" + | [e] -> e_update ?loc record e expr + | elem::tail -> + let next_record = e_accessor record elem in + e_update ?loc record elem (aux tail next_record ) + in + (var, None), true, (aux lst (e_variable var)), false + +let get_e_accessor = fun t -> + match t with + | E_record_accessor {expr; label} -> ok (expr , label) + | _ -> simple_fail "not an accessor" + +let assert_e_accessor = fun t -> + let%bind _ = get_e_accessor t in + ok () + +let get_e_pair = fun t -> + match t with + | E_record r -> ( + let lst = LMap.to_kv_list r in + match lst with + | [(Label "O",a);(Label "1",b)] + | [(Label "1",b);(Label "0",a)] -> + ok (a , b) + | _ -> simple_fail "not a pair" + ) + | _ -> simple_fail "not a pair" + +let get_e_list = fun t -> + match t with + | E_list lst -> ok lst + | _ -> simple_fail "not a list" + +let tuple_of_record (m: _ LMap.t) = + let aux i = + let opt = LMap.find_opt (Label (string_of_int i)) m in + Option.bind (fun opt -> Some (opt,i+1)) opt + in + Base.Sequence.to_list @@ Base.Sequence.unfold ~init:0 ~f:aux + +let get_e_tuple = fun t -> + match t with + | E_record r -> ok @@ tuple_of_record r + | _ -> simple_fail "ast_core: get_e_tuple: not a tuple" + +(* Same as get_e_pair *) +let extract_pair : expression -> (expression * expression) result = fun e -> + match e.expression_content with + | E_record r -> ( + let lst = LMap.to_kv_list r in + match lst with + | [(Label "O",a);(Label "1",b)] + | [(Label "1",b);(Label "0",a)] -> + ok (a , b) + | _ -> fail @@ bad_kind "pair" e.location + ) + | _ -> fail @@ bad_kind "pair" e.location + +let extract_list : expression -> (expression list) result = fun e -> + match e.expression_content with + | E_list lst -> ok lst + | _ -> fail @@ bad_kind "list" e.location + +let extract_record : expression -> (label * expression) list result = fun e -> + match e.expression_content with + | E_record lst -> ok @@ LMap.to_kv_list lst + | _ -> fail @@ bad_kind "record" e.location + +let extract_map : expression -> (expression * expression) list result = fun e -> + match e.expression_content with + | E_map lst -> ok lst + | _ -> fail @@ bad_kind "map" e.location diff --git a/src/stages/3-ast_core/combinators.mli b/src/stages/3-ast_core/combinators.mli new file mode 100644 index 000000000..ae0aab1bd --- /dev/null +++ b/src/stages/3-ast_core/combinators.mli @@ -0,0 +1,133 @@ +open Types +open Simple_utils.Trace +(* +module Option = Simple_utils.Option + +module SMap = Map.String + +module Errors : sig + val bad_kind : name -> Location.t -> unit -> error +end +*) +val make_t : type_content -> type_expression +val t_bool : type_expression +val t_string : type_expression +val t_bytes : type_expression +val t_int : type_expression +val t_operation : type_expression +val t_nat : type_expression +val t_tez : type_expression +val t_unit : type_expression +val t_address : type_expression +val t_key : type_expression +val t_key_hash : type_expression +val t_timestamp : type_expression +val t_signature : type_expression +(* +val t_option : type_expression -> type_expression +*) +val t_list : type_expression -> type_expression +val t_variable : string -> type_expression +(* +val t_record : te_map -> type_expression +*) +val t_pair : ( type_expression * type_expression ) -> type_expression +val t_tuple : type_expression list -> type_expression + +val t_record : type_expression Map.String.t -> type_expression +val t_record_ez : (string * type_expression) list -> type_expression + +val t_sum : type_expression Map.String.t -> type_expression +val ez_t_sum : ( string * type_expression ) list -> type_expression + +val t_function : type_expression -> type_expression -> type_expression +val t_map : type_expression -> type_expression -> type_expression + +val t_operator : type_operator -> type_expression list -> type_expression result +val t_set : type_expression -> type_expression + +val make_expr : ?loc:Location.t -> expression_content -> expression +val e_var : ?loc:Location.t -> string -> expression +val e_literal : ?loc:Location.t -> literal -> expression +val e_unit : ?loc:Location.t -> unit -> expression +val e_int : ?loc:Location.t -> int -> expression +val e_nat : ?loc:Location.t -> int -> expression +val e_timestamp : ?loc:Location.t -> int -> expression +val e_bool : ?loc:Location.t -> bool -> expression +val e_string : ?loc:Location.t -> string -> expression +val e_address : ?loc:Location.t -> string -> expression +val e_signature : ?loc:Location.t -> string -> expression +val e_key : ?loc:Location.t -> string -> expression +val e_key_hash : ?loc:Location.t -> string -> expression +val e_chain_id : ?loc:Location.t -> string -> expression +val e_mutez : ?loc:Location.t -> int -> expression +val e'_bytes : string -> expression_content result +val e_bytes_hex : ?loc:Location.t -> string -> expression result +val e_bytes_raw : ?loc:Location.t -> bytes -> expression +val e_bytes_string : ?loc:Location.t -> string -> expression +val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression + +val e_record_ez : ?loc:Location.t -> ( string * expr ) list -> expression +val e_tuple : ?loc:Location.t -> expression list -> expression +val e_some : ?loc:Location.t -> expression -> expression +val e_none : ?loc:Location.t -> unit -> expression +val e_string_cat : ?loc:Location.t -> expression -> expression -> expression +val e_map_add : ?loc:Location.t -> expression -> expression -> expression -> expression +val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression +val e_set : ?loc:Location.t -> expression list -> expression +val e_list : ?loc:Location.t -> expression list -> expression +val e_pair : ?loc:Location.t -> expression -> expression -> expression +val e_constructor : ?loc:Location.t -> string -> expression -> expression +val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression +val e_matching_bool : ?loc:Location.t -> expression -> expression -> expression -> expression +val e_accessor : ?loc:Location.t -> expression -> string -> expression +val e_accessor_list : ?loc:Location.t -> expression -> string list -> expression +val e_variable : ?loc:Location.t -> expression_variable -> expression +val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression +val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression +val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression +val e_application : ?loc:Location.t -> expression -> expression -> expression +val e_binop : ?loc:Location.t -> constant' -> expression -> expression -> expression +val e_constant : ?loc:Location.t -> constant' -> expression list -> expression +val e_look_up : ?loc:Location.t -> expression -> expression -> expression +val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content +val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression + +val make_option_typed : ?loc:Location.t -> expression -> type_expression option -> expression + +val e_typed_none : ?loc:Location.t -> type_expression -> expression + +val e_typed_list : ?loc:Location.t -> expression list -> type_expression -> expression + +val e_typed_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression +val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression + +val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression + +val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression +val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression +val e_record : ?loc:Location.t -> expr Map.String.t -> expression +val e_update : ?loc:Location.t -> expression -> string -> expression -> expression +val e_assign_with_let : ?loc:Location.t -> string -> string list -> expression -> ((expression_variable*type_expression option)*bool*expression*bool) + +(* +val get_e_accessor : expression' -> ( expression * access_path ) result +*) + +val assert_e_accessor : expression_content -> unit result + +val get_e_pair : expression_content -> ( expression * expression ) result + +val get_e_list : expression_content -> ( expression list ) result +val get_e_tuple : expression_content -> ( expression list ) result +(* +val get_e_failwith : expression -> expression result +val is_e_failwith : expression -> bool +*) +val extract_pair : expression -> ( expression * expression ) result + +val extract_list : expression -> (expression list) result + +val extract_record : expression -> (label * expression) list result + +val extract_map : expression -> (expression * expression) list result diff --git a/src/stages/3-ast_core/dune b/src/stages/3-ast_core/dune new file mode 100644 index 000000000..ce45b1899 --- /dev/null +++ b/src/stages/3-ast_core/dune @@ -0,0 +1,13 @@ +(library + (name ast_core) + (public_name ligo.ast_core) + (libraries + simple-utils + tezos-utils + stage_common + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -open Simple_utils )) +) diff --git a/src/stages/ast_simplified/misc.ml b/src/stages/3-ast_core/misc.ml similarity index 99% rename from src/stages/ast_simplified/misc.ml rename to src/stages/3-ast_core/misc.ml index f2094d3ca..a09efa475 100644 --- a/src/stages/ast_simplified/misc.ml +++ b/src/stages/3-ast_core/misc.ml @@ -184,7 +184,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result = | (E_application _, _) | (E_let_in _, _) | (E_recursive _,_) | (E_record_accessor _, _) | (E_look_up _, _) | (E_matching _, _) - | (E_skip, _) -> simple_fail "comparing not a value" + -> simple_fail "comparing not a value" let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b) diff --git a/src/stages/3-ast_core/misc.mli b/src/stages/3-ast_core/misc.mli new file mode 100644 index 000000000..0784d109c --- /dev/null +++ b/src/stages/3-ast_core/misc.mli @@ -0,0 +1,20 @@ +open Trace +open Types + + +(* + +module Errors : sig + val different_literals_because_different_types : name -> literal -> literal -> unit -> error + + val different_literals : name -> literal -> literal -> unit -> error + + val error_uncomparable_literals : name -> literal -> literal -> unit -> error +end + +val assert_literal_eq : ( literal * literal ) -> unit result +*) + +val assert_value_eq : ( expression * expression ) -> unit result + +val is_value_eq : ( expression * expression ) -> bool diff --git a/src/stages/ast_simplified/types.ml b/src/stages/3-ast_core/types.ml similarity index 92% rename from src/stages/ast_simplified/types.ml rename to src/stages/3-ast_core/types.ml index 696dbd028..2b8f0dbc2 100644 --- a/src/stages/ast_simplified/types.ml +++ b/src/stages/3-ast_core/types.ml @@ -2,15 +2,15 @@ module Location = Simple_utils.Location -module Ast_simplified_parameter = struct +module Ast_core_parameter = struct type type_meta = unit end include Stage_common.Types -(*include Ast_generic_type(Ast_simplified_parameter) +(*include Ast_generic_type(Ast_core_parameter) *) -include Ast_generic_type (Ast_simplified_parameter) +include Ast_generic_type (Ast_core_parameter) type inline = bool type program = declaration Location.wrap list @@ -34,9 +34,8 @@ and expression_content = | E_variable of expression_variable | E_application of application | E_lambda of lambda - | E_let_in of let_in | E_recursive of recursive - | E_skip + | E_let_in of let_in (* Variant *) | E_constructor of constructor (* For user defined constructors *) | E_matching of matching @@ -58,27 +57,29 @@ and constant = { cons_name: constant' (* this is at the end because it is huge *) ; arguments: expression list } -and application = {expr1: expression; expr2: expression} +and application = { + lamb: expression ; + args: expression ; + } and lambda = - { binder: expression_variable + { binder: expression_variable ; input_type: type_expression option ; output_type: type_expression option ; result: expression } -and let_in = - { let_binder: expression_variable * type_expression option - ; mut: bool - ; rhs: expression - ; let_result: expression - ; inline: bool } - and recursive = { fun_name : expression_variable; fun_type : type_expression; lambda : lambda; } +and let_in = + { let_binder: expression_variable * type_expression option + ; rhs: expression + ; let_result: expression + ; inline: bool } + and constructor = {constructor: constructor'; element: expression} and accessor = {expr: expression; label: label} diff --git a/src/stages/ast_typed/PP.ml b/src/stages/4-ast_typed/PP.ml similarity index 97% rename from src/stages/ast_typed/PP.ml rename to src/stages/4-ast_typed/PP.ml index aed4648c5..1325d0476 100644 --- a/src/stages/ast_typed/PP.ml +++ b/src/stages/4-ast_typed/PP.ml @@ -19,8 +19,8 @@ and expression_content ppf (ec: expression_content) = literal ppf l | E_variable n -> fprintf ppf "%a" expression_variable n - | E_application app -> - fprintf ppf "(%a)@(%a)" expression app.expr1 expression app.expr2 + | E_application {lamb;args} -> + fprintf ppf "(%a)@(%a)" expression lamb expression args | E_constructor c -> fprintf ppf "%a(%a)" constructor c.constructor expression c.element | E_constant c -> diff --git a/src/stages/ast_typed/ast_typed.ml b/src/stages/4-ast_typed/ast_typed.ml similarity index 100% rename from src/stages/ast_typed/ast_typed.ml rename to src/stages/4-ast_typed/ast_typed.ml diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/4-ast_typed/combinators.ml similarity index 98% rename from src/stages/ast_typed/combinators.ml rename to src/stages/4-ast_typed/combinators.ml index d6f1e8da5..014ab8f2f 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/4-ast_typed/combinators.ml @@ -23,7 +23,7 @@ module Errors = struct error (thunk "No declaration with the given name") message end -let make_t type_content simplified = { type_content ; type_meta=simplified } +let make_t type_content core = { type_content ; type_meta=core } let make_a_e ?(location = Location.generated) expression_content type_expression environment = { expression_content ; type_expression ; @@ -294,7 +294,7 @@ let e_chain_id s : expression_content = E_literal (Literal_chain_id s) let e_operation s : expression_content = E_literal (Literal_operation s) let e_lambda l : expression_content = E_lambda l let e_pair a b : expression_content = ez_e_record [(Label "0",a);(Label "1", b)] -let e_application expr1 expr2 : expression_content = E_application {expr1;expr2} +let e_application lamb args : expression_content = E_application {lamb;args} let e_variable v : expression_content = E_variable v let e_list lst : expression_content = E_list lst let e_let_in let_binder inline rhs let_result = E_let_in { let_binder ; rhs ; let_result; inline } diff --git a/src/stages/ast_typed/combinators.mli b/src/stages/4-ast_typed/combinators.mli similarity index 100% rename from src/stages/ast_typed/combinators.mli rename to src/stages/4-ast_typed/combinators.mli diff --git a/src/stages/ast_typed/combinators_environment.ml b/src/stages/4-ast_typed/combinators_environment.ml similarity index 100% rename from src/stages/ast_typed/combinators_environment.ml rename to src/stages/4-ast_typed/combinators_environment.ml diff --git a/src/stages/ast_typed/combinators_environment.mli b/src/stages/4-ast_typed/combinators_environment.mli similarity index 100% rename from src/stages/ast_typed/combinators_environment.mli rename to src/stages/4-ast_typed/combinators_environment.mli diff --git a/src/stages/ast_typed/dune b/src/stages/4-ast_typed/dune similarity index 84% rename from src/stages/ast_typed/dune rename to src/stages/4-ast_typed/dune index 7eed79e47..d33c8dac6 100644 --- a/src/stages/ast_typed/dune +++ b/src/stages/4-ast_typed/dune @@ -4,7 +4,7 @@ (libraries simple-utils tezos-utils - ast_simplified ; Is that a good idea? + ast_core ; Is that a good idea? stage_common ) (preprocess diff --git a/src/stages/ast_typed/environment.ml b/src/stages/4-ast_typed/environment.ml similarity index 100% rename from src/stages/ast_typed/environment.ml rename to src/stages/4-ast_typed/environment.ml diff --git a/src/stages/ast_typed/environment.mli b/src/stages/4-ast_typed/environment.mli similarity index 100% rename from src/stages/ast_typed/environment.mli rename to src/stages/4-ast_typed/environment.mli diff --git a/src/stages/ast_typed/misc.ml b/src/stages/4-ast_typed/misc.ml similarity index 99% rename from src/stages/ast_typed/misc.ml rename to src/stages/4-ast_typed/misc.ml index 20a778f9c..04efcca5f 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/4-ast_typed/misc.ml @@ -206,7 +206,7 @@ module Free_variables = struct | true -> empty | false -> singleton name ) - | E_application {expr1;expr2} -> unions @@ List.map self [ expr1 ; expr2 ] + | E_application {lamb;args} -> unions @@ List.map self [ lamb ; args ] | E_constructor {element;_} -> self element | E_record m -> unions @@ List.map self @@ LMap.to_list m | E_record_accessor {expr;_} -> self expr diff --git a/src/stages/ast_typed/misc.mli b/src/stages/4-ast_typed/misc.mli similarity index 100% rename from src/stages/ast_typed/misc.mli rename to src/stages/4-ast_typed/misc.mli diff --git a/src/stages/ast_typed/misc_smart.ml b/src/stages/4-ast_typed/misc_smart.ml similarity index 97% rename from src/stages/ast_typed/misc_smart.ml rename to src/stages/4-ast_typed/misc_smart.ml index 414f01670..0040f7d90 100644 --- a/src/stages/ast_typed/misc_smart.ml +++ b/src/stages/4-ast_typed/misc_smart.ml @@ -63,8 +63,8 @@ module Captured_variables = struct | ED_binder -> ok empty | ED_declaration {expr=_ ; free_variables=_} -> simple_fail "todo" ) - | E_application {expr1;expr2} -> - let%bind lst' = bind_map_list self [ expr1 ; expr2 ] in + | E_application {lamb;args} -> + let%bind lst' = bind_map_list self [ lamb ; args ] in ok @@ unions lst' | E_constructor {element;_} -> self element | E_record m -> diff --git a/src/stages/ast_typed/misc_smart.mli b/src/stages/4-ast_typed/misc_smart.mli similarity index 100% rename from src/stages/ast_typed/misc_smart.mli rename to src/stages/4-ast_typed/misc_smart.mli diff --git a/src/stages/ast_typed/types.ml b/src/stages/4-ast_typed/types.ml similarity index 97% rename from src/stages/ast_typed/types.ml rename to src/stages/4-ast_typed/types.ml index af143aa89..fdb24969b 100644 --- a/src/stages/ast_typed/types.ml +++ b/src/stages/4-ast_typed/types.ml @@ -1,6 +1,6 @@ [@@@warning "-30"] -module S = Ast_simplified +module S = Ast_core include Stage_common.Types module Ast_typed_type_parameter = struct @@ -40,8 +40,8 @@ and expression_content = | E_variable of expression_variable | E_application of application | E_lambda of lambda - | E_let_in of let_in | E_recursive of recursive + | E_let_in of let_in (* Variant *) | E_constructor of constructor (* For user defined constructors *) | E_matching of matching @@ -61,7 +61,10 @@ and constant = { cons_name: constant' ; arguments: expression list } -and application = {expr1: expression; expr2: expression} +and application = { + lamb: expression ; + args: expression ; + } and lambda = { binder: expression_variable ; diff --git a/src/stages/mini_c/PP.ml b/src/stages/5-mini_c/PP.ml similarity index 100% rename from src/stages/mini_c/PP.ml rename to src/stages/5-mini_c/PP.ml diff --git a/src/stages/mini_c/PP.mli b/src/stages/5-mini_c/PP.mli similarity index 100% rename from src/stages/mini_c/PP.mli rename to src/stages/5-mini_c/PP.mli diff --git a/src/stages/mini_c/combinators.ml b/src/stages/5-mini_c/combinators.ml similarity index 100% rename from src/stages/mini_c/combinators.ml rename to src/stages/5-mini_c/combinators.ml diff --git a/src/stages/mini_c/combinators.mli b/src/stages/5-mini_c/combinators.mli similarity index 100% rename from src/stages/mini_c/combinators.mli rename to src/stages/5-mini_c/combinators.mli diff --git a/src/stages/mini_c/combinators_smart.ml b/src/stages/5-mini_c/combinators_smart.ml similarity index 100% rename from src/stages/mini_c/combinators_smart.ml rename to src/stages/5-mini_c/combinators_smart.ml diff --git a/src/stages/mini_c/dune b/src/stages/5-mini_c/dune similarity index 100% rename from src/stages/mini_c/dune rename to src/stages/5-mini_c/dune diff --git a/src/stages/mini_c/environment.ml b/src/stages/5-mini_c/environment.ml similarity index 100% rename from src/stages/mini_c/environment.ml rename to src/stages/5-mini_c/environment.ml diff --git a/src/stages/mini_c/environment.mli b/src/stages/5-mini_c/environment.mli similarity index 100% rename from src/stages/mini_c/environment.mli rename to src/stages/5-mini_c/environment.mli diff --git a/src/stages/mini_c/mini_c.ml b/src/stages/5-mini_c/mini_c.ml similarity index 100% rename from src/stages/mini_c/mini_c.ml rename to src/stages/5-mini_c/mini_c.ml diff --git a/src/stages/mini_c/misc.ml b/src/stages/5-mini_c/misc.ml similarity index 100% rename from src/stages/mini_c/misc.ml rename to src/stages/5-mini_c/misc.ml diff --git a/src/stages/mini_c/types.ml b/src/stages/5-mini_c/types.ml similarity index 100% rename from src/stages/mini_c/types.ml rename to src/stages/5-mini_c/types.ml diff --git a/src/stages/typesystem/misc.ml b/src/stages/typesystem/misc.ml index 10a59f4bc..4b60cf454 100644 --- a/src/stages/typesystem/misc.ml +++ b/src/stages/typesystem/misc.ml @@ -89,28 +89,28 @@ module Substitution = struct let _TODO = substs in failwith "TODO: T_function" - and s_simpl_type_content : Ast_simplified.type_content w = fun ~substs -> function - | Ast_simplified.T_sum _ -> failwith "TODO: subst: unimplemented case s_type_expression sum" - | Ast_simplified.T_record _ -> failwith "TODO: subst: unimplemented case s_type_expression record" - | Ast_simplified.T_arrow _ -> failwith "TODO: subst: unimplemented case s_type_expression arrow" - | Ast_simplified.T_variable _ -> failwith "TODO: subst: unimplemented case s_type_expression variable" - | Ast_simplified.T_operator op -> + and s_abstr_type_content : Ast_core.type_content w = fun ~substs -> function + | Ast_core.T_sum _ -> failwith "TODO: subst: unimplemented case s_type_expression sum" + | Ast_core.T_record _ -> failwith "TODO: subst: unimplemented case s_type_expression record" + | Ast_core.T_arrow _ -> failwith "TODO: subst: unimplemented case s_type_expression arrow" + | Ast_core.T_variable _ -> failwith "TODO: subst: unimplemented case s_type_expression variable" + | Ast_core.T_operator op -> let%bind op = - Ast_simplified.bind_map_type_operator - (s_simpl_type_expression ~substs) + Ast_core.bind_map_type_operator + (s_abstr_type_expression ~substs) op in (* TODO: when we have generalized operators, we might need to subst the operator name itself? *) - ok @@ Ast_simplified.T_operator op - | Ast_simplified.T_constant constant -> - ok @@ Ast_simplified.T_constant constant + ok @@ Ast_core.T_operator op + | Ast_core.T_constant constant -> + ok @@ Ast_core.T_constant constant - and s_simpl_type_expression : Ast_simplified.type_expression w = fun ~substs {type_content;type_meta} -> - let%bind type_content = s_simpl_type_content ~substs type_content in - ok @@ Ast_simplified.{type_content;type_meta} + and s_abstr_type_expression : Ast_core.type_expression w = fun ~substs {type_content;type_meta} -> + let%bind type_content = s_abstr_type_content ~substs type_content in + ok @@ Ast_core.{type_content;type_meta} and s_type_expression : T.type_expression w = fun ~substs { type_content; type_meta } -> let%bind type_content = s_type_content ~substs type_content in - let%bind type_meta = bind_map_option (s_simpl_type_expression ~substs) type_meta in + let%bind type_meta = bind_map_option (s_abstr_type_expression ~substs) type_meta in ok @@ T.{ type_content; type_meta} and s_literal : T.literal w = fun ~substs -> function | T.Literal_unit -> @@ -151,10 +151,10 @@ module Substitution = struct | T.E_variable tv -> let%bind tv = s_variable ~substs tv in ok @@ T.E_variable tv - | T.E_application {expr1;expr2} -> - let%bind expr1 = s_expression ~substs expr1 in - let%bind expr2 = s_expression ~substs expr2 in - ok @@ T.E_application {expr1;expr2} + | T.E_application {lamb;args} -> + let%bind lamb = s_expression ~substs lamb in + let%bind args = s_expression ~substs args in + ok @@ T.E_application {lamb;args} | T.E_lambda { binder; result } -> let%bind binder = s_variable ~substs binder in let%bind result = s_expression ~substs result in diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index 5df29091f..dcf82891a 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -4,8 +4,7 @@ open Trace open Test_helpers let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "pascaligo" (Contract "main") in ok @@ (typed,state) let get_program = @@ -20,16 +19,15 @@ let get_program = ) let compile_main () = - let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/coase.ligo" (Syntax_name "pascaligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in - let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in - let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in + let%bind typed_prg = get_program () in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = (* fails if the given entry point is not a valid contract *) Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_simplified +open Ast_imperative let card owner = e_record_ez [ @@ -222,15 +220,16 @@ let sell () = let storage = basic 100 1000 cards (2 * n) in e_pair sell_action storage in - let make_expecter : int -> expression -> unit result = fun n result -> - let%bind (ops , storage) = get_e_pair result.expression_content in + let make_expecter : int -> Ast_core.expression -> unit result = fun n result -> + let%bind (ops , storage) = Ast_core.get_e_pair result.expression_content in let%bind () = - let%bind lst = get_e_list ops.expression_content in + let%bind lst = Ast_core.get_e_list ops.expression_content in Assert.assert_list_size lst 1 in let expected_storage = let cards = List.hds @@ cards_ez first_owner n in basic 99 1000 cards (2 * n) in - Ast_simplified.Misc.assert_value_eq (expected_storage , storage) + let%bind expected_storage = Test_helpers.expression_to_core expected_storage in + Ast_core.Misc.assert_value_eq (expected_storage , storage) in let%bind () = let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in diff --git a/src/test/contracts/negative/nested_bigmap_1.religo b/src/test/contracts/negative/nested_bigmap_1.religo new file mode 100644 index 000000000..b86e549b1 --- /dev/null +++ b/src/test/contracts/negative/nested_bigmap_1.religo @@ -0,0 +1,10 @@ +type bar = big_map (nat, int); + +/* this should result in an error as nested big_maps are not supported: */ +type storage = big_map (int, bar); + +type return = (list (operation), storage); + +let main = ((ignore, store): (unit, storage)): return => { + ([]: list(operation), store) +}; diff --git a/src/test/contracts/negative/nested_bigmap_2.religo b/src/test/contracts/negative/nested_bigmap_2.religo new file mode 100644 index 000000000..d8061f912 --- /dev/null +++ b/src/test/contracts/negative/nested_bigmap_2.religo @@ -0,0 +1,9 @@ +/* this should result in an error as nested big_maps are not supported: */ +type storage = big_map (nat, big_map (int, string)); + +type return = (list (operation), storage); + +let main = ((ignore, store): (unit, storage)): return => { + ([]: list(operation), store) +}; + \ No newline at end of file diff --git a/src/test/contracts/negative/nested_bigmap_3.religo b/src/test/contracts/negative/nested_bigmap_3.religo new file mode 100644 index 000000000..e8941f445 --- /dev/null +++ b/src/test/contracts/negative/nested_bigmap_3.religo @@ -0,0 +1,15 @@ +type bar = big_map (nat, int); + +type foo = { + a: int, + b: bar +}; + +/* this should result in an error as nested big_maps are not supported: */ +type storage = big_map(nat, foo); + +type return = (list (operation), storage); + +let main = ((ignore, store): (unit, storage)): return => { + ([]: list(operation), store) +}; diff --git a/src/test/contracts/negative/nested_bigmap_4.religo b/src/test/contracts/negative/nested_bigmap_4.religo new file mode 100644 index 000000000..653908636 --- /dev/null +++ b/src/test/contracts/negative/nested_bigmap_4.religo @@ -0,0 +1,9 @@ +/* this should result in an error as nested big_maps are not supported: */ +type storage = map (int, big_map (nat, big_map (int, string))); + +type return = (list (operation), storage); + +let main = ((ignore, store): (unit, storage)): return => { + ([]: list(operation), store) +}; + \ No newline at end of file diff --git a/src/test/contracts/tuple_list.religo b/src/test/contracts/tuple_list.religo new file mode 100644 index 000000000..0736701d2 --- /dev/null +++ b/src/test/contracts/tuple_list.religo @@ -0,0 +1,3 @@ +type z = list((int, int)); + +let o: z = [(2,4), (4, 6)]; \ No newline at end of file diff --git a/src/test/hash_lock_tests.ml b/src/test/hash_lock_tests.ml index 7a6db1ea8..e33364cda 100644 --- a/src/test/hash_lock_tests.ml +++ b/src/test/hash_lock_tests.ml @@ -1,10 +1,9 @@ open Trace open Test_helpers -open Ast_simplified +open Ast_imperative let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in ok @@ (typed,state) let get_program = @@ -18,10 +17,9 @@ let get_program = ) let compile_main () = - let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/hashlock.mligo" (Syntax_name "cameligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in - let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in - let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in + let%bind typed_prg,_ = get_program () in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = (* fails if the given entry point is not a valid contract *) Ligo.Compile.Of_michelson.build_contract michelson_prg in diff --git a/src/test/id_tests.ml b/src/test/id_tests.ml index 294cd08ff..4d7a88a6d 100644 --- a/src/test/id_tests.ml +++ b/src/test/id_tests.ml @@ -1,11 +1,10 @@ open Trace open Test_helpers -open Ast_simplified +open Ast_imperative let mtype_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in ok (typed,state) let get_program = @@ -19,8 +18,7 @@ let get_program = ) let compile_main () = - let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/id.mligo" (Syntax_name "cameligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed_prg,_ = get_program () in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 9c17f2479..4006d6b79 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1,22 +1,18 @@ open Trace open Test_helpers -open Ast_simplified.Combinators +open Ast_imperative.Combinators let retype_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "reasonligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile Env simplified in - let () = Typer.Solver.discard_state state in + let%bind typed,state = Ligo.Compile.Utils.type_file f "reasonligo" Env in let () = Typer.Solver.discard_state state in ok typed let mtype_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile Env simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" Env in let () = Typer.Solver.discard_state state in ok typed let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile Env simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "pascaligo" Env in let () = Typer.Solver.discard_state state in ok typed @@ -428,52 +424,52 @@ let bytes_arithmetic () : unit result = let%bind () = expect_eq program "slice_op" tata at in let%bind () = expect_fail program "slice_op" foo in let%bind () = expect_fail program "slice_op" ba in - let%bind b1 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foo in - let%bind () = expect_eq program "hasherman" foo b1 in - let%bind b3 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foo in + let%bind () = expect_eq_core program "hasherman" foo b1 in + let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in ok () let crypto () : unit result = let%bind program = type_file "./contracts/crypto.ligo" in let%bind foo = e_bytes_hex "0f00" in let%bind foototo = e_bytes_hex "0f007070" in - let%bind b1 = Test_helpers.run_typed_program_with_simplified_input program "hasherman512" foo in - let%bind () = expect_eq program "hasherman512" foo b1 in - let%bind b2 = Test_helpers.run_typed_program_with_simplified_input program "hasherman512" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b2 , b1) in - let%bind b4 = Test_helpers.run_typed_program_with_simplified_input program "hasherman_blake" foo in - let%bind () = expect_eq program "hasherman_blake" foo b4 in - let%bind b5 = Test_helpers.run_typed_program_with_simplified_input program "hasherman_blake" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b5 , b4) in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in + let%bind () = expect_eq_core program "hasherman512" foo b1 in + let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in + let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in + let%bind () = expect_eq_core program "hasherman_blake" foo b4 in + let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in ok () let crypto_mligo () : unit result = let%bind program = mtype_file "./contracts/crypto.mligo" in let%bind foo = e_bytes_hex "0f00" in let%bind foototo = e_bytes_hex "0f007070" in - let%bind b1 = Test_helpers.run_typed_program_with_simplified_input program "hasherman512" foo in - let%bind () = expect_eq program "hasherman512" foo b1 in - let%bind b2 = Test_helpers.run_typed_program_with_simplified_input program "hasherman512" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b2 , b1) in - let%bind b4 = Test_helpers.run_typed_program_with_simplified_input program "hasherman_blake" foo in - let%bind () = expect_eq program "hasherman_blake" foo b4 in - let%bind b5 = Test_helpers.run_typed_program_with_simplified_input program "hasherman_blake" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b5 , b4) in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in + let%bind () = expect_eq_core program "hasherman512" foo b1 in + let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in + let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in + let%bind () = expect_eq_core program "hasherman_blake" foo b4 in + let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in ok () let crypto_religo () : unit result = let%bind program = retype_file "./contracts/crypto.religo" in let%bind foo = e_bytes_hex "0f00" in let%bind foototo = e_bytes_hex "0f007070" in - let%bind b1 = Test_helpers.run_typed_program_with_simplified_input program "hasherman512" foo in - let%bind () = expect_eq program "hasherman512" foo b1 in - let%bind b2 = Test_helpers.run_typed_program_with_simplified_input program "hasherman512" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b2 , b1) in - let%bind b4 = Test_helpers.run_typed_program_with_simplified_input program "hasherman_blake" foo in - let%bind () = expect_eq program "hasherman_blake" foo b4 in - let%bind b5 = Test_helpers.run_typed_program_with_simplified_input program "hasherman_blake" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b5 , b4) in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in + let%bind () = expect_eq_core program "hasherman512" foo b1 in + let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in + let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in + let%bind () = expect_eq_core program "hasherman_blake" foo b4 in + let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in ok () let bytes_arithmetic_mligo () : unit result = @@ -490,10 +486,10 @@ let bytes_arithmetic_mligo () : unit result = let%bind () = expect_eq program "slice_op" tata at in let%bind () = expect_fail program "slice_op" foo in let%bind () = expect_fail program "slice_op" ba in - let%bind b1 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foo in - let%bind () = expect_eq program "hasherman" foo b1 in - let%bind b3 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foo in + let%bind () = expect_eq_core program "hasherman" foo b1 in + let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in ok () let bytes_arithmetic_religo () : unit result = @@ -510,10 +506,10 @@ let bytes_arithmetic_religo () : unit result = let%bind () = expect_eq program "slice_op" tata at in let%bind () = expect_fail program "slice_op" foo in let%bind () = expect_fail program "slice_op" ba in - let%bind b1 = Test_helpers.run_typed_program_with_simplified_input program"hasherman" foo in - let%bind () = expect_eq program "hasherman" foo b1 in - let%bind b3 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foototo in - let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program"hasherman" foo in + let%bind () = expect_eq_core program "hasherman" foo b1 in + let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in + let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in ok () let set_arithmetic () : unit result = @@ -978,7 +974,6 @@ let reoption () : unit result = let map_ type_f path : unit result = let%bind program = type_f path in 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_typed_map lst' t_int t_int in @@ -1067,7 +1062,6 @@ let map_ type_f path : unit result = let big_map_ type_f path : unit result = let%bind program = type_f path in 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_typed_big_map lst' t_int t_int) in @@ -1280,7 +1274,6 @@ let loop () : unit result = expect_eq program "inner_capture_in_conditional_block" 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 @@ -2035,13 +2028,13 @@ let get_contract_ligo () : unit result = let%bind program = type_file "./contracts/get_contract.ligo" in let%bind () = let make_input = fun _n -> e_unit () in - let make_expected : int -> Ast_simplified.expression -> unit result = fun _n result -> - let%bind (ops , storage) = get_e_pair result.expression_content in + let make_expected : int -> Ast_core.expression -> unit result = fun _n result -> + let%bind (ops , storage) = Ast_core.get_e_pair result.expression_content in let%bind () = - let%bind lst = get_e_list ops.expression_content in + let%bind lst = Ast_core.get_e_list ops.expression_content in Assert.assert_list_size lst 1 in - let expected_storage = e_unit () in - Ast_simplified.Misc.assert_value_eq (expected_storage , storage) + let expected_storage = Ast_core.e_unit () in + Ast_core.Misc.assert_value_eq (expected_storage , storage) in let%bind () = let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in @@ -2323,6 +2316,10 @@ let no_semicolon_religo () : unit result = in ok () +let tuple_list_religo () : unit result = + let%bind _ = retype_file "./contracts/tuple_list.religo" in + ok () + let loop_bugs_ligo () : unit result = let%bind program = type_file "./contracts/loop_bugs.ligo" in let input = e_unit () in @@ -2509,4 +2506,5 @@ let main = test_suite "Integration (End to End)" [ test "tuple type (religo)" tuple_type_religo ; test "no semicolon (religo)" no_semicolon_religo ; test "loop_bugs (ligo)" loop_bugs_ligo ; + test "tuple_list (religo)" tuple_list_religo ; ] diff --git a/src/test/md_file_tests.ml b/src/test/md_file_tests.ml index 14748f9c8..6114e9126 100644 --- a/src/test/md_file_tests.ml +++ b/src/test/md_file_tests.ml @@ -68,8 +68,10 @@ let compile_groups _filename grp_list = (fun ((s,grp),contents) -> trace (failed_to_compile_md_file _filename (s,grp,contents)) @@ let%bind v_syntax = Compile.Helpers.syntax_to_variant (Syntax_name s) None in - let%bind simplified = Compile.Of_source.compile_string contents v_syntax in - let%bind typed,_ = Compile.Of_simplified.compile Env simplified in + let%bind imperative = Compile.Of_source.compile_string contents v_syntax in + let%bind sugar = Ligo.Compile.Of_imperative.compile imperative in + let%bind core = Ligo.Compile.Of_sugar.compile sugar in + let%bind typed,_ = Compile.Of_core.compile Env core in let%bind mini_c = Compile.Of_typed.compile typed in bind_map_list (fun ((_, _, exp),_) -> Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp) diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index 704171e01..948704894 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -6,8 +6,7 @@ let mfile = "./contracts/multisig.mligo" let refile = "./contracts/multisig.religo" let type_file f s = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name s) in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f s (Contract "main") in ok @@ (typed,state) let get_program f st = @@ -29,7 +28,7 @@ let compile_main f s () = Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_simplified +open Ast_imperative let init_storage threshold counter pkeys = let keys = List.map @@ -175,12 +174,12 @@ let main = test_suite "Multisig" [ test "valid_2_of_3 (mligo)" (valid_2_of_3 mfile "cameligo"); test "invalid_3_of_3 (mligo)" (invalid_3_of_3 mfile "cameligo"); test "not_enough_2_of_3 (mligo)" (not_enough_2_of_3 mfile "cameligo"); - test "compile (religo)" (compile_main refile "reasonligo"); + test "compile (religo)" (compile_main refile "reasonligo"); test "unmatching_counter (religo)" (unmatching_counter refile "reasonligo"); - test "valid_1_of_1 (religo)" (valid_1_of_1 refile "reasonligo"); - test "invalid_1_of_1 (religo)" (invalid_1_of_1 refile "reasonligo"); - test "not_enough_signature (religo)" (not_enough_1_of_2 refile "reasonligo"); - test "valid_2_of_3 (religo)" (valid_2_of_3 refile "reasonligo"); - test "invalid_3_of_3 (religo)" (invalid_3_of_3 refile "reasonligo"); - test "not_enough_2_of_3 (religo)" (not_enough_2_of_3 refile "reasonligo"); + test "valid_1_of_1 (religo)" (valid_1_of_1 refile "reasonligo"); + test "invalid_1_of_1 (religo)" (invalid_1_of_1 refile "reasonligo"); + test "not_enough_signature (religo)" (not_enough_1_of_2 refile "reasonligo"); + test "valid_2_of_3 (religo)" (valid_2_of_3 refile "reasonligo"); + test "invalid_3_of_3 (religo)" (invalid_3_of_3 refile "reasonligo"); + test "not_enough_2_of_3 (religo)" (not_enough_2_of_3 refile "reasonligo"); ] diff --git a/src/test/multisig_v2_tests.ml b/src/test/multisig_v2_tests.ml index 391be83d2..8b2b8972b 100644 --- a/src/test/multisig_v2_tests.ml +++ b/src/test/multisig_v2_tests.ml @@ -2,8 +2,7 @@ open Trace open Test_helpers let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "pascaligo" (Contract "main") in ok @@ (typed,state) let get_program = @@ -17,16 +16,15 @@ let get_program = ) let compile_main () = - let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/multisig-v2.ligo" (Syntax_name "pascaligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in - let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in - let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in + let%bind typed_prg,_ = get_program () in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = (* fails if the given entry point is not a valid contract *) Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_simplified +open Ast_imperative let empty_op_list = (e_typed_list [] t_operation) diff --git a/src/test/pledge_tests.ml b/src/test/pledge_tests.ml index d6af4f369..4f6df8a01 100644 --- a/src/test/pledge_tests.ml +++ b/src/test/pledge_tests.ml @@ -1,11 +1,9 @@ open Trace open Test_helpers -open Ast_simplified - +open Ast_imperative let retype_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "reasonligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile Env simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "reasonligo" Env in ok (typed,state) let get_program = @@ -19,10 +17,9 @@ let get_program = ) let compile_main () = - let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/pledge.religo" (Syntax_name "reasonligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile Env simplified in - let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in - let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in + let%bind typed_prg,_ = get_program () in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = (* fails if the given entry point is not a valid contract *) Ligo.Compile.Of_michelson.build_contract michelson_prg in diff --git a/src/test/replaceable_id_tests.ml b/src/test/replaceable_id_tests.ml index 60bcb203e..1c634c611 100644 --- a/src/test/replaceable_id_tests.ml +++ b/src/test/replaceable_id_tests.ml @@ -2,8 +2,7 @@ open Trace open Test_helpers let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "pascaligo" (Contract "main") in ok @@ (typed,state) let get_program = @@ -17,15 +16,15 @@ let get_program = ) let compile_main () = - let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/replaceable_id.ligo" (Syntax_name "pascaligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed_prg,_ = get_program () in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = (* fails if the given entry point is not a valid contract *) Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_simplified + +open Ast_imperative let empty_op_list = (e_typed_list [] t_operation) diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index f7ca0f320..ded88c33b 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -29,15 +29,21 @@ let test name f = let test_suite name lst = Test_suite (name , lst) +let expression_to_core expression = + let%bind sugar = Compile.Of_imperative.compile_expression expression in + let%bind core = Compile.Of_sugar.compile_expression sugar in + ok @@ core -open Ast_simplified +open Ast_imperative let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result = let%bind code = let env = Ast_typed.program_environment program in - let%bind (typed,_) = Compile.Of_simplified.compile_expression - ~env ~state:(Typer.Solver.initial_state) payload in + let%bind sugar = Compile.Of_imperative.compile_expression payload in + let%bind core = Compile.Of_sugar.compile_expression sugar in + let%bind (typed,_) = Compile.Of_core.compile_expression + ~env ~state:(Typer.Solver.initial_state) core in let%bind mini_c = Compile.Of_typed.compile_expression typed in Compile.Of_mini_c.compile_expression mini_c in let (Ex_ty payload_ty) = code.expr_ty in @@ -77,27 +83,29 @@ let sha_256_hash pl = let open Proto_alpha_utils.Memory_proto_alpha.Alpha_environment in Raw_hashes.sha256 pl -open Ast_simplified.Combinators +open Ast_imperative.Combinators -let typed_program_with_simplified_input_to_michelson +let typed_program_with_imperative_input_to_michelson (program: Ast_typed.program) (entry_point: string) - (input: Ast_simplified.expression) : Compiler.compiled_expression result = + (input: Ast_imperative.expression) : Compiler.compiled_expression result = Printexc.record_backtrace true; let env = Ast_typed.program_environment program in let state = Typer.Solver.initial_state in - let%bind app = Compile.Of_simplified.apply entry_point input in - let%bind (typed_app,_) = Compile.Of_simplified.compile_expression ~env ~state app in + let%bind sugar = Compile.Of_imperative.compile_expression input in + let%bind core = Compile.Of_sugar.compile_expression sugar in + let%bind app = Compile.Of_core.apply entry_point core in + let%bind (typed_app,_) = Compile.Of_core.compile_expression ~env ~state app in let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in let%bind mini_c_prg = Compile.Of_typed.compile program in Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied -let run_typed_program_with_simplified_input ?options +let run_typed_program_with_imperative_input ?options (program: Ast_typed.program) (entry_point: string) - (input: Ast_simplified.expression) : Ast_simplified.expression result = - let%bind michelson_program = typed_program_with_simplified_input_to_michelson program entry_point input in + (input: Ast_imperative.expression) : Ast_core.expression result = + let%bind michelson_program = typed_program_with_imperative_input_to_michelson program entry_point input in let%bind michelson_output = Ligo.Run.Of_michelson.run_no_failwith ?options michelson_program.expr michelson_program.expr_ty in Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output - + let expect ?options program entry_point input expecter = let%bind result = let run_error = @@ -106,7 +114,7 @@ let expect ?options program entry_point input expecter = error title content in trace run_error @@ - run_typed_program_with_simplified_input ?options program entry_point input in + run_typed_program_with_imperative_input ?options program entry_point input in expecter result let expect_fail ?options program entry_point input = @@ -117,10 +125,10 @@ let expect_fail ?options program entry_point input = in trace run_error @@ Assert.assert_fail @@ - run_typed_program_with_simplified_input ?options program entry_point input + run_typed_program_with_imperative_input ?options program entry_point input let expect_string_failwith ?options program entry_point input expected_failwith = - let%bind michelson_program = typed_program_with_simplified_input_to_michelson program entry_point input in + let%bind michelson_program = typed_program_with_imperative_input_to_michelson program entry_point input in let%bind err = Ligo.Run.Of_michelson.run_failwith ?options michelson_program.expr michelson_program.expr_ty in match err with @@ -128,15 +136,28 @@ let expect_string_failwith ?options program entry_point input expected_failwith | _ -> simple_fail "Expected to fail with a string" let expect_eq ?options program entry_point input expected = + let%bind expected = expression_to_core expected in let expecter = fun result -> let expect_error = let title () = "expect result" in let content () = Format.asprintf "Expected %a, got %a" - Ast_simplified.PP.expression expected - Ast_simplified.PP.expression result in + Ast_core.PP.expression expected + Ast_core.PP.expression result in error title content in trace expect_error @@ - Ast_simplified.Misc.assert_value_eq (expected , result) in + Ast_core.Misc.assert_value_eq (expected,result) in + expect ?options program entry_point input expecter + +let expect_eq_core ?options program entry_point input expected = + let expecter = fun result -> + let expect_error = + let title () = "expect result" in + let content () = Format.asprintf "Expected %a, got %a" + Ast_core.PP.expression expected + Ast_core.PP.expression result in + error title content in + trace expect_error @@ + Ast_core.Misc.assert_value_eq (expected,result) in expect ?options program entry_point input expecter let expect_evaluate program entry_point expecter = @@ -153,8 +174,9 @@ let expect_evaluate program entry_point expecter = expecter res_simpl let expect_eq_evaluate program entry_point expected = + let%bind expected = expression_to_core expected in let expecter = fun result -> - Ast_simplified.Misc.assert_value_eq (expected , result) in + Ast_core.Misc.assert_value_eq (expected , result) in expect_evaluate program entry_point expecter let expect_n_aux ?options lst program entry_point make_input make_expecter = @@ -183,7 +205,7 @@ let expect_eq_exp_trace_aux ?options explst program entry_point make_input make_ let aux exp = let%bind input = make_input exp in let%bind expected = make_expected exp in - let pps = Format.asprintf "%a" Ast_simplified.PP.expression exp in + let pps = Format.asprintf "%a" Ast_core.PP.expression exp in trace (simple_error ("expect_eq_exp " ^ pps )) @@ let result = expect_eq ?options program entry_point input expected in result @@ -195,7 +217,7 @@ let expect_failwith_exp_trace_aux ?options explst program entry_point make_input let aux exp = let%bind input = make_input exp in let%bind expected = make_expected_failwith exp in - let pps = Format.asprintf "%a" Ast_simplified.PP.expression exp in + let pps = Format.asprintf "%a" Ast_core.PP.expression exp in trace (simple_error ("expect_eq_exp " ^ pps )) @@ let result = expect_string_failwith ?options program entry_point input expected in result @@ -237,7 +259,6 @@ let expect_eq_n_int a b c = expect_eq_n a b e_int (fun n -> e_int (c n)) let expect_eq_b_bool a b c = - let open Ast_simplified.Combinators in expect_eq_b a b (fun bool -> e_bool (c bool)) diff --git a/src/test/time_lock_repeat_tests.ml b/src/test/time_lock_repeat_tests.ml index b5a3f7427..2720cfb64 100644 --- a/src/test/time_lock_repeat_tests.ml +++ b/src/test/time_lock_repeat_tests.ml @@ -1,10 +1,9 @@ open Trace open Test_helpers -open Ast_simplified +open Ast_imperative let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in ok @@ (typed,state) let get_program = @@ -18,8 +17,7 @@ let get_program = ) let compile_main () = - let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/timelock_repeat.mligo" (Syntax_name "cameligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed_prg,_ = type_file "./contracts/timelock_repeat.mligo" in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/time_lock_tests.ml b/src/test/time_lock_tests.ml index eb3001f49..e22cb1792 100644 --- a/src/test/time_lock_tests.ml +++ b/src/test/time_lock_tests.ml @@ -2,8 +2,7 @@ open Trace open Test_helpers let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "pascaligo" (Contract "main") in ok @@ (typed,state) let get_program = @@ -17,8 +16,7 @@ let get_program = ) let compile_main () = - let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/time-lock.ligo" (Syntax_name "pascaligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed_prg,_ = type_file "./contracts/time-lock.ligo" in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = @@ -26,7 +24,8 @@ let compile_main () = Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_simplified +open Ast_imperative + let empty_op_list = (e_typed_list [] t_operation) let empty_message = e_lambda (Var.of_name "arguments") diff --git a/src/test/typer_tests.ml b/src/test/typer_tests.ml index df0817ba8..57b06a7b7 100644 --- a/src/test/typer_tests.ml +++ b/src/test/typer_tests.ml @@ -1,10 +1,10 @@ open Trace -open Ast_simplified +open Ast_core open Test_helpers module Typed = Ast_typed module Typer = Typer -module Simplified = Ast_simplified +module Simplified = Ast_core let int () : unit result = let open Combinators in @@ -72,7 +72,7 @@ end (* TODO: deep types (e.g. record of record) TODO: negative tests (expected type error) *) -let main = test_suite "Typer (from simplified AST)" [ +let main = test_suite "Typer (from core AST)" [ test "int" int ; test "unit" TestExpressions.unit ; test "int2" TestExpressions.int ; diff --git a/src/test/vote_tests.ml b/src/test/vote_tests.ml index ddc3d620d..9122eff9e 100644 --- a/src/test/vote_tests.ml +++ b/src/test/vote_tests.ml @@ -2,8 +2,7 @@ open Trace open Test_helpers let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in + let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in ok @@ (typed,state) let get_program = @@ -16,7 +15,7 @@ let get_program = ok (program , state) ) -open Ast_simplified +open Ast_imperative let init_storage name = e_record_ez [ ("title" , e_string name) ; @@ -39,14 +38,14 @@ let yea = e_constructor "Vote" (e_constructor "Yea" (e_unit ())) let init_vote () = let%bind (program , _) = get_program () in let%bind result = - Test_helpers.run_typed_program_with_simplified_input + Test_helpers.run_typed_program_with_imperative_input program "main" (e_pair yea (init_storage "basic")) in - let%bind (_, storage) = extract_pair result in - let%bind storage' = extract_record storage in + let%bind (_, storage) = Ast_core.extract_pair result in + let%bind storage' = Ast_core.extract_record storage in (* let votes = List.assoc (Label "voters") storage' in let%bind votes' = extract_map votes in *) let yea = List.assoc (Label "yea") storage' in - let%bind () = Ast_simplified.Misc.assert_value_eq (yea, e_nat 1) in + let%bind () = Ast_core.Misc.assert_value_eq (yea, Ast_core.e_nat 1) in ok () let main = test_suite "Vote" [