From 59cb210b83acfdfab69c7880ab181b512a9e6d7c Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Mon, 7 Oct 2019 14:18:32 +0000 Subject: [PATCH 01/15] Interface for Ocaml code --- src/bin/cli.mli | 27 ++ src/bin/cli_helpers.mli | 3 + src/main/display.ml | 2 +- src/main/display.mli | 35 +++ src/passes/1-parser/camligo/generator.ml | 3 +- src/passes/1-parser/camligo/generator.mli | 275 ++++++++++++++++++ src/passes/1-parser/camligo/lex/generator.mli | 43 +++ src/passes/1-parser/camligo/location.mli | 20 ++ src/passes/1-parser/camligo/user.mli | 3 + src/passes/2-simplify/ligodity.mli | 63 ++++ src/passes/2-simplify/pascaligo.mli | 82 ++++++ src/passes/4-typer/typer.mli | 53 ++++ src/passes/6-transpiler/transpiler.mli | 59 ++++ .../8-compiler/compiler_environment.mli | 33 +++ src/passes/8-compiler/compiler_program.mli | 48 +++ src/passes/8-compiler/compiler_type.mli | 95 ++++++ src/passes/8-compiler/uncompiler.mli | 6 + src/passes/operators/helpers.mli | 77 +++++ src/passes/operators/operators.mli | 129 ++++++++ src/rope/rope_test.mli | 19 ++ src/stages/ast_simplified/PP.mli | 44 +++ src/stages/ast_simplified/combinators.mli | 124 ++++++++ src/stages/ast_simplified/misc.mli | 18 ++ src/stages/ast_typed/PP.mli | 33 +++ src/stages/ast_typed/combinators.mli | 152 ++++++++++ .../ast_typed/combinators_environment.mli | 22 ++ src/stages/ast_typed/environment.mli | 62 ++++ src/stages/ast_typed/misc.mli | 70 +++++ src/stages/ast_typed/misc_smart.mli | 25 ++ src/stages/mini_c/PP.mli | 32 ++ src/stages/mini_c/combinators.mli | 85 ++++++ src/stages/mini_c/combinators_smart.mli | 3 + src/stages/mini_c/environment.mli | 58 ++++ vendors/rope/rope.mli | 2 + vendors/rope/rope_implementation.mli | 2 + vendors/rope/rope_top_level_open.mli | 2 + 36 files changed, 1806 insertions(+), 3 deletions(-) create mode 100644 src/bin/cli.mli create mode 100644 src/bin/cli_helpers.mli create mode 100644 src/main/display.mli create mode 100644 src/passes/1-parser/camligo/generator.mli create mode 100644 src/passes/1-parser/camligo/lex/generator.mli create mode 100644 src/passes/1-parser/camligo/location.mli create mode 100644 src/passes/1-parser/camligo/user.mli create mode 100644 src/passes/2-simplify/ligodity.mli create mode 100644 src/passes/2-simplify/pascaligo.mli create mode 100644 src/passes/4-typer/typer.mli create mode 100644 src/passes/6-transpiler/transpiler.mli create mode 100644 src/passes/8-compiler/compiler_environment.mli create mode 100644 src/passes/8-compiler/compiler_program.mli create mode 100644 src/passes/8-compiler/compiler_type.mli create mode 100644 src/passes/8-compiler/uncompiler.mli create mode 100644 src/passes/operators/helpers.mli create mode 100644 src/passes/operators/operators.mli create mode 100644 src/rope/rope_test.mli create mode 100644 src/stages/ast_simplified/PP.mli create mode 100644 src/stages/ast_simplified/combinators.mli create mode 100644 src/stages/ast_simplified/misc.mli create mode 100644 src/stages/ast_typed/PP.mli create mode 100644 src/stages/ast_typed/combinators.mli create mode 100644 src/stages/ast_typed/combinators_environment.mli create mode 100644 src/stages/ast_typed/environment.mli create mode 100644 src/stages/ast_typed/misc.mli create mode 100644 src/stages/ast_typed/misc_smart.mli create mode 100644 src/stages/mini_c/PP.mli create mode 100644 src/stages/mini_c/combinators.mli create mode 100644 src/stages/mini_c/combinators_smart.mli create mode 100644 src/stages/mini_c/environment.mli diff --git a/src/bin/cli.mli b/src/bin/cli.mli new file mode 100644 index 000000000..7b2c6ac42 --- /dev/null +++ b/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 +*) diff --git a/src/bin/cli_helpers.mli b/src/bin/cli_helpers.mli new file mode 100644 index 000000000..18fce0b58 --- /dev/null +++ b/src/bin/cli_helpers.mli @@ -0,0 +1,3 @@ +open Trace + +val toplevel : display_format : string -> string result -> unit diff --git a/src/main/display.ml b/src/main/display.ml index 93eebbfe9..614ca60c7 100644 --- a/src/main/display.ml +++ b/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) diff --git a/src/main/display.mli b/src/main/display.mli new file mode 100644 index 000000000..dc6cc2408 --- /dev/null +++ b/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 diff --git a/src/passes/1-parser/camligo/generator.ml b/src/passes/1-parser/camligo/generator.ml index c8abd06bd..920bcfe7e 100644 --- a/src/passes/1-parser/camligo/generator.ml +++ b/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 - diff --git a/src/passes/1-parser/camligo/generator.mli b/src/passes/1-parser/camligo/generator.mli new file mode 100644 index 000000000..129b93408 --- /dev/null +++ b/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 +*) diff --git a/src/passes/1-parser/camligo/lex/generator.mli b/src/passes/1-parser/camligo/lex/generator.mli new file mode 100644 index 000000000..d08c6868a --- /dev/null +++ b/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 +*) diff --git a/src/passes/1-parser/camligo/location.mli b/src/passes/1-parser/camligo/location.mli new file mode 100644 index 000000000..f6bbb44d4 --- /dev/null +++ b/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 +*) diff --git a/src/passes/1-parser/camligo/user.mli b/src/passes/1-parser/camligo/user.mli new file mode 100644 index 000000000..a3e14101a --- /dev/null +++ b/src/passes/1-parser/camligo/user.mli @@ -0,0 +1,3 @@ +open! Trace + +val parse_file : string -> Ast.entry_point result diff --git a/src/passes/2-simplify/ligodity.mli b/src/passes/2-simplify/ligodity.mli new file mode 100644 index 000000000..5a444d7b6 --- /dev/null +++ b/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 diff --git a/src/passes/2-simplify/pascaligo.mli b/src/passes/2-simplify/pascaligo.mli new file mode 100644 index 000000000..0d22c29c6 --- /dev/null +++ b/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 diff --git a/src/passes/4-typer/typer.mli b/src/passes/4-typer/typer.mli new file mode 100644 index 000000000..cd7c00012 --- /dev/null +++ b/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 +*) diff --git a/src/passes/6-transpiler/transpiler.mli b/src/passes/6-transpiler/transpiler.mli new file mode 100644 index 000000000..60600ea53 --- /dev/null +++ b/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 diff --git a/src/passes/8-compiler/compiler_environment.mli b/src/passes/8-compiler/compiler_environment.mli new file mode 100644 index 000000000..a82e6e48a --- /dev/null +++ b/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 +*) diff --git a/src/passes/8-compiler/compiler_program.mli b/src/passes/8-compiler/compiler_program.mli new file mode 100644 index 000000000..4d13bdf7d --- /dev/null +++ b/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 + +*) diff --git a/src/passes/8-compiler/compiler_type.mli b/src/passes/8-compiler/compiler_type.mli new file mode 100644 index 000000000..ffa4760e2 --- /dev/null +++ b/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 + +*) diff --git a/src/passes/8-compiler/uncompiler.mli b/src/passes/8-compiler/uncompiler.mli new file mode 100644 index 000000000..d8b07a19d --- /dev/null +++ b/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 diff --git a/src/passes/operators/helpers.mli b/src/passes/operators/helpers.mli new file mode 100644 index 000000000..63b9b49c6 --- /dev/null +++ b/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 diff --git a/src/passes/operators/operators.mli b/src/passes/operators/operators.mli new file mode 100644 index 000000000..2224cc74e --- /dev/null +++ b/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 diff --git a/src/rope/rope_test.mli b/src/rope/rope_test.mli new file mode 100644 index 000000000..d946fb7e2 --- /dev/null +++ b/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 diff --git a/src/stages/ast_simplified/PP.mli b/src/stages/ast_simplified/PP.mli new file mode 100644 index 000000000..4a08aaf28 --- /dev/null +++ b/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 diff --git a/src/stages/ast_simplified/combinators.mli b/src/stages/ast_simplified/combinators.mli new file mode 100644 index 000000000..a5cc91887 --- /dev/null +++ b/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 diff --git a/src/stages/ast_simplified/misc.mli b/src/stages/ast_simplified/misc.mli new file mode 100644 index 000000000..efafd75e6 --- /dev/null +++ b/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 diff --git a/src/stages/ast_typed/PP.mli b/src/stages/ast_typed/PP.mli new file mode 100644 index 000000000..0d9d1a62c --- /dev/null +++ b/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 +*) diff --git a/src/stages/ast_typed/combinators.mli b/src/stages/ast_typed/combinators.mli new file mode 100644 index 000000000..082293b76 --- /dev/null +++ b/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 diff --git a/src/stages/ast_typed/combinators_environment.mli b/src/stages/ast_typed/combinators_environment.mli new file mode 100644 index 000000000..5c327cddd --- /dev/null +++ b/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 diff --git a/src/stages/ast_typed/environment.mli b/src/stages/ast_typed/environment.mli new file mode 100644 index 000000000..bdd6c16d8 --- /dev/null +++ b/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 diff --git a/src/stages/ast_typed/misc.mli b/src/stages/ast_typed/misc.mli new file mode 100644 index 000000000..3324c22fb --- /dev/null +++ b/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 diff --git a/src/stages/ast_typed/misc_smart.mli b/src/stages/ast_typed/misc_smart.mli new file mode 100644 index 000000000..249ddc893 --- /dev/null +++ b/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 diff --git a/src/stages/mini_c/PP.mli b/src/stages/mini_c/PP.mli new file mode 100644 index 000000000..e59300cc7 --- /dev/null +++ b/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 diff --git a/src/stages/mini_c/combinators.mli b/src/stages/mini_c/combinators.mli new file mode 100644 index 000000000..7005b2c7e --- /dev/null +++ b/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 diff --git a/src/stages/mini_c/combinators_smart.mli b/src/stages/mini_c/combinators_smart.mli new file mode 100644 index 000000000..68ff160f2 --- /dev/null +++ b/src/stages/mini_c/combinators_smart.mli @@ -0,0 +1,3 @@ +open Types + +val basic_int_quote_env : environment diff --git a/src/stages/mini_c/environment.mli b/src/stages/mini_c/environment.mli new file mode 100644 index 000000000..a9ac6afef --- /dev/null +++ b/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 +*) diff --git a/vendors/rope/rope.mli b/vendors/rope/rope.mli index 0fb2e14f3..d9a045069 100644 --- a/vendors/rope/rope.mli +++ b/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 +*) diff --git a/vendors/rope/rope_implementation.mli b/vendors/rope/rope_implementation.mli index b478569a7..6e08373c1 100644 --- a/vendors/rope/rope_implementation.mli +++ 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 +*) diff --git a/vendors/rope/rope_top_level_open.mli b/vendors/rope/rope_top_level_open.mli index b0e50e2e8..a03932aad 100644 --- a/vendors/rope/rope_top_level_open.mli +++ b/vendors/rope/rope_top_level_open.mli @@ -1,3 +1,5 @@ +(* open Rope val ( #% ) : ((impl -> impl) -> 'a -> 'b) -> 'a -> 'b +*) From ff9584c7b7e067606b9f06700e8cc87be91a475f Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Mon, 7 Oct 2019 16:33:34 +0200 Subject: [PATCH 02/15] Gardening. --- src/passes/1-parser/ligodity/.Parser.mly.tag | 2 +- src/passes/1-parser/ligodity/.links | 27 +- src/passes/1-parser/ligodity/LexerMain.ml | 2 +- src/passes/1-parser/ligodity/Parser.mly | 243 +++++++++--------- src/passes/1-parser/ligodity/ParserLog.ml | 3 +- src/passes/1-parser/ligodity/ParserMain.ml | 2 +- src/passes/1-parser/pascaligo/.links | 26 +- .../1-parser/pascaligo/Doc/pascaligo.md | 222 ++++++++-------- src/passes/1-parser/pascaligo/ParserMain.ml | 2 +- src/passes/1-parser/pascaligo/SParserMain.ml | 2 +- src/passes/1-parser/shared/EvalOpt.ml | 2 +- src/passes/1-parser/shared/EvalOpt.mli | 5 +- 12 files changed, 268 insertions(+), 270 deletions(-) diff --git a/src/passes/1-parser/ligodity/.Parser.mly.tag b/src/passes/1-parser/ligodity/.Parser.mly.tag index c009b4efc..100f7bb69 100644 --- a/src/passes/1-parser/ligodity/.Parser.mly.tag +++ b/src/passes/1-parser/ligodity/.Parser.mly.tag @@ -1 +1 @@ ---explain --external-tokens Token --base Parser ParToken.mly +--explain --external-tokens LexToken --base Parser ParToken.mly diff --git a/src/passes/1-parser/ligodity/.links b/src/passes/1-parser/ligodity/.links index 1f30004d4..f0fdfb646 100644 --- a/src/passes/1-parser/ligodity/.links +++ b/src/passes/1-parser/ligodity/.links @@ -4,18 +4,17 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml -$HOME/git/ligo/src/parser/shared/Lexer.mli -$HOME/git/ligo/src/parser/shared/Lexer.mll -$HOME/git/ligo/src/parser/shared/Error.mli -$HOME/git/ligo/src/parser/shared/EvalOpt.ml -$HOME/git/ligo/src/parser/shared/EvalOpt.mli -$HOME/git/ligo/src/parser/shared/FQueue.ml -$HOME/git/ligo/src/parser/shared/FQueue.mli -$HOME/git/ligo/src/parser/shared/LexerLog.mli -$HOME/git/ligo/src/parser/shared/LexerLog.ml -$HOME/git/ligo/src/parser/shared/Markup.ml -$HOME/git/ligo/src/parser/shared/Markup.mli -$HOME/git/ligo/src/parser/shared/Utils.mli -$HOME/git/ligo/src/parser/shared/Utils.ml -$HOME/git/ligo/src/parser/shared/Version.ml +../shared/Lexer.mli +../shared/Lexer.mll +../shared/Error.mli +../shared/EvalOpt.ml +../shared/EvalOpt.mli +../shared/FQueue.ml +../shared/FQueue.mli +../shared/LexerLog.mli +../shared/LexerLog.ml +../shared/Markup.ml +../shared/Markup.mli +../shared/Utils.mli +../shared/Utils.ml Stubs/Simple_utils.ml diff --git a/src/passes/1-parser/ligodity/LexerMain.ml b/src/passes/1-parser/ligodity/LexerMain.ml index 12f864562..a708432d0 100644 --- a/src/passes/1-parser/ligodity/LexerMain.ml +++ b/src/passes/1-parser/ligodity/LexerMain.ml @@ -6,7 +6,7 @@ let () = Printexc.record_backtrace true (* Running the lexer on the source *) -let options = EvalOpt.read "Ligodity" ".mligo" +let options = EvalOpt.read "CameLIGO" ".mligo" open EvalOpt diff --git a/src/passes/1-parser/ligodity/Parser.mly b/src/passes/1-parser/ligodity/Parser.mly index bb04220f6..0c8a5fbac 100644 --- a/src/passes/1-parser/ligodity/Parser.mly +++ b/src/passes/1-parser/ligodity/Parser.mly @@ -49,7 +49,7 @@ par(X): rpar = $3} in {region; value} } - + brackets(X): LBRACKET X RBRACKET { let region = cover $1 $3 @@ -109,7 +109,7 @@ sepseq(item,sep): (* Non-empty comma-separated values (at least two values) *) tuple(item): - item COMMA nsepseq(item,COMMA) { + item COMMA nsepseq(item,COMMA) { let h,t = $3 in $1,($2,h)::t } @@ -117,7 +117,7 @@ tuple(item): list(item): LBRACKET sep_or_term_list(item,SEMI) RBRACKET { - let elements, terminator = $2 in + let elements, terminator = $2 in { value = { opening = LBracket $1; @@ -136,7 +136,7 @@ list(item): terminator = None; closing = RBracket $2 }; - region = cover $1 $2 + region = cover $1 $2 } } @@ -150,10 +150,10 @@ declarations: | declaration declarations { Utils.(nseq_foldl (swap nseq_cons) $2 $1)} declaration: - LetEntry entry_binding { + LetEntry entry_binding { let start = $1 in let stop = expr_to_region $2.let_rhs in - let region = cover start stop in + let region = cover start stop in LetEntry { value = ($1, $2); region}, [] } | type_decl { TypeDecl $1, [] } @@ -162,7 +162,7 @@ declaration: (* Type declarations *) type_decl: - Type type_name EQ type_expr { + Type type_name EQ type_expr { let region = cover $1 (type_expr_to_region $4) in let value = { kwd_type = $1; @@ -179,19 +179,19 @@ type_expr: | record_type { TRecord $1 } cartesian: - nsepseq(fun_type, TIMES) { + nsepseq(fun_type, TIMES) { let region = nsepseq_to_region type_expr_to_region $1 in {region; value=$1} } fun_type: - core_type { - $1 + core_type { + $1 } -| core_type ARROW fun_type { +| core_type ARROW fun_type { let region = cover (type_expr_to_region $1) (type_expr_to_region $3) - in + in TFun {region; value = ($1, $2, $3)} } @@ -202,16 +202,16 @@ core_type: | module_name DOT type_name { let module_name = $1.value in let type_name = $3.value in - let value = module_name ^ "." ^ type_name in + let value = module_name ^ "." ^ type_name in let region = cover $1.region $3.region - in + in TAlias {region; value} } | core_type type_constr { let arg_val = $1 in let constr = $2 in - let start = type_expr_to_region $1 in - let stop = $2.region in + let start = type_expr_to_region $1 in + let stop = $2.region in let region = cover start stop in let lpar, rpar = ghost, ghost in let value = {lpar; inside=arg_val,[]; rpar} in @@ -219,12 +219,12 @@ core_type: TApp Region.{value = constr, arg; region} } | type_tuple type_constr { - let total = cover $1.region $2.region in + let total = cover $1.region $2.region in TApp {region=total; value = $2, $1 } -} +} | par(cartesian) { let Region.{value={inside=prod; _}; _} = $1 in - TPar {$1 with value={$1.value with inside = TProd prod}} } + TPar {$1 with value={$1.value with inside = TProd prod}} } type_constr: type_name { $1 } @@ -233,7 +233,7 @@ type_tuple: par(tuple(type_expr)) { $1 } sum_type: - ioption(VBAR) nsepseq(variant,VBAR) { + ioption(VBAR) nsepseq(variant,VBAR) { let region = nsepseq_to_region (fun x -> x.region) $2 in {region; value = $2} } @@ -256,7 +256,7 @@ record_type: elements = Some elements; terminator; closing = RBrace $3} - in {region; value} + in {region; value} } field_decl: @@ -264,7 +264,7 @@ field_decl: let stop = type_expr_to_region $3 in let region = cover $1.region stop and value = {field_name = $1; colon = $2; field_type = $3} - in {region; value} + in {region; value} } (* Entry points *) @@ -284,7 +284,7 @@ entry_binding: let_declaration: Let let_binding { - let kwd_let = $1 in + let kwd_let = $1 in let binding, region = $2 in {value = kwd_let, binding; region} } @@ -299,10 +299,10 @@ let_binding: let region = cover start stop in ({bindings= (ident_pattern :: hd :: tl); lhs_type=$3; eq=$4; let_rhs}, region) } -| irrefutable type_annotation? EQ expr { +| irrefutable type_annotation? EQ expr { let pattern = $1 in let start = pattern_to_region $1 in - let stop = expr_to_region $4 in + let stop = expr_to_region $4 in let region = cover start stop in ({bindings = [pattern]; lhs_type=$2; eq=$3; let_rhs=$4}, region) } @@ -313,11 +313,11 @@ type_annotation: (* Patterns *) irrefutable: - tuple(sub_irrefutable) { - let h, t = $1 in + tuple(sub_irrefutable) { + let h, t = $1 in let start = pattern_to_region h in let stop = last (fun (region, _) -> region) t in - let region = cover start stop in + let region = cover start stop in PTuple { value = $1; region } } | sub_irrefutable { $1 } @@ -335,14 +335,14 @@ closed_irrefutable: | typed_pattern { PTyped $1 } typed_pattern: - irrefutable COLON type_expr { - let start = pattern_to_region $1 in + irrefutable COLON type_expr { + let start = pattern_to_region $1 in let stop = type_expr_to_region $3 in let region = cover start stop in { value = { - pattern = $1; - colon = $2; + pattern = $1; + colon = $2; type_expr = $3 }; region @@ -350,18 +350,18 @@ typed_pattern: } pattern: - sub_pattern CONS tail { + sub_pattern CONS tail { let start = pattern_to_region $1 in - let stop = pattern_to_region $3 in + let stop = pattern_to_region $3 in let region = cover start stop in let val_ = {value = $1, $2, $3; region} in - PList (PCons val_) + PList (PCons val_) } -| tuple(sub_pattern) { - let h, t = $1 in +| tuple(sub_pattern) { + let h, t = $1 in let start = pattern_to_region h in let stop = last (fun (region, _) -> region) t in - let region = cover start stop in + let region = cover start stop in PTuple { value = $1; region } } | core_pattern { $1 } @@ -379,7 +379,7 @@ core_pattern: | False { PFalse $1 } | Str { PString $1 } | par(ptuple) { PPar $1 } -| list(tail) { PList (Sugar $1) } +| list(tail) { PList (Sugar $1) } | constr_pattern { PConstr $1 } | record_pattern { PRecord $1 } @@ -393,7 +393,7 @@ record_pattern: terminator; closing = RBrace $3} in - {region; value} + {region; value} } field_pattern: @@ -405,29 +405,29 @@ field_pattern: } constr_pattern: - Constr sub_pattern { + Constr sub_pattern { let region = cover $1.region (pattern_to_region $2) in { value = $1, Some $2; region } } | Constr { { value = $1, None; region = $1.region } } ptuple: - tuple(tail) { - let h, t = $1 in + tuple(tail) { + let h, t = $1 in let start = pattern_to_region h in let stop = last (fun (region, _) -> region) t in - let region = cover start stop in - PTuple { value = $1; region } + let region = cover start stop in + PTuple { value = $1; region } } unit: - LPAR RPAR { + LPAR RPAR { let the_unit = ghost, ghost in let region = cover $1 $2 in { value = the_unit; region } } tail: - sub_pattern CONS tail { + sub_pattern CONS tail { let start = pattern_to_region $1 in let end_ = pattern_to_region $3 in let region = cover start end_ in @@ -456,11 +456,11 @@ base_expr(right_expr): | fun_expr(right_expr) | disj_expr_level { $1 } | tuple(disj_expr_level) { - let h, t = $1 in + let h, t = $1 in let start = expr_to_region h in let stop = last (fun (region, _) -> region) t in - let region = cover start stop in - ETuple { value = $1; region } + let region = cover start stop in + ETuple { value = $1; region } } conditional(right_expr): @@ -476,27 +476,27 @@ if_then(right_expr): let ifnot = EUnit {region=ghost; value=the_unit} in { value = { - kwd_if = $1; - test = $2; - kwd_then = $3; + kwd_if = $1; + test = $2; + kwd_then = $3; ifso = $4; - kwd_else = ghost; + kwd_else = ghost; ifnot }; - region + region } } if_then_else(right_expr): If expr Then closed_if Else right_expr { let region = cover $1 (expr_to_region $6) in - { + { value = { - kwd_if = $1; - test = $2; - kwd_then = $3; + kwd_if = $1; + test = $2; + kwd_then = $3; ifso = $4; - kwd_else = $5; + kwd_else = $5; ifnot = $6 }; region @@ -520,21 +520,21 @@ match_expr(right_expr): let start = $1 in let stop = match $5 with (* TODO: move to separate function *) | {region; _}, [] -> region - | _, tl -> last (fun (region,_) -> region) tl + | _, tl -> last (fun (region,_) -> region) tl in let region = cover start stop in { value = { - kwd_match = $1; - expr = $2; + kwd_match = $1; + expr = $2; opening = With $3; - lead_vbar = $4; + lead_vbar = $4; cases = { - value = cases; + value = cases; region = nsepseq_to_region (fun {region; _} -> region) $5 }; closing = End ghost - }; - region + }; + region } } | MatchNat expr With VBAR? cases(right_expr) { @@ -544,27 +544,27 @@ match_expr(right_expr): let start = $1 in let stop = match $5 with (* TODO: move to separate function *) | {region; _}, [] -> region - | _, tl -> last (fun (region,_) -> region) tl + | _, tl -> last (fun (region,_) -> region) tl in let region = cover start stop in - { + { value = { - kwd_match = $1; - expr = cast; + kwd_match = $1; + expr = cast; opening = With $3; - lead_vbar = $4; + lead_vbar = $4; cases = { - value = cases; + value = cases; region = nsepseq_to_region (fun {region; _} -> region) $5 }; closing = End ghost - }; - region + }; + region } } cases(right_expr): - case_clause(right_expr) { + case_clause(right_expr) { let start = pattern_to_region $1.pattern in let stop = expr_to_region $1.rhs in let region = cover start stop in @@ -573,25 +573,25 @@ cases(right_expr): | cases(base_cond) VBAR case_clause(right_expr) { let start = match $1 with | {region; _}, [] -> region - | _, tl -> last (fun (region,_) -> region) tl + | _, tl -> last (fun (region,_) -> region) tl in let stop = expr_to_region $3.rhs in let region = cover start stop in - let h,t = $1 in { value = $3; region}, ($2, h)::t - } + let h,t = $1 in { value = $3; region}, ($2, h)::t + } case_clause(right_expr): - pattern ARROW right_expr { + pattern ARROW right_expr { { - pattern = $1; - arrow = $2; - rhs=$3 + pattern = $1; + arrow = $2; + rhs=$3 } } let_expr(right_expr): Let let_binding In right_expr { - let kwd_let = $1 in + let kwd_let = $1 in let (binding, _) = $2 in let kwd_in = $3 in let body = $4 in @@ -603,7 +603,7 @@ let_expr(right_expr): fun_expr(right_expr): Fun nseq(irrefutable) ARROW right_expr { let kwd_fun = $1 in - let bindings = $2 in + let bindings = $2 in let arrow = $3 in let body = $4 in let stop = expr_to_region $4 in @@ -624,7 +624,7 @@ disj_expr_level: | conj_expr_level { $1 } bin_op(arg1,op,arg2): - arg1 op arg2 { + arg1 op arg2 { let start = expr_to_region $1 in let stop = expr_to_region $3 in let region = cover start stop in @@ -720,16 +720,16 @@ unary_expr_level: let start = $1 in let end_ = expr_to_region $2 in let region = cover start end_ - and value = {op = $1; arg = $2} - in EArith (Neg {region; value}) + and value = {op = $1; arg = $2} + in EArith (Neg {region; value}) } | Not call_expr_level { let start = $1 in let end_ = expr_to_region $2 in let region = cover start end_ - and value = {op = $1; arg = $2} in + and value = {op = $1; arg = $2} in ELogic (BoolExpr (Not ({region; value}))) -} +} | call_expr_level { $1 } call_expr_level: @@ -738,11 +738,11 @@ call_expr_level: | core_expr { $1 } constr_expr: - Constr core_expr? { + Constr core_expr? { let start = $1.region in - let stop = match $2 with + let stop = match $2 with | Some c -> expr_to_region c - | None -> start + | None -> start in let region = cover start stop in { value = $1,$2; region} @@ -751,7 +751,7 @@ constr_expr: call_expr: core_expr nseq(core_expr) { let start = expr_to_region $1 in - let stop = match $2 with + let stop = match $2 with | e, [] -> expr_to_region e | _, l -> last expr_to_region l in @@ -777,50 +777,49 @@ core_expr: EAnnot {$1 with value=$1.value.inside} } module_field: - module_name DOT field_name { + module_name DOT field_name { let region = cover $1.region $3.region in - { value = $1.value ^ "." ^ $3.value; region } + { value = $1.value ^ "." ^ $3.value; region } } projection: struct_name DOT nsepseq(selection,DOT) { - let start = $1.region in - let stop = nsepseq_to_region (function - | FieldName f -> f.region - | Component c -> c.region) $3 + let start = $1.region in + let stop = nsepseq_to_region (function + | FieldName f -> f.region + | Component c -> c.region) $3 in let region = cover start stop in - { value = + { value = { - struct_name = $1; - selector = $2; + struct_name = $1; + selector = $2; field_path = $3 }; region } } | module_name DOT field_name DOT nsepseq(selection,DOT) { - let open Region in let module_name = $1 in let field_name = $3 in let value = module_name.value ^ "." ^ field_name.value in let struct_name = {$1 with value} in let start = $1.region in - let stop = nsepseq_to_region (function - | FieldName f -> f.region + let stop = nsepseq_to_region (function + | FieldName f -> f.region | Component c -> c.region) $5 - in + in let region = cover start stop in - { + { value = { - struct_name; - selector = $4; + struct_name; + selector = $4; field_path = $5 }; region } } - + selection: field_name { FieldName $1 } | par(Int) { Component $1 } @@ -829,36 +828,36 @@ record_expr: LBRACE sep_or_term_list(field_assignment,SEMI) RBRACE { let elements, terminator = $2 in let region = cover $1 $3 in - {value = + {value = { opening = LBrace $1; elements = Some elements; terminator; closing = RBrace $3 - }; + }; region} } field_assignment: field_name EQ expr { - let start = $1.region in - let stop = expr_to_region $3 in + let start = $1.region in + let stop = expr_to_region $3 in let region = cover start stop in - { value = + { value = { - field_name = $1; - assignment = $2; + field_name = $1; + assignment = $2; field_expr = $3 }; region - } + } } sequence: Begin sep_or_term_list(expr,SEMI) End { let elements, terminator = $2 in - let start = $1 in - let stop = $3 in + let start = $1 in + let stop = $3 in let region = cover start stop in { value = { @@ -869,4 +868,4 @@ sequence: }; region } - } \ No newline at end of file + } diff --git a/src/passes/1-parser/ligodity/ParserLog.ml b/src/passes/1-parser/ligodity/ParserLog.ml index 7f62ec5a6..5b594e969 100644 --- a/src/passes/1-parser/ligodity/ParserLog.ml +++ b/src/passes/1-parser/ligodity/ParserLog.ml @@ -1,3 +1,5 @@ +[@@@warning "-42"] + open AST open! Region @@ -351,7 +353,6 @@ and print_fun_expr {value; _} = print_expr body and print_conditional {value; _} = - let open Region in let {kwd_if; test; kwd_then; ifso; kwd_else; ifnot} = value in print_token ghost "("; print_token kwd_if "if"; diff --git a/src/passes/1-parser/ligodity/ParserMain.ml b/src/passes/1-parser/ligodity/ParserMain.ml index 3d7ed2f3e..1a8913c70 100644 --- a/src/passes/1-parser/ligodity/ParserMain.ml +++ b/src/passes/1-parser/ligodity/ParserMain.ml @@ -6,7 +6,7 @@ let () = Printexc.record_backtrace true (* Reading the command-line options *) -let options = EvalOpt.read "Ligodity" ".mligo" +let options = EvalOpt.read "CameLIGO" ".mligo" open EvalOpt diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links index eff63d2f8..f0fdfb646 100644 --- a/src/passes/1-parser/pascaligo/.links +++ b/src/passes/1-parser/pascaligo/.links @@ -4,17 +4,17 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml -$HOME/git/ligo/src/parser/shared/Lexer.mli -$HOME/git/ligo/src/parser/shared/Lexer.mll -$HOME/git/ligo/src/parser/shared/Error.mli -$HOME/git/ligo/src/parser/shared/EvalOpt.ml -$HOME/git/ligo/src/parser/shared/EvalOpt.mli -$HOME/git/ligo/src/parser/shared/FQueue.ml -$HOME/git/ligo/src/parser/shared/FQueue.mli -$HOME/git/ligo/src/parser/shared/LexerLog.mli -$HOME/git/ligo/src/parser/shared/LexerLog.ml -$HOME/git/ligo/src/parser/shared/Markup.ml -$HOME/git/ligo/src/parser/shared/Markup.mli -$HOME/git/ligo/src/parser/shared/Utils.mli -$HOME/git/ligo/src/parser/shared/Utils.ml +../shared/Lexer.mli +../shared/Lexer.mll +../shared/Error.mli +../shared/EvalOpt.ml +../shared/EvalOpt.mli +../shared/FQueue.ml +../shared/FQueue.mli +../shared/LexerLog.mli +../shared/LexerLog.ml +../shared/Markup.ml +../shared/Markup.mli +../shared/Utils.mli +../shared/Utils.ml Stubs/Simple_utils.ml diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo.md b/src/passes/1-parser/pascaligo/Doc/pascaligo.md index 5f1b54a96..e9802ebab 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo.md +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo.md @@ -119,9 +119,9 @@ use the non-operation `skip`. end end with f - Like Pascal, PascaLIGO offers procedures, as well as functions. The -difference follows the divide between expressions and instructions: -function calls are expressions, procedure calls are instructions. + + + In order for a function to be a candidate to be an entrypoint to the contract, it needs to return a specific type: `list (operation) * @@ -554,7 +554,7 @@ given the declarations (in verbose style) then the value of `r.f` is `4`. -### Predefined functions, procedures and instructions +### Predefined functions instructions Beyond a few operators, PascaLIGO features some predefined values and functions. @@ -590,54 +590,54 @@ string: if `offset + length` is greater than the length of `string`, the result is `None`, otherwise `Some (substring)`. See section "Options". -#### Lists + -PascaLIGO offers two kinds of iterators on lists. + -The first applies a given function to all the items of a given list, -each call returning the predefined value `Unit`. If the function name -is `f` and the list is `l`, this is expressed as + + + - list_iter (l, f); + -Note: `list_iter` is a predefined _procedure_. Procedures are -functions that return `Unit` and whose calls are instructions, not -expressions. The same holds for the iterated function `f` here. See -section "Declarations/Procedures". + + + + -For an iterator like `list_iter` to be useful, it needs to be able to -perform a side effect, which user-defined procedures and functions -cannot do. Like so: + + + - function iter (const delta : int; const l : list (int)) : int is - var acc : int := 0 - procedure aggregate (const i : int) is - begin - acc := acc + i - end - begin - aggregate (delta); // Has no effect on acc - list_iter (l, aggregate) // Has an effect on acc - end with acc + + + + + + + + + + -The other predefined iterator on lists is `list_map`. It is useful -when we need to apply a function to all the items of a list and gather -them into another list, in the same order as the original items. (In -mathematical terms, `list_map` builds the list of the images through -the function.) For instance, the function `iter` + + + + + - function iter (const l : list (int)) : list (int) is - function incr (const i : int) : int is - begin - skip - end with i+1 - begin - skip - end with list_map (l, incr) + + + + + + + + -will take a list of integers as a parameter and return a list with the -integers all incremented, e.g., `iter (list [1;2;3])` evaluates in -`list [2;3;4]`. + + + #### Sets @@ -709,18 +709,13 @@ functions to update sets. has value `3`. - - - The iterator `set_iter` is similar to `list_iter`: it takes a set - and a procedure (or function returning `Unit`) and applies it in - turn to all the elements of the set. - - - Another form of complete iteration on sets is performed by - loops. See section "Loops". + - Complete iteration on sets is performed by loops. See section + "Loops". #### Maps Currently, maps have less support than sets. PascaLIGO offers the -following functions and procedures on maps: +following functions on maps: - Adding bindings to a map is only possible if the map is mutable, that is, if it was declared with the annotation `var`, like so, in @@ -768,19 +763,8 @@ following functions and procedures on maps: where `sender` is a key and `backers` is a map. If the key is absent in the map, this instruction is a non-operation. - - The iterator `map_iter` is similar to `list_iter`: it takes a set - and a procedure (or function returning `Unit`) and applies it in - turn to all the bindings of the map. The type of the iterated - procedure/function is expected to be `key * value -> unit`. - - - The iterator `map_map` is similar to `list_map`: it takes a map - and a function and builds a new map by applying the function to - all the bindings. In particular, this means that the expected - return type of the iterated function must be the type of the - values in the map. - - - Another form of complete iteration on maps is performed by - loops. See section "Loops". + - Complete iteration on maps is performed by loops. See section + "Loops". #### Failures @@ -800,17 +784,17 @@ can chose. ## Declarations There are several kinds of declarations: types, mutable variables, -constants, functions, procedures, fields. Depending on the syntactic -context, only some of those declarations will be allowed. Declarations -may be separated by a semicolon. (Because each declaration starts with a +constants, functions, fields. Depending on the syntactic context, only +some of those declarations will be allowed. Declarations may be +separated by a semicolon. (Because each declaration starts with a keyword they can be parsed without separators.) ### Types Type declarations are found only at top-level, that is, outside any -function or procedure. They associate a type name to a type -expression. The general syntax is +function. They associate a type name to a type expression. The general +syntax is type some_type_name is some_type_expression @@ -959,27 +943,39 @@ is valid and changes the value of the mutable variable `counter` to be `3n`. This is the semantics found in all imperative languages. IMPORTANT: Mutable variables cannot be declared at top-level, but only -in the scope of function and procedure bodies. This is to avoid global -side effects that hide the control flow and makes static analysis -extremely difficult. +in the scope of function bodies. This is to avoid global side effects +that hide the control flow and makes static analysis extremely +difficult. ### Functions -Function declarations can occur both at top-level and inside functions -and procedures (in the tradition of Pascal). We saw an example -earlier: +Function declarations can occur both at top-level and inside +functions, in the tradition of Pascal. For example, - function iter (const l : list (int)) : list (int) is - function incr (const i : int) : int is + function incr_list (const l : list (int)) : list (int) is + function incr_int (const i : int) : int is begin skip end with i+1 + const item : int = 0 begin - skip - end with list_map (l, incr) + var temp : list (int) := nil; + for item in l + begin + temp := incr_int (item) # temp + end; + var new_l : list (int) := nil; + for item in temp + begin + new_l := item # new_l + end + end with new_l -Here, the function `incr` is declared inside the declaration of the -function `iter`. The general shape of a function declaration is +Here, the function `incr_int` is declared inside the declaration of +the function `incr_list`, which take a list of integers and a list +containing the same integers plus one. + +The general shape of a function declaration is function my_name ( ... (* parameters here *)) : return_type is ... // local declarations here @@ -1042,7 +1038,7 @@ copies. Let us copy an example seen above: function iter (const delta : int; const l : list (int)) : int is var acc : int := 0 - procedure aggregate (const i : int) is + function aggregate (const i : int) : unit is begin acc := acc + i // acc is part of the copied environment end @@ -1058,41 +1054,41 @@ value in return. IMPORTANT: _Functions cannot be recursive in PascaLIGO_, that is why loops or iterators are needed. -### Procedures + -WARNING: Procedures are not implemented in the current version of LIGO, they -will appear in a future version with these semantics but cannot currently be -used. + + + -Procedures are a special kind of functions that return `Unit`. They -are declared as follows: + + - procedure my_name ( ... (* parameters here *)) is - ... // local declarations here - begin - ... // instructions here - end + + + + + -Since function calls (see section "Functions") leave the environment -invariant, one may wonder what use there is to procedures. As we have -seen in the section about "Lists" and their iterators, the exception -to this rule are predefined iterators, like `list_iter`. They actually -allow the iterated function to perform side effects. Here is the -example again: + + + + + + - function iter (const delta : int; const l : list (int)) : int is - var acc : int := 0 - procedure aggregate (const i : int) is - begin - acc := acc + i - end - begin - aggregate (delta); // Has no effect on acc - list_iter (l, aggregate) // Has an effect on acc - end with acc + + + + + + + + + + -(For the keen reader, this is because the iterated function is inlined -by the compiler.) + + ## Instructions @@ -1154,7 +1150,7 @@ To iterate on a set `s`, we would write, for instance, ... // instructions end -where `e` is bound in turn in increasing orde to each element of the +where `e` is bound in turn in increasing order to each element of the set `s`. For example, given the declarations const s : set (int) = set 3; 1; 2 end @@ -1329,7 +1325,7 @@ PascaLIGO has an explicit keyword for the non-operation: `skip`. Using - The `for` loop is not supported yet. -- Procedures are not supported yet. + - Nested code blocks are not supported yet. diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index 8cb9daa03..14ee99307 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -6,7 +6,7 @@ let () = Printexc.record_backtrace true (* Reading the command-line options *) -let options = EvalOpt.read "Pascaligo" ".ligo" +let options = EvalOpt.read "PascaLIGO" ".ligo" open EvalOpt diff --git a/src/passes/1-parser/pascaligo/SParserMain.ml b/src/passes/1-parser/pascaligo/SParserMain.ml index d6b91d0f1..64a2bcd96 100644 --- a/src/passes/1-parser/pascaligo/SParserMain.ml +++ b/src/passes/1-parser/pascaligo/SParserMain.ml @@ -8,7 +8,7 @@ let () = Printexc.record_backtrace true (* Reading the command-line options *) -let options = EvalOpt.read () +let options = EvalOpt.read "PascaLIGO" ".ligo" open EvalOpt diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 25e5d3e02..44bb9adc8 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -174,7 +174,7 @@ let check extension = let read language extension = try - Getopt.parse_cmdline (specs language extension) anonymous; + Getopt.parse_cmdline (specs language extension) anonymous; (verb_str := let apply e a = if a <> "" then Printf.sprintf "%s, %s" e a else e diff --git a/src/passes/1-parser/shared/EvalOpt.mli b/src/passes/1-parser/shared/EvalOpt.mli index 1173ece56..3b4c3497a 100644 --- a/src/passes/1-parser/shared/EvalOpt.mli +++ b/src/passes/1-parser/shared/EvalOpt.mli @@ -47,6 +47,9 @@ type options = { cmd : command } -(* Parsing the command-line options on stdin *) +(* Parsing the command-line options on stdin. The first parameter is + the name of the concrete syntax, e.g., "pascaligo", and the second + is the file extension, e.g., ".ligo". + *) val read : string -> string -> options From 1401d03d62a927b7714c12cd1a1b39339610f584 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 7 Oct 2019 11:53:07 +0200 Subject: [PATCH 03/15] Parser patch from Christian --- src/passes/1-parser/pascaligo/Parser.mly | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index a1902bade..f4d25bbe5 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -591,7 +591,11 @@ assignment: in {region; value}} rhs: - expr { Expr $1 } + expr { + match $1 with + EConstr (NoneExpr e) -> (NoneExpr e : rhs) + | e -> Expr e + } lhs: path { Path $1 } From 08a3e08f5718a543c02b555a7d5e420cda0e49b7 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 7 Oct 2019 11:54:27 +0200 Subject: [PATCH 04/15] add a new T_constant in ast_simplified and ast_typed --- src/passes/2-simplify/pascaligo.ml | 3 ++- src/passes/4-typer/typer.ml | 2 ++ src/passes/6-transpiler/transpiler.ml | 2 ++ src/passes/6-transpiler/untranspiler.ml | 4 +++- src/stages/ast_typed/combinators.ml | 3 ++- src/stages/ast_typed/combinators_environment.ml | 2 +- src/stages/ast_typed/misc.ml | 3 +++ src/test/contracts/option.ligo | 9 +++++++++ src/test/integration_tests.ml | 4 ++++ 9 files changed, 28 insertions(+), 4 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 31e739f36..8fe81f388 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -792,7 +792,8 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let (a , loc) = r_split a in let%bind value_expr = match a.rhs with | Expr e -> simpl_expression e - | NoneExpr reg -> fail @@ unsupported_ass_None reg + (* | NoneExpr reg -> fail @@ unsupported_ass_None reg *) + | NoneExpr reg -> simpl_expression (Raw.EConstr (Raw.NoneExpr reg)) in match a.lhs with | Path path -> ( diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 391239506..7eba933bf 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -615,6 +615,8 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a let output_type = body.type_annotation in return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ()) ) + | E_constant ("NONE", []) -> + return (E_constant ("NONE", [])) (t_option_none ()) | E_constant (name, lst) -> let%bind lst' = bind_list @@ List.map (type_expression e) lst in let tv_lst = List.map get_type_annotation lst' in diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index 0cef7b26b..acc4bd7e1 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -130,6 +130,8 @@ let rec transpile_type (t:AST.type_value) : type_value result = | T_constant ("option", [o]) -> let%bind o' = transpile_type o in ok (T_option o') + | T_constant ("option_none", []) -> + ok (T_option (T_base Base_unit)) | T_constant (name , _lst) -> fail @@ unrecognized_type_constant name (* TODO hmm *) | T_sum m -> diff --git a/src/passes/6-transpiler/untranspiler.ml b/src/passes/6-transpiler/untranspiler.ml index 78c41cca8..08ed0d141 100644 --- a/src/passes/6-transpiler/untranspiler.ml +++ b/src/passes/6-transpiler/untranspiler.ml @@ -107,12 +107,14 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression get_string v in return (E_literal (Literal_address n)) ) + | T_constant ("option_none", []) -> + ok e_a_empty_none | T_constant ("option", [o]) -> ( let%bind opt = trace_strong (wrong_mini_c_value "option" v) @@ get_option v in match opt with - | None -> ok (e_a_empty_none o) + | None -> ok e_a_empty_none | Some s -> let%bind s' = untranspile s o in ok (e_a_empty_some s') diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index d9dcebb73..5ae376b9d 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -25,6 +25,7 @@ let t_tez ?s () : type_value = make_t (T_constant ("tez", [])) s let t_timestamp ?s () : type_value = make_t (T_constant ("timestamp", [])) s let t_unit ?s () : type_value = make_t (T_constant ("unit", [])) s let t_option o ?s () : type_value = make_t (T_constant ("option", [o])) s +let t_option_none ?s () : type_value = make_t (T_constant ("option_none", [])) s let t_tuple lst ?s () : type_value = make_t (T_tuple lst) s let t_list t ?s () : type_value = make_t (T_constant ("list", [t])) s let t_set t ?s () : type_value = make_t (T_constant ("set", [t])) s @@ -254,7 +255,7 @@ let e_a_address s = make_a_e (e_address s) (t_address ()) let e_a_pair a b = make_a_e (e_pair a b) (t_pair a.type_annotation b.type_annotation ()) let e_a_some s = make_a_e (e_some s) (t_option s.type_annotation ()) let e_a_lambda l in_ty out_ty = make_a_e (e_lambda l) (t_function in_ty out_ty ()) -let e_a_none t = make_a_e e_none (t_option t ()) +let e_a_none = make_a_e e_none (t_option_none ()) let e_a_tuple lst = make_a_e (E_tuple lst) (t_tuple (List.map get_type_annotation lst) ()) let e_a_record r = make_a_e (e_record r) (t_record (SMap.map get_type_annotation r) ()) let e_a_application a b = make_a_e (e_application a b) (get_type_annotation b) diff --git a/src/stages/ast_typed/combinators_environment.ml b/src/stages/ast_typed/combinators_environment.ml index 1446c8780..3cea2fd1d 100644 --- a/src/stages/ast_typed/combinators_environment.ml +++ b/src/stages/ast_typed/combinators_environment.ml @@ -12,7 +12,7 @@ let e_a_empty_string s = e_a_string s Environment.full_empty let e_a_empty_address s = e_a_address s Environment.full_empty let e_a_empty_pair a b = e_a_pair a b Environment.full_empty let e_a_empty_some s = e_a_some s Environment.full_empty -let e_a_empty_none t = e_a_none t Environment.full_empty +let e_a_empty_none = e_a_none Environment.full_empty let e_a_empty_tuple lst = e_a_tuple lst Environment.full_empty let e_a_empty_record r = e_a_record r Environment.full_empty let e_a_empty_map lst k v = e_a_map lst k v Environment.full_empty diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index 5ba66b4ea..b7fb63f76 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -296,6 +296,9 @@ let rec assert_type_value_eq (a, b: (type_value * type_value)) : unit result = m bind_list_iter assert_type_value_eq (List.combine ta tb) ) | T_tuple _, _ -> fail @@ different_kinds a b + | T_constant ("option", _), T_constant ("option_none", []) | + T_constant ("option_none", []), T_constant ("option", _) -> + ok () | T_constant (ca, lsta), T_constant (cb, lstb) -> ( let%bind _ = trace_strong (different_size_constants a b) diff --git a/src/test/contracts/option.ligo b/src/test/contracts/option.ligo index c2d36439d..9abf2c845 100644 --- a/src/test/contracts/option.ligo +++ b/src/test/contracts/option.ligo @@ -4,3 +4,12 @@ type foobar is option(int) const s : foobar = Some(42) const n : foobar = None + +function assign (var m : int) : foobar is + var coco : foobar := None; + block +{ + coco := Some(m); + coco := None; +} +with coco diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 16a4c7d69..b558d08dd 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -368,6 +368,10 @@ let option () : unit result = let expected = e_typed_none t_int in expect_eq_evaluate program "n" expected in + let%bind () = + let expected = e_typed_none t_int in + expect_eq program "assign" (e_int 12) expected + in ok () let moption () : unit result = From 3a3cfa341ab4405c31666f5047f36a13d31c0762 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 7 Oct 2019 12:03:19 +0200 Subject: [PATCH 05/15] cleaning --- src/passes/2-simplify/pascaligo.ml | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 8fe81f388..2e0eee337 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -26,16 +26,6 @@ module Errors = struct ] in error ~data title message - let unsupported_ass_None region = - let title () = "assignment of None" in - let message () = - Format.asprintf "assignments of None are not supported yet" in - let data = [ - ("none_expr", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message - let bad_bytes loc str = let title () = "bad bytes string" in let message () = @@ -792,8 +782,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let (a , loc) = r_split a in let%bind value_expr = match a.rhs with | Expr e -> simpl_expression e - (* | NoneExpr reg -> fail @@ unsupported_ass_None reg *) - | NoneExpr reg -> simpl_expression (Raw.EConstr (Raw.NoneExpr reg)) + | NoneExpr reg -> simpl_expression (EConstr (NoneExpr reg)) in match a.lhs with | Path path -> ( From 3a14ef26ef3092e70356f70a9386e4bda897ff40 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 7 Oct 2019 08:11:46 -0500 Subject: [PATCH 06/15] Simplify? --- src/passes/1-parser/pascaligo/Parser.mly | 6 +----- src/passes/2-simplify/pascaligo.ml | 2 +- src/passes/4-typer/typer.ml | 8 ++++++-- src/passes/6-transpiler/transpiler.ml | 2 -- src/passes/6-transpiler/untranspiler.ml | 4 +--- src/stages/ast_typed/combinators.ml | 3 +-- src/stages/ast_typed/combinators_environment.ml | 2 +- src/stages/ast_typed/misc.ml | 3 --- src/test/contracts/option.ligo | 2 +- 9 files changed, 12 insertions(+), 20 deletions(-) diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index f4d25bbe5..a1902bade 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -591,11 +591,7 @@ assignment: in {region; value}} rhs: - expr { - match $1 with - EConstr (NoneExpr e) -> (NoneExpr e : rhs) - | e -> Expr e - } + expr { Expr $1 } lhs: path { Path $1 } diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 2e0eee337..ddb3d7bd8 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -782,7 +782,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let (a , loc) = r_split a in let%bind value_expr = match a.rhs with | Expr e -> simpl_expression e - | NoneExpr reg -> simpl_expression (EConstr (NoneExpr reg)) + | NoneExpr reg -> simpl_expression (EConstr (NoneExpr reg)) in match a.lhs with | Path path -> ( diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 7eba933bf..7acbf5138 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -616,7 +616,11 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ()) ) | E_constant ("NONE", []) -> - return (E_constant ("NONE", [])) (t_option_none ()) + let%bind tv_opt = bind_map_option get_t_option tv_opt in + begin match tv_opt with + | None -> fail @@ simple_info "None without a type annotation" + | Some tv -> return (E_constant ("NONE", [])) (t_option tv ()) + end | E_constant (name, lst) -> let%bind lst' = bind_list @@ List.map (type_expression e) lst in let tv_lst = List.map get_type_annotation lst' in @@ -728,7 +732,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae in bind_fold_list aux (typed_name.type_value , []) path in - let%bind expr' = type_expression e expr in + let%bind expr' = type_expression e ~tv_opt:assign_tv expr in let t_expr' = get_type_annotation expr' in let%bind () = trace_strong (type_error diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index acc4bd7e1..0cef7b26b 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -130,8 +130,6 @@ let rec transpile_type (t:AST.type_value) : type_value result = | T_constant ("option", [o]) -> let%bind o' = transpile_type o in ok (T_option o') - | T_constant ("option_none", []) -> - ok (T_option (T_base Base_unit)) | T_constant (name , _lst) -> fail @@ unrecognized_type_constant name (* TODO hmm *) | T_sum m -> diff --git a/src/passes/6-transpiler/untranspiler.ml b/src/passes/6-transpiler/untranspiler.ml index 08ed0d141..78c41cca8 100644 --- a/src/passes/6-transpiler/untranspiler.ml +++ b/src/passes/6-transpiler/untranspiler.ml @@ -107,14 +107,12 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression get_string v in return (E_literal (Literal_address n)) ) - | T_constant ("option_none", []) -> - ok e_a_empty_none | T_constant ("option", [o]) -> ( let%bind opt = trace_strong (wrong_mini_c_value "option" v) @@ get_option v in match opt with - | None -> ok e_a_empty_none + | None -> ok (e_a_empty_none o) | Some s -> let%bind s' = untranspile s o in ok (e_a_empty_some s') diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index 5ae376b9d..d9dcebb73 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -25,7 +25,6 @@ let t_tez ?s () : type_value = make_t (T_constant ("tez", [])) s let t_timestamp ?s () : type_value = make_t (T_constant ("timestamp", [])) s let t_unit ?s () : type_value = make_t (T_constant ("unit", [])) s let t_option o ?s () : type_value = make_t (T_constant ("option", [o])) s -let t_option_none ?s () : type_value = make_t (T_constant ("option_none", [])) s let t_tuple lst ?s () : type_value = make_t (T_tuple lst) s let t_list t ?s () : type_value = make_t (T_constant ("list", [t])) s let t_set t ?s () : type_value = make_t (T_constant ("set", [t])) s @@ -255,7 +254,7 @@ let e_a_address s = make_a_e (e_address s) (t_address ()) let e_a_pair a b = make_a_e (e_pair a b) (t_pair a.type_annotation b.type_annotation ()) let e_a_some s = make_a_e (e_some s) (t_option s.type_annotation ()) let e_a_lambda l in_ty out_ty = make_a_e (e_lambda l) (t_function in_ty out_ty ()) -let e_a_none = make_a_e e_none (t_option_none ()) +let e_a_none t = make_a_e e_none (t_option t ()) let e_a_tuple lst = make_a_e (E_tuple lst) (t_tuple (List.map get_type_annotation lst) ()) let e_a_record r = make_a_e (e_record r) (t_record (SMap.map get_type_annotation r) ()) let e_a_application a b = make_a_e (e_application a b) (get_type_annotation b) diff --git a/src/stages/ast_typed/combinators_environment.ml b/src/stages/ast_typed/combinators_environment.ml index 3cea2fd1d..1446c8780 100644 --- a/src/stages/ast_typed/combinators_environment.ml +++ b/src/stages/ast_typed/combinators_environment.ml @@ -12,7 +12,7 @@ let e_a_empty_string s = e_a_string s Environment.full_empty let e_a_empty_address s = e_a_address s Environment.full_empty let e_a_empty_pair a b = e_a_pair a b Environment.full_empty let e_a_empty_some s = e_a_some s Environment.full_empty -let e_a_empty_none = e_a_none Environment.full_empty +let e_a_empty_none t = e_a_none t Environment.full_empty let e_a_empty_tuple lst = e_a_tuple lst Environment.full_empty let e_a_empty_record r = e_a_record r Environment.full_empty let e_a_empty_map lst k v = e_a_map lst k v Environment.full_empty diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index b7fb63f76..5ba66b4ea 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -296,9 +296,6 @@ let rec assert_type_value_eq (a, b: (type_value * type_value)) : unit result = m bind_list_iter assert_type_value_eq (List.combine ta tb) ) | T_tuple _, _ -> fail @@ different_kinds a b - | T_constant ("option", _), T_constant ("option_none", []) | - T_constant ("option_none", []), T_constant ("option", _) -> - ok () | T_constant (ca, lsta), T_constant (cb, lstb) -> ( let%bind _ = trace_strong (different_size_constants a b) diff --git a/src/test/contracts/option.ligo b/src/test/contracts/option.ligo index 9abf2c845..d3d1ef36c 100644 --- a/src/test/contracts/option.ligo +++ b/src/test/contracts/option.ligo @@ -8,7 +8,7 @@ const n : foobar = None function assign (var m : int) : foobar is var coco : foobar := None; block -{ +{ coco := Some(m); coco := None; } From 1c2c6cbc43985ce3dd4aa3345f277f618ec6a9f9 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 7 Oct 2019 08:47:51 -0500 Subject: [PATCH 07/15] Delete unused NoneExpr --- src/passes/1-parser/pascaligo/AST.ml | 2 -- src/passes/1-parser/pascaligo/AST.mli | 1 - src/passes/1-parser/pascaligo/ParserLog.ml | 1 - src/passes/2-simplify/pascaligo.ml | 1 - 4 files changed, 5 deletions(-) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 214daaafe..8a95555eb 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -408,7 +408,6 @@ and lhs = and rhs = Expr of expr -| NoneExpr of c_None and loop = While of while_loop reg @@ -760,7 +759,6 @@ let lhs_to_region : lhs -> Region.t = function let rhs_to_region = function Expr e -> expr_to_region e -| NoneExpr r -> r let selection_to_region = function FieldName {region; _} diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index 15e7e9883..f3a22e743 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -392,7 +392,6 @@ and lhs = and rhs = Expr of expr -| NoneExpr of c_None and loop = While of while_loop reg diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 4c8223aab..b6e9d651f 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -311,7 +311,6 @@ and print_assignment {value; _} = and print_rhs = function Expr e -> print_expr e -| NoneExpr r -> print_token r "None" and print_lhs = function Path path -> print_path path diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index ddb3d7bd8..f536a409a 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -782,7 +782,6 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let (a , loc) = r_split a in let%bind value_expr = match a.rhs with | Expr e -> simpl_expression e - | NoneExpr reg -> simpl_expression (EConstr (NoneExpr reg)) in match a.lhs with | Path path -> ( From e2c831a23157276caac74611d6d9e4b3433431b5 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 7 Oct 2019 09:12:10 -0500 Subject: [PATCH 08/15] Simplify more --- src/passes/4-typer/typer.ml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 7acbf5138..28258b9fb 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -615,12 +615,6 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a let output_type = body.type_annotation in return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ()) ) - | E_constant ("NONE", []) -> - let%bind tv_opt = bind_map_option get_t_option tv_opt in - begin match tv_opt with - | None -> fail @@ simple_info "None without a type annotation" - | Some tv -> return (E_constant ("NONE", [])) (t_option tv ()) - end | E_constant (name, lst) -> let%bind lst' = bind_list @@ List.map (type_expression e) lst in let tv_lst = List.map get_type_annotation lst' in From 36ec771adfd2eec9f64e1ca3abb99d23d3bd737c Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 7 Oct 2019 09:24:56 -0500 Subject: [PATCH 09/15] Remove singleton inductive type --- src/passes/1-parser/pascaligo/AST.ml | 6 ++---- src/passes/1-parser/pascaligo/AST.mli | 3 +-- src/passes/1-parser/pascaligo/Parser.mly | 2 +- src/passes/1-parser/pascaligo/ParserLog.ml | 3 +-- src/passes/2-simplify/pascaligo.ml | 4 +--- 5 files changed, 6 insertions(+), 12 deletions(-) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 8a95555eb..44c6c0734 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -406,8 +406,7 @@ and lhs = Path of path | MapPath of map_lookup reg -and rhs = - Expr of expr +and rhs = expr and loop = While of while_loop reg @@ -757,8 +756,7 @@ let lhs_to_region : lhs -> Region.t = function Path path -> path_to_region path | MapPath {region; _} -> region -let rhs_to_region = function - Expr e -> expr_to_region e +let rhs_to_region = expr_to_region let selection_to_region = function FieldName {region; _} diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index f3a22e743..4984830e0 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -390,8 +390,7 @@ and lhs = Path of path | MapPath of map_lookup reg -and rhs = - Expr of expr +and rhs = expr and loop = While of while_loop reg diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index a1902bade..bc99f9176 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -591,7 +591,7 @@ assignment: in {region; value}} rhs: - expr { Expr $1 } + expr { $1 } lhs: path { Path $1 } diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index b6e9d651f..3be60d699 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -309,8 +309,7 @@ and print_assignment {value; _} = print_token assign ":="; print_rhs rhs -and print_rhs = function - Expr e -> print_expr e +and print_rhs e = print_expr e and print_lhs = function Path path -> print_path path diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index f536a409a..5627c49f6 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -780,9 +780,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu ) | Assign a -> ( let (a , loc) = r_split a in - let%bind value_expr = match a.rhs with - | Expr e -> simpl_expression e - in + let%bind value_expr = simpl_expression a.rhs in match a.lhs with | Path path -> ( let (name , path') = simpl_path path in From 44767c4b8ebd1e53db8a1c8e6f678bb6d4b4da95 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 7 Oct 2019 17:16:03 +0200 Subject: [PATCH 10/15] Simplifier now emit CONCAT constant --- src/passes/2-simplify/pascaligo.ml | 7 +++++-- src/stages/ast_simplified/combinators.ml | 1 + src/test/contracts/string.ligo | 2 ++ src/test/integration_tests.ml | 3 ++- 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 31e739f36..022577c91 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -488,8 +488,11 @@ let rec simpl_expression (t:Raw.expr) : expr result = String.(sub s 1 (length s - 2)) in return @@ e_literal ~loc (Literal_string s') - | EString (Cat _) as e -> - fail @@ unsupported_string_catenation e + | EString (Cat bo) -> + let (bo , loc) = r_split bo in + let%bind sl = simpl_expression bo.arg1 in + let%bind sr = simpl_expression bo.arg2 in + return @@ e_string_cat ~loc sl sr | ELogic l -> simpl_logic_expression l | EList l -> simpl_list_expression l | ESet s -> simpl_set_expression s diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index 8e9e6c377..d50df9ba1 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/ast_simplified/combinators.ml @@ -73,6 +73,7 @@ let e_record ?loc map : expression = location_wrap ?loc @@ E_record map let e_tuple ?loc lst : expression = location_wrap ?loc @@ E_tuple lst let e_some ?loc s : expression = location_wrap ?loc @@ E_constant ("SOME", [s]) let e_none ?loc () : expression = location_wrap ?loc @@ E_constant ("NONE", []) +let e_string_cat ?loc sl sr : expression = location_wrap ?loc @@ E_constant ("CONCAT" , [sl ; sr ]) let e_map_add ?loc k v old : expression = location_wrap ?loc @@ E_constant ("MAP_ADD" , [k ; v ; old]) let e_map ?loc lst : expression = location_wrap ?loc @@ E_map lst let e_set ?loc lst : expression = location_wrap ?loc @@ E_set lst diff --git a/src/test/contracts/string.ligo b/src/test/contracts/string.ligo index ae54f8c09..846daf7e5 100644 --- a/src/test/contracts/string.ligo +++ b/src/test/contracts/string.ligo @@ -1 +1,3 @@ const s : string = "toto" +const x : string = s^"bar" +const y : string = "foo"^x diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 16a4c7d69..b7fae8c0b 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -262,7 +262,8 @@ let unit_expression () : unit result = let string_expression () : unit result = let%bind program = type_file "./contracts/string.ligo" in - expect_eq_evaluate program "s" (e_string "toto") + let%bind _ = expect_eq_evaluate program "s" (e_string "toto") in + expect_eq_evaluate program "y" (e_string "foototobar") let include_ () : unit result = let%bind program = type_file "./contracts/includer.ligo" in From 4a5e41faa45e21d3cbc4ad825f9265e50f42dfd7 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 7 Oct 2019 13:56:48 -0500 Subject: [PATCH 11/15] Resolve mli merge conflict --- src/passes/2-simplify/pascaligo.ml | 11 ----------- src/passes/2-simplify/pascaligo.mli | 1 - src/stages/ast_simplified/combinators.mli | 1 + 3 files changed, 1 insertion(+), 12 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 44dd0afda..1998f1c85 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -89,17 +89,6 @@ module Errors = struct ] in error ~data title message - let unsupported_string_catenation expr = - let title () = "string expressions" in - let message () = - Format.asprintf "string concatenation is not supported yet" in - let expr_loc = Raw.expr_to_region expr in - let data = [ - ("expr_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ expr_loc) - ] in - error ~data title message - let unsupported_proc_calls call = let title () = "procedure calls" in let message () = diff --git a/src/passes/2-simplify/pascaligo.mli b/src/passes/2-simplify/pascaligo.mli index 0d22c29c6..ccc42e5e1 100644 --- a/src/passes/2-simplify/pascaligo.mli +++ b/src/passes/2-simplify/pascaligo.mli @@ -29,7 +29,6 @@ module Errors : sig *) 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 diff --git a/src/stages/ast_simplified/combinators.mli b/src/stages/ast_simplified/combinators.mli index a5cc91887..764b7ca16 100644 --- a/src/stages/ast_simplified/combinators.mli +++ b/src/stages/ast_simplified/combinators.mli @@ -61,6 +61,7 @@ val e_record : ?loc:Location.t -> ( expr * expr ) list -> expression val e_tuple : ?loc:Location.t -> expression list -> expression val e_some : ?loc:Location.t -> expression -> expression val e_none : ?loc:Location.t -> unit -> expression +val e_string_cat : ?loc:Location.t -> expression -> expression -> expression val e_map_add : ?loc:Location.t -> expression -> expression -> expression -> expression val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression val e_set : ?loc:Location.t -> expression list -> expression From 0c756a4a46502fbe45691dc537356b9b2c47d676 Mon Sep 17 00:00:00 2001 From: Rodrigo Quelhas Date: Sat, 28 Sep 2019 15:42:50 +0000 Subject: [PATCH 12/15] Adding `--rm` to ligo.sh --- scripts/ligo.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/ligo.sh b/scripts/ligo.sh index 236ebe98f..e780f3b53 100755 --- a/scripts/ligo.sh +++ b/scripts/ligo.sh @@ -4,7 +4,7 @@ if test "x$PWD" = "x"; then echo "Cannot detect the current directory, the environment variable PWD is empty." exit 1 else - docker run -it -v "$PWD":"$PWD" -w "$PWD" ligolang/ligo:next "$@" + docker run --rm -it -v "$PWD":"$PWD" -w "$PWD" ligolang/ligo:next "$@" fi # Do not remove the next line. It is used as an approximate witness that the download of this file was complete. This string should not appear anywhere else in the file. # END OF DOWNLOADED FILE From 7cf75c54c869dddaccbf6272c8fc27608f9e35ab Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Mon, 7 Oct 2019 21:41:36 -0700 Subject: [PATCH 13/15] Untested rough draft of pascaligo set removal --- src/passes/2-simplify/pascaligo.ml | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 1998f1c85..9dc303e3c 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -163,7 +163,8 @@ module Errors = struct ] in error ~data title message - let unsupported_set_removal remove = + + (* let unsupported_set_removal remove = let title () = "set removals" in let message () = Format.asprintf "removal of elements in a set is not \ @@ -172,6 +173,16 @@ module Errors = struct ("removal_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ remove.Region.region) ] in + error ~data title message *) + + let unsupported_deep_set_rm path = + let title () = "set removals" in + let message () = + Format.asprintf "removal of members from embedded sets is not supported yet" in + let data = [ + ("path_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ path.Region.region) + ] in error ~data title message let unsupported_non_var_pattern p = @@ -840,7 +851,15 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let expr = e_constant ~loc "MAP_REMOVE" [key' ; e_variable map] in return_statement @@ e_assign ~loc map [] expr ) - | SetRemove r -> fail @@ unsupported_set_removal r + | SetRemove r -> ( + let (set_rm, loc) = r_split r in + let%bind set = match set_rm.set with + | Name v -> ok v.value + | Path path -> fail @@ unsupported_deep_set_rm path in + let%bind removed' = simpl_expression set_rm.element in + let expr = e_constant ~loc "SET_REMOVE" [removed' ; e_variable set] in + return_statement @@ e_assign ~loc set [] expr + ) and simpl_path : Raw.path -> string * Ast_simplified.access_path = fun p -> match p with From 1362fbae9e87faa04d1bae09d3dcf0b5dffc2beb Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Tue, 8 Oct 2019 12:22:22 +0200 Subject: [PATCH 14/15] Made big_map a keyword, like map. --- src/passes/1-parser/pascaligo/LexToken.mli | 3 ++- src/passes/1-parser/pascaligo/LexToken.mll | 11 ++++++++--- src/passes/1-parser/pascaligo/ParToken.mly | 1 + src/passes/1-parser/pascaligo/Parser.mly | 5 +++++ 4 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/passes/1-parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli index f98c7576c..49998a2e1 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mli +++ b/src/passes/1-parser/pascaligo/LexToken.mli @@ -72,6 +72,7 @@ type t = | And of Region.t (* "and" *) | Begin of Region.t (* "begin" *) +| BigMap of Region.t (* "big_map" *) | Block of Region.t (* "block" *) | Case of Region.t (* "case" *) | Const of Region.t (* "const" *) @@ -141,7 +142,7 @@ type int_err = type ident_err = Reserved_name -type invalid_natural = +type invalid_natural = | Invalid_natural | Non_canonical_zero_nat diff --git a/src/passes/1-parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll index 0fac02d8e..b92ae7edd 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mll +++ b/src/passes/1-parser/pascaligo/LexToken.mll @@ -70,6 +70,7 @@ type t = | And of Region.t (* "and" *) | Begin of Region.t (* "begin" *) +| BigMap of Region.t (* "big_map" *) | Block of Region.t (* "block" *) | Case of Region.t (* "case" *) | Const of Region.t (* "const" *) @@ -201,6 +202,7 @@ let proj_token = function | And region -> region, "And" | Begin region -> region, "Begin" +| BigMap region -> region, "BigMap" | Block region -> region, "Block" | Case region -> region, "Case" | Const region -> region, "Const" @@ -293,6 +295,7 @@ let to_lexeme = function | And _ -> "and" | Begin _ -> "begin" +| BigMap _ -> "big_map" | Block _ -> "block" | Case _ -> "case" | Const _ -> "const" @@ -353,6 +356,7 @@ let to_region token = proj_token token |> fst let keywords = [ (fun reg -> And reg); (fun reg -> Begin reg); + (fun reg -> BigMap reg); (fun reg -> Block reg); (fun reg -> Case reg); (fun reg -> Const reg); @@ -476,14 +480,14 @@ let mk_int lexeme region = then Error Non_canonical_zero else Ok (Int Region.{region; value = lexeme, z}) -type invalid_natural = +type invalid_natural = | Invalid_natural | Non_canonical_zero_nat let mk_nat lexeme region = - match (String.index_opt lexeme 'n') with + match (String.index_opt lexeme 'n') with | None -> Error Invalid_natural - | Some _ -> ( + | Some _ -> ( let z = Str.(global_replace (regexp "_") "" lexeme) |> Str.(global_replace (regexp "n") "") |> @@ -569,6 +573,7 @@ let is_ident = function let is_kwd = function And _ | Begin _ +| BigMap _ | Block _ | Case _ | Const _ diff --git a/src/passes/1-parser/pascaligo/ParToken.mly b/src/passes/1-parser/pascaligo/ParToken.mly index e400947cb..49f77b8d3 100644 --- a/src/passes/1-parser/pascaligo/ParToken.mly +++ b/src/passes/1-parser/pascaligo/ParToken.mly @@ -46,6 +46,7 @@ %token And (* "and" *) %token Begin (* "begin" *) +%token BigMap (* "big_map" *) %token Block (* "block" *) %token Case (* "case" *) %token Const (* "const" *) diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index bc99f9176..55729ed77 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -168,6 +168,11 @@ core_type: let type_constr = {value="map"; region=$1} in TApp {region; value = type_constr, $2} } +| BigMap type_tuple { + let region = cover $1 $2.region in + let type_constr = {value="big_map"; region=$1} + in TApp {region; value = type_constr, $2} + } | Set par(type_expr) { let total = cover $1 $2.region in let type_constr = {value="set"; region=$1} in From 88de350264bcb4d87ab0d2364efa72863ad8b285 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Tue, 8 Oct 2019 11:54:49 -0700 Subject: [PATCH 15/15] Add test for PascaLIGO remove syntax which appears to work --- src/test/contracts/set_arithmetic.ligo | 4 ++++ src/test/integration_tests.ml | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/src/test/contracts/set_arithmetic.ligo b/src/test/contracts/set_arithmetic.ligo index cd7c1175c..81f9b0d6c 100644 --- a/src/test/contracts/set_arithmetic.ligo +++ b/src/test/contracts/set_arithmetic.ligo @@ -13,6 +13,10 @@ function add_op (const s : set(string)) : set(string) is function remove_op (const s : set(string)) : set(string) is begin skip end with set_remove("foobar" , s) +// Test the PascaLIGO syntactic sugar for set removal vs. the function call +function remove_syntax (var s : set(string)) : set(string) is + begin remove "foobar" from set s; end with s + function mem_op (const s : set(string)) : bool is begin skip end with set_mem("foobar" , s) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index a8f67cd2b..e68e32d8f 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -241,6 +241,10 @@ let set_arithmetic () : unit result = expect_eq program "remove_op" (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) (e_set [e_string "foo" ; e_string "bar"]) in + let%bind () = + expect_eq program "remove_syntax" + (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) + (e_set [e_string "foo" ; e_string "bar"]) in let%bind () = expect_eq program "mem_op" (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])