diff --git a/gitlab-pages/docker-compose.yml b/gitlab-pages/docker-compose.yml index 79619bae3..90c32ea95 100644 --- a/gitlab-pages/docker-compose.yml +++ b/gitlab-pages/docker-compose.yml @@ -18,4 +18,5 @@ services: - ./website/sidebars.json:/app/website/sidebars.json - ./website/siteConfig.js:/app/website/siteConfig.js - ./website/versions.json:/app/website/versions.json + - ./website/node_modules/reason-highlightjs:/app/website/node_modules/reason-highlightjs working_dir: /app/website diff --git a/gitlab-pages/docs/language-basics/boolean-if-else.md b/gitlab-pages/docs/language-basics/boolean-if-else.md index a2059b697..7dfabba45 100644 --- a/gitlab-pages/docs/language-basics/boolean-if-else.md +++ b/gitlab-pages/docs/language-basics/boolean-if-else.md @@ -20,6 +20,12 @@ const b: bool = False; let a: bool = true let b: bool = false ``` + + +```reasonligo +let a: bool = true; +let b: bool = false; +``` @@ -44,6 +50,13 @@ let b: string = "Alice" // true let c: bool = (a = b) ``` + +```reasonligo +let a: string = "Alice"; +let b: string = "Alice"; +// true +let c: bool = (a == b); +``` @@ -72,6 +85,18 @@ let f: bool = (a <= b) let g: bool = (a >= b) let h: bool = (a =/= b) ``` + + +```reasonligo +let a: int = 5; +let b: int = 4; +let c: bool = (a == b); +let d: bool = (a > b); +let e: bool = (a < b); +let f: bool = (a <= b); +let g: bool = (a >= b); +let h: bool = (a != b); +``` @@ -93,6 +118,13 @@ let b: tez = 10mutez // false let c: bool = (a = b) ``` + +```reasonligo +let a: tez = 5mutez; +let b: tez = 10mutez; +// false +let c: bool = (a == b); +``` @@ -144,6 +176,26 @@ let min_age: nat = 16n let is_adult (age: nat) : bool = if (age > min_age) then true else false ``` + +```reasonligo +let min_age: nat = 16n; + +/** + + This function is really obnoxious, but it showcases + how the if statement and it's syntax can be used. + + Normally, you'd use `with (age > min_age)` instead. + +*/ + +let is_adult = (age: nat): bool => + if (age > min_age) { + true; + } else { + false; + }; +``` > You can run the function above with > ``` diff --git a/gitlab-pages/docs/language-basics/functions.md b/gitlab-pages/docs/language-basics/functions.md index d618779c7..189d5a3e1 100644 --- a/gitlab-pages/docs/language-basics/functions.md +++ b/gitlab-pages/docs/language-basics/functions.md @@ -99,4 +99,9 @@ const a: int = increment(1); let increment : (int -> int) = fun (i: int) -> i + 1 ``` + +```reasonligo +let increment: (int => int) = (i: int) => i + 1; +``` + diff --git a/gitlab-pages/docs/language-basics/maps-records.md b/gitlab-pages/docs/language-basics/maps-records.md index 7b8471290..60e6d4bd9 100644 --- a/gitlab-pages/docs/language-basics/maps-records.md +++ b/gitlab-pages/docs/language-basics/maps-records.md @@ -22,6 +22,11 @@ type ledger is map(address, tez); type ledger = (address, tez) map ``` + +```reasonligo +type ledger = map(address, tez); +``` + And here's how a map value is populated: @@ -51,6 +56,20 @@ let ledger: ledger = Map.literal > Note also the `;` to separate individual map entries. > > `("": address)` means that we type-cast a string into an address. + + + +```reasonligo +let ledger: ledger = + Map.literal([ + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, 1000(mutez)), + ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, 2000(mutez)), + ]); + +> Map.literal constructs the map from a list of key-value pair tuples, `(, )`. +> +> `("": address)` means that we type-cast a string into an address. +``` ### Accessing map values by key @@ -68,6 +87,13 @@ const balance: option(tez) = ledger[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": add ```cameligo let balance: tez option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) ledger ``` + + + +```reasonligo +let balance: option(tez) = + Map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, ledger); +``` #### Obtaining a map value forcefully @@ -86,6 +112,13 @@ const balance: tez = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) let balance: tez = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) ledger ``` + + +```reasonligo +let balance: tez = + Map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, ledger); +``` + ### Iteration over the contents of a map @@ -112,6 +145,14 @@ let iter_op (m : ledger) : unit = let assert_eq = fun (i: address) (j: tez) -> assert (j > 100) in Map.iter assert_eq m ``` + + +```reasonligo +let iter_op = (m: ledger): unit => { + let assert_eq = (i: address, j: tez) => assert(j > 100); + Map.iter(assert_eq, m); +}; +``` `map` is a way to create a new map by modifying the contents of an existing one. @@ -131,6 +172,14 @@ let map_op (m : ledger) : ledger = let increment = fun (_: address) (j: tez) -> j+1 in Map.map increment m ``` + + +```reasonligo +let map_op = (m: ledger): ledger => { + let increment = (ignore: address, j: tez) => j + 1; + Map.map(increment, m); +}; +``` `fold` is an aggregation function that return the combination of a maps contents. @@ -154,10 +203,19 @@ function fold_op (const m : ledger) : tez is ```cameligo let fold_op (m : ledger) : ledger = - let aggregate = fun (_: address) (j: tez * tez) -> j.0 + j.1 + let aggregate = fun (ignore: address) (j: tez * tez) -> j.0 + j.1 in Map.fold aggregate m 10 ``` + +```reasonligo +let fold_op = (m: ledger): ledger => { + let aggregate = (ignore: address, j: (tez, tez)) => j[0] + j[1]; + Map.fold(aggregate, m, 10); +}; + +``` + ## Records @@ -185,6 +243,15 @@ type user = { } ``` + +```reasonligo +type user = { + id: nat, + is_admin: bool, + name: string +}; +``` + And here's how a record value is populated: @@ -208,6 +275,14 @@ let user: user = { } ``` + +```reasonligo +let user: user = { + id: 1n, + is_admin: true, + name: "Alice" +}; +``` @@ -226,4 +301,9 @@ const is_admin: bool = user.is_admin; let is_admin: bool = user.is_admin ``` + +```reasonligo +let is_admin: bool = user.is_admin; +``` + diff --git a/gitlab-pages/docs/language-basics/math-numbers-tez.md b/gitlab-pages/docs/language-basics/math-numbers-tez.md index 83a591ecd..8ad4ecc96 100644 --- a/gitlab-pages/docs/language-basics/math-numbers-tez.md +++ b/gitlab-pages/docs/language-basics/math-numbers-tez.md @@ -60,6 +60,29 @@ let g: int = 1_000_000 >let g: int = 1_000_000; >``` + + +```reasonligo +// int + int produces int +let a: int = 5 + 10; +// nat + int produces int +let b: int = 5n + 10; +// tez + tez produces tez +let c: tez = 5mutez + 10mutez; +// you can't add tez + int or tez + nat, this won't compile +// let d: tez = 5mutez + 10n; +let e: nat = 5n + 10n; +// nat + int produces an int, this won't compile +// let f: nat = 5n + 10; +let g: int = 1_000_000; +``` + +> Pro tip: you can use underscores for readability when defining large numbers +> +>```reasonligo +>let g: int = 1_000_000; +>``` + ## Subtraction @@ -89,6 +112,16 @@ let b: int = 5n - 2n let d: tez = 5mutez - 1mt ``` + +```reasonligo +let a: int = 5 - 10; +// substraction of two nats, yields an int +let b: int = 5n - 2n; +// won't compile, result is an int, not a nat +// let c: nat = 5n - 2n; +let d: tez = 5mutez - 1mt; +``` + @@ -114,6 +147,14 @@ let b: nat = 5n * 5n let c: tez = 5n * 5mutez ``` + +```reasonligo +let a: int = 5 * 5; +let b: nat = 5n * 5n; +// you can also multiply `nat` and `tez` +let c: tez = 5n * 5mutez; +``` + @@ -138,6 +179,13 @@ let b: nat = 10n / 3n let c: nat = 10mutez / 3mutez ``` + +```reasonligo +let a: int = 10 / 3; +let b: nat = 10n / 3n; +let c: nat = 10mutez / 3mutez; +``` + ## From `int` to `nat` and back diff --git a/gitlab-pages/docs/language-basics/sets-lists-touples.md b/gitlab-pages/docs/language-basics/sets-lists-touples.md index 5c71338c8..ca8638234 100644 --- a/gitlab-pages/docs/language-basics/sets-lists-touples.md +++ b/gitlab-pages/docs/language-basics/sets-lists-touples.md @@ -31,6 +31,13 @@ let my_set: int_set = Set.add 3 (Set.add 2 (Set.add 1 (Set.empty: int set))) ``` + +```reasonligo +type int_set = set(int); +let my_set: int_set = + Set.add(3, Set.add(2, Set.add(1, Set.empty: set(int)))); +``` + ### Empty sets @@ -45,7 +52,10 @@ const my_set_2: int_set = set_empty; ```cameligo let my_set: int_set = (Set.empty: int set) ``` - + +```reasonligo +let my_set: int_set = (Set.empty: set(int)); +``` ### Checking if set contains an element @@ -62,6 +72,10 @@ const contains_three_fn: bool = set_mem(3, my_set); ```cameligo let contains_three: bool = Set.mem 3 my_set ``` + +```reasonligo +let contains_three: bool = Set.mem(3, my_set); +``` @@ -78,6 +92,11 @@ const set_size: nat = size(my_set); let set_size: nat = Set.size my_set ``` + +```reasonligo +let set_size: nat = Set.size(my_set); +``` + @@ -96,6 +115,13 @@ let larger_set: int_set = Set.add 4 my_set let smaller_set: int_set = Set.remove 3 my_set ``` + + +```reasonligo +let larger_set: int_set = Set.add(4, my_set); +let smaller_set: int_set = Set.remove(3, my_set); +``` + @@ -114,6 +140,11 @@ let sum (result: int) (i: int) : int = result + i let sum_of_a_set: int = Set.fold sum my_set 0 ``` + +```reasonligo +let sum = (result: int, i: int): int => result + i; +let sum_of_a_set: int = Set.fold(sum, my_set, 0); +``` ## Lists @@ -141,6 +172,12 @@ type int_list = int list let my_list: int_list = [1; 2; 3] ``` + +```reasonligo +type int_list = list(int); +let my_list: int_list = [1, 2, 3]; +``` + @@ -159,6 +196,12 @@ let larger_list: int_list = 4 :: my_list (* CameLIGO doesn't have a List.cons *) ``` + +```reasonligo +let larger_list: int_list = [4, ...my_list]; +/* Reasonligo doesn't have a List.cons */ +``` +
@@ -182,6 +225,15 @@ let increment (i: int) : int = i + 1 let incremented_list: int_list = List.map increment larger_list ``` + + + +```reasonligo +let increment = (i: int): int => i + 1; +/* Creates a new list with elements incremented by 1 */ +let incremented_list: int_list = List.map(increment, larger_list); +``` + @@ -202,6 +254,14 @@ let sum (result: int) (i: int) : int = result + i let sum_of_a_list: int = List.fold sum my_list 0 ``` + + +```reasonligo +let sum = (result: int, i: int): int => result + i; +// Outputs 6 +let sum_of_a_list: int = List.fold(sum, my_list, 0); +``` + @@ -239,6 +299,13 @@ type full_name = string * string let full_name: full_name = ("Alice", "Johnson") ``` + +```reasonligo +type full_name = (string, string); +/* The parenthesis here are optional */ +let full_name: full_name = ("Alice", "Johnson"); +``` + @@ -262,4 +329,9 @@ const first_name: string = full_name.1; let first_name: string = full_name.1 ``` + +```reasonligo +let first_name: string = full_name[1]; +``` + diff --git a/gitlab-pages/docs/language-basics/strings.md b/gitlab-pages/docs/language-basics/strings.md index 608fd64e8..16efeba0d 100644 --- a/gitlab-pages/docs/language-basics/strings.md +++ b/gitlab-pages/docs/language-basics/strings.md @@ -39,6 +39,12 @@ let name: string = "Alice" let greeting: string = "Hello" let full_greeting: string = greeting ^ " " ^ name ``` + +```reasonligo +let name: string = "Alice"; +let greeting: string = "Hello"; +let full_greeting: string = greeting ++ " " ++ name; +``` @@ -58,6 +64,11 @@ const slice: string = string_slice(0n, 1n, name); let name: string = "Alice" let slice: string = String.slice 0n 1n name ``` + +```reasonligo +let name: string = "Alice"; +let slice: string = String.slice(0n, 1n, name); +``` > ⚠️ Notice that the `offset` and slice `length` are `nats` @@ -78,4 +89,9 @@ const length: nat = size(name); let name: string = "Alice" let length: nat = String.size name ``` + +```reasonligo +let name: string = "Alice"; +let length: nat = String.size(name); +``` \ No newline at end of file diff --git a/gitlab-pages/docs/language-basics/types.md b/gitlab-pages/docs/language-basics/types.md index 614e4b11b..32289c2a3 100644 --- a/gitlab-pages/docs/language-basics/types.md +++ b/gitlab-pages/docs/language-basics/types.md @@ -27,6 +27,13 @@ type animal_breed = string let dog_breed: animal_breed = "Saluki" ``` + + +```reasonligo +type animal_breed = string; +let dog_breed: animal_breed = "Saluki"; +``` + ## Simple types @@ -44,12 +51,23 @@ end ```cameligo // account_balances is a simple type, a map of address <-> tez -type account_balances is (address, tez) map +type account_balances = (address, tez) map let ledger: account_balances = Map.literal [(("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address), 10mutez)] ``` + +```reasonligo +// account_balances is a simple type, a map of address <-> tez +type account_balances = map(address, tez); + +let ledger: account_balances = + Map.literal([ + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, 10(mutez)), + ]); +``` + ## Composed types @@ -104,4 +122,29 @@ let ledger: account_balances = Map.literal )] ``` + +```reasonligo +/* alias two types */ +type account = address; +type number_of_transactions = nat; +/* account_data consists of a record with two fields (balance, number_of_transactions) */ +type account_data = { + balance: tez, + number_of_transactions, +}; +/* our ledger / account_balances is a map of account <-> account_data */ +type account_balances = map(account, account_data); + +// pseudo-JSON representation of our map +// {"tz1...": {balance: 10mutez, number_of_transactions: 5n}} +let ledger: account_balances = + Map.literal([ + ( + "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, + {balance: 10(mutez), number_of_transactions: 5n}, + ), + ]); + +``` + diff --git a/gitlab-pages/docs/language-basics/unit-option-pattern-matching.md b/gitlab-pages/docs/language-basics/unit-option-pattern-matching.md index cbd7ddecc..567890145 100644 --- a/gitlab-pages/docs/language-basics/unit-option-pattern-matching.md +++ b/gitlab-pages/docs/language-basics/unit-option-pattern-matching.md @@ -24,6 +24,11 @@ const n: unit = Unit; let n: unit = () ``` + +```reasonligo +let n: unit = (); +``` + ## Variants @@ -57,6 +62,18 @@ let u: user = Admin 1000n let g: user = Guest () ``` + +```reasonligo +type id = nat; +type user = + | Admin(id) + | Manager(id) + | Guest(unit); + +let u: user = Admin(1000n); +let g: user = Guest(); +``` + Defining a varient can be extremely useful for building semantically appealing contracts. We'll learn how to use variants for 'logic purposes' shortly. @@ -84,6 +101,14 @@ let p1: dinner = None let p2: dinner = Some "Hamburgers" ``` + +```reasonligo +type dinner = option(string); + +let p1: dinner = None; +let p2: dinner = Some("Hamburgers"); +``` + @@ -113,4 +138,14 @@ let is_hungry (d: dinner) : bool = | Some s -> false ``` + +```reasonligo +type dinner = option(string); +let is_hungry = (d: dinner): bool => + switch (d) { + | None => true + | Some(s) => false + }; +``` + diff --git a/gitlab-pages/docs/language-basics/variables-and-constants.md b/gitlab-pages/docs/language-basics/variables-and-constants.md index 3823c0635..2c29f18c6 100644 --- a/gitlab-pages/docs/language-basics/variables-and-constants.md +++ b/gitlab-pages/docs/language-basics/variables-and-constants.md @@ -32,6 +32,17 @@ ligo evaluate-value -s cameligo gitlab-pages/docs/language-basics/src/variables- # Outputs: 25 ``` + +```reasonligo +let age: int = 25; +``` + +You can evaluate the constant definition above using the following CLI command: +```shell +ligo evaluate-value -s reasonligo gitlab-pages/docs/language-basics/src/variables-and-constants/const.religo age +# Outputs: 25 +``` + ## Variables @@ -77,7 +88,7 @@ with a new value being bound in place of the old one. ```cameligo -let add(const a: int; const b: int) : int = +let add (a: int) (b: int) : int = let c : int = a + b in c ``` @@ -87,5 +98,27 @@ You can run the `add` function defined above using the LIGO compiler like this: ligo run-function -s cameligo gitlab-pages/docs/language-basics/src/variables-and-constants/add.mligo add '(1,1)' # Outputs: 2 ``` + + +As expected from a functional language, Reasonligo uses value-binding +for variables rather than assignment. Variables are changed by replacement, +with a new value being bound in place of the old one. + +> 💡 Don't worry if you don't understand the function syntax yet. We'll get to it in upcoming sections of the docs. + +```reasonligo + +let add = (a: int, b: int): int => { + let c: int = a + b; + c; +}; +``` + +You can run the `add` function defined above using the LIGO compiler like this: + +```shell +ligo run-function -s reasonligo gitlab-pages/docs/language-basics/src/variables-and-constants/add.religo add '(1,1)' +# Outputs: 2 +``` diff --git a/gitlab-pages/website/core/CodeExamples.js b/gitlab-pages/website/core/CodeExamples.js index 7734e0074..0b636c356 100644 --- a/gitlab-pages/website/core/CodeExamples.js +++ b/gitlab-pages/website/core/CodeExamples.js @@ -44,6 +44,34 @@ let%entry main(p : action) storage = in (([] : operation list), storage) ${pre}`; + +const REASONLIGO_EXAMPLE = `${pre}reasonligo +type storage = int; + +/* variant defining pseudo multi-entrypoint + actions */ +type action = + | Increment(int) + | Decrement(int); + +let add = (a: int, b: int): int => a + b; + +let subtract = (a: int, b: int): int => a - b; + +/* real entrypoint that re-routes the flow + based on the action provided */ +let main = (p: action, storage) => { + let storage = + switch (p) { + | Increment(n) => add(storage, n) + | Decrement(n) => subtract(storage, n) + }; + ([]: list(operation), storage); +}; + +${pre}`; + + module.exports = props => { const MarkdownBlock = props.MarkdownBlock; @@ -60,7 +88,9 @@ module.exports = props => {
CameLIGO
-
ReasonLIGO (coming soon)
+
+ ReasonLIGO +
@@ -69,6 +99,9 @@ module.exports = props => {
{CAMELIGO_EXAMPLE}
+
+ {REASONLIGO_EXAMPLE} +
); diff --git a/gitlab-pages/website/package.json b/gitlab-pages/website/package.json index e32ea799e..665cdff84 100644 --- a/gitlab-pages/website/package.json +++ b/gitlab-pages/website/package.json @@ -11,6 +11,7 @@ "rename-version": "docusaurus-rename-version" }, "devDependencies": { - "docusaurus": "^1.14.0" + "docusaurus": "^1.14.0", + "reason-highlightjs": "0.2.1" } } diff --git a/gitlab-pages/website/siteConfig.js b/gitlab-pages/website/siteConfig.js index a18999197..c42f07a31 100644 --- a/gitlab-pages/website/siteConfig.js +++ b/gitlab-pages/website/siteConfig.js @@ -1,5 +1,7 @@ const repoUrl = 'https://gitlab.com/ligolang/ligo'; +let reasonHighlightJs = require('reason-highlightjs'); + const siteConfig = { title: 'LIGO', // Title for your website. tagline: 'LIGO is a friendly smart-contract language for Tezos', @@ -77,8 +79,9 @@ const siteConfig = { highlight: { // Highlight.js theme to use for syntax highlighting in code blocks. theme: 'default', - hljs: function(hljs) { - hljs.registerLanguage('pascaligo', function(hljs) { + hljs: function (hljs) { + hljs.registerLanguage('reasonligo', reasonHighlightJs); + hljs.registerLanguage('pascaligo', function (hljs) { return { // case_insensitive: true, beginKeywords: '', diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 663c989e7..1adbc05f9 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -1,7 +1,7 @@ open Trace type s_syntax = Syntax_name of string -type v_syntax = Pascaligo | Cameligo +type v_syntax = Pascaligo | Cameligo | ReasonLIGO let syntax_to_variant : s_syntax -> string option -> v_syntax result = fun syntax source_filename -> @@ -16,9 +16,11 @@ let syntax_to_variant : s_syntax -> string option -> v_syntax result = match (syntax , source_filename) with | "auto" , Some sf when endswith sf ".ligo" -> ok Pascaligo | "auto" , Some sf when endswith sf ".mligo" -> ok Cameligo + | "auto" , Some sf when endswith sf ".religo" -> ok ReasonLIGO | "auto" , _ -> simple_fail "cannot auto-detect syntax, pleas use -s name_of_syntax" | "pascaligo" , _ -> ok Pascaligo | "cameligo" , _ -> ok Cameligo + | "reasonligo", _ -> ok ReasonLIGO | _ -> simple_fail "unrecognized parser" let parsify_pascaligo = fun source -> @@ -57,10 +59,38 @@ let parsify_expression_ligodity = fun source -> Simplify.Ligodity.simpl_expression raw in ok simplified +let parsify_reasonligo = fun source -> + let%bind raw = + trace (simple_error "parsing") @@ + Parser.Reasonligo.parse_file source in + let%bind simplified = + trace (simple_error "simplifying") @@ + Simplify.Ligodity.simpl_program raw in + ok simplified + +let parsify_string_reasonligo = fun source -> + let%bind raw = + trace (simple_error "parsing") @@ + Parser.Reasonligo.parse_string source in + let%bind simplified = + trace (simple_error "simplifying") @@ + Simplify.Ligodity.simpl_program raw in + ok simplified + +let parsify_expression_reasonligo = fun source -> + let%bind raw = + trace (simple_error "parsing expression") @@ + Parser.Reasonligo.parse_expression source in + let%bind simplified = + trace (simple_error "simplifying expression") @@ + Simplify.Ligodity.simpl_expression raw in + ok simplified + let parsify = fun (syntax : v_syntax) source_filename -> let%bind parsify = match syntax with | Pascaligo -> ok parsify_pascaligo | Cameligo -> ok parsify_ligodity + | ReasonLIGO -> ok parsify_reasonligo in let%bind parsified = parsify source_filename in let%bind applied = Self_ast_simplified.all_program parsified in @@ -70,6 +100,7 @@ let parsify_expression = fun syntax source -> let%bind parsify = match syntax with | Pascaligo -> ok parsify_expression_pascaligo | Cameligo -> ok parsify_expression_ligodity + | ReasonLIGO -> ok parsify_expression_reasonligo in let%bind parsified = parsify source in let%bind applied = Self_ast_simplified.all_expression parsified in diff --git a/src/passes/1-parser/dune b/src/passes/1-parser/dune index da0988ab2..31b20fb26 100644 --- a/src/passes/1-parser/dune +++ b/src/passes/1-parser/dune @@ -8,6 +8,7 @@ parser_pascaligo parser_camligo parser_ligodity + parser_reasonligo ) (preprocess (pps ppx_let) diff --git a/src/passes/1-parser/ligodity/.Lexer.ml.tag b/src/passes/1-parser/ligodity/.Lexer.ml.tag deleted file mode 100644 index 051eeceb0..000000000 --- a/src/passes/1-parser/ligodity/.Lexer.ml.tag +++ /dev/null @@ -1 +0,0 @@ -ocamlc: -w -42 diff --git a/src/passes/1-parser/parser.ml b/src/passes/1-parser/parser.ml index e53e2913d..b69094d5c 100644 --- a/src/passes/1-parser/parser.ml +++ b/src/passes/1-parser/parser.ml @@ -1,5 +1,6 @@ module Pascaligo = Pascaligo module Camligo = Parser_camligo module Ligodity = Ligodity +module Reasonligo = Reasonligo diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml new file mode 100644 index 000000000..7c335bc94 --- /dev/null +++ b/src/passes/1-parser/reasonligo.ml @@ -0,0 +1,112 @@ +open Trace + +module Parser = Parser_reasonligo.Parser +module AST = Parser_ligodity.AST +module ParserLog = Parser_ligodity.ParserLog +module LexToken = Parser_reasonligo.LexToken +module Lexer = Lexer.Make(LexToken) + +let parse_file (source: string) : AST.t result = + let pp_input = + let prefix = Filename.(source |> basename |> remove_extension) + and suffix = ".pp.religo" + in prefix ^ suffix in + + let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s" + source pp_input in + let%bind () = sys_command cpp_cmd in + + let%bind channel = + generic_try (simple_error "error opening file") @@ + (fun () -> open_in pp_input) in + let lexbuf = Lexing.from_channel channel in + let Lexer.{read ; close ; _} = + Lexer.open_token_stream None in + specific_try (function + | Parser.Error -> ( + let start = Lexing.lexeme_start_p lexbuf in + let end_ = Lexing.lexeme_end_p lexbuf in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + start.pos_fname source + in + simple_error str + ) + | exn -> + let start = Lexing.lexeme_start_p lexbuf in + let end_ = Lexing.lexeme_end_p lexbuf in + let str = Format.sprintf + "Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n" + (Printexc.to_string exn) + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + start.pos_fname source + in + simple_error str + ) @@ (fun () -> + let raw = Parser.contract read lexbuf in + close () ; + raw + ) >>? fun raw -> + ok raw + +let parse_string (s:string) : AST.t result = + let lexbuf = Lexing.from_string s in + let Lexer.{read ; close ; _} = + Lexer.open_token_stream None in + specific_try (function + | Parser.Error -> ( + let start = Lexing.lexeme_start_p lexbuf in + let end_ = Lexing.lexeme_end_p lexbuf in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d)\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in + simple_error str + ) + | _ -> simple_error "unrecognized parse_ error" + ) @@ (fun () -> + let raw = Parser.contract read lexbuf in + close () ; + raw + ) >>? fun raw -> + ok raw + +let parse_expression (s:string) : AST.expr result = + let lexbuf = Lexing.from_string s in + let Lexer.{read ; close; _} = + Lexer.open_token_stream None in + specific_try (function + | Parser.Error -> ( + let start = Lexing.lexeme_start_p lexbuf in + let end_ = Lexing.lexeme_end_p lexbuf in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d)\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in + simple_error str + ) + | exn -> + let start = Lexing.lexeme_start_p lexbuf in + let end_ = Lexing.lexeme_end_p lexbuf in + let str = Format.sprintf + "Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n" + (Printexc.to_string exn) + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + start.pos_fname s + in + simple_error str + ) @@ (fun () -> + let raw = Parser.interactive_expr read lexbuf in + close () ; + raw + ) >>? fun raw -> + ok raw diff --git a/src/passes/1-parser/reasonligo/LexToken.mli b/src/passes/1-parser/reasonligo/LexToken.mli new file mode 100644 index 000000000..29ef4d2da --- /dev/null +++ b/src/passes/1-parser/reasonligo/LexToken.mli @@ -0,0 +1,158 @@ +(* This signature defines the lexical tokens for LIGO + + _Tokens_ are the abstract units which are used by the parser to + build the abstract syntax tree (AST), in other words, the stream of + tokens is the minimal model of the input program, carrying + implicitly all its structure in a linear encoding, and nothing + else, in particular, comments and whitespace are absent. + + A _lexeme_ is a specific character string (concrete + representation) denoting a token (abstract representation). Tokens + can be thought of as sets, and lexemes as elements of those sets -- + there is often an infinite number of lexemes, but a small number of + tokens. (Think of identifiers as lexemes and one token.) + + The tokens are qualified here as being "lexical" because the + parser generator Menhir expects to define them, in which context + they are called "parsing tokens", and they are made to match each + other. (This is an idiosyncratic terminology.) + + The type of the lexical tokens is the variant [t], also + aliased to [token]. +*) + +module Region = Simple_utils.Region +module Pos = Simple_utils.Pos + +type lexeme = string + +(* TOKENS *) + +type t = + (* Symbols *) + + CAT of Region.t (* "++" *) + + (* Arithmetics *) + +| MINUS of Region.t (* "-" *) +| PLUS of Region.t (* "+" *) +| SLASH of Region.t (* "/" *) +| TIMES of Region.t (* "*" *) + + (* Compounds *) + +| LPAR of Region.t (* "(" *) +| RPAR of Region.t (* ")" *) +| LBRACKET of Region.t (* "[" *) +| RBRACKET of Region.t (* "]" *) +| LBRACE of Region.t (* "{" *) +| RBRACE of Region.t (* "}" *) + + (* Separators *) + +| COMMA of Region.t (* "," *) +| SEMI of Region.t (* ";" *) +| VBAR of Region.t (* "|" *) +| COLON of Region.t (* ":" *) +| DOT of Region.t (* "." *) +| DOTDOTDOT of Region.t (* "..." *) + + (* Wildcard *) + +| WILD of Region.t (* "_" *) + + (* Comparisons *) + +| EQ of Region.t (* "=" *) +| EQEQ of Region.t (* "=" *) +| NE of Region.t (* "!=" *) +| LT of Region.t (* "<" *) +| GT of Region.t (* ">" *) +| LE of Region.t (* "=<" *) +| GE of Region.t (* ">=" *) +| ARROW of Region.t (* "=>" *) + +| BOOL_OR of Region.t (* "||" *) +| BOOL_AND of Region.t(* "&&" *) + +| NOT of Region.t (* ! *) + + (* Identifiers, labels, numbers and strings *) + +| Ident of string Region.reg +| Constr of string Region.reg +| Int of (string * Z.t) Region.reg +| Nat of (string * Z.t) Region.reg +| Mtz of (string * Z.t) Region.reg +| Str of string Region.reg +| Bytes of (string * Hex.t) Region.reg + + (* Keywords *) + +| Else of Region.t +| False of Region.t +| If of Region.t +| Let of Region.t +| Switch of Region.t +| Mod of Region.t +| Or of Region.t +| True of Region.t +| Type of Region.t + +(* Data constructors *) + +| C_None of Region.t (* "None" *) +| C_Some of Region.t (* "Some" *) + +(* Virtual tokens *) + +| EOF of Region.t (* End of file *) + +type token = t + +(* Projections + + The difference between extracting the lexeme and a string from a + token is that the latter is the textual representation of the OCaml + value denoting the token (its abstract syntax), rather than its + lexeme (concrete syntax). +*) + +val to_lexeme : token -> lexeme +val to_string : token -> ?offsets:bool -> [`Byte | `Point] -> string +val to_region : token -> Region.t + +(* comments *) +val block_comment_start : lexeme -> bool +val block_comment_end : lexeme -> bool +val line_comment_start : lexeme -> bool + +(* Injections *) + +type int_err = Non_canonical_zero +type ident_err = Reserved_name +type nat_err = Invalid_natural + | Non_canonical_zero_nat +type sym_err = Invalid_symbol + +val mk_string : lexeme -> Region.t -> token +val mk_bytes : lexeme -> Region.t -> token +val mk_int : lexeme -> Region.t -> (token, int_err) result +val mk_nat : lexeme -> Region.t -> (token, nat_err) result +val mk_mutez : lexeme -> Region.t -> (token, int_err) result +val mk_ident : lexeme -> Region.t -> (token, ident_err) result +val mk_constr : lexeme -> Region.t -> token +val mk_sym : lexeme -> Region.t -> (token, sym_err) result +val eof : Region.t -> token + +(* Predicates *) + +val is_string : token -> bool +val is_bytes : token -> bool +val is_int : token -> bool +val is_ident : token -> bool +val is_kwd : token -> bool +val is_constr : token -> bool +val is_sym : token -> bool +val is_eof : token -> bool diff --git a/src/passes/1-parser/reasonligo/LexToken.mll b/src/passes/1-parser/reasonligo/LexToken.mll new file mode 100644 index 000000000..fc6bb4ce7 --- /dev/null +++ b/src/passes/1-parser/reasonligo/LexToken.mll @@ -0,0 +1,504 @@ +{ +type lexeme = string + +let sprintf = Printf.sprintf + +module Region = Simple_utils.Region +module Pos = Simple_utils.Pos +module SMap = Utils.String.Map +module SSet = Utils.String.Set + +(* TOKENS *) + +type t = + (* Symbols *) + + CAT of Region.t (* "++" *) + + (* Arithmetics *) + +| MINUS of Region.t (* "-" *) +| PLUS of Region.t (* "+" *) +| SLASH of Region.t (* "/" *) +| TIMES of Region.t (* "*" *) + + (* Compounds *) + +| LPAR of Region.t (* "(" *) +| RPAR of Region.t (* ")" *) +| LBRACKET of Region.t (* "[" *) +| RBRACKET of Region.t (* "]" *) +| LBRACE of Region.t (* "{" *) +| RBRACE of Region.t (* "}" *) + + (* Separators *) + +| COMMA of Region.t (* "," *) +| SEMI of Region.t (* ";" *) +| VBAR of Region.t (* "|" *) +| COLON of Region.t (* ":" *) +| DOT of Region.t (* "." *) +| DOTDOTDOT of Region.t (* "..." *) + + (* Wildcard *) + +| WILD of Region.t (* "_" *) + + (* Comparisons *) + +| EQ of Region.t (* "=" *) +| EQEQ of Region.t (* "==" *) +| NE of Region.t (* "!=" *) +| LT of Region.t (* "<" *) +| GT of Region.t (* ">" *) +| LE of Region.t (* "<=" *) +| GE of Region.t (* ">=" *) +| ARROW of Region.t (* "=>" *) + +| BOOL_OR of Region.t (* "||" *) +| BOOL_AND of Region.t (* "&&" *) + +| NOT of Region.t (* ! *) + + (* Identifiers, labels, numbers and strings *) + +| Ident of string Region.reg +| Constr of string Region.reg +| Int of (string * Z.t) Region.reg +| Nat of (string * Z.t) Region.reg +| Mtz of (string * Z.t) Region.reg +| Str of string Region.reg +| Bytes of (string * Hex.t) Region.reg + + (* Keywords *) + +(*| And*) +| Else of Region.t +| False of Region.t +| If of Region.t +| Let of Region.t +| Switch of Region.t +| Mod of Region.t +| Or of Region.t +| True of Region.t +| Type of Region.t + (* Data constructors *) + +| C_None of Region.t (* "None" *) +| C_Some of Region.t (* "Some" *) + +(* Virtual tokens *) + +| EOF of Region.t (* End of file *) + +type token = t + +let proj_token = function + | CAT region -> region, "CAT" + | MINUS region -> region, "MINUS" + | PLUS region -> region, "PLUS" + | SLASH region -> region, "SLASH" + | TIMES region -> region, "TIMES" + | LPAR region -> region, "LPAR" + | RPAR region -> region, "RPAR" + | LBRACKET region -> region, "LBRACKET" + | RBRACKET region -> region, "RBRACKET" + | LBRACE region -> region, "LBRACE" + | RBRACE region -> region, "RBRACE" + | COMMA region -> region, "COMMA" + | SEMI region -> region, "SEMI" + | VBAR region -> region, "VBAR" + | COLON region -> region, "COLON" + | DOT region -> region, "DOT" + | DOTDOTDOT region -> region, "DOTDOTDOT" + | WILD region -> region, "WILD" + | EQ region -> region, "EQ" + | EQEQ region -> region, "EQEQ" + | NE region -> region, "NE" + | LT region -> region, "LT" + | GT region -> region, "GT" + | LE region -> region, "LE" + | GE region -> region, "GE" + | ARROW region -> region, "ARROW" + | BOOL_OR region -> region, "BOOL_OR" + | BOOL_AND region -> region, "BOOL_AND" + | Ident Region.{region; value} -> + region, sprintf "Ident %s" value + | Constr Region.{region; value} -> + region, sprintf "Constr %s" value + | Int Region.{region; value = s,n} -> + region, sprintf "Int (\"%s\", %s)" s (Z.to_string n) + | Nat Region.{region; value = s,n} -> + region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n) + | Mtz Region.{region; value = s,n} -> + region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n) + | Str Region.{region; value} -> + region, sprintf "Str %s" value + | Bytes Region.{region; value = s,b} -> + region, + sprintf "Bytes (\"%s\", \"0x%s\")" + s (Hex.to_string b) + | Else region -> region, "Else" + | False region -> region, "False" + | If region -> region, "If" + | Let region -> region, "Let" + | Switch region -> region, "Switch" + | Mod region -> region, "Mod" + | NOT region -> region, "!" + | Or region -> region, "Or" + | True region -> region, "True" + | Type region -> region, "Type" + | C_None region -> region, "C_None" + | C_Some region -> region, "C_Some" + | EOF region -> region, "EOF" + +let to_lexeme = function + | CAT _ -> "++" + | MINUS _ -> "-" + | PLUS _ -> "+" + | SLASH _ -> "/" + | TIMES _ -> "*" + | LPAR _ -> "(" + | RPAR _ -> ")" + | LBRACKET _ -> "[" + | RBRACKET _ -> "]" + | LBRACE _ -> "{" + | RBRACE _ -> "}" + | COMMA _ -> "," + | SEMI _ -> ";" + | VBAR _ -> "|" + | COLON _ -> ":" + | DOT _ -> "." + | DOTDOTDOT _ -> "..." + | WILD _ -> "_" + | EQ _ -> "=" + | EQEQ _ -> "==" + | NE _ -> "!=" + | LT _ -> "<" + | GT _ -> ">" + | LE _ -> "<=" + | GE _ -> ">=" + | ARROW _ -> "=>" + | BOOL_OR _ -> "||" + | BOOL_AND _ -> "&&" + | Ident id -> id.Region.value + | Constr id -> id.Region.value + | Int i + | Nat i + | Mtz i -> fst i.Region.value + | Str s -> s.Region.value + | Bytes b -> fst b.Region.value + | Else _ -> "else" + | False _ -> "false" + | If _ -> "if" + | Let _ -> "let" + | Mod _ -> "mod" + | NOT _ -> "!" + | Or _ -> "or" + | Switch _ -> "switch" + | True _ -> "true" + | Type _ -> "type" + | C_None _ -> "None" + | C_Some _ -> "Some" + | EOF _ -> "" + +let to_string token ?(offsets=true) mode = + let region, val_str = proj_token token in + let reg_str = region#compact ~offsets mode + in sprintf "%s: %s" reg_str val_str + +let to_region token = proj_token token |> fst + +(* Injections *) + +type int_err = Non_canonical_zero +type ident_err = Reserved_name +type nat_err = Invalid_natural + | Non_canonical_zero_nat +type sym_err = Invalid_symbol + +(* LEXIS *) + +let keywords = [ + (fun reg -> Else reg); + (fun reg -> False reg); + (fun reg -> If reg); + (fun reg -> Let reg); + (fun reg -> Switch reg); + (fun reg -> Mod reg); + (fun reg -> Or reg); + (fun reg -> True reg); + (fun reg -> Type reg); +] + +(* See: http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#sec86 and + https://github.com/facebook/reason/blob/master/src/reason-parser/reason_parser.mly *) +let reserved = + let open SSet in + empty + |> add "and" + |> add "as" + |> add "asr" + |> add "begin" + |> add "class" + |> add "constraint" + |> add "do" + |> add "done" + |> add "downto" + |> add "end" + |> add "exception" + |> add "external" + |> add "for" + |> add "function" + |> add "functor" + |> add "inherit" + |> add "initializer" + (* |> add "land" - see https://ligo.atlassian.net/browse/LIGO-263 *) + |> add "lazy" + (* |> add "lor" - see https://ligo.atlassian.net/browse/LIGO-263 *) + |> add "lsl" + |> add "lsr" + (* |> add "lxor" - see https://ligo.atlassian.net/browse/LIGO-263 *) + |> add "match" + |> add "method" + |> add "module" + |> add "mutable" + |> add "new" + |> add "nonrec" + |> add "object" + |> add "of" + |> add "open" + |> add "private" + |> add "rec" + |> add "sig" + |> add "struct" + |> add "then" + |> add "to" + |> add "try" + |> add "val" + |> add "virtual" + |> add "when" + |> add "while" + |> add "pri" + |> add "pub" + +let constructors = [ + (fun reg -> C_None reg); + (fun reg -> C_Some reg); +] + +let add map (key, value) = SMap.add key value map + +let mk_map mk_key list = + let apply map value = add map (mk_key value, value) + in List.fold_left apply SMap.empty list + +type lexis = { + kwd : (Region.t -> token) SMap.t; + cstr : (Region.t -> token) SMap.t; + res : SSet.t +} + +let lexicon : lexis = + let build list = mk_map (fun f -> to_lexeme (f Region.ghost)) list + in {kwd = build keywords; + cstr = build constructors; + res = reserved} + +} + +(* START LEXER DEFINITION *) + +(* Named regular expressions *) + +let small = ['a'-'z'] +let capital = ['A'-'Z'] +let letter = small | capital +let digit = ['0'-'9'] +let ident = small (letter | '_' | digit)* +let constr = capital (letter | '_' | digit)* + +(* Rules *) + +rule scan_ident region lexicon = parse + (ident as value) eof { + if SSet.mem value lexicon.res + then Error Reserved_name + else Ok (match SMap.find_opt value lexicon.kwd with + Some mk_kwd -> mk_kwd region + | None -> Ident Region.{region; value}) } + +and scan_constr region lexicon = parse + (constr as value) eof { + match SMap.find_opt value lexicon.cstr with + Some mk_cstr -> mk_cstr region + | None -> Constr Region.{region; value} } + +(* END LEXER DEFINITION *) + +{ +(* START TRAILER *) + +(* comments *) +let block_comment_start lexeme = lexeme = "/*" +let block_comment_end lexeme = lexeme = "*/" +let line_comment_start lexeme = lexeme = "//" + +(* Smart constructors (injections) *) + +let mk_string lexeme region = Str Region.{region; value=lexeme} + +let mk_bytes lexeme region = + let norm = Str.(global_replace (regexp "_") "" lexeme) in + let value = lexeme, Hex.of_string norm + in Bytes Region.{region; value} + +let mk_int lexeme region = + let z = Str.(global_replace (regexp "_") "" lexeme) + |> Z.of_string in + if Z.equal z Z.zero && lexeme <> "0" + then Error Non_canonical_zero + else Ok (Int Region.{region; value = lexeme, z}) + +let mk_nat lexeme region = + let z = + Str.(global_replace (regexp "_") "" lexeme) |> + Str.(global_replace (regexp "n") "") |> + Z.of_string in + if Z.equal z Z.zero && lexeme <> "0n" + then Error Non_canonical_zero_nat + else Ok (Nat Region.{region; value = lexeme, z}) + +let mk_mutez lexeme region = + let z = + Str.(global_replace (regexp "_") "" lexeme) |> + Str.(global_replace (regexp "mutez") "") |> + Z.of_string in + if Z.equal z Z.zero && lexeme <> "0mutez" + then Error Non_canonical_zero + else Ok (Mtz Region.{region; value = lexeme, z}) + +let eof region = EOF region + +let mk_sym lexeme region = + match lexeme with + "-" -> Ok (MINUS region) + | "+" -> Ok (PLUS region) + | "/" -> Ok (SLASH region) + | "*" -> Ok (TIMES region) + | "[" -> Ok (LBRACKET region) + | "]" -> Ok (RBRACKET region) + | "{" -> Ok (LBRACE region) + | "}" -> Ok (RBRACE region) + | "," -> Ok (COMMA region) + | ";" -> Ok (SEMI region) + | "|" -> Ok (VBAR region) + | ":" -> Ok (COLON region) + | "." -> Ok (DOT region) + | "_" -> Ok (WILD region) + | "=" -> Ok (EQ region) + | "!=" -> Ok (NE region) + | "<" -> Ok (LT region) + | ">" -> Ok (GT region) + | "<=" -> Ok (LE region) + | ">=" -> Ok (GE region) + | "||" -> Ok (BOOL_OR region) + | "&&" -> Ok (BOOL_AND region) + | "(" -> Ok (LPAR region) + | ")" -> Ok (RPAR region) + + (* Symbols specific to ReasonLIGO *) + | "..."-> Ok (DOTDOTDOT region) + | "=>" -> Ok (ARROW region) + | "==" -> Ok (EQEQ region) + | "!" -> Ok (NOT region) + | "++" -> Ok (CAT region) + | _ -> Error Invalid_symbol + +(* Identifiers *) + +let mk_ident' lexeme region lexicon = + Lexing.from_string lexeme |> scan_ident region lexicon + +let mk_ident lexeme region = mk_ident' lexeme region lexicon + +(* Constructors *) + +let mk_constr' lexeme region lexicon = + Lexing.from_string lexeme |> scan_constr region lexicon + +let mk_constr lexeme region = mk_constr' lexeme region lexicon + +(* Predicates *) + +let is_string = function + Str _ -> true +| _ -> false + +let is_bytes = function + Bytes _ -> true +| _ -> false + +let is_int = function + Int _ -> true +| _ -> false + +let is_ident = function + Ident _ -> true +| _ -> false + +let is_kwd = function + | Else _ + | False _ + | If _ + | Let _ + | Switch _ + | Mod _ + | Or _ + | True _ + | Type _ + | _ -> false + +let is_constr = function +| Constr _ +| Ident _ +| False _ +| True _ -> true +| _ -> false + +let is_sym = function +| CAT _ +| MINUS _ +| PLUS _ +| SLASH _ +| TIMES _ +| LPAR _ +| RPAR _ +| LBRACKET _ +| RBRACKET _ +| LBRACE _ +| RBRACE _ +| COMMA _ +| SEMI _ +| VBAR _ +| COLON _ +| DOT _ +| DOTDOTDOT _ +| WILD _ +| EQ _ +| EQEQ _ +| NE _ +| LT _ +| GT _ +| LE _ +| GE _ +| ARROW _ +| BOOL_OR _ +| NOT _ +| BOOL_AND _ -> true +| _ -> false + +let is_eof = function EOF _ -> true | _ -> false + +(* END TRAILER *) +} \ No newline at end of file diff --git a/src/passes/1-parser/reasonligo/LexerMain.ml b/src/passes/1-parser/reasonligo/LexerMain.ml new file mode 100644 index 000000000..f84e56c92 --- /dev/null +++ b/src/passes/1-parser/reasonligo/LexerMain.ml @@ -0,0 +1,62 @@ +(* Driver for the lexer of ReasonLIGO *) + +(* Error printing and exception tracing *) + +let () = Printexc.record_backtrace true + +(* Running the lexer on the source *) + +let options = EvalOpt.read "ReasonLIGO" ".religo" + +open EvalOpt + +let external_ text = + Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;; + +(* Path for CPP inclusions (#include) *) + +let lib_path = + match options.libs with + [] -> "" + | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path + in List.fold_right mk_I libs "" + +(* Preprocessing the input source and opening the input channels *) + +let prefix = + match options.input with + None | Some "-" -> "temp" + | Some file -> Filename.(file |> basename |> remove_extension) + +let suffix = ".pp.religo" + +let pp_input = + if Utils.String.Set.mem "cpp" options.verbose + then prefix ^ suffix + else let pp_input, pp_out = Filename.open_temp_file prefix suffix + in close_out pp_out; pp_input + +let cpp_cmd = + + match options.input with + None | Some "-" -> + Printf.sprintf "cpp -traditional-cpp%s - > %s" + lib_path pp_input + | Some file -> + Printf.sprintf "cpp -traditional-cpp%s %s > %s" + lib_path file pp_input + +let () = + if Utils.String.Set.mem "cpp" options.verbose + then Printf.eprintf "%s\n%!" cpp_cmd; + if Sys.command cpp_cmd <> 0 then + external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) + +(* Running the lexer on the input file *) + +module Lexer = Lexer.Make (LexToken) + +module Log = LexerLog.Make (Lexer) + +let () = Log.trace ~offsets:options.offsets + options.mode (Some pp_input) options.cmd diff --git a/src/passes/1-parser/reasonligo/ParToken.mly b/src/passes/1-parser/reasonligo/ParToken.mly new file mode 100644 index 000000000..a19dbec36 --- /dev/null +++ b/src/passes/1-parser/reasonligo/ParToken.mly @@ -0,0 +1,76 @@ +%{ +%} + +(* Tokens (mirroring thise defined in module LexToken) *) + + (* Literals *) + +%token Ident +%token Constr +%token Str +%token <(string * Z.t) Region.reg> Int +%token <(string * Z.t) Region.reg> Nat +%token <(string * Z.t) Region.reg> Mtz + + (* Symbols *) + +%token MINUS +%token PLUS +%token SLASH +%token TIMES + +%token LPAR +%token RPAR +%token LBRACKET +%token RBRACKET +%token LBRACE +%token RBRACE + +%token CAT +%token DOT +%token DOTDOTDOT + +%token COMMA +%token SEMI +%token COLON +%token VBAR + +%token WILD + +%token EQ +%token EQEQ +%token NE +%token LT +%token GT +%token LE +%token GE +%token ARROW + +%token NOT + +%token BOOL_OR +%token BOOL_AND + + + (* Keywords *) + +%token Else +%token False +%token If +%token Let +%token Switch +%token Mod +%token Or +%token True +%token Type + + (* Data constructors *) + +%token C_None (* "None" *) +%token C_Some (* "Some" *) + + (* Virtual tokens *) + +%token EOF + +%% diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly new file mode 100644 index 000000000..1a63fb329 --- /dev/null +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -0,0 +1,1077 @@ +%{ +(* START HEADER *) + +[@@@warning "-42"] + +open Region +module AST = Parser_ligodity.AST +open AST + + +type 'a sequence_elements = { + s_elts : ('a, semi) Utils.nsepseq; + s_terminator : semi option +} + +type 'a record_elements = { + r_elts : (field_assign reg, semi) Utils.nsepseq; + r_terminator : semi option +} + +type 'a sequence_or_record = + PaSequence of 'a sequence_elements +| PaRecord of 'a record_elements +| PaSingleExpr of expr + +(* END HEADER *) +%} + +(* See [ParToken.mly] for the definition of tokens. *) + +(* Entry points *) + +%start contract interactive_expr +%type contract +%type interactive_expr + + +%nonassoc Ident +%nonassoc COLON (* Solves a shift/reduce problem that happens with record + and sequences. To elaborate: + - sequence_or_record_in can be reduced to + expr -> Ident, but also to + field_assignment -> Ident. + *) +%% + +(* RULES *) + +(* The rule [sep_or_term(item,sep)] ("separated or terminated list") + parses a non-empty list of items separated by [sep], and optionally + terminated by [sep]. *) + +sep_or_term_list(item,sep): + nsepseq(item,sep) { + $1, None + } +| nseq(item sep {$1,$2}) { + let (first,sep), tail = $1 in + let rec trans (seq, prev_sep as acc) = function + [] -> acc + | (item,next_sep)::others -> + trans ((prev_sep,item)::seq, next_sep) others in + let list, term = trans ([],sep) tail + in (first, List.rev list), Some term } + +(* Compound constructs *) + +par(X): + LPAR X RPAR { + let region = cover $1 $3 + and value = { + lpar = $1; + inside = $2; + rpar = $3} + in {region; value} + } + +braces(X): + LBRACE X RBRACE { + let region = cover $1 $3 + and value = { + lpar = $1; + inside = $2; + rpar = $3} + in {region; value} + } + + +(* Sequences + + Series of instances of the same syntactical category have often to + be parsed, like lists of expressions, patterns etc. The simplest of + all is the possibly empty sequence (series), parsed below by + [seq]. The non-empty sequence is parsed by [nseq]. Note that the + latter returns a pair made of the first parsed item (the parameter + [X]) and the rest of the sequence (possibly empty). This way, the + OCaml typechecker can keep track of this information along the + static control-flow graph. The rule [sepseq] parses possibly empty + sequences of items separated by some token (e.g., a comma), and + rule [nsepseq] is for non-empty such sequences. See module [Utils] + for the types corresponding to the semantic actions of those + rules. +*) + +(* Possibly empty sequence of items *) + +seq(item): + (**) { [] } +| item seq(item) { $1::$2 } + +(* Non-empty sequence of items *) + +nseq(item): + item seq(item) { $1,$2 } + +(* Non-empty separated sequence of items *) + +nsepseq(item,sep): + item { $1, [] } +| item sep nsepseq(item,sep) { let h,t = $3 in $1, ($2,h)::t } + +(* Possibly empy separated sequence of items *) + +sepseq(item,sep): + (**) { None } +| nsepseq(item,sep) { Some $1 } + +(* Helpers *) + +%inline type_name : Ident { $1 } +%inline field_name : Ident { $1 } +%inline module_name : Constr { $1 } +%inline struct_name : Ident { $1 } + +(* Non-empty comma-separated values (at least two values) *) + +tuple(item): + item COMMA nsepseq(item,COMMA) { + let h,t = $3 in $1,($2,h)::t + } + +(* Possibly empty semicolon-separated values between brackets *) + +list(item): + LBRACKET sep_or_term_list(item, COMMA) RBRACKET { + let elements, terminator = $2 in + { value = + { + compound = Brackets ($1,$3); + elements = Some elements; + terminator; + }; + region = cover $1 $3 + } + } +| LBRACKET RBRACKET { + let value = { + compound = Brackets ($1,$2); + elements = None; + terminator = None} in + let region = cover $1 $2 + in {value; region} + } + +(* Main *) + +contract: + declarations EOF { + {decl = $1; eof=$2} } + +declarations: + declaration { $1,[] : AST.declaration Utils.nseq } +| declaration declarations { Utils.nseq_cons $1 $2 } + +declaration: +| type_decl SEMI { TypeDecl $1 } +| let_declaration SEMI { Let $1 } + +(* Type declarations *) + +type_decl: + Type type_name EQ type_expr { + let region = cover $1 (type_expr_to_region $4) in + let value = { + kwd_type = $1; + name = $2; + eq = $3; + type_expr = $4; + } + in {region; value} + } + +type_expr: + cartesian { $1 } +| sum_type { TSum $1 } +| record_type { TRecord $1 } + +cartesian: + fun_type COMMA nsepseq(fun_type,COMMA) { + let value = Utils.nsepseq_cons $1 $2 $3 in + let region = nsepseq_to_region type_expr_to_region value + in TProd {region; value} + } +| fun_type { ($1 : type_expr) } + +fun_type: + core_type { + $1 + } +| core_type ARROW fun_type { + let region = cover (type_expr_to_region $1) (type_expr_to_region $3) in + TFun {region; value = ($1, $2, $3)} +} + +core_type: + type_name { + TVar $1 + } +| module_name DOT type_name { + let module_name = $1.value in + let type_name = $3.value in + let value = module_name ^ "." ^ type_name in + let region = cover $1.region $3.region + in + TVar {region; value} + } +| type_constr LPAR nsepseq(core_type, COMMA) RPAR { + let arg_val = $3 in + let constr = $1 in + let start = $1.region in + let stop = $4 in + let region = cover start stop in + let lpar, rpar = $2, $4 in + TApp Region.{value = constr, { + value = { + lpar; + rpar; + inside = arg_val + }; + region = cover lpar rpar; + }; region} + } +| par (type_expr) { + TPar $1 +} + +type_constr: + type_name { $1 } + +sum_type: + VBAR nsepseq(variant,VBAR) { + let region = nsepseq_to_region (fun x -> x.region) $2 + in {region; value = $2} + } + +variant: + Constr LPAR cartesian RPAR { + let region = cover $1.region $4 + and value = {constr = $1; arg = Some ($2, $3)} + in {region; value} + } +| Constr { + {region=$1.region; value= {constr=$1; arg=None}} } + +record_type: + LBRACE sep_or_term_list(field_decl,COMMA) RBRACE { + let ne_elements, terminator = $2 in + let region = cover $1 $3 + and value = { + compound = Braces ($1,$3); + ne_elements; + terminator; + } + in {region; value} + } + +type_expr_field: + core_type { $1 } +| sum_type { TSum $1 } +| record_type { TRecord $1 } + +field_decl: + field_name { + let value = {field_name = $1; colon = Region.ghost; field_type = TVar $1} + in {region = $1.region; value} + } + | field_name COLON type_expr_field { + let stop = type_expr_to_region $3 in + let region = cover $1.region stop + and value = {field_name = $1; colon = $2; field_type = $3} + in {region; value} + } + +(* Top-level non-recursive definitions *) + +let_declaration: + Let let_binding { + let kwd_let = $1 in + let binding, (region: Region.region) = $2 in + {value = kwd_let, binding; region} + } + +es6_func: + ARROW expr { + $1, $2 + } + +let_binding: + | Ident type_annotation? EQ expr { + let pattern = PVar $1 in + let start = pattern_to_region pattern in + let stop = expr_to_region $4 in + let region = cover start stop in + ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) + } +| tuple(sub_irrefutable) type_annotation? EQ expr { + let h, t = $1 in + let start = pattern_to_region h in + let stop = last (fun (region, _) -> region) t in + let region = cover start stop in + let pattern = PTuple { value = $1; region } in + let start = region in + let stop = expr_to_region $4 in + let region = cover start stop in + ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) +} +| WILD type_annotation? EQ expr { + let pattern = PWild $1 in + let start = pattern_to_region pattern in + let stop = expr_to_region $4 in + let region = cover start stop in + ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) + } +| unit type_annotation? EQ expr { + let pattern = PUnit $1 in + let start = pattern_to_region pattern in + let stop = expr_to_region $4 in + let region = cover start stop in + ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) + } +| record_pattern type_annotation? EQ expr { + let pattern = PRecord $1 in + let start = pattern_to_region pattern in + let stop = expr_to_region $4 in + let region = cover start stop in + ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) + } +| par(closed_irrefutable) type_annotation? EQ expr { + let pattern = PPar $1 in + let start = pattern_to_region pattern in + let stop = expr_to_region $4 in + let region = cover start stop in + ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) + } + +type_annotation: + COLON type_expr { $1,$2 } + +(* Patterns *) + +irrefutable: + tuple(sub_irrefutable) { + let h, t = $1 in + let start = pattern_to_region h in + let stop = last (fun (region, _) -> region) t in + let region = cover start stop in + PTuple { value = $1; region } + } +| sub_irrefutable { $1 } + +sub_irrefutable: + Ident { PVar $1 } +| WILD { PWild $1 } +| unit { PUnit $1 } +| record_pattern { PRecord $1 } +| par(closed_irrefutable) { PPar $1 } + +closed_irrefutable: + irrefutable { $1 } +| constr_pattern { PConstr $1 } +| typed_pattern { PTyped $1 } + +typed_pattern: + irrefutable COLON type_expr { + let start = pattern_to_region $1 in + let stop = type_expr_to_region $3 in + let region = cover start stop in + { + value = { + pattern = $1; + colon = $2; + type_expr = $3 + }; + region + } + } + +pattern: + LBRACKET sub_pattern COMMA DOTDOTDOT sub_pattern RBRACKET { + let start = pattern_to_region $2 in + let stop = pattern_to_region $5 in + let region = cover start stop in + let val_ = {value = $2, $3, $5; region} in + PList (PCons val_) + } +| tuple(sub_pattern) { + let h, t = $1 in + let start = pattern_to_region h in + let stop = last (fun (region, _) -> region) t in + let region = cover start stop in + PTuple { value = $1; region } + } +| core_pattern { $1 } + +sub_pattern: + par(sub_pattern) { PPar $1 } +| core_pattern { $1 } + +core_pattern: + Ident { PVar $1 } +| WILD { PWild $1 } +| unit { PUnit $1 } +| Int { PInt $1 } +| True { PTrue $1 } +| False { PFalse $1 } +| Str { PString $1 } +| par(ptuple) { PPar $1 } +| list(sub_pattern) { PList (PListComp $1) } +| constr_pattern { PConstr $1 } +| record_pattern { PRecord $1 } + +record_pattern: + LBRACE sep_or_term_list(field_pattern,COMMA) RBRACE { + let ne_elements, terminator = $2 in + let region = cover $1 $3 in + let value = { + compound = Braces ($1,$3); + ne_elements; + terminator; + } + in + {region; value} + } + +field_pattern: + field_name EQ sub_pattern { + let start = $1.region in + let stop = pattern_to_region $3 in + let region = cover start stop in + { value = {field_name=$1; eq=$2; pattern=$3}; region } + } + +constr_pattern: + C_None { PNone $1 } +| C_Some sub_pattern { + let stop = pattern_to_region $2 in + let region = cover $1 stop + and value = $1, $2 + in PSomeApp {value; region} + } +| Constr { + PConstrApp { value = $1, None; region = $1.region } } +| Constr sub_pattern { + let region = cover $1.region (pattern_to_region $2) in + PConstrApp { value = $1, Some $2; region } + } + + +ptuple: + tuple(sub_pattern) { + let h, t = $1 in + let start = pattern_to_region h in + let stop = last (fun (region, _) -> region) t in + let region = cover start stop in + PTuple { value = $1; region } + } + +unit: + LPAR RPAR { + let the_unit = ghost, ghost in + let region = cover $1 $2 in + { value = the_unit; region } + } + +(* Expressions *) + +interactive_expr: + expr EOF { $1 } + +expr: + base_cond__open(expr) { $1 } +| switch_expr(base_cond) { ECase $1 } + + +base_cond__open(x): + base_expr(x) +| conditional(x) { $1 } + +base_cond: + base_cond__open(base_cond) { $1 } + +type_expr_simple_args: + LPAR nsepseq(type_expr_simple, COMMA) RPAR { + $1, $2, $3 + } + +type_expr_simple: + core_expr_2 type_expr_simple_args? { + let args = $2 in + let constr = match $1 with + | EVar i -> i + | EProj {value = {struct_name; field_path; _}; region} -> + let path = + (Utils.nsepseq_foldl + (fun a e -> + match e with + | FieldName v -> a ^ "." ^ v.value + | Component {value = c, _; _} -> a ^ "." ^ c + ) + struct_name.value + field_path + ) + in + {value = path; region } + | EArith (Mutez {value = s, _; region }) + | EArith (Int {value = s, _; region }) + | EArith (Nat {value = s, _; region }) -> { value = s; region } + | EString (StrLit {value = s; region}) -> { value = s; region } + | ELogic (BoolExpr (True t)) -> { value = "true"; region = t } + | ELogic (BoolExpr (False f)) -> { value = "false"; region = f } + | _ -> failwith "Not supported" + in + match args with + Some (lpar, args, rpar) -> ( + let start = expr_to_region $1 in + let stop = rpar in + let region = cover start stop in + TApp { + value = constr, { + value = { + inside = args; + lpar; + rpar + }; + region}; + region} + ) + | None -> TVar constr + } + | LPAR nsepseq(type_expr_simple, COMMA) RPAR { + TProd {value = $2; region = cover $1 $3} + } + | LPAR type_expr_simple ARROW type_expr_simple RPAR { + TFun {value = $2, $3, $4; region = cover $1 $5} + } + +type_annotation_simple: + COLON type_expr_simple { $2 } + +fun_expr: + disj_expr_level es6_func { + let arrow, body = $2 in + let kwd_fun = Region.ghost in + let start = expr_to_region $1 in + let stop = expr_to_region body in + let region = cover start stop in + let rec arg_to_pattern = (function + | EVar val_ -> PVar val_ + | EAnnot {value = (EVar v, typ); region} -> + PTyped {value = { + pattern = PVar v; + colon = Region.ghost; + type_expr = typ; + } ; region} + | EPar {value = {inside; lpar; rpar}; region} -> + PPar {value = {inside = arg_to_pattern inside; lpar; rpar}; region} + | EUnit u -> PUnit u + | _ -> failwith "Not supported" + ) + in + let fun_args_to_pattern = (function + | EAnnot {value = (ETuple {value = fun_args; _}, _); _} -> (* ((foo:x, bar) : type) *) + let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in + (arg_to_pattern (fst fun_args), bindings) + | EAnnot {value = (EPar {value = {inside = fun_arg ; _}; _}, _); _} -> (* ((foo:x, bar) : type) *) + (arg_to_pattern fun_arg, []) + | EPar {value = {inside = fun_arg; _ }; _} -> + (arg_to_pattern fun_arg, []) + | EAnnot e -> (arg_to_pattern (EAnnot e), []) + | ETuple {value = fun_args; _} -> + let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in + (arg_to_pattern (fst fun_args), bindings) + | EUnit e -> + (arg_to_pattern (EUnit e), []) + | _ -> failwith "Not supported" + ) + in + let binders = fun_args_to_pattern $1 in + let f = { + kwd_fun ; + binders ; + lhs_type = None; + arrow ; + body ; + } in + EFun { region; value=f } + } + +base_expr(right_expr): + let_expr(right_expr) +| disj_expr_level { $1 } +| fun_expr { $1 } + +conditional(right_expr): + if_then_else(right_expr) + | if_then(right_expr) { ECond $1 } + +parenthesized_expr: + braces (expr) { $1.value.inside } + | par (expr) { $1.value.inside } + +if_then(right_expr): + If parenthesized_expr LBRACE closed_if RBRACE { + let the_unit = ghost, ghost in + let ifnot = EUnit {region=ghost; value=the_unit} in + let region = cover $1 $5 in + { + value = { + kwd_if = $1; + test = $2; + kwd_then = $3; + ifso = $4; + kwd_else = Region.ghost; + ifnot; + }; + region + } + } + +if_then_else(right_expr): + If parenthesized_expr LBRACE closed_if SEMI RBRACE Else LBRACE right_expr SEMI RBRACE { + let region = cover $1 $11 in + { + value = { + kwd_if = $1; + test = $2; + kwd_then = $3; + ifso = $4; + kwd_else = $6; + ifnot = $9 + }; + region + } + } + +base_if_then_else__open(x): + base_expr(x) { $1 } +| if_then_else(x) { ECond $1 } + +base_if_then_else: + base_if_then_else__open(base_if_then_else) { $1 } + +closed_if: + base_if_then_else__open(closed_if) { $1 } +| switch_expr(base_if_then_else) { ECase $1 } + +switch_expr(right_expr): + Switch switch_expr_ LBRACE cases(right_expr) RBRACE { + let cases = $4 in + let start = $1 in + let stop = $5 in + let region = cover start stop in + { value = { + kwd_match = $1; + expr = $2; + lead_vbar = None; + kwd_with = Region.ghost; + cases = { + value = cases; + region = nsepseq_to_region (fun {region; _} -> region) $4 + }; + }; + region + } + } + +switch_expr_: + | par(expr) { + $1.value.inside + } + | core_expr_2 { + $1 + } + +cases(right_expr): + nseq(case_clause(right_expr)) { + let (hd, tl) = $1 in + hd, (List.map (fun f -> expr_to_region f.value.rhs, f) tl) + } + +case_clause(right_expr): + VBAR pattern ARROW right_expr SEMI? { + let region = cover (pattern_to_region $2) (expr_to_region $4) in + {value = + { + pattern = $2; + arrow = $3; + rhs=$4 + }; + region + } + } + +let_expr(right_expr): + Let let_binding SEMI right_expr { + let kwd_let = $1 in + let (binding: let_binding), _ = $2 in + let kwd_in = $3 in + let body = $4 in + let stop = expr_to_region $4 in + let region = cover $1 stop in + let let_in = {kwd_let; binding; kwd_in; body} + in ELetIn {region; value=let_in} } + +disj_expr_level: + disj_expr { ELogic (BoolExpr (Or $1)) } +| conj_expr_level { $1 } +| par(tuple(disj_expr_level)) type_annotation_simple? { + let region = $1.region in + let tuple = ETuple {value=$1.value.inside; region} in + let region = match $2 with + | Some s -> cover $1.region (type_expr_to_region s) + | None -> region + in + match $2 with + | Some typ -> EAnnot({value = tuple, typ; region}) + | None -> tuple + } + +bin_op(arg1,op,arg2): + arg1 op arg2 { + let start = expr_to_region $1 in + let stop = expr_to_region $3 in + let region = cover start stop in + { value = { arg1=$1; op=$2; arg2=$3}; region } + } + +disj_expr: + bin_op(disj_expr_level, BOOL_OR, conj_expr_level) +| bin_op(disj_expr_level, Or, conj_expr_level) { $1 } + +conj_expr_level: + conj_expr { ELogic (BoolExpr (And $1)) } +| comp_expr_level { $1 } + +conj_expr: + bin_op(conj_expr_level, BOOL_AND, comp_expr_level) { $1 } + +comp_expr_level: + lt_expr { ELogic (CompExpr (Lt $1)) } +| le_expr { ELogic (CompExpr (Leq $1)) } +| gt_expr { ELogic (CompExpr (Gt $1)) } +| ge_expr { ELogic (CompExpr (Geq $1)) } +| eq_expr { ELogic (CompExpr (Equal $1)) } +| ne_expr { ELogic (CompExpr (Neq $1)) } +| cat_expr_level { $1 } + +lt_expr: + bin_op(comp_expr_level, LT, cat_expr_level) { $1 } + +le_expr: + bin_op(comp_expr_level, LE, cat_expr_level) { $1 } + +gt_expr: + bin_op(comp_expr_level, GT, cat_expr_level) { $1 } + +ge_expr: + bin_op(comp_expr_level, GE, cat_expr_level) { $1 } + +eq_expr: + bin_op(comp_expr_level, EQEQ, cat_expr_level) { $1 } + +ne_expr: + bin_op(comp_expr_level, NE, cat_expr_level) { $1 } + +cat_expr_level: + cat_expr { EString (Cat $1) } +| add_expr_level { $1 } + +cat_expr: + bin_op(add_expr_level, CAT, add_expr_level) { $1 } + +add_expr_level: + plus_expr { EArith (Add $1) } +| minus_expr { EArith (Sub $1) } +| mult_expr_level { $1 } + +plus_expr: + bin_op(add_expr_level, PLUS, mult_expr_level) { $1 } + +minus_expr: + bin_op(add_expr_level, MINUS, mult_expr_level) { $1 } + +mult_expr_level: + times_expr { EArith (Mult $1) } +| div_expr { EArith (Div $1) } +| mod_expr { EArith (Mod $1) } +| unary_expr_level { $1 } + +times_expr: + bin_op(mult_expr_level, TIMES, unary_expr_level) { $1 } + +div_expr: + bin_op(mult_expr_level, SLASH, unary_expr_level) { $1 } + +mod_expr: + bin_op(mult_expr_level, Mod, unary_expr_level) { $1 } + +unary_expr_level: + MINUS call_expr_level { + let start = $1 in + let end_ = expr_to_region $2 in + let region = cover start end_ + and value = {op = $1; arg = $2} + in EArith (Neg {region; value}) +} +| NOT call_expr_level { + let start = $1 in + let end_ = expr_to_region $2 in + let region = cover start end_ + and value = {op = $1; arg = $2} in + ELogic (BoolExpr (Not ({region; value}))) +} +| call_expr_level { + $1 + } + +call_expr_level: + call_expr_level_in type_annotation_simple? { + let region = match $2 with + | Some s -> cover (expr_to_region $1) (type_expr_to_region s) + | None -> expr_to_region $1 + in + match $2 with + | Some t -> + EAnnot { value = $1, t; region } + | None -> $1 + } + +call_expr_level_in: + call_expr { $1 } +| constr_expr { $1 } +| core_expr { $1 } + +constr_expr: + C_None { + EConstr (ENone $1) + } + | C_Some core_expr { + let region = cover $1 (expr_to_region $2) + in EConstr (ESomeApp {value = $1,$2; region}) + } + | Constr core_expr? { + let start = $1.region in + let stop = match $2 with + | Some c -> expr_to_region c + | None -> start + in + let region = cover start stop in + EConstr (EConstrApp { value = $1,$2; region}) + } + +call_expr: + core_expr LPAR nsepseq(expr, COMMA) RPAR { + let start = expr_to_region $1 in + let stop = $4 in + let region = cover start stop in + let hd, tl = $3 in + let tl = (List.map (fun (_, a) -> a) tl) in + ECall { value = $1, (hd, tl); region } + } + | core_expr unit { + let start = expr_to_region $1 in + let stop = $2.region in + let region = cover start stop in + ECall { value = $1, (EUnit $2, []); region } + } + +core_expr_2: + Int { EArith (Int $1) } +| Mtz { EArith (Mutez $1) } +| Nat { EArith (Nat $1) } +| Ident | module_field { EVar $1 } +| projection { EProj $1 } +| Str { EString (StrLit $1) } +| unit { EUnit $1 } +| False { ELogic (BoolExpr (False $1)) } +| True { ELogic (BoolExpr (True $1)) } +| list(expr) { EList (EListComp $1) } + +list_or_spread: + LBRACKET expr COMMA sep_or_term_list(expr, COMMA) RBRACKET { + let (e, terminator) = $4 in + let e = Utils.nsepseq_cons $2 $3 e in + EList (EListComp ({ value = + { + compound = Brackets ($1,$5); + elements = Some e; + terminator; + }; + region = cover $1 $5 + })) + } + | LBRACKET expr COMMA DOTDOTDOT expr RBRACKET { + let region = cover $1 $6 in + EList (ECons {value={arg1=$2; op=$4; arg2=$5}; region}) + } + | LBRACKET expr RBRACKET { + EList (EListComp ({ value = + { + compound = Brackets ($1,$3); + elements = Some ($2, []); + terminator = None; + }; + region = cover $1 $3 + })) + } + | LBRACKET RBRACKET { + let value = { + compound = Brackets ($1,$2); + elements = None; + terminator = None} in + let region = cover $1 $2 + in EList (EListComp ( {value; region})) + } + +core_expr: + Int { EArith (Int $1) } +| Mtz { EArith (Mutez $1) } +| Nat { EArith (Nat $1) } +| Ident | module_field { EVar $1 } +| projection { EProj $1 } +| Str { EString (StrLit $1) } +| unit { EUnit $1 } +| False { ELogic (BoolExpr (False $1)) } +| True { ELogic (BoolExpr (True $1)) } +| list_or_spread { $1 } +| par(expr) { EPar $1 } +| sequence_or_record { $1 } + +module_field: + module_name DOT field_name { + let region = cover $1.region $3.region in + { value = $1.value ^ "." ^ $3.value; region } + } + +selection: + | LBRACKET Int RBRACKET selection { + let r, (h, t) = $4 in + let result:((selection, dot) Utils.nsepseq) = (Component $2), (Region.ghost, h) :: t in + r, result + } + | DOT field_name selection { + let r, (h, t) = $3 in + let result:((selection, dot) Utils.nsepseq) = (FieldName $2), ($1, h) :: t in + r, result + } + | DOT field_name { + $1, ((FieldName $2), []) + } + | LBRACKET Int RBRACKET { + Region.ghost, ((Component $2), []) + } + +projection: + struct_name selection { + let start = $1.region in + let stop = nsepseq_to_region (function + | FieldName f -> f.region + | Component c -> c.region) (snd $2) + in + let region = cover start stop in + { value = + { + struct_name = $1; + selector = fst $2; + field_path = snd $2 + }; + region + } + } +| module_name DOT field_name selection { + let module_name = $1 in + let field_name = $3 in + let value = module_name.value ^ "." ^ field_name.value in + let struct_name = {$1 with value} in + let start = $1.region in + let stop = nsepseq_to_region (function + | FieldName f -> f.region + | Component c -> c.region) (snd $4) + in + let region = cover start stop in + { value = + { + struct_name; + selector = fst $4; + field_path = snd $4 + }; + region + } + } + +sequence_or_record_in: + expr SEMI sep_or_term_list(expr,SEMI) { + let (e, _region) = $3 in + let e = Utils.nsepseq_cons $1 $2 e in + PaSequence { s_elts = e; s_terminator = None} + } +| field_assignment COMMA sep_or_term_list(field_assignment,COMMA) { + let (e, _region) = $3 in + let e = Utils.nsepseq_cons $1 $2 e in + PaRecord { r_elts = e; r_terminator = None} + } + | expr SEMI? { + PaSingleExpr $1 + } + +sequence_or_record: + LBRACE sequence_or_record_in RBRACE { + let compound = Braces($1, $3) in + let region = cover $1 $3 in + match $2 with + | PaSequence s -> ( + let value: expr injection = { + compound; + elements = Some s.s_elts; + terminator = s.s_terminator; + } + in + ESeq {value; region} + ) + | PaRecord r -> ( + let value: field_assign reg ne_injection = { + compound; + ne_elements = r.r_elts; + terminator = r.r_terminator; + } + in + ERecord {value; region} + ) + | PaSingleExpr e -> e + } + +field_assignment: + field_name { + { value = + { + field_name = $1; + assignment = Region.ghost; + field_expr = EVar $1 + }; + region = $1.region + } + } + | field_name COLON expr { + let start = $1.region in + let stop = expr_to_region $3 in + let region = cover start stop in + { value = + { + field_name = $1; + assignment = $2; + field_expr = $3 + }; + region + } + } diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml new file mode 100644 index 000000000..aa49c4364 --- /dev/null +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -0,0 +1,124 @@ +(* Driver for the parser of ReasonLIGO *) + +(* Error printing and exception tracing *) + +let () = Printexc.record_backtrace true + +(* Reading the command-line options *) + +let options = EvalOpt.read "ReasonLIGO" ".religo" + +open EvalOpt + +(* Auxiliary functions *) + +let sprintf = Printf.sprintf + +(* Extracting the input file *) + +let file = + match options.input with + None | Some "-" -> false + | Some _ -> true + +(* Error printing and exception tracing *) + +let () = Printexc.record_backtrace true + +let external_ text = + Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;; + +type Error.t += ParseError + +let error_to_string = function + ParseError -> "Syntax error.\n" +| _ -> assert false + +let print_error ?(offsets=true) mode Region.{region; value} ~file = + let msg = error_to_string value in + let reg = region#to_string ~file ~offsets mode in + Utils.highlight (sprintf "Parse error %s:\n%s%!" reg msg) + +(* Path for CPP inclusions (#include) *) + +let lib_path = + match options.libs with + [] -> "" + | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path + in List.fold_right mk_I libs "" + +(* Preprocessing the input source and opening the input channels *) + +let prefix = + match options.input with + None | Some "-" -> "temp" + | Some file -> Filename.(file |> basename |> remove_extension) + +let suffix = ".pp.religo" + +let pp_input = + if Utils.String.Set.mem "cpp" options.verbose + then prefix ^ suffix + else let pp_input, pp_out = Filename.open_temp_file prefix suffix + in close_out pp_out; pp_input + +let cpp_cmd = + match options.input with + None | Some "-" -> + Printf.sprintf "cpp -traditional-cpp%s - > %s" + lib_path pp_input + | Some file -> + Printf.sprintf "cpp -traditional-cpp%s %s > %s" + lib_path file pp_input + +let () = + if Utils.String.Set.mem "cpp" options.verbose + then Printf.eprintf "%s\n%!" cpp_cmd; + if Sys.command cpp_cmd <> 0 then + external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) + +(* Instanciating the lexer *) + +module Lexer = Lexer.Make (LexToken) + +module Log = LexerLog.Make (Lexer) + +let Lexer.{read; buffer; get_pos; get_last; close} = + Lexer.open_token_stream (Some pp_input) + +and cout = stdout + +let log = Log.output_token ~offsets:options.offsets + options.mode options.cmd cout + +and close_all () = close (); close_out cout + +(* Tokeniser *) + +let tokeniser = read ~log + +(* Main *) + +let () = + try + let ast = Parser.contract tokeniser buffer in + if Utils.String.Set.mem "ast" options.verbose + then let buffer = Buffer.create 131 in + begin + Parser_ligodity.ParserLog.offsets := options.offsets; + Parser_ligodity.ParserLog.mode := options.mode; + Parser_ligodity.ParserLog.print_tokens buffer ast; + Buffer.output_buffer stdout buffer + end + with + Lexer.Error err -> + close_all (); + Lexer.print_error ~offsets:options.offsets + options.mode err ~file + | Parser.Error -> + let region = get_last () in + let error = Region.{region; value=ParseError} in + let () = close_all () in + print_error ~offsets:options.offsets + options.mode error ~file + | Sys_error msg -> Utils.highlight msg diff --git a/src/passes/1-parser/reasonligo/dune b/src/passes/1-parser/reasonligo/dune new file mode 100644 index 000000000..eaaaaf012 --- /dev/null +++ b/src/passes/1-parser/reasonligo/dune @@ -0,0 +1,41 @@ +(ocamllex LexToken) + +(menhir + (merge_into Parser) + (modules ParToken Parser) + (flags -la 1 --explain --dump --strict --external-tokens LexToken)) + +(library + (name parser_reasonligo) + (public_name ligo.parser.reasonligo) + (modules reasonligo LexToken Parser) + (libraries + parser_shared + parser_ligodity + str + simple-utils + tezos-utils + getopt + ) + (flags (:standard -open Simple_utils -open Parser_shared -open Parser_ligodity )) +) + +(executable + (name LexerMain) + (libraries + parser_reasonligo) + (modules + LexerMain + ) + (flags (:standard -open Parser_shared -open Parser_reasonligo)) +) + +(executable + (name ParserMain) + (libraries + parser_reasonligo) + (modules + ParserMain + ) + (flags (:standard -open Simple_utils -open Parser_shared -open Parser_reasonligo)) +) diff --git a/src/passes/1-parser/reasonligo/reasonligo.ml b/src/passes/1-parser/reasonligo/reasonligo.ml new file mode 100644 index 000000000..ceea5c54c --- /dev/null +++ b/src/passes/1-parser/reasonligo/reasonligo.ml @@ -0,0 +1,5 @@ +module Parser = Parser +module AST = Parser_ligodity.AST +module Lexer = Lexer +module LexToken = LexToken +module ParserLog = Parser_ligodity.ParserLog diff --git a/src/passes/1-parser/shared/Lexer.mll b/src/passes/1-parser/shared/Lexer.mll index 4f9697d38..582860c51 100644 --- a/src/passes/1-parser/shared/Lexer.mll +++ b/src/passes/1-parser/shared/Lexer.mll @@ -526,13 +526,14 @@ let esc = "\\n" | "\\\"" | "\\\\" | "\\b" | "\\r" | "\\t" | "\\x" byte let pascaligo_sym = "=/=" | '#' | ":=" let cameligo_sym = "<>" | "::" | "||" | "&&" +let reasonligo_sym = '!' | "=>" | "!=" | "==" | "++" | "..." | "||" | "&&" let symbol = ';' | ',' | '(' | ')'| '[' | ']' | '{' | '}' | '=' | ':' | '|' | "->" | '.' | '_' | '^' | '+' | '-' | '*' | '/' | '<' | "<=" | '>' | ">=" -| pascaligo_sym | cameligo_sym +| pascaligo_sym | cameligo_sym | reasonligo_sym let string = [^'"' '\\' '\n']* (* For strings of #include *) diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 6a56721d8..b9ab1e3d6 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -258,9 +258,10 @@ module Simplify = struct | "LT" -> ok C_LT | "LE" -> ok C_LE | "CONS" -> ok C_CONS + | "NEQ" -> ok C_NEQ | "Michelson.is_nat" -> ok C_IS_NAT - | _ -> simple_fail "Not a Ligodity constant" + | _ -> simple_fail "Not a constant" let type_constants = type_constants let type_operators = type_operators diff --git a/src/test/contracts/address.religo b/src/test/contracts/address.religo new file mode 100644 index 000000000..1bab0004b --- /dev/null +++ b/src/test/contracts/address.religo @@ -0,0 +1 @@ +let main = (c: contract(unit)): address => Current.address(c); diff --git a/src/test/contracts/arithmetic.religo b/src/test/contracts/arithmetic.religo new file mode 100644 index 000000000..6d7fc5d29 --- /dev/null +++ b/src/test/contracts/arithmetic.religo @@ -0,0 +1,24 @@ +/* Test ReasonLIGO arithmetic operators */ + +let mod_op = (n: int): nat => n mod 42; + +let plus_op = (n: int): int => n + 42; + +let minus_op = (n: int): int => n - 42; + +let times_op = (n: int): int => n * 42; + +let div_op = (n: int): int => n / 2; + +/* TODO (?): Support conversion from nat to int and back + + let int_op (n : nat) : int = + Int n + + */ + +let neg_op = (n: int): int => - n; + +let foo = (n: int): int => n + 10; + +let neg_op_2 = (b: int): int => - foo(b); diff --git a/src/test/contracts/assert.religo b/src/test/contracts/assert.religo new file mode 100644 index 000000000..26b9f0775 --- /dev/null +++ b/src/test/contracts/assert.religo @@ -0,0 +1,4 @@ +let main = (p: bool, s: unit) => { + let u: unit = assert(p); + ([]: list(operation), s); +}; diff --git a/src/test/contracts/balance_constant.religo b/src/test/contracts/balance_constant.religo new file mode 100644 index 000000000..f76e32db1 --- /dev/null +++ b/src/test/contracts/balance_constant.religo @@ -0,0 +1,15 @@ +/** + +This test makes sure that the balance is accessible in ReasonLIGO. +It's there to detect a regression of: https://gitlab.com/ligolang/ligo/issues/61 + +Which results in this error when you attempt to compile this contract: + +generated. unrecognized constant: {"constant":"BALANCE","location":"generated"} + + +*/ + +type storage = tez; + +let main = (p: unit, storage) => ([]: list(operation), balance); diff --git a/src/test/contracts/basic.religo b/src/test/contracts/basic.religo new file mode 100644 index 000000000..cefed4a76 --- /dev/null +++ b/src/test/contracts/basic.religo @@ -0,0 +1,3 @@ +type toto = int; + +let foo : toto = 42 + 127; diff --git a/src/test/contracts/big_map.religo b/src/test/contracts/big_map.religo new file mode 100644 index 000000000..1c2913cdd --- /dev/null +++ b/src/test/contracts/big_map.religo @@ -0,0 +1,20 @@ +type foo = big_map(int, int); + +let set_ = (n: int, m: foo): foo => Big_map.update(23, Some(n), m); + +let rm = (m: foo): foo => Big_map.remove(42, m); + +let gf = (m: foo): int => Big_map.find(23, m); + +let get = (m: foo): option(int) => Big_map.find_opt(42, m); + +let empty_map: foo = Big_map.empty; + +let map1: foo = Big_map.literal([(23, 0), (42, 0)]); + +let map1: foo = Big_map.literal([(23, 0), (42, 0)]); + +let mutimaps = (m: foo, n: foo): foo => { + let bar: foo = Big_map.update(42, Some(0), m); + Big_map.update(42, get(bar), n); +}; diff --git a/src/test/contracts/bitwise_arithmetic.religo b/src/test/contracts/bitwise_arithmetic.religo new file mode 100644 index 000000000..c5e2c7837 --- /dev/null +++ b/src/test/contracts/bitwise_arithmetic.religo @@ -0,0 +1,5 @@ +/* Test ReasonLigo bitwise operators */ + +let or_op = (n: nat): nat => Bitwise.lor(n, 4n); +let and_op = (n: nat): nat => Bitwise.land(n, 7n); +let xor_op = (n: nat): nat => Bitwise.lxor(n, 7n); diff --git a/src/test/contracts/boolean_operators.religo b/src/test/contracts/boolean_operators.religo new file mode 100644 index 000000000..8603380a7 --- /dev/null +++ b/src/test/contracts/boolean_operators.religo @@ -0,0 +1,11 @@ +// Test ReasonLIGO boolean operators + +let or_true = (b: bool): bool => b || true; + +let or_false = (b: bool): bool => b || false; + +let and_true = (b: bool): bool => b && true; + +let and_false = (b: bool): bool => b && false; + +let not_bool = (b: bool): bool => !b; diff --git a/src/test/contracts/bytes_arithmetic.religo b/src/test/contracts/bytes_arithmetic.religo new file mode 100644 index 000000000..0c2bf9e12 --- /dev/null +++ b/src/test/contracts/bytes_arithmetic.religo @@ -0,0 +1,5 @@ +let concat_op = (s: bytes): bytes => Bytes.concat(s, "7070": bytes); + +let slice_op = (s: bytes): bytes => Bytes.slice(1n, 2n, s); + +let hasherman = (s: bytes): bytes => Crypto.sha256(s); diff --git a/src/test/contracts/closure.religo b/src/test/contracts/closure.religo new file mode 100644 index 000000000..a17ddb728 --- /dev/null +++ b/src/test/contracts/closure.religo @@ -0,0 +1,9 @@ +/* Test whether closures retain values in ReasonLIGO */ + +let test = (k: int): int => { + let j: int = k + 5; + let close: (int => int) = (i: int) => i + j; + + let j: int = 20; /* Shadow original variable to see if value close'd */ + close(20); +}; diff --git a/src/test/contracts/condition-annot.religo b/src/test/contracts/condition-annot.religo new file mode 100644 index 000000000..97e14f489 --- /dev/null +++ b/src/test/contracts/condition-annot.religo @@ -0,0 +1,6 @@ +let main = (i: int) => + if (((i == 2): bool)) { + (42: int); + } else { + (0: int); + }; diff --git a/src/test/contracts/condition-shadowing.religo b/src/test/contracts/condition-shadowing.religo new file mode 100644 index 000000000..523733331 --- /dev/null +++ b/src/test/contracts/condition-shadowing.religo @@ -0,0 +1,12 @@ +/* TODO : make a test using mutation, not shadowing */ + +let main = (i: int) => { + let result = 0; + if (i == 2) { + let result = 42; + result; + } else { + let result = 0; + result; + }; +}; diff --git a/src/test/contracts/condition.religo b/src/test/contracts/condition.religo new file mode 100644 index 000000000..e44e93d7f --- /dev/null +++ b/src/test/contracts/condition.religo @@ -0,0 +1,8 @@ +/* Test conditional in ReasonLIGO */ + +let main = (i: int) => + if (i == 2) { + 42; + } else { + 0; + }; diff --git a/src/test/contracts/counter.religo b/src/test/contracts/counter.religo new file mode 100644 index 000000000..7a58446b6 --- /dev/null +++ b/src/test/contracts/counter.religo @@ -0,0 +1,4 @@ + +type storage = int; + +let main = (p: int, storage): string => ([]: list(operation), p + storage); diff --git a/src/test/contracts/failwith.religo b/src/test/contracts/failwith.religo new file mode 100644 index 000000000..c7b028c3e --- /dev/null +++ b/src/test/contracts/failwith.religo @@ -0,0 +1,8 @@ +type storage = unit; + +let main = (p: unit, storage) => + if (true) { + failwith("This contract always fails"); + } else { + (); + }; diff --git a/src/test/contracts/function-shared.religo b/src/test/contracts/function-shared.religo new file mode 100644 index 000000000..94cc6b337 --- /dev/null +++ b/src/test/contracts/function-shared.religo @@ -0,0 +1,7 @@ +/* Test use of multiple subroutines in a ReasonLIGO function */ + +let foo = (i: int): int => i + 20; + +let bar = (i: int): int => i + 50; + +let foobar = (i: int): int => foo(i) + bar(i); diff --git a/src/test/contracts/high-order.religo b/src/test/contracts/high-order.religo new file mode 100644 index 000000000..9e8e5cd17 --- /dev/null +++ b/src/test/contracts/high-order.religo @@ -0,0 +1,48 @@ +/* Test a function which takes another function as an argument */ +let foobar = (i: int): int => { + let foo: int => int = (i: int) => i; + + let bar: ((int => int) => int) = (f: (int => int)) => f(i); + + bar(foo); +}; + +/* higher order function with more than one argument */ +let higher2 = (i: int, f: (int => int)): int => { + let ii: int = f(i); + ii; +}; + +let foobar2 = (i: int): int => { + let foo2: int => int = (i: int) => i; + + higher2(i, foo2); +}; + +let a: int = 0; + +let foobar3 = (i: int): int => { + let foo2: int => int = (i: int) => a + i; + + higher2(i, foo2); +}; + +let f = (i: int): int => i; + +let g = (i: int): int => f(i); + +let foobar4 = (i: int): int => g(g(i)); + +let higher3 = (i: int, f: (int => int), g: (int => int)): int => { + let ii: int = f(g(i)); + ii; +}; + +let foobar5 = (i: int): int => { + let a: int = 0; + let foo: int => int = (i: int) => a + i; + + let goo: int => int = (i: int) => foo(i); + + higher3(i, foo, goo); +}; diff --git a/src/test/contracts/implicit_account.religo b/src/test/contracts/implicit_account.religo new file mode 100644 index 000000000..dba1656ec --- /dev/null +++ b/src/test/contracts/implicit_account.religo @@ -0,0 +1 @@ +let main = (kh: key_hash): contract(unit) => Current.implicit_account(kh); diff --git a/src/test/contracts/isnat.religo b/src/test/contracts/isnat.religo new file mode 100644 index 000000000..b6b5921b7 --- /dev/null +++ b/src/test/contracts/isnat.religo @@ -0,0 +1 @@ +let main = (i: int): option(nat) => Michelson.is_nat(i); diff --git a/src/test/contracts/lambda.religo b/src/test/contracts/lambda.religo new file mode 100644 index 000000000..097da1e95 --- /dev/null +++ b/src/test/contracts/lambda.religo @@ -0,0 +1,8 @@ +type storage = unit; + +/* not supported yet + let%entry main (p:unit) storage = + (fun x -> ()) () + */ + +let main = ((p: unit), storage) => (((xxx: unit)) => ())(); diff --git a/src/test/contracts/lambda2.religo b/src/test/contracts/lambda2.religo new file mode 100644 index 000000000..c442d2012 --- /dev/null +++ b/src/test/contracts/lambda2.religo @@ -0,0 +1,8 @@ +type storage = unit; + +/* Not supported yet: + let main (p:unit) storage = (fun x -> ()) () + */ + +let main = (z: unit, storage) => + ((f: (unit => unit)) => f())((z: unit) => unit); diff --git a/src/test/contracts/let_multiple.religo b/src/test/contracts/let_multiple.religo new file mode 100644 index 000000000..0e5934027 --- /dev/null +++ b/src/test/contracts/let_multiple.religo @@ -0,0 +1,14 @@ +/* Simple test of binding multiple values */ + +let ((x: int), (y: int)) = (1, 2); + +let main = (p: unit): int => x + y; + +let ((x: int), (y: int)) = (3, 3); + +let main_paren = (p: unit): int => x + y; + +let foobar: (int, int) = (23, 42); +let ((foo: int), (bar: int)) = foobar; + +let non_tuple_rhs = (p: unit): int => foo + bar; diff --git a/src/test/contracts/letin.religo b/src/test/contracts/letin.religo new file mode 100644 index 000000000..48290282f --- /dev/null +++ b/src/test/contracts/letin.religo @@ -0,0 +1,9 @@ +type storage = (int, int); + +let main = ((n : int), storage) => { + let x: (int, int) = { + let x: int = 7; + (x + n, storage[0] + storage[1]); + }; + ([]: list(operation), x); +}; diff --git a/src/test/contracts/list.religo b/src/test/contracts/list.religo new file mode 100644 index 000000000..524edfa00 --- /dev/null +++ b/src/test/contracts/list.religo @@ -0,0 +1,29 @@ +type storage = (int, list(int)); + +type param = list(int); + +let x: list(int) = []; +let y: list(int) = [3, 4, 5]; +let z: list(int) = [2, ...y]; + +let main = (p: param, storage) => { + let storage = + switch (p) { + | [] => storage + | [hd, ...tl] => (storage[0] + hd, tl) + }; + ([]: list(operation), storage); +}; + +let fold_op = (s: list(int)): int => { + let aggregate = (prec: int, cur: int) => prec + cur; + List.fold(aggregate, s, 10); +}; + +let map_op = (s: list(int)): list(int) => + List.map((cur: int) => cur + 1, s); + +let iter_op = (s: list(int)): unit => { + let do_nothing = (z: int) => unit; + List.iter(do_nothing, s); +}; diff --git a/src/test/contracts/loop.religo b/src/test/contracts/loop.religo new file mode 100644 index 000000000..60bba7d17 --- /dev/null +++ b/src/test/contracts/loop.religo @@ -0,0 +1,46 @@ +/* Test loops in ReasonLIGO */ + +let aux_simple = (i: int): (bool, int) => + if (i < 100) { + continue(i + 1); + } else { + stop(i); + }; + +let counter_simple = (n: int): int => Loop.fold_while(aux_simple, n); + +type sum_aggregator = { + counter: int, + sum: int, +}; + +let counter = (n: int): int => { + let initial: sum_aggregator = {counter: 0, sum: 0}; + let out: sum_aggregator = + Loop.fold_while( + (prev: sum_aggregator) => + if (prev.counter <= n) { + continue({counter: prev.counter + 1, sum: prev.counter + prev.sum}); + } else { + stop({counter: prev.counter, sum: prev.sum}); + }, + initial + ); + out.sum; +}; + +let aux_nest = (prev: sum_aggregator): (bool, sum_aggregator) => + if (prev.counter < 100) { + continue({ + counter: prev.counter + 1, + sum: prev.sum + Loop.fold_while(aux_simple, prev.counter), + }); + } else { + stop({counter: prev.counter, sum: prev.sum}); + }; + +let counter_nest = (n: int): int => { + let initial: sum_aggregator = {counter: 0, sum: 0}; + let out: sum_aggregator = Loop.fold_while(aux_nest, initial); + out.sum; +}; diff --git a/src/test/contracts/map.religo b/src/test/contracts/map.religo new file mode 100644 index 000000000..6faacb700 --- /dev/null +++ b/src/test/contracts/map.religo @@ -0,0 +1,57 @@ + +type foobar = map(int, int); + +let empty_map: foobar = Map.empty; + +let map1: foobar = + Map.literal([(144, 23), (51, 23), (42, 23), (120, 23), (421, 23)]); + +let map2: foobar = Map.literal([(23, 0), (42, 0)]); + +let set_ = (n: int, m: foobar): foobar => Map.update(23, Some(n), m); + +let rm = (m: foobar): foobar => Map.remove(42, m); + +/* Dummy test so that we can add the same test for PascaLIGO */ +let patch_ = (m: foobar): foobar => Map.literal([(0, 5), (1, 6), (2, 7)]); + +/* Second dummy test, see above */ +let patch_empty = (m: foobar): foobar => + Map.literal([(0, 0), (1, 1), (2, 2)]); + +/* Third dummy test, see above */ +let patch_deep = (m: (foobar, nat)): (foobar, nat) => ( + Map.literal([(0, 0), (1, 9), (2, 2)]), + 10n +); + +let size_ = (m: foobar): nat => Map.size(m); + +let gf = (m: foobar): int => Map.find(23, m); + +let get = (m: foobar): option(int) => Map.find_opt(42, m); +let get_ = (m: foobar): option(int) => Map.find_opt(42, m); + +let mem = (km: (int, foobar)): bool => Map.mem(km[0], km[1]); + +let iter_op = (m: foobar): unit => { + let assert_eq = (i: int, j: int) => assert(i == j); + Map.iter(assert_eq, m); +}; + +let map_op = (m: foobar): foobar => { + let increment = (z: int, j: int) => j + 1; + Map.map(increment, m); +}; + +let fold_op = (m: foobar): foobar => { + let aggregate = (i: int, j: (int, int)) => i + j[0] + j[1]; + Map.fold(aggregate, m, 10); +}; + +let deep_op = (m: foobar): foobar => { + let coco = (0, m); + let coco = (0, Map.remove(42, coco[1])); + let coco = (0, Map.update(32, Some(16), coco[1])); + coco[1]; +}; diff --git a/src/test/contracts/match.religo b/src/test/contracts/match.religo new file mode 100644 index 000000000..2e2fbc7a9 --- /dev/null +++ b/src/test/contracts/match.religo @@ -0,0 +1,17 @@ +type storage = int; + +type param = + | Add(int) + | Sub(int); + +let main = ((p: param), storage) => { + let storage = + storage + + ( + switch (p) { + | Add(n) => n + | Sub(n) => 0 - n + } + ); + (([]: list(operation)), storage); +}; diff --git a/src/test/contracts/match_bis.religo b/src/test/contracts/match_bis.religo new file mode 100644 index 000000000..7c8c2df0f --- /dev/null +++ b/src/test/contracts/match_bis.religo @@ -0,0 +1,22 @@ +type storage = int; + +/* variant defining pseudo multi-entrypoint actions */ + +type action = + | Increment(int) + | Decrement(int); + +let add = ((a: int), (b: int)) => a + b; + +let subtract = ((a: int), (b: int)) => a - b; + +/* real entrypoint that re-routes the flow based on the action provided */ + +let main = ((p: action), storage) => { + let storage = + switch (p) { + | Increment(n) => add(storage, n) + | Decrement(n) => subtract(storage, n) + }; + (([]: list(operation)), storage); +}; diff --git a/src/test/contracts/multiple-parameters.religo b/src/test/contracts/multiple-parameters.religo new file mode 100644 index 000000000..ff6c6d604 --- /dev/null +++ b/src/test/contracts/multiple-parameters.religo @@ -0,0 +1,3 @@ +/* Test function with several parameters */ + +let abcde = (a: int, b: int, c: int, d: int, e: int): int => c + e + 3; diff --git a/src/test/contracts/option.religo b/src/test/contracts/option.religo new file mode 100644 index 000000000..75dacb697 --- /dev/null +++ b/src/test/contracts/option.religo @@ -0,0 +1,4 @@ +type foobar = option(int); + +let s: foobar = Some(42); +let n: foobar = None; diff --git a/src/test/contracts/self_address.religo b/src/test/contracts/self_address.religo new file mode 100644 index 000000000..e072bc56f --- /dev/null +++ b/src/test/contracts/self_address.religo @@ -0,0 +1 @@ +let main = (p: unit): address => Current.self_address; diff --git a/src/test/contracts/set_arithmetic.religo b/src/test/contracts/set_arithmetic.religo new file mode 100644 index 000000000..4e613500d --- /dev/null +++ b/src/test/contracts/set_arithmetic.religo @@ -0,0 +1,20 @@ +/* Test set operations in ReasonLIGO */ + +let add_op = (s: set(string)): set(string) => Set.add("foobar", s); + +let remove_op = (s: set(string)): set(string) => Set.remove("foobar", s); + +let remove_deep = (s: (set(string), nat)): (set(string), nat) => + Set.remove("foobar", s[0]); + +/* + let patch_op (s: string set) : string set = + begin patch s with set ["foobar"]; end with s + + let patch_op_deep (s: string set * nat) : string set * nat = + begin patch s[0] with set ["foobar"]; end with s + */ + +let mem_op = (s: set(string)): bool => Set.mem("foobar", s); + +let size_op = (s: set(string)): nat => Set.size(s); diff --git a/src/test/contracts/string_arithmetic.religo b/src/test/contracts/string_arithmetic.religo new file mode 100644 index 000000000..ba3949f08 --- /dev/null +++ b/src/test/contracts/string_arithmetic.religo @@ -0,0 +1,7 @@ +/* Test that the string concatenation syntax in ReasonLIGO works */ + +let size_op = (s: string): nat => String.size(s); + +let slice_op = (s: string): string => String.slice(1n, 2n, s); + +let concat_syntax = (s: string) => s ++ "test_literal"; diff --git a/src/test/contracts/super-counter.religo b/src/test/contracts/super-counter.religo new file mode 100644 index 000000000..3e64f3152 --- /dev/null +++ b/src/test/contracts/super-counter.religo @@ -0,0 +1,12 @@ +type action = + | Increment(int) + | Decrement(int); + +let main = (p: action, s: int): (list(operation), int) => { + let storage = + switch (p) { + | Increment(n) => s + n + | Decrement(n) => s - n + }; + ([]: list(operation), storage); +}; diff --git a/src/test/contracts/tuple.religo b/src/test/contracts/tuple.religo new file mode 100644 index 000000000..fc7beb188 --- /dev/null +++ b/src/test/contracts/tuple.religo @@ -0,0 +1,13 @@ +type abc = (int, int, int); + +let projection_abc = (tpl: abc): int => tpl[1]; + +type foobar = (int, int); + +let fb: foobar = (0, 0); + +let projection = (tpl: foobar): int => tpl[0] + tpl[1]; + +type big_tuple = (int, int, int, int, int); + +let br: big_tuple = (23, 23, 23, 23, 23); \ No newline at end of file diff --git a/src/test/contracts/tuples_sequences_functions.religo b/src/test/contracts/tuples_sequences_functions.religo new file mode 100644 index 000000000..bffd78faf --- /dev/null +++ b/src/test/contracts/tuples_sequences_functions.religo @@ -0,0 +1,54 @@ +let a = 1; +let b = 1n; +let c = 2mutez; +let d = 1n + 2n; +let e = 1mutez + 3mutez; +let f = (a, c); +let g = (a + 1, c); +let h = ("a" ++ "2", d); +let i = (a: int, b: int) => a + b; +let j = (a: int, b: int) => a - b; +/* not supported by typer yet: let k = () => b; */ +/* not supported by typer yet: let l = () => i(2,3); */ +let m = { + let z = 3; + z; +}; +let n = (a: int): int => a + 1; +let o = (a: int): int => a + 1; +let n = (a: int, b: int): int => a + 1; +let o = (a: int, b: int): int => a + 1; +let p = {{ + 3; +}}; +let q = { + f: 3, + g: 6, + h: { + i: "bla", + j: 1 + 2, + k: { + l: 1, + z: 2 + }, + }, +}; + +/* +Not supported yet by parser: + +let r = { + a: 1 +}; +*/ + +let s = { + let a = 2; + { + z: a, + a + }; +}; + +let t = (((((((2))))))); +let u = if (true) { 1; } else { 2; }; \ No newline at end of file diff --git a/src/test/contracts/variant.religo b/src/test/contracts/variant.religo new file mode 100644 index 000000000..99b69e94f --- /dev/null +++ b/src/test/contracts/variant.religo @@ -0,0 +1,10 @@ +type foobar = + | Foo(int) + | Bar(bool) + | Kee(nat); + +let foo: foobar = Foo(42); + +let bar: foobar = Bar(true); + +let kee: foobar = Kee(23n); diff --git a/src/test/contracts/website2.religo b/src/test/contracts/website2.religo new file mode 100644 index 000000000..d20033efc --- /dev/null +++ b/src/test/contracts/website2.religo @@ -0,0 +1,21 @@ +type storage = int; + +/* variant defining pseudo multi-entrypoint actions */ + +type action = + | Increment(int) + | Decrement(int); + +let add = (a: int, b: int): int => a + b; +let sub = (a: int, b: int): int => a - b; + +/* real entrypoint that re-routes the flow based on the action provided */ + +let main = (p: action, storage) => { + let storage = + switch (p) { + | Increment(n) => add(storage, n) + | Decrement(n) => sub(storage, n) + }; + ([]: list(operation), storage); +}; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index d467eefee..201c0ebd3 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -3,6 +3,10 @@ open Test_helpers open Ast_simplified.Combinators +let retype_file f = + let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "reasonligo") f in + let () = Typer.Solver.discard_state state in + ok typed let mtype_file f = let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "cameligo") f in let () = Typer.Solver.discard_state state in @@ -98,6 +102,20 @@ let variant_mligo () : unit result = expect_eq_evaluate program "kee" expected in ok () +let variant_religo () : unit result = + let%bind program = retype_file "./contracts/variant.religo" in + let%bind () = + let expected = e_constructor "Foo" (e_int 42) in + expect_eq_evaluate program "foo" expected in + let%bind () = + let expected = e_constructor "Bar" (e_bool true) in + expect_eq_evaluate program "bar" expected in + let%bind () = + let expected = e_constructor "Kee" (e_nat 23) in + expect_eq_evaluate program "kee" expected in + ok () + + let variant_matching () : unit result = let%bind program = type_file "./contracts/variant-matching.ligo" in let%bind () = @@ -143,6 +161,16 @@ let closure_mligo () : unit result = in ok () +let closure_religo () : unit result = + let%bind program = retype_file "./contracts/closure.religo" in + let%bind _ = + let input = e_int 0 in + let expected = e_int 25 in + expect_eq program "test" input expected + in + ok () + + let shadow () : unit result = let%bind program = type_file "./contracts/shadow.ligo" in let make_expect = fun _ -> 0 in @@ -168,6 +196,15 @@ let higher_order_mligo () : unit result = let%bind _ = expect_eq_n_int program "foobar5" make_expect in ok () +let higher_order_religo () : unit result = + let%bind program = retype_file "./contracts/high-order.religo" in + let make_expect = fun n -> n in + let%bind _ = expect_eq_n_int program "foobar" make_expect in + let%bind _ = expect_eq_n_int program "foobar2" make_expect in + let%bind _ = expect_eq_n_int program "foobar3" make_expect in + let%bind _ = expect_eq_n_int program "foobar4" make_expect in + let%bind _ = expect_eq_n_int program "foobar5" make_expect in + ok () let shared_function () : unit result = let%bind program = type_file "./contracts/function-shared.ligo" in @@ -204,6 +241,14 @@ let shared_function_mligo () : unit result = in ok () +let shared_function_religo () : unit result = + let%bind program = retype_file "./contracts/function-shared.religo" in + let%bind () = + let make_expect = fun n -> (2 * n + 70) in + expect_eq_n_int program "foobar" make_expect + in + ok () + let bool_expression () : unit result = let%bind program = type_file "./contracts/boolean_operators.ligo" in let%bind _ = @@ -230,6 +275,19 @@ let bool_expression_mligo () : unit result = ] in ok () +let bool_expression_religo () : unit result = + let%bind program = retype_file "./contracts/boolean_operators.religo" in + let%bind _ = + let aux (name, f) = expect_eq_b_bool program name f in + bind_map_list aux [ + ("or_true", fun b -> b || true) ; + ("or_false", fun b -> b || false) ; + ("and_true", fun b -> b && true) ; + ("and_false", fun b -> b && false) ; + ("not_bool", fun b -> not b) ; + ] in + ok () + let arithmetic () : unit result = let%bind program = type_file "./contracts/arithmetic.ligo" in let%bind _ = @@ -260,6 +318,21 @@ let arithmetic_mligo () : unit result = let%bind () = expect_eq_n_pos program "div_op" e_int (fun n -> e_int (n / 2)) in ok () +let arithmetic_religo () : unit result = + let%bind program = retype_file "./contracts/arithmetic.religo" in + let%bind _ = + let aux (name, f) = expect_eq_n_int program name f in + bind_map_list aux [ + ("plus_op", fun n -> (n + 42)) ; + ("minus_op", fun n -> (n - 42)) ; + ("times_op", fun n -> (n * 42)) ; + ("neg_op", fun n -> (-n)) ; + ("neg_op_2", fun n -> -(n + 10)) ; + ] in + let%bind () = expect_eq_n_pos program "mod_op" e_int (fun n -> e_nat (n mod 42)) in + let%bind () = expect_eq_n_pos program "div_op" e_int (fun n -> e_int (n / 2)) in + ok () + let bitwise_arithmetic () : unit result = let%bind program = type_file "./contracts/bitwise_arithmetic.ligo" in let%bind () = expect_eq program "or_op" (e_nat 7) (e_nat 7) in @@ -292,6 +365,22 @@ let bitwise_arithmetic_mligo () : unit result = let%bind () = expect_eq program "xor_op" (e_nat 7) (e_nat 0) in ok () +let bitwise_arithmetic_religo () : unit result = + let%bind program = retype_file "./contracts/bitwise_arithmetic.religo" in + let%bind () = expect_eq program "or_op" (e_nat 7) (e_nat 7) in + let%bind () = expect_eq program "or_op" (e_nat 3) (e_nat 7) in + let%bind () = expect_eq program "or_op" (e_nat 2) (e_nat 6) in + let%bind () = expect_eq program "or_op" (e_nat 14) (e_nat 14) in + let%bind () = expect_eq program "or_op" (e_nat 10) (e_nat 14) in + let%bind () = expect_eq program "and_op" (e_nat 7) (e_nat 7) in + let%bind () = expect_eq program "and_op" (e_nat 3) (e_nat 3) in + let%bind () = expect_eq program "and_op" (e_nat 2) (e_nat 2) in + let%bind () = expect_eq program "and_op" (e_nat 14) (e_nat 6) in + let%bind () = expect_eq program "and_op" (e_nat 10) (e_nat 2) in + let%bind () = expect_eq program "xor_op" (e_nat 0) (e_nat 7) in + let%bind () = expect_eq program "xor_op" (e_nat 7) (e_nat 0) in + ok () + let string_arithmetic () : unit result = let%bind program = type_file "./contracts/string_arithmetic.ligo" in let%bind () = expect_eq program "concat_op" (e_string "foo") (e_string "foototo") in @@ -309,6 +398,15 @@ let string_arithmetic_mligo () : unit result = let%bind () = expect_eq program "concat_syntax" (e_string "string_") (e_string "string_test_literal") in ok () +let string_arithmetic_religo () : unit result = + let%bind program = retype_file "./contracts/string_arithmetic.religo" in + let%bind () = expect_eq program "size_op" (e_string "tata") (e_nat 4) in + let%bind () = expect_eq program "slice_op" (e_string "tata") (e_string "at") in + let%bind () = expect_eq program "slice_op" (e_string "foo") (e_string "oo") in + let%bind () = expect_eq program "concat_syntax" (e_string "string_") (e_string "string_test_literal") + in ok () + + let bytes_arithmetic () : unit result = let%bind program = type_file "./contracts/bytes_arithmetic.ligo" in let%bind foo = e_bytes "0f00" in @@ -349,6 +447,26 @@ let bytes_arithmetic_mligo () : unit result = let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in ok () +let bytes_arithmetic_religo () : unit result = + let%bind program = retype_file "./contracts/bytes_arithmetic.religo" in + let%bind foo = e_bytes "0f00" in + let%bind foototo = e_bytes "0f007070" in + let%bind toto = e_bytes "7070" in + let%bind empty = e_bytes "" in + let%bind tata = e_bytes "7a7a7a7a" in + let%bind at = e_bytes "7a7a" in + let%bind ba = e_bytes "ba" in + let%bind () = expect_eq program "concat_op" foo foototo in + let%bind () = expect_eq program "concat_op" empty toto in + 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 + ok () + let set_arithmetic () : unit result = let%bind program = type_file "./contracts/set_arithmetic.ligo" in let%bind program_1 = type_file "./contracts/set_arithmetic-1.ligo" in @@ -442,6 +560,36 @@ let set_arithmetic_mligo () : unit result = in ok () +let set_arithmetic_religo () : unit result = + let%bind program = retype_file "./contracts/set_arithmetic.religo" in + let%bind program_1 = type_file "./contracts/set_arithmetic-1.ligo" in + let%bind () = + expect_eq program "size_op" + (e_set [e_string "foo"; e_string "bar"; e_string "foobar"]) + (e_nat 3) in + let%bind () = + expect_eq program "add_op" + (e_set [e_string "foo" ; e_string "bar"]) + (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) in + let%bind () = + expect_eq program "add_op" + (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) + (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) in + let%bind () = + expect_eq program "remove_op" + (e_set [e_string "foo" ; e_string "bar"]) + (e_set [e_string "foo" ; e_string "bar"]) in + let%bind () = + expect_eq program "remove_op" + (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) + (e_set [e_string "foo" ; e_string "bar"]) in + let%bind () = + expect_eq program_1 "fold_op" + (e_set [ e_int 4 ; e_int 10 ]) + (e_int 29) + in + ok () + let unit_expression () : unit result = let%bind program = type_file "./contracts/unit.ligo" in expect_eq_evaluate program "u" (e_unit ()) @@ -486,6 +634,18 @@ let multiple_parameters_mligo () : unit result = ] in ok () +let multiple_parameters_religo () : unit result = + let%bind program = retype_file "./contracts/multiple-parameters.religo" in + let aux ((name : string) , make_input , make_output) = + let make_output' = fun n -> e_int @@ make_output n in + expect_eq_n program name make_input make_output' + in + let%bind _ = bind_list @@ List.map aux [ + (* Didn't include the other tests because they're probably not necessary *) + ("abcde", tuple_ez_int ["a";"b";"c";"d";"e"], fun n -> 2 * n + 3) ; + ] in + ok () + let record () : unit result = let%bind program = type_file "./contracts/record.ligo" in let%bind () = @@ -581,6 +741,31 @@ let tuple_mligo () : unit result = in ok () + +let tuple_religo () : unit result = + let%bind program = retype_file "./contracts/tuple.religo" in + let ez n = + e_tuple (List.map e_int n) in + let%bind () = + let expected = ez [0 ; 0] in + expect_eq_evaluate program "fb" expected + in + let%bind () = + let make_input = fun n -> ez [n ; n] in + let make_expected = fun n -> e_int (2 * n) in + expect_eq_n program "projection" make_input make_expected + in + let%bind () = + let make_input = fun n -> ez [n ; 2 * n ; n] in + let make_expected = fun n -> e_int (2 * n) in + expect_eq_n program "projection_abc" make_input make_expected + in + let%bind () = + let expected = ez [23 ; 23 ; 23 ; 23 ; 23] in + expect_eq_evaluate program "br" expected + in + ok () + let option () : unit result = let%bind program = type_file "./contracts/option.ligo" in let%bind () = @@ -609,6 +794,19 @@ let moption () : unit result = in ok () +let reoption () : unit result = + let%bind program = retype_file "./contracts/option.religo" in + let%bind () = + let expected = e_some (e_int 42) in + expect_eq_evaluate program "s" expected + in + let%bind () = + let expected = e_typed_none t_int in + expect_eq_evaluate program "n" expected + in + ok () + + let map_ type_f path : unit result = let%bind program = type_f path in let ez lst = @@ -616,7 +814,7 @@ let map_ type_f path : unit result = let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in e_typed_map lst' t_int t_int in - let%bind () = + let%bind () = let make_input = fun n -> let m = ez [(23 , 0) ; (42 , 0)] in e_tuple [(e_int n) ; m] @@ -738,8 +936,10 @@ let big_map_ type_f path : unit result = let map () : unit result = map_ type_file "./contracts/map.ligo" let mmap () : unit result = map_ mtype_file "./contracts/map.mligo" +let remap () : unit result = map_ retype_file "./contracts/map.religo" let big_map () : unit result = big_map_ type_file "./contracts/big_map.ligo" let mbig_map () : unit result = big_map_ mtype_file "./contracts/big_map.mligo" +let rebig_map () : unit result = big_map_ retype_file "./contracts/big_map.religo" let list () : unit result = @@ -813,6 +1013,21 @@ let condition_mligo () : unit result = ] in ok () +let condition_religo () : unit result = + let%bind _ = + let aux file = + let%bind program = retype_file file in + let make_input = e_int in + let make_expected = fun n -> e_int (if n = 2 then 42 else 0) in + expect_eq_n program "main" make_input make_expected in + bind_map_list aux [ + "./contracts/condition.religo"; + "./contracts/condition-shadowing.religo"; + "./contracts/condition-annot.religo"; + ] in + ok () + + let condition_simple () : unit result = let%bind program = type_file "./contracts/condition-simple.ligo" in let make_input = e_int in @@ -910,6 +1125,25 @@ let loop_mligo () : unit result = expect_eq program "counter_nest" input expected in ok () +let loop_religo () : unit result = + let%bind program = retype_file "./contracts/loop.religo" in + let%bind () = + let input = e_int 0 in + let expected = e_int 100 in + expect_eq program "counter_simple" input expected + in + let%bind () = + let input = e_int 100 in + let expected = e_int 5050 in + expect_eq program "counter" input expected + in + let%bind () = + let input = e_int 100 in + let expected = e_int 10000 in + expect_eq program "counter_nest" input expected + in ok () + + let matching () : unit result = let%bind program = type_file "./contracts/match.ligo" in let%bind () = @@ -1010,6 +1244,17 @@ let super_counter_contract_mligo () : unit result = e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in expect_eq_n program "main" make_input make_expected +let super_counter_contract_religo () : unit result = + let%bind program = retype_file "./contracts/super-counter.religo" in + let make_input = fun n -> + let action = if n mod 2 = 0 then "Increment" else "Decrement" in + e_pair (e_constructor action (e_int n)) (e_int 42) in + let make_expected = fun n -> + let op = if n mod 2 = 0 then (+) else (-) in + e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in + expect_eq_n program "main" make_input make_expected + + let dispatch_counter_contract () : unit result = let%bind program = type_file "./contracts/dispatch-counter.ligo" in let make_input = fun n -> @@ -1040,6 +1285,11 @@ let failwith_mligo () : unit result = let make_input = e_pair (e_unit ()) (e_unit ()) in expect_fail program "main" make_input +let failwith_religo () : unit result = + let%bind program = retype_file "./contracts/failwith.religo" in + let make_input = e_pair (e_unit ()) (e_unit ()) in + expect_fail program "main" make_input + let assert_mligo () : unit result = let%bind program = mtype_file "./contracts/assert.mligo" in let make_input b = e_pair (e_bool b) (e_unit ()) in @@ -1048,6 +1298,14 @@ let assert_mligo () : unit result = let%bind _ = expect_eq program "main" (make_input true) make_expected in ok () +let assert_religo () : unit result = + let%bind program = retype_file "./contracts/assert.religo" in + let make_input b = e_pair (e_bool b) (e_unit ()) in + let make_expected = e_pair (e_typed_list [] t_operation) (e_unit ()) in + let%bind _ = expect_fail program "main" (make_input false) in + let%bind _ = expect_eq program "main" (make_input true) make_expected in + ok () + let guess_the_hash_mligo () : unit result = let%bind program = mtype_file "./contracts/new-syntax.mligo" in let make_input = fun n-> e_pair (e_int n) (e_int 42) in @@ -1055,7 +1313,7 @@ let guess_the_hash_mligo () : unit result = expect_eq_n program "main" make_input make_expected let guess_string_mligo () : unit result = - let%bind program = mtype_file "./contracts/guess_string.mligo" in + let%bind program = type_file "./contracts/guess_string.mligo" in let make_input = fun n -> e_pair (e_int n) (e_int 42) in let make_expected = fun n -> e_pair (e_typed_list [] t_operation) (e_int (42 + n)) in expect_eq_n program "main" make_input make_expected @@ -1064,12 +1322,23 @@ let basic_mligo () : unit result = let%bind typed = mtype_file "./contracts/basic.mligo" in expect_eq_evaluate typed "foo" (e_int (42+127)) +let basic_religo () : unit result = + let%bind typed = retype_file "./contracts/basic.religo" in + expect_eq_evaluate typed "foo" (e_int (42+127)) + let counter_mligo () : unit result = let%bind program = mtype_file "./contracts/counter.mligo" in let make_input n = e_pair (e_int n) (e_int 42) in let make_expected n = e_pair (e_typed_list [] t_operation) (e_int (42 + n)) in expect_eq_n program "main" make_input make_expected +let counter_religo () : unit result = + let%bind program = retype_file "./contracts/counter.religo" in + let make_input n = e_pair (e_int n) (e_int 42) in + let make_expected n = e_pair (e_typed_list [] t_operation) (e_int (42 + n)) in + expect_eq_n program "main" make_input make_expected + + let let_in_mligo () : unit result = let%bind program = mtype_file "./contracts/letin.mligo" in let make_input n = e_pair (e_int n) (e_pair (e_int 3) (e_int 5)) in @@ -1077,6 +1346,14 @@ let let_in_mligo () : unit result = e_pair (e_typed_list [] t_operation) (e_pair (e_int (7+n)) (e_int (3+5))) in expect_eq_n program "main" make_input make_expected +let let_in_religo () : unit result = + let%bind program = retype_file "./contracts/letin.religo" in + let make_input n = e_pair (e_int n) (e_pair (e_int 3) (e_int 5)) in + let make_expected n = + e_pair (e_typed_list [] t_operation) (e_pair (e_int (7+n)) (e_int (3+5))) + in expect_eq_n program "main" make_input make_expected + + let match_variant () : unit result = let%bind program = mtype_file "./contracts/match.mligo" in let%bind () = @@ -1107,6 +1384,15 @@ let match_variant () : unit result = expect_eq_n program "match_option" make_input make_expected in ok () +let match_variant_re () : unit result = + let%bind program = retype_file "./contracts/match.religo" in + let make_input n = + e_pair (e_constructor "Sub" (e_int n)) (e_int 3) in + let make_expected n = + e_pair (e_typed_list [] t_operation) (e_int (3-n)) + in expect_eq_n program "main" make_input make_expected + + let match_matej () : unit result = let%bind program = mtype_file "./contracts/match_bis.mligo" in let make_input n = @@ -1115,6 +1401,15 @@ let match_matej () : unit result = e_pair (e_typed_list [] t_operation) (e_int (3-n)) in expect_eq_n program "main" make_input make_expected +let match_matej_re () : unit result = + let%bind program = retype_file "./contracts/match_bis.religo" in + let make_input n = + e_pair (e_constructor "Decrement" (e_int n)) (e_int 3) in + let make_expected n = + e_pair (e_typed_list [] t_operation) (e_int (3-n)) + in expect_eq_n program "main" make_input make_expected + + let mligo_list () : unit result = let%bind program = mtype_file "./contracts/list.mligo" in let aux lst = e_list @@ List.map e_int lst in @@ -1136,12 +1431,40 @@ let mligo_list () : unit result = let%bind () = expect_eq program "iter_op" (aux [2 ; 3 ; 4 ; 5]) (e_unit ()) in ok () +let religo_list () : unit result = + let%bind program = retype_file "./contracts/list.religo" in + let aux lst = e_list @@ List.map e_int lst in + let%bind () = expect_eq program "fold_op" (aux [ 1 ; 2 ; 3 ]) (e_int 16) in + let%bind () = + let make_input n = + e_pair (e_list [e_int n; e_int (2*n)]) + (e_pair (e_int 3) (e_list [e_int 8])) in + let make_expected n = + e_pair (e_typed_list [] t_operation) + (e_pair (e_int (n+3)) (e_list [e_int (2*n)])) + in + expect_eq_n program "main" make_input make_expected + in + let%bind () = expect_eq_evaluate program "x" (e_list []) in + let%bind () = expect_eq_evaluate program "y" (e_list @@ List.map e_int [3 ; 4 ; 5]) in + let%bind () = expect_eq_evaluate program "z" (e_list @@ List.map e_int [2 ; 3 ; 4 ; 5]) in + let%bind () = expect_eq program "map_op" (aux [2 ; 3 ; 4 ; 5]) (aux [3 ; 4 ; 5 ; 6]) in + let%bind () = expect_eq program "iter_op" (aux [2 ; 3 ; 4 ; 5]) (e_unit ()) in + ok () + let lambda_mligo () : unit result = let%bind program = mtype_file "./contracts/lambda.mligo" in let make_input = e_pair (e_unit ()) (e_unit ()) in let make_expected = (e_unit ()) in expect_eq program "main" make_input make_expected +let lambda_religo () : unit result = + let%bind program = retype_file "./contracts/lambda.religo" in + let make_input = e_pair (e_unit ()) (e_unit ()) in + let make_expected = (e_unit ()) in + expect_eq program "main" make_input make_expected + + let lambda_ligo () : unit result = let%bind program = type_file "./contracts/lambda.ligo" in let make_input = e_pair (e_unit ()) (e_unit ()) in @@ -1154,6 +1477,13 @@ let lambda2_mligo () : unit result = let make_expected = (e_unit ()) in expect_eq program "main" make_input make_expected +let lambda2_religo () : unit result = + let%bind program = retype_file "./contracts/lambda2.religo" in + let make_input = e_pair (e_unit ()) (e_unit ()) in + let make_expected = (e_unit ()) in + expect_eq program "main" make_input make_expected + + let fibo_mligo () : unit result = let%bind program = mtype_file "./contracts/fibo.mligo" in let make_input = e_pair (e_unit ()) (e_unit ()) in @@ -1209,6 +1539,17 @@ let website2_mligo () : unit result = e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in expect_eq_n program "main" make_input make_expected +let website2_religo () : unit result = + let%bind program = retype_file "./contracts/website2.religo" in + let make_input = fun n -> + let action = if n mod 2 = 0 then "Increment" else "Decrement" in + e_pair (e_constructor action (e_int n)) (e_int 42) in + let make_expected = fun n -> + let op = if n mod 2 = 0 then (+) else (-) in + e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in + expect_eq_n program "main" make_input make_expected + + let mligo_let_multiple () : unit result = let%bind program = mtype_file "./contracts/let_multiple.mligo" in let%bind () = @@ -1243,6 +1584,25 @@ let mligo_let_multiple () : unit result = in ok () +let religo_let_multiple () : unit result = + let%bind program = retype_file "./contracts/let_multiple.religo" in + let%bind () = + let input = e_unit () in + let expected = e_int 3 in + expect_eq program "main" input expected + in + let%bind () = + let input = e_unit () in + let expected = e_int 6 in + expect_eq program "main_paren" input expected + in + let%bind () = + let input = e_unit () in + let expected = e_int 65 in + expect_eq program "non_tuple_rhs" input expected + in + ok () + let balance_constant () : unit result = let%bind program = type_file "./contracts/balance_constant.ligo" in let input = e_tuple [e_unit () ; e_mutez 0] in @@ -1256,6 +1616,13 @@ let balance_constant_mligo () : unit result = let expected = e_tuple [e_list []; e_mutez 4000000000000] in expect_eq program "main" input expected +let balance_constant_religo () : unit result = + let%bind program = retype_file "./contracts/balance_constant.religo" in + let input = e_tuple [e_unit () ; e_mutez 0] in + let expected = e_tuple [e_list []; e_mutez 4000000000000] in + expect_eq program "main" input expected + + let address () : unit result = let%bind _ = type_file "./contracts/address.ligo" in ok () @@ -1264,6 +1631,11 @@ let address_mligo () : unit result = let%bind _ = mtype_file "./contracts/address.mligo" in ok () +let address_religo () : unit result = + let%bind _ = retype_file "./contracts/address.religo" in + ok () + + let self_address () : unit result = let%bind _ = type_file "./contracts/self_address.ligo" in ok () @@ -1272,6 +1644,10 @@ let self_address_mligo () : unit result = let%bind _ = mtype_file "./contracts/self_address.mligo" in ok () +let self_address_religo () : unit result = + let%bind _ = retype_file "./contracts/self_address.religo" in + ok () + let implicit_account () : unit result = let%bind _ = type_file "./contracts/implicit_account.ligo" in ok () @@ -1280,6 +1656,15 @@ let implicit_account_mligo () : unit result = let%bind _ = mtype_file "./contracts/implicit_account.mligo" in ok () + +let implicit_account_religo () : unit result = + let%bind _ = retype_file "./contracts/implicit_account.religo" in + ok () + +let tuples_sequences_functions_religo () : unit result = + let%bind _ = retype_file "./contracts/tuples_sequences_functions.religo" in + ok () + let is_nat () : unit result = let%bind program = type_file "./contracts/isnat.ligo" in let%bind () = @@ -1306,6 +1691,20 @@ let is_nat_mligo () : unit result = expect_eq program "main" input expected in ok () +let is_nat_religo () : unit result = + let%bind program = retype_file "./contracts/isnat.religo" in + let%bind () = + let input = e_int 10 in + let expected = e_some (e_nat 10) in + expect_eq program "main" input expected + in + let%bind () = + let input = e_int (-10) in + let expected = e_none () in + expect_eq program "main" input expected + in ok () + + let simple_access_ligo () : unit result = let%bind program = type_file "./contracts/simple_access.ligo" in let make_input = e_tuple [e_int 0; e_int 1] in @@ -1370,46 +1769,63 @@ let main = test_suite "Integration (End to End)" [ test "various applications" application ; test "closure" closure ; test "closure (mligo)" closure_mligo ; + test "closure (religo)" closure_religo ; test "shared function" shared_function ; test "shared function (mligo)" shared_function_mligo ; + test "shared function (religo)" shared_function_religo ; test "higher order" higher_order ; test "higher order (mligo)" higher_order_mligo ; + test "higher order (religo)" higher_order_religo ; test "variant" variant ; test "variant (mligo)" variant_mligo ; + test "variant (religo)" variant_religo ; test "variant matching" variant_matching ; test "tuple" tuple ; test "tuple (mligo)" tuple_mligo ; + test "tuple (religo)" tuple_religo ; test "record" record ; test "condition simple" condition_simple ; test "condition (ligo)" condition ; test "condition (mligo)" condition_mligo ; + test "condition (religo)" condition_religo ; test "shadow" shadow ; test "annotation" annotation ; test "multiple parameters" multiple_parameters ; test "multiple parameters (mligo)" multiple_parameters_mligo ; + test "multiple parameters (religo)" multiple_parameters_religo ; test "bool" bool_expression ; test "bool (mligo)" bool_expression_mligo ; + test "bool (religo)" bool_expression_religo ; test "arithmetic" arithmetic ; test "arithmetic (mligo)" arithmetic_mligo ; + test "arithmetic (religo)" arithmetic_religo ; test "bitwise_arithmetic" bitwise_arithmetic ; test "bitwise_arithmetic (mligo)" bitwise_arithmetic_mligo; + test "bitwise_arithmetic (religo)" bitwise_arithmetic_religo; test "string_arithmetic" string_arithmetic ; test "string_arithmetic (mligo)" string_arithmetic_mligo ; + test "string_arithmetic (religo)" string_arithmetic_religo ; test "bytes_arithmetic" bytes_arithmetic ; test "bytes_arithmetic (mligo)" bytes_arithmetic_mligo ; + test "bytes_arithmetic (religo)" bytes_arithmetic_religo ; test "set_arithmetic" set_arithmetic ; test "set_arithmetic (mligo)" set_arithmetic_mligo ; + test "set_arithmetic (religo)" set_arithmetic_religo ; test "unit" unit_expression ; test "string" string_expression ; test "option" option ; test "option (mligo)" moption ; + test "option (religo)" reoption ; test "map" map ; test "map (mligo)" mmap ; + test "map (religo)" remap ; test "big_map" big_map ; test "big_map (mligo)" mbig_map ; + test "big_map (religo)" rebig_map ; test "list" list ; test "loop" loop ; test "loop (mligo)" loop_mligo ; + test "loop (religo)" loop_religo ; test "matching" matching ; test "declarations" declarations ; test "quote declaration" quote_declaration ; @@ -1420,21 +1836,30 @@ let main = test_suite "Integration (End to End)" [ test "super counter contract" super_counter_contract_mligo ; test "dispatch counter contract" dispatch_counter_contract ; test "basic (mligo)" basic_mligo ; + test "basic (religo)" basic_religo ; test "counter contract (mligo)" counter_mligo ; + test "counter contract (religo)" counter_religo ; test "let-in (mligo)" let_in_mligo ; + test "let-in (religo)" let_in_religo ; test "match variant (mligo)" match_variant ; + test "match variant (religo)" match_variant_re ; test "match variant 2 (mligo)" match_matej ; + test "match variant 2 (religo)" match_matej_re ; + (* test "list matching (mligo)" mligo_list ; *) test "list matching (mligo)" mligo_list ; + test "list matching (religo)" religo_list ; (* test "guess the hash mligo" guess_the_hash_mligo ; WIP? *) test "failwith ligo" failwith_ligo ; test "failwith mligo" failwith_mligo ; test "assert mligo" assert_mligo ; (* test "guess string mligo" guess_string_mligo ; WIP? *) test "lambda mligo" lambda_mligo ; + test "lambda religo" lambda_religo ; test "lambda ligo" lambda_ligo ; test "tez (ligo)" tez_ligo ; test "tez (mligo)" tez_mligo ; test "lambda2 mligo" lambda2_mligo ; + test "lambda2 religo" lambda2_religo ; (* test "fibo (mligo)" fibo_mligo ; *) (* test "fibo2 (mligo)" fibo2_mligo ; *) (* test "fibo3 (mligo)" fibo3_mligo ; *) @@ -1442,17 +1867,25 @@ let main = test_suite "Integration (End to End)" [ test "website1 ligo" website1_ligo ; test "website2 ligo" website2_ligo ; test "website2 (mligo)" website2_mligo ; + test "website2 (religo)" website2_religo ; test "let multiple (mligo)" mligo_let_multiple ; + test "let multiple (religo)" religo_let_multiple ; test "balance constant" balance_constant ; test "balance constant (mligo)" balance_constant_mligo ; + test "balance constant (religo)" balance_constant_religo ; test "address" address ; - test "address_mligo" address_mligo ; + test "address (mligo)" address_mligo ; + test "address (religo)" address_religo ; test "self address" self_address ; test "self address (mligo)" self_address_mligo ; + test "self address (religo)" self_address_religo ; test "implicit account" implicit_account ; test "implicit account (mligo)" implicit_account_mligo ; + test "implicit account (religo)" implicit_account_religo ; test "is_nat" is_nat ; - test "is_not (mligo)" is_nat_mligo ; + test "is_nat (mligo)" is_nat_mligo ; + test "is_nat (religo)" is_nat_religo ; + test "tuples_sequences_functions (religo)" tuples_sequences_functions_religo ; test "simple_access (ligo)" simple_access_ligo; test "deep_access (ligo)" deep_access_ligo; test "entrypoints (ligo)" entrypoints_ligo ; diff --git a/vendors/ligo-utils/simple-utils/pos.ml b/vendors/ligo-utils/simple-utils/pos.ml index dea23140a..d489da57f 100644 --- a/vendors/ligo-utils/simple-utils/pos.ml +++ b/vendors/ligo-utils/simple-utils/pos.ml @@ -126,13 +126,7 @@ let from_byte byte = let ghost = make ~byte:Lexing.dummy_pos ~point_num:(-1) ~point_bol:(-1) -let min = - let byte = Lexing.{ - pos_fname = ""; - pos_lnum = 1; - pos_bol = 0; - pos_cnum = 0} - in make ~byte ~point_num:0 ~point_bol:0 +let min = make ~byte:Lexing.dummy_pos ~point_num:0 ~point_bol:0 (* Comparisons *)