Interface for Ocaml code

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/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.mli

@@ -0,0 +1,82 @@
+open Trace
+open Ast_simplified
+
+module Raw = Parser.Pascaligo.AST
+module SMap = Map.String
+
+(*
+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 unsupported_cst_constr : Raw.pattern -> unit -> error
+  val unsupported_ass_None : Raw.wild -> unit -> error
+  val unsupported_entry_decl : 'a Raw.reg -> unit -> error
+  val unsupported_proc_decl : 'a Raw.reg -> unit -> error
+  *)
+  val bad_bytes : Location.t -> string -> unit -> error
+  (*
+  val unsupported_local_proc : Raw.wild -> unit -> error
+  val corner_case : loc:string -> string -> 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 unsupported_set_expr : Raw.expr -> unit -> error
+  *)
+  val unsupported_proc_calls : 'a Raw.reg -> unit -> error
+  (*
+  val unsupported_for_loops : Raw.wild -> unit -> error
+  val unsupported_deep_map_assign : 'a Raw.reg -> unit -> error
+  val unsupported_empty_record_patch : 'a Raw.reg -> unit -> error
+  val unsupported_map_patches : 'a Raw.reg -> unit -> error
+  val unsupported_set_patches : 'a Raw.reg -> unit -> error
+  val unsupported_deep_map_rm : 'a Raw.reg -> unit -> error
+  val unsupported_set_removal : 'a Raw.reg -> unit -> error
+  val unsupported_non_var_pattern : Raw.pattern -> unit -> error
+  val only_constructors : Raw.pattern -> unit -> error
+  val unsupported_tuple_pattern : Raw.pattern -> unit -> error
+  val unsupported_deep_Some_patterns : Raw.pattern -> unit -> error
+  val unsupported_deep_list_patterns : 'a Raw.reg -> unit -> error
+  val unsupported_sub_blocks : 'a Raw.reg -> unit -> error
+  val simplifying_instruction : Raw.instruction -> unit -> error
+  *)
+end
+
+(*
+val r_split : 'a Raw.reg -> 'a * Location.t
+val return : expr -> ( expr option -> expr result ) result
+val return_let_in : ?loc:Location.t -> string * type_expression option -> expr -> ( expr option -> expr result ) 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_logic_expression : Raw.logic_expr -> expression result
+val simpl_list_expression : Raw.list_expr -> expression result
+val simpl_set_expression : Raw.set_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_local_declaration : Raw.local_decl -> ( expr option -> expr result) result
+val simpl_data_declaration : Raw.data_decl -> ( expr option -> expr result ) result
+val simpl_param : Raw.param_decl -> (type_name * type_expression) result
+val simpl_fun_declaration : loc:Location.t -> Raw.fun_decl -> ((name * type_expression option) * expression) result
+val simpl_declaration : Raw.declaration -> declaration Location.wrap result
+val simpl_single_instruction : Raw.single_instr -> (expression option -> expression result) result
+val simpl_path : Raw.path -> string * Ast_simplified.access_path
+val simpl_cases : (Raw.pattern * 'a) list -> 'a matching result
+val simpl_instruction_block : Raw.instruction -> (expression option -> expression result) result
+val simpl_instruction : Raw.instruction -> (expression option -> expression result) result
+val simpl_statements : Raw.statements -> (expression option -> expression result) result
+val simpl_block : Raw.block -> (expression option -> expression result) result
+*)
+val simpl_program : Raw.ast -> program result

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

@@ -0,0 +1,44 @@
+open Types
+open Format
+
+(*
+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 type_expression : formatter -> type_expression -> unit
+*)
+
+val literal : formatter -> literal -> 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 : formatter -> access -> unit
+
+val access_path : formatter -> access_path -> unit
+*)
+
+val type_annotation : formatter -> type_expression option -> unit 
+val single_record_patch : formatter -> string * expr -> unit 
+
+val single_tuple_patch : formatter -> int * expr -> unit
+(*
+
+val matching_variant_case : (formatter -> 'a -> unit) -> formatter -> (constructor_name * name) * 'a -> unit
+
+val matching : (formatter -> 'a -> unit) -> formatter -> 'a matching -> unit
+*)
+
+(* Shows the type expected for the matched value *)
+val matching_type : formatter -> 'a matching -> unit
+
+(*
+val matching_variant_case_type : formatter -> ( ( constructor_name * name) * 'a) -> unit
+
+val declaration : formatter -> declaration -> unit
+
+*)
+val program : formatter -> program -> unit

src/stages/ast_simplified/combinators.mli

@@ -0,0 +1,124 @@
+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_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
+*)

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