Merge

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

gitlab-pages/docs/language-basics/maps-records.md

@@ -230,6 +230,106 @@ xy_translate "({x:2,y:3,z:1}, {dx:3,dy:4})"
 You have to understand that `p` has not been changed by the functional
 update: a nameless new version of it has been created and returned.
 
+#### Nested updates
+
+A unique feature of LIGO is the ability to perform nested updates on records.
+
+For example if you have the following record structure:
+
+<Syntax syntax="pascaligo">
+
+```pascaligo
+type color is 
+| Blue 
+| Green
+
+type preferences is record [
+  color : color; 
+  other : int;
+]
+
+type account is record [
+  id : int; 
+  preferences : preferences;
+]
+```
+
+</Syntax>
+<Syntax syntax="cameligo">
+
+```cameligo
+type color = 
+  Blue 
+| Green
+
+type preferences = {
+  color : color;
+  other : int;
+}
+
+type account = {
+  id: int;
+  preferences: preferences;
+}
+```
+
+</Syntax>
+<Syntax syntax="reasonligo">
+
+```reasonligo
+type color = 
+  Blue 
+| Green;
+
+type preferences = {
+  color : color,
+  other : int
+}
+
+type account = {
+  id : int, 
+  preferences : preferences
+}
+```
+
+</Syntax>
+
+You can update the nested record with the following code:
+
+<Syntax syntax="pascaligo">
+
+```pascaligo
+
+function change_color_preference (const account : account; const color : color ) : account is 
+  block {
+      account := account with record [preferences.color = color] 
+  } with account
+  
+```
+
+</Syntax>
+<Syntax syntax="cameligo">
+
+```cameligo
+let change_color_preference (account : account) (color : color) : account = 
+  { account with preferences.color = color }
+```
+
+</Syntax>
+<Syntax syntax="reasonligo">
+
+```reasonligo
+let change_color_preference = (account : account, color : color): account => 
+  { ...account, preferences.color: color };
+```
+
+</Syntax>
+
+Note that all the records in the path will get updated. In this example that's
+`account` and `preferences`.
+
+<Syntax syntax="pascaligo">
+
 ### Record Patches
 
 Another way to understand what it means to update a record value is to
@@ -318,6 +418,8 @@ xy_translate "(record [x=2;y=3;z=1], record [dx=3;dy=4])"
 
 The hiding of a variable by another (here `p`) is called `shadowing`.
 
+</Syntax>
+
 ## Maps
 
 *Maps* are a data structure which associate values of the same type to

gitlab-pages/docs/reference/current.md

@@ -21,13 +21,13 @@ type timestamp
 A date in the real world.
 
 <SyntaxTitle syntax="pascaligo">
-type mutez
+type tez
 </SyntaxTitle>
 <SyntaxTitle syntax="cameligo">
-type mutez
+type tez
 </SyntaxTitle>
 <SyntaxTitle syntax="reasonligo">
-type mutez
+type tez
 </SyntaxTitle>
 
 A specific type for tokens.
@@ -83,13 +83,13 @@ type chain_id
 The identifier of a chain, used to indicate test or main chains.
 
 <SyntaxTitle syntax="pascaligo">
-function balance : mutez
+function balance : tez
 </SyntaxTitle>
 <SyntaxTitle syntax="cameligo">
-val balance : mutez
+val balance : tez
 </SyntaxTitle>
 <SyntaxTitle syntax="reasonligo">
-let balance: mutez
+let balance: tez
 </SyntaxTitle>
 
 Get the balance for the contract.
@@ -263,13 +263,13 @@ let not_tomorrow: bool = (Tezos.now == in_24_hrs);
 
 
 <SyntaxTitle syntax="pascaligo">
-function amount : mutez
+function amount : tez
 </SyntaxTitle>
 <SyntaxTitle syntax="cameligo">
-val amount : mutez
+val amount : tez
 </SyntaxTitle>
 <SyntaxTitle syntax="reasonligo">
-let amount: mutez
+let amount: tez
 </SyntaxTitle>
 
 Get the amount of tez provided by the sender to complete this

scripts/test_cli.sh

@@ -7,7 +7,7 @@ dry_run_output=$(./scripts/ligo_ci.sh dry-run src/test/contracts/website2.ligo m
 
 expected_compiled_parameter="(Right 1)";
 expected_compiled_storage=1;
-expected_dry_run_output="( list[] , 2 )";
+expected_dry_run_output="( LIST_EMPTY() , 2 )";
 
 if [ "$compiled_storage" != "$expected_compiled_storage" ]; then
     echo "Expected $expected_compiled_storage as compile-storage output, got $compiled_storage instead";

src/bin/expect_tests/contract_tests.ml

@@ -7,13 +7,13 @@ let bad_contract basename =
 
 let%expect_test _ =
   run_ligo_good [ "measure-contract" ; contract "coase.ligo" ; "main" ] ;
-  [%expect {| 1870 bytes |}] ;
+  [%expect {| 1872 bytes |}] ;
 
   run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ;
-  [%expect {| 1324 bytes |}] ;
+  [%expect {| 1294 bytes |}] ;
 
   run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ;
-  [%expect {| 3231 bytes |}] ;
+  [%expect {| 2974 bytes |}] ;
 
   run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ;
   [%expect {| 589 bytes |}] ;
@@ -227,16 +227,17 @@ let%expect_test _ =
                      NIL operation ;
                      SWAP ;
                      CONS ;
-                     DIP { DIP 4 { DUP } ;
+                     DUP ;
-                           DIG 4 ;
+                     DIP { DIP 5 { DUP } ;
-                           DIP 4 { DUP } ;
+                           DIG 5 ;
-                           DIG 4 ;
+                           DIP 5 { DUP } ;
+                           DIG 5 ;
                            DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ;
                            SWAP ;
                            PAIR ;
                            PAIR } ;
                      PAIR ;
-                     DIP { DROP 13 } } ;
+                     DIP { DROP 14 } } ;
                  DIP { DROP } }
                { DUP ;
                  DIP { DIP { DUP } ; SWAP } ;
@@ -312,11 +313,8 @@ let%expect_test _ =
              SWAP ;
              CAR ;
              CDR ;
-             DUP ;
+             DIP { DUP } ;
-             DIP { DIP 2 { DUP } ; DIG 2 } ;
+             SWAP ;
-             PAIR ;
-             DIP { DIP { DUP } ; SWAP } ;
-             PAIR ;
              DIP 3 { DUP } ;
              DIG 3 ;
              CAR ;
@@ -333,31 +331,31 @@ let%expect_test _ =
                          PAIR ;
                          DUP ;
                          CAR ;
-                         CAR ;
+                         CDR ;
                          DIP { DUP } ;
                          SWAP ;
                          CAR ;
-                         CDR ;
+                         CAR ;
                          DIP 2 { DUP } ;
                          DIG 2 ;
                          CDR ;
-                         DIP 2 { DUP } ;
+                         DIP { DUP } ;
-                         DIG 2 ;
+                         SWAP ;
-                         DIP { DIP { DUP } ; SWAP } ;
+                         DIP { DIP 2 { DUP } ; DIG 2 } ;
                          PAIR ;
-                         DIP 3 { DUP } ;
+                         DIP 2 { DUP } ;
-                         DIG 3 ;
+                         DIG 2 ;
                          IF_CONS
-                           { DIP 4 { DUP } ;
+                           { DIP 5 { DUP } ;
-                             DIG 4 ;
+                             DIG 5 ;
                              DIP 4 { DUP } ;
                              DIG 4 ;
                              CAR ;
                              DIP { DIP { DUP } ; SWAP ; HASH_KEY } ;
                              COMPARE ;
                              EQ ;
-                             IF { DIP 5 { DUP } ;
+                             IF { DIP 6 { DUP } ;
-                                  DIG 5 ;
+                                  DIG 6 ;
                                   DIP 2 { DUP } ;
                                   DIG 2 ;
                                   DIP { DIP 5 { DUP } ;
@@ -371,8 +369,8 @@ let%expect_test _ =
                                               PAIR ;
                                               PACK } } ;
                                   CHECK_SIGNATURE ;
-                                  IF { DIP 6 { DUP } ;
+                                  IF { DIP 7 { DUP } ;
-                                       DIG 6 ;
+                                       DIG 7 ;
                                        PUSH nat 1 ;
                                        ADD ;
                                        DIP { DUP } ;
@@ -407,9 +405,10 @@ let%expect_test _ =
                          CAR ;
                          DIP 2 { DUP } ;
                          DIG 2 ;
+                         CAR ;
+                         SWAP ;
                          CDR ;
                          SWAP ;
-                         CAR ;
                          PAIR ;
                          SWAP ;
                          CDR ;
@@ -421,10 +420,9 @@ let%expect_test _ =
                          CAR ;
                          DIP 3 { DUP } ;
                          DIG 3 ;
-                         CAR ;
-                         SWAP ;
                          CDR ;
                          SWAP ;
+                         CAR ;
                          PAIR ;
                          SWAP ;
                          CDR ;
@@ -460,16 +458,14 @@ let%expect_test _ =
                        DIP { DROP 2 } } ;
                   DIP 3 { DUP } ;
                   DIG 3 ;
-                  CAR ;
                   DIP { DUP } ;
-                  PAIR ;
+                  SWAP ;
-                  DIP { DROP 3 } } ;
+                  DIP { DROP 4 } } ;
-             DUP ;
+             DIP 2 { DUP } ;
-             CAR ;
+             DIG 2 ;
-             CAR ;
              UNIT ;
              EXEC ;
-             DIP { DUP ; CDR } ;
+             DIP { DUP } ;
              PAIR ;
              DIP { DROP 7 } } } |} ]
 
@@ -518,19 +514,19 @@ let%expect_test _ =
                      GT ;
                      IF { PUSH string "Message size exceed maximum limit" ; FAILWITH }
                         { PUSH unit Unit } ;
-                     DIP 4 { DUP } ;
-                     DIG 4 ;
                      EMPTY_SET address ;
+                     DUP ;
+                     DIP { DIP 5 { DUP } ; DIG 5 } ;
                      PAIR ;
-                     DIP 2 { DUP } ;
+                     DIP 3 { DUP } ;
-                     DIG 2 ;
+                     DIG 3 ;
-                     DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CDR ; CDR } ;
+                     DIP { DIP 6 { DUP } ; DIG 6 ; CAR ; CDR ; CDR } ;
                      GET ;
                      IF_NONE
-                       { DIP 5 { DUP } ;
+                       { DIP 6 { DUP } ;
-                         DIG 5 ;
-                         DIP 6 { DUP } ;
                          DIG 6 ;
+                         DIP 7 { DUP } ;
+                         DIG 7 ;
                          CDR ;
                          CAR ;
                          CAR ;
@@ -540,7 +536,7 @@ let%expect_test _ =
                          PUSH nat 1 ;
                          ADD ;
                          SOME ;
-                         DIP { DIP 6 { DUP } ; DIG 6 ; CDR ; CAR ; CAR } ;
+                         DIP { DIP 7 { DUP } ; DIG 7 ; CDR ; CAR ; CAR } ;
                          SENDER ;
                          UPDATE ;
                          DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ;
@@ -548,31 +544,33 @@ let%expect_test _ =
                          PAIR ;
                          SWAP ;
                          PAIR ;
-                         DIP { DUP } ;
-                         SWAP ;
-                         CAR ;
-                         DIP { DUP } ;
-                         PAIR ;
                          EMPTY_SET address ;
                          PUSH bool True ;
                          SENDER ;
                          UPDATE ;
+                         DIP 2 { DUP } ;
+                         DIG 2 ;
+                         DIP 2 { DUP } ;
+                         DIG 2 ;
                          SWAP ;
+                         CAR ;
+                         PAIR ;
                          CDR ;
+                         DIP { DUP } ;
                          SWAP ;
                          PAIR ;
-                         DIP { DROP } }
+                         DIP { DROP 2 } }
-                       { DIP 6 { DUP } ;
+                       { DIP 7 { DUP } ;
-                         DIG 6 ;
+                         DIG 7 ;
                          DIP { DUP } ;
                          SWAP ;
                          SENDER ;
                          MEM ;
                          IF { DUP }
-                            { DIP 7 { DUP } ;
+                            { DIP 8 { DUP } ;
-                              DIG 7 ;
-                              DIP 8 { DUP } ;
                               DIG 8 ;
+                              DIP 9 { DUP } ;
+                              DIG 9 ;
                               CDR ;
                               CAR ;
                               CAR ;
@@ -582,7 +580,7 @@ let%expect_test _ =
                               PUSH nat 1 ;
                               ADD ;
                               SOME ;
-                              DIP { DIP 8 { DUP } ; DIG 8 ; CDR ; CAR ; CAR } ;
+                              DIP { DIP 9 { DUP } ; DIG 9 ; CDR ; CAR ; CAR } ;
                               SENDER ;
                               UPDATE ;
                               DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ;
@@ -628,25 +626,21 @@ let%expect_test _ =
                      GT ;
                      IF { PUSH string "Maximum number of proposal reached" ; FAILWITH }
                         { PUSH unit Unit } ;
-                     DIP 8 { DUP } ;
+                     NIL operation ;
-                     DIG 8 ;
+                     DUP ;
                      DIP { DIP 3 { DUP } ; DIG 3 } ;
                      PAIR ;
-                     DIP { DIP 7 { DUP } ; DIG 7 ; NIL operation ; SWAP ; PAIR } ;
+                     DIP 5 { DUP } ;
-                     PAIR ;
+                     DIG 5 ;
-                     DIP { DIP 2 { DUP } ; DIG 2 } ;
-                     PAIR ;
-                     DIP 4 { DUP } ;
-                     DIG 4 ;
                      SIZE ;
-                     DIP { DIP 3 { DUP } ; DIG 3 ; CDR ; CDR } ;
+                     DIP { DIP 4 { DUP } ; DIG 4 ; CDR ; CDR } ;
                      COMPARE ;
                      GE ;
-                     IF { DIP 3 { DUP } ;
+                     IF { DIP 4 { DUP } ;
-                          DIG 3 ;
+                          DIG 4 ;
-                          DIP 9 { DUP } ;
+                          DIP 11 { DUP } ;
-                          DIG 9 ;
+                          DIG 11 ;
-                          DIP { DIP 4 { DUP } ; DIG 4 ; CAR ; CDR ; CDR ; NONE (set address) } ;
+                          DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CDR ; CDR ; NONE (set address) } ;
                           UPDATE ;
                           DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ;
                           SWAP ;
@@ -658,7 +652,7 @@ let%expect_test _ =
                           CDR ;
                           CAR ;
                           CDR ;
-                          DIP { DIP 10 { DUP } ; DIG 10 } ;
+                          DIP { DIP 12 { DUP } ; DIG 12 } ;
                           EXEC ;
                           DIP { DUP } ;
                           SWAP ;
@@ -667,7 +661,7 @@ let%expect_test _ =
                           CDR ;
                           CAR ;
                           CDR ;
-                          DIP { DIP 11 { DUP } ; DIG 11 } ;
+                          DIP { DIP 13 { DUP } ; DIG 13 } ;
                           CONCAT ;
                           SHA256 ;
                           DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CAR } ;
@@ -689,32 +683,26 @@ let%expect_test _ =
                                  SWAP ;
                                  CDR ;
                                  CAR ;
-                                 DIP 2 { DUP } ;
-                                 DIG 2 ;
-                                 CDR ;
-                                 CDR ;
                                  DIP { DUP } ;
                                  SWAP ;
                                  DIP { DUP } ;
-                                 PAIR ;
+                                 SWAP ;
-                                 DIP { DIP 2 { DUP } ; DIG 2 } ;
-                                 PAIR ;
-                                 DIP 2 { DUP } ;
-                                 DIG 2 ;
                                  DIP { DIP 12 { DUP } ; DIG 12 } ;
                                  MEM ;
-                                 IF { DIP 3 { DUP } ;
+                                 IF { DIP 2 { DUP } ;
-                                      DIG 3 ;
+                                      DIG 2 ;
-                                      DIP 3 { DUP } ;
+                                      DIP 2 { DUP } ;
-                                      DIG 3 ;
+                                      DIG 2 ;
-                                      DIP { DIP 2 { DUP } ;
+                                      DIP { DIP 4 { DUP } ;
-                                            DIG 2 ;
+                                            DIG 4 ;
+                                            CDR ;
+                                            CDR ;
                                             PUSH nat 1 ;
                                             SWAP ;
                                             SUB ;
                                             ABS ;
                                             SOME ;
-                                            DIP { DIP 4 { DUP } ; DIG 4 ; CDR ; CAR ; CAR } } ;
+                                            DIP { DIP 3 { DUP } ; DIG 3 ; CDR ; CAR ; CAR } } ;
                                       UPDATE ;
                                       DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ;
                                       PAIR ;
@@ -723,23 +711,21 @@ let%expect_test _ =
                                       PAIR ;
                                       DIP { DUP } ;
                                       SWAP ;
-                                      CAR ;
                                       DIP { DUP } ;
-                                      PAIR ;
+                                      SWAP ;
-                                      DIP { DROP } }
+                                      DIP { DROP 2 } }
                                     { DUP } ;
+                                 DIP 4 { DUP } ;
+                                 DIG 4 ;
                                  DIP 5 { DUP } ;
                                  DIG 5 ;
-                                 DIP 6 { DUP } ;
-                                 DIG 6 ;
                                  CAR ;
                                  DIP 2 { DUP } ;
                                  DIG 2 ;
-                                 CDR ;
                                  DIP { DROP ; CDR } ;
                                  PAIR ;
                                  CAR ;
-                                 DIP { DROP 6 } } ;
+                                 DIP { DROP 5 } } ;
                           DIP 4 { DUP } ;
                           DIG 4 ;
                           DIP 4 { DUP } ;
@@ -749,12 +735,10 @@ let%expect_test _ =
                           PAIR ;
                           DIP 3 { DUP } ;
                           DIG 3 ;
-                          DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ;
                           SWAP ;
-                          PAIR ;
+                          CDR ;
                           SWAP ;
                           PAIR ;
-                          PAIR ;
                           DIP 2 { DUP } ;
                           DIG 2 ;
                           SWAP ;
@@ -765,14 +749,14 @@ let%expect_test _ =
                           PAIR ;
                           DIP { DROP 4 } }
                         { DUP ;
-                          DIP 4 { DUP } ;
+                          DIP 5 { DUP } ;
-                          DIG 4 ;
+                          DIG 5 ;
-                          DIP 10 { DUP } ;
+                          DIP 12 { DUP } ;
-                          DIG 10 ;
+                          DIG 12 ;
-                          DIP { DIP 6 { DUP } ;
+                          DIP { DIP 7 { DUP } ;
-                                DIG 6 ;
+                                DIG 7 ;
                                 SOME ;
-                                DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CDR ; CDR } } ;
+                                DIP { DIP 6 { DUP } ; DIG 6 ; CAR ; CDR ; CDR } } ;
                           UPDATE ;
                           DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ;
                           SWAP ;
@@ -785,11 +769,9 @@ let%expect_test _ =
                           PAIR } ;
                      DUP ;
                      CAR ;
-                     CDR ;
-                     CDR ;
                      DIP { DUP ; CDR } ;
                      PAIR ;
-                     DIP { DROP 15 } } ;
+                     DIP { DROP 17 } } ;
                  DIP { DROP } }
                { DUP ;
                  DIP { DIP { DUP } ; SWAP } ;
@@ -800,9 +782,8 @@ let%expect_test _ =
                  SWAP ;
                  CAR ;
                  PACK ;
-                 DUP ;
+                 DIP { DUP } ;
-                 DIP { DIP { DUP } ; SWAP } ;
+                 SWAP ;
-                 PAIR ;
                  DIP { DUP } ;
                  SWAP ;
                  DIP { DIP 2 { DUP } ; DIG 2 ; CAR ; CDR ; CDR } ;
@@ -851,12 +832,7 @@ let%expect_test _ =
                           DIP { DROP 2 } }
                         { DUP } ;
                      DUP ;
-                     DIP 3 { DUP } ;
+                     DUP ;
-                     DIG 3 ;
-                     DIP { DIP 6 { DUP } ; DIG 6 } ;
-                     PAIR ;
-                     DIP { DUP } ;
-                     PAIR ;
                      DIP 4 { DUP } ;
                      DIG 4 ;
                      SIZE ;
@@ -878,10 +854,9 @@ let%expect_test _ =
                           PAIR ;
                           DIP { DUP } ;
                           SWAP ;
-                          CAR ;
                           DIP { DUP } ;
-                          PAIR ;
+                          SWAP ;
-                          DIP { DROP } }
+                          DIP { DROP 2 } }
                         { DUP ;
                           DIP 2 { DUP } ;
                           DIG 2 ;
@@ -898,47 +873,15 @@ let%expect_test _ =
                           SWAP ;
                           PAIR ;
                           PAIR ;
-                          SWAP ;
+                          DIP { DROP } } ;
-                          CAR ;
-                          PAIR } ;
                      DIP 7 { DUP } ;
                      DIG 7 ;
                      DIP 3 { DUP } ;
                      DIG 3 ;
+                     DIP { DROP ; DUP } ;
                      SWAP ;
-                     CAR ;
+                     DIP { DROP 8 } } ;
-                     PAIR ;
-                     DIP { DUP } ;
-                     SWAP ;
-                     CAR ;
-                     CDR ;
-                     SWAP ;
-                     CDR ;
-                     SWAP ;
-                     PAIR ;
-                     DIP { DUP } ;
-                     SWAP ;
-                     CDR ;
-                     SWAP ;
-                     CAR ;
-                     PAIR ;
-                     DIP { DUP } ;
-                     SWAP ;
-                     CAR ;
-                     CDR ;
-                     SWAP ;
-                     CDR ;
-                     SWAP ;
-                     PAIR ;
-                     DIP { DUP } ;
-                     SWAP ;
-                     CDR ;
-                     SWAP ;
-                     CAR ;
-                     PAIR ;
-                     DIP { DROP 7 } } ;
                  DUP ;
-                 CDR ;
                  NIL operation ;
                  PAIR ;
                  DIP { DROP 6 } } ;
@@ -1093,11 +1036,11 @@ let%expect_test _ =
 
 let%expect_test _ =
     run_ligo_good [ "dry-run" ; contract "redeclaration.ligo" ; "main" ; "unit" ; "0" ] ;
-    [%expect {|( list[] , 0 ) |}]
+    [%expect {|( LIST_EMPTY() , 0 ) |}]
 
 let%expect_test _ =
     run_ligo_good [ "dry-run" ; contract "double_main.ligo" ; "main" ; "unit" ; "0" ] ;
-    [%expect {|( list[] , 2 ) |}]
+    [%expect {|( LIST_EMPTY() , 2 ) |}]
 
 let%expect_test _ =
   run_ligo_good [ "compile-contract" ; contract "subtle_nontail_fail.mligo" ; "main" ] ;
@@ -1155,7 +1098,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_good [ "dry-run" ; contract "super-counter.mligo" ; "main" ; "test_param" ; "test_storage" ] ;
   [%expect {|
-    ( list[] , 3 ) |}]
+    ( LIST_EMPTY() , 3 ) |}]
 
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "redundant_constructors.mligo" ; "main" ] ;
@@ -1174,7 +1117,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ;
   [%expect {|
-ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#654 = #P in let p = rhs#654.0 in let s = rhs#654.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
+ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#702 = #P in let p = rhs#702.0 in let s = rhs#702.1 in ( LIST_EMPTY() : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
 
 
  If you're not sure how to fix this error, you can
@@ -1187,7 +1130,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8,
 
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ;
   [%expect {|
-ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#657 = #P in let p = rhs#657.0 in let s = rhs#657.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
+ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#705 = #P in let p = rhs#705.0 in let s = rhs#705.1 in ( LIST_EMPTY() : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
 
 
  If you're not sure how to fix this error, you can
@@ -1396,4 +1339,4 @@ let%expect_test _ =
     * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
     * Ask a question on our Discord: https://discord.gg/9rhYaEt
     * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
-    * Check the changelog by running 'ligo changelog' |}]
+    * Check the changelog by running 'ligo changelog' |}]

src/bin/expect_tests/ligo_interpreter_tests.ml

@@ -43,12 +43,12 @@ let%expect_test _ =
     val map_finds = Some(2 : int)
     val map_finds_fail = "failed map find" : failure
     val map_empty = {  ; 0 = ([]) ; 1 = ([]) }
-    val m = [ ; "one" : string -> 1 : int ; "two" : string -> 2 : int ; "three" : string -> 3 : int]
+    val m = [ ; "one" : string -> 1 : int ; "three" : string -> 3 : int ; "two" : string -> 2 : int]
     val map_fold = 4 : int
     val map_iter = unit
-    val map_map = [ ; "one" : string -> 4 : int ; "two" : string -> 5 : int ; "three" : string -> 8 : int]
+    val map_map = [ ; "one" : string -> 4 : int ; "three" : string -> 8 : int ; "two" : string -> 5 : int]
     val map_mem = {  ; 0 = (true) ; 1 = (false) }
-    val map_remove = {  ; 0 = ([ ; "two" : string -> 2 : int ; "three" : string -> 3 : int]) ; 1 = ([ ; "one" : string -> 1 : int ; "two" : string -> 2 : int ; "three" : string -> 3 : int]) }
+    val map_remove = {  ; 0 = ([ ; "three" : string -> 3 : int ; "two" : string -> 2 : int]) ; 1 = ([ ; "one" : string -> 1 : int ; "three" : string -> 3 : int ; "two" : string -> 2 : int]) }
     val map_update = {  ; 0 = ([ ; "one" : string -> 1 : int]) ; 1 = ([]) ; 2 = ([]) ; 3 = ([ ; "one" : string -> 1 : int]) }
     val s = { ; 1 : int ; 2 : int ; 3 : int}
     val set_add = {  ; 0 = ({ ; 1 : int ; 2 : int ; 3 : int}) ; 1 = ({ ; 1 : int ; 2 : int ; 3 : int ; 4 : int}) ; 2 = ({ ; 1 : int}) }

src/bin/expect_tests/typer_error_tests.ml

@@ -175,7 +175,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_good [ "interpret" ; "Set.literal [ (1,(2,3)) ; (2,(3,4)) ]" ; "--syntax=cameligo" ] ;
   [%expect {|
-    set[( 2 , ( 3 , 4 ) ) , ( 1 , ( 2 , 3 ) )] |}];
+    SET_ADD(( 2 , ( 3 , 4 ) ) , SET_ADD(( 1 , ( 2 , 3 ) ) , SET_EMPTY())) |}];
 
   run_ligo_bad [ "interpret" ; "Set.literal [ (1,2,3) ; (2,3,4) ]" ; "--syntax=cameligo" ] ;
   [%expect {|

src/passes/1-parser/pascaligo/Doc/pascaligo.md

@@ -823,7 +823,7 @@ example, in verbose style:
 
     type store is
       record
-        goal     : mutez;               // Millionth of a tez
+        goal     : tez;              
         deadline : timestamp;
         backers  : map (address, nat);
         funded   : bool

src/passes/1-parser/reasonligo/error.messages.checked-in

@@ -2945,7 +2945,7 @@ This is an incorrect let binding.
 Examples of correct let bindings: 
 let a: int = 4;
 let (a: int, b: int) = (1, 2);
-let func = (a: int, b: int) => a + b
+let func = (a: int, b: int) => a + b;
 
 contract: Let Ident WILD
 ##

src/passes/10-interpreter/interpreter.ml

@@ -119,6 +119,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
     | ( C_OR     , [ V_Ct (C_bool a'  ) ; V_Ct (C_bool b'  ) ] ) -> return_ct @@ C_bool   (a' || b')
     | ( C_AND    , [ V_Ct (C_bool a'  ) ; V_Ct (C_bool b'  ) ] ) -> return_ct @@ C_bool   (a' && b')
     | ( C_XOR    , [ V_Ct (C_bool a'  ) ; V_Ct (C_bool b'  ) ] ) -> return_ct @@ C_bool   ( (a' || b') && (not (a' && b')) ) 
+    | ( C_LIST_EMPTY, []) -> ok @@ V_List ([])
     | ( C_LIST_MAP , [ V_Func_val (arg_name, body, env) ; V_List (elts) ] ) ->
       let%bind elts' = bind_map_list
         (fun elt ->
@@ -170,6 +171,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
           eval body env'
         )
         init elts
+    | ( C_MAP_EMPTY , []) -> ok @@ V_Map ([])
     | ( C_MAP_FOLD , [ V_Func_val (arg_name, body, env) ; V_Map kvs ; init ] ) ->
       bind_fold_list
         (fun prev kv ->
@@ -188,6 +190,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
       | "None" -> ok @@ V_Map (List.remove_assoc k kvs)
       | _ -> simple_fail "update without an option"
     )
+    | ( C_SET_EMPTY, []) -> ok @@ V_Set ([])
     | ( C_SET_ADD , [ v ; V_Set l ] ) -> ok @@ V_Set (List.sort_uniq compare (v::l))
     | ( C_SET_FOLD , [ V_Func_val (arg_name, body, env) ; V_Set elts ; init ] ) ->
       bind_fold_list
@@ -289,22 +292,6 @@ and eval : Ast_typed.expression -> env -> value result
       let%bind rhs' = eval rhs env in
       eval let_result (Env.extend env (let_binder,rhs'))
     )
-    | E_map kvlist | E_big_map kvlist ->
-      let%bind kvlist' = bind_map_list
-        (fun kv -> bind_map_pair (fun (el:Ast_typed.expression) -> eval el env) kv)
-        kvlist in
-      ok @@ V_Map kvlist'
-    | E_list expl ->
-      let%bind expl' = bind_map_list
-        (fun (exp:Ast_typed.expression) -> eval exp env)
-        expl in
-      ok @@ V_List expl'
-    | E_set expl ->
-      let%bind expl' = bind_map_list
-        (fun (exp:Ast_typed.expression) -> eval exp env)
-        (List.sort_uniq compare expl)
-      in
-      ok @@ V_Set expl'
     | E_literal l ->
       eval_literal l
     | E_variable var ->
@@ -316,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 { expr ; label} -> (
+    | E_record_accessor { record ; path} -> (
-      let%bind record' = eval expr env in
+      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"
     )
@@ -378,9 +365,6 @@ and eval : Ast_typed.expression -> env -> value result
     )
     | E_recursive {fun_name; fun_type=_; lambda} ->
       ok @@ V_Func_rec (fun_name, lambda.binder, lambda.result, env)
-    | E_look_up _ ->
-      let serr = Format.asprintf "Unsupported construct :\n %a\n" Ast_typed.PP.expression term in
-      simple_fail serr
 
 let dummy : Ast_typed.program -> string result =
   fun prg ->

src/passes/10-transpiler/transpiler.ml

@@ -141,6 +141,8 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
   | T_operator (TC_big_map (key,value)) ->
       let%bind kv' = bind_map_pair transpile_type (key, value) in
       ok (T_big_map kv')
+  | T_operator (TC_map_or_big_map (_,_)) ->
+      fail @@ corner_case ~loc:"transpiler" "TC_map_or_big_map should have been resolved before transpilation"
   | T_operator (TC_list t) ->
       let%bind t' = transpile_type t in
       ok (T_list t')
@@ -170,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
@@ -189,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
@@ -234,7 +236,6 @@ and tree_of_sum : AST.type_expression -> (AST.constructor' * AST.type_expression
 and transpile_annotated_expression (ae:AST.expression) : expression result =
   let%bind tv = transpile_type ae.type_expression in
   let return ?(tv = tv) expr = ok @@ Combinators.Expression.make_tpl (expr, tv) in
-  let f = transpile_annotated_expression in
   let info =
     let title () = "translating expression" in
     let content () = Format.asprintf "%a" Location.pp ae.location in
@@ -289,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
@@ -301,21 +303,21 @@ 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 {expr; label} ->
+  | E_record_accessor {record; path} ->
-      let%bind ty' = transpile_type (get_type_expression expr) in
+      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 (get_type_expression expr) 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
           | `Right -> C_CDR in
         Combinators.Expression.make_tpl (E_constant {cons_name=c;arguments=[pred]} , ty) in
-      let%bind record' = transpile_annotated_expression expr in
+      let%bind record' = transpile_annotated_expression record in
       let expr = List.fold_left aux record' path in
       ok expr
   | E_record_update {record; path; update} -> 
@@ -390,58 +392,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
     transpile_lambda l io
   | E_recursive r ->
     transpile_recursive r
-  | E_list lst -> (
-      let%bind t =
-        trace_strong (corner_case ~loc:__LOC__ "not a list") @@
-        get_t_list tv in
-      let%bind lst' = bind_map_list (transpile_annotated_expression) lst in
-      let aux : expression -> expression -> expression result = fun prev cur ->
-        return @@ E_constant {cons_name=C_CONS;arguments=[cur ; prev]} in
-      let%bind (init : expression) = return @@ E_make_empty_list t in
-      bind_fold_right_list aux init lst'
-    )
-  | E_set lst -> (
-      let%bind t =
-        trace_strong (corner_case ~loc:__LOC__ "not a set") @@
-        get_t_set tv in
-      let%bind lst' = bind_map_list (transpile_annotated_expression) lst in
-      let aux : expression -> expression -> expression result = fun prev cur ->
-        return @@ E_constant {cons_name=C_SET_ADD;arguments=[cur ; prev]} in
-      let%bind (init : expression) = return @@ E_make_empty_set t in
-      bind_fold_list aux init lst'
-    )
-  | E_map m -> (
-      let%bind (src, dst) =
-        trace_strong (corner_case ~loc:__LOC__ "not a map") @@
-        Mini_c.Combinators.get_t_map tv in
-      let aux : expression result -> (AST.expression * AST.expression) -> expression result = fun prev (k, v) ->
-        let%bind prev' = prev in
-        let%bind (k', v') =
-          let v' = e_a_some v ae.environment in
-          bind_map_pair (transpile_annotated_expression) (k , v') in
-        return @@ E_constant {cons_name=C_UPDATE;arguments=[k' ; v' ; prev']}
-      in
-      let init = return @@ E_make_empty_map (src, dst) in
-      List.fold_left aux init m
-    )
-  | E_big_map m -> (
-      let%bind (src, dst) =
-        trace_strong (corner_case ~loc:__LOC__ "not a map") @@
-        Mini_c.Combinators.get_t_big_map tv in
-      let aux : expression result -> (AST.expression * AST.expression) -> expression result = fun prev (k, v) ->
-        let%bind prev' = prev in
-        let%bind (k', v') =
-          let v' = e_a_some v ae.environment in
-          bind_map_pair (transpile_annotated_expression) (k , v') in
-        return @@ E_constant {cons_name=C_UPDATE;arguments=[k' ; v' ; prev']}
-      in
-      let init = return @@ E_make_empty_big_map (src, dst) in
-      List.fold_left aux init m
-    )
-  | E_look_up dsi -> (
-      let%bind (ds', i') = bind_map_pair f dsi in
-      return @@ E_constant {cons_name=C_MAP_FIND_OPT;arguments=[i' ; ds']}
-    )
   | E_matching {matchee=expr; cases=m} -> (
       let%bind expr' = transpile_annotated_expression expr in
       match m with

src/passes/10-transpiler/untranspiler.ml

@@ -151,29 +151,41 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
             ok (e_a_empty_some s')
       )
     | TC_map (k_ty,v_ty)-> (
-        let%bind lst =
+        let%bind map =
           trace_strong (wrong_mini_c_value "map" v) @@
           get_map v in
-        let%bind lst' =
+        let%bind map' =
           let aux = fun (k, v) ->
             let%bind k' = untranspile k k_ty in
             let%bind v' = untranspile v v_ty in
             ok (k', v') in
-          bind_map_list aux lst in
+          bind_map_list aux map in
-        return (E_map lst')
+        let map' = List.sort_uniq compare map' in
+        let aux = fun prev (k, v) ->
+          let (k', v') = (k , v ) in
+          return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
+        in
+        let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
+        bind_fold_right_list aux init map'
       )
     | TC_big_map (k_ty, v_ty) -> (
-        let%bind lst =
+        let%bind big_map =
           trace_strong (wrong_mini_c_value "big_map" v) @@
           get_big_map v in
-        let%bind lst' =
+        let%bind big_map' =
           let aux = fun (k, v) ->
             let%bind k' = untranspile k k_ty in
             let%bind v' = untranspile v v_ty in
             ok (k', v') in
-          bind_map_list aux lst in
+          bind_map_list aux big_map in
-        return (E_big_map lst')
+        let big_map' = List.sort_uniq compare big_map' in
+        let aux = fun prev (k, v) ->
+          return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k ; v ; prev]}
+        in
+        let%bind init = return @@ E_constant {cons_name=C_BIG_MAP_EMPTY;arguments=[]} in
+        bind_fold_right_list aux init big_map'
       )
+    | TC_map_or_big_map (_, _) -> fail @@ corner_case ~loc:"untranspiler" "TC_map_or_big_map t should not be present in mini-c"
     | TC_list ty -> (
         let%bind lst =
           trace_strong (wrong_mini_c_value "list" v) @@
@@ -181,7 +193,10 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
         let%bind lst' =
           let aux = fun e -> untranspile e ty in
           bind_map_list aux lst in
-        return (E_list lst')
+        let aux = fun prev cur ->
+          return @@ E_constant {cons_name=C_CONS;arguments=[cur ; prev]} in
+        let%bind init  = return @@ E_constant {cons_name=C_LIST_EMPTY;arguments=[]} in
+        bind_fold_right_list aux init lst'
       )
     | TC_arrow _ -> (
         let%bind n =
@@ -196,7 +211,11 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
         let%bind lst' =
           let aux = fun e -> untranspile e ty in
           bind_map_list aux lst in
-        return (E_set lst')
+        let lst' = List.sort_uniq compare lst' in
+        let aux = fun prev cur ->
+          return @@ E_constant {cons_name=C_SET_ADD;arguments=[cur ; prev]} in
+        let%bind init = return @@ E_constant {cons_name=C_SET_EMPTY;arguments=[]} in
+        bind_fold_list aux init lst'
       )
     | TC_contract _ ->
       fail @@ bad_untranspile "contract" v
@@ -213,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/11-self_mini_c/helpers.ml

@@ -25,12 +25,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   let%bind init' = f init e in
   match e.content with
   | E_variable _ | E_skip | E_make_none _
-  | E_make_empty_map _
-  | E_make_empty_big_map _
-  | E_make_empty_list _
-  | E_make_empty_set _ -> (
-    ok init'
-  )
   | E_literal _ -> ok init'
   | E_constant (c) -> (
       let%bind res = bind_fold_list self init' c.arguments in
@@ -94,10 +88,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
   let return content = ok { e' with content } in
   match e'.content with
   | E_variable _ | E_literal _ | E_skip | E_make_none _
-  | E_make_empty_map _
+    as em -> return em
-  | E_make_empty_big_map _
-  | E_make_empty_list _
-  | E_make_empty_set _ as em -> return em
   | E_constant (c) -> (
       let%bind lst = bind_map_list self c.arguments in
       return @@ E_constant {cons_name = c.cons_name; arguments = lst}

src/passes/11-self_mini_c/self_mini_c.ml

@@ -47,10 +47,6 @@ let rec is_pure : expression -> bool = fun e ->
   | E_closure _
   | E_skip
   | E_variable _
-  | E_make_empty_map _
-  | E_make_empty_big_map _
-  | E_make_empty_list _
-  | E_make_empty_set _
   | E_make_none _
     -> true
 

src/passes/11-self_mini_c/subst.ml

@@ -40,10 +40,6 @@ let rec replace : expression -> var_name -> var_name -> expression =
   | E_variable z ->
     let z = replace_var z in
     return @@ E_variable z
-  | E_make_empty_map _ -> e
-  | E_make_empty_big_map _ -> e
-  | E_make_empty_list _ -> e
-  | E_make_empty_set _ -> e
   | E_make_none _ -> e
   | E_iterator (name, ((v, tv), body), expr) ->
     let body = replace body in
@@ -175,10 +171,7 @@ let rec subst_expression : body:expression -> x:var_name -> expr:expression -> e
   )
   (* All that follows is boilerplate *)
   | E_literal _ | E_skip | E_make_none _
-  | E_make_empty_map (_,_)
+    as em -> return em
-  | E_make_empty_big_map _
-  | E_make_empty_list _
-  | E_make_empty_set _ as em -> return em
   | E_constant (c) -> (
       let lst = List.map self c.arguments in
       return @@ E_constant {cons_name = c.cons_name; arguments = lst }

src/passes/12-compiler/compiler_program.ml

@@ -66,10 +66,25 @@ let rec get_operator : constant' -> type_value -> expression list -> predicate r
           let%bind m_ty = Compiler_type.type_ ty in
           ok @@ simple_unary @@ prim ~children:[m_ty] I_RIGHT
       )
+      | C_LIST_EMPTY -> (
+          let%bind ty' = Mini_c.get_t_list ty in
+          let%bind m_ty = Compiler_type.type_ ty' in
+          ok @@ simple_constant @@ i_nil m_ty
+        )
       | C_SET_EMPTY -> (
           let%bind ty' = Mini_c.get_t_set ty in
           let%bind m_ty = Compiler_type.type_ ty' in
-          ok @@ simple_constant @@ prim ~children:[m_ty] I_EMPTY_SET
+          ok @@ simple_constant @@ i_empty_set m_ty
+        )
+      | C_MAP_EMPTY -> (
+          let%bind sd = Mini_c.get_t_map ty in
+          let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
+          ok @@ simple_constant @@ i_empty_map src dst
+        )
+      | C_BIG_MAP_EMPTY -> (
+          let%bind sd = Mini_c.get_t_big_map ty in
+          let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
+          ok @@ simple_constant @@ i_empty_big_map src dst
         )
       | C_BYTES_UNPACK -> (
           let%bind ty' = Mini_c.get_t_option ty in
@@ -297,18 +312,6 @@ and translate_expression (expr:expression) (env:environment) : michelson result
         error title content in
       trace error @@
       return code
-  | E_make_empty_map sd ->
-      let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
-      return @@ i_empty_map src dst
-  | E_make_empty_big_map sd ->
-      let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
-      return @@ i_empty_big_map src dst
-  | E_make_empty_list t ->
-      let%bind t' = Compiler_type.type_ t in
-      return @@ i_nil t'
-  | E_make_empty_set t ->
-      let%bind t' = Compiler_type.type_ t in
-      return @@ i_empty_set t'
   | E_make_none o ->
       let%bind o' = Compiler_type.type_ o in
       return @@ i_none o'

src/passes/2-concrete_to_imperative/cameligo.ml

@@ -383,11 +383,10 @@ let rec compile_expression :
         match variables with
         | hd :: [] ->
           if (List.length prep_vars = 1)
-          then e_let_in hd false inline rhs_b_expr body
+          then e_let_in hd inline rhs_b_expr body
-          else e_let_in hd false inline (e_accessor rhs_b_expr (string_of_int ((List.length prep_vars) - 1))) body
+          else e_let_in hd inline (e_accessor rhs_b_expr (string_of_int ((List.length prep_vars) - 1))) body
         | hd :: tl ->
           e_let_in hd
-          false
           inline
           (e_accessor rhs_b_expr (string_of_int ((List.length prep_vars) - (List.length tl) - 1)))
           (chain_let_in tl body)
@@ -408,7 +407,7 @@ let rec compile_expression :
       let%bind ret_expr = if List.length prep_vars = 1
         then ok (chain_let_in prep_vars body)
         (* Bind the right hand side so we only evaluate it once *)
-        else ok (e_let_in (rhs_b, ty_opt) false inline rhs' (chain_let_in prep_vars body))
+        else ok (e_let_in (rhs_b, ty_opt) inline rhs' (chain_let_in prep_vars body))
       in
       let%bind ret_expr = match kwd_rec with 
         | None -> ok @@ ret_expr
@@ -572,7 +571,7 @@ let rec compile_expression :
                   | Raw.PVar y ->
                     let var_name = Var.of_name y.value in
                     let%bind type_expr = compile_type_expression x'.type_expr in
-                    return @@ e_let_in (var_name , Some type_expr) false false e rhs
+                    return @@ e_let_in (var_name , Some type_expr) false e rhs
                   | _ -> default_action ()
                 )
               | _ -> default_action ()

src/passes/2-concrete_to_imperative/dune

@@ -6,7 +6,6 @@
     tezos-utils
     parser
     ast_imperative
-    self_ast_imperative
     operators)
   (modules cameligo pascaligo concrete_to_imperative)
   (preprocess

src/passes/2-concrete_to_imperative/pascaligo.ml

@@ -14,92 +14,6 @@ let pseq_to_list = function
 | Some lst -> npseq_to_list lst
 let get_value : 'a Raw.reg -> 'a = fun x -> x.value
 
-and repair_mutable_variable_in_matching (for_body : expression) (element_names : expression_variable list) (env : expression_variable) =
-  let%bind captured_names = Self_ast_imperative.fold_map_expression
-    (* TODO : these should use Variables sets *)
-    (fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) ->
-      match ass_exp.expression_content with
-        | E_let_in {let_binder;mut=false;rhs;let_result} ->
-          let (name,_) = let_binder in
-          ok (true,(name::decl_var, free_var),e_let_in let_binder false false rhs let_result)
-        | E_let_in {let_binder;mut=true; rhs;let_result} ->
-          let (name,_) = let_binder in
-          if List.mem name decl_var then 
-            ok (true,(decl_var, free_var), e_let_in let_binder false false rhs let_result)
-          else(
-            let free_var = if (List.mem name free_var) then free_var else name::free_var in
-            let expr = e_let_in (env,None) false false (e_update (e_variable env) (Var.to_name name) (e_variable name)) let_result in
-            ok (true,(decl_var, free_var), e_let_in let_binder false  false rhs expr)
-          )
-        | E_variable name ->
-          if List.mem name decl_var || List.mem name free_var || Var.equal name env then 
-            ok (true,(decl_var, free_var), e_variable name)
-          else
-            ok (true, (decl_var, name::free_var), e_variable name)
-        | E_constant {cons_name=C_MAP_FOLD;arguments= _}
-        | E_constant {cons_name=C_SET_FOLD;arguments= _}
-        | E_constant {cons_name=C_LIST_FOLD;arguments= _} 
-        | E_matching _ -> ok @@ (false, (decl_var,free_var),ass_exp)
-      | _ -> ok (true, (decl_var, free_var),ass_exp)
-    )
-      (element_names,[])
-      for_body in
-  ok @@ captured_names
-
-and repair_mutable_variable_in_loops (for_body : expression) (element_names : expression_variable list) (env : expression_variable) =
-  let%bind captured_names = Self_ast_imperative.fold_map_expression
-    (* TODO : these should use Variables sets *)
-    (fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) ->
-      match ass_exp.expression_content with
-        | E_let_in {let_binder;mut=false;rhs;let_result} ->
-          let (name,_) = let_binder in
-          ok (true,(name::decl_var, free_var),e_let_in let_binder false false rhs let_result)
-        | E_let_in {let_binder;mut=true; rhs;let_result} ->
-          let (name,_) = let_binder in
-          if List.mem name decl_var then 
-            ok (true,(decl_var, free_var), e_let_in let_binder false false rhs let_result)
-          else(
-            let free_var = if (List.mem name free_var) then free_var else name::free_var in
-            let expr = e_let_in (env,None) false false (
-              e_update (e_variable env) ("0") 
-              (e_update (e_accessor (e_variable env) "0") (Var.to_name name) (e_variable name))
-              )
-              let_result in
-            ok (true,(decl_var, free_var), e_let_in let_binder false  false rhs expr)
-          )
-        | E_variable name ->
-          if List.mem name decl_var || List.mem name free_var || Var.equal name env then 
-            ok (true,(decl_var, free_var), e_variable name)
-          else
-            ok (true,(decl_var, name::free_var), e_variable name)
-        | E_constant {cons_name=C_MAP_FOLD;arguments= _}
-        | E_constant {cons_name=C_SET_FOLD;arguments= _}
-        | E_constant {cons_name=C_LIST_FOLD;arguments= _} 
-        | E_matching _ -> ok @@ (false,(decl_var,free_var),ass_exp)
-      | _ -> ok (true,(decl_var, free_var),ass_exp)
-    )
-      (element_names,[])
-      for_body in
-  ok @@ captured_names
-
-and store_mutable_variable (free_vars : expression_variable list) =
-  if (List.length free_vars == 0) then
-    e_unit ()
-  else
-    let aux var = (Var.to_name var, e_variable var) in
-    e_record_ez (List.map aux free_vars)
- 
-and restore_mutable_variable (expr : expression->expression) (free_vars : expression_variable list) (env :expression_variable) =
-  let aux (f:expression -> expression) (ev:expression_variable) =
-    ok @@ fun expr -> f (e_let_in (ev,None) true false (e_accessor (e_variable env) (Var.to_name ev)) expr)
-  in
-  let%bind ef = bind_fold_list aux (fun e -> e) free_vars in
-  ok @@ fun expr'_opt -> match expr'_opt with
-  | None -> ok @@ expr (ef (e_skip ()))
-  | Some expr' -> ok @@ expr (ef expr')
- 
-
-
 module Errors = struct
   let unsupported_cst_constr p =
     let title () = "" in
@@ -218,10 +132,10 @@ let r_split = Location.r_split
    [return_statement] is used for non-let-in statements.
  *)
 
-let return_let_in ?loc binder mut inline rhs = ok @@ fun expr'_opt ->
+let return_let_in ?loc binder inline rhs = ok @@ fun expr'_opt ->
   match expr'_opt with
-  | None -> ok @@ e_let_in ?loc binder mut inline rhs (e_skip ())
+  | None -> ok @@ e_let_in ?loc binder inline rhs (e_skip ())
-  | Some expr' -> ok @@ e_let_in ?loc binder mut inline rhs expr'
+  | Some expr' -> ok @@ e_let_in ?loc binder inline rhs expr'
 
 let return_statement expr = ok @@ fun expr'_opt ->
   match expr'_opt with
@@ -433,10 +347,7 @@ let rec compile_expression (t:Raw.expr) : expr result =
       let%bind expr = compile_expression c.test in
       let%bind match_true = compile_expression c.ifso in
       let%bind match_false = compile_expression c.ifnot in
-      let match_expr = e_matching expr ~loc (Match_bool {match_true; match_false}) in
+      return @@ e_matching expr ~loc (Match_bool {match_true; match_false})
-      let env = Var.fresh () in
-      let%bind (_, match_expr) = repair_mutable_variable_in_matching match_expr [] env in
-      return @@ match_expr
 
   | ECase c -> (
       let (c , loc) = r_split c in
@@ -450,10 +361,7 @@ let rec compile_expression (t:Raw.expr) : expr result =
         @@ List.map get_value
         @@ npseq_to_list c.cases.value in
       let%bind cases = compile_cases lst in
-      let match_expr = e_matching ~loc e cases in
+      return @@ e_matching ~loc e cases
-      let env = Var.fresh () in
-      let%bind (_, match_expr) = repair_mutable_variable_in_matching match_expr [] env in
-      return @@ match_expr
     )
   | EMap (MapInj mi)  -> (
       let (mi , loc) = r_split mi in
@@ -615,7 +523,7 @@ and compile_data_declaration : Raw.data_decl -> _ result =
       let name = x.name.value in
       let%bind t = compile_type_expression x.var_type in
       let%bind expression = compile_expression x.init in
-      return_let_in ~loc (Var.of_name name, Some t) false false expression
+      return_let_in ~loc (Var.of_name name, Some t) false expression
   | LocalConst x ->
       let (x , loc) = r_split x in
       let name = x.name.value in
@@ -627,7 +535,7 @@ and compile_data_declaration : Raw.data_decl -> _ result =
         | Some {value; _} ->
            npseq_to_list value.ne_elements
            |> List.exists (fun Region.{value; _} -> value = "\"inline\"")
-      in return_let_in ~loc (Var.of_name name, Some t) false inline expression
+      in return_let_in ~loc (Var.of_name name, Some t) inline expression
   | LocalFun f  ->
       let (f , loc) = r_split f in
       let%bind (binder, expr) = compile_fun_decl ~loc f in
@@ -637,7 +545,7 @@ and compile_data_declaration : Raw.data_decl -> _ result =
         | Some {value; _} ->
            npseq_to_list value.ne_elements
            |> List.exists (fun Region.{value; _} -> value = "\"inline\"")
-      in return_let_in ~loc binder false inline expr
+      in return_let_in ~loc binder inline expr
 
 and compile_param :
       Raw.param_decl -> (string * type_expression) result =
@@ -708,7 +616,7 @@ and compile_fun_decl :
            let expr =
              e_accessor (e_variable arguments_name) (string_of_int i) in
            let type_variable = Some type_expr in
-           let ass = return_let_in (Var.of_name param , type_variable) false inline expr in
+           let ass = return_let_in (Var.of_name param , type_variable) inline expr in
            ass
          in
          bind_list @@ List.mapi aux params in
@@ -771,7 +679,7 @@ and compile_fun_expression :
          let aux = fun i (param, param_type) ->
            let expr = e_accessor (e_variable arguments_name) (string_of_int i) in
            let type_variable = Some param_type in
-           let ass = return_let_in (Var.of_name param , type_variable) false false expr in
+           let ass = return_let_in (Var.of_name param , type_variable) false expr in
            ass
          in
          bind_list @@ List.mapi aux params in
@@ -819,35 +727,6 @@ and compile_statement_list statements =
       hook (compile_data_declaration d :: acc) statements
   in bind_list @@ hook [] (List.rev statements)
 
-and get_case_variables (t:Raw.pattern) : expression_variable list result = 
-  match t with 
-    | PConstr PFalse _ 
-    | PConstr PTrue _ 
-    | PConstr PNone _ -> ok @@ [] 
-    | PConstr PSomeApp v -> (let (_,v) = v.value in get_case_variables (v.value.inside)) 
-    | PConstr PConstrApp v -> (
-      match v.value with
-      | constr, None -> ok @@ [ Var.of_name constr.value]
-      | constr, pat_opt ->
-        let%bind pat =
-          trace_option (unsupported_cst_constr t) @@
-          pat_opt in
-        let pat = npseq_to_list pat.value.inside in
-        let%bind var = bind_map_list get_case_variables pat in
-        ok @@ [Var.of_name constr.value ] @ (List.concat var)
-    )
-    | PList PNil _  -> ok @@ []
-    | PList PCons c -> (
-        match c.value with
-        | a, [(_, b)] ->
-            let%bind a = get_case_variables a in
-            let%bind b = get_case_variables b in
-            ok @@ a@b
-        | _ -> fail @@ unsupported_deep_list_patterns c
-    )
-    | PVar  v -> ok @@ [Var.of_name v.value] 
-    | p -> fail @@ unsupported_cst_constr p
-
 and compile_single_instruction : Raw.instruction -> (_ -> expression result) result =
   fun t ->
   match t with
@@ -877,14 +756,33 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       return_statement @@ e_skip ~loc ()
     )
   | Loop (While l) ->
-      compile_while_loop l.value
+      let (wl, loc) = r_split l in
+      let%bind condition = compile_expression wl.cond in
+      let%bind body = compile_block wl.block.value in
+      let%bind body = body @@ None in
+      return_statement @@ e_while ~loc condition body
   | Loop (For (ForInt fi)) -> (
-      let%bind loop = compile_for_int fi.value in
+      let (fi,loc) = r_split fi in
-      ok loop
+      let binder = Var.of_name fi.assign.value.name.value in
+      let%bind start = compile_expression fi.assign.value.expr in
+      let%bind bound = compile_expression fi.bound in
+      let increment = e_int 1 in
+      let%bind body = compile_block fi.block.value in
+      let%bind body = body @@ None in
+      return_statement @@ e_for ~loc binder start bound increment body
   )
   | Loop (For (ForCollect fc)) ->
-      let%bind loop = compile_for_collect fc.value in
+      let (fc,loc) = r_split fc in
-      ok loop
+      let binder = (Var.of_name fc.var.value, Option.map (fun x -> Var.of_name (snd x:string Raw.reg).value) fc.bind_to) in
+      let%bind collection = compile_expression fc.expr in
+      let collection_type = match fc.collection with
+        | Map _  -> Map
+        | Set _  -> Set
+        | List _ -> List
+      in
+      let%bind body = compile_block fc.block.value in
+      let%bind body = body @@ None in
+      return_statement @@ e_for_each ~loc binder collection collection_type body
   | Cond c -> (
       let (c , loc) = r_split c in
       let%bind expr = compile_expression c.test in
@@ -906,26 +804,10 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
                 compile_block value
             | ShortBlock {value; _} ->
                 compile_statements @@ fst value.inside in
-      let env = Var.fresh () in
       
-      let%bind match_true' = match_true None in
+      let%bind match_true = match_true None in
-      let%bind match_false' = match_false None in
+      let%bind match_false = match_false None in
-      let%bind match_true  = match_true @@ Some (e_variable env) in
+      return_statement @@ e_matching expr ~loc (Match_bool {match_true; match_false})
-      let%bind match_false = match_false @@ Some (e_variable env) in
-
-      let%bind ((_,free_vars_true), match_true) = repair_mutable_variable_in_matching match_true [] env in
-      let%bind ((_,free_vars_false), match_false) = repair_mutable_variable_in_matching match_false [] env in
-      let free_vars = free_vars_true @ free_vars_false in
-      if (List.length free_vars != 0) then 
-        let match_expr  = e_matching expr ~loc (Match_bool {match_true; match_false}) in
-        let return_expr = fun expr ->
-          e_let_in (env,None) false false (store_mutable_variable free_vars) @@
-          e_let_in (env,None) false false match_expr @@
-          expr 
-        in
-        restore_mutable_variable return_expr free_vars env
-      else
-        return_statement @@ e_matching expr ~loc (Match_bool {match_true=match_true'; match_false=match_false'})
     )
   | Assign a -> (
       let (a , loc) = r_split a in
@@ -933,8 +815,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       match a.lhs with
         | Path path -> (
             let (name , path') = compile_path path in
-            let (let_binder, mut, rhs, inline) = e_assign_with_let ~loc name path' value_expr in
+            return_statement @@ e_ez_assign ~loc name path' value_expr
-            return_let_in let_binder mut inline rhs
           )
         | MapPath v -> (
             let v' = v.value in
@@ -947,16 +828,14 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
             in
             let%bind key_expr = compile_expression v'.index.value.inside in
             let expr' = e_map_add key_expr value_expr map in
-            let (let_binder, mut, rhs, inline) = e_assign_with_let ~loc varname path expr' in
+            return_statement @@ e_ez_assign ~loc varname path expr'
-            return_let_in let_binder mut inline rhs  
           )
     )
   | CaseInstr c -> (
       let (c , loc) = r_split c in
       let%bind expr = compile_expression c.expr in
-      let env = Var.fresh () in
+      let%bind cases =
-      let%bind (fv,cases) =
+        let aux (x : Raw.if_clause Raw.case_clause Raw.reg) =
-        let aux fv (x : Raw.if_clause Raw.case_clause Raw.reg) =
           let%bind case_clause =
             match x.value.rhs with
               ClauseInstr i ->
@@ -967,28 +846,13 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
                     compile_block value
                 | ShortBlock {value; _} ->
                   compile_statements @@ fst value.inside in
-          let%bind case_clause'= case_clause @@ None in
+          let%bind case_clause = case_clause None in
-          let%bind case_clause = case_clause @@ Some(e_variable env) in
+          ok (x.value.pattern, case_clause) in
-          let%bind case_vars   = get_case_variables x.value.pattern in
+        bind_list
-          let%bind ((_,free_vars), case_clause) = repair_mutable_variable_in_matching case_clause case_vars env in
+        @@ List.map aux
-          ok (free_vars::fv,(x.value.pattern, case_clause, case_clause')) in
+        @@ npseq_to_list c.cases.value in
-        bind_fold_map_list aux [] (npseq_to_list c.cases.value) in
+      let%bind m = compile_cases cases in
-      let free_vars = List.concat fv in
+      return_statement @@ e_matching ~loc expr m
-      if (List.length free_vars == 0) then (
-        let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in
-        let%bind m = compile_cases cases in
-        return_statement @@ e_matching ~loc expr m
-      ) else (
-        let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in
-        let%bind m = compile_cases cases in
-        let match_expr = e_matching ~loc expr m in
-        let return_expr = fun expr ->
-          e_let_in (env,None) false false (store_mutable_variable free_vars) @@
-          e_let_in (env,None) false false match_expr @@
-          expr 
-        in
-        restore_mutable_variable return_expr free_vars env
-      )
     )
   | RecordPatch r -> (
       let reg = r.region in
@@ -1004,9 +868,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       let u : Raw.update = {record=r.path;kwd_with=r.kwd_with; updates=update} in
       let%bind expr = compile_update {value=u;region=reg} in
       let (name , access_path) = compile_path r.path in
-      let loc = Some loc in
+       return_statement @@ e_ez_assign ~loc name access_path expr
-      let (binder, mut, rhs, inline) = e_assign_with_let ?loc name access_path expr in
-      return_let_in binder mut inline rhs
 
   )
   | MapPatch patch -> (
@@ -1029,8 +891,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
             inj
             (e_accessor_list ~loc (e_variable (Var.of_name name)) access_path)
         in 
-        let (binder, mut, rhs, inline) = e_assign_with_let ~loc name access_path assigns in
+       return_statement @@ e_ez_assign ~loc name access_path assigns
-        return_let_in binder mut inline rhs
     )
   | SetPatch patch -> (
       let (setp, loc) = r_split patch in
@@ -1045,8 +906,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
         let assigns = List.fold_right
           (fun hd s -> e_constant C_SET_ADD [hd ; s])
           inj (e_accessor_list ~loc (e_variable (Var.of_name name)) access_path) in
-        let (binder, mut, rhs, inline) = e_assign_with_let ~loc name access_path assigns in
+       return_statement @@ e_ez_assign ~loc name access_path assigns
-        return_let_in binder mut inline rhs
     )
   | MapRemove r -> (
       let (v , loc) = r_split r in
@@ -1060,8 +920,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       in
       let%bind key' = compile_expression key in
       let expr = e_constant ~loc C_MAP_REMOVE [key' ; map] in
-      let (binder, mut, rhs, inline) = e_assign_with_let ~loc varname path expr in
+       return_statement @@ e_ez_assign ~loc varname path expr
-      return_let_in binder mut inline rhs
     )
   | SetRemove r -> (
       let (set_rm, loc) = r_split r in
@@ -1074,8 +933,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       in
       let%bind removed' = compile_expression set_rm.element in
       let expr = e_constant ~loc C_SET_REMOVE [removed' ; set] in
-      let (binder, mut, rhs, inline) = e_assign_with_let ~loc varname path expr in
+       return_statement @@ e_ez_assign ~loc varname path expr
-      return_let_in binder mut inline rhs
     )
 
 and compile_path : Raw.path -> string * string list = fun p ->
@@ -1204,121 +1062,6 @@ and compile_statements : Raw.statements -> (_ -> expression result) result =
 and compile_block : Raw.block -> (_ -> expression result) result =
   fun t -> compile_statements t.statements
 
-and compile_while_loop : Raw.while_loop -> (_ -> expression result) result = fun wl ->
-  let env_rec = Var.fresh () in
-  let binder  = Var.fresh () in
-
-  let%bind cond = compile_expression wl.cond in
-  let ctrl = 
-    (e_variable binder)
-  in
-
-  let%bind for_body = compile_block wl.block.value in
-  let%bind for_body = for_body @@ Some( ctrl ) in
-  let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [] binder in
-
-  let aux name expr=
-    e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr
-  in
-  let init_rec = e_tuple [store_mutable_variable @@ captured_name_list] in
-  let restore = fun expr -> List.fold_right aux captured_name_list expr in
-  let continue_expr = e_constant C_FOLD_CONTINUE [for_body] in
-  let stop_expr = e_constant C_FOLD_STOP [e_variable binder] in
-  let aux_func = 
-    e_lambda binder None None @@ 
-    restore @@
-    e_cond cond continue_expr stop_expr in
-  let loop = e_constant C_FOLD_WHILE [aux_func; e_variable env_rec] in
-  let return_expr = fun expr -> 
-    e_let_in (env_rec,None) false false init_rec @@
-    e_let_in (env_rec,None) false false loop @@
-    e_let_in (env_rec,None) false false (e_accessor (e_variable env_rec) "0") @@
-    expr
-  in
-  restore_mutable_variable return_expr captured_name_list env_rec 
-
-
-and compile_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
-  let env_rec = Var.fresh () in
-  let binder  = Var.fresh () in
-  let name = fi.assign.value.name.value in
-  let it = Var.of_name name in
-  let var = e_variable it in
-  (*Make the cond and the step *)
-  let%bind value = compile_expression fi.assign.value.expr in
-  let%bind bound = compile_expression fi.bound in
-  let cond = e_annotation (e_constant C_LE [var ; bound]) t_bool in
-  let step = e_int 1 in
-  let continue_expr = e_constant C_FOLD_CONTINUE [(e_variable binder)] in
-  let ctrl = 
-    e_let_in (it,Some t_int) false false (e_constant C_ADD [ var ; step ]) @@
-    e_let_in (binder, None) false false (e_update (e_variable binder) "1" var)@@
-    continue_expr
-  in
-  (* Modify the body loop*)
-  let%bind for_body = compile_block fi.block.value in
-  let%bind for_body = for_body @@ Some ctrl in
-  let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [it] binder in
-
-  let aux name expr=
-    e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr
-  in
-
-  (* restores the initial value of the free_var*)
-  let restore = fun expr -> List.fold_right aux captured_name_list expr in
-
-  (*Prep the lambda for the fold*)
-  let stop_expr = e_constant C_FOLD_STOP [e_variable binder] in
-  let aux_func = e_lambda binder None None @@ 
-                 e_let_in (it,Some t_int) false false (e_accessor (e_variable binder) "1") @@
-                 e_cond cond (restore for_body) (stop_expr) in
-
-  (* Make the fold_while en precharge the vakye *)
-  let loop = e_constant C_FOLD_WHILE [aux_func; e_variable env_rec] in
-  let init_rec = e_pair (store_mutable_variable @@ captured_name_list) var in
-
-  let return_expr = fun expr -> 
-    e_let_in (it, Some t_int) false false value @@ 
-    e_let_in (env_rec,None) false false init_rec @@
-    e_let_in (env_rec,None) false false loop @@
-    e_let_in (env_rec,None) false false (e_accessor (e_variable env_rec) "0") @@
-    expr
-  in
-  restore_mutable_variable return_expr captured_name_list env_rec 
-
-and compile_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc ->
-  let binder = Var.of_name "arguments" in
-  let%bind element_names = ok @@ match fc.bind_to with
-    | Some v -> [Var.of_name fc.var.value;Var.of_name (snd v).value]
-    | None -> [Var.of_name fc.var.value] in
-  
-  let env = Var.fresh () in
-  let%bind for_body = compile_block fc.block.value in
-  let%bind for_body = for_body @@ Some (e_accessor (e_variable binder) "0") in
-  let%bind ((_,free_vars), for_body) = repair_mutable_variable_in_loops for_body element_names binder in
-
-  let init_record = store_mutable_variable free_vars in
-  let%bind collect = compile_expression fc.expr in
-  let aux name expr=
-    e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr
-  in
-  let restore = fun expr -> List.fold_right aux free_vars expr in
-  let restore = match fc.collection with
-    | Map _ -> (match fc.bind_to with 
-      | Some v -> fun expr -> restore (e_let_in (Var.of_name  fc.var.value, None) false false (e_accessor (e_accessor (e_variable binder) "1") "0") 
-                                    (e_let_in (Var.of_name (snd v).value, None) false false (e_accessor (e_accessor (e_variable binder) "1") "1") expr))
-      | None -> fun expr -> restore (e_let_in (Var.of_name  fc.var.value, None) false false (e_accessor (e_accessor (e_variable binder) "1") "0") expr) 
-    )
-    | _ -> fun expr -> restore (e_let_in (Var.of_name fc.var.value, None) false false (e_accessor (e_variable binder) "1") expr)
-  in
-  let lambda = e_lambda binder None None (restore for_body) in
-  let op_name = match fc.collection with
-   | Map _ -> C_MAP_FOLD | Set _ -> C_SET_FOLD | List _ -> C_LIST_FOLD in
-  let fold = fun expr -> 
-    e_let_in (env,None) false false (e_constant op_name [lambda; collect ; init_record]) @@
-    expr
-  in
-  restore_mutable_variable fold free_vars env
 
 and compile_declaration_list declarations : declaration Location.wrap list result =
   let open Raw 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

@@ -47,8 +47,25 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = fold_expression self res update in
     ok res 
   )
-  | E_record_accessor {expr} -> (
+  | E_record_accessor {record} -> (
-     let%bind res = self init' expr in
+     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 } -> (
@@ -59,10 +76,30 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   | E_recursive { lambda={result=e;_}; _} ->
       let%bind res = self init' e in
       ok res
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind res = self init' condition in
+      let%bind res = self res then_clause in
+      let%bind res = self res else_clause in
+      ok res
   | E_sequence {expr1;expr2} ->
       let ab = (expr1,expr2) in
       let%bind res = bind_fold_pair self init' ab in
       ok res
+  | E_assign {variable=_;access_path=_;expression} ->
+      let%bind res = self init' expression in
+      ok res
+  | E_for {body; _} ->
+      let%bind res = self init' body in
+      ok res
+  | E_for_each {collection; body; _} ->
+      let%bind res = self init' collection in
+      let%bind res = self res body in
+      ok res
+  | E_while {condition; body} ->
+      let%bind res = self init' condition in
+      let%bind res = self res body in
+      ok res  
+
      
 
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
@@ -134,8 +171,8 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       return @@ E_matching {matchee=e';cases=cases'}
     )
   | E_record_accessor acc -> (
-      let%bind e' = self acc.expr in
+      let%bind e' = self acc.record in
-      return @@ E_record_accessor {acc with expr = e'}
+      return @@ E_record_accessor {acc with record = e'}
     )
   | E_record m -> (
     let%bind m' = bind_map_lmap self m in
@@ -146,6 +183,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'}
@@ -155,10 +205,10 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind (lamb,args) = bind_map_pair self ab in
       return @@ E_application {lamb;args}
     )
-  | E_let_in { let_binder ; mut; rhs ; let_result; inline } -> (
+  | E_let_in { let_binder ; rhs ; let_result; inline } -> (
       let%bind rhs = self rhs in
       let%bind let_result = self let_result in
-      return @@ E_let_in { let_binder ; mut; rhs ; let_result; inline }
+      return @@ E_let_in { let_binder ; rhs ; let_result; inline }
     )
   | E_lambda { binder ; input_type ; output_type ; result } -> (
       let%bind result = self result in
@@ -172,16 +222,37 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind args = bind_map_list self c.arguments in
       return @@ E_constant {c with arguments=args}
     )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind condition   = self condition in
+      let%bind then_clause = self then_clause in
+      let%bind else_clause = self else_clause in
+      return @@ E_cond {condition;then_clause;else_clause}
   | E_sequence {expr1;expr2} -> (
       let%bind (expr1,expr2) = bind_map_pair self (expr1,expr2) in
       return @@ E_sequence {expr1;expr2}
     )
+  | E_assign {variable;access_path;expression} -> (
+      let%bind expression = self expression in
+      return @@ E_assign {variable;access_path;expression}
+  )
+  | E_for {binder; start; final; increment; body} ->
+      let%bind body = self body in
+      return @@ E_for {binder; start; final; increment; body}
+  | E_for_each {binder; collection; collection_type; body} ->
+      let%bind collection = self collection in
+      let%bind body = self body in
+      return @@ E_for_each {binder; collection; collection_type; body}
+  | E_while {condition; body} ->
+      let%bind condition = self condition in
+      let%bind body = self body in
+      return @@ E_while {condition; body}
+
   | 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 +260,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
@@ -280,8 +354,8 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       ok (res, return @@ E_matching {matchee=e';cases=cases'})
     )
   | E_record_accessor acc -> (
-      let%bind (res, e') = self init' acc.expr in
+      let%bind (res, e') = self init' acc.record in
-      ok (res, return @@ E_record_accessor {acc with expr = e'})
+      ok (res, return @@ E_record_accessor {acc with record = e'})
     )
   | 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
@@ -293,6 +367,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'})
@@ -302,10 +389,10 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in
       ok (res, return @@ E_application {lamb=a;args=b})
     )
-  | E_let_in { let_binder ; mut; rhs ; let_result; inline } -> (
+  | E_let_in { let_binder ; rhs ; let_result; inline } -> (
       let%bind (res,rhs) = self init' rhs in
       let%bind (res,let_result) = self res let_result in
-      ok (res, return @@ E_let_in { let_binder ; mut; rhs ; let_result ; inline })
+      ok (res, return @@ E_let_in { let_binder ; rhs ; let_result ; inline })
     )
   | E_lambda { binder ; input_type ; output_type ; result } -> (
       let%bind (res,result) = self init' result in
@@ -319,10 +406,29 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,args) = bind_fold_map_list self init' c.arguments in
       ok (res, return @@ E_constant {c with arguments=args})
     )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind res,condition   = self init' condition in
+      let%bind res,then_clause = self res then_clause in
+      let%bind res,else_clause = self res else_clause in
+      ok (res, return @@ E_cond {condition;then_clause;else_clause})
   | E_sequence {expr1;expr2} -> (
       let%bind (res,(expr1,expr2)) = bind_fold_map_pair self init' (expr1,expr2) in
       ok (res, return @@ E_sequence {expr1;expr2})
     )
+  | E_assign {variable;access_path;expression} ->
+      let%bind (res, expression) = self init' expression in
+      ok (res, return @@ E_assign {variable;access_path;expression})
+  | E_for {binder; start; final; increment; body} ->
+      let%bind (res, body) = self init' body in
+      ok (res, return @@ E_for {binder; start; final; increment; body})
+  | E_for_each {binder; collection; collection_type; body} ->
+      let%bind res,collection = self init' collection in
+      let%bind res,body = self res body in
+      ok (res, return @@ E_for_each {binder; collection; collection_type; body})
+  | E_while {condition; body} ->
+      let%bind res,condition = self init' condition in
+      let%bind res,body = self res body in
+      ok (res, return @@ E_while {condition; body})
   | E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e')
 
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->

src/passes/4-imperative_to_sugar/dune

@@ -5,6 +5,7 @@
     simple-utils
     ast_imperative
     ast_sugar
+    self_ast_sugar
     proto-alpha-utils
   )
   (preprocess

src/passes/4-imperative_to_sugar/imperative_to_sugar.ml

@@ -2,6 +2,105 @@ module I = Ast_imperative
 module O = Ast_sugar
 open Trace
 
+module Errors = struct
+  let bad_collection expr =
+    let title () = "" in
+    let message () = Format.asprintf "\nCannot loop over this collection : %a\n" I.PP.expression expr in
+    let data = [
+      ("location",
+      fun () -> Format.asprintf  "%a" Location.pp expr.location)
+    ] in
+    error ~data title message
+end
+
+let rec add_to_end (expression: O.expression) to_add =
+  match expression.expression_content with
+  | O.E_let_in lt -> 
+    let lt = {lt with let_result = add_to_end lt.let_result to_add} in
+    {expression with expression_content = O.E_let_in lt}
+  | O.E_sequence seq -> 
+    let seq = {seq with expr2 = add_to_end seq.expr2 to_add} in
+    {expression with expression_content = O.E_sequence seq}
+  | _ -> O.e_sequence expression to_add
+
+let repair_mutable_variable_in_matching (match_body : O.expression) (element_names : O.expression_variable list) (env : I.expression_variable) =
+  let%bind ((dv,fv),mb) = Self_ast_sugar.fold_map_expression
+    (* TODO : these should use Variables sets *)
+    (fun (decl_var,free_var : O.expression_variable list * O.expression_variable list) (ass_exp : O.expression) ->
+      match ass_exp.expression_content with
+        | E_let_in {let_binder;mut=false;rhs;let_result} ->
+          let (name,_) = let_binder in
+          ok (true,(name::decl_var, free_var),O.e_let_in let_binder false false rhs let_result)
+        | E_let_in {let_binder;mut=true; rhs;let_result} ->
+          let (name,_) = let_binder in
+          if List.mem name decl_var then 
+            ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result)
+          else(
+            let free_var = if (List.mem name free_var) then free_var else name::free_var in
+            let expr = O.e_let_in (env,None) false false (O.e_record_update (O.e_variable env) (Var.to_name name) (O.e_variable name)) let_result in
+            ok (true,(decl_var, free_var), O.e_let_in let_binder false  false rhs expr)
+          )
+        | E_constant {cons_name=C_MAP_FOLD;arguments= _}
+        | E_constant {cons_name=C_SET_FOLD;arguments= _}
+        | E_constant {cons_name=C_LIST_FOLD;arguments= _} 
+        | E_matching _ -> ok @@ (false, (decl_var,free_var),ass_exp)
+      | _ -> ok (true, (decl_var, free_var),ass_exp)
+    )
+      (element_names,[])
+      match_body in
+  ok @@ ((dv,fv),mb)
+
+and repair_mutable_variable_in_loops (for_body : O.expression) (element_names : O.expression_variable list) (env : O.expression_variable) =
+  let%bind ((dv,fv),fb) = Self_ast_sugar.fold_map_expression
+    (* TODO : these should use Variables sets *)
+    (fun (decl_var,free_var : O.expression_variable list * O.expression_variable list) (ass_exp : O.expression) ->
+      (* Format.printf "debug: dv:%a; fv:%a; expr:%a \n%!" 
+        (I.PP.list_sep_d I.PP.expression_variable) decl_var
+        (I.PP.list_sep_d I.PP.expression_variable) decl_var
+        O.PP.expression ass_exp
+      ;*)
+      match ass_exp.expression_content with
+        | E_let_in {let_binder;mut=false;} ->
+          let (name,_) = let_binder in
+          ok (true,(name::decl_var, free_var),ass_exp)
+        | E_let_in {let_binder;mut=true; rhs;let_result} ->
+          let (name,_) = let_binder in
+          if List.mem name decl_var then 
+            ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result)
+          else(
+            let free_var = if (List.mem name free_var) then free_var else name::free_var in
+            let expr = O.e_let_in (env,None) false false (
+              O.e_record_update (O.e_variable env) ("0") 
+              (O.e_record_update (O.e_record_accessor (O.e_variable env) "0") (Var.to_name name) (O.e_variable name))
+              )
+              let_result in
+            ok (true,(decl_var, free_var), O.e_let_in let_binder false  false rhs expr)
+          )
+        | E_constant {cons_name=C_MAP_FOLD;arguments= _}
+        | E_constant {cons_name=C_SET_FOLD;arguments= _}
+        | E_constant {cons_name=C_LIST_FOLD;arguments= _} 
+        | E_matching _ -> ok @@ (false,(decl_var,free_var),ass_exp)
+      | _ -> ok (true,(decl_var, free_var),ass_exp)
+    )
+      (element_names,[])
+      for_body in
+  ok @@ ((dv,fv),fb)
+
+and store_mutable_variable (free_vars : I.expression_variable list) =
+  if (List.length free_vars == 0) then
+    O.e_unit ()
+  else
+    let aux var = (Var.to_name var, O.e_variable var) in
+    O.e_record_ez (List.map aux free_vars)
+ 
+and restore_mutable_variable (expr : O.expression->O.expression_content) (free_vars : O.expression_variable list) (env : O.expression_variable) =
+  let aux (f: O.expression -> O.expression) (ev: O.expression_variable) =
+    fun expr -> f (O.e_let_in (ev,None) true false (O.e_record_accessor (O.e_variable env) (Var.to_name ev)) expr)
+  in
+  let ef = List.fold_left aux (fun e -> e) free_vars in
+  expr (ef (O.e_skip ()))
+
+
 let rec compile_type_expression : I.type_expression -> O.type_expression result =
   fun te ->
   let return te = ok @@ O.make_t te in
@@ -24,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
@@ -79,19 +181,18 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind fun_type = compile_type_expression fun_type in
       let%bind lambda = compile_lambda lambda in
       return @@ O.E_recursive {fun_name;fun_type;lambda}
-    | I.E_let_in {let_binder;mut=_;inline;rhs;let_result} ->
+    | I.E_let_in {let_binder;inline;rhs;let_result} ->
       let (binder,ty_opt) = let_binder in
       let%bind ty_opt = bind_map_option compile_type_expression ty_opt in
       let%bind rhs = compile_expression rhs in
       let%bind let_result = compile_expression let_result in
-      return @@ O.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
+      return @@ O.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result}
     | I.E_constructor {constructor;element} ->
       let%bind element = compile_expression element in
       return @@ O.E_constructor {constructor;element}
-    | I.E_matching {matchee; cases} ->
+    | I.E_matching m ->
-      let%bind matchee = compile_expression matchee in
+      let%bind m = compile_matching m in
-      let%bind cases   = compile_matching cases in
+      return @@ m 
-      return @@ O.E_matching {matchee;cases}
     | I.E_record record ->
       let record = I.LMap.to_kv_list record in
       let%bind record = 
@@ -101,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 {expr;label} ->
+    | I.E_record_accessor {record;path} ->
-      let%bind expr = compile_expression expr in
+      let%bind record = compile_expression record in
-      return @@ O.E_record_accessor {expr;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
@@ -133,46 +234,305 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind anno_expr = compile_expression anno_expr in
       let%bind type_annotation = compile_type_expression type_annotation in
       return @@ O.E_ascription {anno_expr; type_annotation}
+    | I.E_cond {condition;then_clause;else_clause} ->
+      let%bind condition   = compile_expression condition in
+      let%bind then_clause' = compile_expression then_clause in
+      let%bind else_clause' = compile_expression else_clause in
+      let env = Var.fresh () in
+      let%bind ((_,free_vars_true), then_clause) = repair_mutable_variable_in_matching then_clause' [] env in
+      let%bind ((_,free_vars_false), else_clause) = repair_mutable_variable_in_matching else_clause' [] env in
+      let then_clause  = add_to_end then_clause (O.e_variable env) in
+      let else_clause = add_to_end else_clause (O.e_variable env) in
+
+      let free_vars = List.sort_uniq Var.compare @@ free_vars_true @ free_vars_false in
+      if (List.length free_vars != 0) then 
+        let cond_expr  = O.e_cond condition then_clause else_clause in
+        let return_expr = fun expr ->
+          O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars);
+          let_result=O.e_let_in (env,None) false false cond_expr @@
+          expr 
+          }
+        in
+        return @@ restore_mutable_variable return_expr free_vars env
+      else
+        return @@ O.E_cond {condition; then_clause=then_clause'; else_clause=else_clause'}
     | I.E_sequence {expr1; expr2} ->
       let%bind expr1 = compile_expression expr1 in
       let%bind expr2 = compile_expression expr2 in
-      return @@ O.E_sequence {expr1; expr2}
+      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
+    | I.E_for f -> 
+      let%bind f = compile_for f in
+      return @@ f
+    | I.E_for_each fe -> 
+      let%bind fe = compile_for_each fe in
+      return @@ fe
+    | I.E_while w ->
+      let%bind w = compile_while w in
+      return @@ w
+
+and compile_assign {variable; access_path; expression} expr =
+  let accessor ?loc s a =
+    match a with 
+      I.Access_tuple _i -> failwith "adding tuple soon"
+    | I.Access_record a -> ok @@ O.e_record_accessor ?loc s a
+    | I.Access_map k -> 
+      let%bind k = compile_expression k in
+      ok @@ O.e_constant ?loc C_MAP_FIND_OPT [k;s]
+  in
+  let update ?loc (s:O.expression) a e =
+    match a with
+      I.Access_tuple _i -> failwith "adding tuple soon"      
+    | I.Access_record a -> ok @@ O.e_record_update ?loc s a e
+    | I.Access_map k ->
+      let%bind k = compile_expression k in
+      ok @@ O.e_constant ?loc C_UPDATE [k;O.e_some (e);s]
+  in
+  let aux (s, e : O.expression * _) lst =
+    let%bind s' = accessor ~loc:s.location s lst in
+    let e' = fun expr -> 
+      let%bind u = update ~loc:s.location s lst (expr)
+      in e u 
+    in
+    ok @@ (s',e')
+  in
+  let%bind (_,rhs) = bind_fold_list aux (O.e_variable variable, fun e -> ok @@ e) access_path in
+  let%bind expression = compile_expression expression in
+  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
     let%bind output_type = bind_map_option compile_type_expression output_type in
     let%bind result = compile_expression result in
     ok @@ O.{binder;input_type;output_type;result}
-and compile_matching : I.matching_expr -> O.matching_expr result =
+
-  fun m -> 
+and compile_matching : I.matching -> O.expression_content result =
-  match m with 
+  fun {matchee;cases} ->
+  let%bind matchee = compile_expression matchee in
+  match cases with 
     | I.Match_bool {match_true;match_false} ->
-      let%bind match_true = compile_expression match_true in
+      let%bind match_true' = compile_expression match_true in
-      let%bind match_false = compile_expression match_false in
+      let%bind match_false' = compile_expression match_false in
-      ok @@ O.Match_bool {match_true;match_false}
+      let env = Var.fresh () in
-    | I.Match_list {match_nil;match_cons} ->
+      let%bind ((_,free_vars_true), match_true) = repair_mutable_variable_in_matching match_true' [] env in
-      let%bind match_nil = compile_expression match_nil in
+      let%bind ((_,free_vars_false), match_false) = repair_mutable_variable_in_matching match_false' [] env in
-      let (hd,tl,expr,tv) = match_cons in
+      let match_true  = add_to_end match_true (O.e_variable env) in
-      let%bind expr = compile_expression expr in
+      let match_false = add_to_end match_false (O.e_variable env) in
-      ok @@ O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+
+      let free_vars = List.sort_uniq Var.compare @@ free_vars_true @ free_vars_false in
+      if (List.length free_vars != 0) then 
+        let match_expr  = O.e_matching matchee (O.Match_bool {match_true; match_false}) in
+        let return_expr = fun expr ->
+          O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars);
+          let_result=O.e_let_in (env,None) false false match_expr @@
+          expr 
+          }
+        in
+        ok @@ restore_mutable_variable return_expr free_vars env
+      else
+        ok @@ O.E_matching {matchee;cases=O.Match_bool {match_true=match_true';match_false=match_false'}}
     | I.Match_option {match_none;match_some} ->
-      let%bind match_none = compile_expression match_none in
+      let%bind match_none' = compile_expression match_none in
       let (n,expr,tv) = match_some in
-      let%bind expr = compile_expression expr in
+      let%bind expr' = compile_expression expr in
-      ok @@ O.Match_option {match_none; match_some=(n,expr,tv)}
+      let env = Var.fresh () in
+      let%bind ((_,free_vars_none), match_none) = repair_mutable_variable_in_matching match_none' [] env in
+      let%bind ((_,free_vars_some), expr) = repair_mutable_variable_in_matching expr' [n] env in
+      let match_none = add_to_end match_none (O.e_variable env) in
+      let expr       = add_to_end expr (O.e_variable env) in
+      let free_vars = List.sort_uniq Var.compare @@ free_vars_none @ free_vars_some in
+      if (List.length free_vars != 0) then
+        let match_expr  = O.e_matching matchee (O.Match_option {match_none; match_some=(n,expr,tv)}) in
+        let return_expr = fun expr ->
+          O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars);
+          let_result=O.e_let_in (env,None) false false match_expr @@
+          expr 
+          }
+        in
+        ok @@ restore_mutable_variable return_expr free_vars env
+      else
+        ok @@ O.E_matching {matchee; cases=O.Match_option {match_none=match_none'; match_some=(n,expr',tv)}}
+    | I.Match_list {match_nil;match_cons} ->
+      let%bind match_nil' = compile_expression match_nil in
+      let (hd,tl,expr,tv) = match_cons in
+      let%bind expr' = compile_expression expr in
+      let env = Var.fresh () in
+      let%bind ((_,free_vars_nil), match_nil) = repair_mutable_variable_in_matching match_nil' [] env in
+      let%bind ((_,free_vars_cons), expr) = repair_mutable_variable_in_matching expr' [hd;tl] env in
+      let match_nil = add_to_end match_nil (O.e_variable env) in
+      let expr       = add_to_end expr (O.e_variable env) in
+      let free_vars = List.sort_uniq Var.compare @@ free_vars_nil @ free_vars_cons in
+      if (List.length free_vars != 0) then
+        let match_expr  = O.e_matching matchee (O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}) in
+        let return_expr = fun expr ->
+          O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars);
+          let_result=O.e_let_in (env,None) false false match_expr @@
+          expr 
+          }
+        in
+        ok @@ restore_mutable_variable return_expr free_vars env
+      else
+        ok @@ O.E_matching {matchee;cases=O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr',tv)}}
     | I.Match_tuple ((lst,expr), tv) ->
       let%bind expr = compile_expression expr in
-      ok @@ O.Match_tuple ((lst,expr), tv)
+      ok @@ O.E_matching {matchee; cases=O.Match_tuple ((lst,expr), tv)}
     | I.Match_variant (lst,tv) ->
-      let%bind lst = bind_map_list (
+      let env = Var.fresh () in
-        fun ((c,n),expr) ->
+      let aux fv ((c,n),expr) =
-          let%bind expr = compile_expression expr in
+        let%bind expr = compile_expression expr in
-          ok @@ ((c,n),expr)
+        let%bind ((_,free_vars), case_clause) = repair_mutable_variable_in_matching expr [n] env in
-      ) lst 
+        let case_clause'= expr in
-      in
+        let case_clause = add_to_end case_clause (O.e_variable env) in
-      ok @@ O.Match_variant (lst,tv)
+        ok (free_vars::fv,((c,n), case_clause, case_clause')) in
+      let%bind (fv,cases) = bind_fold_map_list aux [] lst in
+      let free_vars = List.sort_uniq Var.compare @@ List.concat fv in
+      if (List.length free_vars == 0) then (
+        let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in
+        ok @@ O.E_matching{matchee; cases=O.Match_variant (cases,tv)}
+      ) else (
+        let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in
+        let match_expr = O.e_matching matchee @@ O.Match_variant (cases,tv) in
+        let return_expr = fun expr ->
+          O.E_let_in {let_binder=(env,None); mut=false; inline=false; rhs=(store_mutable_variable free_vars);
+          let_result=O.e_let_in (env,None) false false match_expr @@
+          expr 
+          }
+        in
+        ok @@ restore_mutable_variable return_expr free_vars env
+      )
  
+and compile_while I.{condition;body} =
+  let env_rec = Var.fresh () in
+  let binder  = Var.fresh () in
+
+  let%bind cond = compile_expression condition in
+  let ctrl = 
+    (O.e_variable binder)
+  in
+
+  let%bind for_body = compile_expression body in
+  let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [] binder in
+  let for_body = add_to_end for_body ctrl in
+
+  let aux name expr=
+    O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable binder) "0") (Var.to_name name)) expr
+  in
+  let init_rec = O.e_tuple [store_mutable_variable @@ captured_name_list] in
+  let restore = fun expr -> List.fold_right aux captured_name_list expr in
+  let continue_expr = O.e_constant C_FOLD_CONTINUE [for_body] in
+  let stop_expr = O.e_constant C_FOLD_STOP [O.e_variable binder] in
+  let aux_func = 
+    O.e_lambda binder None None @@ 
+    restore @@
+    O.e_cond cond continue_expr stop_expr in
+  let loop = O.e_constant C_FOLD_WHILE [aux_func; O.e_variable env_rec] in
+  let let_binder = (env_rec,None) in
+  let return_expr = fun expr -> 
+    O.E_let_in {let_binder; mut=false; inline=false; rhs=init_rec; let_result=
+    O.e_let_in let_binder false false loop @@
+    O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) "0") @@
+    expr
+    }
+  in
+  ok @@ restore_mutable_variable return_expr captured_name_list env_rec 
+
+
+and compile_for I.{binder;start;final;increment;body} =
+  let env_rec = Var.fresh () in
+  (*Make the cond and the step *)
+  let cond = I.e_annotation (I.e_constant C_LE [I.e_variable binder ; final]) I.t_bool in
+  let%bind cond = compile_expression cond in
+  let%bind step = compile_expression increment in
+  let continue_expr = O.e_constant C_FOLD_CONTINUE [(O.e_variable env_rec)] in
+  let ctrl = 
+    O.e_let_in (binder,Some O.t_int) false false (O.e_constant C_ADD [ O.e_variable binder ; step ]) @@
+    O.e_let_in (env_rec, None) false false (O.e_record_update (O.e_variable env_rec) "1" @@ O.e_variable binder)@@
+    continue_expr
+  in
+  (* Modify the body loop*)
+  let%bind body = compile_expression body in
+  let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops body [binder] env_rec in
+  let for_body = add_to_end for_body ctrl in
+
+  let aux name expr=
+    O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable env_rec) "0") (Var.to_name name)) expr
+  in
+
+  (* restores the initial value of the free_var*)
+  let restore = fun expr -> List.fold_right aux captured_name_list expr in
+
+  (*Prep the lambda for the fold*)
+  let stop_expr = O.e_constant C_FOLD_STOP [O.e_variable env_rec] in
+  let aux_func = O.e_lambda env_rec None None @@ 
+                 O.e_let_in (binder,Some O.t_int) false false (O.e_record_accessor (O.e_variable env_rec) "1") @@
+                 O.e_cond cond (restore for_body) (stop_expr) in
+
+  (* Make the fold_while en precharge the vakye *)
+  let loop = O.e_constant C_FOLD_WHILE [aux_func; O.e_variable env_rec] in
+  let init_rec = O.e_pair (store_mutable_variable captured_name_list) @@ O.e_variable binder in
+  
+  let%bind start = compile_expression start in
+  let let_binder = (env_rec,None) in
+  let return_expr = fun expr -> 
+    O.E_let_in {let_binder=(binder, Some O.t_int);mut=false; inline=false;rhs=start;let_result=
+    O.e_let_in let_binder false false init_rec @@
+    O.e_let_in let_binder false false loop @@
+    O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) "0") @@
+    expr
+    }
+  in
+  ok @@ restore_mutable_variable return_expr captured_name_list env_rec 
+
+and compile_for_each I.{binder;collection;collection_type; body} =
+  let args = Var.fresh () in
+  let%bind element_names = ok @@ match snd binder with
+    | Some v -> [fst binder;v]
+    | None -> [fst binder] 
+  in
+  
+  let env = Var.fresh () in
+  let%bind body = compile_expression body in
+  let%bind ((_,free_vars), body) = repair_mutable_variable_in_loops body element_names args in
+  let for_body = add_to_end body @@ (O.e_record_accessor (O.e_variable args) "0") in
+
+  let init_record = store_mutable_variable free_vars in
+  let%bind collect = compile_expression collection in
+  let aux name expr=
+    O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) "0") (Var.to_name name)) expr
+  in
+  let restore = fun expr -> List.fold_right aux free_vars expr in
+  let restore = match collection_type with
+    | Map -> (match snd binder with 
+      | Some v -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) "1") "0") 
+                                    (O.e_let_in (v, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) "1") "1") expr))
+      | None -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) "1") "0") expr) 
+    )
+    | _ -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_variable args) "1") expr)
+  in
+  let lambda = O.e_lambda args None None (restore for_body) in
+  let%bind op_name = match collection_type with
+   | Map -> ok @@ O.C_MAP_FOLD | Set -> ok @@ O.C_SET_FOLD | List -> ok @@ O.C_LIST_FOLD 
+  in
+  let fold = fun expr -> 
+    O.E_let_in {let_binder=(env,None);mut=false; inline=false;rhs=(O.e_constant op_name [lambda; collect ; init_record]);
+    let_result=expr;}
+  in
+  ok @@ restore_mutable_variable fold free_vars env
 let compile_declaration : I.declaration Location.wrap -> _ =
   fun {wrap_content=declaration;location} ->
   let return decl = ok @@ Location.wrap ~loc:location decl in
@@ -212,6 +572,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
@@ -272,7 +635,7 @@ let rec uncompile_expression : O.expression -> I.expression result =
     let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in
     let%bind rhs = uncompile_expression rhs in
     let%bind let_result = uncompile_expression let_result in
-    return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result}
+    return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
   | O.E_constructor {constructor;element} ->
     let%bind element = uncompile_expression element in
     return @@ I.E_constructor {constructor;element}
@@ -289,13 +652,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 {expr;label} ->
+  | O.E_record_accessor {record;path} ->
-    let%bind expr = uncompile_expression expr in
+    let%bind record = uncompile_expression record in
-    return @@ I.E_record_accessor {expr;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
@@ -321,6 +694,11 @@ let rec uncompile_expression : O.expression -> I.expression result =
     let%bind anno_expr = uncompile_expression anno_expr in
     let%bind type_annotation = uncompile_type_expression type_annotation in
     return @@ I.E_ascription {anno_expr; type_annotation}
+  | O.E_cond {condition;then_clause;else_clause} ->
+    let%bind condition   = uncompile_expression condition in
+    let%bind then_clause = uncompile_expression then_clause in
+    let%bind else_clause = uncompile_expression else_clause in
+    return @@ I.E_cond {condition; then_clause; else_clause}
   | O.E_sequence {expr1; expr2} ->
     let%bind expr1 = uncompile_expression expr1 in
     let%bind expr2 = uncompile_expression expr2 in

src/passes/5-self_ast_sugar/helpers.ml

@@ -0,0 +1,417 @@
+open Ast_sugar
+open Trace
+open Stage_common.Helpers
+
+type 'a folder = 'a -> expression -> 'a result
+let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e ->
+  let self = fold_expression f in 
+  let%bind init' = f init e in
+  match e.expression_content with
+  | E_literal _ | E_variable _ | E_skip -> ok init'
+  | E_list lst | E_set lst | E_constant {arguments=lst} -> (
+    let%bind res = bind_fold_list self init' lst in
+    ok res
+  )
+  | E_map lst | E_big_map lst -> (
+    let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
+    ok res
+  )
+  | E_look_up ab ->
+      let%bind res = bind_fold_pair self init' ab in
+      ok res
+  | E_application {lamb;args} -> (
+      let ab = (lamb,args) in
+      let%bind res = bind_fold_pair self init' ab in
+      ok res
+    )
+  | E_lambda { binder = _ ; input_type = _ ; output_type = _ ; result = e }
+  | E_ascription {anno_expr=e; _} | E_constructor {element=e} -> (
+      let%bind res = self init' e in
+      ok res
+    )
+  | E_matching {matchee=e; cases} -> (
+      let%bind res = self init' e in
+      let%bind res = fold_cases f res cases in
+      ok res
+    )
+  | E_record m -> (
+    let aux init'' _ expr =
+      let%bind res = fold_expression self init'' expr in
+      ok res
+    in
+    let%bind res = bind_fold_lmap aux (ok init') m in
+    ok res
+  )
+  | E_record_update {record;update} -> (
+    let%bind res = self init' record in
+    let%bind res = fold_expression self res update in
+    ok res 
+  )
+  | E_record_accessor {record} -> (
+     let%bind res = self init' record 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
+      ok res
+    )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind res = self init' condition in
+      let%bind res = self res then_clause in
+      let%bind res = self res else_clause in
+      ok res
+  | E_recursive { lambda={result=e;_}; _} ->
+      let%bind res = self init' e in
+      ok res
+  | E_sequence {expr1;expr2} ->
+      let ab = (expr1,expr2) in
+      let%bind res = bind_fold_pair self init' ab in
+      ok res
+  | 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 ->
+  match m with
+  | Match_bool { match_true ; match_false } -> (
+      let%bind res = fold_expression f init match_true in
+      let%bind res = fold_expression f res match_false in
+      ok res
+    )
+  | Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
+      let%bind res = fold_expression f init match_nil in
+      let%bind res = fold_expression f res cons in
+      ok res
+    )
+  | Match_option { match_none ; match_some = (_ , some, _) } -> (
+      let%bind res = fold_expression f init match_none in
+      let%bind res = fold_expression f res some in
+      ok res
+    )
+  | Match_tuple ((_ , e), _) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_variant (lst, _) -> (
+      let aux init' ((_ , _) , e) =
+        let%bind res' = fold_expression f init' e in
+        ok res' in
+      let%bind res = bind_fold_list aux init lst in
+      ok res
+    )
+
+type exp_mapper = expression -> expression result
+type ty_exp_mapper = type_expression -> type_expression result
+type abs_mapper =
+  | Expression of exp_mapper
+  | Type_expression of ty_exp_mapper 
+let rec map_expression : exp_mapper -> expression -> expression result = fun f e ->
+  let self = map_expression f in
+  let%bind e' = f e in
+  let return expression_content = ok { e' with expression_content } in
+  match e'.expression_content with
+  | E_list lst -> (
+    let%bind lst' = bind_map_list self lst in
+    return @@ E_list lst'
+  )
+  | E_set lst -> (
+    let%bind lst' = bind_map_list self lst in
+    return @@ E_set lst'
+  )
+  | E_map lst -> (
+    let%bind lst' = bind_map_list (bind_map_pair self) lst in
+    return @@ E_map lst'
+  )
+  | E_big_map lst -> (
+    let%bind lst' = bind_map_list (bind_map_pair self) lst in
+    return @@ E_big_map lst'
+  )
+  | E_look_up ab -> (
+      let%bind ab' = bind_map_pair self ab in
+      return @@ E_look_up ab'
+    )
+  | E_ascription ascr -> (
+      let%bind e' = self ascr.anno_expr in
+      return @@ E_ascription {ascr with anno_expr=e'}
+    )
+  | E_matching {matchee=e;cases} -> (
+      let%bind e' = self e in
+      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 m -> (
+    let%bind m' = bind_map_lmap self m in
+    return @@ E_record m'
+  )
+  | E_record_update {record; path; update} -> (
+    let%bind record = self record in
+    let%bind update = self update in
+    return @@ E_record_update {record;path;update}
+  )
+  | E_constructor c -> (
+      let%bind e' = self c.element in
+      return @@ E_constructor {c with element = e'}
+  )
+  | E_application {lamb;args} -> (
+      let ab = (lamb,args) in
+      let%bind (lamb,args) = bind_map_pair self ab in
+      return @@ E_application {lamb;args}
+    )
+  | E_let_in { let_binder ; mut; rhs ; let_result; inline } -> (
+      let%bind rhs = self rhs in
+      let%bind let_result = self let_result in
+      return @@ E_let_in { let_binder ; mut; rhs ; let_result; inline }
+    )
+  | E_lambda { binder ; input_type ; output_type ; result } -> (
+      let%bind result = self result in
+      return @@ E_lambda { binder ; input_type ; output_type ; result }
+    )
+  | E_recursive { fun_name; fun_type; lambda} ->
+      let%bind result = self lambda.result in
+      let lambda = {lambda with result} in
+      return @@ E_recursive { fun_name; fun_type; lambda}
+  | E_constant c -> (
+      let%bind args = bind_map_list self c.arguments in
+      return @@ E_constant {c with arguments=args}
+    )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind condition   = self condition in
+      let%bind then_clause = self then_clause in
+      let%bind else_clause = self else_clause in
+      return @@ E_cond {condition;then_clause;else_clause}
+  | E_sequence {expr1;expr2} -> (
+      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 { type_content } in
+  match te'.type_content with
+  | T_sum temap ->
+    let%bind temap' = bind_map_cmap self temap in
+    return @@ (T_sum temap')
+  | 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
+    return @@ (T_arrow {type1=type1' ; type2=type2'})
+  | T_operator _
+  | T_variable _ | T_constant _ -> ok te'
+
+and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
+  match m with
+  | Match_bool { match_true ; match_false } -> (
+      let%bind match_true = map_expression f match_true in
+      let%bind match_false = map_expression f match_false in
+      ok @@ Match_bool { match_true ; match_false }
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+      let%bind match_nil = map_expression f match_nil in
+      let%bind cons = map_expression f cons in
+      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, ()) }
+    )
+  | Match_option { match_none ; match_some = (name , some, _) } -> (
+      let%bind match_none = map_expression f match_none in
+      let%bind some = map_expression f some in
+      ok @@ Match_option { match_none ; match_some = (name , some, ()) }
+    )
+  | Match_tuple ((names , e), _) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_tuple ((names , e'), [])
+    )
+  | Match_variant (lst, _) -> (
+      let aux ((a , b) , e) =
+        let%bind e' = map_expression f e in
+        ok ((a , b) , e')
+      in
+      let%bind lst' = bind_map_list aux lst in
+      ok @@ Match_variant (lst', ())
+    )
+
+and map_program : abs_mapper -> program -> program result = fun m p ->
+  let aux = fun (x : declaration) ->
+    match x,m with
+    | (Declaration_constant (t , o , i, e), Expression m') -> (
+        let%bind e' = map_expression m' e in
+        ok (Declaration_constant (t , o , i, e'))
+      )
+    | (Declaration_type (tv,te), Type_expression m') -> (
+        let%bind te' = map_type_expression m' te in
+        ok (Declaration_type (tv, te'))
+      )
+    | decl,_ -> ok decl
+  (* | Declaration_type of (type_variable * type_expression) *)
+  in
+  bind_map_list (bind_map_location aux) p
+
+type 'a fold_mapper = 'a -> expression -> (bool * 'a * expression) result
+let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expression) result = fun f a e ->
+  let self = fold_map_expression f in
+  let%bind (continue, init',e') = f a e in
+  if (not continue) then ok(init',e')
+  else
+  let return expression_content = { e' with expression_content } in
+  match e'.expression_content with
+  | E_list lst -> (
+    let%bind (res, lst') = bind_fold_map_list self init' lst in
+    ok (res, return @@ E_list lst')
+  )
+  | E_set lst -> (
+    let%bind (res, lst') = bind_fold_map_list self init' lst in
+    ok (res, return @@ E_set lst')
+  )
+  | E_map lst -> (
+    let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
+    ok (res, return @@ E_map lst')
+  )
+  | E_big_map lst -> (
+    let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
+    ok (res, return @@ E_big_map lst')
+  )
+  | E_look_up ab -> (
+      let%bind (res, ab') = bind_fold_map_pair self init' ab in
+      ok (res, return @@ E_look_up ab')
+    )
+  | E_ascription ascr -> (
+      let%bind (res,e') = self init' ascr.anno_expr in
+      ok (res, return @@ E_ascription {ascr with anno_expr=e'})
+    )
+  | E_matching {matchee=e;cases} -> (
+      let%bind (res, e') = self init' e in
+      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 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
+    let m' = LMap.of_list lst' in
+    ok (res, return @@ E_record m')
+  )
+  | E_record_update {record; path; update} -> (
+    let%bind (res, record) = self init' record in
+    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'})
+  )
+  | E_application {lamb;args} -> (
+      let ab = (lamb,args) in
+      let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in
+      ok (res, return @@ E_application {lamb=a;args=b})
+    )
+  | E_let_in { let_binder ; mut; rhs ; let_result; inline } -> (
+      let%bind (res,rhs) = self init' rhs in
+      let%bind (res,let_result) = self res let_result in
+      ok (res, return @@ E_let_in { let_binder ; mut; rhs ; let_result ; inline })
+    )
+  | E_lambda { binder ; input_type ; output_type ; result } -> (
+      let%bind (res,result) = self init' result in
+      ok ( res, return @@ E_lambda { binder ; input_type ; output_type ; result })
+    )
+  | E_recursive { fun_name; fun_type; lambda} ->
+      let%bind (res, result) = self init' lambda.result in
+      let lambda = {lambda with result} in
+      ok ( res, return @@ E_recursive { fun_name; fun_type; lambda})
+  | E_constant c -> (
+      let%bind (res,args) = bind_fold_map_list self init' c.arguments in
+      ok (res, return @@ E_constant {c with arguments=args})
+    )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind res,condition   = self init' condition in
+      let%bind res,then_clause = self res then_clause in
+      let%bind res,else_clause = self res else_clause in
+      ok (res, return @@ E_cond {condition;then_clause;else_clause})
+  | E_sequence {expr1;expr2} -> (
+      let%bind (res,(expr1,expr2)) = bind_fold_map_pair self init' (expr1,expr2) in
+      ok (res, return @@ E_sequence {expr1;expr2})
+    )
+  | E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e')
+
+and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
+  match m with
+  | Match_bool { match_true ; match_false } -> (
+      let%bind (init, match_true) = fold_map_expression f init match_true in
+      let%bind (init, match_false) = fold_map_expression f init match_false in
+      ok @@ (init, Match_bool { match_true ; match_false })
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+      let%bind (init, match_nil) = fold_map_expression f init match_nil in
+      let%bind (init, cons) = fold_map_expression f init cons in
+      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, ()) })
+    )
+  | Match_option { match_none ; match_some = (name , some, _) } -> (
+      let%bind (init, match_none) = fold_map_expression f init match_none in
+      let%bind (init, some) = fold_map_expression f init some in
+      ok @@ (init, Match_option { match_none ; match_some = (name , some, ()) })
+    )
+  | Match_tuple ((names , e), _) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_tuple ((names , e'), []))
+    )
+  | Match_variant (lst, _) -> (
+      let aux init ((a , b) , e) =
+        let%bind (init,e') = fold_map_expression f init e in
+        ok (init, ((a , b) , e'))
+      in
+      let%bind (init,lst') = bind_fold_map_list aux init lst in
+      ok @@ (init, Match_variant (lst', ()))
+    )  

src/passes/5-self_ast_sugar/self_ast_sugar.ml

@@ -0,0 +1,25 @@
+open Trace
+
+let all_expression_mapper = [
+]
+
+let all_type_expression_mapper = [
+]
+
+let all_exp = List.map (fun el -> Helpers.Expression el) all_expression_mapper
+let all_ty = List.map (fun el -> Helpers.Type_expression el) all_type_expression_mapper
+
+let all_program =
+  let all_p = List.map Helpers.map_program all_exp in
+  let all_p2 = List.map Helpers.map_program all_ty in
+  bind_chain (List.append all_p all_p2)
+
+let all_expression =
+  let all_p = List.map Helpers.map_expression all_expression_mapper in
+  bind_chain all_p
+
+let map_expression = Helpers.map_expression
+
+let fold_expression = Helpers.fold_expression
+
+let fold_map_expression = Helpers.fold_map_expression

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
@@ -101,43 +108,78 @@ let rec compile_expression : I.expression -> O.expression result =
         ) record
       in
       return @@ O.E_record (O.LMap.of_list record)
-    | I.E_record_accessor {expr;label} ->
+    | I.E_record_accessor {record;path} ->
-      let%bind expr = compile_expression expr in
+      let%bind record = compile_expression record in
-      return @@ O.E_record_accessor {expr;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
       return @@ O.E_record_update {record;path;update}
-    | I.E_map map ->
+    | I.E_map map -> (
-      let%bind map = bind_map_list (
+      let map = List.sort_uniq compare map in
-        bind_map_pair compile_expression
+      let aux = fun prev (k, v) ->
-      ) map
+        let%bind (k', v') = bind_map_pair (compile_expression) (k, v) in
+        return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
       in
-      return @@ O.E_map map
+      let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
-    | I.E_big_map big_map ->
+      bind_fold_right_list aux init map
-      let%bind big_map = bind_map_list (
+    )
-        bind_map_pair compile_expression
+    | I.E_big_map big_map -> (
-      ) big_map
+      let big_map = List.sort_uniq compare big_map in
+      let aux = fun prev (k, v) ->
+        let%bind (k', v') = bind_map_pair (compile_expression) (k, v) in
+        return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
       in
-      return @@ O.E_big_map big_map
+      let%bind init = return @@ E_constant {cons_name=C_BIG_MAP_EMPTY;arguments=[]} in
+      bind_fold_right_list aux init big_map
+    )
     | I.E_list lst ->
-      let%bind lst = bind_map_list compile_expression lst in
+      let%bind lst' = bind_map_list (compile_expression) lst in
-      return @@ O.E_list lst
+      let aux = fun prev cur ->
-    | I.E_set set ->
+        return @@ E_constant {cons_name=C_CONS;arguments=[cur ; prev]} in
-      let%bind set = bind_map_list compile_expression set in
+      let%bind init  = return @@ E_constant {cons_name=C_LIST_EMPTY;arguments=[]} in
-      return @@ O.E_set set 
+      bind_fold_right_list aux init lst'
+    | I.E_set set -> (
+      let%bind lst' = bind_map_list (compile_expression) set in
+      let lst' = List.sort_uniq compare lst' in
+      let aux = fun prev cur ->
+        return @@ E_constant {cons_name=C_SET_ADD;arguments=[cur ; prev]} in
+      let%bind init = return @@ E_constant {cons_name=C_SET_EMPTY;arguments=[]} in
+      bind_fold_list aux init lst'
+      )
     | I.E_look_up look_up ->
-      let%bind look_up = bind_map_pair compile_expression look_up in
+      let%bind (path, index) = bind_map_pair compile_expression look_up in
-      return @@ O.E_look_up look_up
+      return @@ O.E_constant {cons_name=C_MAP_FIND_OPT;arguments=[index;path]}
     | I.E_ascription {anno_expr; type_annotation} ->
       let%bind anno_expr = compile_expression anno_expr in
       let%bind type_annotation = idle_type_expression type_annotation in
       return @@ O.E_ascription {anno_expr; type_annotation}
+    | I.E_cond {condition; then_clause; else_clause} ->
+      let%bind matchee = compile_expression condition in
+      let%bind match_true = compile_expression then_clause in
+      let%bind match_false = compile_expression else_clause in
+      return @@ O.E_matching {matchee; cases=Match_bool{match_true;match_false}}
     | I.E_sequence {expr1; expr2} ->
       let%bind expr1 = compile_expression expr1 in
       let%bind expr2 = compile_expression expr2 in
       return @@ O.E_let_in {let_binder=(Var.of_name "_", Some O.t_unit); rhs=expr1;let_result=expr2; inline=false}
     | I.E_skip -> ok @@ O.e_unit ~loc:e.location ()
+    | 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}->
@@ -244,6 +286,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 _ -> 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)
@@ -277,7 +320,7 @@ let rec uncompile_expression : O.expression -> I.expression result =
     let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in
     let%bind rhs = uncompile_expression rhs in
     let%bind let_result = uncompile_expression let_result in
-    return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
+    return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result}
   | O.E_constructor {constructor;element} ->
     let%bind element = uncompile_expression element in
     return @@ I.E_constructor {constructor;element}
@@ -294,34 +337,13 @@ let rec uncompile_expression : O.expression -> I.expression result =
       ) record
     in
     return @@ I.E_record (O.LMap.of_list record)
-  | O.E_record_accessor {expr;label} ->
+  | O.E_record_accessor {record;path} ->
-    let%bind expr = uncompile_expression expr in
+    let%bind record = uncompile_expression record in
-    return @@ I.E_record_accessor {expr;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_map map ->
-    let%bind map = bind_map_list (
-      bind_map_pair uncompile_expression
-    ) map
-    in
-    return @@ I.E_map map
-  | O.E_big_map big_map ->
-    let%bind big_map = bind_map_list (
-      bind_map_pair uncompile_expression
-    ) big_map
-    in
-    return @@ I.E_big_map big_map
-  | O.E_list lst ->
-    let%bind lst = bind_map_list uncompile_expression lst in
-    return @@ I.E_list lst
-  | O.E_set set ->
-    let%bind set = bind_map_list uncompile_expression set in
-    return @@ I.E_set set 
-  | O.E_look_up look_up ->
-    let%bind look_up = bind_map_pair uncompile_expression look_up in
-    return @@ I.E_look_up look_up
   | O.E_ascription {anno_expr; type_annotation} ->
     let%bind anno_expr = uncompile_expression anno_expr in
     let%bind type_annotation = uncompile_type_expression type_annotation in

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

@@ -70,6 +70,7 @@ module Wrap = struct
           | TC_set s               -> (C_set, [s])
           | TC_map ( k , v )       -> (C_map, [k;v])
           | TC_big_map ( k , v)    -> (C_big_map, [k;v])
+          | TC_map_or_big_map ( k , v)    -> (C_map, [k;v])
           | TC_arrow ( arg , ret ) -> (C_arrow, [ arg ; ret ])
           | TC_list l              -> (C_list, [l])
           | TC_contract c          -> (C_contract, [c])
@@ -103,6 +104,7 @@ module Wrap = struct
           | TC_set  s              -> (C_set    , [s])
           | TC_map  ( k , v )      -> (C_map    , [k;v])
           | TC_big_map  ( k , v )  -> (C_big_map, [k;v])
+          | TC_map_or_big_map ( k , v)    -> (C_map, [k;v])
           | TC_contract c          -> (C_contract, [c])
           | TC_arrow ( arg , ret ) -> (C_arrow, [ arg ; ret ])
       )

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

@@ -163,7 +163,6 @@ end
 
 open Errors
 
-let swap (a,b) = ok (b,a)
 (*
 let rec type_program (p:I.program) : O.program result =
   let aux (e, acc:(environment * O.declaration Location.wrap list)) (d:I.declaration Location.wrap) =
@@ -346,6 +345,10 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
             let%bind k = evaluate_type e k in 
             let%bind v = evaluate_type e v in 
             ok @@ O.TC_big_map (k,v) 
+        | TC_map_or_big_map (k,v) ->
+            let%bind k = evaluate_type e k in 
+            let%bind v = evaluate_type e v in 
+            ok @@ O.TC_map_or_big_map (k,v) 
         | TC_contract c ->
             let%bind c = evaluate_type e c in
             ok @@ O.TC_contract c
@@ -452,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 {expr;label} -> (
+  | E_record_accessor {record;path} -> (
-      let%bind (base' , state') = type_expression e state expr in
+      let%bind (base' , state') = type_expression e state record in
-      let wrapped = Wrap.access_label ~base:base'.type_expression ~label in
+      let wrapped = Wrap.access_label ~base:base'.type_expression ~label:path in
-      return_wrapped (E_record_accessor {expr=base';label}) state' wrapped
+      return_wrapped (E_record_accessor {record=base';path}) state' wrapped
     )
 
   (* Sum *)
@@ -503,140 +506,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression -
     return_wrapped (E_record_update {record; path; update}) state (Wrap.record wrapped)
   (* Data-structure *)
 
-(*
-  | E_list lst ->
-    let%bind lst' = bind_map_list (type_expression e) lst in
-    let%bind tv =
-      let aux opt c =
-        match opt with
-        | None -> ok (Some c)
-        | Some c' ->
-          let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
-          ok (Some c') in
-      let%bind init = match tv_opt with
-        | None -> ok None
-        | Some ty ->
-          let%bind ty' = get_t_list ty in
-          ok (Some ty') in
-      let%bind ty =
-        let%bind opt = bind_fold_list aux init
-          @@ List.map get_type_annotation lst' in
-        trace_option (needs_annotation ae "empty list") opt in
-      ok (t_list ty ())
-    in
-    return (E_list lst') tv
-  | E_set lst ->
-    let%bind lst' = bind_map_list (type_expression e) lst in
-    let%bind tv =
-      let aux opt c =
-        match opt with
-        | None -> ok (Some c)
-        | Some c' ->
-          let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
-          ok (Some c') in
-      let%bind init = match tv_opt with
-        | None -> ok None
-        | Some ty ->
-          let%bind ty' = get_t_set ty in
-          ok (Some ty') in
-      let%bind ty =
-        let%bind opt = bind_fold_list aux init
-          @@ List.map get_type_annotation lst' in
-        trace_option (needs_annotation ae "empty set") opt in
-      ok (t_set ty ())
-    in
-    return (E_set lst') tv
-  | E_map lst ->
-    let%bind lst' = bind_map_list (bind_map_pair (type_expression e)) lst in
-    let%bind tv =
-      let aux opt c =
-        match opt with
-        | None -> ok (Some c)
-        | Some c' ->
-          let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
-          ok (Some c') in
-      let%bind key_type =
-        let%bind sub =
-          bind_fold_list aux None
-          @@ List.map get_type_annotation
-          @@ List.map fst lst' in
-        let%bind annot = bind_map_option get_t_map_key tv_opt in
-        trace (simple_info "empty map expression without a type annotation") @@
-        O.merge_annotation annot sub (needs_annotation ae "this map literal")
-      in
-      let%bind value_type =
-        let%bind sub =
-          bind_fold_list aux None
-          @@ List.map get_type_annotation
-          @@ List.map snd lst' in
-        let%bind annot = bind_map_option get_t_map_value tv_opt in
-        trace (simple_info "empty map expression without a type annotation") @@
-        O.merge_annotation annot sub (needs_annotation ae "this map literal")
-      in
-      ok (t_map key_type value_type ())
-    in
-    return (E_map lst') tv
-*)
-
-  | E_list lst ->
-    let%bind (state', lst') =
-      bind_fold_map_list (fun state' elt -> type_expression e state' elt >>? swap) state lst in
-    let wrapped = Wrap.list (List.map (fun x -> O.(x.type_expression)) lst') in
-    return_wrapped (E_list lst') state' wrapped
-  | E_set set ->
-    let aux = fun state' elt -> type_expression e state' elt >>? swap in
-    let%bind (state', set') =
-      bind_fold_map_list aux state set in
-    let wrapped = Wrap.set (List.map (fun x -> O.(x.type_expression)) set') in
-    return_wrapped (E_set set') state' wrapped
-  | E_map map ->
-    let aux' state' elt = type_expression e state' elt >>? swap in
-    let aux = fun state' elt -> bind_fold_map_pair aux' state' elt in
-    let%bind (state', map') =
-      bind_fold_map_list aux state map in
-    let aux (x, y) = O.(x.type_expression , y.type_expression) in
-    let wrapped = Wrap.map (List.map aux map') in
-    return_wrapped (E_map map') state' wrapped
-
-  (* | E_big_map lst ->
-   *   let%bind lst' = bind_map_list (bind_map_pair (type_expression e)) lst in
-   *   let%bind tv =
-   *     let aux opt c =
-   *       match opt with
-   *       | None -> ok (Some c)
-   *       | Some c' ->
-   *         let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
-   *         ok (Some c') in
-   *     let%bind key_type =
-   *       let%bind sub =
-   *         bind_fold_list aux None
-   *         @@ List.map get_type_annotation
-   *         @@ List.map fst lst' in
-   *       let%bind annot = bind_map_option get_t_big_map_key tv_opt in
-   *       trace (simple_info "empty map expression without a type annotation") @@
-   *       O.merge_annotation annot sub (needs_annotation ae "this map literal")
-   *     in
-   *     let%bind value_type =
-   *       let%bind sub =
-   *         bind_fold_list aux None
-   *         @@ List.map get_type_annotation
-   *         @@ List.map snd lst' in
-   *       let%bind annot = bind_map_option get_t_big_map_value tv_opt in
-   *       trace (simple_info "empty map expression without a type annotation") @@
-   *       O.merge_annotation annot sub (needs_annotation ae "this map literal")
-   *     in
-   *     ok (t_big_map key_type value_type ())
-   *   in
-   *   return (E_big_map lst') tv *)
-  | E_big_map big_map ->
-    let aux' state' elt = type_expression e state' elt >>? swap in
-    let aux = fun state' elt -> bind_fold_map_pair aux' state' elt in
-    let%bind (state', big_map') =
-      bind_fold_map_list aux state big_map in
-    let aux (x, y) = O.(x.type_expression , y.type_expression) in
-    let wrapped = Wrap.big_map (List.map aux big_map') in
-    return_wrapped (E_big_map big_map') state' wrapped
-
   (* | E_lambda {
    *     binder ;
    *     input_type ;
@@ -685,17 +554,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression -
     let wrapped = Wrap.application f'.type_expression args.type_expression in
     return_wrapped (E_application {lamb=f';args}) state'' wrapped
 
-  (* | E_look_up dsi ->
-   *   let%bind (ds, ind) = bind_map_pair (type_expression e) dsi in
-   *   let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) ds.type_annotation in
-   *   let%bind _ = O.assert_type_value_eq (ind.type_annotation, src) in
-   *   return (E_look_up (ds , ind)) (t_option dst ()) *)
-
-  | E_look_up dsi ->
-    let aux' state' elt = type_expression e state' elt >>? swap in
-    let%bind (state'' , (ds , ind)) = bind_fold_map_pair aux' state dsi in
-    let wrapped = Wrap.look_up ds.type_expression ind.type_expression in
-    return_wrapped (E_look_up (ds , ind)) state'' wrapped
 
   (* Advanced *)
   (* | E_matching (ex, m) -> (
@@ -983,6 +841,10 @@ let rec untype_type_expression (t:O.type_expression) : (I.type_expression) resul
          let%bind k = untype_type_expression k in
          let%bind v = untype_type_expression v in
          ok @@ I.TC_big_map (k,v)
+      | O.TC_map_or_big_map (k,v) ->     
+         let%bind k = untype_type_expression k in
+         let%bind v = untype_type_expression v in
+         ok @@ I.TC_map_or_big_map (k,v)
       | O.TC_arrow ( arg , ret ) ->
          let%bind arg' = untype_type_expression arg in
          let%bind ret' = untype_type_expression ret in
@@ -1055,30 +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 {expr; label} ->
+  | E_record_accessor {record; path} ->
-    let%bind r' = untype_expression expr in
+    let%bind r' = untype_expression record in
-    let Label s = label in
+    let Label s = path in
-    return (e_accessor r' s)
+    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_map m ->
-    let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
-    return (e_map m')
-  | E_big_map m ->
-    let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
-    return (e_big_map m')
-  | E_list lst ->
-    let%bind lst' = bind_map_list untype_expression lst in
-    return (e_list lst')
-  | E_set lst ->
-    let%bind lst' = bind_map_list untype_expression lst in
-    return (e_set lst')
-  | E_look_up dsi ->
-    let%bind (a , b) = bind_map_pair untype_expression dsi in
-    return (e_look_up a b)
   | 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

@@ -381,6 +381,10 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
             let%bind k = evaluate_type e k in 
             let%bind v = evaluate_type e v in 
             ok @@ O.TC_big_map (k,v) 
+        | TC_map_or_big_map (k,v) ->
+            let%bind k = evaluate_type e k in 
+            let%bind v = evaluate_type e v in 
+            ok @@ O.TC_map_or_big_map (k,v) 
         | TC_arrow ( arg , ret ) ->
             let%bind arg' = evaluate_type e arg in
             let%bind ret' = evaluate_type e ret in
@@ -450,8 +454,8 @@ 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 {expr;label} ->
+  | E_record_accessor {record;path} ->
-      let%bind e' = type_expression' e expr in
+      let%bind e' = type_expression' e record in
       let aux (prev:O.expression) (a:I.label) : O.expression result =
             let property = a in
             let%bind r_tv = get_t_record prev.type_expression in
@@ -459,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 {expr=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
@@ -511,108 +515,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
     let%bind () = O.assert_type_expression_eq (tv, get_type_expression update) in
     return (E_record_update {record; path; update}) wrapped
   (* Data-structure *)
-  | E_list lst ->
-      let%bind lst' = bind_map_list (type_expression' e) lst in
-      let%bind tv =
-        let aux opt c =
-          match opt with
-          | None -> ok (Some c)
-          | Some c' ->
-              let%bind _eq = Ast_typed.assert_type_expression_eq (c, c') in
-              ok (Some c') in
-        let%bind init = match tv_opt with
-          | None -> ok None
-          | Some ty ->
-              let%bind ty' = get_t_list ty in
-              ok (Some ty') in
-        let%bind ty =
-          let%bind opt = bind_fold_list aux init
-          @@ List.map get_type_expression lst' in
-          trace_option (needs_annotation ae "empty list") opt in
-        ok (t_list ty ())
-      in
-      return (E_list lst') tv
-  | E_set lst ->
-      let%bind lst' = bind_map_list (type_expression' e) lst in
-      let%bind tv =
-        let aux opt c =
-          match opt with
-          | None -> ok (Some c)
-          | Some c' ->
-              let%bind _eq = Ast_typed.assert_type_expression_eq (c, c') in
-              ok (Some c') in
-        let%bind init = match tv_opt with
-          | None -> ok None
-          | Some ty ->
-              let%bind ty' = get_t_set ty in
-              ok (Some ty') in
-        let%bind ty =
-          let%bind opt = bind_fold_list aux init
-          @@ List.map get_type_expression lst' in
-          trace_option (needs_annotation ae "empty set") opt in
-        ok (t_set ty ())
-      in
-      return (E_set lst') tv
-  | E_map lst ->
-      let%bind lst' = bind_map_list (bind_map_pair (type_expression' e)) lst in
-      let%bind tv =
-        let aux opt c =
-          match opt with
-          | None -> ok (Some c)
-          | Some c' ->
-              let%bind _eq = Ast_typed.assert_type_expression_eq (c, c') in
-              ok (Some c') in
-        let%bind key_type =
-          let%bind sub =
-            bind_fold_list aux None
-            @@ List.map get_type_expression
-            @@ List.map fst lst' in
-          let%bind annot = bind_map_option get_t_map_key tv_opt in
-          trace (simple_info "empty map expression without a type annotation") @@
-          O.merge_annotation annot sub (needs_annotation ae "this map literal")
-        in
-        let%bind value_type =
-          let%bind sub =
-            bind_fold_list aux None
-            @@ List.map get_type_expression
-            @@ List.map snd lst' in
-          let%bind annot = bind_map_option get_t_map_value tv_opt in
-          trace (simple_info "empty map expression without a type annotation") @@
-          O.merge_annotation annot sub (needs_annotation ae "this map literal")
-        in
-        ok (t_map key_type value_type ())
-      in
-      return (E_map lst') tv
-  | E_big_map lst ->
-      let%bind lst' = bind_map_list (bind_map_pair (type_expression' e)) lst in
-      let%bind tv =
-        let aux opt c =
-          match opt with
-          | None -> ok (Some c)
-          | Some c' ->
-              let%bind _eq = Ast_typed.assert_type_expression_eq (c, c') in
-              ok (Some c') in
-        let%bind key_type =
-          let%bind sub =
-            bind_fold_list aux None
-            @@ List.map get_type_expression
-            @@ List.map fst lst' in
-          let%bind annot = bind_map_option get_t_big_map_key tv_opt in
-          trace (simple_info "empty map expression without a type annotation") @@
-          O.merge_annotation annot sub (needs_annotation ae "this map literal")
-        in
-        let%bind value_type =
-          let%bind sub =
-            bind_fold_list aux None
-            @@ List.map get_type_expression
-            @@ List.map snd lst' in
-          let%bind annot = bind_map_option get_t_big_map_value tv_opt in
-          trace (simple_info "empty map expression without a type annotation") @@
-          O.merge_annotation annot sub (needs_annotation ae "this map literal")
-        in
-        ok (t_big_map key_type value_type ())
-      in
-      return (E_big_map lst') tv
   | E_lambda lambda -> 
    let%bind (lambda, lambda_type) = type_lambda e lambda in
    return (E_lambda lambda ) lambda_type
@@ -682,6 +584,35 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
       let%bind (name', tv) =
         type_constant cons_name tv_lst tv_opt in
       return (E_constant {cons_name=name';arguments=lst'}) tv
+  | E_constant {cons_name=C_SET_ADD|C_CONS as cst;arguments=[key;set]} ->
+      let%bind key' =  type_expression' e key in
+      let tv_key = get_type_expression key' in
+      let tv = match tv_opt with 
+          Some tv -> tv 
+        | None -> match cst with 
+            C_SET_ADD -> t_set tv_key ()
+          | C_CONS -> t_list tv_key ()
+          | _ -> failwith "Only C_SET_ADD and C_CONS are possible because those were the two cases matched above"
+      in
+      let%bind set' =  type_expression' e ~tv_opt:tv set in
+      let tv_set = get_type_expression set' in 
+      let tv_lst = [tv_key;tv_set] in
+      let%bind (name', tv) = type_constant cst tv_lst tv_opt in
+      return (E_constant {cons_name=name';arguments=[key';set']}) tv
+  | E_constant {cons_name=C_MAP_ADD as cst; arguments=[key;value;map]} ->
+      let%bind key' = type_expression' e key in
+      let%bind val' = type_expression' e value in
+      let tv_key = get_type_expression key' in
+      let tv_val = get_type_expression val' in
+      let tv = match tv_opt with 
+          Some tv -> tv 
+        | None -> t_map_or_big_map tv_key tv_val ()
+      in
+      let%bind map' =  type_expression' e ~tv_opt:tv map in
+      let tv_map = get_type_expression map' in 
+      let tv_lst = [tv_key;tv_val;tv_map] in
+      let%bind (name', tv) = type_constant cst tv_lst tv_opt in
+      return (E_constant {cons_name=name';arguments=[key';val';map']}) tv
   | E_constant {cons_name;arguments} ->
       let%bind lst' = bind_list @@ List.map (type_expression' e) arguments in
       let tv_lst = List.map get_type_expression lst' in
@@ -703,11 +634,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
             lamb'.location
       in
       return (E_application {lamb=lamb'; args=args'}) tv
-  | E_look_up dsi ->
-      let%bind (ds, ind) = bind_map_pair (type_expression' e) dsi in
-      let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) ds.type_expression in
-      let%bind _ = O.assert_type_expression_eq (ind.type_expression, src) in
-      return (E_look_up (ds , ind)) (t_option dst ())
   (* Advanced *)
   | E_matching {matchee;cases} -> (
       let%bind ex' = type_expression' e matchee in
@@ -861,30 +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 {expr; label} ->
+  | E_record_accessor {record; path} ->
-      let%bind r' = untype_expression expr in
+      let%bind r' = untype_expression record in
-      let Label s = label in
+      let Label s = path in
-      return (e_accessor r' s)
+      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_map m ->
-      let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
-      return (e_map m')
-  | E_big_map m ->
-      let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
-      return (e_big_map m')
-  | E_list lst ->
-      let%bind lst' = bind_map_list untype_expression lst in
-      return (e_list lst')
-  | E_set lst ->
-      let%bind lst' = bind_map_list untype_expression lst in
-      return (e_set lst')
-  | E_look_up dsi ->
-      let%bind (a , b) = bind_map_pair untype_expression dsi in
-      return (e_look_up a b)
   | 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

@@ -8,17 +8,10 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   let%bind init' = f init e in
   match e.expression_content with
   | E_literal _ | E_variable _ -> ok init'
-  | E_list lst | E_set lst | E_constant {arguments=lst} -> (
+  | E_constant {arguments=lst} -> (
     let%bind res = bind_fold_list self init' lst in
     ok res
   )
-  | E_map lst | E_big_map lst -> (
-    let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
-    ok res
-  )
-  | E_look_up ab ->
-      let%bind res = bind_fold_pair self init' ab in
-      ok res
   | E_application {lamb; args} -> (
       let ab = (lamb, args) in
       let%bind res = bind_fold_pair self init' ab in
@@ -48,8 +41,8 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = fold_expression self res update in
     ok res 
   )
-  | E_record_accessor {expr} -> (
+  | E_record_accessor {record} -> (
-     let%bind res = self init' expr in
+     let%bind res = self init' record in
      ok res
     )
   | E_let_in { let_binder = _ ; rhs ; let_result } -> (
@@ -93,34 +86,14 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
   let%bind e' = f e in
   let return expression_content = ok { e' with expression_content } in
   match e'.expression_content with
-  | E_list lst -> (
-    let%bind lst' = bind_map_list self lst in
-    return @@ E_list lst'
-  )
-  | E_set lst -> (
-    let%bind lst' = bind_map_list self lst in
-    return @@ E_set lst'
-  )
-  | E_map lst -> (
-    let%bind lst' = bind_map_list (bind_map_pair self) lst in
-    return @@ E_map lst'
-  )
-  | E_big_map lst -> (
-    let%bind lst' = bind_map_list (bind_map_pair self) lst in
-    return @@ E_big_map lst'
-  )
-  | E_look_up ab -> (
-      let%bind ab' = bind_map_pair self ab in
-      return @@ E_look_up ab'
-    )
   | E_matching {matchee=e;cases} -> (
       let%bind e' = self e in
       let%bind cases' = map_cases f cases in
       return @@ E_matching {matchee=e';cases=cases'}
     )
-  | E_record_accessor acc -> (
+  | E_record_accessor {record; path} -> (
-      let%bind e' = self acc.expr in
+      let%bind record = self record in
-      return @@ E_record_accessor {acc with expr = e'}
+      return @@ E_record_accessor {record; path}
     )
   | E_record m -> (
     let%bind m' = bind_map_lmap self m in
@@ -208,34 +181,14 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
   else
   let return expression_content = { e' with expression_content } in
   match e'.expression_content with
-  | E_list lst -> (
-    let%bind (res, lst') = bind_fold_map_list self init' lst in
-    ok (res, return @@ E_list lst')
-  )
-  | E_set lst -> (
-    let%bind (res, lst') = bind_fold_map_list self init' lst in
-    ok (res, return @@ E_set lst')
-  )
-  | E_map lst -> (
-    let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
-    ok (res, return @@ E_map lst')
-  )
-  | E_big_map lst -> (
-    let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
-    ok (res, return @@ E_big_map lst')
-  )
-  | E_look_up ab -> (
-      let%bind (res, ab') = bind_fold_map_pair self init' ab in
-      ok (res, return @@ E_look_up ab')
-    )
   | E_matching {matchee=e;cases} -> (
       let%bind (res, e') = self init' e in
       let%bind (res,cases') = fold_map_cases f res cases in
       ok (res, return @@ E_matching {matchee=e';cases=cases'})
     )
-  | E_record_accessor acc -> (
+  | E_record_accessor {record; path} -> (
-      let%bind (res, e') = self init' acc.expr in
+      let%bind (res, record) = self init' record in
-      ok (res, return @@ E_record_accessor {acc with expr = e'})
+      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/passes/9-self_ast_typed/no_nested_big_map.ml

@@ -21,6 +21,10 @@ let rec check_no_nested_bigmap is_in_bigmap e =
     let%bind _ = check_no_nested_bigmap false key in
     let%bind _ = check_no_nested_bigmap true value in
     ok ()
+  | T_operator (TC_map_or_big_map (key, value)) ->
+    let%bind _ = check_no_nested_bigmap false key in
+    let%bind _ = check_no_nested_bigmap true value in
+    ok ()
   | T_operator (TC_contract t)
   | T_operator (TC_option t)
   | T_operator (TC_list t)

src/passes/9-self_ast_typed/tail_recursion.ml

@@ -49,28 +49,13 @@ let rec check_recursive_call : expression_variable -> bool -> expression -> unit
     let es = LMap.to_list elm in
     let%bind _ = bind_map_list (check_recursive_call n false) es in
     ok ()
-  | E_record_accessor {expr;_} ->
+  | E_record_accessor {record;_} ->
-    let%bind _ = check_recursive_call n false expr in
+    let%bind _ = check_recursive_call n false record in
     ok ()
   | E_record_update {record;update;_} ->
     let%bind _ = check_recursive_call n false record in
     let%bind _ = check_recursive_call n false update in
     ok ()
-  | E_map eel | E_big_map eel->
-    let aux (e1,e2) = 
-      let%bind _ = check_recursive_call n false e1 in
-      let%bind _ = check_recursive_call n false e2 in
-      ok ()
-    in
-    let%bind _ = bind_map_list aux eel in
-    ok ()
-  | E_list el | E_set el ->
-    let%bind _ = bind_map_list (check_recursive_call n false) el in
-    ok ()
-  | E_look_up (e1,e2) ->
-    let%bind _ = check_recursive_call n false e1 in
-    let%bind _ = check_recursive_call n false e2 in
-    ok ()
 
 and check_recursive_call_in_matching = fun n final_path c ->
   match c with

src/passes/operators/operators.ml

@@ -621,6 +621,20 @@ module Typer = struct
     let%bind () = assert_type_expression_eq (src , k) in
     ok m
 
+  let map_empty = typer_0 "MAP_EMPTY" @@ fun tv_opt ->
+    match tv_opt with
+    | None -> simple_fail "untyped MAP_EMPTY"
+    | Some t -> 
+      let%bind (src, dst) = get_t_map t in
+      ok @@ t_map src dst ()
+
+  let big_map_empty = typer_0 "BIG_MAP_EMPTY" @@ fun tv_opt ->
+    match tv_opt with
+    | None -> simple_fail "untyped BIG_MAP_EMPTY"
+    | Some t -> 
+      let%bind (src, dst) = get_t_big_map t in
+      ok @@ t_big_map src dst ()
+
   let map_add : typer = typer_3 "MAP_ADD" @@ fun k v m ->
     let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in
     let%bind () = assert_type_expression_eq (src, k) in
@@ -949,6 +963,11 @@ module Typer = struct
     then ok (t_unit ())
     else fail @@ Operator_errors.type_error "bad set iter" key arg ()
 
+  let list_empty = typer_0 "LIST_EMPTY" @@ fun tv_opt ->
+    match tv_opt with
+    | None -> simple_fail "untyped LIST_EMPTY"
+    | Some t -> ok t
+
   let list_iter = typer_2 "LIST_ITER" @@ fun body lst ->
     let%bind (arg , res) = get_t_function body in
     let%bind () = Assert.assert_true (eq_1 res (t_unit ())) in
@@ -1145,7 +1164,6 @@ module Typer = struct
     | C_SLICE               -> ok @@ slice ;
     | C_BYTES_PACK          -> ok @@ bytes_pack ;
     | C_BYTES_UNPACK        -> ok @@ bytes_unpack ;
-    | C_CONS                -> ok @@ cons ;
     (* SET  *)
     | C_SET_EMPTY           -> ok @@ set_empty ;
     | C_SET_ADD             -> ok @@ set_add ;
@@ -1155,10 +1173,14 @@ module Typer = struct
     | C_SET_MEM             -> ok @@ set_mem ;
 
     (* LIST *)
+    | C_CONS                -> ok @@ cons ;
+    | C_LIST_EMPTY          -> ok @@ list_empty ;
     | C_LIST_ITER           -> ok @@ list_iter ;
     | C_LIST_MAP            -> ok @@ list_map ;
     | C_LIST_FOLD           -> ok @@ list_fold ;
     (* MAP *)
+    | C_MAP_EMPTY           -> ok @@ map_empty ;
+    | C_BIG_MAP_EMPTY       -> ok @@ big_map_empty ;
     | C_MAP_ADD             -> ok @@ map_add ;
     | C_MAP_REMOVE          -> ok @@ map_remove ;
     | C_MAP_UPDATE          -> ok @@ map_update ;

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
+      fprintf ppf "{%a}" (record_sep expression (const ";")) m
   | E_record_accessor ra ->
-      fprintf ppf "%a.%a" expression ra.expr 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 ->
@@ -57,15 +91,58 @@ and expression_content ppf (ec : expression_content) =
         expression_variable fun_name 
         type_expression fun_type
         expression_content (E_lambda lambda)
-  | E_let_in { let_binder ; mut; rhs ; let_result; inline } ->    
+  | E_let_in { let_binder ; rhs ; let_result; inline } ->    
-      fprintf ppf "let %a%a = %a%a in %a" option_mut mut option_type_name let_binder expression rhs option_inline inline expression let_result
+      fprintf ppf "let %a = %a%a in %a" option_type_name let_binder expression rhs option_inline inline expression let_result
   | E_ascription {anno_expr; type_annotation} ->
       fprintf ppf "%a : %a" expression anno_expr type_expression
         type_annotation
+  | E_cond {condition; then_clause; else_clause} ->
+      fprintf ppf "if %a then %a else %a"
+        expression condition
+        expression then_clause
+        expression else_clause
   | E_sequence {expr1;expr2} ->
-      fprintf ppf "%a;\n%a" expression expr1 expression expr2
+      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
+        (list_sep (fun ppf a -> fprintf ppf ".%a" accessor a) (fun ppf () -> fprintf ppf "")) access_path
+        expression e
+  | E_for {binder; start; final; increment; body} ->
+      fprintf ppf "for %a from %a to %a by %a do %a" 
+        expression_variable binder
+        expression start 
+        expression final 
+        expression increment
+        expression body
+  | E_for_each {binder; collection; body; _} ->
+      fprintf ppf "for each %a in %a do %a" 
+        option_map binder
+        expression collection
+        expression body
+  | E_while {condition; body} ->
+      fprintf ppf "while %a do %a"
+        expression condition
+        expression body
+    
+and accessor ppf a =
+  match a with
+    | Access_tuple i  -> fprintf ppf "%d" i
+    | Access_record s -> fprintf ppf "%s" s
+    | Access_map e    -> fprintf ppf "%a" expression e
+
+and option_map ppf (k,v_opt) =
+  match v_opt with
+  | None -> fprintf ppf "%a" expression_variable k
+  | Some v -> fprintf ppf "%a -> %a" expression_variable k expression_variable v 
 
 and option_type_name ppf
     ((n, ty_opt) : expression_variable * type_expression option) =

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 = make_t @@ T_tuple lst
-let t_tuple lst    : type_expression = t_record_ez (tuple_to_record 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,19 +113,25 @@ let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst
 let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a}
 let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b}
 let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
-let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {expr = a; label= Label b}
+let e_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
-let e_let_in ?loc (binder, ascr) mut inline rhs let_result = 
+let e_let_in ?loc (binder, ascr) inline rhs let_result = 
-  make_expr ?loc @@ E_let_in { let_binder = (binder, ascr) ; mut; rhs ; let_result; inline }
+  make_expr ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline }
 let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty}
 let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b}
 let e_binop ?loc name a b  = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]}
 let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst}
 let e_look_up ?loc x y = make_expr ?loc @@ E_look_up (x , y)
 let e_sequence ?loc expr1 expr2 = make_expr ?loc @@ E_sequence {expr1; expr2}
-let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false})
+
+let e_while ?loc condition body = make_expr ?loc @@ E_while {condition; body}
+let e_for ?loc binder start final increment body = make_expr ?loc @@ E_for {binder;start;final;increment;body}
+let e_for_each ?loc binder collection collection_type body = make_expr ?loc @@ E_for_each {binder;collection;collection_type;body}
+
+let e_cond ?loc condition then_clause else_clause = make_expr ?loc @@ E_cond {condition;then_clause;else_clause}
 (*
 let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*)
 *)
@@ -146,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 =
@@ -163,8 +165,9 @@ let e_typed_none ?loc t_opt =
   let type_annotation = t_option t_opt in
   e_annotation ?loc (e_none ?loc ()) type_annotation
 
-let e_typed_list ?loc lst t =
+let e_typed_list ?loc lst t = e_annotation ?loc (e_list lst) (t_list t)
-  e_annotation ?loc (e_list lst) (t_list t)
+let e_typed_list_literal ?loc lst t =
+  e_annotation ?loc (e_constant C_LIST_LITERAL lst) (t_list t)
 
 let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v)
 let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v)
@@ -186,24 +189,16 @@ 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 e_assign_with_let ?loc var access_path expr = 
+let e_assign ?loc variable access_path expression =
-  let var = Var.of_name (var) in
+  make_expr ?loc @@ E_assign {variable;access_path;expression} 
-  match access_path with 
+let e_ez_assign ?loc variable access_path expression = 
-  | [] -> (var, None), true, expr, false
+  let variable = Var.of_name variable in
-
+  let access_path = List.map (fun s -> Access_record s) access_path in
-  | lst -> 
+  e_assign ?loc variable access_path expression 
-    let rec aux path record= match path with 
-    | [] -> failwith "acces_path cannot be empty"
-    | [e] -> e_update ?loc record e expr
-    | elem::tail -> 
-      let next_record = e_accessor record elem in
-      e_update ?loc record elem (aux tail next_record )
-    in 
-    (var, None), true, (aux lst (e_variable var)), false
 
 let get_e_accessor = fun t ->
   match t with
-  | E_record_accessor {expr; label} -> ok (expr , label)
+  | E_record_accessor {record; path} -> ok (record , path)
   | _ -> simple_fail "not an accessor"
 
 let assert_e_accessor = fun t ->
@@ -212,14 +207,7 @@ let assert_e_accessor = fun t ->
 
 let get_e_pair = fun t ->
   match t with
-  | E_record r -> ( 
+  | E_tuple [a ; b] -> ok (a , b)
-  let lst = LMap.to_kv_list r in
-    match lst with 
-    | [(Label "O",a);(Label "1",b)]
-    | [(Label "1",b);(Label "0",a)] -> 
-        ok (a , b)
-    | _ -> simple_fail "not a pair"
-    )
   | _ -> simple_fail "not a pair"
 
 let get_e_list = fun t ->
@@ -227,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 -> ( 
+  | E_tuple [a;b] -> ok @@ (a,b)
-  let lst = LMap.to_kv_list r in
-    match lst with 
-    | [(Label "O",a);(Label "1",b)]
-    | [(Label "1",b);(Label "0",a)] -> 
-        ok (a , b)
-    | _ -> fail @@ bad_kind "pair" e.location
-    )
   | _ -> fail @@ bad_kind "pair" e.location
 
 let extract_list : expression -> (expression list) result = fun e ->

src/stages/1-ast_imperative/combinators.mli

@@ -86,7 +86,7 @@ val e_variable : ?loc:Location.t -> expression_variable -> expression
 val e_skip : ?loc:Location.t -> unit -> expression
 val e_sequence : ?loc:Location.t -> expression -> expression -> expression
 val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
-val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> bool -> expression -> expression -> expression
+val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
 val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
 val e_application : ?loc:Location.t -> expression -> expression -> expression
 val e_binop    : ?loc:Location.t -> constant' -> expression -> expression -> expression
@@ -100,6 +100,7 @@ val make_option_typed : ?loc:Location.t -> expression -> type_expression option
 val e_typed_none : ?loc:Location.t -> type_expression -> expression
 
 val e_typed_list : ?loc:Location.t -> expression list -> type_expression -> expression
+val e_typed_list_literal : ?loc:Location.t -> expression list -> type_expression -> expression
 
 val e_typed_map : ?loc:Location.t -> ( expression * expression ) list  -> type_expression -> type_expression -> expression
 val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list  -> type_expression -> type_expression -> expression
@@ -110,11 +111,15 @@ val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option
 val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
 val e_record : ?loc:Location.t -> expr Map.String.t -> expression
 val e_update : ?loc:Location.t -> expression -> string -> expression -> expression
-val e_assign_with_let : ?loc:Location.t -> string -> string list -> expression -> ((expression_variable*type_expression option)*bool*expression*bool)
+val e_assign : ?loc:Location.t -> expression_variable -> access list -> expression -> expression
+val e_ez_assign : ?loc:Location.t -> string -> string list -> expression -> expression
 
 (*
 val get_e_accessor : expression' -> ( expression * access_path ) result
 *)
+val e_while  : ?loc:Location.t -> expression -> expression -> expression
+val e_for     : ?loc:Location.t -> expression_variable -> expression -> expression -> expression -> expression -> expression
+val e_for_each : ?loc:Location.t -> expression_variable * expression_variable option -> expression -> collect_type -> expression -> expression
 
 val assert_e_accessor : expression_content -> unit result
 

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,9 +202,14 @@ 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_look_up _, _) | (E_matching _, _)
+  | (E_record_accessor _, _) | (E_tuple_accessor _, _)
-  | (E_sequence _, _) | (E_skip, _) -> simple_fail "comparing not a value"
+  | (E_look_up _, _) 
+  | (E_matching _, _) | (E_cond _, _)
+  | (E_sequence _, _) | (E_skip, _) 
+  | (E_assign _, _)
+  | (E_for _, _) | (E_for_each _, _)
+  | (E_while _, _) -> simple_fail "comparing not a value"
 
 let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)
 

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)
+type type_content =
-*)
+  | T_sum of type_expression constructor_map
-include Ast_generic_type (Ast_imperative_parameter)
+  | 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,19 +55,28 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of accessor
+  | E_record_accessor of record_accessor
-  | E_record_update of update
+  | E_record_update   of record_update
   (* Advanced *)
   | E_ascription of ascription
   (* Sugar *)
+  | E_cond of conditional
   | 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
   | E_list of expression list
   | E_set of expression list
   | E_look_up of (expression * expression)
+  (* Imperative *)
+  | E_assign of assign
+  | E_for of for_
+  | E_for_each of for_each
+  | E_while of while_loop
 
 and constant =
   { cons_name: constant' (* this is at the end because it is huge *)
@@ -78,16 +101,16 @@ and recursive = {
 
 and let_in =
   { let_binder: expression_variable * type_expression option
-  ; mut: bool
   ; rhs: expression
   ; let_result: expression
   ; inline: bool }
 
 and constructor = {constructor: constructor'; element: expression}
 
-and accessor = {expr: expression; label: label}
+and 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 =
@@ -96,11 +119,57 @@ and matching =
   }
 
 and ascription = {anno_expr: expression; type_annotation: type_expression}
+
+and conditional = {
+  condition : expression ;
+  then_clause : expression ;
+  else_clause : expression ;
+}
+
 and sequence = {
   expr1: expression ;
   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;
+  expression : expression;
+}
+
+and access =
+  | Access_tuple of int
+  | Access_record of string
+  | Access_map of expr
+
+and for_ = {
+  binder : expression_variable;
+  start : expression;
+  final : expression;
+  increment : expression;
+  body : expression;
+}
+
+and for_each = {
+  binder : expression_variable * expression_variable option;
+  collection : expression;
+  collection_type : collect_type;
+  body : expression;
+}
+
+and collect_type = 
+ | Map
+ | Set
+ | List
+
+and while_loop = {
+  condition : expression;
+  body : expression;
+}
+
 and environment_element_definition =
   | ED_binder
   | ED_declaration of (expression * free_variables)

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.expr 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 ->
@@ -56,14 +86,30 @@ and expression_content ppf (ec : expression_content) =
   | E_matching {matchee; cases; _} ->
       fprintf ppf "match %a with %a" expression matchee (matching expression)
         cases
-  | E_let_in { let_binder ; rhs ; let_result; inline } ->    
+  | E_let_in { let_binder ; rhs ; let_result; inline; mut} ->    
-    fprintf ppf "let %a = %a%a in %a" option_type_name let_binder expression rhs option_inline inline expression let_result
+      fprintf ppf "let %a%a = %a%a in %a" 
-  | E_sequence {expr1;expr2} ->
+        option_type_name let_binder 
-      fprintf ppf "%a;\n%a" expression expr1 expression expr2
+        option_mut mut
+        expression rhs 
+        option_inline inline 
+        expression let_result
   | E_ascription {anno_expr; type_annotation} ->
       fprintf ppf "%a : %a" expression anno_expr type_expression type_annotation
+  | E_cond {condition; then_clause; else_clause} ->
+      fprintf ppf "if %a then %a else %a"
+        expression condition
+        expression then_clause
+        expression else_clause
+  | E_sequence {expr1;expr2} ->
+      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
 
 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 =
@@ -107,33 +107,31 @@ let e_bytes_raw ?loc (b: bytes) : expression =
   make_expr ?loc @@ E_literal (Literal_bytes b)
 let e_bytes_string ?loc (s: string) : expression =
   make_expr ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s)))
-let e_big_map ?loc lst : expression = make_expr ?loc @@ E_big_map lst
 let e_some ?loc s  : expression = make_expr ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]}
 let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NONE; arguments = []}
-let e_string_cat ?loc sl sr : expression = make_expr ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]}
-let e_map_add ?loc k v old  : expression = make_expr ?loc @@ E_constant {cons_name = C_MAP_ADD; arguments = [k ; v ; old]}
-let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst
-let e_set ?loc lst : expression = make_expr ?loc @@ E_set lst
-let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst
 let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a}
 let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b}
 let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
-let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {expr = a; label= Label b}
+let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; path = 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_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_skip ?loc () = make_expr ?loc @@ E_skip
+let e_let_in ?loc (binder, ascr) mut inline rhs let_result = 
-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; mut }
-  make_expr ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline }
-let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty}
 let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b}
-let e_binop ?loc name a b  = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]}
 let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst}
-let e_look_up ?loc x y = make_expr ?loc @@ E_look_up (x , y)
+
+let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty}
+
+let e_cond ?loc condition then_clause else_clause = make_expr ?loc @@ E_cond {condition;then_clause;else_clause}
 let e_sequence ?loc expr1 expr2 = make_expr ?loc @@ E_sequence {expr1; expr2}
-let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false})
+let e_skip ?loc () = make_expr ?loc @@ E_skip
-(*
+
-let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*)
+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
   Match_variant (lst,())
@@ -145,19 +143,19 @@ 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; path= Label b}
 
-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_tuple ?loc lst : expression = e_record_ez ?loc (tuple_to_record lst)
-let e_pair ?loc a b  : expression = e_tuple ?loc [a;b]
-
 let make_option_typed ?loc e t_opt =
   match t_opt with
   | None -> e
   | Some t -> e_annotation ?loc e t
 
+let e_tuple ?loc lst : expression = e_record_ez ?loc (tuple_to_record lst)
+let e_pair ?loc a b  : expression = e_tuple ?loc [a;b]
 
 let e_typed_none ?loc t_opt =
   let type_annotation = t_option t_opt in
@@ -185,41 +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_record_accessor = fun t ->
-let e_assign_with_let ?loc var access_path expr = 
-  let var = Var.of_name (var) in
-  match access_path with 
-  | [] -> (var, None), true, expr, false
-
-  | lst -> 
-    let rec aux path record= match path with 
-    | [] -> failwith "acces_path cannot be empty"
-    | [e] -> e_update ?loc record e expr
-    | elem::tail -> 
-      let next_record = e_accessor record elem in
-      e_update ?loc record elem (aux tail next_record )
-    in 
-    (var, None), true, (aux lst (e_variable var)), false
-
-let get_e_accessor = fun t ->
   match t with
-  | E_record_accessor {expr; label} -> ok (expr , label)
+  | E_record_accessor {record; path} -> ok (record, path)
-  | _ -> simple_fail "not an accessor"
+  | _ -> 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 -> ( 
+  | E_tuple [a ; b] -> ok (a , b)
-  let lst = LMap.to_kv_list r in
-    match lst with 
-    | [(Label "O",a);(Label "1",b)]
-    | [(Label "1",b);(Label "0",a)] -> 
-        ok (a , b)
-    | _ -> simple_fail "not a pair"
-    )
   | _ -> simple_fail "not a pair"
 
 let get_e_list = fun t ->
@@ -227,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 -> ( 
+  | E_tuple [a;b] -> ok @@ (a,b)
-  let lst = LMap.to_kv_list r in
-    match lst with 
-    | [(Label "O",a);(Label "1",b)]
-    | [(Label "1",b);(Label "0",a)] -> 
-        ok (a , b)
-    | _ -> fail @@ bad_kind "pair" e.location
-    )
   | _ -> fail @@ bad_kind "pair" e.location
 
 let extract_list : expression -> (expression list) result = fun e ->

src/stages/2-ast_sugar/combinators.mli

@@ -65,33 +65,37 @@ val e'_bytes : string -> expression_content result
 val e_bytes_hex : ?loc:Location.t -> string -> expression result
 val e_bytes_raw : ?loc:Location.t -> bytes -> expression
 val e_bytes_string : ?loc:Location.t -> string -> expression
-val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
-
-val e_record_ez  : ?loc:Location.t -> ( string * expr ) list -> expression
-val e_tuple : ?loc:Location.t -> expression list -> expression
 val e_some : ?loc:Location.t -> expression -> expression
 val e_none : ?loc:Location.t -> unit -> expression
-val e_string_cat : ?loc:Location.t -> expression -> expression -> expression
+
-val e_map_add : ?loc:Location.t -> expression -> expression ->  expression -> expression
+val e_variable : ?loc:Location.t -> expression_variable -> expression
-val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression
-val e_set : ?loc:Location.t -> expression list -> expression
-val e_list : ?loc:Location.t -> expression list -> expression
-val e_pair : ?loc:Location.t -> expression -> expression -> expression
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
+val e_constant : ?loc:Location.t -> constant' -> expression list -> expression
+
+val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
+val e_application : ?loc:Location.t -> expression -> expression -> expression
+val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
+val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> bool -> expression -> expression -> expression
+
+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
+
+val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
+val e_sequence : ?loc:Location.t -> expression -> expression -> expression
+val e_skip : ?loc:Location.t -> unit -> expression
+
+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 e_accessor : ?loc:Location.t -> expression -> string -> expression
-val e_accessor_list : ?loc:Location.t -> expression -> string list -> expression
-val e_variable : ?loc:Location.t -> expression_variable -> expression
-val e_skip : ?loc:Location.t -> unit -> expression
-val e_sequence : ?loc:Location.t -> expression -> expression -> expression
-val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
-val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
-val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
-val e_application : ?loc:Location.t -> expression -> expression -> expression
-val e_binop    : ?loc:Location.t -> constant' -> expression -> expression -> expression
-val e_constant : ?loc:Location.t -> constant' -> expression list -> expression
-val e_look_up : ?loc:Location.t -> expression -> expression -> expression
 val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content
 val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression
 
@@ -103,18 +107,11 @@ val e_typed_list : ?loc:Location.t -> expression list -> type_expression -> expr
 
 val e_typed_map : ?loc:Location.t -> ( expression * expression ) list  -> type_expression -> type_expression -> expression
 val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list  -> type_expression -> type_expression -> expression
-
 val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression
 
-val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
+val e_record_ez : ?loc:Location.t -> (string * expression) list -> expression
-val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
+val e_tuple : ?loc:Location.t -> expression list -> expression
-val e_record : ?loc:Location.t -> expr Map.String.t -> expression
+val e_pair : ?loc:Location.t -> expression -> expression -> expression
-val e_update : ?loc:Location.t -> expression -> string -> expression -> expression
-val e_assign_with_let : ?loc:Location.t -> string -> string list -> expression -> ((expression_variable*type_expression option)*bool*expression*bool)
-
-(*
-val get_e_accessor : expression' -> ( expression * access_path ) result
-*)
 
 val assert_e_accessor : expression_content -> unit result
 

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,8 +202,10 @@ 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_look_up _, _) | (E_matching _, _)
+  | (E_record_accessor _, _) | (E_tuple_accessor _, _)
+  | (E_look_up _, _) 
+  | (E_matching _, _) | (E_cond _, _)
   | (E_sequence _, _) | (E_skip, _) -> simple_fail "comparing not a value"
 
 let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)

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)
+type type_content =
-*)
+  | T_sum of type_expression constructor_map
-include Ast_generic_type (Ast_sugar_parameter)
+  | 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,17 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of accessor
+  | E_record_accessor of record_accessor
-  | E_record_update of update
+  | E_record_update   of record_update
   (* Advanced *)
   | E_ascription of ascription
   (* Sugar *)
+  | E_cond of conditional
   | 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
@@ -76,17 +94,18 @@ and recursive = {
   lambda : lambda;
 }
 
-and let_in =
+and let_in = { 
-  { let_binder: expression_variable * type_expression option
+  let_binder: expression_variable * type_expression option ;
-  ; rhs: expression
+  rhs: expression ;
-  ; let_result: expression
+  let_result: expression ;
-  ; inline: bool }
+  inline: bool ;
+  mut: bool;
+  }
 
 and constructor = {constructor: constructor'; element: expression}
 
-and accessor = {expr: 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 =
@@ -95,11 +114,20 @@ and matching =
   }
 
 and ascription = {anno_expr: expression; type_annotation: type_expression}
+
+and conditional = {
+  condition : expression ;
+  then_clause : expression ;
+  else_clause : expression ;
+}
 and sequence = {
   expr1: expression ;
   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,19 +28,9 @@ 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.expr 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_map m ->
-      fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
-  | E_big_map m ->
-      fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m
-  | E_list lst ->
-      fprintf ppf "list[%a]" (list_sep_d expression) lst
-  | E_set lst ->
-      fprintf ppf "set[%a]" (list_sep_d expression) lst
-  | E_look_up (ds, ind) ->
-      fprintf ppf "(%a)[%a]" expression ds expression ind
   | E_lambda {binder; input_type; output_type; result} ->
       fprintf ppf "lambda (%a:%a) : %a return %a"
         expression_variable binder

src/stages/3-ast_core/combinators.ml

@@ -107,19 +107,15 @@ let e_bytes_raw ?loc (b: bytes) : expression =
   make_expr ?loc @@ E_literal (Literal_bytes b)
 let e_bytes_string ?loc (s: string) : expression =
   make_expr ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s)))
-let e_big_map ?loc lst : expression = make_expr ?loc @@ E_big_map lst
 let e_some ?loc s  : expression = make_expr ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]}
 let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NONE; arguments = []}
 let e_string_cat ?loc sl sr : expression = make_expr ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]}
 let e_map_add ?loc k v old  : expression = make_expr ?loc @@ E_constant {cons_name = C_MAP_ADD; arguments = [k ; v ; old]}
-let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst
-let e_set ?loc lst : expression = make_expr ?loc @@ E_set lst
-let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst
 let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a}
 let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b}
 let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
-let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {expr = a; label= Label b}
+let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; path = 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_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 }
@@ -127,7 +123,6 @@ let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr;
 let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b}
 let e_binop ?loc name a b  = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]}
 let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst}
-let e_look_up ?loc x y = make_expr ?loc @@ E_look_up (x , y)
 let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false})
 (*
 let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*)
@@ -144,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}
 
@@ -161,15 +156,6 @@ let e_typed_none ?loc t_opt =
   let type_annotation = t_option t_opt in
   e_annotation ?loc (e_none ?loc ()) type_annotation
 
-let e_typed_list ?loc lst t =
-  e_annotation ?loc (e_list lst) (t_list t)
-
-let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v)
-let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v)
-
-let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k)
-
-
 let e_lambda ?loc (binder : expression_variable)
     (input_type : type_expression option)
     (output_type : type_expression option)
@@ -192,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
+      let next_record = e_record_accessor record elem in
-      e_update ?loc record elem (aux tail next_record )
+      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 {expr; label} -> ok (expr , label)
+  | E_record_accessor {record; path} -> ok (record, path)
   | _ -> simple_fail "not an accessor"
 
-let assert_e_accessor = fun t ->
+let assert_e_record_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 ->
@@ -221,20 +207,20 @@ let get_e_pair = fun t ->
   | _ -> simple_fail "not a pair"
 
 let get_e_list = fun t ->
-  match t with
+  let rec aux t = 
-  | E_list lst -> ok lst
+    match t with
-  | _ -> simple_fail "not a list"
+      E_constant {cons_name=C_CONS;arguments=[key;lst]} -> 
-
+        let%bind lst = aux lst.expression_content in
-let tuple_of_record (m: _ LMap.t) =
+        ok @@ key::(lst)
-  let aux i = 
+    | E_constant {cons_name=C_LIST_EMPTY;arguments=[]} ->
-    let opt = LMap.find_opt (Label (string_of_int i)) m in
+        ok @@ []
-    Option.bind (fun opt -> Some (opt,i+1)) opt
+    | _ -> simple_fail "not a list"
   in
-  Base.Sequence.to_list @@ Base.Sequence.unfold ~init:0 ~f:aux
+  aux t
 
 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 *)
@@ -250,17 +236,18 @@ let extract_pair : expression -> (expression * expression) result = fun e ->
     )
   | _ -> fail @@ bad_kind "pair" e.location
 
-let extract_list : expression -> (expression list) result = fun e ->
-  match e.expression_content with
-  | E_list lst -> ok lst
-  | _ -> fail @@ bad_kind "list" e.location
-
 let extract_record : expression -> (label * expression) list result = fun e ->
   match e.expression_content with
   | E_record lst -> ok @@ LMap.to_kv_list lst
   | _ -> fail @@ bad_kind "record" e.location
 
 let extract_map : expression -> (expression * expression) list result = fun e ->
-  match e.expression_content with
+  let rec aux e =
-  | E_map lst -> ok lst
+    match e.expression_content with
-  | _ -> fail @@ bad_kind "map" e.location
+      E_constant {cons_name=C_UPDATE|C_MAP_ADD; arguments=[k;v;map]} -> 
+        let%bind map = aux map in
+        ok @@ (k,v)::map 
+    | E_constant {cons_name=C_MAP_EMPTY|C_BIG_MAP_EMPTY; arguments=[]} -> ok @@ []
+    | _ -> fail @@ bad_kind "map" e.location
+  in
+  aux e

src/stages/3-ast_core/combinators.mli

@@ -65,7 +65,6 @@ val e'_bytes : string -> expression_content result
 val e_bytes_hex : ?loc:Location.t -> string -> expression result
 val e_bytes_raw : ?loc:Location.t -> bytes -> expression
 val e_bytes_string : ?loc:Location.t -> string -> expression
-val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
 
 val e_record_ez  : ?loc:Location.t -> ( string * expr ) list -> expression
 val e_tuple : ?loc:Location.t -> expression list -> expression
@@ -73,15 +72,12 @@ val e_some : ?loc:Location.t -> expression -> expression
 val e_none : ?loc:Location.t -> unit -> expression
 val e_string_cat : ?loc:Location.t -> expression -> expression -> expression
 val e_map_add : ?loc:Location.t -> expression -> expression ->  expression -> expression
-val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression
-val e_set : ?loc:Location.t -> expression list -> expression
-val e_list : ?loc:Location.t -> expression list -> expression
 val e_pair : ?loc:Location.t -> expression -> expression -> expression
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
 val e_matching_bool : ?loc:Location.t -> expression -> expression -> expression -> expression
-val e_accessor : ?loc:Location.t -> expression -> string -> expression
+val e_record_accessor : ?loc:Location.t -> expression -> string -> expression
-val e_accessor_list : ?loc:Location.t -> expression -> string list -> 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
@@ -89,7 +85,6 @@ val e_annotation : ?loc:Location.t -> expression -> type_expression -> expressio
 val e_application : ?loc:Location.t -> expression -> expression -> expression
 val e_binop    : ?loc:Location.t -> constant' -> expression -> expression -> expression
 val e_constant : ?loc:Location.t -> constant' -> expression list -> expression
-val e_look_up : ?loc:Location.t -> expression -> expression -> expression
 val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content
 val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression
 
@@ -97,24 +92,17 @@ val make_option_typed : ?loc:Location.t -> expression -> type_expression option
 
 val e_typed_none : ?loc:Location.t -> type_expression -> expression
 
-val e_typed_list : ?loc:Location.t -> expression list -> type_expression -> expression
-
-val e_typed_map : ?loc:Location.t -> ( expression * expression ) list  -> type_expression -> type_expression -> expression
-val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list  -> type_expression -> type_expression -> expression
-
-val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression
-
 val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
 val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
 val e_record : ?loc:Location.t -> expr Map.String.t -> expression
-val e_update : ?loc:Location.t -> expression -> string -> expression -> expression
+val e_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
 
@@ -126,8 +114,6 @@ val is_e_failwith : expression -> bool
 *)
 val extract_pair : expression -> ( expression * expression ) result 
 
-val extract_list : expression -> (expression list) result
-
 val extract_record : expression -> (label * expression) list result
 
 val extract_map : expression -> (expression * expression) list result

src/stages/3-ast_core/misc.ml

@@ -139,52 +139,13 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
     ok ()
   | E_record_update _, _ ->
      simple_fail "comparing record update with other expression"
-
-  | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
-      let%bind lst = generic_try (simple_error "maps of different lengths")
-          (fun () ->
-             let lsta' = List.sort compare lsta in
-             let lstb' = List.sort compare lstb in
-             List.combine lsta' lstb') in
-      let aux = fun ((ka, va), (kb, vb)) ->
-        let%bind _ = assert_value_eq (ka, kb) in
-        let%bind _ = assert_value_eq (va, vb) in
-        ok () in
-      let%bind _all = bind_map_list aux lst in
-      ok ()
-    )
-  | (E_map _ | E_big_map _), _ ->
-      simple_fail "comparing map with other expression"
-
-  | E_list lsta, E_list lstb -> (
-      let%bind lst =
-        generic_try (simple_error "list of different lengths")
-          (fun () -> List.combine lsta lstb) in
-      let%bind _all = bind_map_list assert_value_eq lst in
-      ok ()
-    )
-  | E_list _, _ ->
-      simple_fail "comparing list with other expression"
-
-  | E_set lsta, E_set lstb -> (
-      let lsta' = List.sort (compare) lsta in
-      let lstb' = List.sort (compare) lstb in
-      let%bind lst =
-        generic_try (simple_error "set of different lengths")
-          (fun () -> List.combine lsta' lstb') in
-      let%bind _all = bind_map_list assert_value_eq lst in
-      ok ()
-    )
-  | E_set _, _ ->
-      simple_fail "comparing set with other expression"
-
   | (E_ascription a ,  _b') -> assert_value_eq (a.anno_expr , b)
   | (_a' , E_ascription b) -> assert_value_eq (a , b.anno_expr)
   | (E_variable _, _) | (E_lambda _, _)
   | (E_application _, _) | (E_let_in _, _)
   | (E_recursive _,_) | (E_record_accessor _, _)
-  | (E_look_up _, _) | (E_matching _, _)
+  | (E_matching _, _)
-   -> simple_fail "comparing not a value"
+  -> simple_fail "comparing not a value"
 
 let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)
 

src/stages/3-ast_core/types.ml

@@ -41,15 +41,8 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of accessor
+  | E_record_accessor of record_accessor
-  | E_record_update of update
+  | E_record_update   of record_update
-  (* Data Structures *)
-  (* TODO : move to constant*)
-  | E_map of (expression * expression) list (*move to operator *)
-  | E_big_map of (expression * expression) list (*move to operator *)
-  | E_list of expression list
-  | E_set of expression list
-  | E_look_up of (expression * expression)
   (* Advanced *)
   | E_ascription of ascription
 
@@ -82,9 +75,8 @@ and let_in =
 
 and constructor = {constructor: constructor'; element: expression}
 
-and accessor = {expr: 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 =

src/stages/4-ast_typed/PP.ml

@@ -29,19 +29,9 @@ 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.expr 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_map m ->
-      fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
-  | E_big_map m ->
-      fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m
-  | E_list lst ->
-      fprintf ppf "list[%a]" (list_sep_d expression) lst
-  | E_set lst ->
-      fprintf ppf "set[%a]" (list_sep_d expression) lst
-  | E_look_up (ds, ind) ->
-      fprintf ppf "(%a)[%a]" expression ds expression ind
   | E_lambda {binder; result} ->
       fprintf ppf "lambda (%a) return %a" expression_variable binder
         expression result

src/stages/4-ast_typed/combinators.ml

@@ -64,6 +64,7 @@ let t_pair a b ?s ()   : type_expression = ez_t_record [(Label "0",a) ; (Label "
 
 let t_map key value ?s () = make_t (T_operator (TC_map (key , value))) s
 let t_big_map key value ?s () = make_t (T_operator (TC_big_map (key , value))) s
+let t_map_or_big_map key value ?s () = make_t (T_operator (TC_map_or_big_map (key,value))) s
 
 let t_sum m ?s () : type_expression = make_t (T_sum m) s
 let make_t_ez_sum (lst:(constructor' * type_expression) list) : type_expression =
@@ -190,11 +191,13 @@ let get_t_record (t:type_expression) : type_expression label_map result = match
 let get_t_map (t:type_expression) : (type_expression * type_expression) result =
   match t.type_content with
   | T_operator (TC_map (k,v)) -> ok (k, v)
+  | T_operator (TC_map_or_big_map (k,v)) -> ok (k, v)
   | _ -> fail @@ Errors.not_a_x_type "map" t ()
 
 let get_t_big_map (t:type_expression) : (type_expression * type_expression) result =
   match t.type_content with
   | T_operator (TC_big_map (k,v)) -> ok (k, v)
+  | T_operator (TC_map_or_big_map (k,v)) -> ok (k, v)
   | _ -> fail @@ Errors.not_a_x_type "big_map" t ()
 
 let get_t_map_key : type_expression -> type_expression result = fun t ->
@@ -276,8 +279,6 @@ let ez_e_record (lst : (label * expression) list) : expression_content =
 let e_some s : expression_content = E_constant {cons_name=C_SOME;arguments=[s]}
 let e_none (): expression_content = E_constant {cons_name=C_NONE; arguments=[]}
 
-let e_map lst : expression_content = E_map lst
-
 let e_unit () : expression_content =     E_literal (Literal_unit)
 let e_int n : expression_content = E_literal (Literal_int n)
 let e_nat n : expression_content = E_literal (Literal_nat n)
@@ -296,7 +297,6 @@ let e_lambda l : expression_content = E_lambda l
 let e_pair a b : expression_content = ez_e_record [(Label "0",a);(Label "1", b)]
 let e_application lamb args : expression_content = E_application {lamb;args}
 let e_variable v : expression_content = E_variable v
-let e_list lst : expression_content = E_list lst
 let e_let_in let_binder inline rhs let_result = E_let_in { let_binder ; rhs ; let_result; inline }
 
 let e_a_unit = make_a_e (e_unit ()) (t_unit ())
@@ -314,8 +314,6 @@ let e_a_record r = make_a_e (e_record r) (t_record (LMap.map get_type_expression
 let e_a_application a b = make_a_e (e_application a b) (get_type_expression b)
 let e_a_variable v ty = make_a_e (e_variable v) ty
 let ez_e_a_record r = make_a_e (ez_e_record r) (ez_t_record (List.map (fun (x, y) -> x, y.type_expression) r) ())
-let e_a_map lst k v = make_a_e (e_map lst) (t_map k v ())
-let e_a_list lst t = make_a_e (e_list lst) (t_list t ())
 let e_a_let_in binder expr body attributes = make_a_e (e_let_in binder expr body attributes) (get_type_expression body)
 
 
@@ -337,7 +335,7 @@ let get_a_bool (t:expression) =
 
 let get_a_record_accessor = fun t ->
   match t.expression_content with
-  | E_record_accessor {expr ; label} -> ok (expr , 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/combinators.mli

@@ -31,6 +31,7 @@ val ez_t_record : ( label * type_expression ) list -> ?s:S.type_expression -> un
 
 val t_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
 val t_big_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
+val t_map_or_big_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
 val t_sum : type_expression constructor_map -> ?s:S.type_expression -> unit -> type_expression
 val make_t_ez_sum : ( constructor' * type_expression ) list -> type_expression
 val t_function : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
@@ -109,7 +110,6 @@ val ez_e_record : ( string * expression ) list -> expression
 *)
 val e_some : expression -> expression_content
 val e_none : unit -> expression_content
-val e_map : ( expression * expression ) list -> expression_content
 val e_unit : unit -> expression_content
 val e_int : int -> expression_content
 val e_nat : int -> expression_content
@@ -128,7 +128,6 @@ val e_lambda : lambda -> expression_content
 val e_pair : expression -> expression -> expression_content
 val e_application : expression -> expr -> expression_content
 val e_variable : expression_variable -> expression_content
-val e_list : expression list -> expression_content
 val e_let_in : expression_variable -> inline -> expression -> expression -> expression_content
 
 val e_a_unit : full_environment -> expression
@@ -146,8 +145,6 @@ val e_a_record : expression label_map -> full_environment -> expression
 val e_a_application : expression -> expression -> full_environment -> expression
 val e_a_variable : expression_variable -> type_expression -> full_environment -> expression
 val ez_e_a_record : ( label * expression ) list -> full_environment -> expression
-val e_a_map : ( expression * expression ) list -> type_expression -> type_expression -> full_environment -> expression
-val e_a_list : expression list -> type_expression -> full_environment -> expression
 val e_a_let_in : expression_variable -> bool -> expression -> expression -> full_environment -> expression
 
 val get_a_int : expression -> int result

src/stages/4-ast_typed/combinators_environment.ml

@@ -14,8 +14,6 @@ let e_a_empty_pair a b = e_a_pair a b Environment.full_empty
 let e_a_empty_some s = e_a_some s Environment.full_empty
 let e_a_empty_none t = e_a_none t Environment.full_empty
 let e_a_empty_record r = e_a_record r Environment.full_empty
-let e_a_empty_map lst k v = e_a_map lst k v Environment.full_empty
-let e_a_empty_list lst t = e_a_list lst t Environment.full_empty
 let ez_e_a_empty_record r = ez_e_a_record r Environment.full_empty
 let e_a_empty_lambda l i o = e_a_lambda l i o Environment.full_empty
 

src/stages/4-ast_typed/combinators_environment.mli

@@ -13,8 +13,6 @@ val e_a_empty_pair : expression -> expression -> expression
 val e_a_empty_some : expression -> expression
 val e_a_empty_none : type_expression -> expression
 val e_a_empty_record : expression label_map -> expression
-val e_a_empty_map : (expression * expression ) list -> type_expression -> type_expression -> expression
-val e_a_empty_list : expression list -> type_expression -> expression
 val ez_e_a_empty_record : ( label * expression ) list -> expression
 val e_a_empty_lambda : lambda -> type_expression -> type_expression -> expression
 

src/stages/4-ast_typed/misc.ml

@@ -209,12 +209,8 @@ module Free_variables = struct
     | E_application {lamb;args} -> unions @@ List.map self [ lamb ; args ]
     | E_constructor {element;_} -> self element
     | E_record m -> unions @@ List.map self @@ LMap.to_list m
-    | E_record_accessor {expr;_} -> self expr
+    | E_record_accessor {record;_} -> self record
     | E_record_update {record; update;_} -> union (self record) @@ self update
-    | E_list lst -> unions @@ List.map self lst
-    | E_set lst -> unions @@ List.map self lst
-    | (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
-    | E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
     | E_matching {matchee; cases;_} -> union (self matchee) (matching_expression b cases)
     | E_let_in { let_binder; rhs; let_result; _} ->
       let b' = union (singleton let_binder) b in
@@ -342,10 +338,11 @@ let rec assert_type_expression_eq (a, b: (type_expression * type_expression)) :
       | TC_list la, TC_list lb
       | TC_contract la, TC_contract lb
       | TC_set la, TC_set lb -> ok @@ ([la], [lb])
-      | TC_map (ka,va), TC_map (kb,vb)
+      | (TC_map (ka,va) | TC_map_or_big_map (ka,va)), (TC_map (kb,vb) | TC_map_or_big_map (kb,vb))
-      | TC_big_map (ka,va), TC_big_map (kb,vb) -> ok @@ ([ka;va] ,[kb;vb]) 
+      | (TC_big_map (ka,va) | TC_map_or_big_map (ka,va)), (TC_big_map (kb,vb) | TC_map_or_big_map (kb,vb))
-      | (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_arrow _),
+       -> ok @@ ([ka;va] ,[kb;vb]) 
-        (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_arrow _ ) -> fail @@ different_operators opa opb
+      | (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ | TC_arrow _),
+        (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ | TC_arrow _ ) -> fail @@ different_operators opa opb
       in
       if List.length lsta <> List.length lstb then
         fail @@ different_operator_number_of_arguments opa opb (List.length lsta) (List.length lstb)
@@ -497,44 +494,10 @@ let rec assert_value_eq (a, b: (expression*expression)) : unit result =
   | E_record _, _ ->
       fail @@ (different_values_because_different_types "record vs. non-record" a b)
 
-  | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
-      let%bind lst = generic_try (different_size_values "maps of different lengths" a b)
-          (fun () ->
-             let lsta' = List.sort compare lsta in
-             let lstb' = List.sort compare lstb in
-             List.combine lsta' lstb') in
-      let aux = fun ((ka, va), (kb, vb)) ->
-        let%bind _ = assert_value_eq (ka, kb) in
-        let%bind _ = assert_value_eq (va, vb) in
-        ok () in
-      let%bind _all = bind_map_list aux lst in
-      ok ()
-    )
-  | (E_map _ | E_big_map _), _ ->
-      fail @@ different_values_because_different_types "map vs. non-map" a b
-
-  | E_list lsta, E_list lstb -> (
-      let%bind lst =
-        generic_try (different_size_values "lists of different lengths" a b)
-          (fun () -> List.combine lsta lstb) in
-      let%bind _all = bind_map_list assert_value_eq lst in
-      ok ()
-    )
-  | E_list _, _ ->
-      fail @@ different_values_because_different_types "list vs. non-list" a b
-  | E_set lsta, E_set lstb -> (
-      let%bind lst =
-        generic_try (different_size_values "sets of different lengths" a b)
-          (fun () -> List.combine lsta lstb) in
-      let%bind _all = bind_map_list assert_value_eq lst in
-      ok ()
-    )
-  | E_set _, _ ->
-      fail @@ different_values_because_different_types "set vs. non-set" a b
   | (E_literal _, _) | (E_variable _, _) | (E_application _, _)
   | (E_lambda _, _) | (E_let_in _, _) | (E_recursive _, _)
   | (E_record_accessor _, _) | (E_record_update _,_)
-  | (E_look_up _, _) | (E_matching _, _)
+  | (E_matching _, _)
   -> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b
 
 let merge_annotation (a:type_expression option) (b:type_expression option) err : type_expression result =

src/stages/4-ast_typed/misc_smart.ml

@@ -70,23 +70,11 @@ module Captured_variables = struct
     | E_record m ->
       let%bind lst' = bind_map_list self @@ LMap.to_list m in
       ok @@ unions lst'
-    | E_record_accessor {expr;_} -> self expr
+    | E_record_accessor {record;_} -> self record
     | E_record_update {record;update;_} -> 
       let%bind r = self record in
       let%bind e = self update in
       ok @@ union r e
-    | E_list lst ->
-      let%bind lst' = bind_map_list self lst in
-      ok @@ unions lst'
-    | E_set lst ->
-      let%bind lst' = bind_map_list self lst in
-      ok @@ unions lst'
-    | (E_map m | E_big_map m) ->
-      let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in
-      ok @@ unions lst'
-    | E_look_up (a , b) ->
-      let%bind lst' = bind_map_list self [ a ; b ] in
-      ok @@ unions lst'
     | E_matching {matchee;cases;_} ->
       let%bind a' = self matchee in
       let%bind cs' = matching_expression b cases in

src/stages/4-ast_typed/types.ml

@@ -47,15 +47,8 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of accessor
+  | E_record_accessor of record_accessor
-  | E_record_update of update
+  | E_record_update   of record_update
-  (* Data Structures *)
-  (* TODO : move to constant*)
-  | E_map of (expression * expression) list (*move to operator *)
-  | E_big_map of (expression * expression) list (*move to operator *)
-  | E_list of expression list
-  | E_set of expression list
-  | E_look_up of (expression * expression)
 
 and constant =
   { cons_name: constant'
@@ -91,12 +84,12 @@ and constructor = {
     element: expression ;
   }
 
-and accessor = {
+and record_accessor = {
-    expr: expression ;
+    record: expression ;
-    label: label ;
+    path: label ;
   }
 
-and update = {
+and record_update = {
     record: expression ;
     path: label ;
     update: expression ;

src/stages/5-mini_c/PP.ml

@@ -86,10 +86,6 @@ and expression' ppf (e:expression') = match e with
 
   | E_constant c -> fprintf ppf "%a %a" constant c.cons_name (pp_print_list ~pp_sep:space_sep expression) c.arguments
   | E_literal v -> fprintf ppf "L(%a)" value v
-  | E_make_empty_map _ -> fprintf ppf "map[]"
-  | E_make_empty_big_map _ -> fprintf ppf "big_map[]"
-  | E_make_empty_list _ -> fprintf ppf "list[]"
-  | E_make_empty_set _ -> fprintf ppf "set[]"
   | E_make_none _ -> fprintf ppf "none"
   | E_if_bool (c, a, b) -> fprintf ppf "%a ? %a : %a" expression c expression a expression b
   | E_if_none (c, n, ((name, _) , s)) -> fprintf ppf "%a ?? %a : %a -> %a" expression c expression n Var.pp name expression s
@@ -199,6 +195,8 @@ and constant ppf : constant' -> unit = function
   | C_SET_FOLD              -> fprintf ppf "SET_FOLD"
   | C_SET_MEM               -> fprintf ppf "SET_MEM"
   (* List *)
+  | C_LIST_EMPTY            -> fprintf ppf "LIST_EMPTY"
+  | C_LIST_LITERAL          -> fprintf ppf "LIST_LITERAL"
   | C_LIST_ITER             -> fprintf ppf "LIST_ITER"
   | C_LIST_MAP              -> fprintf ppf "LIST_MAP"
   | C_LIST_FOLD             -> fprintf ppf "LIST_FOLD"

src/stages/5-mini_c/misc.ml

@@ -44,10 +44,6 @@ module Free_variables = struct
     | E_constant (c) -> unions @@ List.map self c.arguments
     | E_application (f, x) -> unions @@ [ self f ; self x ]
     | E_variable n -> var_name b n
-    | E_make_empty_map _ -> empty
-    | E_make_empty_big_map _ -> empty
-    | E_make_empty_list _ -> empty
-    | E_make_empty_set _ -> empty
     | E_make_none _ -> empty
     | E_iterator (_, ((v, _), body), expr) ->
       unions [ expression (union (singleton v) b) body ;

src/stages/5-mini_c/types.ml

@@ -59,10 +59,6 @@ and expression' =
   | E_constant of constant
   | E_application of (expression * expression)
   | E_variable of var_name
-  | E_make_empty_map of (type_value * type_value)
-  | E_make_empty_big_map of (type_value * type_value)
-  | E_make_empty_list of type_value
-  | E_make_empty_set of type_value
   | E_make_none of type_value
   | E_iterator of constant' * ((var_name * type_value) * expression) * expression
   | E_fold of (((var_name * type_value) * expression) * expression * 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 = Helpers.tuple_of_record m in
-  let lst = List.sort (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
+  let new_pp ppf (_, v) = fprintf ppf "%a" value v in
-  let new_pp ppf (_k, v) = fprintf ppf "%a" value v in
   fprintf ppf "%a" (list_sep new_pp sep) lst
 
 (* Prints records which only contain the consecutive fields
@@ -105,6 +104,8 @@ let constant ppf : constant' -> unit = function
   | C_SET_FOLD              -> fprintf ppf "SET_FOLD"
   | C_SET_MEM               -> fprintf ppf "SET_MEM"
   (* List *)
+  | C_LIST_EMPTY            -> fprintf ppf "LIST_EMPTY"
+  | C_LIST_LITERAL          -> fprintf ppf "LIST_LITERAL"
   | C_LIST_ITER             -> fprintf ppf "LIST_ITER"
   | C_LIST_MAP              -> fprintf ppf "LIST_MAP"
   | C_LIST_FOLD             -> fprintf ppf "LIST_FOLD"
@@ -154,43 +155,50 @@ let constant ppf : constant' -> unit = function
 
 let literal ppf (l : literal) =
   match l with
-  | Literal_unit ->
+  | Literal_unit -> fprintf ppf "unit"
-      fprintf ppf "unit"
+  | Literal_void -> fprintf ppf "void"
-  | Literal_void ->
+  | Literal_bool b -> fprintf ppf "%b" b
-      fprintf ppf "void"
+  | Literal_int n -> fprintf ppf "%d" n
-  | Literal_bool b ->
+  | Literal_nat n -> fprintf ppf "+%d" n
-      fprintf ppf "%b" b
+  | Literal_timestamp n -> fprintf ppf "+%d" n
-  | Literal_int n ->
+  | Literal_mutez n -> fprintf ppf "%dmutez" n
-      fprintf ppf "%d" n
+  | Literal_string s -> fprintf ppf "%S" s
-  | Literal_nat n ->
+  | Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
-      fprintf ppf "+%d" n
+  | Literal_address s -> fprintf ppf "@%S" s
-  | Literal_timestamp n ->
+  | Literal_operation _ -> fprintf ppf "Operation(...bytes)"
-      fprintf ppf "+%d" n
+  | Literal_key s -> fprintf ppf "key %s" s
-  | Literal_mutez n ->
+  | Literal_key_hash s -> fprintf ppf "key_hash %s" s
-      fprintf ppf "%dmutez" n
+  | Literal_signature s -> fprintf ppf "Signature %s" s
-  | Literal_string s ->
+  | Literal_chain_id s -> fprintf ppf "Chain_id %s" s
-      fprintf ppf "%S" s
+
-  | Literal_bytes b ->
+let type_variable ppf (t : type_variable) : unit = fprintf ppf "%a" Var.pp t
-      fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
+
-  | Literal_address s ->
+and type_constant ppf (tc : type_constant) : unit =
-      fprintf ppf "@%S" s
+let s =
-  | Literal_operation _ ->
+    match tc with
-      fprintf ppf "Operation(...bytes)"
+    | TC_unit -> "unit"
-  | Literal_key s ->
+    | TC_string -> "string"
-      fprintf ppf "key %s" s
+    | TC_bytes -> "bytes"
-  | Literal_key_hash s ->
+    | TC_nat -> "nat"
-      fprintf ppf "key_hash %s" s
+    | TC_int -> "int"
-  | Literal_signature s ->
+    | TC_mutez -> "mutez"
-      fprintf ppf "Signature %s" s
+    | TC_bool -> "bool"
-  | Literal_chain_id s ->
+    | TC_operation -> "operation"
-      fprintf ppf "Chain_id %s" s
+    | 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
@@ -198,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 ->
+    | T_sum m -> fprintf ppf "sum[%a]" (cmap_sep_d f) m
-        fprintf ppf "sum[%a]" (cmap_sep_d f) m
+    | T_record m -> fprintf ppf "%a" (tuple_or_record_sep_type f) m
-    | T_record m ->
+    | T_arrow a -> fprintf ppf "%a -> %a" f a.type1 f a.type2
-        fprintf ppf "%a" (tuple_or_record_sep_type f) m
+    | T_variable tv -> type_variable ppf tv
-    | T_arrow a ->
+    | T_constant tc -> type_constant ppf tc
-        fprintf ppf "%a -> %a" f a.type1 f a.type2
+    | T_operator to_ -> type_operator f ppf to_
-    | 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
@@ -263,6 +229,7 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
       | 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_map_or_big_map (k, v) -> Format.asprintf "Map Or 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

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/common/types.ml

@@ -53,6 +53,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | TC_set of type_expression
     | TC_map of type_expression * type_expression
     | TC_big_map of type_expression * type_expression
+    | TC_map_or_big_map of type_expression * type_expression
     | TC_arrow of type_expression * type_expression
 
 
@@ -66,6 +67,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | 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)
+    | TC_map_or_big_map (x , y)-> TC_map_or_big_map (f x , f y)
     | TC_arrow (x, y) -> TC_arrow (f x, f y)
 
   let bind_map_type_operator f = function
@@ -75,6 +77,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | 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)
+    | TC_map_or_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_map_or_big_map (x , y)
     | TC_arrow (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_arrow (x , y)
 
   let type_operator_name = function
@@ -84,6 +87,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
       | TC_set      _ -> "TC_set"
       | TC_map      _ -> "TC_map"
       | TC_big_map  _ -> "TC_big_map"
+      | TC_map_or_big_map _ -> "TC_map_or_big_map"
       | TC_arrow    _ -> "TC_arrow"
 
   let type_expression'_of_string = function
@@ -122,6 +126,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | TC_set       x       -> "TC_set"      , [x]
     | TC_map       (x , y) -> "TC_map"      , [x ; y]
     | TC_big_map   (x , y) -> "TC_big_map"  , [x ; y]
+    | TC_map_or_big_map   (x , y) -> "TC_map_or_big_map"  , [x ; y]
     | TC_arrow     (x , y) -> "TC_arrow"    , [x ; y]
 
   let string_of_type_constant = function
@@ -247,6 +252,8 @@ and constant' =
   | C_SET_FOLD
   | C_SET_MEM
   (* List *)
+  | C_LIST_EMPTY
+  | C_LIST_LITERAL
   | C_LIST_ITER
   | C_LIST_MAP
   | C_LIST_FOLD

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,38 +182,14 @@ 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 {expr=e;label} ->
+      | T.E_record_accessor {record=e;path} ->
-        let%bind expr = s_expression ~substs e in
+        let%bind record = s_expression ~substs e in
-        let%bind label = s_label ~substs label in
+        let%bind path = s_label ~substs path in
-        ok @@ T.E_record_accessor {expr;label}
+        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
         ok @@ T.E_record_update {record;path;update}
-      | T.E_map             val_val_list ->
-        let%bind val_val_list = bind_map_list (fun (val1 , val2) ->
-            let%bind val1 = s_expression ~substs val1 in
-            let%bind val2 = s_expression ~substs val2 in
-            ok @@ (val1 , val2)
-          ) val_val_list in
-        ok @@ T.E_map val_val_list
-      | T.E_big_map         val_val_list ->
-        let%bind val_val_list = bind_map_list (fun (val1 , val2) ->
-            let%bind val1 = s_expression ~substs val1 in
-            let%bind val2 = s_expression ~substs val2 in
-            ok @@ (val1 , val2)
-          ) val_val_list in
-        ok @@ T.E_big_map val_val_list
-      | T.E_list            vals ->
-        let%bind vals = bind_map_list (s_expression ~substs) vals in
-        ok @@ T.E_list vals
-      | T.E_set             vals ->
-        let%bind vals = bind_map_list (s_expression ~substs) vals in
-        ok @@ T.E_set vals
-      | T.E_look_up         (val1, val2) ->
-        let%bind val1 = s_expression ~substs val1 in
-        let%bind val2 = s_expression ~substs val2 in
-        ok @@ T.E_look_up (val1 , val2)
       | T.E_matching   {matchee;cases} ->
         let%bind matchee = s_expression ~substs matchee in
         let%bind cases = s_matching_expr ~substs cases in

src/test/contracts/loop.ligo

@@ -54,9 +54,9 @@ function for_collection_if_and_local_var (var nee : unit) : int is
   block {
     var acc : int := 0;
     const theone : int = 1;
+    const thetwo : int = 2;
     var myset : set (int) := set [1; 2; 3];
     for x in set myset block {
-      const thetwo : int = 2;
       if x = theone then acc := acc + x
       else if x = thetwo then acc := acc + thetwo
       else acc := acc + 10

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  =

src/test/multisig_v2_tests.ml

@@ -33,7 +33,7 @@ let empty_message = e_lambda (Var.of_name "arguments")
   empty_op_list
 let empty_message2 = e_lambda (Var.of_name "arguments")
   (Some t_bytes) (Some (t_list t_operation))
- ( e_let_in ((Var.of_name "foo"),Some t_unit) false false (e_unit ()) empty_op_list)
+ ( e_let_in ((Var.of_name "foo"),Some t_unit) false (e_unit ()) empty_op_list)
 
 let send_param msg = e_constructor "Send" msg
 let withdraw_param = e_constructor "Withdraw" empty_message