balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Interface for Ocaml code

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2019-10-07 14:18:32 +00:00 committed by Christian Rinderknecht
parent 0c7bfbdecd
commit 59cb210b83
36 changed files with 1806 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/bin/cli.mli Normal file
View File

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

3
src/bin/cli_helpers.mli Normal file
View File

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

2
src/main/display.ml
View File

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

35
src/main/display.mli Normal file
View File

@ -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

3
src/passes/1-parser/camligo/generator.ml
View File

@ -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

275
src/passes/1-parser/camligo/generator.mli Normal file
View File

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

43
src/passes/1-parser/camligo/lex/generator.mli Normal file
View File

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

20
src/passes/1-parser/camligo/location.mli Normal file
View File

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

3
src/passes/1-parser/camligo/user.mli Normal file
View File

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

63
src/passes/2-simplify/ligodity.mli Normal file
View File

@ -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

82
src/passes/2-simplify/pascaligo.mli Normal file
View File

@ -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

53
src/passes/4-typer/typer.mli Normal file
View File

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

59
src/passes/6-transpiler/transpiler.mli Normal file
View File

@ -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

33
src/passes/8-compiler/compiler_environment.mli Normal file
View File

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

48
src/passes/8-compiler/compiler_program.mli Normal file
View File

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

95
src/passes/8-compiler/compiler_type.mli Normal file
View File

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

6
src/passes/8-compiler/uncompiler.mli Normal file
View File

@ -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

77
src/passes/operators/helpers.mli Normal file
View File

@ -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

129
src/passes/operators/operators.mli Normal file
View File

@ -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

19
src/rope/rope_test.mli Normal file
View File

@ -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

44
src/stages/ast_simplified/PP.mli Normal file
View File

@ -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

124
src/stages/ast_simplified/combinators.mli Normal file
View File

@ -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

18
src/stages/ast_simplified/misc.mli Normal file
View File

@ -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

33
src/stages/ast_typed/PP.mli Normal file
View File

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

152
src/stages/ast_typed/combinators.mli Normal file
View File

@ -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

22
src/stages/ast_typed/combinators_environment.mli Normal file
View File

@ -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

62
src/stages/ast_typed/environment.mli Normal file
View File

@ -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

70
src/stages/ast_typed/misc.mli Normal file
View File

@ -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

25
src/stages/ast_typed/misc_smart.mli Normal file
View File

@ -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

32
src/stages/mini_c/PP.mli Normal file
View File

@ -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

85
src/stages/mini_c/combinators.mli Normal file
View File

@ -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

3
src/stages/mini_c/combinators_smart.mli Normal file
View File

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

58
src/stages/mini_c/environment.mli Normal file
View File

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

2
vendors/rope/rope.mli vendored
View File

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

2
vendors/rope/rope_implementation.mli vendored
View File

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

2
vendors/rope/rope_top_level_open.mli vendored
View File

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