diff --git a/gitlab-pages/docs/advanced/entrypoints-contracts.md b/gitlab-pages/docs/advanced/entrypoints-contracts.md index 273537c77..eeb4fc0ae 100644 --- a/gitlab-pages/docs/advanced/entrypoints-contracts.md +++ b/gitlab-pages/docs/advanced/entrypoints-contracts.md @@ -12,6 +12,17 @@ Each LIGO smart contract is essentially a single function, that has the followin ``` (const parameter: my_type, const store: my_store_type): (list(operation), my_store_type) ``` + + +``` +(parameter, store: my_type * my_store_type) : operation list * my_store_type +``` + + +``` +(parameter_store: (my_type, my_store_type)) : (list(operation), my_store_type) +``` + This means that every smart contract needs at least one entrypoint function, here's an example: @@ -26,6 +37,25 @@ type store is unit; function main(const parameter: parameter; const store: store): (list(operation) * store) is block { skip } with ((nil : list(operation)), store) ``` + + +```cameligo group=a +type parameter = unit +type store = unit +let main (parameter, store: parameter * store) : operation list * store = + (([]: operation list), store) +``` + + +```reasonligo group=a +type parameter = unit; +type store = unit; +let main = (parameter_store: (parameter, store)) : (list(operation), store) => { + let parameter, store = parameter_store; + (([]: list(operation)), store); +}; +``` + Each entrypoint function receives two arguments: @@ -52,9 +82,30 @@ function main (const p : unit ; const s : unit) : (list(operation) * unit) is if amount > 0mutez then failwith("This contract does not accept tez") else skip } with ((nil : list(operation)), unit); ``` + + +```cameligo group=b +let main (p, s: unit * unit) : operation list * unit = + if amount > 0mutez + then (failwith "This contract does not accept tez": operation list * unit) + else (([]: operation list), unit) +``` + + +```reasonligo group=b +let main = (p_s: (unit, unit)) : (list(operation), unit) => { + if (amount > 0mutez) { + (failwith("This contract does not accept tez"): (list(operation), unit)); + } + else { + (([]: list(operation)), ()); + }; +}; +``` + -### Access control locking +### Access Control This example shows how `sender` or `source` can be used to deny access to an entrypoint. @@ -67,6 +118,28 @@ function main (const p : unit ; const s : unit) : (list(operation) * unit) is if source =/= owner then failwith("This address can't call the contract") else skip } with ((nil : list(operation)), unit); ``` + + +```cameligo group=c +let owner: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) +let main (p,s: unit * unit) : operation list * unit = + if source <> owner + then (failwith "This address can't call the contract": operation list * unit) + else (([]: operation list), ()) +``` + + +```reasonligo group=c +let owner: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address); +let main = (p_s: (unit, unit)) : (list(operation), unit) => { + if (source != owner) { + (failwith("This address can't call the contract"): (list(operation), unit)); + } + else { + (([]: list(operation)), ()); + }; +}; +``` ### Cross contract calls diff --git a/gitlab-pages/docs/advanced/first-contract.md b/gitlab-pages/docs/advanced/first-contract.md index 4932cd5f5..19861291f 100644 --- a/gitlab-pages/docs/advanced/first-contract.md +++ b/gitlab-pages/docs/advanced/first-contract.md @@ -49,6 +49,39 @@ function main (const p : action ; const s : int) : (list(operation) * int) is | Decrement (n) -> s - n end) ``` + + +```cameligo +type action = +| Increment of int +| Decrement of int + +let main (p, s: action * int) : operation list * int = + let result = + match p with + | Increment n -> s + n + | Decrement n -> s - n + in + (([]: operation list), result) +``` + + +```reasonligo +type action = +| Increment(int) +| Decrement(int); + +let main = (p_s: (action, int)) : (list(operation), int) => { + let p, s = p_s; + let result = + switch (p) { + | Increment(n) => s + n + | Decrement(n) => s - n + }; + (([]: list(operation)), result); +}; +``` + To dry-run the counter contract, we will use the `main` entrypoint, provide a variant parameter of `Increment(5)` and an initial storage value of `5`. @@ -149,4 +182,4 @@ ligo compile-parameter src/counter.ligo main 'Increment(5)' -Now we can use `(Right 5)` which is a Michelson value, to invoke our contract - e.g. via `tezos-client` \ No newline at end of file +Now we can use `(Right 5)` which is a Michelson value, to invoke our contract - e.g. via `tezos-client` diff --git a/gitlab-pages/docs/advanced/timestamps-addresses.md b/gitlab-pages/docs/advanced/timestamps-addresses.md index bbd17e2c2..e77ba76ee 100644 --- a/gitlab-pages/docs/advanced/timestamps-addresses.md +++ b/gitlab-pages/docs/advanced/timestamps-addresses.md @@ -17,6 +17,17 @@ You can obtain the current time using the built-in syntax specific expression, p ```pascaligo group=a const today: timestamp = now; ``` + + +```cameligo group=a +let today: timestamp = Current.time +``` + + +```reasonligo group=a +let today: timestamp = Current.time; +``` + > When running code with ligo CLI, the option `--predecessor-timestamp` allows you to control what `now` returns. @@ -35,6 +46,25 @@ const in_24_hrs: timestamp = today + one_day; const some_date: timestamp = ("2000-01-01T10:10:10Z" : timestamp); const one_day_later: timestamp = some_date + one_day; ``` + + +```cameligo group=b +let today: timestamp = Current.time +let one_day: int = 86400 +let in_24_hrs: timestamp = today + one_day +let some_date: timestamp = ("2000-01-01t10:10:10Z" : timestamp) +let one_day_later: timestamp = some_date + one_day +``` + + +```reasonligo group=b +let today: timestamp = Current.time; +let one_day: int = 86400; +let in_24_hrs: timestamp = today + one_day; +let some_date: timestamp = ("2000-01-01t10:10:10Z" : timestamp); +let one_day_later: timestamp = some_date + one_day; +``` + #### 24 hours ago @@ -45,6 +75,21 @@ const today: timestamp = now; const one_day: int = 86400; const in_24_hrs: timestamp = today - one_day; ``` + + +```cameligo group=c +let today: timestamp = Current.time +let one_day: int = 86400 +let in_24_hrs: timestamp = today - one_day +``` + + +```reasonligo group=c +let today: timestamp = Current.time; +let one_day: int = 86400; +let in_24_hrs: timestamp = today - one_day; +``` + ### Comparing timestamps @@ -56,6 +101,17 @@ You can also compare timestamps using the same comparison operators as for numbe ```pascaligo group=c const not_tommorow: bool = (now = in_24_hrs) ``` + + +```cameligo group=c +let not_tomorrow: bool = (Current.time = in_24_hrs) +``` + + +```reasonligo group=c +let not_tomorrow: bool = (Current.time == in_24_hrs); +``` + ## Addresses @@ -69,6 +125,17 @@ Here's how you can define an address: ```pascaligo group=d const my_account: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address); ``` + + +```cameligo group=d +let my_account: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) +``` + + +```reasonligo group=d +let my_account: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address); +``` + ## Signatures @@ -111,4 +178,4 @@ let my_key: key = ("edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav": key ```reasonligo group=f let my_key: key = ("edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav": key); ``` - \ No newline at end of file + diff --git a/gitlab-pages/docs/intro/what-and-why.md b/gitlab-pages/docs/intro/what-and-why.md index 444822720..4cddae9a7 100644 --- a/gitlab-pages/docs/intro/what-and-why.md +++ b/gitlab-pages/docs/intro/what-and-why.md @@ -82,6 +82,42 @@ function main (const p : action ; const s : int) : (list(operation) * int) is | Reset(n) -> 0 end) ``` + + +```cameligo +type action = +| Increment of int +| Decrement of int +| Reset of unit + +let main (p, s: action * int) : operation list * int = + let result = + match p with + | Increment n -> s + n + | Decrement n -> s - n + | Reset n -> 0 + in + (([]: operation list), result) +``` + + +```reasonligo +type action = +| Increment(int) +| Decrement(int) +| Reset(unit); + +let main = (p_s: (action, int)) : (list(operation), int) => { + let p, s = p_s; + let result = + switch (p) { + | Increment(n) => s + n + | Decrement(n) => s - n + | Reset n => 0 + }; + (([]: list(operation)), result); +}; +``` @@ -112,4 +148,4 @@ In certain cases it makes sense to be able to run/evaluate the given snippet or ```shell ligo evaluate-value -s pascaligo gitlab-pages/docs/language-basics/src/variables-and-constants/const.ligo age # Outputs: 25 -``` \ No newline at end of file +``` diff --git a/gitlab-pages/docs/language-basics/functions.md b/gitlab-pages/docs/language-basics/functions.md index 8bd30ee3b..6b5739205 100644 --- a/gitlab-pages/docs/language-basics/functions.md +++ b/gitlab-pages/docs/language-basics/functions.md @@ -107,15 +107,6 @@ value. - - -```pascaligo group=b -const increment : (int -> int) = (function (const i : int) : int is i + 1); -// a = 2 -const a: int = increment(1); -``` - - ## Anonymous functions Functions without a name, also known as anonymous functions are useful in cases when you want to pass the function as an argument or assign it to a key in a record/map. diff --git a/gitlab-pages/docs/language-basics/sets-lists-touples.md b/gitlab-pages/docs/language-basics/sets-lists-tuples.md similarity index 99% rename from gitlab-pages/docs/language-basics/sets-lists-touples.md rename to gitlab-pages/docs/language-basics/sets-lists-tuples.md index 321470da7..65cb1343e 100644 --- a/gitlab-pages/docs/language-basics/sets-lists-touples.md +++ b/gitlab-pages/docs/language-basics/sets-lists-tuples.md @@ -1,5 +1,5 @@ --- -id: sets-lists-touples +id: sets-lists-tuples title: Sets, Lists, Tuples --- diff --git a/gitlab-pages/docs/language-basics/tezos-specific.md b/gitlab-pages/docs/language-basics/tezos-specific.md new file mode 100644 index 000000000..2e40d786a --- /dev/null +++ b/gitlab-pages/docs/language-basics/tezos-specific.md @@ -0,0 +1,146 @@ +--- +id: tezos-specific +title: Tezos Domain-Specific Operations +--- + +LIGO is a language for writing Tezos smart contracts. It would be a little odd if +it didn't have any Tezos specific functions. This page will tell you about them. + +## Pack and Unpack + +Michelson provides the `PACK` and `UNPACK` instructions for data serialization. +`PACK` converts Michelson data structures to a binary format, and `UNPACK` +reverses it. This functionality can be accessed from within LIGO. + +> ⚠️ `PACK` and `UNPACK` are features of Michelson that are intended to be used by people that really know what they're doing. There are several failure cases (such as `UNPACK`ing a lambda from an untrusted source), most of which are beyond the scope of this document. Don't use these functions without doing your homework first. + + + + +```pascaligo +function id_string (const p : string) : option(string) is block { + const packed : bytes = bytes_pack(p) ; +} with (bytes_unpack(packed): option(string)) +``` + + +```cameligo +let id_string (p: string) : string option = + let packed: bytes = Bytes.pack p in + ((Bytes.unpack packed): string option) +``` + + +```reasonligo +let id_string = (p: string) : option(string) => { + let packed : bytes = Bytes.pack(p); + ((Bytes.unpack(packed)): option(string)); +}; +``` + + + +## Hashing Keys + +It's often desirable to hash a public key. In Michelson, certain data structures +such as maps will not allow the use of the `key` type. Even if this weren't the case +hashes are much smaller than keys, and storage on blockchains comes at a cost premium. +You can hash keys with the `key_hash` type and associated built in function. + + + + +```pascaligo +function check_hash_key (const kh1 : key_hash; const k2 : key) : bool * key_hash is block { + var ret : bool := False ; + var kh2 : key_hash := crypto_hash_key(k2) ; + if kh1 = kh2 then ret := True else skip; +} with (ret, kh2) +``` + + +```cameligo +let check_hash_key (kh1, k2: key_hash * key) : bool * key_hash = + let kh2 : key_hash = Crypto.hash_key k2 in + if kh1 = kh2 + then (true, kh2) + else (false, kh2) +``` + + +```reasonligo +let check_hash_key = (kh1_k2: (key_hash, key)) : (bool, key_hash) => { + let kh1, k2 = kh1_k2; + let kh2 : key_hash = Crypto.hash_key(k2); + if (kh1 == kh2) { + (true, kh2); + } + else { + (false, kh2); + } +}; +``` + + + +## Checking Signatures + +Sometimes a contract will want to check that a message has been signed by a +particular key. For example, a point-of-sale system might want a customer to +sign a transaction so it can be processed asynchronously. You can do this in LIGO +using the `key` and `signature` types. + +> ⚠️ There is no way to *generate* a signed message in LIGO. This is because that would require storing a private key on chain, at which point it isn't very private anymore. + + + + +```pascaligo +function check_signature + (const pk: key; + const signed: signature; + const msg: bytes) : bool + is crypto_check(pk, signed, msg) +``` + + +```cameligo +let check_signature (pk, signed, msg: key * signature * bytes) : bool = + Crypto.check pk signed msg +``` + + +```reasonligo +let check_signature = (param: (key, signature, bytes)) : bool => { + let pk, signed, msg = param; + Crypto.check(pk, signed, msg); +}; +``` + + + +## Getting The Contract's Own Address + +Often you want to get the address of the contract being executed. You can do it with +`self_address`. + +> ⚠️ Due to limitations in Michelson, self_address in a contract is only allowed at the entry-point level. Using it in a utility function will cause an error. + + + + +```pascaligo +const current_addr : address = self_address; +``` + + +```cameligo +let current_addr : address = Current.self_address +``` + + +```reasonligo +let current_addr : address = Current.self_address; +``` + + diff --git a/gitlab-pages/website/core/CodeExamples.js b/gitlab-pages/website/core/CodeExamples.js index 0b636c356..1180aa9c5 100644 --- a/gitlab-pages/website/core/CodeExamples.js +++ b/gitlab-pages/website/core/CodeExamples.js @@ -24,51 +24,51 @@ ${pre}`; const CAMELIGO_EXAMPLE = `${pre}ocaml type storage = int -(* variant defining pseudo multi-entrypoint - actions *) +(* variant defining pseudo multi-entrypoint actions *) + type action = - | Increment of int - | Decrement of int +| Increment of int +| Decrement of int -let add (a: int) (b: int): int = a + b +let add (a: int) (b: int) : int = a + b +let sub (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 *) -(* real entrypoint that re-routes the flow - based on the action provided *) -let%entry main(p : action) storage = - let storage = - match p with - | Increment n -> add storage n - | Decrement n -> subtract storage n - in (([] : operation list), storage) +let main (p,s: action * storage) = + let storage = + match p with + | Increment n -> add s n + | Decrement n -> sub s n + in ([] : operation list), storage ${pre}`; const REASONLIGO_EXAMPLE = `${pre}reasonligo type storage = int; -/* variant defining pseudo multi-entrypoint - actions */ +/* 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; -let subtract = (a: int, b: int): int => a - b; +/* real entrypoint that re-routes the flow based on the action provided */ -/* real entrypoint that re-routes the flow - based on the action provided */ -let main = (p: action, storage) => { +let main2 = (p: action, storage) => { let storage = switch (p) { | Increment(n) => add(storage, n) - | Decrement(n) => subtract(storage, n) + | Decrement(n) => sub(storage, n) }; ([]: list(operation), storage); }; +let main = (x: (action, storage)) => main2(x[0],x[1]); + ${pre}`; diff --git a/gitlab-pages/website/sidebars.json b/gitlab-pages/website/sidebars.json index 00fe28d25..717fa03ec 100644 --- a/gitlab-pages/website/sidebars.json +++ b/gitlab-pages/website/sidebars.json @@ -11,7 +11,8 @@ "language-basics/loops", "language-basics/unit-option-pattern-matching", "language-basics/maps-records", - "language-basics/sets-lists-touples" + "language-basics/sets-lists-tuples", + "language-basics/tezos-specific" ], "Advanced": [ "advanced/timestamps-addresses", diff --git a/src/bin/cli.ml b/src/bin/cli.ml index d8be0d864..edb571cd0 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -138,6 +138,57 @@ let compile_file = let doc = "Subcommand: compile a contract." in (Term.ret term , Term.info ~doc cmdname) +let print_cst = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind pp = Compile.Of_source.pretty_print source_file (Syntax_name syntax) in + ok @@ Format.asprintf "%s \n" (Buffer.contents pp) + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-cst" in + let doc = "Subcommand: print the cst. Warning: intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + +let print_ast = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + ok @@ Format.asprintf "%a\n" Compile.Of_simplified.pretty_print simplified + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-ast" in + let doc = "Subcommand: print the ast. Warning: intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + +let print_typed_ast = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed,_ = Compile.Of_simplified.compile simplified in + ok @@ Format.asprintf "%a\n" Compile.Of_typed.pretty_print typed + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-typed-ast" in + let doc = "Subcommand: print the typed ast. Warning: intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + +let print_mini_c = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind mini_c = Compile.Of_typed.compile typed in + ok @@ Format.asprintf "%a\n" Compile.Of_mini_c.pretty_print mini_c + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-mini-c" in + let doc = "Subcommand: print mini c. Warning: intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + let measure_contract = let f source_file entry_point syntax display_format = toplevel ~display_format @@ @@ -371,4 +422,8 @@ let run ?argv () = run_function ; evaluate_value ; dump_changelog ; + print_cst ; + print_ast ; + print_typed_ast ; + print_mini_c ] diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index cc22a7410..443102d80 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -2,6 +2,8 @@ open Cli_expect let contract basename = "../../test/contracts/" ^ basename +let bad_contract basename = + "../../test/contracts/negative/" ^ basename let%expect_test _ = run_ligo_good [ "measure-contract" ; contract "coase.ligo" ; "main" ] ; @@ -1024,3 +1026,15 @@ let%expect_test _ = [%expect {| failwith("This contract always fails") |}] +let%expect_test _ = + run_ligo_bad [ "compile-contract" ; bad_contract "self_in_lambda.mligo" ; "main" ] ; + [%expect {| + ligo: Wrong SELF_ADDRESS location: SELF_ADDRESS is only allowed at top-level + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}] \ No newline at end of file diff --git a/src/bin/expect_tests/help_tests.ml b/src/bin/expect_tests/help_tests.ml index b42ac2c8b..b385abd14 100644 --- a/src/bin/expect_tests/help_tests.ml +++ b/src/bin/expect_tests/help_tests.ml @@ -47,6 +47,22 @@ let%expect_test _ = measure-contract Subcommand: measure a contract's compiled size in bytes. + print-ast + Subcommand: print the ast. Warning: intended for development of + LIGO and can break at any time. + + print-cst + Subcommand: print the cst. Warning: intended for development of + LIGO and can break at any time. + + print-mini-c + Subcommand: print mini c. Warning: intended for development of + LIGO and can break at any time. + + print-typed-ast + Subcommand: print the typed ast. Warning: intended for development + of LIGO and can break at any time. + run-function Subcommand: run a function with the given parameter. @@ -104,6 +120,22 @@ let%expect_test _ = measure-contract Subcommand: measure a contract's compiled size in bytes. + print-ast + Subcommand: print the ast. Warning: intended for development of + LIGO and can break at any time. + + print-cst + Subcommand: print the cst. Warning: intended for development of + LIGO and can break at any time. + + print-mini-c + Subcommand: print mini c. Warning: intended for development of + LIGO and can break at any time. + + print-typed-ast + Subcommand: print the typed ast. Warning: intended for development + of LIGO and can break at any time. + run-function Subcommand: run a function with the given parameter. diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 479b4cd33..317b92736 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -133,3 +133,41 @@ let parsify_string = fun (syntax : v_syntax) source_filename -> let%bind parsified = parsify source_filename in let%bind applied = Self_ast_simplified.all_program parsified in ok applied + +let pretty_print_pascaligo = fun source -> + let%bind ast = Parser.Pascaligo.parse_file source in + let buffer = Buffer.create 59 in + let state = Parser.Pascaligo.ParserLog.mk_state + ~offsets:true + ~mode:`Byte + ~buffer in + Parser.Pascaligo.ParserLog.pp_ast state ast; + ok buffer + +let pretty_print_cameligo = fun source -> + let%bind ast = Parser.Cameligo.parse_file source in + let buffer = Buffer.create 59 in + let state = Parser.Cameligo.ParserLog.mk_state + ~offsets:true + ~mode:`Byte + ~buffer in + Parser.Cameligo.ParserLog.pp_ast state ast; + ok buffer + +let pretty_print_reasonligo = fun source -> + let%bind ast = Parser.Reasonligo.parse_file source in + let buffer = Buffer.create 59 in + let state = Parser.Reasonligo.ParserLog.mk_state + ~offsets:true + ~mode:`Byte + ~buffer in + Parser.Reasonligo.ParserLog.pp_ast state ast; + ok buffer + +let pretty_print = fun syntax source_filename -> + let%bind v_syntax = syntax_to_variant syntax (Some source_filename) in + (match v_syntax with + | Pascaligo -> pretty_print_pascaligo + | Cameligo -> pretty_print_cameligo + | ReasonLIGO -> pretty_print_reasonligo) + source_filename \ No newline at end of file diff --git a/src/main/compile/of_michelson.ml b/src/main/compile/of_michelson.ml index 0b070fb79..87cfbb5a7 100644 --- a/src/main/compile/of_michelson.ml +++ b/src/main/compile/of_michelson.ml @@ -5,10 +5,9 @@ open Trace module Errors = struct (* TODO: those errors should have been caught in the earlier stages on the ligo pipeline - Here, in case of contract not typechecking, we should write a warning with a "please report" - on stderr and print the ill-typed michelson code; + build_contract is a kind of security net *) - let title_type_check_msg () = "Invalid contract (This might be a compiler bug, please report) " + let title_type_check_msg () = "generated Michelson contract failed to typecheck" let bad_parameter c () = let message () = let code = Format.asprintf "%a" Michelson.pp c in @@ -22,7 +21,7 @@ module Errors = struct let bad_contract c () = let message () = let code = Format.asprintf "%a" Michelson.pp c in - "bad contract type (contract entry point is expected to be of the form \"parameter * storage -> list(operation) * storage\"):\n"^code in + "bad contract type\n"^code in error title_type_check_msg message let unknown () = let message () = diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index be27f0f6b..4d99be97a 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -3,6 +3,7 @@ open Proto_alpha_utils open Trace let compile_contract : expression -> Compiler.compiled_expression result = fun e -> + let%bind e = Self_mini_c.contract_check e in let%bind (input_ty , _) = get_t_function e.type_value in let%bind body = get_function e in let%bind body = Compiler.Program.translate_function_body body [] input_ty in @@ -32,3 +33,6 @@ let aggregate_and_compile_contract = fun (program : Types.program) name -> let aggregate_and_compile_expression = fun program exp -> aggregate_and_compile program (ExpressionForm exp) + +let pretty_print program = + Mini_c.PP.program program \ No newline at end of file diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 59df4d647..072243a9c 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -18,3 +18,6 @@ let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simpl { expression = Ast_simplified.E_application (entry_point_var, param) ; location = Virtual "generated application" } in ok applied + +let pretty_print formatter (program : Ast_simplified.program) = + Ast_simplified.PP.program formatter program \ No newline at end of file diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index 0c43d7d45..3a075ac9e 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -18,3 +18,6 @@ let compile_contract_input : string -> string -> v_syntax -> Ast_simplified.expr fun storage parameter syntax -> let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in ok @@ Ast_simplified.e_pair storage parameter + +let pretty_print source_filename syntax = + Helpers.pretty_print syntax source_filename \ No newline at end of file diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index 0aa705405..a69f32c9d 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -21,4 +21,7 @@ let assert_equal_contract_type : check_type -> string -> Ast_typed.program -> As ) | _ -> dummy_fail ) - | _ -> dummy_fail ) \ No newline at end of file + | _ -> dummy_fail ) + +let pretty_print ppf program = + Ast_typed.PP.program ppf program \ No newline at end of file diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index 9bfb5e76a..12f2e7f42 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -439,8 +439,22 @@ fun_expr: {p.value with inside = arg_to_pattern p.value.inside} in PPar {p with value} | EUnit u -> PUnit u - | e -> let open! SyntaxError - in raise (Error (WrongFunctionArguments e)) + | ETuple { value; region } -> + PTuple { value = Utils.nsepseq_map arg_to_pattern value; region} + | EAnnot {region; value = {inside = t, colon, typ; _}} -> + let value = { pattern = arg_to_pattern t; colon; type_expr = typ} in + PPar { + value = { + lpar = Region.ghost; + rpar = Region.ghost; + inside = PTyped {region; value} + }; + region + } + | e -> ( + let open! SyntaxError in + raise (Error (WrongFunctionArguments e)) + ) in let fun_args_to_pattern = function EAnnot { diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index fb16694fb..917d001bf 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -36,7 +36,7 @@ module Errors = struct ] in error ~data title message - let unsuppported_let_in_function (patterns : Raw.pattern list) = + let unsupported_let_in_function (patterns : Raw.pattern list) = let title () = "unsupported 'let ... in' function" in let message () = "defining functions via 'let ... in' is not supported yet" in let patterns_loc = @@ -179,6 +179,10 @@ let rec tuple_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern -> | Raw.PVar _ -> bind_list [pattern_to_typed_var pattern] | other -> (fail @@ wrong_pattern "parenthetical, tuple, or variable" other) +let rec unpar_pattern : Raw.pattern -> Raw.pattern = function + | PPar p -> unpar_pattern p.value.inside + | _ as p -> p + let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> trace (simple_info "simplifying this type expression...") @@ match te with @@ -354,7 +358,7 @@ let rec simpl_expression : (* let f p1 ps... = rhs in body *) | (f, p1 :: ps) -> - fail @@ unsuppported_let_in_function (f :: p1 :: ps) + fail @@ unsupported_let_in_function (f :: p1 :: ps) end | Raw.EAnnot a -> let Raw.{inside=expr, _, type_expr; _}, loc = r_split a in @@ -541,7 +545,8 @@ and simpl_fun lamb' : expr result = (match pt with | Raw.PTyped pt -> begin - match pt.value.pattern with + let pt_pattern = unpar_pattern pt.value.pattern in + match pt_pattern with | Raw.PVar _ -> params | Raw.PTuple _ -> [Raw.PTyped @@ -581,10 +586,10 @@ and simpl_fun lamb' : expr result = match destruct with (* Handle tuple parameter destructuring *) (* In this section we create a let ... in that binds the original parameters *) | Raw.PPar pp -> - (match pp.value.inside with + (match unpar_pattern pp.value.inside with | Raw.PTyped pt -> let vars = pt.value in - (match vars.pattern with + (match unpar_pattern vars.pattern with | PTuple vars -> let let_in_binding: Raw.let_binding = {binders = (PTuple vars, []) ; diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml index a1ce4b580..f0ecd5183 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -6,14 +6,6 @@ let all = [ Literals.peephole_expression ; ] -let rec bind_chain : ('a -> 'a result) list -> 'a -> 'a result = fun fs x -> - match fs with - | [] -> ok x - | hd :: tl -> ( - let aux : 'a -> 'a result = fun x -> bind (bind_chain tl) (hd x) in - bind aux (ok x) - ) - let all_program = let all_p = List.map Helpers.map_program all in bind_chain all_p diff --git a/src/passes/4-typer-new/solver.ml b/src/passes/4-typer-new/solver.ml index e5f12b144..2adac9659 100644 --- a/src/passes/4-typer-new/solver.ml +++ b/src/passes/4-typer-new/solver.ml @@ -729,94 +729,98 @@ let compare_simple_c_constant = function | C_arrow -> (function (* N/A -> 1 *) | C_arrow -> 0 - | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_option -> (function | C_arrow -> 1 | C_option -> 0 - | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_tuple -> (function | C_arrow | C_option -> 1 | C_tuple -> 0 - | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_record -> (function | C_arrow | C_option | C_tuple -> 1 | C_record -> 0 - | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_variant -> (function | C_arrow | C_option | C_tuple | C_record -> 1 | C_variant -> 0 - | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_map -> (function | C_arrow | C_option | C_tuple | C_record | C_variant -> 1 | C_map -> 0 - | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_big_map -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map -> 1 | C_big_map -> 0 - | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_list -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map -> 1 | C_list -> 0 - | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_set -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list -> 1 | C_set -> 0 - | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_unit -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set -> 1 | C_unit -> 0 - | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_bool -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit -> 1 | C_bool -> 0 - | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_string -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool -> 1 | C_string -> 0 - | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_nat -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string -> 1 | C_nat -> 0 - | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_mutez -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat -> 1 | C_mutez -> 0 - | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_timestamp -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez -> 1 | C_timestamp -> 0 - | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_int -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp -> 1 | C_int -> 0 - | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_address -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int -> 1 | C_address -> 0 - | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_bytes -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address -> 1 | C_bytes -> 0 - | C_key_hash | C_key | C_signature | C_operation | C_contract -> -1) + | C_key_hash | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_key_hash -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes -> 1 | C_key_hash -> 0 - | C_key | C_signature | C_operation | C_contract -> -1) + | C_key | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_key -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash -> 1 | C_key -> 0 - | C_signature | C_operation | C_contract -> -1) + | C_signature | C_operation | C_contract | C_chain_id -> -1) | C_signature -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key -> 1 | C_signature -> 0 - | C_operation | C_contract -> -1) + | C_operation | C_contract | C_chain_id -> -1) | C_operation -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature -> 1 | C_operation -> 0 - | C_contract -> -1) + | C_contract | C_chain_id -> -1) | C_contract -> (function | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation -> 1 | C_contract -> 0 + | C_chain_id -> -1) + | C_chain_id -> (function + | C_arrow | C_option | C_tuple | C_record | C_variant | C_map | C_big_map | C_list | C_set | C_unit | C_bool | C_string | C_nat | C_mutez | C_timestamp | C_int | C_address | C_bytes | C_key_hash | C_key | C_signature | C_operation | C_contract -> 1 + | C_chain_id -> 0 (* N/A -> -1 *) ) let rec compare_typeclass a b = compare_list (compare_list compare_type_value) a b diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index 5d1d68465..537a4c485 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/4-typer-new/typer.ml @@ -956,12 +956,41 @@ let type_program_returns_state (p:I.program) : (environment * Solver.state * O.p (* module TSMap = TMap(Solver.TypeVariable) *) +(* let c_tag_to_string : Solver.Core.constant_tag -> string = function + * | Solver.Core.C_arrow -> "arrow" + * | Solver.Core.C_option -> "option" + * | Solver.Core.C_tuple -> "tuple" + * | Solver.Core.C_record -> failwith "record" + * | Solver.Core.C_variant -> failwith "variant" + * | Solver.Core.C_map -> "map" + * | Solver.Core.C_big_map -> "big" + * | Solver.Core.C_list -> "list" + * | Solver.Core.C_set -> "set" + * | Solver.Core.C_unit -> "unit" + * | Solver.Core.C_bool -> "bool" + * | Solver.Core.C_string -> "string" + * | Solver.Core.C_nat -> "nat" + * | Solver.Core.C_mutez -> "mutez" + * | Solver.Core.C_timestamp -> "timestamp" + * | Solver.Core.C_int -> "int" + * | Solver.Core.C_address -> "address" + * | Solver.Core.C_bytes -> "bytes" + * | Solver.Core.C_key_hash -> "key_hash" + * | Solver.Core.C_key -> "key" + * | Solver.Core.C_signature -> "signature" + * | Solver.Core.C_operation -> "operation" + * | Solver.Core.C_contract -> "contract" + * | Solver.Core.C_chain_id -> "chain_id" *) + let type_program (p : I.program) : (O.program * Solver.state) result = let%bind (env, state, program) = type_program_returns_state p in let subst_all = let assignments = state.structured_dbs.assignments in let aux (v : I.type_variable) (expr : Solver.c_constructor_simpl) (p:O.program result) = let%bind p = p in + let Solver.{ tv ; c_tag ; tv_list } = expr in + let () = ignore tv (* I think there is an issue where the tv is stored twice (as a key and in the element itself) *) in + let%bind (expr : O.type_value') = Typesystem.Core.type_expression'_of_simple_c_constant (c_tag , (List.map (fun s -> O.{ type_value' = T_variable s ; simplified = None }) tv_list)) in Typesystem.Misc.Substitution.Pattern.program ~p ~v ~expr in (* let p = TSMap.bind_fold_Map aux program assignments in *) (* TODO: Module magic: this does not work *) let p = Solver.TypeVariableMap.fold aux assignments (ok program) in diff --git a/src/passes/7-self_mini_c/helpers.ml b/src/passes/7-self_mini_c/helpers.ml index ea7756a35..f5638cbe5 100644 --- a/src/passes/7-self_mini_c/helpers.ml +++ b/src/passes/7-self_mini_c/helpers.ml @@ -163,3 +163,11 @@ let rec map_expression : mapper -> expression -> expression result = fun f e -> let%bind updates = bind_map_list (fun (p,e) -> let%bind e = self e in ok(p,e)) updates in return @@ E_update(r,updates) ) + +let map_sub_level_expression : mapper -> expression -> expression result = fun f e -> + match e.content with + | E_closure {binder ; body} -> + let%bind body = map_expression f body in + let content = E_closure {binder; body} in + ok @@ { e with content } + | _ -> ok e \ No newline at end of file diff --git a/src/passes/7-self_mini_c/michelson_restrictions.ml b/src/passes/7-self_mini_c/michelson_restrictions.ml new file mode 100644 index 000000000..7f9e14169 --- /dev/null +++ b/src/passes/7-self_mini_c/michelson_restrictions.ml @@ -0,0 +1,26 @@ +open Mini_c +open Trace + +module Errors = struct + + let bad_self_address cst () = + let title = thunk @@ + Format.asprintf "Wrong %alocation" Mini_c.PP.expression' cst in + let message = thunk @@ + Format.asprintf "%ais only allowed at top-level" Mini_c.PP.expression' cst in + error title message () + +end +open Errors + +let self_in_lambdas : expression -> expression result = + fun e -> + match e.content with + | E_closure {binder=_ ; body} -> + let%bind _self_in_lambdas = Helpers.map_expression + (fun e -> match e.content with + | E_constant (C_SELF_ADDRESS, _) as c -> fail (bad_self_address c) + | _ -> ok e) + body in + ok e + | _ -> ok e diff --git a/src/passes/7-self_mini_c/self_mini_c.ml b/src/passes/7-self_mini_c/self_mini_c.ml index 329dad692..da2c66fa6 100644 --- a/src/passes/7-self_mini_c/self_mini_c.ml +++ b/src/passes/7-self_mini_c/self_mini_c.ml @@ -250,6 +250,11 @@ let betas : bool ref -> expression -> expression = fun changed -> map_expression (beta changed) +let contract_check = + let all = [Michelson_restrictions.self_in_lambdas] in + let all_e = List.map Helpers.map_sub_level_expression all in + bind_chain all_e + let rec all_expression : expression -> expression = fun e -> let changed = ref false in diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index 6ece0d8ab..43d0c8792 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -1,5 +1,6 @@ open Trace open Types +include Stage_common.Misc module Errors = struct let different_kinds a b () = diff --git a/src/stages/common/ast_common.ml b/src/stages/common/ast_common.ml index 302205f4b..b570d3941 100644 --- a/src/stages/common/ast_common.ml +++ b/src/stages/common/ast_common.ml @@ -1,2 +1,3 @@ module Types = Types module PP = PP +module Misc = Misc diff --git a/src/stages/common/misc.ml b/src/stages/common/misc.ml new file mode 100644 index 000000000..7f38acf62 --- /dev/null +++ b/src/stages/common/misc.ml @@ -0,0 +1,85 @@ +open Types +open Trace + +let map_type_operator f = function + TC_contract x -> TC_contract (f x) + | TC_option x -> TC_option (f x) + | TC_list x -> TC_list (f x) + | TC_set x -> TC_set (f x) + | TC_map (x , y) -> TC_map (f x , f y) + | TC_big_map (x , y)-> TC_big_map (f x , f y) + +let bind_map_type_operator f = function + TC_contract x -> let%bind x = f x in ok @@ TC_contract x + | TC_option x -> let%bind x = f x in ok @@ TC_option x + | TC_list x -> let%bind x = f x in ok @@ TC_list x + | TC_set x -> let%bind x = f x in ok @@ TC_set x + | TC_map (x , y) -> let%bind x = f x in let%bind y = f y in ok @@ TC_map (x , y) + | TC_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_big_map (x , y) + +let type_operator_name = function + TC_contract _ -> "TC_contract" + | TC_option _ -> "TC_option" + | TC_list _ -> "TC_list" + | TC_set _ -> "TC_set" + | TC_map _ -> "TC_map" + | TC_big_map _ -> "TC_big_map" + +let type_expression'_of_string = function + | "TC_contract" , [x] -> ok @@ T_operator(TC_contract x) + | "TC_option" , [x] -> ok @@ T_operator(TC_option x) + | "TC_list" , [x] -> ok @@ T_operator(TC_list x) + | "TC_set" , [x] -> ok @@ T_operator(TC_set x) + | "TC_map" , [x ; y] -> ok @@ T_operator(TC_map (x , y)) + | "TC_big_map" , [x ; y] -> ok @@ T_operator(TC_big_map (x, y)) + | ("TC_contract" | "TC_option" | "TC_list" | "TC_set" | "TC_map" | "TC_big_map"), _ -> + failwith "internal error: wrong number of arguments for type operator" + + | "TC_unit" , [] -> ok @@ T_constant(TC_unit) + | "TC_string" , [] -> ok @@ T_constant(TC_string) + | "TC_bytes" , [] -> ok @@ T_constant(TC_bytes) + | "TC_nat" , [] -> ok @@ T_constant(TC_nat) + | "TC_int" , [] -> ok @@ T_constant(TC_int) + | "TC_mutez" , [] -> ok @@ T_constant(TC_mutez) + | "TC_bool" , [] -> ok @@ T_constant(TC_bool) + | "TC_operation" , [] -> ok @@ T_constant(TC_operation) + | "TC_address" , [] -> ok @@ T_constant(TC_address) + | "TC_key" , [] -> ok @@ T_constant(TC_key) + | "TC_key_hash" , [] -> ok @@ T_constant(TC_key_hash) + | "TC_chain_id" , [] -> ok @@ T_constant(TC_chain_id) + | "TC_signature" , [] -> ok @@ T_constant(TC_signature) + | "TC_timestamp" , [] -> ok @@ T_constant(TC_timestamp) + | _, [] -> + failwith "internal error: wrong number of arguments for type constant" + | _ -> + failwith "internal error: unknown type operator" + +let string_of_type_operator = function + | TC_contract x -> "TC_contract" , [x] + | TC_option x -> "TC_option" , [x] + | TC_list x -> "TC_list" , [x] + | TC_set x -> "TC_set" , [x] + | TC_map (x , y) -> "TC_map" , [x ; y] + | TC_big_map (x , y) -> "TC_big_map" , [x ; y] + +let string_of_type_constant = function + | TC_unit -> "TC_unit", [] + | TC_string -> "TC_string", [] + | TC_bytes -> "TC_bytes", [] + | TC_nat -> "TC_nat", [] + | TC_int -> "TC_int", [] + | TC_mutez -> "TC_mutez", [] + | TC_bool -> "TC_bool", [] + | TC_operation -> "TC_operation", [] + | TC_address -> "TC_address", [] + | TC_key -> "TC_key", [] + | TC_key_hash -> "TC_key_hash", [] + | TC_chain_id -> "TC_chain_id", [] + | TC_signature -> "TC_signature", [] + | TC_timestamp -> "TC_timestamp", [] + +let string_of_type_expression' = function + | T_operator o -> string_of_type_operator o + | T_constant c -> string_of_type_constant c + | T_tuple _|T_sum _|T_record _|T_arrow (_, _)|T_variable _ -> + failwith "not a type operator or constant" diff --git a/src/stages/typesystem/core.ml b/src/stages/typesystem/core.ml index 30a3a5fa5..c21888908 100644 --- a/src/stages/typesystem/core.ml +++ b/src/stages/typesystem/core.ml @@ -31,6 +31,7 @@ type constant_tag = | C_signature (* * *) | C_operation (* * *) | C_contract (* * -> * *) + | C_chain_id (* * *) type accessor = | L_int of int @@ -67,3 +68,34 @@ and type_constraint = (* is the first list in case on of the type of the type class as a kind *->*->* ? *) and typeclass = type_value list list + +open Trace +let type_expression'_of_simple_c_constant = function + | C_contract , [x] -> ok @@ T_operator(TC_contract x) + | C_option , [x] -> ok @@ T_operator(TC_option x) + | C_list , [x] -> ok @@ T_operator(TC_list x) + | C_set , [x] -> ok @@ T_operator(TC_set x) + | C_map , [x ; y] -> ok @@ T_operator(TC_map (x , y)) + | C_big_map , [x ; y] -> ok @@ T_operator(TC_big_map (x, y)) + | (C_contract | C_option | C_list | C_set | C_map | C_big_map), _ -> + failwith "internal error: wrong number of arguments for type operator" + + | C_unit , [] -> ok @@ T_constant(TC_unit) + | C_string , [] -> ok @@ T_constant(TC_string) + | C_bytes , [] -> ok @@ T_constant(TC_bytes) + | C_nat , [] -> ok @@ T_constant(TC_nat) + | C_int , [] -> ok @@ T_constant(TC_int) + | C_mutez , [] -> ok @@ T_constant(TC_mutez) + | C_bool , [] -> ok @@ T_constant(TC_bool) + | C_operation , [] -> ok @@ T_constant(TC_operation) + | C_address , [] -> ok @@ T_constant(TC_address) + | C_key , [] -> ok @@ T_constant(TC_key) + | C_key_hash , [] -> ok @@ T_constant(TC_key_hash) + | C_chain_id , [] -> ok @@ T_constant(TC_chain_id) + | C_signature , [] -> ok @@ T_constant(TC_signature) + | C_timestamp , [] -> ok @@ T_constant(TC_timestamp) + | _ , [] -> + failwith "internal error: wrong number of arguments for type constant" + | _ , _ -> + failwith "internal error: unknown type operator" + diff --git a/src/stages/typesystem/misc.ml b/src/stages/typesystem/misc.ml index fdcaae910..b95c603fc 100644 --- a/src/stages/typesystem/misc.ml +++ b/src/stages/typesystem/misc.ml @@ -78,23 +78,37 @@ module Substitution = struct | T.T_constant (type_name) -> let%bind type_name = s_type_name_constant ~v ~expr type_name in ok @@ T.T_constant (type_name) - | T.T_variable _ -> failwith "TODO: T_variable" - | T.T_operator _ -> failwith "TODO: T_operator" + | T.T_variable variable -> + if Var.equal variable v + then ok @@ expr + else ok @@ T.T_variable variable + | T.T_operator (type_name_and_args) -> + let bind_map_type_operator = Stage_common.Misc.bind_map_type_operator in (* TODO: write T.Misc.bind_map_type_operator, but it doesn't work *) + let%bind type_name_and_args = bind_map_type_operator (s_type_value ~v ~expr) type_name_and_args in + ok @@ T.T_operator type_name_and_args | T.T_arrow _ -> let _TODO = (v, expr) in failwith "TODO: T_function" - and s_type_expression ~v ~expr : Ast_simplified.type_expression w = fun {type_expression'} -> + and s_type_expression' ~v ~expr : _ Ast_simplified.type_expression' w = fun type_expression' -> match type_expression' with - | Ast_simplified.T_tuple _ -> failwith "TODO: subst: unimplemented case s_type_expression" - | Ast_simplified.T_sum _ -> failwith "TODO: subst: unimplemented case s_type_expression" - | Ast_simplified.T_record _ -> failwith "TODO: subst: unimplemented case s_type_expression" - | Ast_simplified.T_arrow (_, _) -> failwith "TODO: subst: unimplemented case s_type_expression" - | Ast_simplified.T_variable _ -> failwith "TODO: subst: unimplemented case s_type_expression" - | Ast_simplified.T_operator _ -> failwith "TODO: subst: unimplemented case s_type_expression" - | Ast_simplified.T_constant _ -> - let _TODO = (v, expr) in - failwith "TODO: subst: unimplemented case s_type_expression" + | Ast_simplified.T_tuple _ -> failwith "TODO: subst: unimplemented case s_type_expression tuple" + | Ast_simplified.T_sum _ -> failwith "TODO: subst: unimplemented case s_type_expression sum" + | Ast_simplified.T_record _ -> failwith "TODO: subst: unimplemented case s_type_expression record" + | Ast_simplified.T_arrow (_, _) -> failwith "TODO: subst: unimplemented case s_type_expression arrow" + | Ast_simplified.T_variable _ -> failwith "TODO: subst: unimplemented case s_type_expression variable" + | Ast_simplified.T_operator op -> + let%bind op = + Stage_common.Misc.bind_map_type_operator (* TODO: write Ast_simplified.Misc.type_operator_name *) + (s_type_expression ~v ~expr) + op in + ok @@ Ast_simplified.T_operator op + | Ast_simplified.T_constant constant -> + ok @@ Ast_simplified.T_constant constant + + and s_type_expression ~v ~expr : Ast_simplified.type_expression w = fun {type_expression'} -> + let%bind type_expression' = s_type_expression' ~v ~expr type_expression' in + ok @@ Ast_simplified.{type_expression'} and s_type_value ~v ~expr : T.type_value w = fun { type_value'; simplified } -> let%bind type_value' = s_type_value' ~v ~expr type_value' in diff --git a/src/test/contracts/bytes_unpack.mligo b/src/test/contracts/bytes_unpack.mligo new file mode 100644 index 000000000..e33f09b47 --- /dev/null +++ b/src/test/contracts/bytes_unpack.mligo @@ -0,0 +1,11 @@ +let id_string (p: string) : string option = + let packed: bytes = Bytes.pack p in + ((Bytes.unpack packed): string option) + +let id_int (p: int) : int option = + let packed: bytes = Bytes.pack p in + ((Bytes.unpack packed): int option) + +let id_address (p: address) : address option = + let packed: bytes = Bytes.pack p in + ((Bytes.unpack packed): address option) diff --git a/src/test/contracts/bytes_unpack.religo b/src/test/contracts/bytes_unpack.religo new file mode 100644 index 000000000..86b291ecc --- /dev/null +++ b/src/test/contracts/bytes_unpack.religo @@ -0,0 +1,14 @@ +let id_string = (p: string) : option(string) => { + let packed : bytes = Bytes.pack(p); + ((Bytes.unpack(packed)): option(string)); +}; + +let id_int = (p: int) : option(int) => { + let packed: bytes = Bytes.pack(p); + ((Bytes.unpack(packed)): option(int)); +}; + +let id_address = (p: address) : option(address) => { + let packed: bytes = Bytes.pack(p); + ((Bytes.unpack(packed)): option(address)); +}; diff --git a/src/test/contracts/check_signature.ligo b/src/test/contracts/check_signature.ligo new file mode 100644 index 000000000..231b726ea --- /dev/null +++ b/src/test/contracts/check_signature.ligo @@ -0,0 +1,2 @@ +function check_signature (const pk: key; const signed: signature; const msg: bytes) : bool is + crypto_check(pk, signed, msg) diff --git a/src/test/contracts/check_signature.mligo b/src/test/contracts/check_signature.mligo new file mode 100644 index 000000000..ecd56eb4b --- /dev/null +++ b/src/test/contracts/check_signature.mligo @@ -0,0 +1,2 @@ +let check_signature (pk, signed, msg: key * signature * bytes) : bool = + Crypto.check pk signed msg diff --git a/src/test/contracts/check_signature.religo b/src/test/contracts/check_signature.religo new file mode 100644 index 000000000..9d2f266ce --- /dev/null +++ b/src/test/contracts/check_signature.religo @@ -0,0 +1,4 @@ +let check_signature = (param: (key, signature, bytes)) : bool => { + let pk, signed, msg = param; + Crypto.check(pk, signed, msg); +}; diff --git a/src/test/contracts/key_hash.mligo b/src/test/contracts/key_hash.mligo new file mode 100644 index 000000000..830ea3496 --- /dev/null +++ b/src/test/contracts/key_hash.mligo @@ -0,0 +1,5 @@ +let check_hash_key (kh1, k2: key_hash * key) : bool * key_hash = + let kh2 : key_hash = Crypto.hash_key k2 in + if kh1 = kh2 + then (true, kh2) + else (false, kh2) diff --git a/src/test/contracts/key_hash.religo b/src/test/contracts/key_hash.religo new file mode 100644 index 000000000..f3b8e8976 --- /dev/null +++ b/src/test/contracts/key_hash.religo @@ -0,0 +1,10 @@ +let check_hash_key = (kh1_k2: (key_hash, key)) : (bool, key_hash) => { + let kh1, k2 = kh1_k2; + let kh2 : key_hash = Crypto.hash_key(k2); + if (kh1 == kh2) { + (true, kh2); + } + else { + (false, kh2); + } +}; diff --git a/src/test/contracts/negative/self_in_lambda.mligo b/src/test/contracts/negative/self_in_lambda.mligo new file mode 100644 index 000000000..493047199 --- /dev/null +++ b/src/test/contracts/negative/self_in_lambda.mligo @@ -0,0 +1,5 @@ +let foo (u: unit) : address = + Current.self_address + +let main (ps: unit * address): (operation list * address) = + ( ([] : operation list) , foo) \ No newline at end of file diff --git a/src/test/contracts/tuple_param_destruct.mligo b/src/test/contracts/tuple_param_destruct.mligo index 6dfe30fe4..d9cfc6513 100644 --- a/src/test/contracts/tuple_param_destruct.mligo +++ b/src/test/contracts/tuple_param_destruct.mligo @@ -1 +1,2 @@ -let sum (result, i : int * int) : int = result + i +let sum (result, i : int * int) : int = result - i +let parentheses ((((result, i))) : ((int * int))) : int = result - i diff --git a/src/test/contracts/tuple_param_destruct.religo b/src/test/contracts/tuple_param_destruct.religo new file mode 100644 index 000000000..3641ab8d0 --- /dev/null +++ b/src/test/contracts/tuple_param_destruct.religo @@ -0,0 +1,2 @@ +let sum = ((result, i) : (int, int)) : int => result - i; +let parentheses = (((((result, i)))) : (((int, int)))) : int => result - i; diff --git a/src/test/contracts/website2.mligo b/src/test/contracts/website2.mligo index 17d4c2bc3..77259ad76 100644 --- a/src/test/contracts/website2.mligo +++ b/src/test/contracts/website2.mligo @@ -1,3 +1,5 @@ +(* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *) + type storage = int (* variant defining pseudo multi-entrypoint actions *) @@ -11,9 +13,11 @@ let sub (a: int) (b: int) : int = a - b (* real entrypoint that re-routes the flow based on the action provided *) -let main (ps: action * storage) = +let main (p,s: action * storage) = let storage = - match ps.0 with - | Increment n -> add ps.1 n - | Decrement n -> sub ps.1 n + match p with + | Increment n -> add s n + | Decrement n -> sub s n in ([] : operation list), storage + +(* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *) diff --git a/src/test/contracts/website2.religo b/src/test/contracts/website2.religo index 67e5ac125..fbb4a108d 100644 --- a/src/test/contracts/website2.religo +++ b/src/test/contracts/website2.religo @@ -1,3 +1,5 @@ +(* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *) + type storage = int; /* variant defining pseudo multi-entrypoint actions */ @@ -21,3 +23,5 @@ let main2 = (p: action, storage) => { }; let main = (x: (action, storage)) => main2(x[0],x[1]); + +(* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index afd93bb74..53e71163a 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1901,6 +1901,67 @@ let key_hash () : unit result = let%bind () = expect_eq program "check_hash_key" make_input make_expected in ok () +let key_hash_mligo () : unit result = + let open Tezos_crypto in + let (raw_pkh,raw_pk,_) = Signature.generate_key () in + let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in + let pk_str = Signature.Public_key.to_b58check raw_pk in + let%bind program = mtype_file "./contracts/key_hash.mligo" in + let make_input = e_pair (e_key_hash pkh_str) (e_key pk_str) in + let make_expected = e_pair (e_bool true) (e_key_hash pkh_str) in + let%bind () = expect_eq program "check_hash_key" make_input make_expected in + ok () + +let key_hash_religo () : unit result = + let open Tezos_crypto in + let (raw_pkh,raw_pk,_) = Signature.generate_key () in + let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in + let pk_str = Signature.Public_key.to_b58check raw_pk in + let%bind program = retype_file "./contracts/key_hash.religo" in + let make_input = e_pair (e_key_hash pkh_str) (e_key pk_str) in + let make_expected = e_pair (e_bool true) (e_key_hash pkh_str) in + let%bind () = expect_eq program "check_hash_key" make_input make_expected in + ok () + +let check_signature () : unit result = + let open Tezos_crypto in + let (_, raw_pk, sk) = Signature.generate_key () in + let pk_str = Signature.Public_key.to_b58check raw_pk in + let signed = Signature.sign sk (Bytes.of_string "hello world") in + let%bind program = type_file "./contracts/check_signature.ligo" in + let make_input = e_tuple [e_key pk_str ; + e_signature (Signature.to_b58check signed) ; + e_bytes_ofbytes (Bytes.of_string "hello world")] in + let make_expected = e_bool true in + let%bind () = expect_eq program "check_signature" make_input make_expected in + ok () + +let check_signature_mligo () : unit result = + let open Tezos_crypto in + let (_, raw_pk, sk) = Signature.generate_key () in + let pk_str = Signature.Public_key.to_b58check raw_pk in + let signed = Signature.sign sk (Bytes.of_string "hello world") in + let%bind program = mtype_file "./contracts/check_signature.mligo" in + let make_input = e_tuple [e_key pk_str ; + e_signature (Signature.to_b58check signed) ; + e_bytes_ofbytes (Bytes.of_string "hello world")] in + let make_expected = e_bool true in + let%bind () = expect_eq program "check_signature" make_input make_expected in + ok () + +let check_signature_religo () : unit result = + let open Tezos_crypto in + let (_, raw_pk, sk) = Signature.generate_key () in + let pk_str = Signature.Public_key.to_b58check raw_pk in + let signed = Signature.sign sk (Bytes.of_string "hello world") in + let%bind program = retype_file "./contracts/check_signature.religo" in + let make_input = e_tuple [e_key pk_str ; + e_signature (Signature.to_b58check signed) ; + e_bytes_ofbytes (Bytes.of_string "hello world")] in + let make_expected = e_bool true in + let%bind () = expect_eq program "check_signature" make_input make_expected in + ok () + let curry () : unit result = let%bind program = mtype_file "./contracts/curry.mligo" in let%bind () = @@ -1943,8 +2004,15 @@ let type_tuple_destruct () : unit result = let tuple_param_destruct () : unit result = let%bind program = mtype_file "./contracts/tuple_param_destruct.mligo" in - let%bind () = expect_eq program "sum" (e_tuple [e_int 10; e_int 10]) (e_int 20) - in ok () + let%bind () = expect_eq program "sum" (e_tuple [e_int 20; e_int 10]) (e_int 10) in + let%bind () = expect_eq program "parentheses" (e_tuple [e_int 20; e_int 10]) (e_int 10) in + ok () + +let tuple_param_destruct_religo () : unit result = + let%bind program = retype_file "./contracts/tuple_param_destruct.religo" in + let%bind () = expect_eq program "sum" (e_tuple [e_int 20; e_int 10]) (e_int 10) in + let%bind () = expect_eq program "parentheses" (e_tuple [e_int 20; e_int 10]) (e_int 10) in + ok () let let_in_multi_bind () : unit result = let%bind program = mtype_file "./contracts/let_in_multi_bind.mligo" in @@ -1968,6 +2036,26 @@ let bytes_unpack () : unit result = let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in ok () +let bytes_unpack_mligo () : unit result = + let%bind program = mtype_file "./contracts/bytes_unpack.mligo" in + let%bind () = expect_eq program "id_string" (e_string "teststring") (e_some (e_string "teststring")) in + let%bind () = expect_eq program "id_int" (e_int 42) (e_some (e_int 42)) in + let open Proto_alpha_utils.Memory_proto_alpha in + let addr = Protocol.Alpha_context.Contract.to_b58check @@ + (List.nth dummy_environment.identities 0).implicit_contract in + let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in + ok () + +let bytes_unpack_religo () : unit result = + let%bind program = retype_file "./contracts/bytes_unpack.religo" in + let%bind () = expect_eq program "id_string" (e_string "teststring") (e_some (e_string "teststring")) in + let%bind () = expect_eq program "id_int" (e_int 42) (e_some (e_int 42)) in + let open Proto_alpha_utils.Memory_proto_alpha in + let addr = Protocol.Alpha_context.Contract.to_b58check @@ + (List.nth dummy_environment.identities 0).implicit_contract in + let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in + ok () + let empty_case () : unit result = let%bind program = type_file "./contracts/empty_case.ligo" in let%bind () = @@ -2012,7 +2100,14 @@ let empty_case_religo () : unit result = let main = test_suite "Integration (End to End)" [ test "bytes unpack" bytes_unpack ; + test "bytes unpack (mligo)" bytes_unpack_mligo ; + test "bytes unpack (religo)" bytes_unpack_religo ; test "key hash" key_hash ; + test "key hash (mligo)" key_hash_mligo ; + test "key hash (religo)" key_hash_religo ; + test "check signature" check_signature ; + test "check signature (mligo)" check_signature_mligo ; + test "check signature (religo)" check_signature_religo ; test "chain id" chain_id ; test "type alias" type_alias ; test "function" function_ ; @@ -2159,6 +2254,7 @@ let main = test_suite "Integration (End to End)" [ test "attributes (religo)" attributes_religo; test "let in multi-bind (mligo)" let_in_multi_bind ; test "tuple param destruct (mligo)" tuple_param_destruct ; + test "tuple param destruct (religo)" tuple_param_destruct_religo ; test "empty case" empty_case ; test "empty case (mligo)" empty_case_mligo ; test "empty case (religo)" empty_case_religo ; diff --git a/src/test/md_file_tests.ml b/src/test/md_file_tests.ml index 0401648d0..86aefeb89 100644 --- a/src/test/md_file_tests.ml +++ b/src/test/md_file_tests.ml @@ -100,10 +100,11 @@ let md_files = [ "/gitlab-pages/docs/language-basics/strings.md"; "/gitlab-pages/docs/language-basics/maps-records.md"; "/gitlab-pages/docs/language-basics/variables-and-constants.md"; - "/gitlab-pages/docs/language-basics/sets-lists-touples.md"; + "/gitlab-pages/docs/language-basics/sets-lists-tuples.md"; "/gitlab-pages/docs/language-basics/operators.md"; "/gitlab-pages/docs/language-basics/unit-option-pattern-matching.md"; "/gitlab-pages/docs/language-basics/loops.md"; + "/gitlab-pages/docs/language-basics/tezos-specific.md"; "/gitlab-pages/docs/contributors/big-picture/back-end.md"; "/gitlab-pages/docs/contributors/big-picture/vendors.md"; "/gitlab-pages/docs/contributors/big-picture/front-end.md"; diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml index 44a98c97c..b496e661f 100644 --- a/vendors/ligo-utils/simple-utils/trace.ml +++ b/vendors/ligo-utils/simple-utils/trace.ml @@ -705,6 +705,14 @@ let bind_list_cons v lst = lst >>? fun lst -> ok (v::lst) +let rec bind_chain : ('a -> 'a result) list -> 'a -> 'a result = fun fs x -> + match fs with + | [] -> ok x + | hd :: tl -> ( + let aux : 'a -> 'a result = fun x -> bind (bind_chain tl) (hd x) in + bind aux (ok x) + ) + (** Wraps a call that might trigger an exception in a result. *)