Merge branch 'ast/tuples_are_back' into 'dev'

Adding tuples in ast_sugar

See merge request ligolang/ligo!521

dexter.ligo

@@ -0,0 +1,585 @@
+// Dexter
+// a decentralized Tezos exchange for XTZ and FA1.2
+// copyright: camlCase 2019-2020
+// version: 0.1.5.0
+
+// =============================================================================
+// Entrypoints
+// =============================================================================
+
+type entrypoint is
+| Approve of (address * nat * nat)
+| AddLiquidity of (address * nat * nat * timestamp)
+| RemoveLiquidity of (address * address * nat * tez * nat * timestamp)
+| XtzToToken of (address * nat * timestamp)
+| TokenToXtz of (address * address * nat * tez * timestamp)
+| BetForBakingRights of (key_hash * address * nat)
+| EndAuctionRound
+| UpdateTokenBalance of (nat)
+
+// the transfer entrypoint of the FA1.2 contract
+type token_contract_transfer is (address * address * nat);
+
+// =============================================================================
+// Storage
+// =============================================================================
+
+type baker_address is key_hash;
+
+type account is record
+  balance   : nat;
+  allowances: map(address, nat);
+end
+
+// this is just to force big_maps as the first item of a pair on the top
+// so we can still use the old big map route without big map id for
+// convenience
+type s is record
+  current_baker: option(baker_address);
+  current_baker_candidate: option(baker_address * address * tez * nat);
+  last_auction: timestamp;
+  lqt_total: nat;
+  token_address: address;
+  token_balance: nat;
+  rewards: (tez * nat);
+end
+
+type storage is record
+  s: s;
+  accounts: big_map(address, account);
+end
+
+// =============================================================================
+// Constants
+// =============================================================================
+
+const empty_allowances : map(address,nat) = map end;
+
+const empty_ops : list(operation) = list end;
+
+const no_baker_candidate: option(baker_address * address * tez * nat) = None;
+
+const no_baker: option(key_hash) = None;
+
+// 21 days
+// 86400 seconds * 21 
+const dexter_cycle: int = 1814400;
+
+// =============================================================================
+// Helper Functions
+// =============================================================================
+
+function mutez_to_natural(const a: tez): nat is
+  block {skip} with a / 1mutez
+
+function natural_to_mutez(const a: nat): tez is
+  block {skip} with a * 1mutez
+
+// this will fail if provided a negative number
+function int_to_nat(const error: string ; const a: int): nat is
+  block {
+    var result : nat := 0n;
+    if (a >= 0) then block {
+      result := abs(a);
+    } else block {
+      failwith(error)
+    };    
+  } with result;
+
+// get an account from the big_map, if one does not exist for a particular
+// address then create one.
+function get_account(const a: address ; const m: big_map(address, account)): account is
+  block { skip } with (
+    case (m[a]) of
+      | None          -> record balance = 0n; allowances = empty_allowances; end
+      | Some(account) -> account
+    end
+  );
+
+function update_allowance(const owner            : address;
+                          const spender          : address;
+                          const updated_allowance: nat;
+                          var   storage          : storage):
+                          storage is
+  block {
+    if (spender =/= owner) then block {
+      var account: account        := get_account(owner, storage.accounts);
+      account.allowances[spender] := updated_allowance;
+      storage.accounts[owner]       := record balance = account.balance; allowances = account.allowances; end;
+    } else {
+      skip;
+    }
+  } with storage;
+
+// if sender is owner, return amount, otherwise check if sender has permission
+// if true then return amount, otherwise fail
+function get_sender_allowance(const owner: address ; const storage: storage): nat is
+  block {
+    var result: nat := 0n;
+    case storage.accounts[owner] of
+    | None -> failwith("2")
+    | Some(account) -> block {
+        if sender =/= owner then block {
+          case account.allowances[sender] of
+            | None -> failwith("3")
+            | Some(allowance) -> result := allowance
+          end;
+        } else block {
+          result := account.balance
+        }
+      }
+    end;
+  } with result;
+
+function get_current_candidate_bet (const storage: storage): (tez * nat) is
+  block {
+    var current_candidate_bet: (tez * nat) := (0mutez, 0n);
+    case (storage.s.current_baker_candidate) of
+      | None   -> skip
+      | Some(current_baker_candidate) -> current_candidate_bet := (current_baker_candidate.2, current_baker_candidate.3)
+    end
+  } with current_candidate_bet;
+
+// there might be some zero division edge cases
+function get_xtz_pool (const current_candidate_bet_xtz: tez ; const storage: storage): (tez) is
+  block {
+    const time_since_last_auction: int = now - storage.s.last_auction;
+    const days_since_last_auction: int = time_since_last_auction / 86400;
+    var xtz_pool : tez := 0mutez;
+    
+    if (days_since_last_auction < dexter_cycle) then block {
+      const released_rewards  : tez = (storage.s.rewards.0 / abs((days_since_last_auction * 1000 / dexter_cycle))) / 1000n;
+      const unreleased_rewards: tez = storage.s.rewards.0 - released_rewards;
+
+      xtz_pool := balance - current_candidate_bet_xtz - unreleased_rewards - amount;
+    } else block {
+      // the slow reward wait has passed, all the rewards are released    
+
+      xtz_pool := balance - current_candidate_bet_xtz - amount;
+    };
+  } with xtz_pool;
+
+// there might be some zero division edge cases
+function get_token_pool (const current_candidate_bet_token: nat ; const storage: storage): (nat) is
+  block {
+    const time_since_last_auction: int = now - storage.s.last_auction;
+    const days_since_last_auction: int = time_since_last_auction / 86400;
+    var token_pool : nat := 0n;
+    
+    if (days_since_last_auction < dexter_cycle) then block {
+      const reward_days : int = days_since_last_auction;
+      const released_rewards  : nat = (storage.s.rewards.1 / abs((reward_days * 1000 / dexter_cycle))) / 1000n;
+      const unreleased_rewards: nat = abs(storage.s.rewards.1 - released_rewards);
+
+      token_pool := abs(storage.s.token_balance - current_candidate_bet_token - unreleased_rewards);
+    } else block {
+      // the slow reward wait has passed, all the rewards are released
+      token_pool := abs(storage.s.token_balance - current_candidate_bet_token)
+    };
+  } with token_pool;
+
+// =============================================================================
+// Entrypoint Functions
+// =============================================================================
+
+function approve(const spender  : address;
+                 const allowance: nat;
+                 const current_allowance: nat;
+                 var storage      : storage):
+                 (list(operation) * storage) is
+  block {
+    if (spender =/= sender) then block {
+      // get the sender's account
+      // if the account does not exist, fail, we do not want to create accounts here
+      // creating accounts should be done in add_liquidity
+      const account: account = get_account(sender, storage.accounts);
+
+      var sender_allowances: map(address, nat) := account.allowances;
+      sender_allowances[spender] := allowance;
+      storage.accounts[sender]  := record balance = account.balance; allowances = sender_allowances; end;
+    } else block {
+      failwith("1");
+    }
+  } with (empty_ops, storage);
+
+// it is assumed that the exchange contract has permission from the FA1.2 token
+// to manage the assets of the user. It is the responsibility of the dApp
+// developer to handle permissions.
+function add_liquidity(const owner               : address;
+                       const min_lqt_created     : nat;
+                       const max_tokens_deposited: nat;
+                       const deadline            : timestamp;
+                       var   storage               : storage):
+                       (list(operation) * storage) is
+  block {
+    // add_liquidity performs a transfer to the token contract, we need to
+    // return the operations
+    var op_list: list(operation) := nil;
+    
+    if (now < deadline) then skip else block {
+      failwith("4");
+    };
+
+    if (max_tokens_deposited > 0n) then skip else block {
+      failwith("5");
+    };   
+
+    if (amount > 0mutez) then skip else block {
+      failwith("6");
+    };
+    
+    if (storage.s.lqt_total > 0n) then block {
+      // lqt_total greater than zero
+      // use the existing exchange rate
+
+      if (min_lqt_created > 0n) then skip else block {
+        failwith("7");
+      };
+
+      const current_candidate_bet: (tez * nat) = get_current_candidate_bet(storage);
+      const xtz_pool             : nat = mutez_to_natural(get_xtz_pool(current_candidate_bet.0, storage));
+      const token_pool           : nat = get_token_pool(current_candidate_bet.1, storage);
+      const nat_amount           : nat = mutez_to_natural(amount);
+      const tokens_deposited     : nat = nat_amount * token_pool          / xtz_pool;
+      const lqt_minted           : nat = nat_amount * storage.s.lqt_total / xtz_pool;
+
+      if (max_tokens_deposited >= tokens_deposited) then skip else block {
+        failwith("8");
+      };
+      
+      if (lqt_minted >= min_lqt_created) then skip else block {
+        failwith("9");
+      };
+      
+      const account: account   = get_account(owner, storage.accounts);
+      const new_balance: nat   = account.balance + lqt_minted;
+      storage.accounts[owner] := record balance = new_balance; allowances = account.allowances; end;
+      storage.s.lqt_total     := storage.s.lqt_total + lqt_minted;
+      storage.s.token_balance := storage.s.token_balance + tokens_deposited;
+
+      // send FA1.2 from owner to exchange
+      const token_contract: contract(token_contract_transfer) = get_entrypoint("%transfer", storage.s.token_address);
+      const op1: operation = transaction((owner, self_address, tokens_deposited), 0mutez, token_contract);
+      op_list := list op1; end;
+
+    } else block {
+      // initial add liquidity
+      if (amount >= 1tz) then skip  else block {
+        failwith("10");
+      };
+
+      const tokens_deposited     : nat = max_tokens_deposited;
+      const current_candidate_bet: (tez * nat) = get_current_candidate_bet(storage);
+      const initial_liquidity    : nat = mutez_to_natural(balance - current_candidate_bet.0);
+
+      storage.s.lqt_total     := initial_liquidity;
+      storage.accounts[owner] := record balance = initial_liquidity; allowances = empty_allowances; end;
+      storage.s.token_balance := tokens_deposited;
+
+      // send FA1.2 tokens from owner to exchange
+      const token_contract: contract(token_contract_transfer) = get_entrypoint("%transfer", storage.s.token_address);
+      const op1: operation = transaction((owner, self_address, tokens_deposited), 0mutez, token_contract);
+      op_list := list op1; end;
+    }
+  } with (op_list, storage);
+
+function remove_liquidity(const owner                : address;
+                          const to_                  : address;
+                          const lqt_burned           : nat;
+                          const min_xtz_withdrawn    : tez;
+                          const min_tokens_withdrawn : nat;
+                          const deadline             : timestamp;
+                          var   storage                : storage):
+                          (list(operation) * storage) is
+  block {
+    var op_list: list(operation) := nil;
+    if (now < deadline) then skip else block {
+      failwith("11");
+    };
+    
+    if (min_xtz_withdrawn > 0mutez) then skip else block {
+      failwith("12");
+    };
+
+    if (min_tokens_withdrawn > 0n) then skip else block {
+      failwith("13");
+    };
+
+    if (lqt_burned > 0n) then skip else block {
+      failwith("14");
+    };
+
+    // returns total if sender is owner, otherwise looks it up
+    const lqt: nat = get_sender_allowance(owner, storage);
+
+    if (lqt >= lqt_burned) then skip else block {
+      failwith("15");              
+    };
+
+    if (storage.s.lqt_total > 0n) then skip else block {
+      failwith("16");
+    };
+
+    const current_candidate_bet: (tez * nat) = get_current_candidate_bet(storage);
+    const xtz_withdrawn        : tez = natural_to_mutez(lqt_burned * mutez_to_natural(balance - current_candidate_bet.0) / storage.s.lqt_total);
+
+    if (xtz_withdrawn >= min_xtz_withdrawn) then skip else block {
+      failwith("17");
+    };              
+
+    const token_pool      : nat = get_token_pool(current_candidate_bet.1, storage);
+    const tokens_withdrawn: nat = lqt_burned * token_pool / storage.s.lqt_total;
+
+    if (tokens_withdrawn >= min_tokens_withdrawn) then skip else block {
+      failwith("18");
+    };
+
+    const account: account = get_account(owner, storage.accounts);
+
+    if (account.balance >= lqt_burned) then skip else block {
+      failwith("19");
+    };
+
+    const new_balance: nat = int_to_nat("33", account.balance - lqt_burned);
+    storage.accounts[owner] := record balance = new_balance; allowances = account.allowances; end;
+                                    
+    storage.s.lqt_total     := int_to_nat("34", storage.s.lqt_total - lqt_burned);
+    storage.s.token_balance := int_to_nat("35", storage.s.token_balance - tokens_withdrawn);
+
+    // update allowance
+    // lqt - lqt_burned is safe, we have already checed that lqt >= lqt_burned
+    storage := update_allowance(owner, sender, int_to_nat("36", lqt - lqt_burned), storage);
+                    
+    // send xtz_withdrawn to to_ address
+    const to_contract: contract(unit) = get_contract(to_);
+    const op1: operation = transaction(unit, xtz_withdrawn, to_contract);
+
+    // send tokens_withdrawn to to address
+    // if tokens_withdrawn if greater than storage.s.token_balance, this will fail
+    const token_contract: contract(token_contract_transfer) = get_entrypoint("%transfer", storage.s.token_address);
+    const op2: operation = transaction((self_address, to_, tokens_withdrawn), 0mutez, token_contract);
+    op_list := list op1; op2; end
+  } with (op_list, storage);
+
+function xtz_to_token(const to_              : address;
+                      const min_tokens_bought: nat;
+                      const deadline         : timestamp;
+                      var storage              : storage):                      
+                      (list(operation) * storage) is
+  block {
+    var op_list: list(operation) := nil;
+    if (now < deadline) then skip else block {
+      failwith("20");
+    };
+
+    const current_candidate_bet: (tez * nat) = get_current_candidate_bet(storage);
+    const xtz_pool             : nat = mutez_to_natural(get_xtz_pool(current_candidate_bet.0, storage));
+    const nat_amount           : nat = mutez_to_natural(amount);
+    const token_pool           : nat = get_token_pool(current_candidate_bet.1, storage);
+    const tokens_bought        : nat = (nat_amount * 997n * token_pool) / (xtz_pool * 1000n + (nat_amount * 997n));
+      
+    if (tokens_bought >= min_tokens_bought) then skip else block {
+      failwith("21");
+    };
+
+    storage.s.token_balance := int_to_nat("32", storage.s.token_balance - tokens_bought);
+
+    // send tokens_withdrawn to to address
+    // if tokens_bought is greater than storage.s.token_balance, this will fail
+    const token_contract: contract(token_contract_transfer) = get_entrypoint("%transfer", storage.s.token_address);
+    const op: operation = transaction((self_address, to_, tokens_bought), 0mutez, token_contract);
+
+    // append internal operations
+    op_list := list op; end;
+  } with (op_list, storage);
+
+function token_to_xtz(const owner         : address; // the address of the owner of FA1.2
+                      const to_           : address;
+                      const tokens_sold   : nat;
+                      const min_xtz_bought: tez;
+                      const deadline      : timestamp;
+                      var storage           : storage):                      
+                      (list(operation) * storage) is
+  block {
+    var op_list: list(operation) := nil;
+    if (now < deadline) then skip else block {
+      failwith("22");
+    };
+
+    const current_candidate_bet: (tez * nat) = get_current_candidate_bet(storage);
+    const xtz_pool             : tez = get_xtz_pool(current_candidate_bet.0, storage);
+    const token_pool           : nat = get_token_pool(current_candidate_bet.1, storage);    
+    const xtz_bought           : tez = natural_to_mutez((tokens_sold * 997n * mutez_to_natural(xtz_pool)) / (token_pool * 1000n + (tokens_sold * 997n)));
+
+    if (xtz_bought >= min_xtz_bought) then skip else block {
+      failwith("23");
+    };
+
+    storage.s.token_balance      := storage.s.token_balance + tokens_sold;
+
+    // send xtz_bought to to_ address
+    const to_contract: contract(unit) = get_contract(to_);
+    const op1: operation = transaction(unit, xtz_bought, to_contract);
+
+    // send tokens_sold to the exchange address
+    // this assumes that the exchange has an allowance for the token and owner in FA1.2
+    const token_contract: contract(token_contract_transfer) = get_entrypoint("%transfer", storage.s.token_address);
+    const op2: operation = transaction((owner, self_address, tokens_sold), 0mutez, token_contract);
+
+    // append internal operations
+    op_list := list op1; op2; end;
+  } with (op_list, storage);
+
+function assert_valid_baker (const current_baker: option(key_hash);
+                             const candidate: key_hash): (operation * operation) is
+  block {
+    // test the candidate baker, if it is valid this will not fail
+    const test_set_delegate_operation: operation = set_delegate(Some(candidate));
+
+    // reset to the current baker
+    const reset_set_delegate_operation: operation = set_delegate(current_baker);
+  } with (test_set_delegate_operation, reset_set_delegate_operation);
+
+function bet_for_baking_rights (const candidate      : key_hash;
+                                const token_source   : address;
+                                const max_tokens_bet : nat;
+                                var storage            : storage):
+                                (list(operation) * storage) is
+  block {
+    var op_list: list(operation) := nil;
+
+    // this is a trick to assert that the provided baker address is valid
+    case (storage.s.current_baker_candidate) of
+    | None -> block {
+        const op_pair: (operation * operation) = assert_valid_baker(storage.s.current_baker, candidate);
+        op_list := op_pair.0 # op_list;
+        op_list := op_pair.1 # op_list;
+      }
+    | Some(current_baker_candidate) -> block {
+        if (current_baker_candidate.0 = candidate) then skip else block {
+          const op_pair: (operation * operation) = assert_valid_baker(storage.s.current_baker, candidate);
+          op_list := op_pair.0 # op_list;
+          op_list := op_pair.1 # op_list;
+        };
+      }
+    end;
+
+    // now we are sure it is a valid baker
+
+    // set a minimum bet
+    if (max_tokens_bet > 0n) then skip else block {
+      failwith("24");
+    };
+
+    if (amount > 0mutez) then skip else block {
+      failwith("25");
+    };
+
+    const current_candidate_bet : (tez * nat) = get_current_candidate_bet(storage);
+
+    if (amount > current_candidate_bet.0) then skip else { failwith("26") };
+
+    const xtz_pool         : nat = mutez_to_natural(get_xtz_pool(current_candidate_bet.0, storage));
+    const token_pool       : nat = get_token_pool(current_candidate_bet.1, storage);
+    const nat_amount       : nat = mutez_to_natural(amount);
+    const tokens_deposited : nat = nat_amount * token_pool / xtz_pool;
+
+    if (tokens_deposited > current_candidate_bet.1) then skip else { failwith("27") };
+    if (tokens_deposited > max_tokens_bet) then skip else { failwith("28") };
+
+    case (storage.s.current_baker_candidate) of
+      | None -> block {
+        // add the tokens_deposited to the token_balance
+        storage.s.token_balance := storage.s.token_balance + tokens_deposited;
+      }
+      | Some(current_baker_candidate) -> block {
+        // return rejected candidates tez and tokens to previous candidate
+        const token_contract: contract(token_contract_transfer) = get_entrypoint("%transfer", storage.s.token_address);
+        const return_token_op: operation = transaction((self_address, current_baker_candidate.1, current_baker_candidate.3), 0mutez, token_contract);
+        op_list := return_token_op # op_list;
+
+        const to_contract: contract(unit) = get_contract(current_baker_candidate.1);
+        const return_xtz_op: operation = transaction(unit, current_baker_candidate.2, to_contract);
+        op_list := return_xtz_op # op_list;
+
+        // remove the tokens from the current_baker_candidate
+        // add the tokens_deposited to the token_balance
+        storage.s.token_balance := abs(storage.s.token_balance - current_baker_candidate.3) + tokens_deposited;
+      }
+    end;
+
+    storage.s.current_baker_candidate := Some((candidate,token_source,amount,tokens_deposited));
+
+    // send FA1.2 from owner to exchange, dexter needs permission to transfer these tokens
+    const token_contract: contract(token_contract_transfer) = get_entrypoint("%transfer", storage.s.token_address);
+    const xtz_to_dexter_op: operation = transaction((token_source, self_address, tokens_deposited), 0mutez, token_contract);
+    op_list := xtz_to_dexter_op # op_list;
+    
+  } with (op_list, storage);
+
+function end_auction_round(var storage : storage) : (list(operation) * storage) is
+  block {
+    var op_list: list(operation) := nil;
+    // 604800 seconds is one week
+    if (now > storage.s.last_auction + 604800) then skip else {failwith("29")};
+
+    case (storage.s.current_baker_candidate) of
+      | None -> block {
+          const set_delegate_op: operation = set_delegate(no_baker);
+          op_list := set_delegate_op # op_list;
+        }
+      | Some(current_baker_candidate) -> block {
+          case (storage.s.current_baker) of
+            | None -> block {
+                storage.s.current_baker := Some(current_baker_candidate.0);
+                storage.s.current_baker_candidate := no_baker_candidate;
+                storage.s.token_balance := storage.s.token_balance + current_baker_candidate.3;
+                storage.s.last_auction  := now;
+                const set_delegate_op: operation = set_delegate(storage.s.current_baker);
+                op_list := set_delegate_op # op_list;
+              }
+            | Some(current_baker) -> block {
+                if (current_baker = current_baker_candidate.0) then block {
+                  storage.s.current_baker_candidate := no_baker_candidate;
+                  storage.s.token_balance := storage.s.token_balance + current_baker_candidate.3;
+                  storage.s.last_auction  := now;
+                } else {
+                  storage.s.current_baker := Some(current_baker_candidate.0);
+                  storage.s.current_baker_candidate := no_baker_candidate;
+                  storage.s.token_balance := storage.s.token_balance + current_baker_candidate.3;
+                  storage.s.last_auction  := now;
+                  const set_delegate_op: operation = set_delegate(storage.s.current_baker);
+                  op_list := set_delegate_op # op_list;
+                }
+              }
+          end;
+        }
+    end;
+    
+  } with (op_list, storage);
+
+function update_token_balance(const token_balance: nat ; var storage : storage) : (list(operation) * storage) is
+  block {
+    var op_list: list(operation) := nil;
+    if (sender =/= storage.s.token_address) then {
+      failwith("31");
+    }  else {
+      storage.s.token_balance := token_balance;
+    }
+  } with (op_list, storage);
+
+// =============================================================================
+// Main
+// =============================================================================
+
+function main (const entrypoint : entrypoint ; const storage : storage) : (list(operation) * storage) is
+  (case entrypoint of
+  | Approve(xs)            -> approve(xs.0,xs.1,xs.2,storage)
+  | AddLiquidity(xs)       -> add_liquidity(xs.0,xs.1,xs.2,xs.3,storage)
+  | RemoveLiquidity(xs)    -> remove_liquidity(xs.0,xs.1,xs.2,xs.3,xs.4,xs.5,storage)
+  | XtzToToken(xs)         -> xtz_to_token(xs.0,xs.1,xs.2,storage)
+  | TokenToXtz(xs)         -> token_to_xtz(xs.0,xs.1,xs.2,xs.3,xs.4,storage)
+  | BetForBakingRights(xs) -> bet_for_baking_rights(xs.0,xs.1,xs.2,storage)
+  | EndAuctionRound        -> end_auction_round(storage)
+  | UpdateTokenBalance(xs) -> update_token_balance(xs, storage)
+  end);

src/passes/10-interpreter/interpreter.ml

@@ -303,12 +303,12 @@ and eval : Ast_typed.expression -> env -> value result
           ok (label,v'))
         (LMap.to_kv_list recmap) in
       ok @@ V_Record (LMap.of_list lv')
-    | E_record_accessor { record ; label} -> (
+    | E_record_accessor { record ; path} -> (
       let%bind record' = eval record env in
       match record' with
       | V_Record recmap ->
         let%bind a = trace_option (simple_error "unknown record field") @@
-          LMap.find_opt label recmap in
+          LMap.find_opt path recmap in
         ok a
       | _ -> simple_fail "trying to access a non-record"
     )

src/passes/10-transpiler/transpiler.ml

@@ -172,7 +172,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
                       aux node in
       ok @@ snd m'
   | T_record m ->
-      let node = Append_tree.of_list @@ kv_list_of_lmap m in
+      let node = Append_tree.of_list @@ Stage_common.Helpers.kv_list_of_record_or_tuple m in
       let aux a b : type_value annotated result =
         let%bind a = a in
         let%bind b = b in
@@ -191,7 +191,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
     )
 
 let record_access_to_lr : type_value -> type_value AST.label_map -> AST.label -> (type_value * [`Left | `Right]) list result = fun ty tym ind ->
-  let tys = kv_list_of_lmap tym in
+  let tys = Stage_common.Helpers.kv_list_of_record_or_tuple tym in
   let node_tv = Append_tree.of_list tys in
   let%bind path =
     let aux (i , _) = i = ind  in
@@ -290,7 +290,8 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
       return ~tv ae
     )
   | E_record m -> (
-      let node = Append_tree.of_list @@ list_of_lmap m in
+    (*list_of_lmap to record_to_list*)
+      let node = Append_tree.of_list @@ Stage_common.Helpers.list_of_record_or_tuple m in
       let aux a b : expression result =
         let%bind a = a in
         let%bind b = b in
@@ -302,16 +303,15 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
       trace_strong (corner_case ~loc:__LOC__ "record build") @@
       Append_tree.fold_ne (transpile_annotated_expression) aux node
     )
-  | E_record_accessor {record; label} ->
-      let ty  = get_type_expression record in
-      let%bind ty' = transpile_type ty in
+  | E_record_accessor {record; path} ->
+      let%bind ty' = transpile_type (get_type_expression record) in
       let%bind ty_lmap =
         trace_strong (corner_case ~loc:__LOC__ "not a record") @@
-        get_t_record ty in
+        get_t_record (get_type_expression record) in
       let%bind ty'_lmap = Stage_common.Helpers.bind_map_lmap transpile_type ty_lmap in
       let%bind path =
         trace_strong (corner_case ~loc:__LOC__ "record access") @@
-        record_access_to_lr ty' ty'_lmap label in
+        record_access_to_lr ty' ty'_lmap path in
       let aux = fun pred (ty, lr) ->
         let c = match lr with
           | `Left  -> C_CAR

src/passes/10-transpiler/untranspiler.ml

@@ -232,7 +232,7 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
       let%bind sub = untranspile v tv in
       return (E_constructor {constructor=Constructor name;element=sub})
   | T_record m ->
-      let lst = kv_list_of_lmap m in
+      let lst = Stage_common.Helpers.kv_list_of_record_or_tuple m in
       let%bind node = match Append_tree.of_list lst with
         | Empty -> fail @@ corner_case ~loc:__LOC__ "empty record"
         | Full t -> ok t in

src/passes/3-self_ast_imperative/entrypoints_length_limit.ml

@@ -11,7 +11,7 @@ end
 open Errors
 
 let peephole_type_expression : type_expression -> type_expression result = fun e ->
-  let return type_content = ok { e with type_content } in
+  let return type_content = ok {type_content } in
   match e.type_content with
   | T_sum cmap ->
     let%bind _uu = bind_map_cmapi

src/passes/3-self_ast_imperative/helpers.ml

@@ -51,6 +51,23 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
      let%bind res = self init' record in
      ok res
     )
+  | E_tuple t -> (
+    let aux init'' expr =
+      let%bind res = fold_expression self init'' expr in
+      ok res
+    in
+    let%bind res = bind_fold_list aux (init') t in
+    ok res
+  )
+  | E_tuple_update {tuple;update} -> (
+    let%bind res = self init' tuple in
+    let%bind res = fold_expression self res update in
+    ok res 
+  )
+  | E_tuple_accessor {tuple} -> (
+     let%bind res = self init' tuple in
+     ok res
+    )
   | E_let_in { let_binder = _ ; rhs ; let_result } -> (
       let%bind res = self init' rhs in
       let%bind res = self res let_result in
@@ -161,6 +178,19 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
     let%bind update = self update in
     return @@ E_record_update {record;path;update}
   )
+  | E_tuple t -> (
+    let%bind t' = bind_map_list self t in
+    return @@ E_tuple t'
+  )
+  | E_tuple_update {tuple; path; update} -> (
+    let%bind tuple  = self tuple in
+    let%bind update = self update in
+    return @@ E_tuple_update {tuple; path; update}
+  )
+  | E_tuple_accessor {tuple;path} -> (
+     let%bind tuple = self tuple in
+     return @@ E_tuple_accessor {tuple;path}
+    )
   | E_constructor c -> (
       let%bind e' = self c.element in
       return @@ E_constructor {c with element = e'}
@@ -212,7 +242,7 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
 and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
   let self = map_type_expression f in
   let%bind te' = f te in
-  let return type_content = ok { te' with type_content } in
+  let return type_content = ok { type_content } in
   match te'.type_content with
   | T_sum temap ->
     let%bind temap' = bind_map_cmap self temap in
@@ -220,6 +250,9 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
   | T_record temap ->
     let%bind temap' = bind_map_lmap self temap in
     return @@ (T_record temap')
+  | T_tuple telst ->
+    let%bind telst' = bind_map_list self telst in
+    return @@ (T_tuple telst')
   | T_arrow {type1 ; type2} ->
     let%bind type1' = self type1 in
     let%bind type2' = self type2 in
@@ -324,6 +357,19 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
     let%bind (res, update) = self res update in
     ok (res, return @@ E_record_update {record;path;update})
   )
+  | E_tuple t -> (
+    let%bind (res, t') = bind_fold_map_list self init' t in
+    ok (res, return @@ E_tuple t')
+  )
+  | E_tuple_update {tuple; path; update} -> (
+    let%bind (res, tuple) = self init' tuple in
+    let%bind (res, update) = self res update in
+    ok (res, return @@ E_tuple_update {tuple;path;update})
+  )
+  | E_tuple_accessor {tuple; path} -> (
+     let%bind (res, tuple) = self init' tuple in
+     ok (res, return @@ E_tuple_accessor {tuple; path})
+    )
   | E_constructor c -> (
       let%bind (res,e') = self init' c.element in
       ok (res, return @@ E_constructor {c with element = e'})

src/passes/4-imperative_to_sugar/imperative_to_sugar.ml

@@ -123,6 +123,9 @@ let rec compile_type_expression : I.type_expression -> O.type_expression result
         ) record
       in
       return @@ O.T_record (O.LMap.of_list record)
+    | I.T_tuple tuple ->
+      let%bind tuple = bind_map_list compile_type_expression tuple in
+      return @@ O.T_tuple tuple
     | I.T_arrow {type1;type2} ->
       let%bind type1 = compile_type_expression type1 in
       let%bind type2 = compile_type_expression type2 in
@@ -154,9 +157,6 @@ and compile_type_operator : I.type_operator -> O.type_operator result =
     | TC_big_map (k,v) ->
       let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in
       ok @@ O.TC_big_map (k,v)
-    | TC_map_or_big_map (k,v) ->
-      let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in
-      ok @@ O.TC_map_or_big_map (k,v)
     | TC_arrow (i,o) ->
       let%bind (i,o) = bind_map_pair compile_type_expression (i,o) in
       ok @@ O.TC_arrow (i,o)
@@ -202,9 +202,9 @@ let rec compile_expression : I.expression -> O.expression result =
         ) record
       in
       return @@ O.E_record (O.LMap.of_list record)
-    | I.E_record_accessor {record;label} ->
+    | I.E_record_accessor {record;path} ->
       let%bind record = compile_expression record in
-      return @@ O.E_record_accessor {record;label}
+      return @@ O.E_record_accessor {record;path}
     | I.E_record_update {record;path;update} ->
       let%bind record = compile_expression record in
       let%bind update = compile_expression update in
@@ -239,6 +239,16 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind expr2 = compile_expression expr2 in
       ok @@ add_to_end expr1 expr2 
     | I.E_skip -> return @@ O.E_skip
+    | I.E_tuple tuple ->
+      let%bind tuple = bind_map_list compile_expression tuple in
+      return @@ O.E_tuple (tuple)
+    | I.E_tuple_accessor {tuple;path} ->
+      let%bind tuple = compile_expression tuple in
+      return @@ O.E_tuple_accessor {tuple;path}
+    | I.E_tuple_update {tuple;path;update} ->
+      let%bind tuple = compile_expression tuple in
+      let%bind update = compile_expression update in
+      return @@ O.E_tuple_update {tuple;path;update}
     | I.E_assign ass ->
       let%bind content =  compile_assign ass @@ O.e_skip () in
       return @@ content
@@ -282,7 +292,6 @@ and compile_assign {variable; access_path; expression} expr =
   let%bind rhs = rhs @@ expression in
   ok @@ O.E_let_in {let_binder=(variable,None); mut=true; rhs; let_result=expr;inline = false}
 
-
 and compile_lambda : I.lambda -> O.lambda result =
   fun {binder;input_type;output_type;result}->
     let%bind input_type = bind_map_option compile_type_expression input_type in
@@ -541,6 +550,9 @@ let rec uncompile_type_expression : O.type_expression -> I.type_expression resul
         ) record
       in
       return @@ I.T_record (O.LMap.of_list record)
+    | O.T_tuple tuple ->
+      let%bind tuple = bind_map_list uncompile_type_expression tuple in
+      return @@ I.T_tuple tuple
     | O.T_arrow {type1;type2} ->
       let%bind type1 = uncompile_type_expression type1 in
       let%bind type2 = uncompile_type_expression type2 in
@@ -572,9 +584,6 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
     | TC_big_map (k,v) ->
       let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
       ok @@ I.TC_big_map (k,v)
-    | TC_map_or_big_map (k,v) ->
-      let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
-      ok @@ I.TC_map_or_big_map (k,v)
     | TC_arrow (i,o) ->
       let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
       ok @@ I.TC_arrow (i,o)
@@ -621,13 +630,23 @@ let rec uncompile_expression : O.expression -> I.expression result =
       ) record
     in
     return @@ I.E_record (O.LMap.of_list record)
-  | O.E_record_accessor {record;label} ->
+  | O.E_record_accessor {record;path} ->
     let%bind record = uncompile_expression record in
-    return @@ I.E_record_accessor {record;label}
+    return @@ I.E_record_accessor {record;path}
   | O.E_record_update {record;path;update} ->
     let%bind record = uncompile_expression record in
     let%bind update = uncompile_expression update in
     return @@ I.E_record_update {record;path;update}
+  | O.E_tuple tuple ->
+    let%bind tuple = bind_map_list uncompile_expression tuple in
+    return @@ I.E_tuple tuple
+  | O.E_tuple_accessor {tuple;path} ->
+    let%bind tuple = uncompile_expression tuple in
+    return @@ I.E_tuple_accessor {tuple;path}
+  | O.E_tuple_update {tuple;path;update} ->
+    let%bind tuple  = uncompile_expression tuple in
+    let%bind update = uncompile_expression update in
+    return @@ I.E_tuple_update {tuple;path;update}
   | O.E_map map ->
     let%bind map = bind_map_list (
       bind_map_pair uncompile_expression

src/passes/5-self_ast_sugar/helpers.ml

@@ -63,6 +63,23 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
       let ab = (expr1,expr2) in
       let%bind res = bind_fold_pair self init' ab in
       ok res
+  | E_tuple t -> (
+    let aux init'' expr =
+      let%bind res = fold_expression self init'' expr in
+      ok res
+    in
+    let%bind res = bind_fold_list aux (init') t in
+    ok res
+  )
+  | E_tuple_update {tuple;update} -> (
+    let%bind res = self init' tuple in
+    let%bind res = fold_expression self res update in
+    ok res 
+  )
+  | E_tuple_accessor {tuple} -> (
+     let%bind res = self init' tuple in
+     ok res
+    )
      
 
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
@@ -176,12 +193,25 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind (expr1,expr2) = bind_map_pair self (expr1,expr2) in
       return @@ E_sequence {expr1;expr2}
     )
+  | E_tuple t -> (
+    let%bind t' = bind_map_list self t in
+    return @@ E_tuple t'
+  )
+  | E_tuple_update {tuple; path; update} -> (
+    let%bind tuple  = self tuple in
+    let%bind update = self update in
+    return @@ E_tuple_update {tuple; path; update}
+  )
+  | E_tuple_accessor {tuple;path} -> (
+     let%bind tuple = self tuple in
+     return @@ E_tuple_accessor {tuple;path}
+    )
   | E_literal _ | E_variable _ | E_skip as e' -> return e'
 
 and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
   let self = map_type_expression f in
   let%bind te' = f te in
-  let return type_content = ok { te' with type_content } in
+  let return type_content = ok { type_content } in
   match te'.type_content with
   | T_sum temap ->
     let%bind temap' = bind_map_cmap self temap in
@@ -189,6 +219,9 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
   | T_record temap ->
     let%bind temap' = bind_map_lmap self temap in
     return @@ (T_record temap')
+  | T_tuple telst ->
+    let%bind telst' = bind_map_list self telst in
+    return @@ (T_tuple telst')
   | T_arrow {type1 ; type2} ->
     let%bind type1' = self type1 in
     let%bind type2' = self type2 in
@@ -293,6 +326,19 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
     let%bind (res, update) = self res update in
     ok (res, return @@ E_record_update {record;path;update})
   )
+  | E_tuple t -> (
+    let%bind (res, t') = bind_fold_map_list self init' t in
+    ok (res, return @@ E_tuple t')
+  )
+  | E_tuple_update {tuple; path; update} -> (
+    let%bind (res, tuple) = self init' tuple in
+    let%bind (res, update) = self res update in
+    ok (res, return @@ E_tuple_update {tuple;path;update})
+  )
+  | E_tuple_accessor {tuple; path} -> (
+     let%bind (res, tuple) = self init' tuple in
+     ok (res, return @@ E_tuple_accessor {tuple; path})
+    )
   | E_constructor c -> (
       let%bind (res,e') = self init' c.element in
       ok (res, return @@ E_constructor {c with element = e'})

src/passes/6-sugar_to_core/sugar_to_core.ml

@@ -24,6 +24,13 @@ let rec idle_type_expression : I.type_expression -> O.type_expression result =
         ) record
       in
       return @@ O.T_record (O.LMap.of_list record)
+    | I.T_tuple tuple ->
+      let aux (i,acc) el = 
+        let%bind el = idle_type_expression el in
+        ok @@ (i+1,(O.Label (string_of_int i), el)::acc) in
+      let%bind (_, lst ) = bind_fold_list aux (0,[]) tuple in
+      let record = O.LMap.of_list lst in
+      return @@ O.T_record record
     | I.T_arrow {type1;type2} ->
       let%bind type1 = idle_type_expression type1 in
       let%bind type2 = idle_type_expression type2 in
@@ -55,9 +62,6 @@ and idle_type_operator : I.type_operator -> O.type_operator result =
     | TC_big_map (k,v) ->
       let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in
       ok @@ O.TC_big_map (k,v)
-    | TC_map_or_big_map (k,v) ->
-      let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in
-      ok @@ O.TC_map_or_big_map (k,v)
     | TC_arrow (i,o) ->
       let%bind (i,o) = bind_map_pair idle_type_expression (i,o) in
       ok @@ O.TC_arrow (i,o)
@@ -104,9 +108,9 @@ let rec compile_expression : I.expression -> O.expression result =
         ) record
       in
       return @@ O.E_record (O.LMap.of_list record)
-    | I.E_record_accessor {record;label} ->
+    | I.E_record_accessor {record;path} ->
       let%bind record = compile_expression record in
-      return @@ O.E_record_accessor {record;label}
+      return @@ O.E_record_accessor {record;path}
     | I.E_record_update {record;path;update} ->
       let%bind record = compile_expression record in
       let%bind update = compile_expression update in
@@ -155,6 +159,22 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind expr2 = compile_expression expr2 in
       return @@ O.E_let_in {let_binder=(Var.of_name "_", Some O.t_unit); rhs=expr1;let_result=expr2; inline=false}
     | I.E_skip -> ok @@ O.e_unit ~loc:e.location ()
+    | I.E_tuple t ->
+      let aux (i,acc) el = 
+        let%bind el = compile_expression el in
+        ok @@ (i+1,(O.Label (string_of_int i), el)::acc) in
+      let%bind (_, lst ) = bind_fold_list aux (0,[]) t in
+      let m = O.LMap.of_list lst in
+      return @@ O.E_record m
+    | I.E_tuple_accessor {tuple;path} ->
+      let%bind record = compile_expression tuple in
+      let path        = O.Label (string_of_int path) in
+      return @@ O.E_record_accessor {record;path}
+    | I.E_tuple_update {tuple;path;update} ->
+      let%bind record = compile_expression tuple in
+      let path        = O.Label (string_of_int path) in
+      let%bind update = compile_expression update in
+      return @@ O.E_record_update {record;path;update}
 
 and compile_lambda : I.lambda -> O.lambda result =
   fun {binder;input_type;output_type;result}->
@@ -261,9 +281,7 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
     | TC_big_map (k,v) ->
       let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
       ok @@ I.TC_big_map (k,v)
-    | TC_map_or_big_map (k,v) ->
-      let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
-      ok @@ I.TC_map_or_big_map (k,v)
+    | TC_map_or_big_map _ -> failwith "TC_map_or_big_map shouldn't be uncompiled"
     | TC_arrow (i,o) ->
       let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
       ok @@ I.TC_arrow (i,o)
@@ -314,9 +332,9 @@ let rec uncompile_expression : O.expression -> I.expression result =
       ) record
     in
     return @@ I.E_record (O.LMap.of_list record)
-  | O.E_record_accessor {record;label} ->
+  | O.E_record_accessor {record;path} ->
     let%bind record = uncompile_expression record in
-    return @@ I.E_record_accessor {record;label}
+    return @@ I.E_record_accessor {record;path}
   | O.E_record_update {record;path;update} ->
     let%bind record = uncompile_expression record in
     let%bind update = uncompile_expression update in

src/passes/8-typer-new/typer.ml

@@ -455,10 +455,10 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression -
    *     | Some (T_constant ("address" , [])) -> return (E_literal (Literal_address s)) (t_address ())
    *     | _ -> return (E_literal (Literal_string s)) (t_string ())
    *   ) *)
-  | E_record_accessor {record;label} -> (
+  | E_record_accessor {record;path} -> (
       let%bind (base' , state') = type_expression e state record in
-      let wrapped = Wrap.access_label ~base:base'.type_expression ~label in
-      return_wrapped (E_record_accessor {record=base';label}) state' wrapped
+      let wrapped = Wrap.access_label ~base:base'.type_expression ~label:path in
+      return_wrapped (E_record_accessor {record=base';path}) state' wrapped
     )
 
   (* Sum *)
@@ -917,15 +917,15 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
     let%bind r' = bind_smap
       @@ Map.String.map untype_expression r in
     return (e_record r')
-  | E_record_accessor {record; label} ->
+  | E_record_accessor {record; path} ->
     let%bind r' = untype_expression record in
-    let Label s = label in
-    return (e_accessor r' s)
+    let Label s = path in
+    return (e_record_accessor r' s)
   | E_record_update {record; path; update} ->
     let%bind r' = untype_expression record in
     let%bind e = untype_expression update in 
     let Label l = path in
-    return (e_update r' l e)
+    return (e_record_update r' l e)
   | E_matching {matchee;cases} ->
     let%bind ae' = untype_expression matchee in
     let%bind m' = untype_matching untype_expression cases in

src/passes/8-typer-old/typer.ml

@@ -454,7 +454,7 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
       return (e_address s) (t_address ())
   | E_literal (Literal_operation op) ->
       return (e_operation op) (t_operation ())
-  | E_record_accessor {record;label} ->
+  | E_record_accessor {record;path} ->
       let%bind e' = type_expression' e record in
       let aux (prev:O.expression) (a:I.label) : O.expression result =
             let property = a in
@@ -463,10 +463,10 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
               generic_try (bad_record_access property ae prev.type_expression ae.location)
               @@ (fun () -> I.LMap.find property r_tv) in
             let location = ae.location in
-            ok @@ make_a_e ~location (E_record_accessor {record=prev; label=property}) tv e
+            ok @@ make_a_e ~location (E_record_accessor {record=prev; path=property}) tv e
       in
       let%bind ae =
-      trace (simple_info "accessing") @@ aux e' label in
+      trace (simple_info "accessing") @@ aux e' path in
       (* check type annotation of the final accessed element *)
       let%bind () =
         match tv_opt with
@@ -787,15 +787,15 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
     let%bind r' = bind_smap
       @@ Map.String.map untype_expression r in
     return (e_record r')
-  | E_record_accessor {record; label} ->
+  | E_record_accessor {record; path} ->
       let%bind r' = untype_expression record in
-      let Label s = label in
-      return (e_accessor r' s)
+      let Label s = path in
+      return (e_record_accessor r' s)
   | E_record_update {record=r; path=l; update=e} ->
     let%bind r' = untype_expression r in
     let%bind e = untype_expression e in 
     let Label l = l in
-    return (e_update r' l e)
+    return (e_record_update r' l e)
   | E_matching {matchee;cases} ->
       let%bind ae' = untype_expression matchee in
       let%bind m' = untype_matching untype_expression cases in

src/passes/9-self_ast_typed/helpers.ml

@@ -91,9 +91,9 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
       let%bind cases' = map_cases f cases in
       return @@ E_matching {matchee=e';cases=cases'}
     )
-  | E_record_accessor acc -> (
-      let%bind e' = self acc.record in
-      return @@ E_record_accessor {acc with record = e'}
+  | E_record_accessor {record; path} -> (
+      let%bind record = self record in
+      return @@ E_record_accessor {record; path}
     )
   | E_record m -> (
     let%bind m' = bind_map_lmap self m in
@@ -186,9 +186,9 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,cases') = fold_map_cases f res cases in
       ok (res, return @@ E_matching {matchee=e';cases=cases'})
     )
-  | E_record_accessor acc -> (
-      let%bind (res, e') = self init' acc.record in
-      ok (res, return @@ E_record_accessor {acc with record = e'})
+  | E_record_accessor {record; path} -> (
+      let%bind (res, record) = self init' record in
+      ok (res, return @@ E_record_accessor {record; path})
     )
   | E_record m -> (
     let%bind (res, lst') = bind_fold_map_list (fun res (k,e) -> let%bind (res,e) = self res e in ok (res,(k,e))) init' (LMap.to_kv_list m) in

src/stages/1-ast_imperative/PP.ml

@@ -4,11 +4,45 @@ open Format
 open PP_helpers
 
 include Stage_common.PP
-include Ast_PP_type(Ast_imperative_parameter)
 
 let expression_variable ppf (ev : expression_variable) : unit =
   fprintf ppf "%a" Var.pp ev
 
+let rec type_expression' :
+        (formatter -> type_expression -> unit)
+    -> formatter
+    -> type_expression
+    -> unit =
+  fun f ppf te ->
+  match te.type_content with
+  | T_sum m -> fprintf ppf "sum[%a]" (cmap_sep_d f) m
+  | T_record m -> fprintf ppf "{%a}" (record_sep f (const ";")) m
+  | T_tuple t -> fprintf ppf "(%a)" (list_sep_d f) t
+  | T_arrow a -> fprintf ppf "%a -> %a" f a.type1 f a.type2
+  | T_variable tv -> type_variable ppf tv
+  | T_constant tc -> type_constant ppf tc
+  | T_operator to_ -> type_operator f ppf to_
+
+and type_expression ppf (te : type_expression) : unit =
+  type_expression' type_expression ppf te
+
+and type_operator :
+        (formatter -> type_expression -> unit)
+    -> formatter
+    -> type_operator
+    -> unit =
+  fun f ppf to_ ->
+  let s =
+    match to_ with
+    | TC_option te -> Format.asprintf "option(%a)" f te
+    | TC_list te -> Format.asprintf "list(%a)" f te
+    | TC_set te -> Format.asprintf "set(%a)" f te
+    | TC_map (k, v) -> Format.asprintf "Map (%a,%a)" f k f v
+    | TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
+    | TC_arrow (k, v) -> Format.asprintf "arrow (%a,%a)" f k f v
+    | TC_contract te  -> Format.asprintf "Contract (%a)" f te
+  in
+  fprintf ppf "(TO_%s)" s
 
 let rec expression ppf (e : expression) =
   expression_content ppf e.expression_content
@@ -26,11 +60,11 @@ and expression_content ppf (ec : expression_content) =
       fprintf ppf "%a(%a)" constant c.cons_name (list_sep_d expression)
         c.arguments
   | E_record m ->
-      fprintf ppf "%a" (tuple_or_record_sep_expr expression) m
-  | E_record_accessor {record; label=l}->
-      fprintf ppf "%a.%a" expression record label l
+      fprintf ppf "{%a}" (record_sep expression (const ";")) m
+  | E_record_accessor ra ->
+      fprintf ppf "%a.%a" expression ra.record label ra.path
   | E_record_update {record; path; update} ->
-      fprintf ppf "{ %a with { %a = %a } }" expression record label path expression update
+      fprintf ppf "{ %a with %a = %a }" expression record label path expression update
   | E_map m ->
       fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
   | E_big_map m ->
@@ -66,6 +100,12 @@ and expression_content ppf (ec : expression_content) =
       fprintf ppf "{ %a; @. %a}" expression expr1 expression expr2
   | E_skip ->
       fprintf ppf "skip"
+  | E_tuple t ->
+      fprintf ppf "(%a)" (list_sep_d expression) t
+  | E_tuple_accessor ta ->
+      fprintf ppf "%a.%d" expression ta.tuple ta.path
+  | E_tuple_update {tuple; path; update} ->
+      fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
   | E_assign {variable; access_path; expression=e} ->
       fprintf ppf "%a%a := %a" 
         expression_variable variable

src/stages/1-ast_imperative/combinators.ml

@@ -19,14 +19,9 @@ module Errors = struct
 end
 open Errors
 
-let make_t type_content = {type_content; type_meta = ()}
+let make_t type_content = {type_content}
 
   
-let tuple_to_record lst =
-  let aux (i,acc) el = (i+1,(string_of_int i, el)::acc) in
-  let (_, lst ) = List.fold_left aux (0,[]) lst in
-  lst
-
 let t_bool         : type_expression = make_t @@ T_constant (TC_bool)
 let t_string       : type_expression = make_t @@ T_constant (TC_string)
 let t_bytes        : type_expression = make_t @@ T_constant (TC_bytes)
@@ -51,8 +46,8 @@ let t_record m  : type_expression =
   let lst = Map.String.to_kv_list m in
   t_record_ez lst
 
-let t_pair (a , b) : type_expression = t_record_ez [("0",a) ; ("1",b)]
-let t_tuple lst    : type_expression = t_record_ez (tuple_to_record lst)
+let t_tuple lst    : type_expression = make_t @@ T_tuple lst
+let t_pair (a , b) : type_expression = t_tuple [a; b]
 
 let ez_t_sum (lst:(string * type_expression) list) : type_expression =
   let aux prev (k, v) = CMap.add (Constructor k) v prev in
@@ -118,7 +113,8 @@ let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst
 let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a}
 let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b}
 let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
-let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; label= Label b}
+let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; path = Label b}
+let e_accessor ?loc a b = e_record_accessor ?loc a b
 let e_accessor_list ?loc a b  = List.fold_left (fun a b -> e_accessor ?loc a b) a b
 let e_variable ?loc v = make_expr ?loc @@ E_variable v
 let e_skip ?loc () = make_expr ?loc @@ E_skip
@@ -151,11 +147,12 @@ let e_record ?loc map =
   let lst = Map.String.to_kv_list map in
   e_record_ez ?loc lst 
 
-let e_update ?loc record path update = 
+let e_record_update ?loc record path update = 
   let path = Label path in
   make_expr ?loc @@ E_record_update {record; path; update}
+let e_update ?loc record path update = e_record_update ?loc record path update
 
-let e_tuple ?loc lst : expression = e_record_ez ?loc (tuple_to_record lst)
+let e_tuple ?loc lst : expression = make_expr ?loc @@ E_tuple lst
 let e_pair ?loc a b  : expression = e_tuple ?loc [a;b]
 
 let make_option_typed ?loc e t_opt =
@@ -201,7 +198,7 @@ let e_ez_assign ?loc variable access_path expression =
 
 let get_e_accessor = fun t ->
   match t with
-  | E_record_accessor {record; label} -> ok (record , label)
+  | E_record_accessor {record; path} -> ok (record , path)
   | _ -> simple_fail "not an accessor"
 
 let assert_e_accessor = fun t ->
@@ -210,14 +207,7 @@ let assert_e_accessor = fun t ->
 
 let get_e_pair = fun t ->
   match t with
-  | E_record r -> ( 
-  let lst = LMap.to_kv_list r in
-    match lst with 
-    | [(Label "O",a);(Label "1",b)]
-    | [(Label "1",b);(Label "0",a)] -> 
-        ok (a , b)
-    | _ -> simple_fail "not a pair"
-    )
+  | E_tuple [a ; b] -> ok (a , b)
   | _ -> simple_fail "not a pair"
 
 let get_e_list = fun t ->
@@ -225,29 +215,15 @@ let get_e_list = fun t ->
   | E_list lst -> ok lst
   | _ -> simple_fail "not a list"
 
-let tuple_of_record (m: _ LMap.t) =
-  let aux i = 
-    let opt = LMap.find_opt (Label (string_of_int i)) m in
-    Option.bind (fun opt -> Some (opt,i+1)) opt
-  in
-  Base.Sequence.to_list @@ Base.Sequence.unfold ~init:0 ~f:aux
-
 let get_e_tuple = fun t ->
   match t with
-  | E_record r -> ok @@ tuple_of_record r
+  | E_tuple t -> ok @@ t
   | _ -> simple_fail "ast_core: get_e_tuple: not a tuple"
 
 (* Same as get_e_pair *)
 let extract_pair : expression -> (expression * expression) result = fun e ->
   match e.expression_content with
-  | E_record r -> ( 
-  let lst = LMap.to_kv_list r in
-    match lst with 
-    | [(Label "O",a);(Label "1",b)]
-    | [(Label "1",b);(Label "0",a)] -> 
-        ok (a , b)
-    | _ -> fail @@ bad_kind "pair" e.location
-    )
+  | E_tuple [a;b] -> ok @@ (a,b)
   | _ -> fail @@ bad_kind "pair" e.location
 
 let extract_list : expression -> (expression list) result = fun e ->

src/stages/1-ast_imperative/misc.ml

@@ -140,6 +140,26 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | E_record_update _, _ ->
      simple_fail "comparing record update with other expression"
 
+  | E_tuple lsta, E_tuple lstb -> (
+      let%bind lst =
+        generic_try (simple_error "tuples with different number of elements")
+          (fun () -> List.combine lsta lstb) in
+      let%bind _all = bind_list @@ List.map assert_value_eq lst in
+      ok ()
+    )
+  | E_tuple _, _ ->
+      simple_fail "comparing tuple with other expression"
+  
+  | E_tuple_update uta, E_tuple_update utb ->
+    let _ = 
+      generic_try (simple_error "Updating different tuple") @@ 
+      fun () -> assert_value_eq (uta.tuple, utb.tuple) in
+    let () = assert (uta.path == utb.path) in
+    let%bind () = assert_value_eq (uta.update,utb.update) in
+    ok ()
+  | E_tuple_update _, _ ->
+     simple_fail "comparing tuple update with other expression"
+
   | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
       let%bind lst = generic_try (simple_error "maps of different lengths")
           (fun () ->
@@ -182,7 +202,8 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | (_a' , E_ascription b) -> assert_value_eq (a , b.anno_expr)
   | (E_variable _, _) | (E_lambda _, _)
   | (E_application _, _) | (E_let_in _, _)
-  | (E_recursive _,_) | (E_record_accessor _, _)
+  | (E_recursive _,_) 
+  | (E_record_accessor _, _) | (E_tuple_accessor _, _)
   | (E_look_up _, _) | (E_matching _, _)
   | (E_sequence _, _) | (E_skip, _) 
   | (E_assign _, _)

src/stages/1-ast_imperative/types.ml

@@ -2,17 +2,31 @@
 
 module Location = Simple_utils.Location
 
-module Ast_imperative_parameter = struct
-  type type_meta = unit
-end
-
 include Stage_common.Types
 
-(*include Ast_generic_type(Ast_core_parameter)
-*)
-include Ast_generic_type (Ast_imperative_parameter)
+type type_content =
+  | T_sum of type_expression constructor_map
+  | T_record of type_expression label_map
+  | T_tuple  of type_expression list
+  | T_arrow of arrow
+  | T_variable of type_variable
+  | T_constant of type_constant
+  | T_operator of type_operator
+
+and arrow = {type1: type_expression; type2: type_expression}
+
+and type_operator =
+  | TC_contract of type_expression
+  | TC_option of type_expression
+  | TC_list of type_expression
+  | TC_set of type_expression
+  | TC_map of type_expression * type_expression
+  | TC_big_map of type_expression * type_expression
+  | TC_arrow of type_expression * type_expression
+
+and type_expression = {type_content: type_content}
+
 
-type inline = bool 
 type program = declaration Location.wrap list
 and declaration =
   | Declaration_type of (type_variable * type_expression)
@@ -22,7 +36,7 @@ and declaration =
    *   an optional type annotation
    *   a boolean indicating whether it should be inlined
    *   an expression *)
-  | Declaration_constant of (expression_variable * type_expression option * inline * expression)
+  | Declaration_constant of (expression_variable * type_expression option * bool * expression)
 
 (* | Macro_declaration of macro_declaration *)
 and expression = {expression_content: expression_content; location: Location.t}
@@ -41,13 +55,16 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of accessor
-  | E_record_update of update
+  | E_record_accessor of record_accessor
+  | E_record_update   of record_update
   (* Advanced *)
   | E_ascription of ascription
   (* Sugar *)
   | E_sequence of sequence
   | E_skip
+  | E_tuple of expression list
+  | E_tuple_accessor of tuple_accessor
+  | E_tuple_update   of tuple_update
   (* Data Structures *)
   | E_map of (expression * expression) list 
   | E_big_map of (expression * expression) list
@@ -89,9 +106,10 @@ and let_in =
 
 and constructor = {constructor: constructor'; element: expression}
 
-and accessor = {record: expression; label: label}
+and record_accessor = {record: expression; path: label}
+and record_update   = {record: expression; path: label ; update: expression}
+
 
-and update = {record: expression; path: label ; update: expression}
 
 and matching_expr = (expr,unit) matching_content
 and matching =
@@ -105,6 +123,9 @@ and sequence = {
   expr2: expression ;
   }
 
+and tuple_accessor = {tuple: expression; path: int}
+and tuple_update   = {tuple: expression; path: int ; update: expression}
+
 and assign = {
   variable : expression_variable;
   access_path : access list;

src/stages/2-ast_sugar/PP.ml

@@ -4,11 +4,41 @@ open Format
 open PP_helpers
 
 include Stage_common.PP
-include Ast_PP_type(Ast_sugar_parameter)
 
 let expression_variable ppf (ev : expression_variable) : unit =
   fprintf ppf "%a" Var.pp ev
 
+let rec type_expression' :
+        (formatter -> type_expression -> unit)
+    -> formatter
+    -> type_expression
+    -> unit =
+  fun f ppf te ->
+  match te.type_content with
+  | T_sum m -> fprintf ppf "sum[%a]" (cmap_sep_d f) m
+  | T_record m -> fprintf ppf "{%a}" (record_sep f (const ";")) m
+  | T_tuple  t -> fprintf ppf "(%a)" (list_sep_d f) t
+  | T_arrow  a -> fprintf ppf "%a -> %a" f a.type1 f a.type2
+  | T_variable tv -> type_variable ppf tv
+  | T_constant tc -> type_constant ppf tc
+  | T_operator to_ -> type_operator f ppf to_
+
+and type_expression ppf (te : type_expression) : unit =
+  type_expression' type_expression ppf te
+
+and type_operator : (formatter -> type_expression -> unit) -> formatter -> type_operator -> unit =
+  fun f ppf to_ ->
+  let s =
+    match to_ with
+    | TC_option te -> Format.asprintf "option(%a)" f te
+    | TC_list te -> Format.asprintf "list(%a)" f te
+    | TC_set te -> Format.asprintf "set(%a)" f te
+    | TC_map (k, v) -> Format.asprintf "Map (%a,%a)" f k f v
+    | TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
+    | TC_arrow (k, v) -> Format.asprintf "arrow (%a,%a)" f k f v
+    | TC_contract te  -> Format.asprintf "Contract (%a)" f te
+  in
+  fprintf ppf "(TO_%s)" s
 
 let rec expression ppf (e : expression) =
   expression_content ppf e.expression_content
@@ -26,11 +56,11 @@ and expression_content ppf (ec : expression_content) =
       fprintf ppf "%a(%a)" constant c.cons_name (list_sep_d expression)
         c.arguments
   | E_record m ->
-      fprintf ppf "%a" (tuple_or_record_sep_expr expression) m
+      fprintf ppf "{%a}" (record_sep expression (const ";")) m
   | E_record_accessor ra ->
-      fprintf ppf "%a.%a" expression ra.record label ra.label
+      fprintf ppf "%a.%a" expression ra.record label ra.path
   | E_record_update {record; path; update} ->
-      fprintf ppf "{ %a with { %a = %a } }" expression record label path expression update
+      fprintf ppf "{ %a with %a = %a }" expression record label path expression update
   | E_map m ->
       fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
   | E_big_map m ->
@@ -69,6 +99,12 @@ and expression_content ppf (ec : expression_content) =
       fprintf ppf "%a : %a" expression anno_expr type_expression type_annotation
   | E_skip ->
       fprintf ppf "skip"
+  | E_tuple t ->
+      fprintf ppf "(%a)" (list_sep_d expression) t
+  | E_tuple_accessor ta ->
+      fprintf ppf "%a.%d" expression ta.tuple ta.path
+  | E_tuple_update {tuple; path; update} ->
+      fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
 
 and option_type_name ppf
     ((n, ty_opt) : expression_variable * type_expression option) =

src/stages/2-ast_sugar/combinators.ml

@@ -19,7 +19,7 @@ module Errors = struct
 end
 open Errors
 
-let make_t type_content = {type_content; type_meta = ()}
+let make_t type_content = {type_content}
 
   
 let tuple_to_record lst =
@@ -112,6 +112,8 @@ let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NO
 let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a}
 let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b}
 let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
+let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; path = Label b}
+let e_record_accessor_list ?loc a b  = List.fold_left (fun a b -> e_record_accessor ?loc a b) a b
 let e_variable ?loc v = make_expr ?loc @@ E_variable v
 let e_let_in ?loc (binder, ascr) mut inline rhs let_result = 
   make_expr ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline; mut }
@@ -127,6 +129,7 @@ let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst
 let e_set ?loc lst : expression = make_expr ?loc @@ E_set lst
 let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst
 let e_big_map ?loc lst : expression = make_expr ?loc @@ E_big_map lst
+let e_look_up ?loc a b : expression = make_expr ?loc @@ E_look_up (a,b)
 
 let ez_match_variant (lst : ((string * string) * 'a) list) =
   let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in
@@ -139,7 +142,7 @@ let e_record_ez ?loc (lst : (string * expr) list) : expression =
 let e_record ?loc map =
   let lst = Map.String.to_kv_list map in
   e_record_ez ?loc lst 
-let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; label= Label b}
+let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; path= Label b}
 
 let e_record_update ?loc record path update = 
   let path = Label path in
@@ -180,25 +183,18 @@ let e_lambda ?loc (binder : expression_variable)
   }
 let e_recursive ?loc fun_name fun_type lambda = make_expr ?loc @@ E_recursive {fun_name; fun_type; lambda}
 
-let get_e_accessor = fun t ->
+let get_e_record_accessor = fun t ->
   match t with
-  | E_record_accessor {record; label} -> ok (record , label)
-  | _ -> simple_fail "not an accessor"
+  | E_record_accessor {record; path} -> ok (record, path)
+  | _ -> simple_fail "not a record accessor"
 
 let assert_e_accessor = fun t ->
-  let%bind _ = get_e_accessor t in
+  let%bind _ = get_e_record_accessor t in
   ok ()
 
 let get_e_pair = fun t ->
   match t with
-  | E_record r -> ( 
-  let lst = LMap.to_kv_list r in
-    match lst with 
-    | [(Label "O",a);(Label "1",b)]
-    | [(Label "1",b);(Label "0",a)] -> 
-        ok (a , b)
-    | _ -> simple_fail "not a pair"
-    )
+  | E_tuple [a ; b] -> ok (a , b)
   | _ -> simple_fail "not a pair"
 
 let get_e_list = fun t ->
@@ -206,29 +202,15 @@ let get_e_list = fun t ->
   | E_list lst -> ok lst
   | _ -> simple_fail "not a list"
 
-let tuple_of_record (m: _ LMap.t) =
-  let aux i = 
-    let opt = LMap.find_opt (Label (string_of_int i)) m in
-    Option.bind (fun opt -> Some (opt,i+1)) opt
-  in
-  Base.Sequence.to_list @@ Base.Sequence.unfold ~init:0 ~f:aux
-
 let get_e_tuple = fun t ->
   match t with
-  | E_record r -> ok @@ tuple_of_record r
+  | E_tuple t -> ok @@ t
   | _ -> simple_fail "ast_core: get_e_tuple: not a tuple"
 
 (* Same as get_e_pair *)
 let extract_pair : expression -> (expression * expression) result = fun e ->
   match e.expression_content with
-  | E_record r -> ( 
-  let lst = LMap.to_kv_list r in
-    match lst with 
-    | [(Label "O",a);(Label "1",b)]
-    | [(Label "1",b);(Label "0",a)] -> 
-        ok (a , b)
-    | _ -> fail @@ bad_kind "pair" e.location
-    )
+  | E_tuple [a;b] -> ok @@ (a,b)
   | _ -> fail @@ bad_kind "pair" e.location
 
 let extract_list : expression -> (expression list) result = fun e ->

src/stages/2-ast_sugar/combinators.mli

@@ -80,6 +80,7 @@ val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option
 val e_record : ?loc:Location.t -> expr Map.String.t -> expression
 val e_record_update : ?loc:Location.t -> expression -> string -> expression -> expression
 val e_record_accessor : ?loc:Location.t -> expression -> string -> expression
+val e_record_accessor_list : ?loc:Location.t -> expression -> string list -> expression
 
 val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
 
@@ -90,9 +91,11 @@ val e_list : ?loc:Location.t -> expression list -> expression
 val e_set : ?loc:Location.t -> expression list -> expression
 val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression
 val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
+val e_look_up : ?loc:Location.t -> expression -> expression -> expression
 
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
 val e_matching_bool : ?loc:Location.t -> expression -> expression -> expression -> expression
+val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content
 val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression
 
 val make_option_typed : ?loc:Location.t -> expression -> type_expression option -> expression
@@ -109,9 +112,6 @@ val e_record_ez : ?loc:Location.t -> (string * expression) list -> expression
 val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
 val e_tuple : ?loc:Location.t -> expression list -> expression
 val e_pair : ?loc:Location.t -> expression -> expression -> expression
-(*
-val get_e_accessor : expression' -> ( expression * access_path ) result
-*)
 
 val assert_e_accessor : expression_content -> unit result
 

src/stages/2-ast_sugar/misc.ml

@@ -140,6 +140,26 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | E_record_update _, _ ->
      simple_fail "comparing record update with other expression"
 
+  | E_tuple lsta, E_tuple lstb -> (
+      let%bind lst =
+        generic_try (simple_error "tuples with different number of elements")
+          (fun () -> List.combine lsta lstb) in
+      let%bind _all = bind_list @@ List.map assert_value_eq lst in
+      ok ()
+    )
+  | E_tuple _, _ ->
+      simple_fail "comparing tuple with other expression"
+  
+  | E_tuple_update uta, E_tuple_update utb ->
+    let _ = 
+      generic_try (simple_error "Updating different tuple") @@ 
+      fun () -> assert_value_eq (uta.tuple, utb.tuple) in
+    let () = assert (uta.path == utb.path) in
+    let%bind () = assert_value_eq (uta.update,utb.update) in
+    ok ()
+  | E_tuple_update _, _ ->
+     simple_fail "comparing tuple update with other expression"
+
   | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
       let%bind lst = generic_try (simple_error "maps of different lengths")
           (fun () ->
@@ -182,7 +202,8 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | (_a' , E_ascription b) -> assert_value_eq (a , b.anno_expr)
   | (E_variable _, _) | (E_lambda _, _)
   | (E_application _, _) | (E_let_in _, _)
-  | (E_recursive _,_) | (E_record_accessor _, _)
+  | (E_recursive _,_) 
+  | (E_record_accessor _, _) | (E_tuple_accessor _, _)
   | (E_look_up _, _) | (E_matching _, _)
   | (E_sequence _, _) | (E_skip, _) -> simple_fail "comparing not a value"
 

src/stages/2-ast_sugar/types.ml

@@ -2,17 +2,31 @@
 
 module Location = Simple_utils.Location
 
-module Ast_sugar_parameter = struct
-  type type_meta = unit
-end
-
 include Stage_common.Types
 
-(*include Ast_generic_type(Ast_core_parameter)
-*)
-include Ast_generic_type (Ast_sugar_parameter)
+type type_content =
+  | T_sum of type_expression constructor_map
+  | T_record of type_expression label_map
+  | T_tuple  of type_expression list
+  | T_arrow of arrow
+  | T_variable of type_variable
+  | T_constant of type_constant
+  | T_operator of type_operator
+
+and arrow = {type1: type_expression; type2: type_expression}
+
+and type_operator =
+  | TC_contract of type_expression
+  | TC_option of type_expression
+  | TC_list of type_expression
+  | TC_set of type_expression
+  | TC_map of type_expression * type_expression
+  | TC_big_map of type_expression * type_expression
+  | TC_arrow of type_expression * type_expression
+
+and type_expression = {type_content: type_content}
+
 
-type inline = bool 
 type program = declaration Location.wrap list
 and declaration =
   | Declaration_type of (type_variable * type_expression)
@@ -22,7 +36,7 @@ and declaration =
    *   an optional type annotation
    *   a boolean indicating whether it should be inlined
    *   an expression *)
-  | Declaration_constant of (expression_variable * type_expression option * inline * expression)
+  | Declaration_constant of (expression_variable * type_expression option * bool * expression)
 
 (* | Macro_declaration of macro_declaration *)
 and expression = {expression_content: expression_content; location: Location.t}
@@ -41,13 +55,16 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of accessor
-  | E_record_update of update
+  | E_record_accessor of record_accessor
+  | E_record_update   of record_update
   (* Advanced *)
   | E_ascription of ascription
   (* Sugar *)
   | E_sequence of sequence
   | E_skip
+  | E_tuple of expression list
+  | E_tuple_accessor of tuple_accessor
+  | E_tuple_update   of tuple_update
   (* Data Structures *)
   | E_map of (expression * expression) list 
   | E_big_map of (expression * expression) list
@@ -86,9 +103,8 @@ and let_in = {
 
 and constructor = {constructor: constructor'; element: expression}
 
-and accessor = {record: expression; label: label}
-
-and update = {record: expression; path: label ; update: expression}
+and record_accessor = {record: expression; path: label}
+and record_update   = {record: expression; path: label ; update: expression}
 
 and matching_expr = (expr,unit) matching_content
 and matching =
@@ -102,6 +118,9 @@ and sequence = {
   expr2: expression ;
   }
 
+and tuple_accessor = {tuple: expression; path: int}
+and tuple_update   = {tuple: expression; path: int ; update: expression}
+
 and environment_element_definition =
   | ED_binder
   | ED_declaration of (expression * free_variables)

src/stages/3-ast_core/PP.ml

@@ -28,7 +28,7 @@ and expression_content ppf (ec : expression_content) =
   | E_record m ->
       fprintf ppf "%a" (tuple_or_record_sep_expr expression) m
   | E_record_accessor ra ->
-      fprintf ppf "%a.%a" expression ra.record label ra.label
+      fprintf ppf "%a.%a" expression ra.record label ra.path
   | E_record_update {record; path; update} ->
       fprintf ppf "{ %a with { %a = %a } }" expression record label path expression update
   | E_lambda {binder; input_type; output_type; result} ->

src/stages/3-ast_core/combinators.ml

@@ -114,8 +114,8 @@ let e_map_add ?loc k v old  : expression = make_expr ?loc @@ E_constant {cons_na
 let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a}
 let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b}
 let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
-let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; label= Label b}
-let e_accessor_list ?loc a b  = List.fold_left (fun a b -> e_accessor ?loc a b) a b
+let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; path = Label b}
+let e_record_accessor_list ?loc a b  = List.fold_left (fun a b -> e_record_accessor ?loc a b) a b
 let e_variable ?loc v = make_expr ?loc @@ E_variable v
 let e_let_in ?loc (binder, ascr) inline rhs let_result = 
   make_expr ?loc @@ E_let_in { let_binder = (binder,ascr) ; rhs ; let_result; inline }
@@ -139,7 +139,7 @@ let e_record ?loc map =
   let lst = Map.String.to_kv_list map in
   e_record_ez ?loc lst 
 
-let e_update ?loc record path update = 
+let e_record_update ?loc record path update = 
   let path = Label path in
   make_expr ?loc @@ E_record_update {record; path; update}
 
@@ -178,20 +178,20 @@ let e_assign_with_let ?loc var access_path expr =
   | lst -> 
     let rec aux path record= match path with 
     | [] -> failwith "acces_path cannot be empty"
-    | [e] -> e_update ?loc record e expr
+    | [e] -> e_record_update ?loc record e expr
     | elem::tail -> 
-      let next_record = e_accessor record elem in
-      e_update ?loc record elem (aux tail next_record )
+      let next_record = e_record_accessor record elem in
+      e_record_update ?loc record elem (aux tail next_record )
     in 
     (var, None), true, (aux lst (e_variable var)), false
 
-let get_e_accessor = fun t ->
+let get_e_record_accessor = fun t ->
   match t with
-  | E_record_accessor {record; label} -> ok (record , label)
+  | E_record_accessor {record; path} -> ok (record, path)
   | _ -> simple_fail "not an accessor"
 
-let assert_e_accessor = fun t ->
-  let%bind _ = get_e_accessor t in
+let assert_e_record_accessor = fun t ->
+  let%bind _ = get_e_record_accessor t in
   ok ()
 
 let get_e_pair = fun t ->
@@ -218,16 +218,9 @@ let get_e_list = fun t ->
   in
   aux t
 
-let tuple_of_record (m: _ LMap.t) =
-  let aux i = 
-    let opt = LMap.find_opt (Label (string_of_int i)) m in
-    Option.bind (fun opt -> Some (opt,i+1)) opt
-  in
-  Base.Sequence.to_list @@ Base.Sequence.unfold ~init:0 ~f:aux
-
 let get_e_tuple = fun t ->
   match t with
-  | E_record r -> ok @@ tuple_of_record r
+  | E_record r -> ok @@ List.map snd @@ Stage_common.Helpers.tuple_of_record r
   | _ -> simple_fail "ast_core: get_e_tuple: not a tuple"
 
 (* Same as get_e_pair *)

src/stages/3-ast_core/combinators.mli

@@ -76,8 +76,8 @@ val e_pair : ?loc:Location.t -> expression -> expression -> expression
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
 val e_matching_bool : ?loc:Location.t -> expression -> expression -> expression -> expression
-val e_accessor : ?loc:Location.t -> expression -> string -> expression
-val e_accessor_list : ?loc:Location.t -> expression -> string list -> expression
+val e_record_accessor : ?loc:Location.t -> expression -> string -> expression
+val e_record_accessor_list : ?loc:Location.t -> expression -> string list -> expression
 val e_variable : ?loc:Location.t -> expression_variable -> expression
 val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
 val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
@@ -95,14 +95,14 @@ val e_typed_none : ?loc:Location.t -> type_expression -> expression
 val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
 val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
 val e_record : ?loc:Location.t -> expr Map.String.t -> expression
-val e_update : ?loc:Location.t -> expression -> string -> expression -> expression
+val e_record_update : ?loc:Location.t -> expression -> string -> expression -> expression
 val e_assign_with_let : ?loc:Location.t -> string -> string list -> expression -> ((expression_variable*type_expression option)*bool*expression*bool)
 
 (*
 val get_e_accessor : expression' -> ( expression * access_path ) result
 *)
 
-val assert_e_accessor : expression_content -> unit result
+val assert_e_record_accessor : expression_content -> unit result
 
 val get_e_pair : expression_content -> ( expression * expression ) result
 

src/stages/3-ast_core/types.ml

@@ -41,8 +41,8 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of accessor
-  | E_record_update of update
+  | E_record_accessor of record_accessor
+  | E_record_update   of record_update
   (* Advanced *)
   | E_ascription of ascription
 
@@ -75,9 +75,8 @@ and let_in =
 
 and constructor = {constructor: constructor'; element: expression}
 
-and accessor = {record: expression; label: label}
-
-and update = {record: expression; path: label ; update: expression}
+and record_accessor = {record: expression; path: label}
+and record_update   = {record: expression; path: label ; update: expression}
 
 and matching_expr = (expr,unit) matching_content
 and matching =

src/stages/4-ast_typed/PP.ml

@@ -29,7 +29,7 @@ and expression_content ppf (ec: expression_content) =
   | E_record m ->
       fprintf ppf "%a" (tuple_or_record_sep_expr expression) m
   | E_record_accessor ra ->
-      fprintf ppf "%a.%a" expression ra.record label ra.label
+      fprintf ppf "%a.%a" expression ra.record label ra.path
   | E_record_update {record; path; update} ->
       fprintf ppf "{ %a with { %a = %a } }" expression record label path expression update
   | E_lambda {binder; result} ->

src/stages/4-ast_typed/combinators.ml

@@ -335,7 +335,7 @@ let get_a_bool (t:expression) =
 
 let get_a_record_accessor = fun t ->
   match t.expression_content with
-  | E_record_accessor {record ; label} -> ok (record , label)
+  | E_record_accessor {record; path} -> ok (record, path)
   | _ -> simple_fail "not an accessor"
 
 let get_declaration_by_name : program -> string -> declaration result = fun p name ->

src/stages/4-ast_typed/types.ml

@@ -47,8 +47,8 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of accessor
-  | E_record_update of update
+  | E_record_accessor of record_accessor
+  | E_record_update   of record_update
 
 and constant =
   { cons_name: constant'
@@ -84,12 +84,12 @@ and constructor = {
     element: expression ;
   }
 
-and accessor = {
+and record_accessor = {
     record: expression ;
-    label: label ;
+    path: label ;
   }
 
-and update = {
+and record_update = {
     record: expression ;
     path: label ;
     update: expression ;

src/stages/common/PP.ml

@@ -16,15 +16,14 @@ let cmap_sep value sep ppf m =
 
 let record_sep value sep ppf (m : 'a label_map) =
   let lst = LMap.to_kv_list m in
-  let lst = List.sort (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
+  let lst = List.sort_uniq (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
   let new_pp ppf (k, v) = fprintf ppf "%a -> %a" label k value v in
   fprintf ppf "%a" (list_sep new_pp sep) lst
 
 let tuple_sep value sep ppf m =
   assert (Helpers.is_tuple_lmap m);
-  let lst = LMap.to_kv_list m in
-  let lst = List.sort (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
-  let new_pp ppf (_k, v) = fprintf ppf "%a" value v in
+  let lst = Helpers.tuple_of_record m in
+  let new_pp ppf (_, v) = fprintf ppf "%a" value v in
   fprintf ppf "%a" (list_sep new_pp sep) lst
 
 (* Prints records which only contain the consecutive fields
@@ -156,43 +155,50 @@ let constant ppf : constant' -> unit = function
 
 let literal ppf (l : literal) =
   match l with
-  | Literal_unit ->
-      fprintf ppf "unit"
-  | Literal_void ->
-      fprintf ppf "void"
-  | Literal_bool b ->
-      fprintf ppf "%b" b
-  | Literal_int n ->
-      fprintf ppf "%d" n
-  | Literal_nat n ->
-      fprintf ppf "+%d" n
-  | Literal_timestamp n ->
-      fprintf ppf "+%d" n
-  | Literal_mutez n ->
-      fprintf ppf "%dmutez" n
-  | Literal_string s ->
-      fprintf ppf "%S" s
-  | Literal_bytes b ->
-      fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
-  | Literal_address s ->
-      fprintf ppf "@%S" s
-  | Literal_operation _ ->
-      fprintf ppf "Operation(...bytes)"
-  | Literal_key s ->
-      fprintf ppf "key %s" s
-  | Literal_key_hash s ->
-      fprintf ppf "key_hash %s" s
-  | Literal_signature s ->
-      fprintf ppf "Signature %s" s
-  | Literal_chain_id s ->
-      fprintf ppf "Chain_id %s" s
+  | Literal_unit -> fprintf ppf "unit"
+  | Literal_void -> fprintf ppf "void"
+  | Literal_bool b -> fprintf ppf "%b" b
+  | Literal_int n -> fprintf ppf "%d" n
+  | Literal_nat n -> fprintf ppf "+%d" n
+  | Literal_timestamp n -> fprintf ppf "+%d" n
+  | Literal_mutez n -> fprintf ppf "%dmutez" n
+  | Literal_string s -> fprintf ppf "%S" s
+  | Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
+  | Literal_address s -> fprintf ppf "@%S" s
+  | Literal_operation _ -> fprintf ppf "Operation(...bytes)"
+  | Literal_key s -> fprintf ppf "key %s" s
+  | Literal_key_hash s -> fprintf ppf "key_hash %s" s
+  | Literal_signature s -> fprintf ppf "Signature %s" s
+  | Literal_chain_id s -> fprintf ppf "Chain_id %s" s
+
+let type_variable ppf (t : type_variable) : unit = fprintf ppf "%a" Var.pp t
+
+and type_constant ppf (tc : type_constant) : unit =
+let s =
+    match tc with
+    | TC_unit -> "unit"
+    | TC_string -> "string"
+    | TC_bytes -> "bytes"
+    | TC_nat -> "nat"
+    | TC_int -> "int"
+    | TC_mutez -> "mutez"
+    | TC_bool -> "bool"
+    | TC_operation -> "operation"
+    | TC_address -> "address"
+    | TC_key -> "key"
+    | TC_key_hash -> "key_hash"
+    | TC_signature -> "signature"
+    | TC_timestamp -> "timestamp"
+    | TC_chain_id -> "chain_id"
+    | TC_void -> "void"
+in
+fprintf ppf "%s" s
+
 module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
   module Agt=Ast_generic_type(PARAMETER)
   open Agt
   open Format
 
-  let type_variable ppf (t : type_variable) : unit = fprintf ppf "%a" Var.pp t
-
   let rec type_expression' :
          (formatter -> type_expression -> unit)
       -> formatter
@@ -200,58 +206,16 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
       -> unit =
    fun f ppf te ->
     match te.type_content with
-    | T_sum m ->
-        fprintf ppf "sum[%a]" (cmap_sep_d f) m
-    | T_record m ->
-        fprintf ppf "%a" (tuple_or_record_sep_type f) m
-    | T_arrow a ->
-        fprintf ppf "%a -> %a" f a.type1 f a.type2
-    | T_variable tv ->
-        type_variable ppf tv
-    | T_constant tc ->
-        type_constant ppf tc
-    | T_operator to_ ->
-        type_operator f ppf to_
+    | T_sum m -> fprintf ppf "sum[%a]" (cmap_sep_d f) m
+    | T_record m -> fprintf ppf "%a" (tuple_or_record_sep_type f) m
+    | T_arrow a -> fprintf ppf "%a -> %a" f a.type1 f a.type2
+    | T_variable tv -> type_variable ppf tv
+    | T_constant tc -> type_constant ppf tc
+    | T_operator to_ -> type_operator f ppf to_
 
   and type_expression ppf (te : type_expression) : unit =
     type_expression' type_expression ppf te
 
-  and type_constant ppf (tc : type_constant) : unit =
-    let s =
-      match tc with
-      | TC_unit ->
-          "unit"
-      | TC_string ->
-          "string"
-      | TC_bytes ->
-          "bytes"
-      | TC_nat ->
-          "nat"
-      | TC_int ->
-          "int"
-      | TC_mutez ->
-          "mutez"
-      | TC_bool ->
-          "bool"
-      | TC_operation ->
-          "operation"
-      | TC_address ->
-          "address"
-      | TC_key ->
-          "key"
-      | TC_key_hash ->
-          "key_hash"
-      | TC_signature ->
-          "signature"
-      | TC_timestamp ->
-          "timestamp"
-      | TC_chain_id ->
-          "chain_id"
-      | TC_void ->
-          "void"
-    in
-    fprintf ppf "%s" s
-
   and type_operator :
          (formatter -> type_expression -> unit)
       -> formatter

src/stages/common/helpers.ml

@@ -46,3 +46,23 @@ let get_pair m =
   match (LMap.find_opt (Label "0") m , LMap.find_opt (Label "1") m) with
   | Some e1, Some e2 -> ok (e1,e2)
   | _ -> simple_fail "not a pair"
+
+let tuple_of_record (m: _ LMap.t) =
+  let aux i = 
+    let label = Label (string_of_int i) in
+    let opt = LMap.find_opt (label) m in
+    Option.bind (fun opt -> Some ((label,opt),i+1)) opt
+  in
+  Base.Sequence.to_list @@ Base.Sequence.unfold ~init:0 ~f:aux
+
+let list_of_record_or_tuple (m: _ LMap.t) =
+  if (is_tuple_lmap m) then
+    List.map snd @@ tuple_of_record m
+  else
+    List.rev @@ LMap.to_list m
+
+let kv_list_of_record_or_tuple (m: _ LMap.t) =
+  if (is_tuple_lmap m) then
+    tuple_of_record m
+  else
+    List.rev @@ LMap.to_kv_list m

src/stages/common/helpers.mli

@@ -1,3 +1,5 @@
+open Types
+
 val bind_lmap :
   ('a * 'b list, 'c) result Types.label_map ->
   ('a Types.label_map * 'b list, 'c) result
@@ -19,6 +21,9 @@ val is_tuple_lmap : 'a Types.label_map -> bool
 val get_pair :
            'a Types.label_map ->
            (('a * 'a) * 'b list, unit -> Trace.error) result
+val tuple_of_record : 'a LMap.t -> (label * 'a) list
+val list_of_record_or_tuple : 'a LMap.t -> 'a list
+val kv_list_of_record_or_tuple : 'a LMap.t -> (label * 'a) list
 
 
 

src/stages/typesystem/misc.ml

@@ -136,7 +136,7 @@ module Substitution = struct
     and s_matching_expr : T.matching_expr w = fun ~substs _ ->
       let _TODO = substs in
       failwith "TODO: subst: unimplemented case s_matching"
-    and s_accessor  : T.accessor w = fun ~substs _ ->
+    and s_accessor  : T.record_accessor w = fun ~substs _ ->
       let _TODO = substs in
       failwith "TODO: subst: unimplemented case s_access_path"
 
@@ -182,10 +182,10 @@ module Substitution = struct
          *     let val_ = s_expression ~v ~expr val_ in
          *     ok @@ (key , val_)) aemap in
          * ok @@ T.E_record aemap *)
-      | T.E_record_accessor {record=e;label} ->
+      | T.E_record_accessor {record=e;path} ->
         let%bind record = s_expression ~substs e in
-        let%bind label = s_label ~substs label in
-        ok @@ T.E_record_accessor {record;label}
+        let%bind path = s_label ~substs path in
+        ok @@ T.E_record_accessor {record;path}
       | T.E_record_update {record;path;update}->
         let%bind record = s_expression ~substs record in
         let%bind update = s_expression ~substs update in

src/test/contracts/tuple.ligo

@@ -13,6 +13,11 @@ const fb : foobar = (0,0)
 
 function projection (const tpl : foobar) : int is tpl.0 + tpl.1
 
-type big_tuple is int * int * int * int * int
+type big_tuple is int * int * int * int * int * int * int * int * int * int * int * int
 
-const br : big_tuple = (23, 23, 23, 23, 23)
+const br : big_tuple = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)
+
+function update (const tpl : big_tuple) : big_tuple is
+  block {
+    tpl.11 := 2048
+  } with tpl

src/test/integration_tests.ml

@@ -876,9 +876,14 @@ let tuple () : unit result  =
     expect_eq_n program "modify_abc" make_input make_expected
   in
   let%bind () =
-    let expected = ez [23 ; 23 ; 23 ; 23 ; 23] in
+    let expected = ez [0 ; 1 ; 2 ; 3 ; 4; 5; 6; 7; 8; 9; 10; 11] in
     expect_eq_evaluate program "br" expected
   in
+  let%bind () =
+    let make_input = fun n -> ez [n; n; n; n; n; n; n; n; n; n; n; n] in
+    let make_expected = fun n -> ez [n; n; n; n; n; n; n; n; n; n; n; 2048] in
+    expect_eq_n program "update" make_input make_expected
+  in
   ok ()
 
 let tuple_mligo () : unit result  =