Merge branch 'dev' of gitlab.com:ligolang/ligo into gardening/code-comments

scripts/ligo.sh

@@ -4,7 +4,7 @@ if test "x$PWD" = "x"; then
   echo "Cannot detect the current directory, the environment variable PWD is empty."
   exit 1
 else
-  docker run -it -v "$PWD":"$PWD" -w "$PWD" ligolang/ligo:next "$@"
+  docker run --rm -it -v "$PWD":"$PWD" -w "$PWD" ligolang/ligo:next "$@"
 fi
 # Do not remove the next line. It is used as an approximate witness that the download of this file was complete. This string should not appear anywhere else in the file.
 # END OF DOWNLOADED FILE

src/bin/cli.mli

@@ -0,0 +1,27 @@
+(*
+open Cmdliner
+
+val main : unit Term.t * Term.info
+
+val source : int -> string Term.t
+
+val entry_point : int -> string Term.t
+
+val expression : string  -> int -> string Term.t
+
+val syntax : string Term.t
+
+val amount : string Term.t
+
+val compile_file : unit Term.t * Term.info
+
+val compile_parameter : unit Term.t * Term.info
+
+val compile_storage : unit Term.t * Term.info
+
+val dry_run : unit Term.t * Term.info
+
+val run_function : unit Term.t * Term.info
+
+val evaluate_value : unit Term.t * Term.info
+*)

src/bin/cli_helpers.mli

@@ -0,0 +1,3 @@
+open Trace
+
+val toplevel : display_format : string -> string result -> unit

src/main/display.ml

@@ -62,7 +62,7 @@ let string_result_pp_hr = result_pp_hr (fun out s -> Format.fprintf out "%s" s)
 let result_pp_dev f out (r : _ result) =
   match r with
   | Ok (s , _) -> Format.fprintf out "%a" f s
-  | Error e -> Format.fprintf out "%a" (error_pp ~dev:false) (e ())
+  | Error e -> Format.fprintf out "%a" (error_pp ~dev:true) (e ())
 
 let string_result_pp_dev = result_pp_hr (fun out s -> Format.fprintf out "%s" s)
 

src/main/display.mli

@@ -0,0 +1,35 @@
+open Trace
+
+val error_pp : ?dev:bool -> Format.formatter -> error -> unit
+
+val result_pp_hr : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a Simple_utils.Trace.result -> unit
+
+val string_result_pp_hr : Format.formatter -> string Simple_utils.Trace.result -> unit
+
+
+val result_pp_dev : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a Simple_utils.Trace.result -> unit
+
+val string_result_pp_dev : Format.formatter -> string Simple_utils.Trace.result -> unit
+
+val json_pp : Format.formatter -> Simple_utils.Trace.J.t -> unit
+
+val string_result_pp_json : Format.formatter -> string result -> unit
+
+type display_format = [
+  | `Human_readable
+  | `Json
+  | `Dev
+]
+
+val display_format_of_string : string -> display_format
+
+val formatted_string_result_pp : display_format -> Format.formatter -> string Simple_utils.Trace.result -> unit
+
+type michelson_format = [
+  | `Michelson
+  | `Micheline
+]
+
+val michelson_format_of_string : string -> michelson_format Simple_utils.Trace.result
+
+val michelson_pp : michelson_format -> Format.formatter -> Tezos_utils.Michelson.michelson -> unit

src/passes/1-parser/camligo/generator.ml

@@ -1,8 +1,8 @@
 open Simple_utils
 
 type 'a name = {
-  content : 'a ;
   name : string ;
+  content : 'a ;
 }
 
 let make_name name content = { name ; content }
@@ -736,4 +736,3 @@ let () =
     Format.printf "%a@.%a\n" PP_helpers.comment "AST" Print_AST.language language
   )
   | _ -> exit 1
-

src/passes/1-parser/camligo/generator.mli

@@ -0,0 +1,275 @@
+open Simple_utils
+
+type 'a name = {
+  name : string ;
+  content : 'a ;
+}
+
+(*
+val make_name : string -> 'a -> 'a name
+val destruct : 'a name -> ( string * 'a )
+val get_name : 'a name -> string
+val get_content : 'a name -> 'a
+*)
+
+module Token = Lex.Token
+type token = Token.token
+
+module O : sig
+
+  type list_mode =
+    | Trail of token
+    | Trail_option of token
+    | Trail_force of token
+    | Trail_force_ne of token
+    | Lead of token
+    | Lead_ne of token
+    | Separated of token
+    | Separated_ne of token
+    | Separated_nene of token
+    | Naked
+    | Naked_ne
+
+  type 'a list_element = list_mode * 'a
+
+  type rhs_element = [
+    | `Named of string
+    | `Token of token
+    | `List of string list_element
+    | `Option of string
+  ]
+
+  type rhs = rhs_element list name
+  type rule = rhs list name
+
+  type manual_rule_content = {
+    menhir_codes : string list ;
+    ast_code : string ;
+  }
+  type manual_rule = manual_rule_content name
+
+  type singleton =
+    | Manual of manual_rule
+    | Generated of rule
+
+  type name_element = [
+    | `Named of string
+    | `Current
+    | `Lower
+  ]
+
+  type element = [
+    | `Named of string
+    | `Token of token
+    | `List of name_element list_element
+    | `Current
+    | `Lower
+  ]
+
+  type operator = element list
+  type n_operator = operator name
+
+  type n_operators = n_operator list
+  type level = n_operators name
+  type level_list = level list
+  type levels = level List.Ne.t
+
+  type hierarchy = {
+    prefix : string ;
+    levels : levels ;
+    auxiliary_rules : rule list ;
+  }
+  type n_hierarchy = hierarchy name
+  val make_hierarchy : string -> levels -> rule list -> hierarchy
+
+  type language = {
+    entry_point : string ;
+    singletons : singleton list ;
+    hierarchies : n_hierarchy list ;
+  }
+
+  val get_op : n_operator -> operator
+  (*
+  val manual_singleton : string -> string list -> string -> singleton
+  val rule_singleton : rule -> singleton
+  val language : string -> singleton list -> n_hierarchy list -> language
+  val name_hierarchy : string -> string -> n_operators list -> rule list -> n_hierarchy
+  *)
+
+end
+
+module Check : sig
+  open O
+
+  val well_formed : language -> unit
+  val associativity : language -> unit
+
+end
+
+
+(*
+val make_constructor : Format.formatter -> (string * string) -> unit
+val make_operator : Format.formatter -> (string * string) -> unit
+*)
+
+module Print_AST : sig
+  (*
+  open Format
+  val manual_rule : formatter -> O.manual_rule -> unit
+  val generated_rule : formatter -> O.rule -> unit
+  val singleton : formatter -> O.singleton -> unit
+  val singletons : formatter -> O.singleton list -> unit
+  val n_operator : string -> string -> formatter -> O.n_operator -> unit
+  val n_hierarchy : string -> formatter -> O.n_hierarchy -> unit
+  val n_hierarchies : bool -> formatter -> O.n_hierarchy list -> unit
+  val language : formatter -> O.language -> unit
+  *)
+end
+
+module Print_Grammar : sig
+  (*
+  open Format
+  val letters : string array
+  val manual_rule : formatter -> O.manual_rule -> unit
+  val generated_rule : formatter -> O.rule -> unit
+  val singleton : formatter -> O.singleton -> unit
+  val n_operator_rule : string -> string -> formatter -> O.n_operator -> unit
+  val n_operator_code : string -> formatter -> O.n_operator -> unit
+  val n_operator : string -> string -> string -> formatter -> O.n_operator -> unit 
+  val level : string -> string -> formatter -> O.level -> unit
+  val n_hierarchy : formatter -> O.n_hierarchy -> unit
+  val language : formatter -> O.language -> unit
+  *)
+end
+
+(*
+val infix : string -> [`Left | `Right] -> token -> O.n_operator
+(* Ocaml is bad *)
+val empty_infix : string -> [`Left | `Right] -> O.n_operator
+val paren : string -> string -> O.n_operator
+val expression_name : string
+val type_expression_name : string
+val restricted_type_expression_name : string
+val program_name : string
+val variable_name : string
+val pattern_name : string
+val constructor_name : string
+val int_name : string
+val tz_name : string
+val unit_name : string
+val string_name : string
+val variable : O.singleton
+val int : O.singleton
+val tz : O.singleton
+val unit : O.singleton
+val string : O.singleton
+val constructor : O.singleton
+*)
+
+module Pattern : sig
+  (*
+  val application : O.n_operator
+  val data_structure : O.n_operator
+  val record_element : O.rule
+  val record : O.n_operator
+  val pair : O.n_operator
+  val type_annotation : [> `Current | `Named of string | `Token of token ] list name
+  val variable : O.n_operator
+  val constructor : O.n_operator
+  val module_ident : O.n_operator
+  val unit : O.n_operator
+  val restricted_pattern_name : string
+  val restricted_pattern : O.n_hierarchy
+  val main : O.n_hierarchy
+  val singletons : O.singleton list
+  *)
+end
+
+module Expression : sig
+  (*
+  val application : O.n_operator
+  val type_annotation : [> `Current | `Named of string | `Token of token ] list name
+  val data_structure : O.n_operator
+  val fun_ : O.n_operator
+  val let_in : O.n_operator
+  val no_seq_name : string
+  val no_match_name : string
+  val record_element : O.rule
+  val record : O.n_operator
+  val ite : O.n_operator
+  val it : O.n_operator
+
+  (* let sequence = infix "sequence" `Left SEMICOLON *)
+  val sequence : [> `List of O.list_mode * [> `Lower ] ] list name
+  val match_clause : [> `Named of string | `Token of token ] list name list name
+  val match_with : [> `Current 
+    | `List of O.list_mode * [> `Named of string ] 
+    | `Token of token ] list name
+  val lt : O.n_operator
+  val le : O.n_operator
+  val gt : O.n_operator
+  val eq : O.n_operator
+  val neq : O.n_operator
+  val cons : O.n_operator
+  val addition : O.n_operator
+  val substraction : O.n_operator
+  val multiplication : O.n_operator
+  val division : O.n_operator
+  val arith_variable : O.n_operator
+  val int : O.n_operator
+  val tz : O.n_operator
+  val unit : O.n_operator
+  val string : O.n_operator
+  val constructor : O.n_operator
+  val module_ident : O.n_operator
+  *)
+  val access : O.n_operator
+  (*
+  val accessor : O.n_operator
+  val assignment : O.n_operator
+  val tuple : [> `List of O.list_mode * [> `Lower ] ] list name
+  val name : [> `Current | `Token of token ] list name
+  val main_hierarchy_name : string
+  val main_hierarchy : O.n_hierarchy
+  val no_sequence_expression : O.n_hierarchy
+  val no_match_expression : O.n_hierarchy
+  val expression : O.n_hierarchy
+  val singletons : O.singleton list
+  *)
+end
+
+module Type_expression : sig
+
+  (*
+  val record_element : O.rule
+  val record : O.n_operator
+  val application : O.n_operator
+  val tuple : [> `List of O.list_mode * [> `Lower ] ] list name
+  val type_variable : O.n_operator
+  val restricted_type_expression : O.n_hierarchy
+  val type_expression : O.n_hierarchy
+  val singletons : O.singleton list
+  *)
+
+end
+
+module Program : sig
+
+  (*
+  val statement_name : string
+  val program : O.rule
+  val param_name : string
+  val param : O.rule
+  val type_annotation_name : string
+  val type_annotation : O.rule
+  val let_content_name : string
+  val let_content : O.rule
+  val statement : O.rule
+  val singletons : O.singleton list
+  *)
+
+end
+
+(*
+val language : O.language
+*)

src/passes/1-parser/camligo/lex/generator.mli

@@ -0,0 +1,43 @@
+(*
+type pre_token = {
+  name : string ;
+  pattern : string ;
+}
+
+val make : string -> string -> pre_token
+
+val keyword : string -> pre_token
+val symbol : string -> string -> pre_token
+
+module Print_mly : sig
+(*
+  open Format
+  val token : formatter -> pre_token -> unit
+  val tokens : formatter -> pre_token list -> unit
+*)
+end
+
+module Print_mll : sig
+(*
+  open Format
+
+  val pre : string
+  val post : string
+
+  val token : formatter -> pre_token -> unit
+  val tokens : formatter -> pre_token list -> unit
+*)
+end
+
+module Print_ml : sig
+(*
+  open Format
+
+  val pre : string
+  val token : formatter -> pre_token -> unit
+  val tokens : formatter -> pre_token list -> unit
+*)
+end
+
+val tokens : pre_token list
+*)

src/passes/1-parser/camligo/location.mli

@@ -0,0 +1,20 @@
+(*
+type file_location = {
+  filename : string ;
+  start_line : int ;
+  start_column : int ;
+  end_line : int ;
+  end_column : int ;
+}
+
+type virtual_location = string
+
+type t =
+  | File of file_location
+  | Virtual of virtual_location
+
+val make : Lexing.position -> Lexing.position -> t
+
+val virtual_location : string -> t
+val dummy : string
+*)

src/passes/1-parser/camligo/user.mli

@@ -0,0 +1,3 @@
+open! Trace
+
+val parse_file : string -> Ast.entry_point result

src/passes/1-parser/ligodity/.Parser.mly.tag

@@ -1 +1 @@
---explain --external-tokens Token --base Parser ParToken.mly
+--explain --external-tokens LexToken --base Parser ParToken.mly

src/passes/1-parser/ligodity/.links

@@ -4,18 +4,17 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
-$HOME/git/ligo/src/parser/shared/Lexer.mli
-$HOME/git/ligo/src/parser/shared/Lexer.mll
-$HOME/git/ligo/src/parser/shared/Error.mli
-$HOME/git/ligo/src/parser/shared/EvalOpt.ml
-$HOME/git/ligo/src/parser/shared/EvalOpt.mli
-$HOME/git/ligo/src/parser/shared/FQueue.ml
-$HOME/git/ligo/src/parser/shared/FQueue.mli
-$HOME/git/ligo/src/parser/shared/LexerLog.mli
-$HOME/git/ligo/src/parser/shared/LexerLog.ml
-$HOME/git/ligo/src/parser/shared/Markup.ml
-$HOME/git/ligo/src/parser/shared/Markup.mli
-$HOME/git/ligo/src/parser/shared/Utils.mli
-$HOME/git/ligo/src/parser/shared/Utils.ml
-$HOME/git/ligo/src/parser/shared/Version.ml
+../shared/Lexer.mli
+../shared/Lexer.mll
+../shared/Error.mli
+../shared/EvalOpt.ml
+../shared/EvalOpt.mli
+../shared/FQueue.ml
+../shared/FQueue.mli
+../shared/LexerLog.mli
+../shared/LexerLog.ml
+../shared/Markup.ml
+../shared/Markup.mli
+../shared/Utils.mli
+../shared/Utils.ml
 Stubs/Simple_utils.ml

src/passes/1-parser/ligodity/LexerMain.ml

@@ -6,7 +6,7 @@ let () = Printexc.record_backtrace true
 
 (* Running the lexer on the source *)
 
-let options = EvalOpt.read "Ligodity" ".mligo"
+let options = EvalOpt.read "CameLIGO" ".mligo"
 
 open EvalOpt
 

src/passes/1-parser/ligodity/Parser.mly

@@ -49,7 +49,7 @@ par(X):
       rpar   = $3}
     in {region; value}
   }
-  
+
 brackets(X):
   LBRACKET X RBRACKET {
     let region = cover $1 $3
@@ -109,7 +109,7 @@ sepseq(item,sep):
 (* Non-empty comma-separated values (at least two values) *)
 
 tuple(item):
-  item COMMA nsepseq(item,COMMA) { 
+  item COMMA nsepseq(item,COMMA) {
     let h,t = $3 in $1,($2,h)::t
   }
 
@@ -117,7 +117,7 @@ tuple(item):
 
 list(item):
   LBRACKET sep_or_term_list(item,SEMI) RBRACKET {
-    let elements, terminator = $2 in 
+    let elements, terminator = $2 in
     { value =
       {
         opening    = LBracket $1;
@@ -136,7 +136,7 @@ list(item):
          terminator = None;
          closing    = RBracket $2
        };
-      region = cover $1 $2 
+      region = cover $1 $2
     }
   }
 
@@ -150,10 +150,10 @@ declarations:
 | declaration declarations { Utils.(nseq_foldl (swap nseq_cons) $2 $1)}
 
 declaration:
-  LetEntry entry_binding { 
+  LetEntry entry_binding {
     let start = $1 in
     let stop = expr_to_region $2.let_rhs in
-    let region = cover start stop in  
+    let region = cover start stop in
     LetEntry { value = ($1, $2); region}, []
   }
 | type_decl                                         { TypeDecl $1, [] }
@@ -162,7 +162,7 @@ declaration:
 (* Type declarations *)
 
 type_decl:
-  Type type_name EQ type_expr {  
+  Type type_name EQ type_expr {
     let region = cover $1 (type_expr_to_region $4) in
     let value = {
       kwd_type   = $1;
@@ -179,19 +179,19 @@ type_expr:
 | record_type                                            { TRecord $1 }
 
 cartesian:
-  nsepseq(fun_type, TIMES)                                       { 
+  nsepseq(fun_type, TIMES)                                       {
     let region = nsepseq_to_region type_expr_to_region $1
     in {region; value=$1}
   }
 
 fun_type:
-  core_type {      
-    $1 
+  core_type {
+    $1
   }
-| core_type ARROW fun_type { 
+| core_type ARROW fun_type {
     let region = cover (type_expr_to_region $1)
                        (type_expr_to_region $3)
-    in 
+    in
     TFun {region; value = ($1, $2, $3)}
   }
 
@@ -202,16 +202,16 @@ core_type:
 | module_name DOT type_name {
     let module_name = $1.value in
     let type_name = $3.value in
-    let value = module_name ^ "." ^ type_name in 
+    let value = module_name ^ "." ^ type_name in
     let region = cover $1.region $3.region
-    in 
+    in
     TAlias {region; value}
   }
 | core_type type_constr {
     let arg_val = $1 in
     let constr = $2 in
-    let start = type_expr_to_region $1 in 
-    let stop = $2.region in 
+    let start = type_expr_to_region $1 in
+    let stop = $2.region in
     let region = cover start stop in
     let lpar, rpar = ghost, ghost in
     let value = {lpar; inside=arg_val,[]; rpar} in
@@ -219,12 +219,12 @@ core_type:
     TApp Region.{value = constr, arg; region}
   }
   | type_tuple type_constr {
-    let total = cover $1.region $2.region in    
+    let total = cover $1.region $2.region in
     TApp {region=total; value = $2, $1 }
-} 
+}
   | par(cartesian) {
       let Region.{value={inside=prod; _}; _} = $1 in
-      TPar {$1 with value={$1.value with inside = TProd prod}} }  
+      TPar {$1 with value={$1.value with inside = TProd prod}} }
 
 type_constr:
   type_name { $1                               }
@@ -233,7 +233,7 @@ type_tuple:
   par(tuple(type_expr)) { $1 }
 
 sum_type:
-  ioption(VBAR) nsepseq(variant,VBAR) { 
+  ioption(VBAR) nsepseq(variant,VBAR) {
     let region = nsepseq_to_region (fun x -> x.region) $2
     in {region; value = $2}
   }
@@ -256,7 +256,7 @@ record_type:
      elements = Some elements;
      terminator;
      closing = RBrace $3}
-   in {region; value}  
+   in {region; value}
   }
 
 field_decl:
@@ -264,7 +264,7 @@ field_decl:
     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}
   }
 
 (* Entry points *)
@@ -284,7 +284,7 @@ entry_binding:
 
 let_declaration:
   Let let_binding {
-    let kwd_let = $1 in 
+    let kwd_let = $1 in
     let binding, region = $2 in
     {value = kwd_let, binding; region}
   }
@@ -299,10 +299,10 @@ let_binding:
     let region = cover start stop in
     ({bindings= (ident_pattern :: hd :: tl); lhs_type=$3; eq=$4; let_rhs}, region)
   }
-| irrefutable type_annotation? EQ expr {  
+| irrefutable type_annotation? EQ expr {
     let pattern = $1 in
     let start = pattern_to_region $1 in
-    let stop = expr_to_region $4 in  
+    let stop = expr_to_region $4 in
     let region = cover start stop in
     ({bindings = [pattern]; lhs_type=$2; eq=$3; let_rhs=$4}, region)
   }
@@ -313,11 +313,11 @@ type_annotation:
 (* Patterns *)
 
 irrefutable:
-  tuple(sub_irrefutable) {  
-    let h, t = $1 in    
+  tuple(sub_irrefutable) {
+    let h, t = $1 in
     let start = pattern_to_region h in
     let stop = last (fun (region, _) -> region) t in
-    let region = cover start stop in    
+    let region = cover start stop in
     PTuple { value = $1; region }
   }
 | sub_irrefutable                                        {         $1 }
@@ -335,14 +335,14 @@ closed_irrefutable:
 | typed_pattern                                          {  PTyped $1 }
 
 typed_pattern:
-  irrefutable COLON type_expr  { 
-    let start = pattern_to_region $1 in 
+  irrefutable COLON type_expr  {
+    let start = pattern_to_region $1 in
     let stop = type_expr_to_region $3 in
     let region = cover start stop in
     {
       value = {
-        pattern = $1; 
-        colon = $2; 
+        pattern = $1;
+        colon = $2;
         type_expr = $3
       };
       region
@@ -350,18 +350,18 @@ typed_pattern:
   }
 
 pattern:
-  sub_pattern CONS tail { 
+  sub_pattern CONS tail {
     let start = pattern_to_region $1 in
-    let stop = pattern_to_region $3 in 
+    let stop = pattern_to_region $3 in
     let region = cover start stop in
     let val_ = {value = $1, $2, $3; region} in
-    PList (PCons val_) 
+    PList (PCons val_)
   }
-| tuple(sub_pattern) { 
-    let h, t = $1 in    
+| tuple(sub_pattern) {
+    let h, t = $1 in
     let start = pattern_to_region h in
     let stop = last (fun (region, _) -> region) t in
-    let region = cover start stop in    
+    let region = cover start stop in
     PTuple { value = $1; region }
   }
 | core_pattern                                            {        $1 }
@@ -379,7 +379,7 @@ core_pattern:
 | False                                                  {  PFalse $1 }
 | Str                                                    { PString $1 }
 | par(ptuple)                                            {    PPar $1 }
-| list(tail)                                       { PList (Sugar $1) } 
+| list(tail)                                       { PList (Sugar $1) }
 | constr_pattern                                         { PConstr $1 }
 | record_pattern                                         { PRecord $1 }
 
@@ -393,7 +393,7 @@ record_pattern:
       terminator;
       closing = RBrace $3}
     in
-    {region; value}  
+    {region; value}
   }
 
 field_pattern:
@@ -405,29 +405,29 @@ field_pattern:
   }
 
 constr_pattern:
-  Constr sub_pattern {  
+  Constr sub_pattern {
     let region = cover $1.region (pattern_to_region $2) in
     { value = $1, Some $2; region } }
 | Constr                                               {  { value = $1, None; region = $1.region }    }
 
 ptuple:
-  tuple(tail) {  
-    let h, t = $1 in    
+  tuple(tail) {
+    let h, t = $1 in
     let start = pattern_to_region h in
     let stop = last (fun (region, _) -> region) t in
-    let region = cover start stop in    
-    PTuple { value = $1; region } 
+    let region = cover start stop in
+    PTuple { value = $1; region }
   }
 
 unit:
-  LPAR RPAR { 
+  LPAR RPAR {
     let the_unit = ghost, ghost in
     let region = cover $1 $2 in
     { value = the_unit; region }
   }
 
 tail:
-  sub_pattern CONS tail { 
+  sub_pattern CONS tail {
     let start = pattern_to_region $1 in
     let end_ = pattern_to_region $3 in
     let region = cover start end_ in
@@ -456,11 +456,11 @@ base_expr(right_expr):
 | fun_expr(right_expr)
 | disj_expr_level                                         {        $1 }
 | tuple(disj_expr_level) {
-  let h, t = $1 in    
+  let h, t = $1 in
   let start = expr_to_region h in
   let stop = last (fun (region, _) -> region) t in
-  let region = cover start stop in    
-  ETuple { value = $1; region } 
+  let region = cover start stop in
+  ETuple { value = $1; region }
 }
 
 conditional(right_expr):
@@ -476,27 +476,27 @@ if_then(right_expr):
     let ifnot = EUnit {region=ghost; value=the_unit} in
     {
       value = {
-        kwd_if = $1; 
-        test = $2; 
-        kwd_then = $3; 
+        kwd_if = $1;
+        test = $2;
+        kwd_then = $3;
         ifso = $4;
-        kwd_else = ghost; 
+        kwd_else = ghost;
         ifnot
       };
-      region 
+      region
     }
   }
 
 if_then_else(right_expr):
   If expr Then closed_if Else right_expr {
     let region = cover $1 (expr_to_region $6) in
-    { 
+    {
       value = {
-        kwd_if = $1; 
-        test = $2; 
-        kwd_then = $3; 
+        kwd_if = $1;
+        test = $2;
+        kwd_then = $3;
         ifso = $4;
-        kwd_else = $5; 
+        kwd_else = $5;
         ifnot = $6
       };
       region
@@ -520,21 +520,21 @@ match_expr(right_expr):
     let start = $1 in
     let stop = match $5 with (* TODO: move to separate function *)
     | {region; _}, [] -> region
-    | _, tl -> last (fun (region,_) -> region) tl 
+    | _, tl -> last (fun (region,_) -> region) tl
     in
     let region = cover start stop in
     { value = {
-        kwd_match = $1; 
-        expr = $2; 
+        kwd_match = $1;
+        expr = $2;
         opening = With $3;
-        lead_vbar = $4; 
+        lead_vbar = $4;
         cases = {
-          value = cases; 
+          value = cases;
           region = nsepseq_to_region (fun {region; _} -> region) $5
         };
         closing = End ghost
-      }; 
-      region 
+      };
+      region
     }
   }
 | MatchNat expr With VBAR? cases(right_expr) {
@@ -544,27 +544,27 @@ match_expr(right_expr):
     let start = $1 in
     let stop = match $5 with (* TODO: move to separate function *)
     | {region; _}, [] -> region
-    | _, tl -> last (fun (region,_) -> region) tl 
+    | _, tl -> last (fun (region,_) -> region) tl
     in
     let region = cover start stop in
-    { 
+    {
       value = {
-        kwd_match = $1; 
-        expr = cast; 
+        kwd_match = $1;
+        expr = cast;
         opening = With $3;
-        lead_vbar = $4; 
+        lead_vbar = $4;
         cases = {
-          value = cases; 
+          value = cases;
           region = nsepseq_to_region (fun {region; _} -> region) $5
         };
         closing = End ghost
-      }; 
-      region 
+      };
+      region
     }
   }
 
 cases(right_expr):
-  case_clause(right_expr) { 
+  case_clause(right_expr) {
     let start = pattern_to_region $1.pattern in
     let stop = expr_to_region $1.rhs in
     let region = cover start stop in
@@ -573,25 +573,25 @@ cases(right_expr):
   | cases(base_cond) VBAR case_clause(right_expr) {
     let start = match $1 with
     | {region; _}, [] -> region
-    | _, tl -> last (fun (region,_) -> region) tl 
+    | _, tl -> last (fun (region,_) -> region) tl
     in
     let stop = expr_to_region $3.rhs in
     let region = cover start stop in
-    let h,t = $1 in { value = $3; region}, ($2, h)::t    
-  }  
+    let h,t = $1 in { value = $3; region}, ($2, h)::t
+  }
 
 case_clause(right_expr):
-  pattern ARROW right_expr {    
+  pattern ARROW right_expr {
     {
-      pattern = $1; 
-      arrow = $2; 
-      rhs=$3   
+      pattern = $1;
+      arrow = $2;
+      rhs=$3
     }
   }
 
 let_expr(right_expr):
   Let let_binding In right_expr {
-    let kwd_let = $1 in 
+    let kwd_let = $1 in
     let (binding, _) = $2 in
     let kwd_in = $3 in
     let body = $4 in
@@ -603,7 +603,7 @@ let_expr(right_expr):
 fun_expr(right_expr):
   Fun nseq(irrefutable) ARROW right_expr {
     let kwd_fun = $1 in
-    let bindings = $2 in 
+    let bindings = $2 in
     let arrow = $3  in
     let body = $4 in
     let stop = expr_to_region $4 in
@@ -624,7 +624,7 @@ disj_expr_level:
 | conj_expr_level                                                { $1 }
 
 bin_op(arg1,op,arg2):
-  arg1 op arg2                            { 
+  arg1 op arg2                            {
     let start  = expr_to_region $1 in
     let stop   = expr_to_region $3 in
     let region = cover start stop in
@@ -720,16 +720,16 @@ unary_expr_level:
     let start = $1 in
     let end_ = expr_to_region $2 in
     let region = cover start end_
-    and value  = {op = $1; arg = $2} 
-    in EArith (Neg {region; value})      
+    and value  = {op = $1; arg = $2}
+    in EArith (Neg {region; value})
 }
 | Not call_expr_level {
     let start = $1 in
     let end_ = expr_to_region $2 in
     let region = cover start end_
-    and value  = {op = $1; arg = $2} in 
+    and value  = {op = $1; arg = $2} in
     ELogic (BoolExpr (Not ({region; value})))
-}     
+}
 | call_expr_level                        {                         $1 }
 
 call_expr_level:
@@ -738,11 +738,11 @@ call_expr_level:
 | core_expr                                                      { $1 }
 
 constr_expr:
-  Constr core_expr? { 
+  Constr core_expr? {
     let start = $1.region in
-    let stop = match $2 with 
+    let stop = match $2 with
     | Some c -> expr_to_region c
-    | None -> start 
+    | None -> start
     in
     let region = cover start stop in
     { value = $1,$2; region}
@@ -751,7 +751,7 @@ constr_expr:
 call_expr:
   core_expr nseq(core_expr) {
     let start = expr_to_region $1 in
-    let stop = match $2 with 
+    let stop = match $2 with
     | e, [] -> expr_to_region e
     | _, l -> last expr_to_region l
     in
@@ -777,50 +777,49 @@ core_expr:
     EAnnot {$1 with value=$1.value.inside} }
 
 module_field:
-  module_name DOT field_name { 
+  module_name DOT field_name {
     let region = cover $1.region $3.region in
-    { value = $1.value ^ "." ^ $3.value; region } 
+    { value = $1.value ^ "." ^ $3.value; region }
   }
 
 projection:
   struct_name DOT nsepseq(selection,DOT) {
-    let start = $1.region in     
-    let stop = nsepseq_to_region (function 
-    | FieldName f -> f.region 
-    | Component c -> c.region) $3 
+    let start = $1.region in
+    let stop = nsepseq_to_region (function
+    | FieldName f -> f.region
+    | Component c -> c.region) $3
     in
     let region = cover start stop in
-    { value = 
+    { value =
       {
-        struct_name = $1; 
-        selector = $2; 
+        struct_name = $1;
+        selector = $2;
         field_path = $3
       };
       region
     }
   }
 | module_name DOT field_name DOT nsepseq(selection,DOT) {
-    let open Region in
     let module_name = $1 in
     let field_name = $3 in
     let value = module_name.value ^ "." ^ field_name.value in
     let struct_name = {$1 with value} in
     let start = $1.region in
-    let stop = nsepseq_to_region (function 
-    | FieldName f -> f.region 
+    let stop = nsepseq_to_region (function
+    | FieldName f -> f.region
     | Component c -> c.region) $5
-    in 
+    in
     let region = cover start stop in
-    { 
+    {
       value = {
-        struct_name; 
-        selector = $4; 
+        struct_name;
+        selector = $4;
         field_path = $5
       };
       region
     }
   }
-  
+
 selection:
   field_name    { FieldName $1 }
 | par(Int) { Component $1 }
@@ -829,36 +828,36 @@ record_expr:
   LBRACE sep_or_term_list(field_assignment,SEMI) RBRACE {
     let elements, terminator = $2 in
     let region = cover $1 $3 in
-    {value = 
+    {value =
       {
         opening = LBrace $1;
         elements = Some elements;
         terminator;
         closing = RBrace $3
-      }; 
+      };
     region}
   }
 
 field_assignment:
   field_name EQ expr {
-    let start = $1.region in 
-    let stop = expr_to_region $3 in 
+    let start = $1.region in
+    let stop = expr_to_region $3 in
     let region = cover start stop in
-    { value = 
+    { value =
       {
-        field_name = $1; 
-        assignment = $2; 
+        field_name = $1;
+        assignment = $2;
         field_expr = $3
       };
       region
-    } 
+    }
   }
 
 sequence:
   Begin sep_or_term_list(expr,SEMI) End {
     let elements, terminator = $2 in
-    let start = $1 in 
-    let stop = $3 in 
+    let start = $1 in
+    let stop = $3 in
     let region = cover start stop in
     {
       value = {
@@ -869,4 +868,4 @@ sequence:
       };
       region
     }
-  }
+  }

src/passes/1-parser/ligodity/ParserLog.ml

@@ -1,3 +1,5 @@
+[@@@warning "-42"]
+
 open AST
 open! Region
 
@@ -351,7 +353,6 @@ and print_fun_expr {value; _} =
   print_expr body
 
 and print_conditional {value; _} =
-   let open Region in
    let {kwd_if; test; kwd_then; ifso; kwd_else; ifnot} = value
    in print_token ghost "(";
    print_token kwd_if "if";

src/passes/1-parser/ligodity/ParserMain.ml

@@ -6,7 +6,7 @@ let () = Printexc.record_backtrace true
 
 (* Reading the command-line options *)
 
-let options = EvalOpt.read "Ligodity" ".mligo"
+let options = EvalOpt.read "CameLIGO" ".mligo"
 
 open EvalOpt
 

src/passes/1-parser/pascaligo/.links

@@ -4,17 +4,17 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
-$HOME/git/ligo/src/parser/shared/Lexer.mli
-$HOME/git/ligo/src/parser/shared/Lexer.mll
-$HOME/git/ligo/src/parser/shared/Error.mli
-$HOME/git/ligo/src/parser/shared/EvalOpt.ml
-$HOME/git/ligo/src/parser/shared/EvalOpt.mli
-$HOME/git/ligo/src/parser/shared/FQueue.ml
-$HOME/git/ligo/src/parser/shared/FQueue.mli
-$HOME/git/ligo/src/parser/shared/LexerLog.mli
-$HOME/git/ligo/src/parser/shared/LexerLog.ml
-$HOME/git/ligo/src/parser/shared/Markup.ml
-$HOME/git/ligo/src/parser/shared/Markup.mli
-$HOME/git/ligo/src/parser/shared/Utils.mli
-$HOME/git/ligo/src/parser/shared/Utils.ml
+../shared/Lexer.mli
+../shared/Lexer.mll
+../shared/Error.mli
+../shared/EvalOpt.ml
+../shared/EvalOpt.mli
+../shared/FQueue.ml
+../shared/FQueue.mli
+../shared/LexerLog.mli
+../shared/LexerLog.ml
+../shared/Markup.ml
+../shared/Markup.mli
+../shared/Utils.mli
+../shared/Utils.ml
 Stubs/Simple_utils.ml

src/passes/1-parser/pascaligo/AST.ml

@@ -406,9 +406,7 @@ and lhs =
   Path    of path
 | MapPath of map_lookup reg
 
-and rhs =
-      Expr of expr
-| NoneExpr of c_None
+and rhs = expr
 
 and loop =
   While of while_loop reg
@@ -758,9 +756,7 @@ let lhs_to_region : lhs -> Region.t = function
   Path path -> path_to_region path
 | MapPath {region; _} -> region
 
-let rhs_to_region = function
-      Expr e -> expr_to_region e
-| NoneExpr r -> r
+let rhs_to_region = expr_to_region
 
 let selection_to_region = function
   FieldName {region; _}

src/passes/1-parser/pascaligo/AST.mli

@@ -397,9 +397,7 @@ and lhs =
   Path    of path
 | MapPath of map_lookup reg
 
-and rhs =
-      Expr of expr
-| NoneExpr of c_None
+and rhs = expr
 
 and loop =
   While of while_loop reg

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

@@ -119,9 +119,9 @@ use the non-operation `skip`.
           end
       end with f
 
-  Like Pascal, PascaLIGO offers procedures, as well as functions. The
-difference follows the divide between expressions and instructions:
-function calls are expressions, procedure calls are instructions.
+<!--   Like Pascal, PascaLIGO offers procedures, as well as functions. The -->
+<!-- difference follows the divide between expressions and instructions: -->
+<!-- function calls are expressions, procedure calls are instructions. -->
 
   In order for a function to be a candidate to be an entrypoint to the
 contract, it needs to return a specific type: `list (operation) *
@@ -554,7 +554,7 @@ given the declarations (in verbose style)
 
 then the value of `r.f` is `4`.
 
-### Predefined functions, procedures and instructions
+### Predefined functions instructions
 
 Beyond a few operators, PascaLIGO features some predefined values and
 functions.
@@ -590,54 +590,54 @@ string: if `offset + length` is greater than the length of `string`,
 the result is `None`, otherwise `Some (substring)`. See section
 "Options".
 
-#### Lists
+<!-- #### Lists -->
 
-PascaLIGO offers two kinds of iterators on lists.
+<!-- PascaLIGO offers two kinds of iterators on lists. -->
 
-The first applies a given function to all the items of a given list,
-each call returning the predefined value `Unit`. If the function name
-is `f` and the list is `l`, this is expressed as
+<!-- The first applies a given function to all the items of a given list, -->
+<!-- each call returning the predefined value `Unit`. If the function name -->
+<!-- is `f` and the list is `l`, this is expressed as -->
 
-    list_iter (l, f);
+<!--     list_iter (l, f); -->
 
-Note: `list_iter` is a predefined _procedure_. Procedures are
-functions that return `Unit` and whose calls are instructions, not
-expressions. The same holds for the iterated function `f` here. See
-section "Declarations/Procedures".
+<!-- Note: `list_iter` is a predefined _procedure_. Procedures are -->
+<!-- functions that return `Unit` and whose calls are instructions, not -->
+<!-- expressions. The same holds for the iterated function `f` here. See -->
+<!-- section "Declarations/Procedures". -->
 
-For an iterator like `list_iter` to be useful, it needs to be able to
-perform a side effect, which user-defined procedures and functions
-cannot do. Like so:
+<!-- For an iterator like `list_iter` to be useful, it needs to be able to -->
+<!-- perform a side effect, which user-defined procedures and functions -->
+<!-- cannot do. Like so: -->
 
-    function iter (const delta : int; const l : list (int)) : int is
-      var acc : int := 0
-      procedure aggregate (const i : int) is
-        begin
-          acc := acc + i
-        end
-      begin
-        aggregate (delta);         // Has no effect on acc
-        list_iter (l, aggregate)   // Has an effect on acc
-      end with acc
+<!--     function iter (const delta : int; const l : list (int)) : int is -->
+<!--       var acc : int := 0 -->
+<!--       procedure aggregate (const i : int) is -->
+<!--         begin -->
+<!--           acc := acc + i -->
+<!--         end -->
+<!--       begin -->
+<!--         aggregate (delta);         // Has no effect on acc -->
+<!--         list_iter (l, aggregate)   // Has an effect on acc -->
+<!--       end with acc -->
 
-The other predefined iterator on lists is `list_map`. It is useful
-when we need to apply a function to all the items of a list and gather
-them into another list, in the same order as the original items. (In
-mathematical terms, `list_map` builds the list of the images through
-the function.) For instance, the function `iter`
+<!-- The other predefined iterator on lists is `list_map`. It is useful -->
+<!-- when we need to apply a function to all the items of a list and gather -->
+<!-- them into another list, in the same order as the original items. (In -->
+<!-- mathematical terms, `list_map` builds the list of the images through -->
+<!-- the function.) For instance, the function `iter` -->
 
-    function iter (const l : list (int)) : list (int) is
-      function incr (const i : int) : int is
-        begin
-          skip
-        end with i+1
-      begin
-        skip
-      end with list_map (l, incr)
+<!--     function iter (const l : list (int)) : list (int) is -->
+<!--       function incr (const i : int) : int is -->
+<!--         begin -->
+<!--           skip -->
+<!--         end with i+1 -->
+<!--       begin -->
+<!--         skip -->
+<!--       end with list_map (l, incr) -->
 
-will take a list of integers as a parameter and return a list with the
-integers all incremented, e.g., `iter (list [1;2;3])` evaluates in
-`list [2;3;4]`.
+<!-- will take a list of integers as a parameter and return a list with the -->
+<!-- integers all incremented, e.g., `iter (list [1;2;3])` evaluates in -->
+<!-- `list [2;3;4]`. -->
 
 ####  Sets
 
@@ -709,18 +709,13 @@ functions to update sets.
 
     has value `3`.
 
-
-  - The iterator `set_iter` is similar to `list_iter`: it takes a set
-    and a procedure (or function returning `Unit`) and applies it in
-    turn to all the elements of the set.
-
-  - Another form of complete iteration on sets is performed by
-    loops. See section "Loops".
+  - Complete iteration on sets is performed by loops. See section
+    "Loops".
 
 #### Maps
 
 Currently, maps have less support than sets. PascaLIGO offers the
-following functions and procedures on maps:
+following functions on maps:
 
   - Adding bindings to a map is only possible if the map is mutable,
     that is, if it was declared with the annotation `var`, like so, in
@@ -768,19 +763,8 @@ following functions and procedures on maps:
     where `sender` is a key and `backers` is a map. If the key is
     absent in the map, this instruction is a non-operation.
 
-  - The iterator `map_iter` is similar to `list_iter`: it takes a set
-    and a procedure (or function returning `Unit`) and applies it in
-    turn to all the bindings of the map. The type of the iterated
-    procedure/function is expected to be `key * value -> unit`.
-
-  - The iterator `map_map` is similar to `list_map`: it takes a map
-    and a function and builds a new map by applying the function to
-    all the bindings. In particular, this means that the expected
-    return type of the iterated function must be the type of the
-    values in the map.
-
-  - Another form of complete iteration on maps is performed by
-    loops. See section "Loops".
+  - Complete iteration on maps is performed by loops. See section
+    "Loops".
 
 #### Failures
 
@@ -800,17 +784,17 @@ can chose.
 ## Declarations
 
 There are several kinds of declarations: types, mutable variables,
-constants, functions, procedures, fields. Depending on the syntactic
-context, only some of those declarations will be allowed. Declarations
-may be separated by a semicolon. (Because each declaration starts with a
+constants, functions, fields. Depending on the syntactic context, only
+some of those declarations will be allowed. Declarations may be
+separated by a semicolon. (Because each declaration starts with a
 keyword they can be parsed without separators.)
 
 
 ### Types
 
 Type declarations are found only at top-level, that is, outside any
-function or procedure. They associate a type name to a type
-expression. The general syntax is
+function. They associate a type name to a type expression. The general
+syntax is
 
     type some_type_name is some_type_expression
 
@@ -959,27 +943,39 @@ is valid and changes the value of the mutable variable `counter` to be
 `3n`. This is the semantics found in all imperative languages.
 
 IMPORTANT: Mutable variables cannot be declared at top-level, but only
-in the scope of function and procedure bodies. This is to avoid global
-side effects that hide the control flow and makes static analysis
-extremely difficult.
+in the scope of function bodies. This is to avoid global side effects
+that hide the control flow and makes static analysis extremely
+difficult.
 
 ### Functions
 
-Function declarations can occur both at top-level and inside functions
-and procedures (in the tradition of Pascal). We saw an example
-earlier:
+Function declarations can occur both at top-level and inside
+functions, in the tradition of Pascal. For example,
 
-    function iter (const l : list (int)) : list (int) is
-      function incr (const i : int) : int is
+    function incr_list (const l : list (int)) : list (int) is
+      function incr_int (const i : int) : int is
         begin
           skip
         end with i+1
+        const item : int = 0
       begin
-        skip
-      end with list_map (l, incr)
+        var temp : list (int) := nil;
+        for item in l
+          begin
+            temp := incr_int (item) # temp
+          end;
+        var new_l : list (int) := nil;
+        for item in temp
+          begin
+            new_l := item # new_l
+          end
+      end with new_l
 
-Here, the function `incr` is declared inside the declaration of the
-function `iter`. The general shape of a function declaration is
+Here, the function `incr_int` is declared inside the declaration of
+the function `incr_list`, which take a list of integers and a list
+containing the same integers plus one.
+
+The general shape of a function declaration is
 
     function my_name ( ... (* parameters here *)) : return_type is
       ... // local declarations here
@@ -1042,7 +1038,7 @@ copies. Let us copy an example seen above:
 
     function iter (const delta : int; const l : list (int)) : int is
       var acc : int := 0
-      procedure aggregate (const i : int) is
+      function aggregate (const i : int) : unit is
         begin
           acc := acc + i // acc is part of the copied environment
         end
@@ -1058,41 +1054,41 @@ value in return.
 IMPORTANT: _Functions cannot be recursive in PascaLIGO_, that is why
 loops or iterators are needed.
 
-### Procedures
+<!-- ### Procedures -->
 
-WARNING: Procedures are not implemented in the current version of LIGO, they
-will appear in a future version with these semantics but cannot currently be
-used.
+<!-- WARNING: Procedures are not implemented in the current version of LIGO, they -->
+<!-- will appear in a future version with these semantics but cannot currently be -->
+<!-- used. -->
 
-Procedures are a special kind of functions that return `Unit`. They
-are declared as follows:
+<!-- Procedures are a special kind of functions that return `Unit`. They -->
+<!-- are declared as follows: -->
 
-    procedure my_name ( ... (* parameters here *)) is
-      ... // local declarations here
-      begin
-        ... // instructions here
-      end
+<!--     procedure my_name ( ... (* parameters here *)) is -->
+<!--       ... // local declarations here -->
+<!--       begin -->
+<!--         ... // instructions here -->
+<!--       end -->
 
-Since function calls (see section "Functions") leave the environment
-invariant, one may wonder what use there is to procedures. As we have
-seen in the section about "Lists" and their iterators, the exception
-to this rule are predefined iterators, like `list_iter`. They actually
-allow the iterated function to perform side effects. Here is the
-example again:
+<!-- Since function calls (see section "Functions") leave the environment -->
+<!-- invariant, one may wonder what use there is to procedures. As we have -->
+<!-- seen in the section about "Lists" and their iterators, the exception -->
+<!-- to this rule are predefined iterators, like `list_iter`. They actually -->
+<!-- allow the iterated function to perform side effects. Here is the -->
+<!-- example again: -->
 
-    function iter (const delta : int; const l : list (int)) : int is
-      var acc : int := 0
-      procedure aggregate (const i : int) is
-        begin
-          acc := acc + i
-        end
-      begin
-        aggregate (delta);         // Has no effect on acc
-        list_iter (l, aggregate)   // Has an effect on acc
-      end with acc
+<!--     function iter (const delta : int; const l : list (int)) : int is -->
+<!--       var acc : int := 0 -->
+<!--       procedure aggregate (const i : int) is -->
+<!--         begin -->
+<!--           acc := acc + i -->
+<!--         end -->
+<!--       begin -->
+<!--         aggregate (delta);         // Has no effect on acc -->
+<!--         list_iter (l, aggregate)   // Has an effect on acc -->
+<!--       end with acc -->
 
-(For the keen reader, this is because the iterated function is inlined
-by the compiler.)
+<!-- (For the keen reader, this is because the iterated function is inlined -->
+<!-- by the compiler.) -->
 
 ## Instructions
 
@@ -1154,7 +1150,7 @@ To iterate on a set `s`, we would write, for instance,
         ... // instructions
       end
 
-where `e` is bound in turn in increasing orde to each element of the
+where `e` is bound in turn in increasing order to each element of the
 set `s`. For example, given the declarations
 
     const s : set (int) = set 3; 1; 2 end
@@ -1329,7 +1325,7 @@ PascaLIGO has an explicit keyword for the non-operation: `skip`. Using
 
 - The `for` loop is not supported yet.
 
-- Procedures are not supported yet.
+<!-- - Procedures are not supported yet. -->
 
 - Nested code blocks are not supported yet.
 

src/passes/1-parser/pascaligo/LexToken.mli

@@ -72,6 +72,7 @@ type t =
 
 | And        of Region.t  (* "and"        *)
 | Begin      of Region.t  (* "begin"      *)
+| BigMap     of Region.t  (* "big_map"    *)
 | Block      of Region.t  (* "block"      *)
 | Case       of Region.t  (* "case"       *)
 | Const      of Region.t  (* "const"      *)
@@ -141,7 +142,7 @@ type int_err =
 
 type ident_err = Reserved_name
 
-type invalid_natural = 
+type invalid_natural =
   | Invalid_natural
   | Non_canonical_zero_nat
 

src/passes/1-parser/pascaligo/LexToken.mll

@@ -70,6 +70,7 @@ type t =
 
 | And        of Region.t  (* "and"        *)
 | Begin      of Region.t  (* "begin"      *)
+| BigMap     of Region.t  (* "big_map"    *)
 | Block      of Region.t  (* "block"      *)
 | Case       of Region.t  (* "case"       *)
 | Const      of Region.t  (* "const"      *)
@@ -201,6 +202,7 @@ let proj_token = function
 
 | And        region -> region, "And"
 | Begin      region -> region, "Begin"
+| BigMap     region -> region, "BigMap"
 | Block      region -> region, "Block"
 | Case       region -> region, "Case"
 | Const      region -> region, "Const"
@@ -293,6 +295,7 @@ let to_lexeme = function
 
 | And        _ -> "and"
 | Begin      _ -> "begin"
+| BigMap     _ -> "big_map"
 | Block      _ -> "block"
 | Case       _ -> "case"
 | Const      _ -> "const"
@@ -353,6 +356,7 @@ let to_region token = proj_token token |> fst
 let keywords = [
   (fun reg -> And        reg);
   (fun reg -> Begin      reg);
+  (fun reg -> BigMap     reg);
   (fun reg -> Block      reg);
   (fun reg -> Case       reg);
   (fun reg -> Const      reg);
@@ -476,14 +480,14 @@ let mk_int lexeme region =
   then Error Non_canonical_zero
   else Ok (Int Region.{region; value = lexeme, z})
 
-type invalid_natural = 
+type invalid_natural =
   | Invalid_natural
   | Non_canonical_zero_nat
 
 let mk_nat lexeme region =
-  match (String.index_opt lexeme 'n') with  
+  match (String.index_opt lexeme 'n') with
   | None -> Error Invalid_natural
-  | Some _ -> (  
+  | Some _ -> (
     let z =
       Str.(global_replace (regexp "_") "" lexeme) |>
       Str.(global_replace (regexp "n") "") |>
@@ -569,6 +573,7 @@ let is_ident = function
 let is_kwd = function
   And        _
 | Begin      _
+| BigMap     _
 | Block      _
 | Case       _
 | Const      _

src/passes/1-parser/pascaligo/ParToken.mly

@@ -46,6 +46,7 @@
 
 %token <Region.t> And         (* "and"        *)
 %token <Region.t> Begin       (* "begin"      *)
+%token <Region.t> BigMap      (* "big_map"    *)
 %token <Region.t> Block       (* "block"      *)
 %token <Region.t> Case        (* "case"       *)
 %token <Region.t> Const       (* "const"      *)

src/passes/1-parser/pascaligo/Parser.mly

@@ -168,6 +168,11 @@ core_type:
     let type_constr = {value="map"; region=$1}
     in TApp {region; value = type_constr, $2}
   }
+| BigMap type_tuple {
+    let region = cover $1 $2.region in
+    let type_constr = {value="big_map"; region=$1}
+    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
@@ -591,7 +596,7 @@ assignment:
     in {region; value}}
 
 rhs:
-  expr  { Expr $1 }
+  expr  { $1 }
 
 lhs:
   path       {    Path $1 }

src/passes/1-parser/pascaligo/ParserLog.ml

@@ -309,9 +309,7 @@ and print_assignment {value; _} =
   print_token assign ":=";
   print_rhs rhs
 
-and print_rhs = function
-      Expr e -> print_expr e
-| NoneExpr r -> print_token r "None"
+and print_rhs e = print_expr e
 
 and print_lhs = function
   Path path -> print_path path

src/passes/1-parser/pascaligo/ParserMain.ml

@@ -6,7 +6,7 @@ let () = Printexc.record_backtrace true
 
 (* Reading the command-line options *)
 
-let options = EvalOpt.read "Pascaligo" ".ligo"
+let options = EvalOpt.read "PascaLIGO" ".ligo"
 
 open EvalOpt
 

src/passes/1-parser/pascaligo/SParserMain.ml

@@ -8,7 +8,7 @@ let () = Printexc.record_backtrace true
 
 (* Reading the command-line options *)
 
-let options = EvalOpt.read ()
+let options = EvalOpt.read "PascaLIGO" ".ligo"
 
 open EvalOpt
 

src/passes/1-parser/shared/EvalOpt.ml

@@ -174,7 +174,7 @@ let check extension =
 
 let read language extension =
   try
-    Getopt.parse_cmdline (specs language extension) anonymous;    
+    Getopt.parse_cmdline (specs language extension) anonymous;
     (verb_str :=
        let apply e a =
          if a <> "" then Printf.sprintf "%s, %s" e a else e

src/passes/1-parser/shared/EvalOpt.mli

@@ -47,6 +47,9 @@ type options = {
   cmd     : command
 }
 
-(* Parsing the command-line options on stdin *)
+(* Parsing the command-line options on stdin.  The first parameter is
+   the name of the concrete syntax, e.g., "pascaligo", and the second
+   is the file extension, e.g., ".ligo".
+ *)
 
 val read : string -> string -> options

src/passes/2-simplify/ligodity.mli

@@ -0,0 +1,63 @@
+[@@@warning "-45"]
+
+open Trace
+
+open Ast_simplified
+
+module Raw = Parser.Ligodity.AST
+module SMap = Map.String
+module Option = Simple_utils.Option
+
+(*
+val nseq_to_list : 'a * 'a list -> 'a list 
+val npseq_to_list : 'a * ( 'b * 'a ) list -> 'a list 
+*)
+val npseq_to_nelist : 'a * ( 'b * 'c ) list -> 'a * 'c list 
+(*
+val pseq_to_list : ('a * ('b * 'a) list) option -> 'a list
+val get_value : 'a Raw.reg -> 'a
+*)
+
+module Errors : sig 
+  (*
+  val wrong_pattern : string -> Raw.pattern -> unit -> error
+  val multiple_patterns : string -> Raw.pattern list -> unit -> error
+  val unknown_predefined_type : string Raw.reg -> unit -> error
+  val unsupported_arith_op : Raw.expr -> unit -> error
+  val unsupported_string_catenation : Raw.expr -> unit -> error
+  val untyped_fun_param : 'a Raw.reg -> unit -> error
+  val unsupported_tuple_pattern : Raw.pattern -> unit -> error
+  val unsupported_cst_constr : Raw.pattern -> unit -> error
+  val unsupported_non_var_pattern : Raw.pattern -> unit -> error
+  val simplifying_expr : Raw.expr -> unit -> error
+  val only_constructors : Raw.pattern -> unit -> error
+  val unsupported_sugared_lists : Raw.wild -> unit -> error
+  val bad_set_definition : unit -> error
+  val bad_list_definition : unit -> error
+  val bad_map_definition : unit -> error
+  val corner_case : loc:string -> string -> unit -> error
+  *)
+end
+
+
+(*
+val r_split : 'a Raw.reg -> 'a * Location.t
+val pattern_to_var : Raw.pattern -> Raw.variable result
+val pattern_to_typed_var : Raw.pattern -> ( Raw.variable * Raw.type_expr option ) result
+val expr_to_typed_expr : Raw.expr -> ( Raw.expr * Raw.type_expr option ) result
+val patterns_to_var : Raw.pattern list -> Raw.variable result
+val simpl_type_expression : Raw.type_expr -> type_expression result
+val simpl_list_type_expression : Raw.type_expr list -> type_expression result
+*)
+val simpl_expression : Raw.expr -> expr result
+(*
+val simpl_fun : Raw.fun_expr Raw.reg -> expr result 
+val simpl_logic_expression : ?te_annot:type_expression -> Raw.logic_expr -> expr result
+val simpl_list_expression : Raw.list_expr -> expression result
+val simpl_binop : string -> Raw.wild Raw.bin_op Region.reg -> expression result 
+val simpl_unop : string -> Raw.wild Raw.un_op Region.reg -> expression result
+val simpl_tuple_expression : ?loc:Location.t -> Raw.expr list -> expression result
+val simpl_declaration : Raw.declaration -> declaration Location.wrap result
+val simpl_cases : (Raw.pattern * 'a) list -> 'a matching result
+*)
+val simpl_program : Raw.ast -> program result

src/passes/2-simplify/pascaligo.ml

@@ -25,13 +25,13 @@ module Errors = struct
     ] in
     error ~data title message
 
-  let unsupported_ass_None region =
-    let title () = "assignment of None" in
+  let bad_bytes loc str =
+    let title () = "bad bytes string" in
     let message () =
-      Format.asprintf "assignments of None are not supported yet" in
+      Format.asprintf "bytes string contained non-hexadecimal chars" in
     let data = [
-      ("none_expr",
-       fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
+      ("location", fun () -> Format.asprintf "%a" Location.pp loc) ;
+      ("bytes", fun () -> str) ;
     ] in
     error ~data title message
 
@@ -77,10 +77,10 @@ module Errors = struct
     ] in
     error ~data title message
 
-  let unsupported_string_catenation expr =
-    let title () = "string expressions" in
+  let unsupported_arith_op expr =
+    let title () = "arithmetic expressions" in
     let message () =
-      Format.asprintf "string concatenation is not supported yet" in
+      Format.asprintf "this arithmetic operator is not supported yet" in
     let expr_loc = Raw.expr_to_region expr in
     let data = [
       ("expr_loc",
@@ -88,6 +88,16 @@ module Errors = struct
     ] in
     error ~data title message
 
+  let unsupported_proc_calls call =
+    let title () = "procedure calls" in
+    let message () =
+      Format.asprintf "procedure calls are not supported yet" in
+    let data = [
+      ("call_loc",
+       fun () -> Format.asprintf "%a" Location.pp_lift @@ call.Region.region)
+    ] in
+    error ~data title message
+
   let unsupported_for_loops region =
     let title () = "bounded iterators" in
     let message () =
@@ -152,7 +162,8 @@ module Errors = struct
     ] in
     error ~data title message
 
-  let unsupported_set_removal remove =
+
+  (* let unsupported_set_removal remove =
     let title () = "set removals" in
     let message () =
       Format.asprintf "removal of elements in a set is not \
@@ -161,6 +172,16 @@ module Errors = struct
       ("removal_loc",
        fun () -> Format.asprintf "%a" Location.pp_lift @@ remove.Region.region)
     ] in
+    error ~data title message *)
+
+  let unsupported_deep_set_rm path = 
+    let title () = "set removals" in
+    let message () = 
+      Format.asprintf "removal of members from embedded sets is not supported yet" in
+    let data = [
+      ("path_loc",
+       fun () -> Format.asprintf "%a" Location.pp_lift @@ path.Region.region)
+      ] in
     error ~data title message
 
   let unsupported_non_var_pattern p =
@@ -456,8 +477,11 @@ let rec simpl_expression (t:Raw.expr) : expr result =
         String.(sub s 1 (length s - 2))
       in
       return @@ e_literal ~loc (Literal_string s')
-  | EString (Cat _) as e ->
-      fail @@ unsupported_string_catenation e
+  | EString (Cat bo) ->
+    let (bo , loc) = r_split bo in
+    let%bind sl = simpl_expression bo.arg1 in
+    let%bind sr = simpl_expression bo.arg2 in
+    return @@ e_string_cat ~loc sl sr
   | ELogic l -> simpl_logic_expression l
   | EList l -> simpl_list_expression l
   | ESet s -> simpl_set_expression s
@@ -758,10 +782,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
     )
   | Assign a -> (
       let (a , loc) = r_split a in
-      let%bind value_expr = match a.rhs with
-        | Expr e -> simpl_expression e
-        | NoneExpr reg -> fail @@ unsupported_ass_None reg
-      in
+      let%bind value_expr = simpl_expression a.rhs in
       match a.lhs with
         | Path path -> (
             let (name , path') = simpl_path path in
@@ -829,7 +850,15 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
       let expr = e_constant ~loc "MAP_REMOVE" [key' ; e_variable map] in
       return_statement @@ e_assign ~loc map [] expr
     )
-  | SetRemove r -> fail @@ unsupported_set_removal r
+  | SetRemove r -> (
+      let (set_rm, loc) = r_split r in
+      let%bind set = match set_rm.set with
+        | Name v -> ok v.value
+        | Path path -> fail @@ unsupported_deep_set_rm path in 
+      let%bind removed' = simpl_expression set_rm.element in
+      let expr = e_constant ~loc "SET_REMOVE" [removed' ; e_variable set] in
+      return_statement @@ e_assign ~loc set [] expr
+    )
 
 and simpl_path : Raw.path -> string * Ast_simplified.access_path = fun p ->
   match p with

src/passes/2-simplify/pascaligo.mli

@@ -1,14 +1,26 @@
 (** Converts PascaLIGO programs to the Simplified Abstract Syntax Tree. *)
 
+open Trace
 open Ast_simplified
 
 module Raw = Parser.Pascaligo.AST
 module SMap = Map.String
 
+module Errors : sig
+
+  val bad_bytes : Location.t -> string -> unit -> error
+
+  val unsupported_arith_op : Raw.expr -> unit -> error
+
+  val unsupported_proc_calls : 'a Raw.reg -> unit -> error
+
+end
+
+
 (** Convert a concrete PascaLIGO expression AST to the simplified expression AST 
     used by the compiler. *)
-val simpl_expression : Raw.expr -> expression Trace.result
+val simpl_expression : Raw.expr -> expr result
 
 (** Convert a concrete PascaLIGO program AST to the simplified program AST used 
     by the compiler. *)
-val simpl_program : Raw.ast -> program Trace.result
+val simpl_program : Raw.ast -> program result

src/passes/4-typer/typer.ml

@@ -726,7 +726,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
           fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae
       in
       bind_fold_list aux (typed_name.type_value , []) path in
-    let%bind expr' = type_expression e expr in
+    let%bind expr' = type_expression e ~tv_opt:assign_tv expr in
     let t_expr' = get_type_annotation expr' in
     let%bind () =
       trace_strong (type_error

src/passes/4-typer/typer.mli

@@ -0,0 +1,53 @@
+open Trace
+
+module I = Ast_simplified
+module O = Ast_typed
+
+module SMap = O.SMap
+module Environment = O.Environment
+
+type environment = Environment.t
+
+module Errors : sig
+  (*
+  val unbound_type_variable : environment -> string -> unit -> error
+  val unbound_variable : environment -> string -> Location.t -> unit -> error
+  val match_empty_variant : 'a I.matching -> Location.t -> unit -> error
+  val match_missing_case : 'a I.matching -> Location.t -> unit -> error
+  val match_redundant_case : 'a I.matching -> Location.t -> unit -> error
+  val unbound_constructor : environment -> string -> Location.t -> unit -> error
+  val unrecognized_constant : string -> Location.t -> unit -> error
+  *)
+  val wrong_arity : string -> int -> int -> Location.t -> unit -> error
+  (*
+  val match_tuple_wrong_arity : 'a list -> 'b list -> Location.t -> unit -> error
+
+  (* TODO: this should be a trace_info? *)
+  val program_error : I.program -> unit -> error
+  val constant_declaration_error : string -> I.expr -> O.type_value option -> unit -> error
+  val match_error : ?msg:string -> expected:'a I.matching -> actual:O.type_value -> Location.t -> unit -> error
+  val needs_annotation : I.expression -> string -> unit -> error
+  val type_error_approximate : ?msg:string -> expected:string -> actual:O.type_value -> expression:I.expression -> Location.t -> unit -> error
+  val type_error : ?msg:string -> expected:O.type_value -> actual:O.type_value -> expression:I.expression -> Location.t -> unit -> error
+  val bad_tuple_index : int -> I.expression -> O.type_value -> Location.t -> unit -> error
+  val bad_record_access : string -> I.expression -> O.type_value -> Location.t -> unit -> error
+  val not_supported_yet : string -> I.expression -> unit -> error
+  val not_supported_yet_untranspile : string -> O.expression -> unit -> error
+  val constant_error : Location.t -> O.type_value list -> O.type_value option -> unit -> error
+  *)
+end
+
+val type_program : I.program -> O.program result
+val type_declaration : environment -> I.declaration -> (environment * O.declaration option) result
+val type_match : (environment -> 'i -> 'o result) -> environment -> O.type_value -> 'i I.matching -> I.expression -> Location.t -> 'o O.matching result
+val evaluate_type : environment -> I.type_expression -> O.type_value result
+val type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.annotated_expression result
+val type_constant : string -> O.type_value list -> O.type_value option -> Location.t -> (string * O.type_value) result
+(*
+val untype_type_value : O.type_value -> (I.type_expression) result
+val untype_literal : O.literal -> I.literal result
+*)
+val untype_expression : O.annotated_expression -> I.expression result
+(*
+val untype_matching : ('o -> 'i result) -> 'o O.matching -> ('i I.matching) result
+*)

src/passes/6-transpiler/transpiler.mli

@@ -0,0 +1,59 @@
+open! Trace
+
+module AST = Ast_typed
+module Append_tree = Tree.Append
+open Mini_c
+
+val temp_unwrap_loc : 'a Location.wrap -> 'a
+(*
+val temp_unwrap_loc_list : AST.declaration Location.wrap list -> AST.declaration list
+val list_of_map : 'a AST.type_name_map -> 'a list
+val kv_list_of_map : 'a AST.type_name_map -> ( string * 'a ) list
+val map_of_kv_list : ( string * 'a ) list -> 'a AST.type_name_map
+*)
+
+module Errors : sig
+  (*
+  val corner_case : loc:string -> string -> unit -> error
+  val unrecognized_type_constant : string -> unit -> error
+  val row_loc : Location.t -> string * ( unit -> string )
+  val unsupported_pattern_matching : string -> Location.t -> unit -> error
+  val unsupported_iterator : Location.t -> unit -> error
+  *)
+  val not_functional_main : Location.t -> unit -> error
+  val missing_entry_point : string -> unit -> error
+  val wrong_mini_c_value : string -> value -> unit -> error
+  val bad_untranspile : string -> value -> unit -> error
+  val unknown_untranspile : string -> value -> unit -> error
+end
+
+(*
+val translate_type : AST.type_value -> type_value result
+val tuple_access_to_lr : type_value -> type_value list -> int -> (type_value * [`Left | `Right]) list result
+val record_access_to_lr : type_value -> type_value AST.type_name_map -> string -> (type_value * [`Left | `Right]) list result 
+val translate_literal : AST.literal -> value
+val transpile_environment_element_type : AST.environment_element -> type_value result
+val transpile_small_environment : AST.small_environment -> Environment.t result
+val transpile_environment : AST.full_environment -> Environment.t result
+val tree_of_sum : AST.type_value -> (type_name * AST.type_value) Append_tree.t result
+*)
+val transpile_annotated_expression : AST.annotated_expression -> expression result
+(*
+val transpile_lambda_deep : Mini_c.Environment.t -> AST.lambda -> Mini_c.expression result
+val transpile_lambda : Environment.t -> AST.lambda -> expression result
+val transpile_declaration : environment -> AST.declaration -> toplevel_statement result
+*)
+
+val transpile_program : AST.program -> program result
+val check_storage : anon_function -> 'a -> Location.t -> (anon_function * 'a) result
+(*
+val translate_main : AST.lambda -> Location.t ->( anon_function * ( type_value * type_value )) result 
+
+(* From an expression [expr], build the expression [fun () -> expr] *)
+val translate_entry : AST.program -> string -> ( anon_function * ( type_value * type_value )) result
+val functionalize : AST.annotated_expression -> AST.lambda * AST.type_value
+*)
+val extract_constructor : value -> ( string * AST.type_value ) Append_tree.t' -> (string * value * AST.type_value) result
+val extract_tuple : value -> AST.type_value Append_tree.t' -> (value * AST.type_value) list result
+val extract_record : value -> ( string * AST.type_value ) Append_tree.t' -> ( string * ( value * AST.type_value )) list result
+val untranspile : value -> AST.type_value -> AST.annotated_expression result

src/passes/8-compiler/compiler_environment.mli

@@ -0,0 +1,33 @@
+open Proto_alpha_utils
+open Trace
+open Mini_c
+open Michelson
+
+(*
+module Stack = Meta_michelson.Stack
+*)
+val empty: environment
+val get : environment -> string -> michelson result
+val set : environment -> string -> michelson result
+
+val pack_closure : environment -> selector -> michelson result
+val unpack_closure : environment -> michelson result
+
+(*
+val add : environment -> (string * type_value) -> michelson result
+val select : ?rev:bool -> ?keep:bool -> environment -> string list -> michelson result
+
+val select_env : environment -> environment -> michelson result
+
+val clear : environment -> (michelson * environment) result
+
+val pack : environment -> michelson result
+
+val unpack : environment -> michelson result
+
+val pack_select : environment -> string list -> michelson result
+
+val add_packed_anon : environment -> type_value -> michelson result
+
+val pop : environment -> environment result
+*)

src/passes/8-compiler/compiler_program.mli

@@ -0,0 +1,48 @@
+open Trace
+open Mini_c
+
+open Michelson
+open Memory_proto_alpha.Protocol.Script_ir_translator
+open Operators.Compiler
+
+(*
+module Contract_types = Meta_michelson.Types
+module Stack = Meta_michelson.Stack
+*)
+type compiled_program = {
+  input : ex_ty ;
+  output : ex_ty ;
+  body : michelson ;
+}
+
+val get_operator : string -> type_value -> expression list -> predicate result
+val translate_expression : expression -> environment -> michelson result
+val translate_function_body : anon_function -> environment_element list -> type_value -> michelson result
+val translate_value : value -> type_value -> michelson result 
+
+val translate_program : program -> string -> compiled_program result
+
+val translate_contract : anon_function -> (type_value * type_value ) -> michelson result
+
+val translate_entry : anon_function -> type_value * type_value -> compiled_program result
+
+(*
+
+open Operators.Compiler
+
+val get_predicate : string -> type_value -> expression list -> predicate result
+
+val translate_function : anon_function -> michelson result
+
+val translate_expression : ?push_var_name:string -> expression -> environment -> ( michelson * environment ) result
+
+val translate_quote_body : anon_function -> michelson result
+
+val get_main : program -> string -> anon_function result
+
+
+module Errors : sig
+  val corner_case : loc:string -> string -> unit -> error
+end
+
+*)

src/passes/8-compiler/compiler_type.mli

@@ -0,0 +1,95 @@
+open Trace
+open Mini_c.Types
+open Proto_alpha_utils.Memory_proto_alpha
+open Protocol
+open Script_ir_translator
+
+module O = Tezos_utils.Michelson
+(*
+module Contract_types = Meta_michelson.Types
+*)
+
+module Ty : sig
+
+  open Script_typed_ir
+  (*
+  open Script_int_repr
+  *)
+  (*
+  val nat_k : n num comparable_ty
+  val tez_k : Alpha_context.Tez.tez comparable_ty
+  val int_k : z num comparable_ty
+  val string_k : string comparable_ty
+  val address_k : Alpha_context.Contract.t comparable_ty
+  val timestamp_k : Alpha_context.Script_timestamp.t comparable_ty
+  val bytes_k : Tezos_protocol_environment_alpha__Environment.MBytes.t comparable_ty
+  (* val timestamp_k = Timestamp_key None *)
+*)
+(*
+  val unit : unit ty
+  val bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t ty
+  val nat : n num ty
+  val tez : Alpha_context.Tez.tez ty
+  val int : z num ty
+  *)
+  val big_map : 'a comparable_ty -> 'b ty -> ( 'a , 'b ) big_map ty
+  val signature : Alpha_context.signature ty
+  (*
+  val operation : Alpha_context.packed_internal_operation ty
+  val bool : bool ty
+  *)
+  val mutez : Alpha_context.Tez.tez ty
+  (*
+  val string : string ty
+  *)
+  val key : Alpha_context.public_key ty
+  (*
+  val list : 'a ty -> 'a list ty
+  val set : 'a comparable_ty -> 'a set ty
+  val address : Alpha_context.Contract.t ty
+  val option : 'a ty -> 'a option ty
+  val contract : 'a ty -> 'a typed_contract ty
+  val lambda : 'a ty -> 'b ty -> ( 'a , 'b ) lambda ty
+  val timestamp : Alpha_context.Script_timestamp.t ty
+  val map : 'a comparable_ty -> 'b ty -> ( 'a , 'b ) map ty
+  val pair : 'a ty -> 'b ty -> ('a , 'b ) pair ty
+  *)
+  val union : 'a ty -> 'b ty -> ( 'a , 'b ) union ty
+  (*
+  val not_comparable : string -> unit -> error
+  val not_compilable_type : string -> unit -> error
+
+  val comparable_type_base : type_base -> ex_comparable_ty result
+  val comparable_type : type_value -> ex_comparable_ty result
+  val base_type : type_base -> ex_ty result
+ *)
+  val type_ : type_value -> ex_ty result
+
+  val environment_representation : environment -> ex_ty result
+
+  val environment : environment -> ex_stack_ty result
+  (*
+  val not_comparable : string -> unit -> error
+  val not_compilable_type : string -> unit -> error
+
+  val comparable_type_base : type_base -> ex_comparable_ty result
+
+  val comparable_type : type_value -> ex_comparable_ty result
+
+  val base_type : type_base -> ex_ty result
+
+  *)
+end
+
+val type_ : type_value -> O.t result
+
+val environment_element : string * type_value -> (int, O.prim) Tezos_micheline.Micheline.node result
+
+val environment : ( 'a * type_value ) list -> O.t list result
+val lambda_closure : environment * type_value  * type_value -> (int, O.prim) Tezos_micheline.Micheline.node result
+
+val environment_closure : environment -> (int , O.prim ) Tezos_micheline.Micheline.node result
+(*
+val base_type : type_base -> O.michelson result
+
+*)

src/passes/8-compiler/uncompiler.mli

@@ -0,0 +1,6 @@
+open Mini_c.Types
+open Proto_alpha_utils.Memory_proto_alpha
+open X
+open Proto_alpha_utils.Trace
+
+val translate_value : ?bm_opt:value -> ex_typed_value -> value result

src/passes/operators/helpers.mli

@@ -0,0 +1,77 @@
+module Typer : sig
+  open Trace
+  open Ast_typed
+
+  module Errors : sig
+    val wrong_param_number : name -> int -> 'a list -> unit -> error
+    val error_uncomparable_types : type_value -> type_value -> unit -> error
+  end
+
+  type type_result = string * type_value
+  type typer' = type_value list -> type_value option -> type_result result
+  type typer = string * typer'
+
+  (*
+  val typer'_0 : name -> (type_value option -> type_value result) -> typer'
+  *)
+  val typer_0 : name -> ( type_value option -> type_value result ) -> typer
+  (*
+  val typer'_1 : name -> (type_value -> type_value result) -> typer'
+  *)
+  val typer_1 : name -> (type_value -> type_value result) -> typer
+  (*
+  val typer'_1_opt : name -> (type_value -> type_value option -> type_value result) -> typer'
+  *)
+  val typer_1_opt : name -> (type_value -> type_value option -> type_value result) -> typer
+  (*
+  val typer'_2 : name -> (type_value -> type_value -> type_value result) -> typer'
+  *)
+  val typer_2 : name -> (type_value -> type_value -> type_value result) -> typer
+  (*
+  val typer'_3 : name -> (type_value -> type_value -> type_value -> type_value result) -> typer'
+  *)
+  val typer_3 : name -> (type_value -> type_value -> type_value -> type_value result) -> typer
+  (*
+  val typer'_4 : name -> (type_value -> type_value -> type_value -> type_value -> type_value result) -> typer'
+  *)
+  val typer_4 : name -> (type_value -> type_value -> type_value -> type_value -> type_value result) -> typer
+  (*
+  val typer'_5 : name -> (type_value -> type_value -> type_value -> type_value -> type_value -> type_value result) -> typer'
+  *)
+  val typer_5 : name -> (type_value -> type_value -> type_value -> type_value -> type_value -> type_value result) -> typer
+  (*
+  val typer'_6 : name -> (type_value -> type_value -> type_value -> type_value -> type_value -> type_value -> type_value result) -> typer'
+  *)
+  val typer_6 : name -> (type_value -> type_value -> type_value -> type_value -> type_value -> type_value -> type_value result) -> typer
+
+  val constant : name -> type_value -> typer 
+
+  val eq_1 : type_value -> type_value -> bool
+  val eq_2 : ( type_value * type_value ) -> type_value -> bool
+  val assert_eq_1 : ?msg:string -> type_value -> type_value -> unit result
+
+  val comparator : name -> typer
+  val boolean_operator_2 : name -> typer
+
+end
+
+module Compiler : sig
+  open Tezos_utils.Michelson
+
+  type predicate =
+    | Constant of michelson
+    | Unary of michelson
+    | Binary of michelson
+    | Ternary of michelson
+    | Tetrary of michelson
+    | Pentary of michelson
+    | Hexary of michelson
+  val simple_constant : t -> predicate
+  val simple_unary : t -> predicate
+  val simple_binary : t -> predicate
+  val simple_ternary : t -> predicate
+  val simple_tetrary : t -> predicate
+  val simple_pentary : t -> predicate
+  val simple_hexary : t -> predicate
+
+end

src/passes/operators/operators.mli

@@ -0,0 +1,129 @@
+
+module Simplify : sig
+
+  module Pascaligo : sig
+    val constants : ( string * string ) list
+    val type_constants : ( string * string ) list
+  end
+
+  module Camligo : sig
+    val constants : ( string * string ) list
+    val type_constants : ( string * string ) list
+  end
+
+  module Ligodity : sig
+    val constants : ( string * string ) list
+    val type_constants : ( string * string ) list
+  end
+
+end
+
+module Typer : sig
+  open Helpers.Typer
+  open Ast_typed
+
+  (*
+  val none : typer
+  val set_empty : typer
+  val sub : typer
+  val some : typer
+  val map_remove : typer 
+  val map_add : typer 
+  val map_update : typer 
+  val map_mem : typer 
+  val map_find : typer 
+  *)
+  val map_find_opt : typer 
+  (*
+  val map_iter : typer 
+  val map_map : typer 
+  val map_fold : typer 
+  val big_map_remove : typer 
+  val big_map_add : typer 
+  val big_map_update : typer 
+  val big_map_mem : typer 
+  val big_map_find : typer 
+  val size : typer
+  val slice : typer
+  val failwith_ : typer
+  val get_force : typer
+  val int : typer 
+  val bytes_pack : typer
+  val bytes_unpack : typer
+  val hash256 : typer
+  val hash512 : typer
+  val blake2b : typer
+  val hash_key : typer
+  val check_signature : typer
+  val sender : typer
+  val source : typer
+  val unit : typer
+  val amount : typer
+  *)
+  val balance : typer
+  (*
+  val address : typer
+  val now : typer
+  val transaction : typer
+  *)
+  val originate : typer
+  (*
+  val get_contract : typer
+  *)
+  val set_delegate : typer
+  (*
+  val abs : typer
+  val neg : typer
+  val assertion : typer
+  val times : typer
+  val div : typer
+  val mod_ : typer
+  val add : typer
+  val set_mem : typer
+  val set_add : typer
+  val set_remove : typer
+  val set_iter : typer
+  val list_iter : typer
+  val list_map : typer
+  val not_ : typer
+  val or_ : typer
+  val xor : typer
+  val and_ : typer
+  *)
+  val lsl_ : typer
+  val lsr_ : typer
+  (*
+  val concat : typer
+  *)
+  val cons : typer
+  val constant_typers : typer' type_name_map
+
+end
+
+module Compiler : sig
+  (*
+  include Helpers.Compiler
+  *)
+  open Tezos_utils.Michelson
+
+  type predicate =
+    | Constant of michelson
+    | Unary of michelson
+    | Binary of michelson
+    | Ternary of michelson
+    | Tetrary of michelson
+    | Pentary of michelson
+    | Hexary of michelson
+  val operators : predicate Map.String.t
+  val simple_constant : t -> predicate
+  val simple_unary : t -> predicate
+  val simple_binary : t -> predicate
+  val simple_ternary : t -> predicate
+  val simple_tetrary : t -> predicate
+  val simple_pentary : t -> predicate
+  val simple_hexary : t -> predicate
+
+(*
+  val predicates : predicate Map.String.t
+*)
+end

src/rope/rope_test.mli

@@ -0,0 +1,19 @@
+module A = struct
+  (*
+  open Rope
+
+  val _ : unit
+  *)
+end
+
+module B = struct
+  (*
+  open Rope_top_level_open
+
+  (* type foo = S | NotCaptured *)
+  (* let d = NotCaptured *)
+  (* let s = NotCaptured *)
+
+  val _ : unit
+  *)
+end

src/stages/ast_simplified/PP.mli

@@ -1,33 +1,47 @@
 (** Pretty printer for the Simplified Abstract Syntax Tree *)
 
 open Types
+open Format
 
-val type_expression : Format.formatter -> type_expression -> unit
+(*
+val list_sep_d : (formatter -> 'a -> unit) -> formatter -> 'a list -> unit
 
-val literal : Format.formatter -> literal -> unit
+val smap_sep_d : (formatter -> 'a -> unit) -> formatter -> 'a Map.String.t -> unit
 
-val expression : Format.formatter -> expression -> unit
+val type_expression : formatter -> type_expression -> unit
+*)
 
-val option_type_name : Format.formatter -> string * type_expression option -> unit
+val literal : formatter -> literal -> unit
 
-val assoc_expression : Format.formatter -> (expr * expr) -> unit 
+val expression : formatter -> expression -> unit
+(*
+val option_type_name : formatter -> string * type_expression option -> unit
+val assoc_expression : formatter -> (expr * expr) -> unit
 
-val access : Format.formatter -> access -> unit
+val access : formatter -> access -> unit
 
-val access_path : Format.formatter -> access_path -> unit
+val access_path : formatter -> access_path -> unit
+*)
 
-val type_annotation : Format.formatter -> type_expression option -> unit
+val type_annotation : formatter -> type_expression option -> unit 
+val single_record_patch : formatter -> string * expr -> unit 
 
-val single_record_patch : Format.formatter -> string * expr -> unit
+val single_tuple_patch : formatter -> int * expr -> unit
+(*
 
-val single_tuple_patch : Format.formatter -> int * expr -> unit
+val matching_variant_case : (formatter -> 'a -> unit) -> formatter -> (constructor_name * name) * 'a -> unit
 
-(* Shows the type expected for the matched value *)
-val matching_type : Format.formatter -> 'a matching -> unit
+val matching : (formatter -> 'a -> unit) -> formatter -> 'a matching -> unit
+*)
 
-val matching_variant_case_type : Format.formatter -> (string * string) * 'a -> unit
+(** Shows the type expected for the matched value *)
+val matching_type : formatter -> 'a matching -> unit
 
-val declaration : Format.formatter -> declaration -> unit
+(*
+val matching_variant_case_type : formatter -> ( ( constructor_name * name) * 'a) -> unit
 
+val declaration : formatter -> declaration -> unit
+
+*)
 (** Pretty print a full program AST *)
-val program : Format.formatter -> program -> unit
+val program : formatter -> program -> unit

src/stages/ast_simplified/combinators.ml

@@ -73,6 +73,7 @@ let e_record ?loc map : expression = location_wrap ?loc @@ E_record map
 let e_tuple ?loc lst : expression = location_wrap ?loc @@ E_tuple lst
 let e_some ?loc s : expression = location_wrap ?loc @@ E_constant ("SOME", [s])
 let e_none ?loc () : expression = location_wrap ?loc @@ E_constant ("NONE", [])
+let e_string_cat ?loc sl sr : expression = location_wrap ?loc @@ E_constant ("CONCAT" , [sl ; sr ])
 let e_map_add ?loc k v old : expression = location_wrap ?loc @@ E_constant ("MAP_ADD" , [k ; v ; old])
 let e_map ?loc lst : expression = location_wrap ?loc @@ E_map lst
 let e_set ?loc lst : expression = location_wrap ?loc @@ E_set lst

src/stages/ast_simplified/combinators.mli

@@ -0,0 +1,125 @@
+open Types
+open Simple_utils.Trace
+(*
+module Option = Simple_utils.Option
+
+module SMap = Map.String
+
+module Errors : sig
+  val bad_kind : name -> Location.t -> unit -> error
+end
+*)
+val t_bool      : type_expression
+val t_string    : type_expression
+val t_bytes     : type_expression
+val t_int       : type_expression
+val t_operation : type_expression
+val t_nat       : type_expression
+val t_tez       : type_expression
+val t_unit      : type_expression
+val t_address   : type_expression
+(*
+val t_option    : type_expression -> type_expression
+*)
+val t_list      : type_expression -> type_expression
+val t_variable  : type_name -> type_expression
+(*
+val t_tuple     : type_expression list -> type_expression
+val t_record    : te_map -> type_expression
+*)
+val t_pair : ( type_expression * type_expression ) -> type_expression
+
+val t_record_ez : (string * type_expression) list -> type_expression
+
+val t_sum : te_map -> type_expression
+val ez_t_sum : ( string * type_expression ) list -> type_expression
+
+val t_function : type_expression -> type_expression -> type_expression
+val t_map : type_expression -> type_expression -> type_expression
+(*
+val t_set : type_expression -> type_expression
+
+val make_name : string -> name
+
+*)
+val e_var : ?loc:Location.t -> string -> expression
+val e_literal : ?loc:Location.t -> literal -> expression
+val e_unit : ?loc:Location.t -> unit -> expression
+val e_int : ?loc:Location.t -> int -> expression 
+val e_nat : ?loc:Location.t -> int -> expression
+val e_timestamp : ?loc:Location.t -> int -> expression
+val e_bool : ?loc:Location.t -> bool -> expression
+val e_string : ?loc:Location.t -> string -> expression
+val e_address : ?loc:Location.t -> string -> expression 
+val e_mutez : ?loc:Location.t -> int -> expression
+val e'_bytes : string -> expression' result
+val e_bytes : ?loc:Location.t -> string -> expression result
+val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
+(*
+val e_record  : ?loc:Location.t -> ( expr * expr ) list -> expression
+*)
+val e_tuple : ?loc:Location.t -> expression list -> expression
+val e_some : ?loc:Location.t -> expression -> expression
+val e_none : ?loc:Location.t -> unit -> expression
+val e_string_cat : ?loc:Location.t -> expression -> expression -> expression
+val e_map_add : ?loc:Location.t -> expression -> expression ->  expression -> expression
+val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression
+val e_set : ?loc:Location.t -> expression list -> expression
+val e_list : ?loc:Location.t -> expression list -> expression
+val e_pair : ?loc:Location.t -> expression -> expression -> expression
+val e_constructor : ?loc:Location.t -> name -> expression -> expression
+val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
+val e_matching_bool : ?loc:Location.t -> expression -> expression -> expression -> expression
+val e_accessor : ?loc:Location.t -> expression -> access_path -> expression
+val e_accessor_props : ?loc:Location.t -> expression -> name list -> expression
+val e_variable : ?loc:Location.t -> name -> expression
+val e_skip : ?loc:Location.t -> unit -> expression
+val e_loop : ?loc:Location.t -> expression -> expression -> expression
+val e_sequence : ?loc:Location.t -> expression -> expression -> expression
+val e_let_in : ?loc:Location.t -> ( name * type_expression option ) -> expression -> expression -> expression
+val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
+val e_application : ?loc:Location.t -> expression -> expression -> expression
+val e_binop : ?loc:Location.t -> name -> expression -> expression -> expression
+val e_constant : ?loc:Location.t -> name -> expression list -> expression
+val e_look_up : ?loc:Location.t -> expression -> expression -> expression
+val e_assign : ?loc:Location.t -> name -> access_path -> expression -> expression
+
+val make_option_typed : ?loc:Location.t -> expression -> type_expression option -> expression
+val ez_e_record : ?loc:Location.t -> ( string * expression ) list -> expression
+
+val e_typed_none : ?loc:Location.t -> type_expression -> expression
+
+val e_typed_list : ?loc:Location.t -> expression list -> type_expression -> expression
+
+val e_typed_map : ?loc:Location.t -> ( expression * expression ) list  -> type_expression -> type_expression -> expression
+val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list  -> type_expression -> type_expression -> expression
+
+val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression
+
+val e_lambda : ?loc:Location.t -> string -> type_expression option -> type_expression option -> expression -> expression
+val e_record : ?loc:Location.t -> expr_map -> expression
+
+val e_ez_record : ?loc:Location.t -> ( string * expr ) list -> expression
+(*
+val get_e_accessor : expression' -> ( expression * access_path ) result
+*)
+
+val assert_e_accessor : expression' -> unit result
+
+val get_access_record : access -> string result
+
+val get_e_pair : expression' -> ( expression * expression ) result
+
+val get_e_list : expression' -> ( expression list ) result
+val get_e_tuple : expression' -> ( expression list ) result
+(*
+val get_e_failwith : expression -> expression result 
+val is_e_failwith : expression -> bool
+*)
+val extract_pair : expression -> ( expression * expression ) result 
+
+val extract_list : expression -> (expression list) result
+
+val extract_record : expression -> (string * expression) list result
+
+val extract_map : expression -> (expression * expression) list result

src/stages/ast_simplified/misc.mli

@@ -0,0 +1,18 @@
+open Trace
+open Types
+(*
+
+module Errors : sig
+  val different_literals_because_different_types : name -> literal -> literal -> unit -> error
+
+  val different_literals : name -> literal -> literal -> unit -> error
+
+  val error_uncomparable_literals : name -> literal -> literal -> unit -> error
+end
+
+val assert_literal_eq : ( literal * literal ) -> unit result
+*)
+
+val assert_value_eq : ( expression * expression ) -> unit result
+
+val is_value_eq : ( expression * expression ) -> bool

src/stages/ast_typed/PP.mli

@@ -0,0 +1,33 @@
+open Types
+open Format
+
+val value : formatter -> annotated_expression -> unit
+
+val type_value : formatter -> type_value -> unit
+
+val single_record_patch : formatter -> ( string * ae ) -> unit
+
+val program : formatter -> program -> unit
+
+val expression : formatter -> expression -> unit
+
+val literal : formatter -> literal -> unit
+
+val annotated_expression : formatter -> annotated_expression -> unit
+
+(*
+val list_sep_d : ( formatter -> 'a -> unit ) -> formatter -> 'a list -> unit
+val smap_sep_d : ( formatter -> 'a -> unit ) -> formatter -> 'a Map.String.t -> unit
+
+val lambda : formatter -> lambda -> unit
+
+val assoc_annotated_expression : formatter -> (ae * ae) -> unit
+
+val matching_variant_case : ( formatter -> 'a  -> unit ) -> formatter -> ( constructor_name * name ) * 'a -> unit
+
+val matching : ( formatter -> 'a -> unit ) -> formatter -> 'a matching -> unit
+
+val pre_access : formatter -> access -> unit
+
+val declaration : formatter -> declaration -> unit
+*)

src/stages/ast_typed/combinators.mli

@@ -0,0 +1,152 @@
+open Trace
+open Types
+
+val make_n_e : name -> annotated_expression -> named_expression
+val make_n_t : name -> type_value -> named_type_value
+val make_t : type_value' -> S.type_expression option -> type_value
+val make_a_e : ?location:Location.t -> expression -> type_value -> full_environment -> annotated_expression
+
+val t_bool : ?s:S.type_expression -> unit -> type_value
+val t_string : ?s:S.type_expression -> unit -> type_value
+val t_bytes : ?s:S.type_expression -> unit -> type_value
+val t_key : ?s:S.type_expression -> unit -> type_value
+val t_key_hash : ?s:S.type_expression -> unit -> type_value
+val t_operation : ?s:S.type_expression -> unit -> type_value
+val t_timestamp : ?s:S.type_expression -> unit -> type_value
+val t_set : type_value -> ?s:S.type_expression -> unit -> type_value
+val t_contract : type_value -> ?s:S.type_expression -> unit -> type_value
+val t_int : ?s:S.type_expression -> unit -> type_value
+val t_nat : ?s:S.type_expression -> unit -> type_value
+val t_tez : ?s:S.type_expression -> unit -> type_value
+val t_address : ?s:S.type_expression -> unit -> type_value
+val t_unit : ?s:S.type_expression -> unit -> type_value
+val t_option : type_value -> ?s:S.type_expression -> unit -> type_value
+val t_pair : type_value -> type_value -> ?s:S.type_expression -> unit -> type_value
+val t_list  : type_value -> ?s:S.type_expression -> unit -> type_value
+val t_tuple : type_value list -> ?s:S.type_expression -> unit -> type_value
+val t_record : tv_map -> ?s:S.type_expression -> unit -> type_value
+val make_t_ez_record : (string * type_value) list -> type_value 
+(*
+val ez_t_record : ( string * type_value ) list -> ?s:S.type_expression -> unit -> type_value 
+*)
+
+val t_map : type_value -> type_value -> ?s:S.type_expression -> unit -> type_value
+val t_big_map : type_value -> type_value -> ?s:S.type_expression -> unit -> type_value
+val t_sum : tv_map -> ?s:S.type_expression -> unit -> type_value
+val make_t_ez_sum : ( string * type_value ) list -> type_value
+val t_function : type_value -> type_value -> ?s:S.type_expression -> unit -> type_value
+val t_shallow_closure : type_value -> type_value -> ?s:S.type_expression -> unit -> type_value
+val get_type_annotation : annotated_expression -> type_value
+val get_type' : type_value -> type_value'
+val get_environment : annotated_expression -> full_environment
+val get_expression : annotated_expression -> expression
+val get_lambda : expression -> lambda result
+val get_lambda_with_type : annotated_expression -> (lambda * ( tv * tv) ) result
+val get_t_bool : type_value -> unit result
+(*
+val get_t_int : type_value -> unit result
+val get_t_nat : type_value -> unit result
+val get_t_unit : type_value -> unit result
+val get_t_tez : type_value -> unit result
+val get_t_bytes : type_value -> unit result 
+val get_t_string : type_value -> unit result
+*)
+val get_t_contract : type_value -> type_value result
+val get_t_option : type_value -> type_value result
+val get_t_list : type_value -> type_value result 
+val get_t_set : type_value -> type_value result
+(*
+val get_t_key : type_value -> unit result
+val get_t_signature : type_value -> unit result
+val get_t_key_hash : type_value -> unit result
+*)
+val get_t_tuple : type_value -> type_value list result
+val get_t_pair : type_value -> ( type_value * type_value ) result
+val get_t_function : type_value -> ( type_value * type_value ) result
+val get_t_sum : type_value -> type_value SMap.t result
+val get_t_record : type_value -> type_value SMap.t result
+val get_t_map : type_value -> ( type_value * type_value ) result
+val get_t_big_map : type_value -> ( type_value * type_value ) result
+val get_t_map_key : type_value -> type_value result
+val get_t_map_value : type_value -> type_value result
+val get_t_big_map_key : type_value -> type_value result
+val get_t_big_map_value : type_value -> type_value result
+
+val assert_t_map : type_value -> unit result
+
+val is_t_map : type_value -> bool
+val is_t_big_map : type_value -> bool 
+
+val assert_t_tez : type_value -> unit result
+val assert_t_key : type_value -> unit result
+val assert_t_signature : type_value -> unit result
+val assert_t_key_hash : type_value -> unit result
+
+val assert_t_list : type_value -> unit result
+
+val is_t_list   : type_value -> bool
+val is_t_set    : type_value -> bool
+val is_t_nat    : type_value -> bool
+val is_t_string : type_value -> bool
+val is_t_bytes  : type_value -> bool
+val is_t_int    : type_value -> bool
+
+val assert_t_bytes : type_value -> unit result
+(*
+val assert_t_operation : type_value -> unit result
+*)
+val assert_t_list_operation : type_value -> unit result
+val assert_t_int : type_value -> unit result
+val assert_t_nat : type_value -> unit result
+val assert_t_bool : type_value -> unit result
+val assert_t_unit : type_value -> unit result
+(*
+val e_record : ae_map -> expression
+val ez_e_record : ( string * annotated_expression ) list -> expression
+
+val e_some : value -> expression
+val e_none : expression
+val e_map : ( value * value ) list -> expression
+val e_unit : expression
+val e_int : int -> expression
+val e_nat : int -> expression
+val e_tez : int -> expression
+val e_bool : bool -> expression
+val e_string : string -> expression
+*)
+val e_address : string -> expression
+val e_operation : Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation -> expression
+(*
+val e_lambda : lambda -> expression
+val e_pair : value -> value -> expression
+val e_application : value -> value -> expression
+val e_variable : name -> expression
+val e_list : value list -> expression
+val e_let_in : string -> value -> value -> expression
+*)
+
+val e_a_unit : full_environment -> annotated_expression
+val e_a_int : int -> full_environment -> annotated_expression
+val e_a_nat : int -> full_environment -> annotated_expression
+val e_a_mutez : int -> full_environment -> annotated_expression
+val e_a_bool : bool -> full_environment -> annotated_expression
+val e_a_string : string -> full_environment -> annotated_expression
+val e_a_address : string -> full_environment -> annotated_expression
+val e_a_pair : annotated_expression -> annotated_expression -> full_environment -> annotated_expression
+val e_a_some : annotated_expression -> full_environment -> annotated_expression
+val e_a_lambda : lambda -> tv -> tv -> full_environment -> annotated_expression
+val e_a_none : type_value -> full_environment -> annotated_expression
+val e_a_tuple : annotated_expression list -> full_environment -> annotated_expression
+val e_a_record : ae_map -> full_environment -> annotated_expression
+val e_a_application : annotated_expression -> annotated_expression -> full_environment -> annotated_expression
+val e_a_variable : name -> type_value -> full_environment -> annotated_expression
+val ez_e_a_record : ( name * annotated_expression ) list -> full_environment -> annotated_expression
+val e_a_map : ( annotated_expression * annotated_expression ) list -> type_value -> type_value -> full_environment -> annotated_expression
+val e_a_list : annotated_expression list -> type_value -> full_environment -> annotated_expression
+val e_a_let_in : name -> annotated_expression -> annotated_expression -> full_environment -> annotated_expression
+
+val get_a_int : annotated_expression -> int result
+val get_a_unit : annotated_expression -> unit result
+val get_a_bool : annotated_expression -> bool result
+val get_a_record_accessor : annotated_expression -> (annotated_expression * name) result
+val get_declaration_by_name : program -> string -> declaration result

src/stages/ast_typed/combinators_environment.mli

@@ -0,0 +1,22 @@
+open Types
+
+val make_a_e_empty : expression -> type_value -> annotated_expression
+
+val e_a_empty_unit : annotated_expression
+val e_a_empty_int : int -> annotated_expression
+val e_a_empty_nat : int -> annotated_expression
+val e_a_empty_mutez : int -> annotated_expression
+val e_a_empty_bool : bool -> annotated_expression
+val e_a_empty_string : string -> annotated_expression
+val e_a_empty_address : string -> annotated_expression
+val e_a_empty_pair : annotated_expression -> annotated_expression -> annotated_expression
+val e_a_empty_some : annotated_expression -> annotated_expression
+val e_a_empty_none : type_value -> annotated_expression
+val e_a_empty_tuple : annotated_expression list -> annotated_expression
+val e_a_empty_record : ae_map -> annotated_expression
+val e_a_empty_map : (annotated_expression * annotated_expression ) list -> type_value -> type_value -> annotated_expression
+val e_a_empty_list : annotated_expression list -> type_value -> annotated_expression
+val ez_e_a_empty_record : ( name * annotated_expression ) list -> annotated_expression
+val e_a_empty_lambda : lambda -> tv -> tv -> annotated_expression
+
+val env_sum_type : ?env:full_environment -> ?name:name -> (name * type_value) list ->  full_environment

src/stages/ast_typed/environment.mli

@@ -0,0 +1,62 @@
+open Types
+open Trace
+
+type t = full_environment
+type element = environment_element
+
+val get_trace : string -> t -> element result
+val empty : environment
+val full_empty : t
+val add : string -> element -> t -> t
+val add_ez_binder : string -> type_value -> t -> t
+val add_ez_declaration : string -> annotated_expression -> t -> t
+val add_ez_ae : string -> annotated_expression -> t -> t
+val add_type : string -> type_value -> t -> t
+val get_opt : string -> t -> element option
+val get_type_opt : string -> t -> type_value option
+val get_constructor : string -> t -> (type_value * type_value) option
+
+module Small : sig
+  type t = small_environment
+  val get_environment : t -> environment
+(*
+
+  val empty : t
+
+  val get_type_environment : t -> type_environment
+  val map_environment : ( environment -> environment ) -> t -> t
+  val map_type_environment : ( type_environment -> type_environment ) -> t -> t
+
+  val add : string -> element -> t -> t
+  val add_type : string -> type_value -> t -> t
+  val get_opt : string -> t -> element option
+  val get_type_opt : string -> t -> type_value option
+  *)
+end
+(*
+
+val make_element : type_value -> full_environment -> environment_element_definition -> element
+val make_element_binder : type_value -> full_environment -> element
+val make_element_declaration : full_environment -> annotated_expression -> element
+*)
+
+
+
+module PP : sig
+  open Format
+
+  val list_sep_scope : (formatter -> 'a -> unit) -> formatter -> 'a list -> unit
+  val full_environment : formatter -> full_environment -> unit 
+(*
+  val environment_element : formatter -> ( string * environment_element ) -> unit
+
+  val type_environment_element : formatter -> ( string * type_value ) -> unit
+
+  val environment : formatter -> environment -> unit
+
+  val type_environment : formatter -> type_environment -> unit
+
+  val small_environment : formatter -> small_environment -> unit
+
+  *)
+end

src/stages/ast_typed/misc.mli

@@ -0,0 +1,70 @@
+open Trace
+open Types
+
+val assert_value_eq : ( value * value ) -> unit result
+
+val assert_type_value_eq : ( type_value * type_value ) -> unit result
+
+val merge_annotation : type_value option -> type_value option -> error_thunk -> type_value result
+
+(* No information about what made it fail *)
+val type_value_eq : ( type_value * type_value ) -> bool
+
+module Free_variables : sig
+  type bindings = string list
+
+  val matching_expression : bindings -> matching_expr -> bindings
+  val lambda : bindings -> lambda -> bindings
+
+  val annotated_expression : bindings -> annotated_expression -> bindings 
+
+  val empty : bindings 
+  val singleton : string -> bindings 
+
+(*
+  val mem : string -> bindings -> bool
+  val union : bindings -> bindings -> bindings
+  val unions : bindings list -> bindings
+  val of_list : string list -> bindings
+
+  val expression : bindings -> expression -> bindings
+
+  val matching_variant_case : (bindings -> 'a -> bindings) -> bindings -> ((constructor_name * name) * 'a) -> bindings
+
+  val matching : (bindings -> 'a -> bindings) -> bindings -> 'a matching -> bindings
+
+  *)
+end
+
+module Errors : sig
+  (*
+  val different_kinds : type_value -> type_value -> unit -> error
+  val different_constants : string -> string -> unit -> error
+  val different_size_type : name -> type_value -> type_value -> unit -> error
+  val different_props_in_record : string -> string -> unit -> error
+  val different_size_constants : type_value -> type_value -> unit -> error
+  val different_size_tuples : type_value -> type_value -> unit -> error
+  val different_size_sums : type_value -> type_value -> unit -> error
+  val different_size_records : type_value -> type_value -> unit -> error
+  val different_types : name -> type_value -> type_value -> unit -> error
+  val different_literals : name -> literal -> literal -> unit -> error
+  val different_values : name -> value -> value -> unit -> error
+  val different_literals_because_different_types : name -> literal -> literal -> unit -> error
+  val different_values_because_different_types : name -> value -> value -> unit -> error
+  val error_uncomparable_literals : name -> literal -> literal -> unit -> error
+  val error_uncomparable_values : name -> value -> value -> unit -> error
+  val different_size_values : name -> value -> value -> unit -> error
+  val missing_key_in_record_value : string -> unit -> error
+  *)
+  val not_functional_main : Location.t -> unit -> error
+end
+
+
+
+
+(*
+val assert_literal_eq : ( literal * literal ) -> unit result
+*)
+
+val get_entry : program -> string -> annotated_expression result
+val program_environment : program -> full_environment

src/stages/ast_typed/misc_smart.mli

@@ -0,0 +1,25 @@
+open Trace
+open Types
+
+val program_to_main : program -> string -> lambda result
+
+module Captured_variables : sig
+
+  type bindings = string list
+  val matching : (bindings -> 'a -> bindings result) -> bindings -> 'a matching -> bindings result
+
+  val matching_expression : bindings -> matching_expr -> bindings result
+
+  val mem : string -> bindings -> bool
+(*
+  val singleton : string -> bindings
+  val union : bindings -> bindings -> bindings
+  val unions : bindings list -> bindings
+  val empty : bindings
+  val of_list : string list -> bindings
+
+  val annotated_expression : bindings -> annotated_expression -> bindings result
+  val matching_variant_case : (bindings -> 'a -> bindings result) -> bindings -> ((constructor_name * name) * 'a) -> bindings result
+
+*)
+end

src/stages/mini_c/PP.mli

@@ -0,0 +1,32 @@
+open Types
+open Format
+
+(*
+val list_sep_d : ( formatter -> 'a -> unit ) -> formatter -> 'a list -> unit
+val space_sep : formatter -> unit -> unit
+val lr : formatter -> [< `Left ] -> unit
+val type_base : formatter -> type_base -> unit 
+*)
+
+val type_ : formatter -> type_value -> unit
+val environment_element : formatter -> environment_element -> unit
+val environment : formatter -> environment -> unit
+val value : formatter -> value -> unit
+
+(*
+val value_assoc : formatter -> (value * value) -> unit
+*)
+val expression' : formatter -> expression' -> unit
+
+val expression : formatter -> expression -> unit
+val expression_with_type : formatter -> expression -> unit
+val function_ : formatter -> anon_function -> unit
+
+(*
+val assignment : formatter -> assignment -> unit
+*)
+val declaration : formatter -> assignment -> unit
+(*
+val tl_statement : formatter -> assignment * 'a -> unit
+*)
+val program : formatter -> program -> unit

src/stages/mini_c/combinators.mli

@@ -0,0 +1,85 @@
+open Trace
+open Types
+
+module Expression : sig
+  type t' = expression'
+  type t = expression
+
+  val get_content : t -> t' 
+  val get_type : t -> type_value 
+  (*
+  val is_toplevel : t -> bool 
+*)
+  val make : t' -> type_value -> t
+  val make_tpl : t' * type_value -> t
+
+  val pair : t -> t -> t'
+end
+
+val get_bool : value ->bool result
+val get_int : value -> int result
+val get_nat : value -> int result
+val get_mutez : value -> int result
+val get_timestamp : value -> int result
+val get_string : value -> string result
+val get_bytes : value -> bytes result
+val get_unit : value -> unit result
+val get_option : value -> value option result
+val get_map : value -> ( value * value ) list result
+val get_big_map : value -> ( value * value ) list result
+val get_list : value -> value list result
+val get_set : value -> value list result
+val get_function_with_ty : expression -> ( anon_function * ( type_value * type_value) ) result
+val get_function : expression -> value  result
+val get_t_function : type_value -> ( type_value * type_value ) result
+val get_t_closure : type_value -> ( environment * type_value * type_value ) result
+val get_t_option : type_value -> type_value result
+val get_pair : value -> ( value * value ) result
+val get_t_pair : type_value -> ( type_value * type_value ) result
+val get_t_or : type_value -> ( type_value * type_value ) result
+val get_t_map : type_value -> ( type_value * type_value ) result
+val get_t_big_map : type_value -> ( type_value * type_value ) result
+val get_t_list : type_value -> type_value result
+val get_t_set : type_value -> type_value result
+val get_left : value -> value result
+val get_right : value -> value result
+val get_or : value -> ( bool * value ) result
+(*
+val wrong_type : string -> type_value -> unit -> error
+*)
+val get_t_left : type_value -> type_value result
+val get_t_right : type_value -> type_value result
+val get_t_contract : type_value -> type_value result
+val get_t_operation : type_value -> unit result
+val get_operation : value -> Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation result
+
+val t_int : type_value 
+val t_unit : type_value 
+val t_nat : type_value 
+val t_function : type_value -> type_value -> type_value
+val t_deep_closure : environment -> type_value -> type_value -> type_value
+val t_pair : type_value annotated -> type_value annotated -> type_value
+val t_union : type_value annotated -> type_value annotated -> type_value
+(*
+val quote : string -> type_value -> type_value -> Expression.t -> anon_function
+
+
+val e_int : Expression.t' -> Expression.t
+*)
+val e_unit : Expression.t
+val e_skip : Expression.t
+val e_var_int : string -> Expression.t
+val e_let_in : string -> type_value -> Expression.t -> Expression.t -> Expression.t
+
+val ez_e_sequence : Expression.t' -> Expression.t -> expression
+(*
+val ez_e_return : Expression.t -> Expression.t
+*)
+val d_unit : value
+(*
+val basic_quote : type_value -> type_value -> Expression.t -> anon_function result
+*)
+val basic_int_quote : expression -> expression result
+
+val environment_wrap : environment -> environment -> environment_wrap
+val id_environment_wrap : environment -> environment_wrap

src/stages/mini_c/combinators_smart.mli

@@ -0,0 +1,3 @@
+open Types
+
+val basic_int_quote_env : environment

src/stages/mini_c/environment.mli

@@ -0,0 +1,58 @@
+(* open Trace *)
+open Types
+
+
+module Environment : sig
+
+  type element = environment_element
+  type t = environment
+
+  val empty : t
+  val add : element -> t -> t
+  val concat : t list -> t
+  (*
+  val get_opt : string -> t -> type_value option
+  val has : string -> t -> bool
+  *)
+  val get_i : string -> t -> (type_value * int)
+  val of_list : element list -> t
+  val to_list : t -> element list
+  val get_names : t -> string list
+  val remove : int -> t -> t
+  val select : ?rev:bool -> ?keep:bool -> string list -> t -> t
+  (*
+  val fold : ('a -> element -> 'a ) -> 'a -> t -> 'a
+  val filter : ( element -> bool ) -> t -> t
+  *)
+  (*
+  vatl closure_representation : t -> type_value
+  *)
+end
+
+type element = environment_element
+type t = environment
+
+val empty : t
+val add : element -> t -> t
+val concat : t list -> t
+(*
+val get_opt : string -> t -> type_value option
+*)
+val has : string -> t -> bool
+(*
+val get_i : string -> t -> (type_value * int)
+*)
+val of_list : element list -> t
+(*
+val to_list : t -> element list
+val get_names : t -> string list
+val remove : int -> t -> t
+
+*)
+val select : ?rev:bool -> ?keep:bool -> string list -> t -> t
+val fold : ('a -> element -> 'a ) -> 'a -> t -> 'a
+val filter : ( element -> bool ) -> t -> t
+
+(*
+val closure_representation : t -> type_value
+*)

src/test/contracts/option.ligo

@@ -4,3 +4,12 @@ type foobar is option(int)
 
 const s : foobar = Some(42)
 const n : foobar = None
+
+function assign (var m : int) : foobar is
+  var coco : foobar := None;
+  block
+{
+      coco := Some(m);
+      coco := None;
+}
+with coco

src/test/contracts/set_arithmetic.ligo

@@ -13,6 +13,10 @@ function add_op (const s : set(string)) : set(string) is
 function remove_op (const s : set(string)) : set(string) is
   begin skip end with set_remove("foobar" , s)
 
+// Test the PascaLIGO syntactic sugar for set removal vs. the function call
+function remove_syntax (var s : set(string)) : set(string) is
+  begin remove "foobar" from set s; end with s
+
 function mem_op (const s : set(string)) : bool is
   begin skip end with set_mem("foobar" , s)
 

src/test/contracts/string.ligo

@@ -1 +1,3 @@
 const s : string = "toto"
+const x : string =  s^"bar"
+const y : string =  "foo"^x

src/test/integration_tests.ml

@@ -241,6 +241,10 @@ let set_arithmetic () : unit result =
     expect_eq program "remove_op"
       (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
       (e_set [e_string "foo" ; e_string "bar"]) in
+  let%bind () =
+    expect_eq program "remove_syntax"
+      (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
+      (e_set [e_string "foo" ; e_string "bar"]) in
   let%bind () =
     expect_eq program "mem_op"
       (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
@@ -262,7 +266,8 @@ let unit_expression () : unit result =
 
 let string_expression () : unit result =
   let%bind program = type_file "./contracts/string.ligo" in
-  expect_eq_evaluate program "s" (e_string "toto")
+  let%bind _ = expect_eq_evaluate program "s" (e_string "toto") in
+  expect_eq_evaluate program "y" (e_string "foototobar")
 
 let include_ () : unit result =
   let%bind program = type_file "./contracts/includer.ligo" in
@@ -368,6 +373,10 @@ let option () : unit result =
     let expected = e_typed_none t_int in
     expect_eq_evaluate program "n" expected
   in
+  let%bind () =
+    let expected = e_typed_none t_int in
+    expect_eq program "assign" (e_int 12) expected
+  in
   ok ()
 
 let moption () : unit result =

vendors/rope/rope.mli

@@ -1,3 +1,4 @@
+(*
 module RopeImplementation = Rope_implementation
 type impl = RopeImplementation.t
 type 'a t =
@@ -16,3 +17,4 @@ val finish : impl -> impl
 val ( ~% ) : (((impl -> 'a) -> 'a) -> 'b) t -> 'b
 val ( % ) : 'a -> ('a -> 'b) t -> 'b
 val ( #% ) : ((impl -> impl) -> 'a -> 'b) -> 'a -> 'b
+*)

vendors/rope/rope_implementation.mli

@@ -1,4 +1,6 @@
+(*
 type t
 val of_string : string -> t
 val cat : t -> t -> t
 val to_string : t -> string
+*)

vendors/rope/rope_top_level_open.mli

@@ -1,3 +1,5 @@
+(*
 open Rope
 
 val ( #% ) : ((impl -> impl) -> 'a -> 'b) -> 'a -> 'b
+*)