Merge branch 'master' of gitlab.com:gabriel.alfour/tezos

src/ligo/ligo-parser/.gitignore

@@ -1 +1,8 @@
+_build/*
+*/_build
+*~
+.merlin
+*/.merlin
+*.install
 /Version.ml
+/dune-project

src/ligo/ligo-parser/.gitlab-ci.yml

@@ -0,0 +1,21 @@
+before_script:
+  - apt-get update -qq
+  - apt-get -y -qq install libhidapi-dev libcap-dev bubblewrap
+  - wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O opam-2.0.1-x86_64-linux
+  - cp opam-2.0.1-x86_64-linux /usr/local/bin/opam
+  - chmod +x /usr/local/bin/opam
+  - export PATH="/usr/local/bin${PATH:+:}${PATH:-}"
+  - echo "$PATH"
+  - printf '' | opam init
+  - eval $(opam config env)
+  - opam repository add tezos-opam-repository https://gitlab.com/gabriel.alfour/tezos-opam-repository.git
+  - eval $(opam config env)
+  - opam --version
+  - printf '' | ocaml
+
+default-job:
+  script:
+    - opam install -y --working-dir .
+  artifacts:
+    paths:
+      - Parser.exe

src/ligo/ligo-parser/AST.ml

@@ -39,26 +39,36 @@ let sepseq_to_region to_region = function
 
 (* Keywords of LIGO *)
 
+type keyword        = Region.t
+type kwd_and        = Region.t
 type kwd_begin      = Region.t
+type kwd_block      = Region.t
 type kwd_case       = Region.t
 type kwd_const      = Region.t
+type kwd_contains   = Region.t
 type kwd_down       = Region.t
 type kwd_else       = Region.t
 type kwd_end        = Region.t
 type kwd_entrypoint = Region.t
 type kwd_fail       = Region.t
 type kwd_for        = Region.t
+type kwd_from       = Region.t
 type kwd_function   = Region.t
 type kwd_if         = Region.t
 type kwd_in         = Region.t
 type kwd_is         = Region.t
+type kwd_list       = Region.t
 type kwd_map        = Region.t
 type kwd_mod        = Region.t
+type kwd_nil        = Region.t
 type kwd_not        = Region.t
 type kwd_of         = Region.t
+type kwd_or         = Region.t
 type kwd_patch      = Region.t
 type kwd_procedure  = Region.t
 type kwd_record     = Region.t
+type kwd_remove     = Region.t
+type kwd_set        = Region.t
 type kwd_skip       = Region.t
 type kwd_step       = Region.t
 type kwd_storage    = Region.t
@@ -93,8 +103,6 @@ type arrow    = Region.t
 type assign   = Region.t
 type equal    = Region.t
 type colon    = Region.t
-type bool_or  = Region.t
-type bool_and = Region.t
 type lt       = Region.t
 type leq      = Region.t
 type gt       = Region.t
@@ -119,6 +127,7 @@ type fun_name   = string reg
 type type_name  = string reg
 type field_name = string reg
 type map_name   = string reg
+type set_name   = string reg
 type constr     = string reg
 
 (* Parentheses *)
@@ -196,9 +205,10 @@ and variant = {
 }
 
 and record_type = {
-  kwd_record : kwd_record;
+  opening     : kwd_record;
-  fields     : field_decls;
+  field_decls : field_decls;
-  kwd_end    : kwd_end
+  terminator  : semi option;
+  closing     : kwd_end
 }
 
 and field_decls = (field_decl reg, semi) nsepseq
@@ -291,15 +301,32 @@ and param_var = {
 }
 
 and block = {
-  opening    : kwd_begin;
+  opening    : block_opening;
-  instr      : instructions;
+  statements : statements;
   terminator : semi option;
-  close      : kwd_end
+  closing    : block_closing
 }
 
+and block_opening =
+  Block of kwd_block * lbrace
+| Begin of kwd_begin
+
+and block_closing =
+  Block of rbrace
+| End   of kwd_end
+
+and statements = (statement, semi) nsepseq
+
+and statement =
+  Instr of instruction
+| Data  of data_decl
+
 and local_decl =
   LocalLam   of lambda_decl
-| LocalConst of const_decl reg
+| LocalData  of data_decl
+
+and data_decl =
+  LocalConst of const_decl reg
 | LocalVar   of var_decl reg
 
 and var_decl = {
@@ -312,8 +339,6 @@ and var_decl = {
   terminator : semi option
 }
 
-and instructions = (instruction, semi) nsepseq
-
 and instruction =
   Single of single_instr
 | Block  of block reg
@@ -328,19 +353,38 @@ and single_instr =
 | Skip        of kwd_skip
 | RecordPatch of record_patch reg
 | MapPatch    of map_patch reg
+| SetPatch    of set_patch reg
+| MapRemove   of map_remove reg
+| SetRemove   of set_remove reg
+
+and set_remove = {
+  kwd_remove : kwd_remove;
+  element    : expr;
+  kwd_from   : kwd_from;
+  kwd_set    : kwd_set;
+  set        : path
+}
+
+and map_remove = {
+  kwd_remove : kwd_remove;
+  key        : expr;
+  kwd_from   : kwd_from;
+  kwd_map    : kwd_map;
+  map        : path
+}
+
+and set_patch  = {
+  kwd_patch : kwd_patch;
+  path      : path;
+  kwd_with  : kwd_with;
+  set_inj   : expr injection reg
+}
 
 and map_patch  = {
   kwd_patch : kwd_patch;
   path      : path;
   kwd_with  : kwd_with;
-  map_inj   : map_injection reg
+  map_inj   : binding reg injection reg
-}
-
-and map_injection = {
-  opening    : kwd_map;
-  bindings   : (binding reg, semi) nsepseq;
-  terminator : semi option;
-  close      : kwd_end
 }
 
 and binding = {
@@ -362,12 +406,23 @@ and fail_instr = {
 }
 
 and conditional = {
-  kwd_if   : kwd_if;
+  kwd_if     : kwd_if;
-  test     : expr;
+  test       : expr;
-  kwd_then : kwd_then;
+  kwd_then   : kwd_then;
-  ifso     : instruction;
+  ifso       : if_clause;
-  kwd_else : kwd_else;
+  terminator : semi option;
-  ifnot    : instruction
+  kwd_else   : kwd_else;
+  ifnot      : if_clause
+}
+
+and if_clause =
+  ClauseInstr of instruction
+| ClauseBlock of (statements * semi option) braces reg
+
+and set_membership = {
+  set          : expr;
+  kwd_contains : kwd_contains;
+  element      : expr
 }
 
 and case_instr = {
@@ -450,17 +505,37 @@ and expr =
 | ESet    of set_expr
 | EConstr of constr_expr
 | ERecord of record_expr
+| EProj   of projection reg
 | EMap    of map_expr
 | EVar    of Lexer.lexeme reg
 | ECall   of fun_call
 | EBytes  of (Lexer.lexeme * Hex.t) reg
 | EUnit   of c_Unit
-| ETuple  of tuple
+| ETuple  of tuple_expr
 | EPar    of expr par reg
 
+and set_expr =
+  SetInj of expr injection reg
+| SetMem of set_membership reg
+
+and 'a injection = {
+  opening    : opening;
+  elements   : ('a, semi) sepseq;
+  terminator : semi option;
+  closing    : closing
+}
+
+and opening =
+  Kwd        of keyword
+| KwdBracket of keyword * lbracket
+
+and closing =
+  End       of kwd_end
+| RBracket  of rbracket
+
 and map_expr =
   MapLookUp of map_lookup reg
-| MapInj    of map_injection reg
+| MapInj    of binding reg injection reg
 
 and map_lookup = {
   path  : path;
@@ -468,17 +543,17 @@ and map_lookup = {
 }
 
 and path =
-  Name       of variable
+  Name of variable
-| RecordPath of record_projection reg
+| Path of projection reg
 
 and logic_expr =
   BoolExpr of bool_expr
 | CompExpr of comp_expr
 
 and bool_expr =
-  Or    of bool_or  bin_op reg
+  Or    of kwd_or  bin_op reg
-| And   of bool_and bin_op reg
+| And   of kwd_and bin_op reg
-| Not   of kwd_not   un_op reg
+| Not   of kwd_not un_op reg
 | False of c_False
 | True  of c_True
 
@@ -515,13 +590,15 @@ and string_expr =
 | String of Lexer.lexeme reg
 
 and list_expr =
-  Cons      of cons bin_op reg
+  Cons of cons bin_op reg
-| List      of (expr, comma) nsepseq brackets reg
+| List of expr injection reg
-| EmptyList of empty_list reg
+| Nil  of nil par reg
 
-and set_expr =
+and nil = {
-  Set       of (expr, comma) nsepseq braces reg
+  nil       : kwd_nil;
-| EmptySet  of empty_set reg
+  colon     : colon;
+  list_type : type_expr
+}
 
 and constr_expr =
   SomeApp   of (c_Some * arguments) reg
@@ -529,14 +606,13 @@ and constr_expr =
 | ConstrApp of (constr * arguments) reg
 
 and record_expr =
-  RecordInj  of record_injection reg
+  RecordInj of record_injection reg
-| RecordProj of record_projection reg
 
 and record_injection = {
   opening    : kwd_record;
   fields     : (field_assign reg, semi) nsepseq;
   terminator : semi option;
-  close      : kwd_end
+  closing    : kwd_end
 }
 
 and field_assign = {
@@ -545,31 +621,20 @@ and field_assign = {
   field_expr : expr
 }
 
-and record_projection = {
+and projection = {
   record_name : variable;
   selector    : dot;
-  field_path  : (field_name, dot) nsepseq
+  field_path  : (selection, dot) nsepseq
 }
 
-and tuple = (expr, comma) nsepseq par reg
+and selection =
+  FieldName of field_name
+| Component of (Lexer.lexeme * Z.t) reg
 
-and empty_list = typed_empty_list par
+and tuple_expr =
+  TupleInj of tuple_injection
 
-and typed_empty_list = {
+and tuple_injection = (expr, comma) nsepseq par reg
-  lbracket  : lbracket;
-  rbracket  : rbracket;
-  colon     : colon;
-  list_type : type_expr
-}
-
-and empty_set = typed_empty_set par
-
-and typed_empty_set = {
-  lbrace   : lbrace;
-  rbrace   : rbrace;
-  colon    : colon;
-  set_type : type_expr
-}
 
 and none_expr = typed_none_expr par
 
@@ -581,7 +646,7 @@ and typed_none_expr = {
 
 and fun_call = (fun_name * arguments) reg
 
-and arguments = tuple
+and arguments = tuple_injection
 
 (* Patterns *)
 
@@ -601,7 +666,8 @@ and pattern =
 | PTuple  of (pattern, comma) nsepseq par reg
 
 and list_pattern =
-  Sugar of (pattern, comma) sepseq brackets reg
+  Sugar of pattern injection reg
+| PNil  of kwd_nil
 | Raw   of (pattern * cons * pattern) par reg
 
 (* Projecting regions *)
@@ -625,17 +691,25 @@ let rec expr_to_region = function
 | EConstr e -> constr_expr_to_region e
 | ERecord e -> record_expr_to_region e
 | EMap    e -> map_expr_to_region e
+| ETuple  e -> tuple_expr_to_region e
+| EProj  {region; _}
 | EVar   {region; _}
 | ECall  {region; _}
 | EBytes {region; _}
 | EUnit   region
-| ETuple {region; _}
 | EPar   {region; _} -> region
 
+and tuple_expr_to_region = function
+  TupleInj {region; _} -> region
+
 and map_expr_to_region = function
   MapLookUp {region; _}
 | MapInj    {region; _} -> region
 
+and set_expr_to_region = function
+  SetInj {region; _}
+| SetMem {region; _} -> region
+
 and logic_expr_to_region = function
   BoolExpr e -> bool_expr_to_region e
 | CompExpr e -> comp_expr_to_region e
@@ -669,13 +743,9 @@ and string_expr_to_region = function
 | String {region; _} -> region
 
 and list_expr_to_region = function
-  Cons      {region; _}
+  Cons {region; _}
-| List      {region; _}
+| List {region; _}
-| EmptyList {region; _} -> region
+| Nil  {region; _} -> region
-
-and set_expr_to_region = function
-  Set      {region; _}
-| EmptySet {region; _} -> region
 
 and constr_expr_to_region = function
   NoneExpr  {region; _}
@@ -683,12 +753,11 @@ and constr_expr_to_region = function
 | SomeApp   {region; _} -> region
 
 and record_expr_to_region = function
-  RecordInj  {region; _}
+  RecordInj  {region; _} -> region
-| RecordProj {region; _} -> region
 
 let path_to_region = function
   Name var -> var.region
-| RecordPath {region; _} -> region
+| Path {region; _} -> region
 
 let instr_to_region = function
   Single Cond                {region; _}
@@ -702,8 +771,15 @@ let instr_to_region = function
 | Single Fail                {region; _}
 | Single RecordPatch         {region; _}
 | Single MapPatch            {region; _}
+| Single SetPatch            {region; _}
+| Single MapRemove           {region; _}
+| Single SetRemove           {region; _}
 | Block                      {region; _} -> region
 
+let if_clause_to_region = function
+  ClauseInstr instr       -> instr_to_region instr
+| ClauseBlock {region; _} -> region
+
 let pattern_to_region = function
   PCons       {region; _}
 | PVar        {region; _}
@@ -717,17 +793,18 @@ let pattern_to_region = function
 | PNone        region
 | PSome       {region; _}
 | PList Sugar {region; _}
+| PList PNil  region
 | PList Raw   {region; _}
 | PTuple      {region; _} -> region
 
 let local_decl_to_region = function
-  LocalLam FunDecl   {region; _}
+  LocalLam FunDecl     {region; _}
-| LocalLam ProcDecl  {region; _}
+| LocalLam ProcDecl    {region; _}
-| LocalLam EntryDecl {region; _}
+| LocalLam EntryDecl   {region; _}
-| LocalConst         {region; _}
+| LocalData LocalConst {region; _}
-| LocalVar           {region; _} -> region
+| LocalData LocalVar   {region; _} -> region
 
-let lhs_to_region = function
+let lhs_to_region : lhs -> Region.t = function
   Path path -> path_to_region path
 | MapPath {region; _} -> region
 
@@ -735,6 +812,10 @@ let rhs_to_region = function
       Expr e -> expr_to_region e
 | NoneExpr r -> r
 
+let selection_to_region = function
+  FieldName {region; _}
+| Component {region; _} -> region
+
 (* Printing the tokens with their source regions *)
 
 let printf = Printf.printf
@@ -833,10 +914,11 @@ and print_sum_type {value; _} =
   print_nsepseq "|" print_variant value
 
 and print_record_type {value; _} =
-  let {kwd_record; fields; kwd_end} = value in
+  let {opening; field_decls; terminator; closing} = value in
-  print_token       kwd_record "record";
+  print_token       opening "record";
-  print_field_decls fields;
+  print_field_decls field_decls;
-  print_token       kwd_end "end"
+  print_terminator  terminator;
+  print_token       closing "end"
 
 and print_type_app {value; _} =
   let type_name, type_tuple = value in
@@ -955,19 +1037,31 @@ and print_param_var {value; _} =
   print_type_expr param_type
 
 and print_block {value; _} =
-  let {opening; instr; terminator; close} = value in
+  let {opening; statements; terminator; closing} = value in
-  print_token        opening "begin";
+  print_block_opening opening;
-  print_instructions instr;
+  print_statements    statements;
-  print_terminator   terminator;
+  print_terminator    terminator;
-  print_token        close "end"
+  print_block_closing closing
+
+and print_block_opening = function
+  Block (kwd_block, lbrace) -> print_token kwd_block "block";
+                              print_token lbrace    "{"
+| Begin kwd_begin           -> print_token kwd_begin "begin"
+
+and print_block_closing = function
+  Block rbrace -> print_token rbrace "}"
+| End kwd_end  -> print_token kwd_end "end"
 
 and print_local_decls sequence =
   List.iter print_local_decl sequence
 
 and print_local_decl = function
-  LocalLam   decl -> print_lambda_decl decl
+  LocalLam  decl -> print_lambda_decl decl
-| LocalConst decl -> print_const_decl  decl
+| LocalData decl -> print_data_decl decl
-| LocalVar   decl -> print_var_decl    decl
+
+and print_data_decl = function
+  LocalConst decl -> print_const_decl decl
+| LocalVar   decl -> print_var_decl   decl
 
 and print_var_decl {value; _} =
   let {kwd_var; name; colon; var_type;
@@ -980,12 +1074,16 @@ and print_var_decl {value; _} =
   print_expr       init;
   print_terminator terminator
 
-and print_instructions sequence =
+and print_statements sequence =
-  print_nsepseq ";" print_instruction sequence
+  print_nsepseq ";" print_statement sequence
+
+and print_statement = function
+  Instr instr -> print_instruction instr
+| Data data -> print_data_decl data
 
 and print_instruction = function
   Single instr -> print_single_instr instr
-|  Block block -> print_block block
+| Block block -> print_block block
 
 and print_single_instr = function
   Cond        {value; _} -> print_conditional value
@@ -997,20 +1095,34 @@ and print_single_instr = function
 | Skip        kwd_skip   -> print_token kwd_skip "skip"
 | RecordPatch {value; _} -> print_record_patch value
 | MapPatch    {value; _} -> print_map_patch value
+| SetPatch    {value; _} -> print_set_patch value
+| MapRemove   {value; _} -> print_map_remove value
+| SetRemove   {value; _} -> print_set_remove value
 
 and print_fail {kwd_fail; fail_expr} =
   print_token kwd_fail "fail";
   print_expr fail_expr
 
 and print_conditional node =
-  let {kwd_if; test; kwd_then; ifso;
+  let {kwd_if; test; kwd_then; ifso; terminator;
        kwd_else; ifnot} = node in
-  print_token       kwd_if "if";
+  print_token      kwd_if "if";
-  print_expr        test;
+  print_expr       test;
-  print_token       kwd_then "then";
+  print_token      kwd_then "then";
-  print_instruction ifso;
+  print_if_clause  ifso;
-  print_token       kwd_else "else";
+  print_terminator terminator;
-  print_instruction ifnot
+  print_token      kwd_else "else";
+  print_if_clause  ifnot
+
+and print_if_clause = function
+  ClauseInstr instr -> print_instruction instr
+| ClauseBlock {value; _} ->
+    let {lbrace; inside; rbrace} = value in
+    let statements, terminator = inside in
+    print_token lbrace "{";
+    print_statements statements;
+    print_terminator terminator;
+    print_token rbrace "}"
 
 and print_case_instr (node : case_instr) =
   let {kwd_case; expr; kwd_of;
@@ -1113,18 +1225,28 @@ and print_expr = function
 | ESet    e -> print_set_expr e
 | EConstr e -> print_constr_expr e
 | ERecord e -> print_record_expr e
+| EProj   e -> print_projection e
 | EMap    e -> print_map_expr e
 | EVar    v -> print_var v
 | ECall   e -> print_fun_call e
 | EBytes  b -> print_bytes b
 | EUnit   r -> print_token r "Unit"
-| ETuple  e -> print_tuple e
+| ETuple  e -> print_tuple_expr e
 | EPar    e -> print_par_expr e
 
 and print_map_expr = function
   MapLookUp {value; _} -> print_map_lookup value
-| MapInj inj ->
+| MapInj inj           -> print_injection "map" print_binding inj
-    print_map_injection inj
+
+and print_set_expr = function
+  SetInj inj -> print_injection "set" print_expr inj
+| SetMem mem -> print_set_membership mem
+
+and print_set_membership {value; _} =
+  let {set; kwd_contains; element} = value in
+  print_expr set;
+  print_token kwd_contains "contains";
+  print_expr element
 
 and print_map_lookup {path; index} =
   let {lbracket; inside; rbracket} = index.value in
@@ -1134,8 +1256,8 @@ and print_map_lookup {path; index} =
   print_token rbracket "]"
 
 and print_path = function
-  Name var        -> print_var var
+  Name var  -> print_var var
-| RecordPath path -> print_record_projection path
+| Path path -> print_projection path
 
 and print_logic_expr = function
   BoolExpr e -> print_bool_expr e
@@ -1188,12 +1310,8 @@ and print_string_expr = function
 and print_list_expr = function
   Cons {value = {arg1; op; arg2}; _} ->
     print_expr arg1; print_token op "#"; print_expr arg2
-| List e       -> print_list e
+| List e -> print_injection "list" print_expr e
-| EmptyList e  -> print_empty_list e
+| Nil  e -> print_nil e
-
-and print_set_expr = function
-  Set e      -> print_set e
-| EmptySet e -> print_empty_set e
 
 and print_constr_expr = function
   SomeApp e   -> print_some_app e
@@ -1201,15 +1319,14 @@ and print_constr_expr = function
 | ConstrApp e -> print_constr_app e
 
 and print_record_expr = function
-  RecordInj  e -> print_record_injection e
+  RecordInj e -> print_record_injection e
-| RecordProj e -> print_record_projection e
 
 and print_record_injection {value; _} =
-  let {opening; fields; terminator; close} = value in
+  let {opening; fields; terminator; closing} = value in
   print_token opening "record";
   print_nsepseq ";" print_field_assign fields;
   print_terminator terminator;
-  print_token close "end"
+  print_token closing "end"
 
 and print_field_assign {value; _} =
   let {field_name; equal; field_expr} = value in
@@ -1217,14 +1334,18 @@ and print_field_assign {value; _} =
   print_token equal "=";
   print_expr field_expr
 
-and print_record_projection {value; _} =
+and print_projection {value; _} =
   let {record_name; selector; field_path} = value in
   print_var record_name;
   print_token selector ".";
   print_field_path field_path
 
 and print_field_path sequence =
-  print_nsepseq "." print_var sequence
+  print_nsepseq "." print_selection sequence
+
+and print_selection = function
+  FieldName name -> print_var name
+| Component int  -> print_int int
 
 and print_record_patch node =
   let {kwd_patch; path; kwd_with; record_inj} = node in
@@ -1233,19 +1354,54 @@ and print_record_patch node =
   print_token kwd_with "with";
   print_record_injection record_inj
 
+and print_set_patch node =
+  let {kwd_patch; path; kwd_with; set_inj} = node in
+  print_token kwd_patch "patch";
+  print_path path;
+  print_token kwd_with "with";
+  print_injection "set" print_expr set_inj
+
 and print_map_patch node =
   let {kwd_patch; path; kwd_with; map_inj} = node in
   print_token kwd_patch "patch";
   print_path path;
   print_token kwd_with "with";
-  print_map_injection map_inj
+  print_injection "map" print_binding map_inj
 
-and print_map_injection {value; _} =
+and print_map_remove node =
-  let {opening; bindings; terminator; close} = value in
+  let {kwd_remove; key; kwd_from; kwd_map; map} = node in
-  print_token opening "record";
+  print_token kwd_remove "remove";
-  print_nsepseq ";" print_binding bindings;
+  print_expr  key;
-  print_terminator terminator;
+  print_token kwd_from "from";
-  print_token close "end"
+  print_token kwd_map "map";
+  print_path  map
+
+and print_set_remove node =
+  let {kwd_remove; element; kwd_from; kwd_set; set} = node in
+  print_token kwd_remove "remove";
+  print_expr  element;
+  print_token kwd_from "from";
+  print_token kwd_set "set";
+  print_path  set
+
+and print_injection :
+  'a.string -> ('a -> unit) -> 'a injection reg -> unit =
+  fun kwd print {value; _} ->
+    let {opening; elements; terminator; closing} = value in
+    print_opening kwd opening;
+    print_sepseq ";" print elements;
+    print_terminator terminator;
+    print_closing closing
+
+and print_opening lexeme = function
+  Kwd kwd -> print_token kwd lexeme
+| KwdBracket (kwd, lbracket) ->
+    print_token kwd lexeme;
+    print_token lbracket "{"
+
+and print_closing = function
+  RBracket rbracket -> print_token rbracket "}"
+| End kwd_end       -> print_token kwd_end "end"
 
 and print_binding {value; _} =
   let {source; arrow; image} = value in
@@ -1253,44 +1409,24 @@ and print_binding {value; _} =
   print_token arrow "->";
   print_expr image
 
-and print_tuple {value; _} =
+and print_tuple_expr = function
+  TupleInj inj -> print_tuple_inj inj
+
+and print_tuple_inj {value; _} =
   let {lpar; inside; rpar} = value in
   print_token lpar "(";
   print_nsepseq "," print_expr inside;
   print_token rpar ")"
 
-and print_list {value; _} =
+and print_nil {value; _} =
-  let {lbracket; inside; rbracket} = value in
-  print_token lbracket "[";
-  print_nsepseq "," print_expr inside;
-  print_token rbracket "]"
-
-and print_empty_list {value; _} =
   let {lpar; inside; rpar} = value in
-  let {lbracket; rbracket; colon; list_type} = inside in
+  let {nil; colon; list_type} = inside in
   print_token     lpar "(";
-  print_token     lbracket "[";
+  print_token     nil "nil";
-  print_token     rbracket "]";
   print_token     colon ":";
   print_type_expr list_type;
   print_token     rpar ")"
 
-and print_set {value; _} =
-  let {lbrace; inside; rbrace} = value in
-  print_token lbrace "{";
-  print_nsepseq "," print_expr inside;
-  print_token rbrace "}"
-
-and print_empty_set {value; _} =
-  let {lpar; inside; rpar} = value in
-  let {lbrace; rbrace; colon; set_type} = inside in
-  print_token     lpar "(";
-  print_token     lbrace "{";
-  print_token     rbrace "}";
-  print_token     colon ":";
-  print_type_expr set_type;
-  print_token     rpar ")"
-
 and print_none_expr {value; _} =
   let {lpar; inside; rpar} = value in
   let {c_None; colon; opt_type} = inside in
@@ -1302,18 +1438,18 @@ and print_none_expr {value; _} =
 
 and print_fun_call {value; _} =
   let fun_name, arguments = value in
-  print_var   fun_name;
+  print_var       fun_name;
-  print_tuple arguments
+  print_tuple_inj arguments
 
 and print_constr_app {value; _} =
   let constr, arguments = value in
-  print_constr constr;
+  print_constr    constr;
-  print_tuple  arguments
+  print_tuple_inj arguments
 
 and print_some_app {value; _} =
   let c_Some, arguments = value in
   print_token c_Some "Some";
-  print_tuple arguments
+  print_tuple_inj arguments
 
 and print_par_expr {value; _} =
   let {lpar; inside; rpar} = value in
@@ -1348,14 +1484,9 @@ and print_patterns {value; _} =
   print_token rpar ")"
 
 and print_list_pattern = function
-  Sugar sugar -> print_sugar sugar
+  Sugar  sugar -> print_injection "list" print_pattern sugar
-| Raw     raw -> print_raw raw
+| PNil kwd_nil -> print_token kwd_nil "nil"
-
+| Raw      raw -> print_raw raw
-and print_sugar {value; _} =
-  let {lbracket; inside; rbracket} = value in
-  print_token lbracket "[";
-  print_sepseq "," print_pattern inside;
-  print_token rbracket "]"
 
 and print_raw {value; _} =
   let {lpar; inside; rpar} = value in

src/ligo/ligo-parser/AST.mli

@@ -23,26 +23,36 @@ val sepseq_to_region  : ('a -> Region.t) -> ('a,'sep) sepseq -> Region.t
 
 (* Keywords of LIGO *)
 
+type keyword        = Region.t
+type kwd_and        = Region.t
 type kwd_begin      = Region.t
-type kwd_case      = Region.t
+type kwd_block      = Region.t
+type kwd_case       = Region.t
 type kwd_const      = Region.t
+type kwd_contains   = Region.t
 type kwd_down       = Region.t
 type kwd_else       = Region.t
 type kwd_end        = Region.t
 type kwd_entrypoint = Region.t
 type kwd_fail       = Region.t
 type kwd_for        = Region.t
+type kwd_from       = Region.t
 type kwd_function   = Region.t
 type kwd_if         = Region.t
 type kwd_in         = Region.t
 type kwd_is         = Region.t
+type kwd_list       = Region.t
 type kwd_map        = Region.t
 type kwd_mod        = Region.t
+type kwd_nil        = Region.t
 type kwd_not        = Region.t
 type kwd_of         = Region.t
+type kwd_or         = Region.t
 type kwd_patch      = Region.t
 type kwd_procedure  = Region.t
 type kwd_record     = Region.t
+type kwd_remove     = Region.t
+type kwd_set        = Region.t
 type kwd_skip       = Region.t
 type kwd_step       = Region.t
 type kwd_storage    = Region.t
@@ -77,8 +87,6 @@ type arrow    = Region.t  (* "->"  *)
 type assign   = Region.t  (* ":="  *)
 type equal    = Region.t  (* "="   *)
 type colon    = Region.t  (* ":"   *)
-type bool_or  = Region.t  (* "||"  *)
-type bool_and = Region.t  (* "&&"  *)
 type lt       = Region.t  (* "<"   *)
 type leq      = Region.t  (* "<="  *)
 type gt       = Region.t  (* ">"   *)
@@ -103,6 +111,7 @@ type fun_name   = string reg
 type type_name  = string reg
 type field_name = string reg
 type map_name   = string reg
+type set_name   = string reg
 type constr     = string reg
 
 (* Parentheses *)
@@ -180,9 +189,10 @@ and variant = {
 }
 
 and record_type = {
-  kwd_record : kwd_record;
+  opening     : kwd_record;
-  fields     : field_decls;
+  field_decls : field_decls;
-  kwd_end    : kwd_end
+  terminator  : semi option;
+  closing     : kwd_end
 }
 
 and field_decls = (field_decl reg, semi) nsepseq
@@ -275,15 +285,32 @@ and param_var = {
 }
 
 and block = {
-  opening    : kwd_begin;
+  opening    : block_opening;
-  instr      : instructions;
+  statements : statements;
   terminator : semi option;
-  close      : kwd_end
+  closing    : block_closing
 }
 
+and block_opening =
+  Block of kwd_block * lbrace
+| Begin of kwd_begin
+
+and block_closing =
+  Block of rbrace
+| End   of kwd_end
+
+and statements = (statement, semi) nsepseq
+
+and statement =
+  Instr of instruction
+| Data  of data_decl
+
 and local_decl =
   LocalLam   of lambda_decl
-| LocalConst of const_decl reg
+| LocalData  of data_decl
+
+and data_decl =
+  LocalConst of const_decl reg
 | LocalVar   of var_decl reg
 
 and var_decl = {
@@ -296,8 +323,6 @@ and var_decl = {
   terminator : semi option
 }
 
-and instructions = (instruction, semi) nsepseq
-
 and instruction =
   Single of single_instr
 | Block  of block reg
@@ -312,19 +337,38 @@ and single_instr =
 | Skip        of kwd_skip
 | RecordPatch of record_patch reg
 | MapPatch    of map_patch reg
+| SetPatch    of set_patch reg
+| MapRemove   of map_remove reg
+| SetRemove   of set_remove reg
+
+and set_remove = {
+  kwd_remove : kwd_remove;
+  element    : expr;
+  kwd_from   : kwd_from;
+  kwd_set    : kwd_set;
+  set        : path
+}
+
+and map_remove = {
+  kwd_remove : kwd_remove;
+  key        : expr;
+  kwd_from   : kwd_from;
+  kwd_map    : kwd_map;
+  map        : path
+}
+
+and set_patch  = {
+  kwd_patch : kwd_patch;
+  path      : path;
+  kwd_with  : kwd_with;
+  set_inj   : expr injection reg
+}
 
 and map_patch  = {
   kwd_patch : kwd_patch;
   path      : path;
   kwd_with  : kwd_with;
-  map_inj   : map_injection reg
+  map_inj   : binding reg injection reg
-}
-
-and map_injection = {
-  opening    : kwd_map;
-  bindings   : (binding reg, semi) nsepseq;
-  terminator : semi option;
-  close      : kwd_end
 }
 
 and binding = {
@@ -346,12 +390,23 @@ and fail_instr = {
 }
 
 and conditional = {
-  kwd_if   : kwd_if;
+  kwd_if     : kwd_if;
-  test     : expr;
+  test       : expr;
-  kwd_then : kwd_then;
+  kwd_then   : kwd_then;
-  ifso     : instruction;
+  ifso       : if_clause;
-  kwd_else : kwd_else;
+  terminator : semi option;
-  ifnot    : instruction
+  kwd_else   : kwd_else;
+  ifnot      : if_clause
+}
+
+and if_clause =
+  ClauseInstr of instruction
+| ClauseBlock of (statements * semi option) braces reg
+
+and set_membership = {
+  set          : expr;
+  kwd_contains : kwd_contains;
+  element      : expr
 }
 
 and case_instr = {
@@ -434,17 +489,37 @@ and expr =
 | ESet    of set_expr
 | EConstr of constr_expr
 | ERecord of record_expr
+| EProj   of projection reg
 | EMap    of map_expr
 | EVar    of Lexer.lexeme reg
 | ECall   of fun_call
 | EBytes  of (Lexer.lexeme * Hex.t) reg
 | EUnit   of c_Unit
-| ETuple  of tuple
+| ETuple  of tuple_expr
 | EPar    of expr par reg
 
+and set_expr =
+  SetInj of expr injection reg
+| SetMem of set_membership reg
+
+and 'a injection = {
+  opening    : opening;
+  elements   : ('a, semi) sepseq;
+  terminator : semi option;
+  closing    : closing
+}
+
+and opening =
+  Kwd        of keyword
+| KwdBracket of keyword * lbracket
+
+and closing =
+  End       of kwd_end
+| RBracket  of rbracket
+
 and map_expr =
   MapLookUp of map_lookup reg
-| MapInj    of map_injection reg
+| MapInj    of binding reg injection reg
 
 and map_lookup = {
   path  : path;
@@ -452,17 +527,17 @@ and map_lookup = {
 }
 
 and path =
-  Name       of variable
+  Name of variable
-| RecordPath of record_projection reg
+| Path of projection reg
 
 and logic_expr =
   BoolExpr of bool_expr
 | CompExpr of comp_expr
 
 and bool_expr =
-  Or    of bool_or  bin_op reg
+  Or    of kwd_or  bin_op reg
-| And   of bool_and bin_op reg
+| And   of kwd_and bin_op reg
-| Not   of kwd_not   un_op reg
+| Not   of kwd_not  un_op reg
 | False of c_False
 | True  of c_True
 
@@ -499,13 +574,15 @@ and string_expr =
 | String of Lexer.lexeme reg
 
 and list_expr =
-  Cons      of cons bin_op reg
+  Cons of cons bin_op reg
-| List      of (expr, comma) nsepseq brackets reg
+| List of expr injection reg
-| EmptyList of empty_list reg
+| Nil  of nil par reg
 
-and set_expr =
+and nil = {
-  Set       of (expr, comma) nsepseq braces reg
+  nil       : kwd_nil;
-| EmptySet  of empty_set reg
+  colon     : colon;
+  list_type : type_expr
+}
 
 and constr_expr =
   SomeApp   of (c_Some * arguments) reg
@@ -513,14 +590,13 @@ and constr_expr =
 | ConstrApp of (constr * arguments) reg
 
 and record_expr =
-  RecordInj  of record_injection reg
+  RecordInj of record_injection reg
-| RecordProj of record_projection reg
 
 and record_injection = {
   opening    : kwd_record;
   fields     : (field_assign reg, semi) nsepseq;
   terminator : semi option;
-  close      : kwd_end
+  closing    : kwd_end
 }
 
 and field_assign = {
@@ -529,31 +605,20 @@ and field_assign = {
   field_expr : expr
 }
 
-and record_projection = {
+and projection = {
   record_name : variable;
   selector    : dot;
-  field_path  : (field_name, dot) nsepseq
+  field_path  : (selection, dot) nsepseq
 }
 
-and tuple = (expr, comma) nsepseq par reg
+and selection =
+  FieldName of field_name
+| Component of (Lexer.lexeme * Z.t) reg
 
-and empty_list = typed_empty_list par
+and tuple_expr =
+  TupleInj of tuple_injection
 
-and typed_empty_list = {
+and tuple_injection = (expr, comma) nsepseq par reg
-  lbracket  : lbracket;
-  rbracket  : rbracket;
-  colon     : colon;
-  list_type : type_expr
-}
-
-and empty_set = typed_empty_set par
-
-and typed_empty_set = {
-  lbrace   : lbrace;
-  rbrace   : rbrace;
-  colon    : colon;
-  set_type : type_expr
-}
 
 and none_expr = typed_none_expr par
 
@@ -565,7 +630,7 @@ and typed_none_expr = {
 
 and fun_call = (fun_name * arguments) reg
 
-and arguments = tuple
+and arguments = tuple_injection
 
 (* Patterns *)
 
@@ -585,7 +650,8 @@ and pattern =
 | PTuple  of (pattern, comma) nsepseq par reg
 
 and list_pattern =
-  Sugar of (pattern, comma) sepseq brackets reg
+  Sugar of pattern injection reg
+| PNil  of kwd_nil
 | Raw   of (pattern * cons * pattern) par reg
 
 (* Projecting regions *)
@@ -598,6 +664,8 @@ val local_decl_to_region : local_decl -> Region.t
 val path_to_region       : path -> Region.t
 val lhs_to_region        : lhs -> Region.t
 val rhs_to_region        : rhs -> Region.t
+val if_clause_to_region  : if_clause -> Region.t
+val selection_to_region  : selection -> Region.t
 
 (* Printing *)
 

src/ligo/ligo-parser/AST2.ml

@@ -0,0 +1,799 @@
+(*
+
+[@@@warning "-30"]
+
+module I = AST
+
+open Region
+
+module SMap = Map.Make(String)
+
+module O = struct
+  type asttodo = [`TODO] (* occurrences of asttodo will point to some part of the original parser AST *)
+
+  type name_and_region = {name: string; orig: Region.t}
+  type type_name  = name_and_region
+  type var_name   = name_and_region
+  type field_name = name_and_region
+
+  type pattern =
+    PVar    of var_name
+  | PWild
+  | PInt    of Z.t
+  | PBytes  of MBytes.t
+  | PString of string
+  | PUnit
+  | PFalse
+  | PTrue
+  | PNone
+  | PSome   of pattern
+  | PCons   of pattern * pattern
+  | PNull
+  | PRecord of (field_name * pattern) SMap.t
+
+  type type_constructor =
+    Option
+  | List
+  | Set
+  | Map
+
+  type type_expr_case =
+    Sum      of (type_name * type_expr) SMap.t
+  | Record   of (field_name * type_expr) SMap.t
+  | TypeApp  of type_constructor * (type_expr list)
+  | Function of { arg: type_expr; ret: type_expr }
+  | Ref      of type_expr
+  | String
+  | Bytes
+  | Int
+  | Unit
+  | Bool
+
+  and type_expr = { type_expr: type_expr_case; name: type_name option; orig: Region.t }
+
+  type typed_var = { name:var_name; ty:type_expr; orig: asttodo }
+
+  type type_decl = { name:type_name; ty:type_expr; orig: asttodo }
+
+  type expr =
+    App      of { operator: operator; arguments: expr list }
+  | Var      of var_name
+  | Constant of constant
+  | Record   of (field_name * expr) list
+  | Lambda   of lambda
+
+  and decl = { name:var_name; ty:type_expr; value: expr }
+
+  and lambda = {
+      parameter:    typed_var;
+      declarations: decl list;
+      instructions: instr list;
+      result:       expr;
+    }
+
+  and operator =
+    Function    of var_name
+  | Constructor of var_name
+  | UpdateField of field_name
+  | GetField    of field_name
+  | Or | And | Lt | Leq | Gt | Geq | Equal | Neq | Cat | Cons | Add | Sub | Mult | Div | Mod
+  | Neg | Not
+  | Set | List
+  | MapLookup
+
+  and constant =
+    Unit
+  | Int of Z.t | String of string | Bytes of MBytes.t
+  | False | True
+  | Null of type_expr
+  | EmptySet of type_expr
+  | CNone of type_expr
+
+  and instr =
+    Assignment    of { name: var_name; value: expr; orig: asttodo }
+  | While         of { condition: expr; body: instr list; orig: asttodo }
+  | ForCollection of { list: expr; var: var_name; body: instr list; orig: asttodo }
+  | Match         of { expr: expr; cases: (pattern * instr list) list; orig: asttodo }
+  | ProcedureCall of { expr: expr; orig: asttodo } (* expr returns unit, drop the result. Similar to OCaml's ";". *)
+  | Fail          of { expr: expr; orig: asttodo }
+
+  type ast = {
+      types           : type_decl list;
+      storage_decl    : typed_var;
+      declarations    : decl list;
+      orig            : AST.t
+    }
+end
+
+(* open Sanity: *)
+let (|>) v f = f v       (* pipe f to v *)
+let (@@) f v = f v       (* apply f on v *)
+let (@.) f g x = f (g x) (* compose *)
+let map f l = List.rev (List.rev_map f l)
+let mapi f l =
+  let f (i, l) elem =
+    (i + 1, (f i elem) :: l)
+  in snd (List.fold_left f (0,[]) l)
+(* TODO: check that List.append is not broken
+   (i.e. check that it is tail-recursive) *)
+let append_map f l = map f l |>  List.flatten
+let append l1 l2 = List.append l1 l2
+let list_to_map l = List.fold_left (fun m (k,v) -> SMap.add k v m) SMap.empty l
+let fold_map f a l =
+  let f (acc, l) elem =
+    let acc', elem' = f acc elem
+    in acc', (elem' :: l) in
+  let last_acc, last_l = List.fold_left f (a, []) l
+  in last_acc, List.rev last_l
+
+(* Simplify the AST *)
+
+let name_and_region_of_int i = O.{name = string_of_int i; orig = Region.ghost}
+
+let s_nsepseq : ('a,'sep) Utils.nsepseq -> 'a list =
+  fun (first, rest) -> first :: (map snd rest)
+
+let s_sepseq : ('a,'sep) Utils.sepseq -> 'a list =
+  function
+    None         -> []
+  | Some nsepseq -> s_nsepseq nsepseq
+
+let s_name {value=name; region} : O.var_name =
+  let () = ignore (region) in
+  {name;orig = region}
+
+let name_to_string {value=name; region} : string =
+  let () = ignore (region) in
+  name
+
+let type_expr (orig : Region.t) (e : O.type_expr_case) : O.type_expr =
+  { type_expr = e; name = None; orig }
+
+let s_type_constructor {value=name;region} : O.type_constructor =
+  let () = ignore (region) in
+  match name with
+     "Option" -> Option
+   | "List"   -> List
+   | "Map"    -> Map
+   | "Set"    -> Set
+   (* TODO: escape the name, prevent any \x1b and other weird characters from appearing in the output *)
+   | _ -> failwith ("Unknown type constructor: " ^ name)
+
+let named_list_to_map (l : (O.name_and_region * 'a) list) : (O.name_and_region * 'a) SMap.t =
+  List.fold_left
+    (fun m ((x,_) as p) ->
+      let {name;_} : O.name_and_region = x in
+      SMap.add name p m)
+    SMap.empty
+    l
+
+let rec s_cartesian {value=sequence; region} : O.type_expr =
+  let () = ignore (region) in
+  s_nsepseq sequence
+  |>map s_type_expr
+  |> mapi (fun i p -> name_and_region_of_int i, p)
+  |> named_list_to_map
+  |> (fun x -> (Record x : O.type_expr_case))
+  |> type_expr region
+
+and s_sum_type {value=sequence; region} : O.type_expr =
+  let () = ignore (region) in
+  type_expr region (Sum (map s_variant (s_nsepseq sequence) |> named_list_to_map))
+
+and s_variant {value=(constr, kwd_of, cartesian); region} =
+  let () = ignore (kwd_of,region) in
+  (s_name constr, s_cartesian cartesian)
+
+and s_record_type {value=(kwd_record, field_decls, kwd_end); region} : O.type_expr =
+  let () = ignore (kwd_record,region,kwd_end) in
+  type_expr region (Record (map s_field_decl (s_nsepseq field_decls) |> named_list_to_map) : O.type_expr_case)
+
+and s_field_decl {value=(var, colon, type_expr); region} : O.type_name * O.type_expr =
+  let () = ignore (colon,region) in
+  ((s_name var), (s_type_expr type_expr))
+
+and s_type_app {value=(type_name,type_tuple); region} : O.type_expr =
+  let () = ignore (region) in
+  type_expr region (TypeApp (s_type_constructor type_name, s_type_tuple type_tuple))
+
+and s_type_tuple ({value=(lpar, sequence, rpar); region} : (I.type_name, I.comma) Utils.nsepseq I.par) : O.type_expr list =
+  let () = ignore (lpar,rpar,region) in
+  (* TODO: the grammar should allow any type expr, not just type_name in the tuple elements *)
+  map s_type_expr (map (fun a -> I.TAlias a) (s_nsepseq sequence))
+
+and s_par_type {value=(lpar, type_expr, rpar); region} : O.type_expr =
+  let () = ignore (lpar,rpar,region) in
+  s_type_expr type_expr
+
+and s_type_alias name : O.type_expr =
+  let () = ignore () in
+  type_expr name.region (TypeApp (s_type_constructor name, []))
+
+and s_type_expr (orig : I.type_expr) : O.type_expr = match orig with
+  Prod    cartesian   -> s_cartesian   cartesian
+| Sum     sum_type    -> s_sum_type    sum_type
+| Record  record_type -> s_record_type record_type
+| TypeApp type_app    -> s_type_app    type_app
+| ParType par_type    -> s_par_type    par_type
+| TAlias  type_alias  -> s_type_alias  type_alias
+
+
+let s_type_decl I.{value={kwd_type;name;kwd_is;type_expr;terminator}; region} : O.type_decl =
+  let () = ignore (kwd_type,kwd_is,terminator,region) in
+  let ty = s_type_expr type_expr in
+  O.{ name = s_name name; ty = { ty with name = Some (s_name name) }; orig = `TODO }
+
+let s_storage_decl I.{value={kwd_storage; name; colon; store_type; terminator}; region} : O.typed_var =
+  let () = ignore (kwd_storage,colon,terminator,region) in
+  O.{ name = s_name name; ty = s_type_expr store_type; orig = `TODO }
+
+let s_operations_decl I.{value={kwd_operations;name;colon;op_type;terminator}; region} : O.typed_var =
+  let () = ignore (kwd_operations,colon,terminator,region) in
+  O.{ name = s_name name; ty = s_type_expr op_type; orig = `TODO }
+
+let s_empty_list {value=(l, (lbracket, rbracket, colon, type_expr), r); region} : O.expr =
+  let () = ignore (l, lbracket, rbracket, colon, r, region) in
+  Constant (Null (s_type_expr type_expr))
+
+let s_empty_set {value=(l, (lbrace, rbrace, colon, type_expr), r); region} : O.expr =
+  let () = ignore (l, lbrace, rbrace, colon, r, region) in
+  Constant (EmptySet (s_type_expr type_expr))
+
+let s_none {value=(l, (c_None, colon, type_expr), r); region} : O.expr =
+  let () = ignore (l, c_None, colon, r, region) in
+  Constant (CNone (s_type_expr type_expr))
+
+let parameters_to_tuple (parameters : (string * O.type_expr) list) : O.type_expr =
+  (* TODO: use records with named fields to have named arguments. *)
+  let parameter_tuple : O.type_expr_case =
+    Record (mapi (fun i (_name,ty) -> name_and_region_of_int i, ty) parameters |> named_list_to_map) in
+  O.{ type_expr = parameter_tuple; name = None; orig = Region.ghost }
+
+and parameters_to_decls singleparam (parameters : (string * O.type_expr) list) : O.decl list =
+  let f i (name,ty) =
+    O.{ name = {name; orig=Region.ghost};
+        ty = ty;
+        value = App { operator = O.GetField (name_and_region_of_int i);
+                      arguments = [Var singleparam] } }
+  in mapi f parameters
+
+let rec bin l operator r = O.App { operator; arguments = [s_expr l; s_expr r] }
+and     una operator v = O.App { operator; arguments = [s_expr v] }
+and s_expr : I.expr -> O.expr =
+  function
+    Or        {value=(l, bool_or, r);     region} -> let () = ignore (region, bool_or) in bin l Or    r
+  | And       {value=(l, bool_and, r);    region} -> let () = ignore (region,bool_and) in bin l And   r
+  | Lt        {value=(l, lt, r);          region} -> let () = ignore (region,      lt) in bin l Lt    r
+  | Leq       {value=(l, leq, r);         region} -> let () = ignore (region,     leq) in bin l Leq   r
+  | Gt        {value=(l, gt, r);          region} -> let () = ignore (region,      gt) in bin l Gt    r
+  | Geq       {value=(l, geq, r);         region} -> let () = ignore (region,     geq) in bin l Geq   r
+  | Equal     {value=(l, equal, r);       region} -> let () = ignore (region,   equal) in bin l Equal r
+  | Neq       {value=(l, neq, r);         region} -> let () = ignore (region,     neq) in bin l Neq   r
+  | Cat       {value=(l, cat, r);         region} -> let () = ignore (region,     cat) in bin l Cat   r
+  | Cons      {value=(l, cons, r);        region} -> let () = ignore (region,    cons) in bin l Cons  r
+  | Add       {value=(l, plus, r);        region} -> let () = ignore (region,    plus) in bin l Add   r
+  | Sub       {value=(l, minus, r);       region} -> let () = ignore (region,   minus) in bin l Sub   r
+  | Mult      {value=(l, times, r);       region} -> let () = ignore (region,   times) in bin l Mult  r
+  | Div       {value=(l, slash, r);       region} -> let () = ignore (region,   slash) in bin l Div   r
+  | Mod       {value=(l, kwd_mod, r);     region} -> let () = ignore (region, kwd_mod) in bin l Mod   r
+  | Neg       {value=(minus, expr);       region} -> let () = ignore (region,   minus) in una Neg expr
+  | Not       {value=(kwd_not, expr);     region} -> let () = ignore (region, kwd_not) in una Not expr
+  | Int       {value=(lexeme, z);         region} -> let () = ignore (region,  lexeme) in Constant (Int z)
+  | Var       lexeme                              ->                                      Var (s_name lexeme)
+  | String    {value=s;                   region} -> let () = ignore (region)          in Constant (String s)
+  | Bytes     {value=(lexeme, mbytes);    region} -> let () = ignore (region,  lexeme) in Constant (Bytes mbytes)
+  | False     c_False                             -> let () = ignore (c_False)         in Constant (False)
+  | True      c_True                              -> let () = ignore (c_True)          in Constant (True)
+  | Unit      c_Unit                              -> let () = ignore (c_Unit)          in Constant (Unit)
+  | Tuple     {value=(l,tuple,r);         region} -> let () = ignore (l,r,region)      in s_tuple_expr (tuple |> s_nsepseq |> map s_expr)
+  | List      list                                -> s_list list
+  | EmptyList empty_list                          -> s_empty_list empty_list
+  | Set       set                                 -> s_set set
+  | EmptySet  empty_set                           -> s_empty_set empty_set
+  | NoneExpr  none_expr                           -> s_none none_expr
+  | FunCall   fun_call                            -> s_fun_call fun_call
+  | ConstrApp constr_app                          -> s_constr_app constr_app
+  | SomeApp   some_app                            -> s_some_app some_app
+  | MapLookUp map_lookup                          -> s_map_lookup map_lookup
+  | ParExpr   {value=(lpar,expr,rpar);    region} -> let () = ignore (lpar,rpar,region) in s_expr expr
+
+and s_tuple_expr tuple : O.expr =
+  Record (mapi (fun i e -> name_and_region_of_int i, e) tuple)
+
+and s_map_lookup I.{value = {map_name; selector; index}; region} : O.expr =
+  let {value = lbracket, index_expr, rbracket; region=region2} = index in
+  let () = ignore (selector, lbracket, rbracket, region2, region) in
+  App { operator = MapLookup; arguments = [Var (s_name map_name); s_expr index_expr] }
+
+and s_some_app {value=(c_Some, {value=(l,arguments,r); region=region2}); region} : O.expr =
+  let () = ignore (c_Some,l,r,region2,region) in
+  match s_nsepseq arguments with
+    [] -> failwith "tuple cannot be empty"
+  | [a] -> s_expr a
+  | l -> s_tuple_expr (map s_expr l)
+
+and s_list {value=(l, list, r); region} : O.expr =
+  let () = ignore (l, r, region) in
+  App { operator = List; arguments = map s_expr (s_nsepseq list) }
+
+and s_set {value=(l, set, r); region} : O.expr =
+  let () = ignore (l, r, region) in
+  App { operator = Set; arguments = map s_expr (s_nsepseq set) }
+
+and s_pattern {value=sequence; region} : O.pattern =
+  let () = ignore (region) in
+  s_pattern_conses (s_nsepseq sequence)
+
+and s_pattern_conses : I.core_pattern list -> O.pattern = function
+    [] -> assert false
+  | [p] -> s_core_pattern p
+  | hd :: tl -> PCons (s_core_pattern hd, s_pattern_conses tl)
+
+and s_case ({value=(pattern, arrow, instruction); region} : I.case) : O.pattern * O.instr list =
+  let () = ignore (arrow,region) in
+  s_pattern pattern, s_instruction instruction
+
+and s_core_pattern : I.core_pattern -> O.pattern = function
+  PVar var                     -> PVar (s_name var)
+| PWild wild                   -> let () = ignore      (wild) in PWild
+| PInt {value=(si,i);region}   -> let () = ignore (si,region) in PInt i
+| PBytes {value=(sb,b);region} -> let () = ignore (sb,region) in PBytes b
+| PString {value=s;region}     -> let () = ignore    (region) in PString s
+| PUnit region                 -> let () = ignore    (region) in PUnit
+| PFalse region                -> let () = ignore    (region) in PFalse
+| PTrue region                 -> let () = ignore    (region) in PTrue
+| PNone region                 -> let () = ignore    (region) in PNone
+| PSome psome                  -> s_psome psome
+| PList pattern                -> s_list_pattern pattern
+| PTuple ptuple                -> s_ptuple ptuple
+
+and s_list_pattern = function
+  Sugar sugar -> s_sugar sugar
+| Raw     raw -> s_raw raw
+
+and s_sugar {value=(lbracket, sequence, rbracket); region} : O.pattern =
+  let () = ignore (lbracket, rbracket, region) in
+  List.fold_left (fun acc p -> O.PCons (s_core_pattern p, acc))
+                 O.PNull
+                 (s_sepseq sequence);
+
+and s_raw {value=(lpar, (core_pattern, cons, pattern), rpar); region} =
+  let () = ignore (lpar, cons, rpar, region) in
+  O.PCons (s_core_pattern core_pattern, s_pattern pattern)
+
+and s_ptuple {value=(lpar, sequence, rpar); region} =
+  let () = ignore (lpar, rpar, region) in
+  s_nsepseq sequence
+  |> map s_core_pattern
+  |> mapi (fun i p -> name_and_region_of_int i, p)
+  |> fun x -> O.PRecord (x |> named_list_to_map)
+
+and s_psome {value=(c_Some,{value=(l,psome,r);region=region2});region} : O.pattern =
+  let () = ignore    (c_Some,l,r,region2,region) in
+  PSome (s_core_pattern psome)
+
+and s_const_decl I.{value={kwd_const;name;colon;const_type;equal;init;terminator}; region} : O.decl =
+  let () = ignore (kwd_const,colon,equal,terminator,region) in
+  O.{ name = s_name name; ty = s_type_expr const_type; value = s_expr init }
+
+and s_param_const {value=(kwd_const,variable,colon,type_expr); region} : string * O.type_expr =
+  let () = ignore (kwd_const,colon,region) in
+  name_to_string variable, s_type_expr type_expr
+
+and s_param_var {value=(kwd_var,variable,colon,type_expr); region} : string * O.type_expr =
+  let () = ignore (kwd_var,colon,region) in
+  name_to_string variable, s_type_expr type_expr
+
+and s_param_decl : I.param_decl -> string * O.type_expr = function
+    ParamConst p ->  s_param_const p
+  | ParamVar p ->    s_param_var p
+
+and s_parameters ({value=(lpar,param_decl,rpar);region} : I.parameters) : (string * O.type_expr) list =
+  let () = ignore (lpar,rpar,region) in
+  let l = (s_nsepseq param_decl) in
+  map s_param_decl l
+
+and s_var_decl I.{value={kwd_var;name;colon;var_type;ass;init;terminator}; region} : O.decl =
+  let () = ignore (kwd_var,colon,ass,terminator,region) in
+  O.{
+      name = s_name name;
+      ty = s_type_expr var_type;
+      value = s_expr init
+  }
+
+and s_local_decl : I.local_decl -> O.decl = function
+  LocalLam   decl -> s_lambda_decl decl
+| LocalConst decl -> s_const_decl  decl
+| LocalVar   decl -> s_var_decl    decl
+
+and s_instructions ({value=sequence; region} : I.instructions) : O.instr list =
+  let () = ignore (region) in
+  append_map s_instruction (s_nsepseq sequence)
+
+and s_instruction : I.instruction -> O.instr list = function
+  Single instr -> s_single_instr instr
+|  Block block -> (s_block block)
+
+and s_conditional I.{kwd_if;test;kwd_then;ifso;kwd_else;ifnot} : O.instr =
+  let () = ignore (kwd_if,kwd_then,kwd_else) in
+  let test = s_expr test in
+  let ifso = O.PTrue, s_instruction ifso in
+  let ifnot = O.PFalse, s_instruction ifnot in
+  Match {
+      expr  = test;
+      cases = [ifso; ifnot];
+      orig  = `TODO
+    }
+
+and s_match_instr I.{kwd_match;expr;kwd_with;lead_vbar;cases;kwd_end} : O.instr =
+  let {value=cases;region} = cases in
+  let () = ignore (kwd_match,kwd_with,lead_vbar,kwd_end,region) in
+  Match { expr = s_expr expr; cases = map s_case (s_nsepseq cases); orig = `TODO }
+
+and s_ass_instr {value=(variable,ass,expr); region} : O.instr =
+  let () = ignore (ass,region) in
+  Assignment { name = s_name variable; value = s_expr expr; orig = `TODO }
+
+and s_while_loop {value=(kwd_while, expr, block); region} : O.instr list =
+  let () = ignore (kwd_while,region) in
+  [While {condition = s_expr expr; body = s_block block; orig = `TODO}]
+
+and s_for_loop : I.for_loop -> O.instr list = function
+  ForInt     for_int     -> s_for_int     for_int
+| ForCollect for_collect -> s_for_collect for_collect
+
+and s_for_int ({value={kwd_for;ass;down;kwd_to;bound;step;block}; region} : I.for_int reg) : O.instr list =
+  let {value=(variable,ass_kwd,expr);region = ass_region} = ass in
+  let () = ignore (kwd_for,ass_region,ass_kwd,kwd_to,region) in
+  let name = s_name variable in
+  let condition, operator = match down with Some kwd_down -> ignore kwd_down; O.Gt, O.Sub
+                                          | None          ->                  O.Lt, O.Add in
+  let step = s_step step
+  in [
+      Assignment { name; value = s_expr expr; orig = `TODO };
+      (* TODO: lift the declaration of the variable, to avoid creating a nested scope here. *)
+      While {
+          condition = App { operator = condition;
+                            arguments = [Var name; s_expr bound]};
+          body = append (s_block block)
+                        [O.Assignment { name;
+                                        value = App { operator;
+                                                      arguments = [Var name; step]};
+                                        orig = `TODO }];
+          orig = `TODO
+        }
+    ]
+
+and s_for_collect ({value={kwd_for;var;bind_to;kwd_in;expr;block}; _} : I.for_collect reg) : O.instr list =
+  let () = ignore (kwd_for,kwd_in) in
+  let for_instr =
+    match s_bind_to bind_to with
+      Some _ ->
+      failwith "TODO: For on maps is not supported yet!"
+    | None ->
+       O.ForCollection {
+           list = s_expr expr;
+           var = s_name var;
+           body = s_block block;
+           orig = `TODO
+         }
+  in [for_instr]
+
+and s_step : (I.kwd_step * I.expr) option -> O.expr = function
+  Some (kwd_step, expr) -> let () = ignore (kwd_step) in s_expr expr
+| None -> Constant (Int (Z.of_int 1))
+
+and s_bind_to : (I.arrow * I.variable) option -> O.var_name option = function
+    Some (arrow, variable) -> let () = ignore (arrow) in Some (s_name variable)
+  | None -> None
+
+and s_loop : I.loop -> O.instr list = function
+    While while_loop -> s_while_loop while_loop
+  | For     for_loop -> s_for_loop for_loop
+
+and s_fun_call {value=(fun_name, arguments); region} : O.expr =
+  let () = ignore (region) in
+  let {value=fun_name_string;_} = fun_name in
+  let firstchar = String.sub fun_name_string 0 1 in
+  (* If it starts with a capital letter, then it is a constructor *)
+  if String.equal firstchar (String.uppercase_ascii firstchar) then
+    App { operator = Constructor (s_name fun_name); arguments = s_arguments arguments }
+  else
+    App { operator = Function (s_name fun_name); arguments = s_arguments arguments }
+
+and s_constr_app {value=(constr, arguments); region} : O.expr =
+  let () = ignore (region) in
+  App { operator = Function (s_name constr); arguments = s_arguments arguments }
+
+and s_arguments {value=(lpar, sequence, rpar); region} : O.expr list =
+  (* TODO: should return a tuple *)
+  let () = ignore (lpar,rpar,region) in
+  match map s_expr (s_nsepseq sequence) with
+    []                -> [Constant Unit]
+  | [single_argument] -> [single_argument]
+  | args              -> [s_tuple_expr args] ;
+
+and s_fail ((kwd_fail, expr) : (I.kwd_fail * I.expr)) : O.instr =
+  let () = ignore (kwd_fail) in
+  Fail { expr = s_expr expr; orig = `TODO }
+
+
+
+
+and s_single_instr : I.single_instr -> O.instr list = function
+  Cond     {value; _} -> [s_conditional value]
+| Match    {value; _} -> [s_match_instr value]
+| Ass      instr      -> [s_ass_instr instr]
+| Loop     loop       -> s_loop loop
+| ProcCall fun_call   -> [ProcedureCall { expr = s_fun_call fun_call; orig = `TODO }]
+| Null     kwd_null   -> let () = ignore (kwd_null) in
+                         []
+| Fail     {value; _} -> [s_fail value]
+
+and s_block I.{value={opening;instr;terminator;close}; _} : O.instr list =
+  let () = ignore (opening,terminator,close) in
+  s_instructions instr
+
+and gensym =
+  let i = ref 0 in
+  fun ty ->
+  i := !i + 1;
+  (* TODO: Region.ghost *)
+  ({name = {name=(string_of_int !i) ^ "gensym"; orig = Region.ghost}; ty; orig = `TODO} : O.typed_var)
+
+and s_fun_decl I.{value={kwd_function;name;param;colon;ret_type;kwd_is;local_decls;block;kwd_with;return;terminator}; region} : O.decl =
+  let () = ignore (kwd_function,colon,kwd_is,kwd_with,terminator,region) in
+  let tuple_type = s_parameters param |> parameters_to_tuple in
+  let single_argument = gensym tuple_type in
+  let ({name = single_argument_xxx; ty = _; orig = `TODO} : O.typed_var) = single_argument in
+  O.{
+      name = s_name name;
+      ty = type_expr region (Function { arg = tuple_type;
+                                        ret = s_type_expr ret_type });
+      value = Lambda {
+                  parameter    = single_argument;
+                  declarations = append
+                                   (s_parameters param |> parameters_to_decls single_argument_xxx)
+                                   (map s_local_decl local_decls);
+                  instructions = s_block block;
+                  result       = s_expr return
+                }
+  }
+
+and s_proc_decl I.{value={kwd_procedure;name;param;kwd_is;local_decls;block;terminator}; region} =
+  let () = ignore (kwd_procedure,kwd_is,terminator,region) in
+  let tuple_type = s_parameters param |> parameters_to_tuple in
+  let single_argument = gensym tuple_type in
+  let ({name = single_argument_xxx; ty = _; orig = `TODO} : O.typed_var) = single_argument in
+  O.{
+      name = s_name name;
+      ty = type_expr region (Function { arg = tuple_type;
+                                        ret = type_expr region Unit });
+      value = Lambda {
+                  parameter    = single_argument;
+                  declarations = append
+                                   (s_parameters param |> parameters_to_decls single_argument_xxx)
+                                   (map s_local_decl local_decls);
+                  instructions = s_block block;
+                  result       = O.Constant O.Unit
+                }
+  }
+
+and s_entry_decl I.{value={kwd_entrypoint;name;param;kwd_is;local_decls;block;terminator}; region} =
+  let () = ignore (kwd_entrypoint,kwd_is,terminator,region) in
+  let tuple_type = s_parameters param |> parameters_to_tuple in
+  let single_argument = gensym tuple_type in
+  let ({name = single_argument_xxx; ty = _; orig = `TODO} : O.typed_var) = single_argument in
+  O.{
+      name = s_name name;
+      ty = type_expr region (Function { arg = tuple_type;
+                                        ret = type_expr region Unit });
+      value = Lambda {
+                  parameter    = single_argument;
+                  declarations = append
+                                   (s_parameters param |> parameters_to_decls single_argument_xxx)
+                                   (map s_local_decl local_decls);
+                  instructions = s_block block;
+                  result       = O.Constant O.Unit
+                }
+  }
+
+and s_lambda_decl : I.lambda_decl -> O.decl = function
+  FunDecl     fun_decl -> s_fun_decl fun_decl
+| EntryDecl entry_decl -> s_entry_decl entry_decl
+| ProcDecl   proc_decl -> s_proc_decl proc_decl
+
+type tmp_ast = {
+    types           : O.type_decl list;
+    storage_decl    : O.typed_var option;
+    operations_decl : O.typed_var option;
+    declarations    : O.decl list;
+  }
+
+
+let s_declaration (ast : tmp_ast) : I.declaration -> tmp_ast = function
+    TypeDecl    t -> { ast with types           = (s_type_decl    t) :: ast.types }
+  | ConstDecl   c -> { ast with declarations    = (s_const_decl   c) :: ast.declarations }
+  | StorageDecl s -> { ast with storage_decl    = Some (s_storage_decl    s) }
+  | OpDecl      o -> { ast with operations_decl = Some (s_operations_decl o) }
+  | LambdaDecl  l -> { ast with declarations    = (s_lambda_decl  l) :: ast.declarations }
+
+let s_ast (ast : I.ast) : O.ast =
+  let I.{decl=(decl1,decls);eof} = ast in
+  let () = ignore (eof) in
+  let {types; storage_decl; operations_decl; declarations} =
+    List.fold_left s_declaration
+                   { types = [];
+                     storage_decl = None;
+                     operations_decl = None;
+                     declarations = [] }
+                   ( decl1 :: decls ) in
+  let storage_decl = match storage_decl with
+      Some x -> x
+    | None -> failwith "Missing storage declaration" in
+  let () = match operations_decl with
+      Some _ -> failwith "Operations declaration is not allowed anymore TODO"
+    | None -> ()
+  in {types; storage_decl; declarations; orig = ast}
+
+
+
+
+(* let s_token region lexeme = *)
+(*   printf "%s: %s\n"(compact region) lexeme *)
+
+(* and s_var {region; value=lexeme} = *)
+(*   printf "%s: Ident \"%s\"\n" (compact region) lexeme *)
+
+(* and s_constr {region; value=lexeme} = *)
+(*   printf "%s: Constr \"%s\"\n" *)
+(*          (compact region) lexeme *)
+
+(* and s_string {region; value=lexeme} = *)
+(*   printf "%s: String \"%s\"\n" *)
+(*          (compact region) lexeme *)
+
+(* and s_bytes {region; value = lexeme, abstract} = *)
+(*   printf "%s: Bytes (\"%s\", \"0x%s\")\n" *)
+(*          (compact region) lexeme *)
+(*          (MBytes.to_hex abstract |> Hex.to_string) *)
+
+(* and s_int {region; value = lexeme, abstract} = *)
+(*   printf "%s: Int (\"%s\", %s)\n" *)
+(*          (compact region) lexeme *)
+(*          (Z.to_string abstract) *)
+
+
+(* and s_parameters {value=node; _} = *)
+(*   let lpar, sequence, rpar = node in *)
+(*   s_token lpar "("; *)
+(*   s_nsepseq ";" s_param_decl sequence; *)
+(*   s_token rpar ")" *)
+
+(* and s_param_decl = function *)
+(*   ParamConst param_const -> s_param_const param_const *)
+(* | ParamVar   param_var   -> s_param_var   param_var *)
+
+(* and s_region_cases {value=sequence; _} = *)
+(*   s_nsepseq "|" s_case sequence *)
+
+(* and s_expr = function *)
+(*   Or {value = expr1, bool_or, expr2; _} -> *)
+(*     s_expr expr1; s_token bool_or "||"; s_expr expr2 *)
+(* | And {value = expr1, bool_and, expr2; _} -> *)
+(*     s_expr expr1; s_token bool_and "&&"; s_expr expr2 *)
+(* | Lt {value = expr1, lt, expr2; _} -> *)
+(*     s_expr expr1; s_token lt "<"; s_expr expr2 *)
+(* | Leq {value = expr1, leq, expr2; _} -> *)
+(*     s_expr expr1; s_token leq "<="; s_expr expr2 *)
+(* | Gt {value = expr1, gt, expr2; _} -> *)
+(*     s_expr expr1; s_token gt ">"; s_expr expr2 *)
+(* | Geq {value = expr1, geq, expr2; _} -> *)
+(*     s_expr expr1; s_token geq ">="; s_expr expr2 *)
+(* | Equal {value = expr1, equal, expr2; _} -> *)
+(*     s_expr expr1; s_token equal "="; s_expr expr2 *)
+(* | Neq {value = expr1, neq, expr2; _} -> *)
+(*     s_expr expr1; s_token neq "=/="; s_expr expr2 *)
+(* | Cat {value = expr1, cat, expr2; _} -> *)
+(*     s_expr expr1; s_token cat "^"; s_expr expr2 *)
+(* | Cons {value = expr1, cons, expr2; _} -> *)
+(*     s_expr expr1; s_token cons "<:"; s_expr expr2 *)
+(* | Add {value = expr1, add, expr2; _} -> *)
+(*     s_expr expr1; s_token add "+"; s_expr expr2 *)
+(* | Sub {value = expr1, sub, expr2; _} -> *)
+(*     s_expr expr1; s_token sub "-"; s_expr expr2 *)
+(* | Mult {value = expr1, mult, expr2; _} -> *)
+(*     s_expr expr1; s_token mult "*"; s_expr expr2 *)
+(* | Div {value = expr1, div, expr2; _} -> *)
+(*     s_expr expr1; s_token div "/"; s_expr expr2 *)
+(* | Mod {value = expr1, kwd_mod, expr2; _} -> *)
+(*     s_expr expr1; s_token kwd_mod "mod"; s_expr expr2 *)
+(* | Neg {value = minus, expr; _} -> *)
+(*     s_token minus "-"; s_expr expr *)
+(* | Not {value = kwd_not, expr; _} -> *)
+(*     s_token kwd_not "not"; s_expr expr *)
+(* | Int i            -> s_int i *)
+(* | Var var          -> s_var var *)
+(* | String s         -> s_string s *)
+(* | Bytes b          -> s_bytes b *)
+(* | False region     -> s_token region "False" *)
+(* | True region      -> s_token region "True" *)
+(* | Unit region      -> s_token region "Unit" *)
+(* | Tuple tuple      -> s_tuple tuple *)
+(* | List list        -> s_list list *)
+(* | EmptyList elist  -> s_empty_list elist *)
+(* | Set set          -> s_set set *)
+(* | EmptySet eset    -> s_empty_set eset *)
+(* | NoneExpr nexpr   -> s_none_expr nexpr *)
+(* | FunCall fun_call -> s_fun_call fun_call *)
+(* | ConstrApp capp   -> s_constr_app capp *)
+(* | SomeApp sapp     -> s_some_app sapp *)
+(* | MapLookUp lookup -> s_map_lookup lookup *)
+(* | ParExpr pexpr    -> s_par_expr pexpr *)
+
+(* and s_list {value=node; _} = *)
+(*   let lbra, sequence, rbra = node in *)
+(*   s_token lbra "["; *)
+(*   s_nsepseq "," s_expr sequence; *)
+(*   s_token rbra "]" *)
+
+(* and s_empty_list {value=node; _} = *)
+(*   let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in *)
+(*   s_token     lpar "("; *)
+(*   s_token     lbracket "["; *)
+(*   s_token     rbracket "]"; *)
+(*   s_token     colon ":"; *)
+(*   s_type_expr type_expr; *)
+(*   s_token     rpar ")" *)
+
+(* and s_set {value=node; _} = *)
+(*   let lbrace, sequence, rbrace = node in *)
+(*   s_token lbrace "{"; *)
+(*   s_nsepseq "," s_expr sequence; *)
+(*   s_token rbrace "}" *)
+
+(* and s_empty_set {value=node; _} = *)
+(*   let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in *)
+(*   s_token     lpar "("; *)
+(*   s_token     lbrace "{"; *)
+(*   s_token     rbrace "}"; *)
+(*   s_token     colon ":"; *)
+(*   s_type_expr type_expr; *)
+(*   s_token     rpar ")" *)
+
+(* and s_none_expr {value=node; _} = *)
+(*   let lpar, (c_None, colon, type_expr), rpar = node in *)
+(*   s_token     lpar "("; *)
+(*   s_token     c_None "None"; *)
+(*   s_token     colon ":"; *)
+(*   s_type_expr type_expr; *)
+(*   s_token     rpar ")" *)
+
+(* and s_constr_app {value=node; _} = *)
+(*   let constr, arguments = node in *)
+(*   s_constr constr; *)
+(*   s_tuple  arguments *)
+
+(* and s_some_app {value=node; _} = *)
+(*   let c_Some, arguments = node in *)
+(*   s_token c_Some "Some"; *)
+(*   s_tuple arguments *)
+
+
+(* and s_par_expr {value=node; _} = *)
+(*   let lpar, expr, rpar = node in *)
+(*   s_token lpar "("; *)
+(*   s_expr  expr; *)
+(*   s_token rpar ")" *)
+
+(* and s_psome {value=node; _} = *)
+(*   let c_Some, patterns = node in *)
+(*   s_token    c_Some "Some"; *)
+(*   s_patterns patterns *)
+
+
+(* and s_terminator = function *)
+(*   Some semi -> s_token semi ";" *)
+(* | None -> () *)
+
+ *)

src/ligo/ligo-parser/LexToken.mli

@@ -67,26 +67,33 @@ type t =
 
 | And        of Region.t  (* "and"        *)
 | Begin      of Region.t  (* "begin"      *)
+| Block      of Region.t  (* "block"      *)
 | Case       of Region.t  (* "case"       *)
 | Const      of Region.t  (* "const"      *)
+| Contains   of Region.t  (* "contains"   *)
 | Down       of Region.t  (* "down"       *)
 | Else       of Region.t  (* "else"       *)
 | End        of Region.t  (* "end"        *)
 | Entrypoint of Region.t  (* "entrypoint" *)
 | Fail       of Region.t  (* "fail"       *)
 | For        of Region.t  (* "for"        *)
+| From       of Region.t  (* "from"       *)
 | Function   of Region.t  (* "function"   *)
 | If         of Region.t  (* "if"         *)
 | In         of Region.t  (* "in"         *)
 | Is         of Region.t  (* "is"         *)
+| List       of Region.t  (* "list"       *)
 | Map        of Region.t  (* "map"        *)
 | Mod        of Region.t  (* "mod"        *)
+| Nil        of Region.t  (* "nil"        *)
 | Not        of Region.t  (* "not"        *)
 | Of         of Region.t  (* "of"         *)
 | Or         of Region.t  (* "or"         *)
 | Patch      of Region.t  (* "patch"      *)
 | Procedure  of Region.t  (* "procedure"  *)
 | Record     of Region.t  (* "record"     *)
+| Remove     of Region.t  (* "remove"     *)
+| Set        of Region.t  (* "set"        *)
 | Skip       of Region.t  (* "skip"       *)
 | Step       of Region.t  (* "step"       *)
 | Storage    of Region.t  (* "storage"    *)

src/ligo/ligo-parser/LexToken.mll

@@ -66,26 +66,33 @@ type t =
 
 | And        of Region.t  (* "and"        *)
 | Begin      of Region.t  (* "begin"      *)
+| Block      of Region.t  (* "block"      *)
 | Case       of Region.t  (* "case"       *)
 | Const      of Region.t  (* "const"      *)
+| Contains   of Region.t  (* "contains"   *)
 | Down       of Region.t  (* "down"       *)
 | Else       of Region.t  (* "else"       *)
 | End        of Region.t  (* "end"        *)
 | Entrypoint of Region.t  (* "entrypoint" *)
 | Fail       of Region.t  (* "fail"       *)
 | For        of Region.t  (* "for"        *)
+| From       of Region.t  (* "from"       *)
 | Function   of Region.t  (* "function"   *)
 | If         of Region.t  (* "if"         *)
 | In         of Region.t  (* "in"         *)
 | Is         of Region.t  (* "is"         *)
+| List       of Region.t  (* "list"       *)
 | Map        of Region.t  (* "map"        *)
 | Mod        of Region.t  (* "mod"        *)
+| Nil        of Region.t  (* "nil"        *)
 | Not        of Region.t  (* "not"        *)
 | Of         of Region.t  (* "of"         *)
 | Or         of Region.t  (* "or"         *)
 | Patch      of Region.t  (* "patch"      *)
 | Procedure  of Region.t  (* "procedure"  *)
 | Record     of Region.t  (* "record"     *)
+| Remove     of Region.t  (* "remove"     *)
+| Set        of Region.t  (* "set"        *)
 | Skip       of Region.t  (* "skip"       *)
 | Step       of Region.t  (* "step"       *)
 | Storage    of Region.t  (* "storage"    *)
@@ -186,26 +193,33 @@ let proj_token = function
 
 | And        region -> region, "And"
 | Begin      region -> region, "Begin"
+| Block      region -> region, "Block"
 | Case       region -> region, "Case"
 | Const      region -> region, "Const"
+| Contains   region -> region, "Contains"
 | Down       region -> region, "Down"
 | Else       region -> region, "Else"
 | End        region -> region, "End"
 | Entrypoint region -> region, "Entrypoint"
 | Fail       region -> region, "Fail"
 | For        region -> region, "For"
+| From       region -> region, "From"
 | Function   region -> region, "Function"
 | If         region -> region, "If"
 | In         region -> region, "In"
 | Is         region -> region, "Is"
+| List       region -> region, "List"
 | Map        region -> region, "Map"
 | Mod        region -> region, "Mod"
+| Nil        region -> region, "Nil"
 | Not        region -> region, "Not"
 | Of         region -> region, "Of"
 | Or         region -> region, "Or"
 | Patch      region -> region, "Patch"
 | Procedure  region -> region, "Procedure"
 | Record     region -> region, "Record"
+| Remove     region -> region, "Remove"
+| Set        region -> region, "Set"
 | Skip       region -> region, "Skip"
 | Step       region -> region, "Step"
 | Storage    region -> region, "Storage"
@@ -271,33 +285,40 @@ let to_lexeme = function
 
 | And        _ -> "and"
 | Begin      _ -> "begin"
+| Block      _ -> "block"
 | Case       _ -> "case"
 | Const      _ -> "const"
+| Contains   _ -> "contains"
 | Down       _ -> "down"
+| Else       _ -> "else"
+| End        _ -> "end"
+| Entrypoint _ -> "entrypoint"
 | Fail       _ -> "fail"
+| For        _ -> "for"
+| From       _ -> "from"
+| Function   _ -> "function"
 | If         _ -> "if"
 | In         _ -> "in"
 | Is         _ -> "is"
-| Entrypoint _ -> "entrypoint"
+| List       _ -> "list"
-| For        _ -> "for"
+| Map        _ -> "map"
-| Function   _ -> "function"
+| Mod        _ -> "mod"
-| Type       _ -> "type"
+| Nil        _ -> "nil"
+| Not        _ -> "not"
 | Of         _ -> "of"
 | Or         _ -> "or"
-| Var        _ -> "var"
-| End        _ -> "end"
-| Then       _ -> "then"
-| Else       _ -> "else"
-| Map        _ -> "map"
 | Patch      _ -> "patch"
 | Procedure  _ -> "procedure"
 | Record     _ -> "record"
+| Remove     _ -> "remove"
+| Set        _ -> "set"
 | Skip       _ -> "skip"
 | Step       _ -> "step"
 | Storage    _ -> "storage"
+| Then       _ -> "then"
 | To         _ -> "to"
-| Mod        _ -> "mod"
+| Type       _ -> "type"
-| Not        _ -> "not"
+| Var        _ -> "var"
 | While      _ -> "while"
 | With       _ -> "with"
 
@@ -326,78 +347,47 @@ let to_region token = proj_token token |> fst
 let keywords = [
   (fun reg -> And        reg);
   (fun reg -> Begin      reg);
+  (fun reg -> Block      reg);
   (fun reg -> Case       reg);
   (fun reg -> Const      reg);
+  (fun reg -> Contains   reg);
   (fun reg -> Down       reg);
+  (fun reg -> Else       reg);
+  (fun reg -> End        reg);
+  (fun reg -> Entrypoint reg);
+  (fun reg -> For        reg);
+  (fun reg -> From       reg);
+  (fun reg -> Function   reg);
   (fun reg -> Fail       reg);
   (fun reg -> If         reg);
   (fun reg -> In         reg);
   (fun reg -> Is         reg);
-  (fun reg -> Entrypoint reg);
+  (fun reg -> List       reg);
-  (fun reg -> For        reg);
+  (fun reg -> Map        reg);
-  (fun reg -> Function   reg);
+  (fun reg -> Mod        reg);
-  (fun reg -> Type       reg);
+  (fun reg -> Nil        reg);
+  (fun reg -> Not        reg);
   (fun reg -> Of         reg);
   (fun reg -> Or         reg);
-  (fun reg -> Var        reg);
-  (fun reg -> End        reg);
-  (fun reg -> Then       reg);
-  (fun reg -> Else       reg);
-  (fun reg -> Map        reg);
   (fun reg -> Patch      reg);
   (fun reg -> Procedure  reg);
   (fun reg -> Record     reg);
+  (fun reg -> Remove     reg);
+  (fun reg -> Set        reg);
   (fun reg -> Skip       reg);
   (fun reg -> Step       reg);
   (fun reg -> Storage    reg);
+  (fun reg -> Then       reg);
   (fun reg -> To         reg);
-  (fun reg -> Mod        reg);
+  (fun reg -> Type       reg);
-  (fun reg -> Not        reg);
+  (fun reg -> Var        reg);
   (fun reg -> While      reg);
   (fun reg -> With       reg)
 ]
 
 let reserved =
   let open SSet in
-  empty |> add "as"
+  empty |> add "args"
-        |> add "asr"
-        |> add "assert"
-        |> add "class"
-        |> add "constraint"
-        |> add "do"
-        |> add "done"
-        |> add "downto"
-        |> add "exception"
-        |> add "external"
-        |> add "false"
-        |> add "fun"
-        |> add "functor"
-        |> add "include"
-        |> add "inherit"
-        |> add "initializer"
-        |> add "land"
-        |> add "lazy"
-        |> add "let"
-        |> add "lor"
-        |> add "lsl"
-        |> add "lsr"
-        |> add "lxor"
-        |> add "method"
-        |> add "module"
-        |> add "mutable"
-        |> add "new"
-        |> add "nonrec"
-        |> add "object"
-        |> add "open"
-        |> add "private"
-        |> add "rec"
-        |> add "sig"
-        |> add "struct"
-        |> add "true"
-        |> add "try"
-        |> add "val"
-        |> add "virtual"
-        |> add "when"
 
 let constructors = [
   (fun reg -> C_False reg);
@@ -549,33 +539,40 @@ let is_ident = function
 let is_kwd = function
   And        _
 | Begin      _
+| Block      _
 | Case       _
 | Const      _
+| Contains   _
 | Down       _
+| Else       _
+| End        _
+| Entrypoint _
 | Fail       _
+| For        _
+| From       _
+| Function   _
 | If         _
 | In         _
 | Is         _
-| Entrypoint _
+| List       _
-| For        _
+| Map        _
-| Function   _
+| Mod        _
-| Type       _
+| Nil        _
+| Not        _
 | Of         _
 | Or         _
-| Var        _
-| End        _
-| Then       _
-| Else       _
-| Map        _
 | Patch      _
 | Procedure  _
 | Record     _
+| Remove     _
+| Set        _
 | Skip       _
 | Step       _
 | Storage    _
+| Then       _
 | To         _
-| Mod        _
+| Type       _
-| Not        _
+| Var        _
 | While      _
 | With       _ -> true
 |            _ -> false

src/ligo/ligo-parser/Lexer.mll

@@ -459,8 +459,7 @@ let byte_seq   = byte | byte (byte | '_')* byte
 let bytes      = "0x" (byte_seq? as seq)
 let esc        = "\\n" | "\\\"" | "\\\\" | "\\b"
                | "\\r" | "\\t" | "\\x" byte
-let symbol     = ';' | ','
+let symbol     = ';' | ',' | '(' | ')'| '[' | ']' | '{' | '}'
-               | '(' | ')' | '{' | '}' | '[' | ']'
                | '#' | '|' | "->" | ":=" | '=' | ':'
                | '<' | "<=" | '>' | ">=" | "=/="
                | '+' | '-' | '*' | '.' | '_' | '^'

src/ligo/ligo-parser/MBytes.ml

@@ -1,6 +0,0 @@
-(* TEMPORARY: SHOULD BE ERASED *)
-
-type t = Hex.t
-
-let of_hex x = x
-let to_hex x = x

src/ligo/ligo-parser/MBytes.mli

@@ -1,6 +0,0 @@
-(* TEMPORARY: SHOULD BE ERASED *)
-
-type t
-
-val of_hex : Hex.t -> t
-val to_hex : t -> Hex.t

src/ligo/ligo-parser/ParToken.mly

@@ -44,33 +44,40 @@
 
 %token <Region.t> And         (* "and"        *)
 %token <Region.t> Begin       (* "begin"      *)
+%token <Region.t> Block       (* "block"      *)
 %token <Region.t> Case        (* "case"       *)
 %token <Region.t> Const       (* "const"      *)
+%token <Region.t> Contains    (* "contains"   *)
 %token <Region.t> Down        (* "down"       *)
+%token <Region.t> Else        (* "else"       *)
+%token <Region.t> End         (* "end"        *)
+%token <Region.t> Entrypoint  (* "entrypoint" *)
 %token <Region.t> Fail        (* "fail"       *)
+%token <Region.t> For         (* "for"        *)
+%token <Region.t> Function    (* "function"   *)
+%token <Region.t> From        (* "from"       *)
 %token <Region.t> If          (* "if"         *)
 %token <Region.t> In          (* "in"         *)
 %token <Region.t> Is          (* "is"         *)
-%token <Region.t> Entrypoint  (* "entrypoint" *)
+%token <Region.t> List        (* "list"       *)
-%token <Region.t> For         (* "for"        *)
+%token <Region.t> Map         (* "map"        *)
-%token <Region.t> Function    (* "function"   *)
+%token <Region.t> Mod         (* "mod"        *)
-%token <Region.t> Type        (* "type"       *)
+%token <Region.t> Nil         (* "nil"        *)
+%token <Region.t> Not         (* "not"        *)
 %token <Region.t> Of          (* "of"         *)
 %token <Region.t> Or          (* "or"         *)
-%token <Region.t> Var         (* "var"        *)
-%token <Region.t> End         (* "end"        *)
-%token <Region.t> Then        (* "then"       *)
-%token <Region.t> Else        (* "else"       *)
-%token <Region.t> Map         (* "map"        *)
 %token <Region.t> Patch       (* "patch"      *)
 %token <Region.t> Procedure   (* "procedure"  *)
 %token <Region.t> Record      (* "record"     *)
+%token <Region.t> Remove      (* "remove"     *)
+%token <Region.t> Set         (* "set"        *)
 %token <Region.t> Skip        (* "skip"       *)
 %token <Region.t> Step        (* "step"       *)
 %token <Region.t> Storage     (* "storage"    *)
+%token <Region.t> Then        (* "then"       *)
 %token <Region.t> To          (* "to"         *)
-%token <Region.t> Mod         (* "mod"        *)
+%token <Region.t> Type        (* "type"       *)
-%token <Region.t> Not         (* "not"        *)
+%token <Region.t> Var         (* "var"        *)
 %token <Region.t> While       (* "while"      *)
 %token <Region.t> With        (* "with"       *)
 

src/ligo/ligo-parser/Parser.mly

@@ -21,32 +21,32 @@ open AST
 
 (* RULES *)
 
-(* The rule [series(Item)] parses a list of [Item] separated by
+(* The rule [series(Item,TERM)] parses a list of [Item] separated by
-   semi-colons and optionally terminated by a semi-colon, then the
+   semicolons and optionally terminated by a semicolon, then the
-   keyword [End]. *)
+   terminal TERM. *)
 
-series(Item):
+series(Item,TERM):
-  Item after_item(Item) { $1,$2 }
+  Item after_item(Item,TERM) { $1,$2 }
 
-after_item(Item):
+after_item(Item,TERM):
-  SEMI item_or_end(Item) {
+  SEMI item_or_closing(Item,TERM) {
     match $2 with
-      `Some (item, items, term, close) ->
+      `Some (item, items, term, closing) ->
-        ($1, item)::items, term, close
+        ($1, item)::items, term, closing
-    | `End close ->
+    | `Closing closing ->
-        [], Some $1, close
+        [], Some $1, closing
   }
-| End {
+| TERM {
    [], None, $1
   }
 
-item_or_end(Item):
+item_or_closing(Item,TERM):
-  End {
+  TERM {
-   `End $1
+   `Closing $1
   }
-| series(Item) {
+| series(Item,TERM) {
-    let item, (items, term, close) = $1
+    let item, (items, term, closing) = $1
-    in `Some (item, items, term, close)
+    in `Some (item, items, term, closing)
   }
 
 (* Compound constructs *)
@@ -61,20 +61,10 @@ par(X):
     in {region; value}
   }
 
-braces(X):
-  LBRACE X RBRACE {
-    let region = cover $1 $3
-    and value = {
-      lbrace = $1;
-      inside = $2;
-      rbrace = $3}
-    in {region; value}
-  }
-
 brackets(X):
   LBRACKET X RBRACKET {
     let region = cover $1 $3
-    and value = {
+    and value  = {
       lbracket = $1;
       inside   = $2;
       rbracket = $3}
@@ -135,9 +125,9 @@ contract:
   }
 
 declaration:
-  type_decl       {    TypeDecl $1 }
+  type_decl   {    TypeDecl $1 }
-| const_decl      {   ConstDecl $1 }
+| const_decl  {   ConstDecl $1 }
-| lambda_decl     {  LambdaDecl $1 }
+| lambda_decl {  LambdaDecl $1 }
 
 (* Type declarations *)
 
@@ -164,8 +154,7 @@ type_expr:
 cartesian:
   nsepseq(core_type,TIMES) {
     let region = nsepseq_to_region type_expr_to_region $1
-    in {region; value=$1}
+    in {region; value=$1}}
-  }
 
 core_type:
   type_name {
@@ -177,12 +166,25 @@ core_type:
   }
 | Map type_tuple {
     let region = cover $1 $2.region in
-    let value = {value="map"; region=$1}
+    let type_constr = {value="map"; region=$1}
-    in TApp {region; value = value, $2}
+    in TApp {region; value = type_constr, $2}
+  }
+| Set par(type_expr) {
+    let total = cover $1 $2.region in
+    let type_constr = {value="set"; region=$1} in
+    let {region; value = {lpar; inside; rpar}} = $2 in
+    let tuple = {region; value={lpar; inside=inside,[]; rpar}}
+    in TApp {region=total; value = type_constr, tuple}
+  }
+| List par(type_expr) {
+    let total = cover $1 $2.region in
+    let type_constr = {value="list"; region=$1} in
+    let {region; value = {lpar; inside; rpar}} = $2 in
+    let tuple = {region; value={lpar; inside=inside,[]; rpar}}
+    in TApp {region=total; value = type_constr, tuple}
   }
 | par(type_expr) {
-    TPar $1
+    TPar $1}
-  }
 
 type_tuple:
   par(nsepseq(type_expr,COMMA)) { $1 }
@@ -190,39 +192,37 @@ type_tuple:
 sum_type:
   nsepseq(variant,VBAR) {
     let region = nsepseq_to_region (fun x -> x.region) $1
-    in {region; value = $1}
+    in {region; value = $1}}
-  }
 
 variant:
   Constr Of cartesian {
     let region = cover $1.region $3.region
     and value = {constr = $1; kwd_of = $2; product = $3}
-    in {region; value}
+    in {region; value}}
-  }
 
 record_type:
-  Record
+  Record series(field_decl,End) {
-    nsepseq(field_decl,SEMI)
+   let first, (others, terminator, closing) = $2 in
-  End
+   let region = cover $1 closing
-  {
+   and value  = {
-   let region = cover $1 $3
+     opening = $1;
-   and value  = {kwd_record = $1; fields = $2; kwd_end = $3}
+     field_decls = first, others;
-   in {region; value}
+     terminator;
-  }
+     closing}
+   in {region; value}}
 
 field_decl:
   field_name COLON type_expr {
     let stop   = type_expr_to_region $3 in
     let region = cover $1.region stop
     and value  = {field_name = $1; colon = $2; field_type = $3}
-    in {region; value}
+    in {region; value}}
-  }
 
 (* Function and procedure declarations *)
 
 lambda_decl:
-  fun_decl   { FunDecl   $1 }
+  fun_decl   {   FunDecl $1 }
-| proc_decl  { ProcDecl  $1 }
+| proc_decl  {  ProcDecl $1 }
 | entry_decl { EntryDecl $1 }
 
 fun_decl:
@@ -234,8 +234,8 @@ fun_decl:
       match $11 with
         Some region -> region
       |        None -> expr_to_region $10 in
-    let region = cover $1 stop in
+    let region = cover $1 stop
-    let value = {
+    and value = {
       kwd_function = $1;
       name         = $2;
       param        = $3;
@@ -247,8 +247,7 @@ fun_decl:
       kwd_with     = $9;
       return       = $10;
       terminator   = $11}
-    in {region; value}
+    in {region; value}}
-  }
 
 entry_decl:
   Entrypoint fun_name entry_params COLON type_expr Is
@@ -259,8 +258,8 @@ entry_decl:
       match $11 with
         Some region -> region
       |        None -> expr_to_region $10 in
-    let region = cover $1 stop in
+    let region = cover $1 stop
-    let value = {
+    and value = {
       kwd_entrypoint = $1;
       name           = $2;
       param          = $3;
@@ -272,8 +271,7 @@ entry_decl:
       kwd_with       = $9;
       return         = $10;
       terminator     = $11}
-    in {region; value}
+    in {region; value}}
-  }
 
 entry_params:
   par(nsepseq(entry_param_decl,SEMI)) { $1 }
@@ -287,8 +285,8 @@ proc_decl:
        match $7 with
          Some region -> region
        |        None -> $6.region in
-     let region = cover $1 stop in
+     let region = cover $1 stop
-     let value = {
+     and value = {
        kwd_procedure = $1;
        name          = $2;
        param         = $3;
@@ -296,14 +294,13 @@ proc_decl:
        local_decls   = $5;
        block         = $6;
        terminator    = $7}
-     in {region; value}
+     in {region; value}}
-  }
 
 parameters:
   par(nsepseq(param_decl,SEMI)) { $1 }
 
 param_decl:
-  Var var COLON type_expr {
+  Var var COLON param_type {
     let stop   = type_expr_to_region $4 in
     let region = cover $1 stop
     and value  = {
@@ -313,7 +310,7 @@ param_decl:
       param_type = $4}
     in ParamVar {region; value}
   }
-| Const var COLON type_expr {
+| Const var COLON param_type {
     let stop   = type_expr_to_region $4 in
     let region = cover $1 stop
     and value  = {
@@ -321,8 +318,7 @@ param_decl:
       var        = $2;
       colon      = $3;
       param_type = $4}
-    in ParamConst {region; value}
+    in ParamConst {region; value}}
-  }
 
 entry_param_decl:
   param_decl {
@@ -330,7 +326,7 @@ entry_param_decl:
       ParamConst const -> EntryConst const
     | ParamVar     var -> EntryVar   var
   }
-| Storage var COLON type_expr {
+| Storage var COLON param_type {
     let stop   = type_expr_to_region $4 in
     let region = cover $1 stop
     and value  = {
@@ -338,46 +334,101 @@ entry_param_decl:
       var          = $2;
       colon        = $3;
       storage_type = $4}
-    in EntryStore {region; value}
+    in EntryStore {region; value}}
+
+param_type:
+  nsepseq(core_param_type,TIMES) {
+    let region = nsepseq_to_region type_expr_to_region $1
+    in TProd {region; value=$1}}
+
+core_param_type:
+  type_name {
+    TAlias $1
   }
+| type_name type_tuple {
+    let region = cover $1.region $2.region
+    in TApp {region; value = $1,$2}}
 
 block:
-  Begin series(instruction) {
+  Begin series(statement,End) {
-   let first, (others, terminator, close) = $2 in
+   let first, (others, terminator, closing) = $2 in
-   let region = cover $1 close
+   let region = cover $1 closing
    and value = {
-     opening = $1;
+     opening    = Begin $1;
-     instr   = first, others;
+     statements = first, others;
      terminator;
-     close}
+     closing    = End closing}
    in {region; value}
   }
+| Block LBRACE series(statement,RBRACE) {
+   let first, (others, terminator, closing) = $3 in
+   let region = cover $1 closing
+   and value = {
+     opening    = Block ($1,$2);
+     statements = first, others;
+     terminator;
+     closing    = Block closing}
+   in {region; value}}
+
+statement:
+  instruction     { Instr $1 }
+| open_data_decl  { Data  $1 }
+
+open_data_decl:
+  open_const_decl { LocalConst $1 }
+| open_var_decl   { LocalVar   $1 }
+
+open_const_decl:
+  Const unqualified_decl(EQUAL) {
+    let name, colon, const_type, equal, init, stop = $2 in
+    let region = cover $1 stop
+    and value = {
+      kwd_const = $1;
+      name;
+      colon;
+      const_type;
+      equal;
+      init;
+      terminator = None}
+    in {region; value}}
+
+open_var_decl:
+  Var unqualified_decl(ASS) {
+    let name, colon, var_type, assign, init, stop = $2 in
+    let region = cover $1 stop
+    and value = {
+      kwd_var = $1;
+      name;
+      colon;
+      var_type;
+      assign;
+      init;
+      terminator = None}
+    in {region; value}}
 
 local_decl:
-  lambda_decl { LocalLam   $1 }
+  lambda_decl { LocalLam  $1 }
-| const_decl  { LocalConst $1 }
+| data_decl   { LocalData $1 }
-| var_decl    { LocalVar   $1 }
+
+data_decl:
+  const_decl { LocalConst $1 }
+| var_decl   { LocalVar   $1 }
 
 unqualified_decl(OP):
-  var COLON type_expr OP extended_expr option(SEMI) {
+  var COLON type_expr OP extended_expr {
-    let stop = match $6 with
+    let init, region =
-                 Some region -> region
+      match $5 with
-               |        None -> $5.region in
+        `Expr e -> e, expr_to_region e
-    let init =
+      | `EList kwd_nil ->
-      match $5.value with
+           let value = {
-        `Expr e -> e
+             nil = kwd_nil;
-      | `EList (lbracket, rbracket) ->
-           let region = $5.region
-           and value = {
-             lbracket;
-             rbracket;
              colon = Region.ghost;
              list_type = $3} in
            let value = {
              lpar   = Region.ghost;
              inside = value;
              rpar   = Region.ghost} in
-           EList (EmptyList {region; value})
+           EList (Nil {region=kwd_nil; value}), kwd_nil
       | `ENone region ->
            let value = {
              lpar = Region.ghost;
@@ -386,56 +437,49 @@ unqualified_decl(OP):
                colon    = Region.ghost;
                opt_type = $3};
              rpar = Region.ghost}
-           in EConstr (NoneExpr {region; value})
+           in EConstr (NoneExpr {region; value}), region
-      | `EMap inj ->
+    in $1, $2, $3, $4, init, region}
-           EMap (MapInj inj)
-    in $1, $2, $3, $4, init, $6, stop
-  }
 
 const_decl:
-  Const unqualified_decl(EQUAL) {
+  Const unqualified_decl(EQUAL) SEMI {
-    let name, colon, const_type, equal,
+    let name, colon, const_type, equal, init, _ = $2 in
-        init, terminator, stop = $2 in
+    let region = cover $1 $3
-    let region = cover $1 stop in
+    and value = {
-    let value = {
       kwd_const = $1;
       name;
       colon;
       const_type;
       equal;
       init;
-      terminator}
+      terminator = Some $3}
     in {region; value}
   }
+| open_const_decl { $1 }
 
 var_decl:
-  Var unqualified_decl(ASS) {
+  Var unqualified_decl(ASS) SEMI {
-    let name, colon, var_type, assign,
+    let name, colon, var_type, assign, init, _ = $2 in
-        init, terminator, stop = $2 in
+    let region = cover $1 $3
-    let region = cover $1 stop in
+    and value = {
-    let value = {
       kwd_var = $1;
       name;
       colon;
       var_type;
       assign;
       init;
-      terminator}
+      terminator = Some $3}
     in {region; value}
   }
+| open_var_decl { $1 }
 
 extended_expr:
-  expr              { {region = expr_to_region $1;
+  expr   { `Expr  $1 }
-                       value  = `Expr $1} }
+| Nil    { `EList $1 }
-| LBRACKET RBRACKET { {region = cover $1 $2;
+| C_None { `ENone $1 }
-                       value  = `EList ($1,$2)} }
-| C_None            { {region = $1; value = `ENone $1} }
-| map_injection     { {region = $1.region; value = `EMap $1} }
-
 
 instruction:
   single_instr { Single $1 }
-| block        { Block  $1 }
+| block        { Block  $1 : instruction }
 
 single_instr:
   conditional  {        Cond $1 }
@@ -447,6 +491,41 @@ single_instr:
 | Skip         {        Skip $1 }
 | record_patch { RecordPatch $1 }
 | map_patch    {    MapPatch $1 }
+| set_patch    {    SetPatch $1 }
+| map_remove   {   MapRemove $1 }
+| set_remove   {   SetRemove $1 }
+
+set_remove:
+  Remove expr From Set path {
+    let region = cover $1 (path_to_region $5) in
+    let value  = {
+      kwd_remove = $1;
+      element    = $2;
+      kwd_from   = $3;
+      kwd_set    = $4;
+      set        = $5}
+    in {region; value}}
+
+map_remove:
+  Remove expr From Map path {
+    let region = cover $1 (path_to_region $5) in
+    let value  = {
+      kwd_remove = $1;
+      key        = $2;
+      kwd_from   = $3;
+      kwd_map    = $4;
+      map        = $5}
+    in {region; value}}
+
+set_patch:
+  Patch path With injection(Set,expr) {
+    let region = cover $1 $4.region in
+    let value  = {
+      kwd_patch = $1;
+      path      = $2;
+      kwd_with  = $3;
+      set_inj   = $4}
+    in {region; value}}
 
 map_patch:
   Patch path With map_injection {
@@ -456,20 +535,85 @@ map_patch:
       path      = $2;
       kwd_with  = $3;
       map_inj   = $4}
+    in {region; value}}
+
+injection(Kind,element):
+  Kind series(element,End) {
+    let first, (others, terminator, closing) = $2 in
+    let region = cover $1 closing
+    and value = {
+      opening  = Kwd $1;
+      elements = Some (first, others);
+      terminator;
+      closing = End closing}
     in {region; value}
   }
+| Kind End {
+    let region = cover $1 $2
+    and value = {
+      opening    = Kwd $1;
+      elements   = None;
+      terminator = None;
+      closing    = End $2}
+    in {region; value}
+  }
+| Kind LBRACKET series(element,RBRACKET) {
+    let first, (others, terminator, closing) = $3 in
+    let region = cover $1 closing
+    and value = {
+      opening  = KwdBracket ($1,$2);
+      elements = Some (first, others);
+      terminator;
+      closing = RBracket closing}
+    in {region; value}
+  }
+| Kind LBRACKET RBRACKET {
+    let region = cover $1 $3
+    and value = {
+      opening    = KwdBracket ($1,$2);
+      elements   = None;
+      terminator = None;
+      closing    = RBracket $3}
+    in {region; value}}
 
 map_injection:
-  Map series(binding) {
+  Map series(binding,End) {
-    let first, (others, terminator, close) = $2 in
+    let first, (others, terminator, closing) = $2 in
-    let region = cover $1 close
+    let region = cover $1 closing
     and value = {
-      opening  = $1;
+      opening  = Kwd $1;
-      bindings = first, others;
+      elements = Some (first, others);
       terminator;
-      close}
+      closing = End closing}
     in {region; value}
   }
+| Map End {
+    let region = cover $1 $2
+    and value = {
+      opening    = Kwd $1;
+      elements   = None;
+      terminator = None;
+      closing    = End $2}
+    in {region; value}
+  }
+| Map LBRACKET series(binding,RBRACKET) {
+    let first, (others, terminator, closing) = $3 in
+    let region = cover $1 closing
+    and value = {
+      opening  = KwdBracket ($1,$2);
+      elements = Some (first, others);
+      terminator;
+      closing = RBracket closing}
+    in {region; value}
+  }
+| Map LBRACKET RBRACKET {
+    let region = cover $1 $3
+    and value = {
+      opening    = KwdBracket ($1,$2);
+      elements   = None;
+      terminator = None;
+      closing    = RBracket $3}
+    in {region; value}}
 
 binding:
   expr ARROW expr {
@@ -480,8 +624,7 @@ binding:
       source = $1;
       arrow  = $2;
       image  = $3}
-    in {region; value}
+    in {region; value}}
-  }
 
 record_patch:
   Patch path With record_injection {
@@ -491,8 +634,7 @@ record_patch:
       path       = $2;
       kwd_with   = $3;
       record_inj = $4}
-    in {region; value}
+    in {region; value}}
-  }
 
 fail_instr:
   Fail expr {
@@ -504,17 +646,30 @@ proc_call:
   fun_call { $1 }
 
 conditional:
-  If expr Then instruction Else instruction {
+  If expr Then if_clause option(SEMI) Else if_clause {
-    let region = cover $1 (instr_to_region $6) in
+    let region = cover $1 (if_clause_to_region $7) in
     let value = {
-      kwd_if   = $1;
+      kwd_if     = $1;
-      test     = $2;
+      test       = $2;
-      kwd_then = $3;
+      kwd_then   = $3;
-      ifso     = $4;
+      ifso       = $4;
-      kwd_else = $5;
+      terminator = $5;
-      ifnot    = $6}
+      kwd_else   = $6;
-    in {region; value}
+      ifnot      = $7}
+    in {region; value}}
+
+if_clause:
+  instruction {
+    ClauseInstr $1
   }
+| LBRACE series(statement,RBRACE) {
+   let first, (others, terminator, closing) = $2 in
+   let region = cover $1 closing in
+   let value = {
+     lbrace = $1;
+     inside = (first, others), terminator;
+     rbrace = closing} in
+   ClauseBlock {value; region}}
 
 case_instr:
   Case expr Of option(VBAR) cases End {
@@ -526,29 +681,25 @@ case_instr:
       lead_vbar = $4;
       cases     = $5;
       kwd_end   = $6}
-    in {region; value}
+    in {region; value}}
-  }
 
 cases:
   nsepseq(case,VBAR) {
     let region = nsepseq_to_region (fun x -> x.region) $1
-    in {region; value = $1}
+    in {region; value = $1}}
-  }
 
 case:
   pattern ARROW instruction {
     let region = cover (pattern_to_region $1) (instr_to_region $3)
     and value  = {pattern = $1; arrow = $2; instr = $3}
-    in {region; value}
+    in {region; value}}
-  }
 
 assignment:
   lhs ASS rhs {
     let stop   = rhs_to_region $3 in
     let region = cover (lhs_to_region $1) stop
     and value  = {lhs = $1; assign = $2; rhs = $3}
-    in {region; value}
+    in {region; value}}
-  }
 
 rhs:
   expr   {     Expr $1 }
@@ -569,20 +720,19 @@ while_loop:
       kwd_while = $1;
       cond      = $2;
       block     = $3}
-    in While {region; value}
+    in While {region; value}}
-  }
 
 for_loop:
   For var_assign Down? To expr option(step_clause) block {
     let region = cover $1 $7.region in
     let value = {
-      kwd_for  = $1;
+      kwd_for = $1;
-      assign   = $2;
+      assign  = $2;
-      down     = $3;
+      down    = $3;
-      kwd_to   = $4;
+      kwd_to  = $4;
-      bound    = $5;
+      bound   = $5;
-      step     = $6;
+      step    = $6;
-      block    = $7}
+      block   = $7}
     in For (ForInt {region; value})
   }
 | For var option(arrow_clause) In expr block {
@@ -594,15 +744,13 @@ for_loop:
       kwd_in  = $4;
       expr    = $5;
       block   = $6}
-    in For (ForCollect {region; value})
+    in For (ForCollect {region; value})}
-  }
 
 var_assign:
   var ASS expr {
     let region = cover $1.region (expr_to_region $3)
     and value  = {name = $1; assign = $2; expr = $3}
-    in {region; value}
+    in {region; value}}
-  }
 
 step_clause:
   Step expr { $1,$2 }
@@ -626,13 +774,26 @@ expr:
 | conj_expr { $1 }
 
 conj_expr:
-  conj_expr And comp_expr {
+  conj_expr And set_membership {
     let start  = expr_to_region $1
     and stop   = expr_to_region $3 in
     let region = cover start stop
     and value  = {arg1 = $1; op = $2; arg2 = $3}
     in ELogic (BoolExpr (And {region; value}))
   }
+| set_membership { $1 }
+
+set_membership:
+  core_expr Contains set_membership {
+    let start  = expr_to_region $1
+    and stop   = expr_to_region $3 in
+    let region = cover start stop in
+    let value  = {
+      set          = $1;
+      kwd_contains = $2;
+      element      = $3}
+    in ESet (SetMem {region; value})
+  }
 | comp_expr { $1 }
 
 comp_expr:
@@ -757,62 +918,73 @@ unary_expr:
 | core_expr { $1 }
 
 core_expr:
-  Int              { EArith (Int $1) }
+  Int              { EArith (Int $1)              }
-| var              { EVar $1 }
+| var              { EVar $1                      }
-| String           { EString (String $1) }
+| String           { EString (String $1)          }
-| Bytes            { EBytes $1 }
+| Bytes            { EBytes $1                    }
 | C_False          { ELogic (BoolExpr (False $1)) }
-| C_True           { ELogic (BoolExpr (True $1)) }
+| C_True           { ELogic (BoolExpr (True  $1)) }
-| C_Unit           { EUnit $1 }
+| C_Unit           { EUnit $1                     }
-| tuple            { ETuple $1 }
+| tuple_expr       { ETuple $1                    }
-| list_expr        { EList (List $1) }
+| list_expr        { EList $1                     }
-| empty_list       { EList (EmptyList $1) }
+| none_expr        { EConstr (NoneExpr $1)        }
-| set_expr         { ESet (Set $1) }
+| fun_call         { ECall $1                     }
-| empty_set        { ESet (EmptySet $1) }
+| map_expr         { EMap $1                      }
-| none_expr        { EConstr (NoneExpr $1) }
+| set_expr         { ESet $1                      }
-| fun_call         { ECall $1 }
+| record_expr      { ERecord $1                   }
-| map_expr         { EMap $1 }
+| projection       { EProj $1                     }
-| record_expr      { ERecord $1 }
 | Constr arguments {
     let region = cover $1.region $2.region in
     EConstr (ConstrApp {region; value = $1,$2})
   }
 | C_Some arguments {
     let region = cover $1 $2.region in
-    EConstr (SomeApp {region; value = $1,$2})
+    EConstr (SomeApp {region; value = $1,$2})}
-  }
+
+set_expr:
+  injection(Set,expr) { SetInj $1 }
 
 map_expr:
-  map_lookup { MapLookUp $1 }
+  map_lookup    { MapLookUp $1 }
-
+| map_injection {    MapInj $1 }
-path:
-  var               {       Name $1 }
-| record_projection { RecordPath $1 }
 
 map_lookup:
   path brackets(expr) {
     let region = cover (path_to_region $1) $2.region in
-    let value  = {
+    let value  = {path=$1; index=$2}
-      path  = $1;
+    in {region; value}}
-      index = $2}
+
-    in {region; value}
+path:
-  }
+  var        { Name $1 }
+| projection { Path $1 }
 
 record_expr:
-  record_injection  { RecordInj  $1 }
+  record_injection { RecordInj $1 }
-| record_projection { RecordProj $1 }
+
+projection:
+  record_name DOT nsepseq(selection,DOT) {
+    let stop   = nsepseq_to_region selection_to_region $3 in
+    let region = cover $1.region stop
+    and value  = {
+      record_name = $1;
+      selector    = $2;
+      field_path  = $3}
+    in {region; value}}
+
+selection:
+  field_name { FieldName $1 }
+| Int        { Component $1 }
 
 record_injection:
-  Record series(field_assignment) {
+  Record series(field_assignment,End) {
-    let first, (others, terminator, close) = $2 in
+    let first, (others, terminator, closing) = $2 in
-    let region = cover $1 close
+    let region = cover $1 closing
     and value = {
       opening = $1;
       fields  = first, others;
       terminator;
-      close}
+      closing}
-    in {region; value}
+    in {region; value}}
-  }
 
 field_assignment:
   field_name EQUAL expr {
@@ -821,59 +993,34 @@ field_assignment:
       field_name = $1;
       equal      = $2;
       field_expr = $3}
-    in {region; value}
+    in {region; value}}
-  }
-
-record_projection:
-  record_name DOT nsepseq(field_name,DOT) {
-    let stop   = nsepseq_to_region (fun x -> x.region) $3 in
-    let region = cover $1.region stop
-    and value  = {
-      record_name = $1;
-      selector    = $2;
-      field_path  = $3}
-    in {region; value}
-  }
 
 fun_call:
   fun_name arguments {
     let region = cover $1.region $2.region
-    in {region; value = $1,$2}
+    in {region; value = $1,$2}}
-  }
 
-tuple:
+tuple_expr:
+  tuple_inj { TupleInj $1 }
+
+tuple_inj:
   par(nsepseq(expr,COMMA)) { $1 }
 
 arguments:
-  tuple { $1 }
+  tuple_inj { $1 }
 
 list_expr:
-  brackets(nsepseq(expr,COMMA)) { $1 }
+  injection(List,expr) { List $1 }
+| nil                  {  Nil $1 }
 
-empty_list:
+nil:
   par(typed_empty_list) { $1 }
 
 typed_empty_list:
-  LBRACKET RBRACKET COLON type_expr {
+  Nil COLON type_expr {
-    {lbracket  = $1;
+    {nil       = $1;
-     rbracket  = $2;
+     colon     = $2;
-     colon     = $3;
+     list_type = $3}}
-     list_type = $4}
-  }
-
-set_expr:
-  braces(nsepseq(expr,COMMA)) { $1 }
-
-empty_set:
-  par(typed_empty_set) { $1 }
-
-typed_empty_set:
-  LBRACE RBRACE COLON type_expr {
-    {lbrace   = $1;
-     rbrace   = $2;
-     colon    = $3;
-     set_type = $4}
-  }
 
 none_expr:
   par(typed_none_expr) { $1 }
@@ -882,16 +1029,14 @@ typed_none_expr:
   C_None COLON type_expr {
     {c_None   = $1;
      colon    = $2;
-     opt_type = $3}
+     opt_type = $3}}
-  }
 
 (* Patterns *)
 
 pattern:
   nsepseq(core_pattern,CONS) {
     let region = nsepseq_to_region pattern_to_region $1
-    in PCons {region; value=$1}
+    in PCons {region; value=$1}}
-  }
 
 core_pattern:
   var        {    PVar $1 }
@@ -906,12 +1051,12 @@ core_pattern:
 | tuple_patt {  PTuple $1 }
 | C_Some par(core_pattern) {
     let region = cover $1 $2.region
-    in PSome {region; value = $1,$2}
+    in PSome {region; value = $1,$2}}
-  }
 
 list_patt:
-  brackets(sepseq(core_pattern,COMMA)) { Sugar $1 }
+  injection(List,core_pattern) { Sugar $1 }
-| par(cons_pattern)                    {   Raw $1 }
+| Nil                          {  PNil $1 }
+| par(cons_pattern)            {   Raw $1 }
 
 cons_pattern:
   core_pattern CONS pattern { $1,$2,$3 }

src/ligo/ligo-parser/Tests/a.li

@@ -1,29 +0,0 @@
-type t is int * string
-type u is t
-type v is record foo: key; bar: mutez; baz: address end
-type w is K of (U of int) (*v * u*)
-
-storage s : w     // Line comment
-operations o : u;
-
-type i is int;
-
-(* Block comment *)
-
-entrypoint g (const l : list (int)) is
-   function f (const x : int) : int is
-     var y : int := 5 - x
-     const z : int = 6
-     begin
-       y := x + y
-     end with y * 2
-  begin
-     match l with
-         [] -> null
-     | h#t -> q (h+2)
-     end;
-     begin
-       g (Unit);
-       fail "in extremis"
-     end
-  end

src/ligo/ligo-parser/Tests/a.ligo

@@ -0,0 +1,45 @@
+type t is int * string
+type u is t
+
+type v is record
+            foo: key;
+            bar: mutez;
+            baz: address
+          end
+
+type w is K of (U of int) // v * u
+
+type i is int;
+
+const x : v =
+   record
+     foo = 4;
+     bar = 5;
+     baz = 0x3244
+   end
+
+(* Block comment *)
+
+entrypoint g (storage s : u; const l : list (int))
+  : operation (list) is
+  var m : map (int, string) := empty_map;
+  var y : v := copy x with record bar = 7 end;
+
+  function f (const x : int) : int is
+     var y : int := 5 - x
+     const z : int = 6
+     begin
+       y := x + y
+     end with y * 2
+
+  begin
+     y.[4] := "hello";
+     match l with
+        [] -> null
+     | h#t -> q (h+2)
+     end;
+     begin
+       g (Unit);
+       fail "in extremis"
+     end
+  end with (s, ([]: (u * operation (list))))

src/ligo/ligo-parser/Tests/crowdfunding.ligo

@@ -0,0 +1,64 @@
+type store is
+  record
+    goal     : nat;
+    deadline : timestamp;
+    backers  : map (address, nat);
+    funded   : bool;
+  end
+
+entrypoint contribute (storage store : store;
+                       const sender  : address;
+                       const amount  : mutez)
+  : store * list (operation) is
+  var operations : list (operation) := nil
+  const s : list (int) = list [1; 2; 3]
+  const t : set (int) = set []
+  block {
+    if now > store.deadline then
+      fail "Deadline passed";
+    else
+      case store.backers[sender] of
+        None -> store.backers[sender] := Some (amount)
+//        None -> patch store.backers with map sender -> amount end
+      |    _ -> skip
+      end
+  } with (store, operations)
+
+entrypoint withdraw (storage store : store; const sender : address)
+  : store * list (operation) is
+  var operations : list (operation) := list end
+  begin
+//    if set ["a"; "b"] contains x then skip else skip;
+    if sender = owner then
+      if now (Unit) >= store.deadline then
+        if balance >= store.goal then {
+             store.funded := True;
+//           patch store with record funded = True end;
+             operations := list [Transfer (owner, balance)];
+        };
+        else fail "Below target"
+      else { fail "Too soon"; }
+    else skip
+  end with (store, operations)
+
+entrypoint claim (storage store : store; const sender : address)
+  : store * list (operation) is
+  var operations : list (operation) := list []
+  var amount : mutez := 0
+  begin
+    if now <= store.deadline then
+      fail "Too soon"
+    else
+      case store.backers[sender] of
+        None ->
+          fail "Not a backer"
+      | Some (amount) ->
+          if balance >= store.goal or store.funded then
+            fail "Cannot refund"
+          else
+            begin
+              operations := list [Transfer (sender, amount)];
+              remove sender from map store.backers
+            end
+      end
+  end with (store, operations)

src/ligo/ligo-parser/Typecheck2.ml

@@ -0,0 +1,276 @@
+(*
+[@@@warning "-27"] (* TODO *)
+[@@@warning "-32"] (* TODO *)
+[@@@warning "-30"]
+
+module SMap = Map.Make(String)
+
+module I = AST2.O
+
+module O = struct
+  type asttodo = [`TODO] (* occurrences of asttodo will point to some part of the original parser AST *)
+
+  type name_and_region = {name: string; orig: Region.t}
+  type type_name  = name_and_region
+  type var_name   = name_and_region
+  type field_name = name_and_region
+
+  type pattern =
+    PVar    of var_name
+  | PWild
+  | PInt    of Z.t
+  | PBytes  of Hex.t
+  | PString of string
+  | PUnit
+  | PFalse
+  | PTrue
+  | PNone
+  | PSome   of pattern
+  | PCons   of pattern * pattern
+  | PNull
+  | PRecord of (field_name * pattern) SMap.t
+
+  type type_constructor =
+    Option
+  | List
+  | Set
+  | Map
+
+  type type_expr_case =
+    Sum      of (type_name * type_expr) SMap.t
+  | Record   of (field_name * type_expr) SMap.t
+  | TypeApp  of type_constructor * (type_expr list)
+  | Function of { arg: type_expr; ret: type_expr }
+  | Ref      of type_expr
+  | String
+  | Bytes
+  | Int
+  | Unit
+  | Bool
+
+  and type_expr = { type_expr: type_expr_case; name: type_name option; orig: Region.t }
+
+  type typed_var = { name:var_name; ty:type_expr; orig: asttodo }
+
+  type type_decl = { name: type_name; ty:type_expr; orig: asttodo }
+
+  type expr_case =
+    App      of { operator: operator; arguments: expr list }
+  | Var      of typed_var
+  | Constant of constant
+  | Record   of (field_name * expr) list
+  | Lambda   of lambda
+
+  and expr = { expr: expr_case; ty:type_expr; orig: asttodo }
+
+  and decl = { var: typed_var; value: expr; orig: asttodo }
+
+  and lambda = {
+      parameter:    typed_var;
+      declarations: decl list;
+      instructions: instr list;
+      result:       expr;
+    }
+
+  and operator_case =
+    Function    of var_name
+  | Constructor of var_name
+  | UpdateField of field_name
+  | GetField    of field_name
+  | Or | And | Lt | Leq | Gt | Geq | Equal | Neq | Cat | Cons | Add | Sub | Mult | Div | Mod
+  | Neg | Not
+  | Set
+  | MapLookup
+
+  and operator = { operator: operator_case; ty:type_expr; orig: asttodo }
+
+  and constant =
+    Unit
+  | Int of Z.t | String of string | Bytes of Hex.t
+  | False | True
+  | Null
+  | EmptySet
+  | CNone
+
+  and instr =
+    Assignment    of { name: var_name; value: expr; orig: asttodo }
+  | While         of { condition: expr; body: instr list; orig: asttodo }
+  | ForCollection of { list: expr; var: var_name; body: instr list; orig: asttodo }
+  | Match         of { expr: expr; cases: (pattern * instr list) list; orig: asttodo }
+  | ProcedureCall of { expr: expr; orig: asttodo } (* expr returns unit, drop the result. Similar to OCaml's ";". *)
+  | Fail          of { expr: expr; orig: asttodo }
+
+  type ast = {
+      types           : type_decl list;
+      storage_decl    : typed_var;
+      declarations    : decl list;
+      orig            : AST.t
+    }
+end
+
+type te = O.type_expr list SMap.t
+type ve = O.type_expr list SMap.t
+type tve = te * ve
+
+let fold_map f a l =
+  let f (acc, l) elem =
+    let acc', elem' = f acc elem
+    in acc', (elem' :: l) in
+  let last_acc, last_l = List.fold_left f (a, []) l
+  in last_acc, List.rev last_l
+
+let map f l = List.rev (List.rev_map f l)
+
+let shadow (name : string) (typ : O.type_expr) (env : O.type_expr list SMap.t)
+    : O.type_expr list SMap.t =
+  SMap.update name (function None -> Some [typ] | Some tl -> Some (typ :: tl)) env
+
+let lookup (name : string) (env : O.type_expr list SMap.t) : O.type_expr =
+  match SMap.find name env with
+    latest :: shadowed -> latest
+  | []                 -> failwith "Unbound variable"
+
+let string_of_name ({name;_} : I.name_and_region) = name
+
+let a_name_and_region ({name; orig} : I.name_and_region) : O.name_and_region =
+  {name; orig}
+
+let a_type_constructor (tve : tve) : I.type_constructor -> O.type_constructor = function
+  Option -> Option
+| List   -> List
+| Set    -> Set
+| Map    -> Map
+
+let a_type_expr_case (tve : tve) : I.type_expr_case -> O.type_expr_case = function
+    Sum      lt         -> failwith "TODO"
+  | Record   lt         -> failwith "TODO"
+  | TypeApp  (tc, args) -> failwith "TODO"
+  | Function {arg;ret}  -> failwith "TODO"
+  | Ref      t          -> failwith "TODO"
+  | String              -> String
+  | Int                 -> Int
+  | Unit                -> Unit
+  | Bool                -> Bool
+
+let a_type_expr (tve : tve) ({type_expr;name;orig} : I.type_expr) : O.type_expr =
+  let type_expr = a_type_expr_case tve type_expr in
+  let name = match name with
+      None -> None
+     |Some name -> Some (a_name_and_region name)
+  in {type_expr;name;orig}
+
+let a_type (te,ve : tve) ({name;ty;orig} : I.type_decl) : tve * O.type_decl =
+  let ty = a_type_expr (te,ve) ty in
+  let tve = shadow (string_of_name name) ty te, ve in
+  let name = (a_name_and_region name) in
+  tve, {name; ty; orig}
+
+let a_types (tve : tve) (l : I.type_decl list) : tve * O.type_decl list =
+  fold_map a_type tve l
+
+let a_storage_decl : tve -> I.typed_var -> tve * O.typed_var =
+  failwith "TODO"
+
+let type_expr_case_equal (t1 : O.type_expr_case) (t2 : O.type_expr_case) : bool = match t1,t2 with
+    Sum      m1,                  Sum      m2                  -> failwith "TODO" (* of (O.name_and_region * O.type_expr) SMap.t *)
+  | Record   m1,                  Record   m2                  -> failwith "TODO" (* of (O.name_and_region * O.type_expr) SMap.t *)
+  | TypeApp  (tc1, args1),        TypeApp  (tc2, args2)        -> failwith "TODO" (* of O.type_constructor * O.type_expr list *)
+  | Function {arg=arg1;ret=ret1}, Function {arg=arg2;ret=ret2} -> failwith "TODO" (* of { arg : O.type_expr; ret : O.type_expr; } *)
+  | Ref      t1,                  Ref      t2                  -> failwith "TODO" (* of O.type_expr *)
+  | String,                       String                       -> true
+  | Int,                          Int                          -> true
+  | Unit,                         Unit                         -> true
+  | Bool,                         Bool                         -> true
+  | _                                                          -> false
+
+let type_expr_equal (t1 : O.type_expr) (t2 : O.type_expr) : bool =
+  type_expr_case_equal t1.type_expr t2.type_expr
+
+let check_type_expr_equal (expected : O.type_expr) (actual : O.type_expr) : unit =
+  if type_expr_equal expected actual then
+    ()
+  else
+    failwith "got [actual] but expected [expected]"
+
+let a_var_expr (te,ve : tve) (expected : O.type_expr) (var_name : I.name_and_region) : O.expr_case =
+  check_type_expr_equal expected (lookup (string_of_name var_name) ve);
+  Var { name = a_name_and_region var_name;
+        ty   = expected;
+        orig = `TODO }
+
+let a_constant_expr (tve : tve) (expected : O.type_expr) (constant : I.constant) : O.expr_case =
+  let to_type_expr type_expr_case : O.type_expr =
+    { type_expr = type_expr_case; name = None; orig = Region.ghost } in
+  let actual : O.type_expr = match constant with
+      Unit       -> to_type_expr Unit
+    | Int      _ -> to_type_expr Int
+    | String   _ -> to_type_expr String
+    | Bytes    _ -> to_type_expr Bytes
+    | False      -> to_type_expr Bool
+    | True       -> to_type_expr Bool
+    | Null     t -> a_type_expr tve t
+    | EmptySet t -> a_type_expr tve t
+    | CNone    t -> a_type_expr tve t
+  in
+  check_type_expr_equal expected actual;
+  let c : O.constant = match constant with
+      Unit       -> Unit
+    | Int      i -> Int      i
+    | String   s -> String   s
+    | Bytes    b -> Bytes    b
+    | False      -> False
+    | True       -> True
+    | Null     _ -> Null
+    | EmptySet _ -> EmptySet
+    | CNone    _ -> CNone
+  in Constant c
+
+let map_to_list m =
+  List.rev (SMap.fold (fun field_name_string p l -> p :: l) m [])
+
+let a_field tve (expected,expr) =
+  failwith "TODO"
+
+let a_record (tve : tve) (expected : O.type_expr) (record : (I.field_name * I.expr) list)
+    : O.expr_case =
+  let {type_expr = expected; _} : O.type_expr = expected in
+  let expected = match expected with
+      Record fields -> fields
+    | _ -> failwith "expected some_type but got record" in
+  let expected_and_field =
+    List.combine
+      (map_to_list expected)
+      record (* TODO SHOULD BE (map_to_list record) *) in
+  Record (map (a_field tve) expected_and_field)
+
+let a_expr_case (te,ve : tve) (expected : O.type_expr) : I.expr -> O.expr_case = function
+    App      {operator;arguments} -> failwith "TODO"
+  | Var      var_name             -> a_var_expr      (te,ve) expected var_name
+  | Constant constant             -> a_constant_expr (te,ve) expected constant
+  | Record   record               -> a_record        (te,ve) expected record
+  | Lambda   lambda               -> failwith "TODO"
+
+let a_expr (te,ve : tve) (expected : O.type_expr) (e : I.expr) : O.expr =
+  let expr_case = a_expr_case (te,ve) expected e in
+  { expr = expr_case; ty = expected; orig = `TODO }
+
+let a_declaration (te,ve : tve) ({name;ty;value} : I.decl) : tve * O.decl =
+  let ty = a_type_expr (te,ve) ty in
+  let value = a_expr (te,ve) ty value in
+  let ve = shadow (string_of_name name) ty ve in
+  let name = a_name_and_region name in
+  (te,ve), {var={name;ty;orig=`TODO};value;orig = `TODO}
+
+let a_declarations (tve : tve) (l : I.decl list) : tve * O.decl list =
+  fold_map a_declaration tve l
+
+let a_ast I.{types; storage_decl; declarations; orig} =
+  let tve = SMap.empty, SMap.empty in
+  let tve, types = a_types tve types in
+  let tve, storage_decl = a_storage_decl tve storage_decl in
+  let tve, declarations = a_declarations tve declarations in
+  let _ = tve in
+  O.{types; storage_decl; declarations; orig}
+
+let annotate : I.ast -> O.ast = a_ast
+*)

src/ligo/ligo-parser/Typecheck2.mli

@@ -0,0 +1,110 @@
+(*
+[@@@warning "-30"]
+
+module SMap : Map.S with type key = string
+
+module I = AST2.O
+
+module O : sig
+  type asttodo = [`TODO] (* occurrences of asttodo will point to some part of the original parser AST *)
+
+  type name_and_region = {name: string; orig: Region.t}
+  type type_name  = name_and_region
+  type var_name   = name_and_region
+  type field_name = name_and_region
+
+  type pattern =
+    PVar    of var_name
+  | PWild
+  | PInt    of Z.t
+  | PBytes  of Hex.t
+  | PString of string
+  | PUnit
+  | PFalse
+  | PTrue
+  | PNone
+  | PSome   of pattern
+  | PCons   of pattern * pattern
+  | PNull
+  | PRecord of (field_name * pattern) SMap.t
+
+  type type_constructor =
+    Option
+  | List
+  | Set
+  | Map
+
+  type type_expr_case =
+    Sum      of (type_name * type_expr) SMap.t
+  | Record   of (field_name * type_expr) SMap.t
+  | TypeApp  of type_constructor * (type_expr list)
+  | Function of { arg: type_expr; ret: type_expr }
+  | Ref      of type_expr
+  | String
+  | Bytes
+  | Int
+  | Unit
+  | Bool
+
+  and type_expr = { type_expr: type_expr_case; name: type_name option; orig: Region.t }
+
+  type typed_var = { name:var_name; ty:type_expr; orig: asttodo }
+
+  type type_decl = { name:type_name; ty:type_expr; orig: asttodo }
+
+  type expr_case =
+    App      of { operator: operator; arguments: expr list }
+  | Var      of typed_var
+  | Constant of constant
+  | Record   of (field_name * expr) list
+  | Lambda   of lambda
+
+  and expr = { expr: expr_case; ty:type_expr; orig: asttodo }
+
+  and decl = { var: typed_var; value: expr; orig: asttodo }
+
+  and lambda = {
+      parameter:    typed_var;
+      declarations: decl list;
+      instructions: instr list;
+      result:       expr;
+    }
+
+  and operator_case =
+    Function    of var_name
+  | Constructor of var_name
+  | UpdateField of field_name
+  | GetField    of field_name
+  | Or | And | Lt | Leq | Gt | Geq | Equal | Neq | Cat | Cons | Add | Sub | Mult | Div | Mod
+  | Neg | Not
+  | Set
+  | MapLookup
+
+  and operator = { operator: operator_case; ty:type_expr; orig: asttodo }
+
+  and constant =
+    Unit
+  | Int of Z.t | String of string | Bytes of Hex.t
+  | False | True
+  | Null
+  | EmptySet
+  | CNone
+
+  and instr =
+    Assignment    of { name: var_name; value: expr; orig: asttodo }
+  | While         of { condition: expr; body: instr list; orig: asttodo }
+  | ForCollection of { list: expr; var: var_name; body: instr list; orig: asttodo }
+  | Match         of { expr: expr; cases: (pattern * instr list) list; orig: asttodo }
+  | ProcedureCall of { expr: expr; orig: asttodo } (* expr returns unit, drop the result. Similar to OCaml's ";". *)
+  | Fail          of { expr: expr; orig: asttodo }
+
+  type ast = {
+      types           : type_decl list;
+      storage_decl    : typed_var;
+      declarations    : decl list;
+      orig            : AST.t
+    }
+end
+
+val annotate : I.ast -> O.ast
+*)

src/ligo/ligo-parser/ligo_parser.ml

@@ -1,3 +0,0 @@
-module Parser = Parser
-module Lexer = Lexer.Make(LexToken)
-module AST = AST