Merge branch 'dev' of gitlab.com:ligolang/ligo into rinderknecht-dev

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)
 ```
+
+<!--CameLIGO-->
+```
+(parameter, store: my_type * my_store_type) : operation list * my_store_type
+```
+
+<!--ReasonLIGO-->
+```
+(parameter_store: (my_type, my_store_type)) : (list(operation), my_store_type)
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 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-->
+```cameligo group=a
+type parameter = unit
+type store = unit
+let main (parameter, store: parameter * store) : operation list * store =
+  (([]: operation list), store)
+```
+
+<!--ReasonLIGO-->
+```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);
+};
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 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-->
+```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-->
+```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)), ());
+  };
+};
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
-### 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-->
+```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-->
+```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)), ());
+  };
+};
+```
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 ### Cross contract calls

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-->
+```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-->
+```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);
+};
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 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`.

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-->
+```cameligo group=a
+let today: timestamp = Current.time
+```
+
+<!--ReasonLIGO-->
+```reasonligo group=a
+let today: timestamp = Current.time;
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 > 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-->
+```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-->
+```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;
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 #### 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-->
+```cameligo group=c
+let today: timestamp = Current.time
+let one_day: int = 86400
+let in_24_hrs: timestamp = today - one_day
+```
+
+<!--ReasonLIGO-->
+```reasonligo group=c
+let today: timestamp = Current.time;
+let one_day: int = 86400;
+let in_24_hrs: timestamp = today - one_day;
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 ### 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-->
+```cameligo group=c
+let not_tomorrow: bool = (Current.time = in_24_hrs)
+```
+
+<!--ReasonLIGO-->
+```reasonligo group=c
+let not_tomorrow: bool = (Current.time == in_24_hrs);
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 ## Addresses
@@ -69,6 +125,17 @@ Here's how you can define an address:
 ```pascaligo group=d
 const my_account: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address);
 ```
+
+<!--CameLIGO-->
+```cameligo group=d
+let my_account: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address)
+```
+
+<!--ReasonLIGO-->
+```reasonligo group=d
+let my_account: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address);
+```
+
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 ## Signatures

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-->
+```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-->
+```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);
+};
+```
 <!--END_DOCUSAURUS_CODE_TABS-->
 
 

gitlab-pages/docs/language-basics/functions.md

@@ -107,15 +107,6 @@ value.
 
 <!--END_DOCUSAURUS_CODE_TABS-->
 
-<!--DOCUSAURUS_CODE_TABS-->
-<!--Pascaligo-->
-```pascaligo group=b
-const increment : (int -> int) = (function (const i : int) : int is i + 1);
-// a = 2
-const a: int = increment(1);
-```
-<!--END_DOCUSAURUS_CODE_TABS-->
-
 ## 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.

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
 ---
 

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.
+
+<!--DOCUSAURUS_CODE_TABS-->
+
+<!--PascaLIGO-->
+```pascaligo
+function id_string (const p : string) : option(string) is block {
+  const packed : bytes = bytes_pack(p) ;
+} with (bytes_unpack(packed): option(string))
+```
+
+<!--CameLIGO-->
+```cameligo
+let id_string (p: string) : string option =
+  let packed: bytes = Bytes.pack p in
+  ((Bytes.unpack packed): string option)
+```
+
+<!--ReasonLIGO-->
+```reasonligo
+let id_string = (p: string) : option(string) => {
+  let packed : bytes = Bytes.pack(p);
+  ((Bytes.unpack(packed)): option(string));
+};
+```
+
+<!--END_DOCUSAURUS_CODE_TABS-->
+
+## 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.
+
+<!--DOCUSAURUS_CODE_TABS-->
+
+<!--PascaLIGO-->
+```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-->
+```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-->
+```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);
+  }
+};
+```
+
+<!--END_DOCUSAURUS_CODE_TABS-->
+
+## 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.
+
+<!--DOCUSAURUS_CODE_TABS-->
+
+<!--PascaLIGO-->
+```pascaligo
+function check_signature
+    (const pk: key;
+     const signed: signature;
+     const msg: bytes) : bool
+  is crypto_check(pk, signed, msg)
+```
+
+<!--CameLIGO-->
+```cameligo
+let check_signature (pk, signed, msg: key * signature * bytes) : bool =
+  Crypto.check pk signed msg
+```
+
+<!--ReasonLIGO-->
+```reasonligo
+let check_signature = (param: (key, signature, bytes)) : bool => {
+  let pk, signed, msg = param;
+  Crypto.check(pk, signed, msg);
+};
+```
+
+<!--END_DOCUSAURUS_CODE_TABS-->
+ 
+## 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.
+
+<!--DOCUSAURUS_CODE_TABS-->
+
+<!--PascaLIGO-->
+```pascaligo
+const current_addr : address = self_address;
+```
+
+<!--CameLIGO-->
+```cameligo
+let current_addr : address = Current.self_address
+```
+
+<!--ReasonLIGO-->
+```reasonligo
+let current_addr : address = Current.self_address;
+```
+
+<!--END_DOCUSAURUS_CODE_TABS-->

gitlab-pages/website/core/CodeExamples.js

@@ -24,51 +24,51 @@ ${pre}`;
 const CAMELIGO_EXAMPLE = `${pre}ocaml
 type storage = int
 
-(* variant defining pseudo multi-entrypoint 
+(* variant defining pseudo multi-entrypoint actions *)
-  actions *)
+
 type action =
-  | Increment of int
+| Increment of int
-  | Decrement 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 
+let main (p,s: action * storage) =
-   based on the action provided *)
-let%entry main(p : action) storage =
  let storage =
    match p with
-    | Increment n -> add storage n
+   | Increment n -> add s n
-    | Decrement n -> subtract storage n
+   | Decrement n -> sub s n
-  in (([] : operation list), storage)
+ in ([] : operation list), storage
 ${pre}`;
 
 
 const REASONLIGO_EXAMPLE = `${pre}reasonligo
 type storage = int;
 
-/* variant defining pseudo multi-entrypoint
+/* variant defining pseudo multi-entrypoint actions */
-   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
+let main2 = (p: action, storage) => {
-   based on the action provided */
-let main = (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}`;
 
 

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",

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
   ]

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' |}]

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.
 

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

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"
+  build_contract is a kind of security net
-        on stderr and print the ill-typed michelson code;
 *)
-  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 () =

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

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

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 

src/main/compile/of_typed.ml

@@ -22,3 +22,6 @@ let assert_equal_contract_type : check_type -> string -> Ast_typed.program -> As
       | _ -> dummy_fail
   )
   | _ -> dummy_fail )
+
+let pretty_print ppf program =
+  Ast_typed.PP.program ppf program

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
+    | ETuple { value; region } -> 
-          in raise (Error (WrongFunctionArguments e))
+        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 {

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, []) ;

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

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

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

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

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

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

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 () =

src/stages/common/ast_common.ml

@@ -1,2 +1,3 @@
 module Types = Types
 module PP = PP
+module Misc = Misc

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"

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"
+

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_variable variable ->
-        | T.T_operator _ -> failwith "TODO: T_operator"
+           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_tuple _ -> failwith "TODO: subst: unimplemented case s_type_expression tuple"
-        | Ast_simplified.T_sum _ -> failwith "TODO: subst: unimplemented case s_type_expression"
+        | 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"
+        | 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"
+        | 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"
+        | Ast_simplified.T_variable _ -> failwith "TODO: subst: unimplemented case s_type_expression variable"
-        | Ast_simplified.T_operator _ -> failwith "TODO: subst: unimplemented case s_type_expression"
+        | Ast_simplified.T_operator op ->
-        | Ast_simplified.T_constant _ ->
+           let%bind op =
-          let _TODO = (v, expr) in
+             Stage_common.Misc.bind_map_type_operator (* TODO: write Ast_simplified.Misc.type_operator_name *)
-          failwith "TODO: subst: unimplemented case s_type_expression"
+               (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

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)

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));
+};

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)

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

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);
+};

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)

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);
+  }
+};

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)

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

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;

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
+   match p with
-   | Increment n -> add ps.1 n
+   | Increment n -> add s n
-   | Decrement n -> sub ps.1 n
+   | Decrement n -> sub s n
  in ([] : operation list), storage
+
+(* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *)

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 *)

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)
+  let%bind () = expect_eq program "sum" (e_tuple [e_int 20; e_int 10]) (e_int 10) in
-  in ok ()
+  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 ;

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";

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.
 *)