From 5a3003f75bb5e16b368dda26788ae8dead671d3e Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Mon, 19 Jul 2021 17:16:06 +0200 Subject: [PATCH] v0.3.1 return{} + functionId(X.y) --- .drom | 28 +- CHANGES.md | 2 +- drom.toml | 2 +- dune-project | 2 +- ez_hash.opam | 2 +- solidity-alcotest.opam | 2 +- solidity-common.opam | 2 +- solidity-parser.opam | 2 +- solidity-test.opam | 2 +- solidity-typechecker.opam | 2 +- src/solidity-alcotest/version.mlt | 2 +- src/solidity-common/solidity_ast.ml | 3 +- src/solidity-common/solidity_ast.mli | 5 +- src/solidity-common/solidity_printer.ml | 22 +- src/solidity-common/solidity_visitor.ml | 6 +- src/solidity-common/version.mlt | 2 +- src/solidity-parser/solidity_lexer.mll | 1 + src/solidity-parser/solidity_raw_parser.mly | 16 +- src/solidity-parser/version.mlt | 2 +- src/solidity-test/version.mlt | 2 +- .../solidity_checker_TYPES.ml | 3 +- .../solidity_postcheck_utils.ml | 1 - .../solidity_primitives.ml | 383 +------- src/solidity-typechecker/solidity_tenv.ml | 5 +- .../solidity_type_conv.ml | 1 + .../solidity_type_printer.ml | 2 + .../solidity_typechecker.ml | 825 +++++++++--------- .../solidity_typechecker.mli | 4 +- src/solidity-typechecker/version.mlt | 2 +- 29 files changed, 507 insertions(+), 826 deletions(-) diff --git a/.drom b/.drom index 498d12f..3195a74 100644 --- a/.drom +++ b/.drom @@ -2,7 +2,7 @@ # hash of toml configuration files # used for generation of all files -1e61bf762d06039228fa40123986164f:. +0c9d153828991ed03dadaee3e6e912de:. # end context for . # begin context for .github/workflows/doc-deploy.yml @@ -37,7 +37,7 @@ a8d1bcd6f62c6b813b77d3ff8959d8d2:.ocamlformat-ignore # begin context for CHANGES.md # file CHANGES.md -3c209b23d1c3cdcf988c1b2c17a062cb:CHANGES.md +873ca123aaa4f12aedad55595c52d1ea:CHANGES.md # end context for CHANGES.md # begin context for LICENSE.md @@ -97,12 +97,12 @@ c8281f46ba9a11d0b61bc8ef67eaa357:docs/style.css # begin context for dune-project # file dune-project -a763e33bb9032a52af3d8b1d54c81a79:dune-project +b877b563b3a1da795b26be4319d5dcc2:dune-project # end context for dune-project # begin context for ez_hash.opam # file ez_hash.opam -bfe0fe6557ac0067c0af0957776a218d:ez_hash.opam +62344d70f0815962091e077cca95a645:ez_hash.opam # end context for ez_hash.opam # begin context for scripts/after.sh @@ -122,27 +122,27 @@ bb3a9d286f0dc64021db4194427263ee:scripts/copy-bin.sh # begin context for solidity-alcotest.opam # file solidity-alcotest.opam -e4c6d96c1d43a4212e0c6fd7eafa0bba:solidity-alcotest.opam +54623069b08f8d7342d62e5d21abf615:solidity-alcotest.opam # end context for solidity-alcotest.opam # begin context for solidity-common.opam # file solidity-common.opam -c5dc9cb80350677af069005eea9029d5:solidity-common.opam +42a80a0071000e29f533534d2e640113:solidity-common.opam # end context for solidity-common.opam # begin context for solidity-parser.opam # file solidity-parser.opam -74a335b608009f3bc87765de148b2eb9:solidity-parser.opam +c105f5cd63f7bdc137cacd90655d3960:solidity-parser.opam # end context for solidity-parser.opam # begin context for solidity-test.opam # file solidity-test.opam -beb8811d7c7c23333e799d1717bc8b97:solidity-test.opam +386c907f168ab33fb2489810d9b8321d:solidity-test.opam # end context for solidity-test.opam # begin context for solidity-typechecker.opam # file solidity-typechecker.opam -424bac9289a1103c40674f0b3433782e:solidity-typechecker.opam +4675cef4797ec67b1c5959d5973396db:solidity-typechecker.opam # end context for solidity-typechecker.opam # begin context for sphinx/_static/css/fixes.css @@ -197,7 +197,7 @@ e86f9a67236dac57aaae3ca819cb7dbb:src/ocaml-solidity/package.toml # begin context for src/solidity-alcotest/version.mlt # file src/solidity-alcotest/version.mlt -1e501a85255c8330e7be2911d58f03d8:src/solidity-alcotest/version.mlt +47d835b1b3ec0a463928fd2af319b6c0:src/solidity-alcotest/version.mlt # end context for src/solidity-alcotest/version.mlt # begin context for src/solidity-common/dune @@ -217,7 +217,7 @@ e86f9a67236dac57aaae3ca819cb7dbb:src/ocaml-solidity/package.toml # begin context for src/solidity-common/version.mlt # file src/solidity-common/version.mlt -1e501a85255c8330e7be2911d58f03d8:src/solidity-common/version.mlt +47d835b1b3ec0a463928fd2af319b6c0:src/solidity-common/version.mlt # end context for src/solidity-common/version.mlt # begin context for src/solidity-parser/dune @@ -237,7 +237,7 @@ be413a351ddaf3cdf0d44e91ad35680e:src/solidity-parser/main.ml # begin context for src/solidity-parser/version.mlt # file src/solidity-parser/version.mlt -1e501a85255c8330e7be2911d58f03d8:src/solidity-parser/version.mlt +47d835b1b3ec0a463928fd2af319b6c0:src/solidity-parser/version.mlt # end context for src/solidity-parser/version.mlt # begin context for src/solidity-test/dune @@ -247,7 +247,7 @@ be413a351ddaf3cdf0d44e91ad35680e:src/solidity-parser/main.ml # begin context for src/solidity-test/version.mlt # file src/solidity-test/version.mlt -1e501a85255c8330e7be2911d58f03d8:src/solidity-test/version.mlt +47d835b1b3ec0a463928fd2af319b6c0:src/solidity-test/version.mlt # end context for src/solidity-test/version.mlt # begin context for src/solidity-typechecker/dune @@ -267,5 +267,5 @@ be413a351ddaf3cdf0d44e91ad35680e:src/solidity-parser/main.ml # begin context for src/solidity-typechecker/version.mlt # file src/solidity-typechecker/version.mlt -1e501a85255c8330e7be2911d58f03d8:src/solidity-typechecker/version.mlt +47d835b1b3ec0a463928fd2af319b6c0:src/solidity-typechecker/version.mlt # end context for src/solidity-typechecker/version.mlt diff --git a/CHANGES.md b/CHANGES.md index 1dc5b9f..c5fdf4b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -## v0.1.0 ( 2021-07-19 ) +## v0.1.0 ( 2021-07-20 ) * Initial commit diff --git a/drom.toml b/drom.toml index 9ab17d3..c533612 100644 --- a/drom.toml +++ b/drom.toml @@ -15,7 +15,7 @@ license = "LGPL2" min-edition = "4.08.0" name = "ocaml-solidity" synopsis = "The ocaml-solidity project" -version = "0.3.0" +version = "0.3.1" # keys that you could also define: # odoc-target = "...odoc-target..." diff --git a/dune-project b/dune-project index de6f922..283682e 100644 --- a/dune-project +++ b/dune-project @@ -3,7 +3,7 @@ (name ocaml-solidity) (allow_approximate_merlin) (generate_opam_files false) -(version 0.3.0) +(version 0.3.1) (formatting (enabled_for ocaml reason)) (using menhir 2.0) diff --git a/ez_hash.opam b/ez_hash.opam index bd21187..a95cf8b 100644 --- a/ez_hash.opam +++ b/ez_hash.opam @@ -2,7 +2,7 @@ # Do not modify, or add to the `skip` field of `drom.toml`. opam-version: "2.0" name: "ez_hash" -version: "0.3.0" +version: "0.3.1" license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" synopsis: "Hash functions: sha3, sha256, blake2b" description: """ diff --git a/solidity-alcotest.opam b/solidity-alcotest.opam index 1e7e178..fcc9d9c 100644 --- a/solidity-alcotest.opam +++ b/solidity-alcotest.opam @@ -2,7 +2,7 @@ # Do not modify, or add to the `skip` field of `drom.toml`. opam-version: "2.0" name: "solidity-alcotest" -version: "0.3.0" +version: "0.3.1" license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" synopsis: "The ocaml-solidity project" description: """ diff --git a/solidity-common.opam b/solidity-common.opam index fb96549..c4e7446 100644 --- a/solidity-common.opam +++ b/solidity-common.opam @@ -2,7 +2,7 @@ # Do not modify, or add to the `skip` field of `drom.toml`. opam-version: "2.0" name: "solidity-common" -version: "0.3.0" +version: "0.3.1" license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" synopsis: "The ocaml-solidity project" description: """ diff --git a/solidity-parser.opam b/solidity-parser.opam index 80d3543..c2609c9 100644 --- a/solidity-parser.opam +++ b/solidity-parser.opam @@ -2,7 +2,7 @@ # Do not modify, or add to the `skip` field of `drom.toml`. opam-version: "2.0" name: "solidity-parser" -version: "0.3.0" +version: "0.3.1" license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" synopsis: "The ocaml-solidity project" description: """ diff --git a/solidity-test.opam b/solidity-test.opam index 8149d75..ae7c6fc 100644 --- a/solidity-test.opam +++ b/solidity-test.opam @@ -2,7 +2,7 @@ # Do not modify, or add to the `skip` field of `drom.toml`. opam-version: "2.0" name: "solidity-test" -version: "0.3.0" +version: "0.3.1" license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" synopsis: "The ocaml-solidity project" description: """ diff --git a/solidity-typechecker.opam b/solidity-typechecker.opam index 3e79028..0c7e6fd 100644 --- a/solidity-typechecker.opam +++ b/solidity-typechecker.opam @@ -2,7 +2,7 @@ # Do not modify, or add to the `skip` field of `drom.toml`. opam-version: "2.0" name: "solidity-typechecker" -version: "0.3.0" +version: "0.3.1" license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" synopsis: "The ocaml-solidity project" description: """ diff --git a/src/solidity-alcotest/version.mlt b/src/solidity-alcotest/version.mlt index 674bb48..1b5969f 100644 --- a/src/solidity-alcotest/version.mlt +++ b/src/solidity-alcotest/version.mlt @@ -13,7 +13,7 @@ let query cmd = let commit_hash = query "git show -s --pretty=format:%H" let commit_date = query "git show -s --pretty=format:%ci" -let version = "0.3.0" +let version = "0.3.1" let version = match commit_hash with | Some commit_hash -> diff --git a/src/solidity-common/solidity_ast.ml b/src/solidity-common/solidity_ast.ml index b870297..698d44d 100644 --- a/src/solidity-common/solidity_ast.ml +++ b/src/solidity-common/solidity_ast.ml @@ -95,6 +95,7 @@ and function_definition = { fun_override : longident list option; (* fallback/receive: external *) fun_virtual : bool; (* but public if missing... *) fun_inline : bool; (* freeton *) + fun_responsible : bool; (* freeton *) fun_body : block option; (* mutability : nonpayable by default *) } @@ -155,7 +156,7 @@ and raw_statement = expression option * statement | TryStatement of expression * return list * block * catch_clause list | Emit of expression * function_call_arguments - | Return of expression option + | Return of expression option * (ident * expression) list | Continue | Break | PlaceholderStatement diff --git a/src/solidity-common/solidity_ast.mli b/src/solidity-common/solidity_ast.mli index 462ce07..ae2a506 100644 --- a/src/solidity-common/solidity_ast.mli +++ b/src/solidity-common/solidity_ast.mli @@ -127,6 +127,7 @@ and function_definition = { fun_override : longident list option; fun_virtual : bool; fun_inline : bool; (* freeton *) + fun_responsible : bool; (* freeton *) fun_body : block option; } @@ -224,8 +225,8 @@ and raw_statement = | Emit of expression * function_call_arguments (** Event emission *) - | Return of expression option - (** Return statement *) + | Return of expression option * (ident * expression) list + (** Return statement (second part only on FreeToN) *) | Continue (** Continue (loop statement) *) diff --git a/src/solidity-common/solidity_printer.ml b/src/solidity-common/solidity_printer.ml index 791a62d..dea4c25 100644 --- a/src/solidity-common/solidity_printer.ml +++ b/src/solidity-common/solidity_printer.ml @@ -287,16 +287,18 @@ and variable_definition b indent ~freeton { and function_definition b indent { fun_name; fun_params; fun_returns; fun_modifiers; fun_visibility; - fun_mutability; fun_override; fun_virtual; fun_inline ; fun_body } = + fun_mutability; fun_override; fun_virtual; + fun_inline ; fun_responsible ; fun_body } = let name = match strip fun_name with | id when Ident.equal id Ident.fallback -> "fallback" | id when Ident.equal id Ident.receive -> "receive" | id when Ident.equal id Ident.constructor -> "constructor" + | id when Ident.equal id Ident.onBounce -> "onBounce" | id -> "function " ^ (Ident.to_string id) in bprint b indent - (Format.sprintf "%s(%s) %s%s%s%s%s%s%s%s" + (Format.sprintf "%s(%s) %s%s%s%s%s%s%s%s%s" (name) (String.concat ", " (List.map string_of_function_param fun_params)) (string_of_visibility fun_visibility) @@ -305,6 +307,7 @@ and function_definition b indent { | m -> " " ^ (string_of_fun_mutability m)) (if fun_virtual then " virtual" else "") (if fun_inline then " inline" else "") + (if fun_responsible then " responsible" else "") (match fun_override with | None -> "" | Some [] -> " override" @@ -415,9 +418,20 @@ and statement b indent s = (string_of_function_call_arguments args)) | PlaceholderStatement -> bprint b indent "_;" - | Return e_opt -> + | Return ( e_opt , options ) -> bprint b indent - (Format.sprintf "return %s;" (string_of_expression_option e_opt)) + (Format.sprintf "return %s %s;" + ( match options with + | [] -> "" + | _ -> + Format.sprintf "{%s}" + (String.concat "," + (List.map (fun (id, e) -> + Format.sprintf "%s: %s" + (string_of_ident id) (string_of_expression e) + ) options)) + ) + (string_of_expression_option e_opt)) | Block statement_list -> bprint b indent "{" ; block b (indent + 2) statement_list; diff --git a/src/solidity-common/solidity_visitor.ml b/src/solidity-common/solidity_visitor.ml index 6163a13..4821a96 100644 --- a/src/solidity-common/solidity_visitor.ml +++ b/src/solidity-common/solidity_visitor.ml @@ -311,6 +311,7 @@ and visitFunctionDef (v : #ast_visitor) (fd : function_definition) : unit = fun_override; fun_virtual; fun_inline = _; + fun_responsible = _; fun_body } : function_definition) : unit = visitNode visitIdent v fun_name; @@ -405,8 +406,9 @@ and visitStatement (v : #ast_visitor) (s : statement) : unit = | Emit (e, fca) -> visitExpression v e; visitFunctionCallArguments v fca - | Return eo -> - visitOpt visitExpression v eo + | Return (eo, l) -> + visitOpt visitExpression v eo; + visitList (visitXY (visitNode visitIdent) visitExpression) v l | Continue | Break | PlaceholderStatement -> () | RepeatStatement (e, s) -> visitExpression v e; diff --git a/src/solidity-common/version.mlt b/src/solidity-common/version.mlt index 674bb48..1b5969f 100644 --- a/src/solidity-common/version.mlt +++ b/src/solidity-common/version.mlt @@ -13,7 +13,7 @@ let query cmd = let commit_hash = query "git show -s --pretty=format:%H" let commit_date = query "git show -s --pretty=format:%ci" -let version = "0.3.0" +let version = "0.3.1" let version = match commit_hash with | Some commit_hash -> diff --git a/src/solidity-parser/solidity_lexer.mll b/src/solidity-parser/solidity_lexer.mll index 30a4694..2429f71 100644 --- a/src/solidity-parser/solidity_lexer.mll +++ b/src/solidity-parser/solidity_lexer.mll @@ -314,6 +314,7 @@ if freeton then "optional", OPTIONAL; "onBounce", ONBOUNCE; "repeat", REPEAT; + "responsible", RESPONSIBLE; ]; () end diff --git a/src/solidity-parser/solidity_raw_parser.mly b/src/solidity-parser/solidity_raw_parser.mly index 4b0daf8..d799e23 100644 --- a/src/solidity-parser/solidity_raw_parser.mly +++ b/src/solidity-parser/solidity_raw_parser.mly @@ -42,6 +42,7 @@ | Invocation of longident * expression list option | Static | Inline + | Responsible let add_free_var_modifiers pos var ml = let has_mut = ref false in @@ -114,6 +115,10 @@ if fct.fun_inline then error pos "Inline already specified"; { fct with fun_inline = true } + | Responsible -> + if fct.fun_responsible then + error pos "responsible already specified"; + { fct with fun_responsible = true } | Invocation (lid, exp_list_opt) -> { fct with fun_modifiers = (lid, exp_list_opt) :: fct.fun_modifiers } @@ -255,6 +260,7 @@ %token USING %token PUBLIC %token INLINE (* freeton *) +%token RESPONSIBLE (* freeton *) %token STATIC (* freeton *) %token OPTIONAL (* freeton *) %token ONBOUNCE (* freeton *) @@ -456,6 +462,7 @@ source_unit: fun_override = None; fun_virtual = false; fun_inline = false; + fun_responsible = false; fun_body = $5; } $3)) } ;; @@ -545,6 +552,7 @@ contract_part: fun_override = None; fun_virtual = false; fun_inline = false; + fun_responsible = false; fun_body = $5; } $3)) } | function_descriptor parameters function_modifier* returns_opt function_body_opt @@ -558,6 +566,7 @@ contract_part: fun_override = None; fun_virtual = false; fun_inline = false; + fun_responsible = false; fun_body = $5; } $3)) } | EVENT identifier event_parameters boption(ANONYMOUS) SEMI { mk $loc (EventDefinition { @@ -591,7 +600,7 @@ struct_fields: function_descriptor: | FUNCTION identifier { $2 } | CONSTRUCTOR { mk $loc Ident.constructor } - | ONBOUNCE { freeton() ; mk $loc Ident.constructor } + | ONBOUNCE { freeton() ; mk $loc Ident.onBounce } | RECEIVE { mk $loc Ident.receive } | FALLBACK { mk $loc Ident.fallback } ;; @@ -619,6 +628,7 @@ function_modifier: | internal_external { $1 } | public_private { $1 } | INLINE { freeton() ; Inline } + | RESPONSIBLE { freeton() ; Responsible } | VIRTUAL { Virtual } | override_specifier { $1 } ;; @@ -861,7 +871,9 @@ statement_no_semi: statement_before_semi: | simple_statement { $1 } | do_while_statement { mk $loc ($1) } - | RETURN expression? { mk $loc (Return ($2)) } + | RETURN LBRACE name_value_nonempty_list RBRACE expression? + { freeton() ; mk $loc (Return ($5, $3)) } + | RETURN expression? { mk $loc (Return ($2, [])) } | CONTINUE { mk $loc (Continue) } | BREAK { mk $loc (Break) } | EMIT function_call { let (f, a) = $2 in mk $loc (Emit (f, a)) } diff --git a/src/solidity-parser/version.mlt b/src/solidity-parser/version.mlt index 674bb48..1b5969f 100644 --- a/src/solidity-parser/version.mlt +++ b/src/solidity-parser/version.mlt @@ -13,7 +13,7 @@ let query cmd = let commit_hash = query "git show -s --pretty=format:%H" let commit_date = query "git show -s --pretty=format:%ci" -let version = "0.3.0" +let version = "0.3.1" let version = match commit_hash with | Some commit_hash -> diff --git a/src/solidity-test/version.mlt b/src/solidity-test/version.mlt index 674bb48..1b5969f 100644 --- a/src/solidity-test/version.mlt +++ b/src/solidity-test/version.mlt @@ -13,7 +13,7 @@ let query cmd = let commit_hash = query "git show -s --pretty=format:%H" let commit_date = query "git show -s --pretty=format:%ci" -let version = "0.3.0" +let version = "0.3.1" let version = match commit_hash with | Some commit_hash -> diff --git a/src/solidity-typechecker/solidity_checker_TYPES.ml b/src/solidity-typechecker/solidity_checker_TYPES.ml index c8d29a2..60b007d 100644 --- a/src/solidity-typechecker/solidity_checker_TYPES.ml +++ b/src/solidity-typechecker/solidity_checker_TYPES.ml @@ -193,7 +193,8 @@ and magic_type = | TAbi (* type of the 'abi' object *) | TTvm (* type of the 'tvm' object *) | TStatic of ( Ident.t * type_ ) list - + | TMath + | TRnd (* source_unit (Import) *) type annot += AImport of Ident.t diff --git a/src/solidity-typechecker/solidity_postcheck_utils.ml b/src/solidity-typechecker/solidity_postcheck_utils.ml index 54895e4..5ff6a73 100644 --- a/src/solidity-typechecker/solidity_postcheck_utils.ml +++ b/src/solidity-typechecker/solidity_postcheck_utils.ml @@ -1112,4 +1112,3 @@ let inheritFrom | None -> invariant_broken ("Cannot find inherited contract " ^ LongIdent.to_string id) | Some e -> e in {env with env_inherited = env.env_inherited @ [id, inherit_env]} - diff --git a/src/solidity-typechecker/solidity_primitives.ml b/src/solidity-typechecker/solidity_primitives.ml index 04a5260..9d9291c 100644 --- a/src/solidity-typechecker/solidity_primitives.ml +++ b/src/solidity-typechecker/solidity_primitives.ml @@ -22,21 +22,6 @@ let register id p f_desc = Solidity_tenv.add_primitive_desc id f_desc - -let primitive_fun_named ?(returns_lvalue=false) - arg_types ret_types function_mutability = - Function { function_abs_name = LongIdent.empty; - function_params = arg_types; - function_returns = List.map (fun t -> (t, None)) ret_types; - function_returns_lvalue = returns_lvalue; - function_visibility = VPublic; - function_mutability; - function_override = None; - function_selector = None; - function_is_method = false; (* can be true *) - function_is_primitive = true; - function_def = None; } - let make_fun = Solidity_type_builder.primitive_fun let make_var = Solidity_type_builder.primitive_var @@ -62,59 +47,6 @@ let preprocess_arg_1 pos t atl_opt = error pos "Need at least 1 argument for function \ call, but provided only 0" -let rec list_sub n list = - if n = 0 then [] else - match list with - | [] -> failwith "List.sub" - | x :: tail -> - x :: ( list_sub (n-1) tail ) - -let make_surcharged_fun ~nreq pos expected_args opt result = - match opt.call_args with - | None -> assert false (* TODO *) - | Some (AList list) -> - let len = List.length list in - if len <= nreq then - None (* TODO *) - else - Some - ( make_fun (List.map (fun (_, type_, _optiona) -> - type_) ( list_sub len expected_args )) result - MNonPayable ) - | Some (ANamed list) -> - let expected_args = - List.mapi (fun i (name, type_, optional) -> - name, (i, type_, optional, ref false) ) - expected_args - in - let nargs = List.length list in - let map = EzCompat.StringMap.of_list expected_args in - List.iter (fun (name, _) -> - match EzCompat.StringMap.find (Ident.to_string name) map with - | exception Not_found -> - error pos "Unknown field %S" (Ident.to_string name) - | (_pos, _expected_type, _optional, found) -> - found := true - ) list ; - let rec iter args n = - if n = 0 then - [] - else - match args with - | [] -> assert false - | ( name, (_i, type_, optional, found) ) :: args -> - if !found then - ( type_, Some ( Ident.of_string name ) ) :: - iter args (n-1) - else - if optional then - iter args n - else - assert false (* TODO: error non-optional argument missing *) - in - let expected_args = iter expected_args nargs in - Some ( primitive_fun_named expected_args result MNonPayable ) - let register_primitives () = @@ -137,10 +69,7 @@ let register_primitives () = | None, Some ((AList [_] | ANamed [_])) -> Some (make_fun [TBool] [] MPure) | None, Some ((AList [_;_] | ANamed [_;_])) -> - if !for_freeton then - Some (make_fun [TBool; TUint 256] [] MPure) - else - Some (make_fun [TBool; TString LMemory] [] MPure) + Some (make_fun [TBool; TString LMemory] [] MPure) | _ -> None); register 3 @@ -264,8 +193,6 @@ let register_primitives () = | Some (TFunction (fd, _fo)) when is_external fd.function_visibility -> error pos "Using \".value(...)\" is deprecated. \ Use \"{value: ...}\" instead" - | Some (TAddress _) when !for_freeton -> - Some (make_var (TUint 256)) | _ -> None); register 17 @@ -339,26 +266,6 @@ let register_primitives () = but %d were provided" (List.length atl) in Some (make_fun atl rtl MPure) - - | Some ( TAbstract TvmSlice ) when !for_freeton -> - begin - match opt.call_args with - | Some ( AList list ) -> - begin - match list with - [ TType type_ ] -> - Some (make_fun list [ type_ ] MNonPayable) - | _ -> - Printf.eprintf "wrong args (1) %s\n%!" - (String.concat " x " - ( List.map - Solidity_type_printer.string_of_type list ) ); - None - end - | _ -> - Printf.eprintf "wrong args (2) \n%!"; - None - end | _ -> None); register 22 @@ -508,8 +415,6 @@ let register_primitives () = prim_kind = PrimMemberVariable } (fun _pos _opt t_opt -> match t_opt with - | Some (TAddress (_)) when !for_freeton -> - Some (make_var (TUint 128)) | Some (TAddress (_)) -> Some (make_var (TUint 256)) | _ -> None); @@ -517,16 +422,8 @@ let register_primitives () = register 36 { prim_name = "transfer"; prim_kind = PrimMemberFunction } - (fun pos opt t_opt -> + (fun pos _opt t_opt -> match t_opt with - | Some (TAddress _) when !for_freeton -> - make_surcharged_fun ~nreq:1 pos - [ "value", TUint 256, false ; - "bounce", TBool, true ; - "flag", TUint 16, true ; - "body", TAbstract TvmCell, true ; - (* not yet: "currencies", ExtraCurrencyCollection *) - ] opt [] | Some (TAddress (true)) -> Some (make_fun [TUint 256] [] MNonPayable) | Some (TAddress (false)) -> @@ -542,8 +439,6 @@ let register_primitives () = match t_opt with | Some (TAddress (true)) -> Some (make_fun [TUint 256] [TBool] MNonPayable) - | Some (TAddress (false)) when !for_freeton -> - Some (make_fun [TUint 256] [TBool] MNonPayable) | Some (TAddress (false)) -> error pos "\"send\" and \"transfer\" are only available \ for objects of type \"address payable\", \ @@ -634,10 +529,6 @@ let register_primitives () = prim_kind = PrimMemberVariable } (fun _pos _opt t_opt -> match t_opt with - | Some (TMapping ( from_, to_, _loc )) when !for_freeton -> - Some (make_fun [ ] - [ TOptional (TTuple [ Some from_ ; - Some to_ ] ) ] MNonPayable) | Some (TMagic (TMetaType (TInt (_) | TUint (_) as t))) -> Some (make_var (t)) | _ -> None); @@ -683,8 +574,6 @@ let register_primitives () = let t = Solidity_type.change_type_location (LStorage false) t in Some (make_fun [t] [] MNonPayable) - | Some (TArray (t, _, _)), _ when !for_freeton -> - Some (make_fun [t] [] MNonPayable) | Some (TBytes (LStorage _)), (None | Some (AList [] | ANamed [])) -> Some (make_fun ~returns_lvalue:true [] [TFixBytes (1)] MNonPayable) @@ -732,274 +621,6 @@ let register_primitives () = Use \"{gas: ...}\" instead" | _ -> None); - (* TODO: allow functions with constant arity ? *) - register 54 - { prim_name = "store"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TAbstract TvmBuilder) when !for_freeton -> - Some (make_fun [TDots] [] MNonPayable) - | _ -> None); - - register 55 - { prim_name = "tvm"; - prim_kind = PrimVariable } - (fun _pos _opt t_opt -> - match t_opt with - | None when !for_freeton -> Some (make_var (TMagic (TTvm))) - | _ -> None); - - register 56 - { prim_name = "toCell"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TAbstract TvmBuilder) when !for_freeton -> - Some (make_fun [] [TAbstract TvmCell] MNonPayable) - | _ -> None); - - register 57 - { prim_name = "hash"; - prim_kind = PrimMemberFunction } - (fun _pos opt t_opt -> - match t_opt with - | Some (TMagic TTvm) when !for_freeton -> - begin - match opt.call_args with - | None -> None - | Some (AList [ - TAbstract TvmCell - | TString _ - | TBytes _ - | TAbstract TvmSlice - ]) - -> - Some (make_fun [TAny] [TUint 256] MNonPayable) - | _ -> None - end - | _ -> None); - - register 58 - { prim_name = "now"; - prim_kind = PrimVariable } - (fun _pos _opt t_opt -> - match t_opt with - | None when !for_freeton -> - Some (make_var (TUint 64)) - | _ -> None); - - register 59 - { prim_name = "fetch"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TMapping ( from_, to_, _loc )) when !for_freeton -> - Some (make_fun [ from_ ] [ TOptional to_ ] MNonPayable) - | _ -> None); - - register 60 - { prim_name = "hasValue"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TOptional _) when !for_freeton -> - Some (make_fun [] [ TBool ] MNonPayable) - | _ -> None); - - register 61 - { prim_name = "get"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TOptional to_) when !for_freeton -> - Some (make_fun [] [ to_ ] MNonPayable) - | _ -> None); - - register 62 - { prim_name = "accept"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TMagic TTvm) when !for_freeton -> - Some (make_fun [] [] MNonPayable) - | _ -> None); - - register 63 - { prim_name = "pubkey"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TMagic ( TTvm | TMsg )) when !for_freeton -> - Some (make_fun [] [TUint 256] MNonPayable) - | _ -> None); - - register 64 - { prim_name = "next"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TMapping ( from_, to_, _loc )) when !for_freeton -> - Some (make_fun [ from_ ] - [ TOptional (TTuple [ Some from_ ; - Some to_ ] ) ] MNonPayable) - | _ -> None); - - register 65 - { prim_name = "toSlice"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TString _ ) when !for_freeton -> - Some (make_fun [] [ TAbstract TvmSlice ] MNonPayable) - | Some (TAbstract ( TvmBuilder | TvmCell )) when !for_freeton -> - Some (make_fun [] [TAbstract TvmSlice] MNonPayable) - | _ -> None); - - register 66 - { prim_name = "functionId"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TMagic TTvm ) when !for_freeton -> - (* TODO: only allow constructor and functions *) - Some (make_fun [ TAny ] [ TUint 32 ] MNonPayable) - | _ -> None); - - register 67 - { prim_name = "exists"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TMapping ( from_, _to, _loc )) when !for_freeton -> - Some (make_fun [ from_ ] [ TBool ] MNonPayable) - | _ -> None); - - register 68 - { prim_name = "reset"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TOptional _ ) when !for_freeton -> - Some (make_fun [] [] MNonPayable) - | _ -> None); - - register 69 - { prim_name = "storeRef"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TAbstract TvmBuilder) when !for_freeton -> - Some (make_fun [TDots] [] MNonPayable) - | _ -> None); - - register 70 - { prim_name = "append"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TString loc | TBytes loc) when !for_freeton -> - Some (make_fun [TString loc] [] MNonPayable) - | _ -> None); - - register 71 - { prim_name = "vergrth16"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TMagic TTvm ) when !for_freeton -> - Some (make_fun [ TString LMemory ] [ TBool ] MNonPayable) - | _ -> None); - - register 72 - { prim_name = "buildStateInit"; - prim_kind = PrimMemberFunction } - (fun pos opt t_opt -> - match t_opt with - | Some ( TMagic TTvm ) when !for_freeton -> - make_surcharged_fun ~nreq:1 pos - [ - "pubkey", TUint 256, false ; - "code", TAbstract TvmCell, false ; - "contr", TDots, false ; (* TODO do better *) - "varInit", TDots, false ; (* TODO do better *) - ] opt - [ TAbstract TvmCell ] - | _ -> None); - - register 73 - { prim_name = "commit"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TMagic TTvm ) when !for_freeton -> - Some (make_fun [] [] MNonPayable) - | _ -> None); - - register 74 - { prim_name = "setcode"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TMagic TTvm ) when !for_freeton -> - Some (make_fun [TAbstract TvmCell] [] MNonPayable) - | _ -> None); - - register 75 - { prim_name = "setCurrentCode"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TMagic TTvm ) when !for_freeton -> - Some (make_fun [TAbstract TvmCell] [] MNonPayable) - | _ -> None); - - register 76 - { prim_name = "resetStorage"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TMagic TTvm ) when !for_freeton -> - Some (make_fun [] [] MNonPayable) - | _ -> None); - - register 77 - { prim_name = "makeAddrStd"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some ( TType (TAddress _ ) ) when !for_freeton -> - Some (make_fun [ TInt 8 ; TUint 256 ] [ TAddress true ] MNonPayable) - | _ -> - None); - - register 78 - { prim_name = "loadRef"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TAbstract TvmSlice) when !for_freeton -> - Some (make_fun [] [TAbstract TvmCell] MNonPayable) - | _ -> None); - - register 79 - { prim_name = "format"; - prim_kind = PrimFunction } - (fun _pos _opt t_opt -> - match t_opt with - | None when !for_freeton -> - Some (make_fun [ TString LMemory ; TDots ] [TString LMemory ] MNonPayable) - | _ -> None); - - register 80 - { prim_name = "byteLength"; - prim_kind = PrimMemberFunction } - (fun _pos _opt t_opt -> - match t_opt with - | Some (TString _) when !for_freeton -> - Some (make_fun [] [TUint 256] MNonPayable) - | _ -> None); - () let init () = diff --git a/src/solidity-typechecker/solidity_tenv.ml b/src/solidity-typechecker/solidity_tenv.ml index 8fea3e9..3ce5ab0 100644 --- a/src/solidity-typechecker/solidity_tenv.ml +++ b/src/solidity-typechecker/solidity_tenv.ml @@ -60,7 +60,7 @@ let is_visible lookup visibility ~origin ~variable = | LExternal -> is_externally_visible visibility | LStatic (Interface, _) -> - false + !for_freeton | LStatic (Contract, false) -> false | LStatic (Contract, true) -> @@ -136,7 +136,8 @@ let rec lookup_lident (lident : relative LongIdent.t) : ident_desc list = match LongIdent.to_ident_list lident with | [] -> assert false - | [ident] -> lookup_ident env ~upper ~lookup ident + | [ident] -> + lookup_ident env ~upper ~lookup ident | ident :: lident -> match lookup_ident env ~upper ~lookup:LAny ident with | [] -> [] diff --git a/src/solidity-typechecker/solidity_type_conv.ml b/src/solidity-typechecker/solidity_type_conv.ml index 368af47..4221c86 100644 --- a/src/solidity-typechecker/solidity_type_conv.ml +++ b/src/solidity-typechecker/solidity_type_conv.ml @@ -111,6 +111,7 @@ let rec implicitly_convertible ?(ignore_loc=false) ~from ~to_ () = | TContract (_, derived, _), TContract (base, _, _) -> List.exists (fun (derived, _) -> LongIdent.equal derived base) derived.contract_hierarchy + | TContract _, TAddress _ -> !for_freeton | TString (loc1), TString (loc2) | TBytes (loc1), TBytes (loc2) -> (ignore_loc || convertible_location ~from:loc1 ~to_:loc2) diff --git a/src/solidity-typechecker/solidity_type_printer.ml b/src/solidity-typechecker/solidity_type_printer.ml index b4a341c..1e9bb68 100644 --- a/src/solidity-typechecker/solidity_type_printer.ml +++ b/src/solidity-typechecker/solidity_type_printer.ml @@ -34,6 +34,8 @@ let rec string_of_magic_type = function | TAbi -> "msg" | TTvm -> "tvm" | TStatic _ -> assert false + | TMath -> "math" + | TRnd -> "rnd" and string_of_type = function | TBool -> diff --git a/src/solidity-typechecker/solidity_typechecker.ml b/src/solidity-typechecker/solidity_typechecker.ml index 094ac38..8119df0 100644 --- a/src/solidity-typechecker/solidity_typechecker.ml +++ b/src/solidity-typechecker/solidity_typechecker.ml @@ -454,7 +454,6 @@ let get_primitive opt base_t_opt id_node = | None -> [] - let type_ident opt env base_t_opt id_node = let id = strip id_node in @@ -577,331 +576,331 @@ and type_expression_lv opt env exp let pos = exp.pos in let t, lv = match strip exp with - (* Literals *) - - | BooleanLiteral (_b) -> - TBool, false - - | NumberLiteral (q, unit, sz_opt) -> - (* Note: size set only if hex *) - let q = apply_unit q unit in - let sz_opt = - match sz_opt with - | Some (i) -> - if (i mod 2 = 0) then - Some (i / 2) - else - None (* Note: if not even, size info is no longer relevant *) - | None -> - None - in - TRationalConst (q, sz_opt), false + (* Literals *) - | StringLiteral (s) -> - TLiteralString (s), false + | BooleanLiteral (_b) -> + TBool, false - | AddressLiteral (_a) -> - (* Note: Valid address literals are of type address payable *) - TAddress (true), false + | NumberLiteral (q, unit, sz_opt) -> + (* Note: size set only if hex *) + let q = apply_unit q unit in + let sz_opt = + match sz_opt with + | Some (i) -> + if (i mod 2 = 0) then + Some (i / 2) + else + None (* Note: if not even, size info is no longer relevant *) + | None -> + None + in + TRationalConst (q, sz_opt), false - (* Array expressions *) + | StringLiteral (s) -> + TLiteralString (s), false - | ImmediateArray (el) -> - let tl = List.map (type_expression opt env) el in - let t = immediate_array_element_type pos tl in - let sz = Z.of_int (List.length tl) in - (* Note: not an lvalue, but index access to such array is an lvalue *) - TArray (t, Some (sz), LMemory), false + | AddressLiteral (_a) -> + (* Note: Valid address literals are of type address payable *) + TAddress (true), false - | ArrayAccess (e, None) -> - begin - match type_expression opt env e with - | TType (t) -> - let t = Solidity_type.change_type_location LMemory t in - replace_annot e (AType (TType t)); - TType (TArray (t, None, LMemory)), false - | _ -> - error pos "Index expression cannot be omitted" - end + (* Array expressions *) - | ArrayAccess (e1, Some (e2)) -> - begin - match type_expression opt env e1 with - | TType (t) -> - begin - match expect_array_index_type opt env None e2 with - | Some (sz) -> - let t = Solidity_type.change_type_location LMemory t in - replace_annot e1 (AType (TType t)); - TType (TArray (t, Some (sz), LMemory)), false - | None -> - error pos "Integer constant expected" - end - | TArray (t, sz_opt, _loc) -> - ignore (expect_array_index_type opt env sz_opt e2); - t, true - | TArraySlice (t, _loc) -> - ignore (expect_array_index_type opt env None e2); - (* Note: array access into a slice is NOT an lvalue *) - t, false - | TMapping (tk, tv, _loc) -> - expect_expression_type opt env e2 tk; - tv, true - | TFixBytes (sz) -> - ignore (expect_array_index_type opt env (Some (Z.of_int sz)) e2); - TFixBytes (1), false - | TBytes (_loc) -> - ignore (expect_array_index_type opt env None e2); - TFixBytes (1), true - | TString (_loc) -> - error pos "Index access for string is not possible" - | t -> - error pos "Indexed expression has to be a type, \ - mapping or array (is %s)" - (Solidity_type_printer.string_of_type t) - end - - | ArraySlice (e1, e1_opt, e2_opt) -> - begin - match type_expression opt env e1 with - | TArray (t, None, (LCalldata as loc)) - | TArraySlice (t, loc) -> - Option.iter (fun e -> - ignore (expect_array_index_type opt env None e)) e1_opt; - Option.iter (fun e -> - ignore (expect_array_index_type opt env None e)) e2_opt; - TArraySlice (t, loc), false - | TArray (_t, _sz_opt, _loc) -> - error pos "Index range access is only supported \ - for dynamic calldata arrays" - | _ -> - error pos "Index range access is only possible \ - for arrays and array slices" - end + | ImmediateArray (el) -> + let tl = List.map (type_expression opt env) el in + let t = immediate_array_element_type pos tl in + let sz = Z.of_int (List.length tl) in + (* Note: not an lvalue, but index access to such array is an lvalue *) + TArray (t, Some (sz), LMemory), false - (* Simple expressions *) - - | PrefixExpression ((UInc | UDec | UDelete as op), e) - | SuffixExpression (e, (UInc | UDec as op)) -> - let t, lv = type_expression_lv { opt with allow_empty = true } env e in - if not lv then error pos "Expression has to be an lvalue"; - unop_type pos op t, false - - | PrefixExpression (op, e) - | SuffixExpression (e, op) -> - unop_type pos op (type_expression opt env e), false - - | BinaryExpression (e1, op, e2) -> - let t1 = type_expression opt env e1 in - let t2 = type_expression opt env e2 in - binop_type pos op t1 t2, false - - | CompareExpression (e1, op, e2) -> - let t1 = type_expression opt env e1 in - let t2 = type_expression opt env e2 in - let valid = - match - let t1 = Solidity_type_conv.mobile_type pos t1 in - let t2 = Solidity_type_conv.mobile_type pos t2 in + | ArrayAccess (e, None) -> + begin + match type_expression opt env e with + | TType (t) -> + let t = Solidity_type.change_type_location LMemory t in + replace_annot e (AType (TType t)); + TType (TArray (t, None, LMemory)), false + | _ -> + error pos "Index expression cannot be omitted" + end + + | ArrayAccess (e1, Some (e2)) -> + begin + match type_expression opt env e1 with + | TType (t) -> + begin + match expect_array_index_type opt env None e2 with + | Some (sz) -> + let t = Solidity_type.change_type_location LMemory t in + replace_annot e1 (AType (TType t)); + TType (TArray (t, Some (sz), LMemory)), false + | None -> + error pos "Integer constant expected" + end + | TArray (t, sz_opt, _loc) -> + ignore (expect_array_index_type opt env sz_opt e2); + t, true + | TArraySlice (t, _loc) -> + ignore (expect_array_index_type opt env None e2); + (* Note: array access into a slice is NOT an lvalue *) + t, false + | TMapping (tk, tv, _loc) -> + expect_expression_type opt env e2 tk; + tv, true + | TFixBytes (sz) -> + ignore (expect_array_index_type opt env (Some (Z.of_int sz)) e2); + TFixBytes (1), false + | TBytes (_loc) -> + ignore (expect_array_index_type opt env None e2); + TFixBytes (1), true + | TString (_loc) -> + error pos "Index access for string is not possible" + | t -> + error pos "Indexed expression has to be a type, \ + mapping or array (is %s)" + (Solidity_type_printer.string_of_type t) + end + + | ArraySlice (e1, e1_opt, e2_opt) -> + begin + match type_expression opt env e1 with + | TArray (t, None, (LCalldata as loc)) + | TArraySlice (t, loc) -> + Option.iter (fun e -> + ignore (expect_array_index_type opt env None e)) e1_opt; + Option.iter (fun e -> + ignore (expect_array_index_type opt env None e)) e2_opt; + TArraySlice (t, loc), false + | TArray (_t, _sz_opt, _loc) -> + error pos "Index range access is only supported \ + for dynamic calldata arrays" + | _ -> + error pos "Index range access is only possible \ + for arrays and array slices" + end + + (* Simple expressions *) + + | PrefixExpression ((UInc | UDec | UDelete as op), e) + | SuffixExpression (e, (UInc | UDec as op)) -> + let t, lv = type_expression_lv { opt with allow_empty = true } env e in + if not lv then error pos "Expression has to be an lvalue"; + unop_type pos op t, false + + | PrefixExpression (op, e) + | SuffixExpression (e, op) -> + unop_type pos op (type_expression opt env e), false + + | BinaryExpression (e1, op, e2) -> + let t1 = type_expression opt env e1 in + let t2 = type_expression opt env e2 in + binop_type pos op t1 t2, false + + | CompareExpression (e1, op, e2) -> + let t1 = type_expression opt env e1 in + let t2 = type_expression opt env e2 in + let valid = + match + let t1 = Solidity_type_conv.mobile_type pos t1 in + let t2 = Solidity_type_conv.mobile_type pos t2 in (* Printf.eprintf "common_type %s %s\n%!" ( Solidity_type_printer.string_of_type t1) ( Solidity_type_printer.string_of_type t2); *) - Solidity_type_conv.common_type t1 t2 - with - | Some (t) -> Solidity_type.is_comparable op t - | None -> - Printf.eprintf "No common type\n%!"; - false - in - if not valid then - error pos "Operator %s not compatible with types %s and %s" - (Solidity_printer.string_of_cmpop op) - (Solidity_type_printer.string_of_type t1) - (Solidity_type_printer.string_of_type t2); - TBool, false - - | AssignExpression (e1, e2) -> - let t1, lv = type_expression_lv { opt with allow_empty = true } env e1 in - let t2 = type_expression opt env e2 in - if not lv then - error pos "Assignment operator requires lvalue as left-hand side"; - (* Note: (true ? tuple : tuple) = tuple - may become allowed in the future *) - if not ( match t1 with - | TOptional t1 -> - let t2 = Solidity_type_conv.mobile_type pos t2 in -(* Printf.eprintf "convert %s <- %s\n%!" - ( Solidity_type_printer.string_of_type t1) - ( Solidity_type_printer.string_of_type t2); *) - Solidity_type_conv.implicitly_convertible - ~from:t2 ~to_:t1 () - | _ -> false ) then - expect_type pos ~expected:t1 ~provided:t2; - t1, false - - | AssignBinaryExpression (e1, op, e2) -> - let t1, lv = type_expression_lv { opt with allow_empty = true } env e1 in - let t2 = type_expression opt env e2 in - if not lv then - error pos "Assignment operator requires lvalue as left-hand side"; - if Solidity_type.is_tuple t1 then - error pos "Compound assignment is not allowed for tuple types" - else - let t = binop_type pos op t1 t2 in - expect_type pos ~expected:t1 ~provided:t; + Solidity_type_conv.common_type t1 t2 + with + | Some (t) -> Solidity_type.is_comparable op t + | None -> + Printf.eprintf "No common type\n%!"; + false + in + if not valid then + error pos "Operator %s not compatible with types %s and %s" + (Solidity_printer.string_of_cmpop op) + (Solidity_type_printer.string_of_type t1) + (Solidity_type_printer.string_of_type t2); + TBool, false + + | AssignExpression (e1, e2) -> + let t1, lv = type_expression_lv { opt with allow_empty = true } env e1 in + let t2 = type_expression opt env e2 in + if not lv then + error pos "Assignment operator requires lvalue as left-hand side"; + (* Note: (true ? tuple : tuple) = tuple + may become allowed in the future *) + if not ( match t1 with + | TOptional t1 -> + let t2 = Solidity_type_conv.mobile_type pos t2 in + (* Printf.eprintf "convert %s <- %s\n%!" + ( Solidity_type_printer.string_of_type t1) + ( Solidity_type_printer.string_of_type t2); *) + Solidity_type_conv.implicitly_convertible + ~from:t2 ~to_:t1 () + | _ -> false ) then + expect_type pos ~expected:t1 ~provided:t2; t1, false - | TupleExpression (eol) -> - let tl, lv = - List.fold_left (fun (tl, lv) e_opt -> - match e_opt with - | Some (e) -> - let t, elv = type_expression_lv opt env e in - Some (t) :: tl, lv && elv - | None when opt.allow_empty -> - None :: tl, lv - | None -> - error pos "Tuple component cannot be empty" - ) ([], true) eol - in - TTuple (List.rev tl), lv - - | IfExpression (e_if, e_then, e_else) -> - (* Note: may become an lvalue in the future *) - expect_expression_type opt env e_if TBool; - let t1 = type_expression opt env e_then in - let t2 = type_expression opt env e_else in - begin - match Solidity_type_conv.common_type - (Solidity_type_conv.mobile_type pos t1) - (Solidity_type_conv.mobile_type pos t2) with - | Some (t) -> - t, false - | None -> - error pos "True expression's type %s does not \ - match false expression's type %s" - (Solidity_type_printer.string_of_type t1) - (Solidity_type_printer.string_of_type t2) - end - - | NewExpression (t) -> - (* Note: this produces a function that takes the - constructor arguments or array size as parameter *) - (* Note: for arrays, only one parameter, even if multidimensional *) - let t = Solidity_type_builder.ast_type_to_type pos ~loc:LMemory env t in - begin - match t with - | TArray (_, None, _) | TBytes (_) | TString (_) -> - let t = Solidity_type_builder.primitive_fun_type - [TUint 256] [t] MPure in - (t, false) - | TContract (_lid, cd, false (* super *)) -> - if cd.contract_def.contract_abstract then - error pos "Cannot instantiate an abstract contract"; - if is_interface cd.contract_def.contract_kind then - error pos "Cannot instantiate an interface"; - if is_library cd.contract_def.contract_kind then - error pos "Instantiating libraries is not supported yet"; - let ctor = Solidity_tenv.find_constructor pos cd in - let atl = List.map fst ctor.function_params in - let t = Solidity_type_builder.primitive_fun_type - ~kind:KNewContract atl [t] MPayable in - (t, false) - | TArray (_, Some (_), _) -> - error pos "Length has to be placed in parentheses \ - after the array type for new expression" - | TStruct (_) | TEnum _ -> - error pos "Identifier is not a contract" - | _ -> - error pos "Contract or array type expected" - end - - | TypeExpression (t) -> - TType (Solidity_type_builder.ast_type_to_type pos ~loc:LMemory env t), - false + | AssignBinaryExpression (e1, op, e2) -> + let t1, lv = type_expression_lv { opt with allow_empty = true } env e1 in + let t2 = type_expression opt env e2 in + if not lv then + error pos "Assignment operator requires lvalue as left-hand side"; + if Solidity_type.is_tuple t1 then + error pos "Compound assignment is not allowed for tuple types" + else + let t = binop_type pos op t1 t2 in + expect_type pos ~expected:t1 ~provided:t; + t1, false + + | TupleExpression (eol) -> + let tl, lv = + List.fold_left (fun (tl, lv) e_opt -> + match e_opt with + | Some (e) -> + let t, elv = type_expression_lv opt env e in + Some (t) :: tl, lv && elv + | None when opt.allow_empty -> + None :: tl, lv + | None -> + error pos "Tuple component cannot be empty" + ) ([], true) eol + in + TTuple (List.rev tl), lv + + | IfExpression (e_if, e_then, e_else) -> + (* Note: may become an lvalue in the future *) + expect_expression_type opt env e_if TBool; + let t1 = type_expression opt env e_then in + let t2 = type_expression opt env e_else in + begin + match Solidity_type_conv.common_type + (Solidity_type_conv.mobile_type pos t1) + (Solidity_type_conv.mobile_type pos t2) with + | Some (t) -> + t, false + | None -> + error pos "True expression's type %s does not \ + match false expression's type %s" + (Solidity_type_printer.string_of_type t1) + (Solidity_type_printer.string_of_type t2) + end + + | NewExpression (t) -> + (* Note: this produces a function that takes the + constructor arguments or array size as parameter *) + (* Note: for arrays, only one parameter, even if multidimensional *) + let t = Solidity_type_builder.ast_type_to_type pos ~loc:LMemory env t in + begin + match t with + | TArray (_, None, _) | TBytes (_) | TString (_) -> + let t = Solidity_type_builder.primitive_fun_type + [TUint 256] [t] MPure in + (t, false) + | TContract (_lid, cd, false (* super *)) -> + if cd.contract_def.contract_abstract then + error pos "Cannot instantiate an abstract contract"; + if is_interface cd.contract_def.contract_kind then + error pos "Cannot instantiate an interface"; + if is_library cd.contract_def.contract_kind then + error pos "Instantiating libraries is not supported yet"; + let ctor = Solidity_tenv.find_constructor pos cd in + let atl = List.map fst ctor.function_params in + let t = Solidity_type_builder.primitive_fun_type + ~kind:KNewContract atl [t] MPayable in + (t, false) + | TArray (_, Some (_), _) -> + error pos "Length has to be placed in parentheses \ + after the array type for new expression" + | TStruct (_) | TEnum _ -> + error pos "Identifier is not a contract" + | _ -> + error pos "Contract or array type expected" + end + + | TypeExpression (t) -> + TType (Solidity_type_builder.ast_type_to_type pos ~loc:LMemory env t), + false - | IdentifierExpression (id_node) -> - type_ident opt env None id_node + | IdentifierExpression (id_node) -> + type_ident opt env None id_node - | FieldExpression (e, id_node) -> - let t = type_expression opt env e in - type_ident opt env (Some t) id_node + | FieldExpression (e, id_node) -> + let t = type_expression opt env e in + type_ident opt env (Some t) id_node - | FunctionCallExpression (e, args) -> - let args = type_function_args opt env args in - let t = type_expression { opt with call_args = Some (args) } env e in - begin - match t, args with + | FunctionCallExpression (e, args) -> + let args = type_function_args opt env args in + let t = type_expression { opt with call_args = Some (args) } env e in + begin + match t, args with - (* Function call *) - | TFunction (fd, _fo), args -> - check_function_application pos "function call" - fd.function_params args; - begin - match fd.function_returns with - | [t, _id_opt] -> t, fd.function_returns_lvalue - | tl -> TTuple (List.map (fun (t, _id_opt) -> Some (t)) tl), - fd.function_returns_lvalue - end + (* Function call *) + | TFunction (fd, _fo), args -> + check_function_application pos "function call" + fd.function_params args; + begin + match fd.function_returns with + | [t, _id_opt] -> t, fd.function_returns_lvalue + | tl -> TTuple (List.map (fun (t, _id_opt) -> Some (t)) tl), + fd.function_returns_lvalue + end - (* Event invocation *) - | TEvent (ed), args -> - check_function_application pos "function call" - ed.event_params args; - TTuple [], false - - (* Struct constructor *) - | TType (TStruct (_lid, sd, _loc) as t), args -> - let t = Solidity_type.change_type_location LMemory t in - replace_annot e (AType (TType t)); - let fp = - List.map (fun (fid, ft) -> - (Solidity_type.change_type_location LMemory ft, Some (fid)) - ) sd.struct_fields - in - check_function_application pos "struct constructor" fp args; - t, false + (* Event invocation *) + | TEvent (ed), args -> + check_function_application pos "function call" + ed.event_params args; + TTuple [], false - (* Type conversion *) - | TType (t), AList ([at]) -> - begin - let loc = Solidity_type.get_type_location e.pos at in - let t = Solidity_type.change_type_location loc t in + (* Struct constructor *) + | TType (TStruct (_lid, sd, _loc) as t), args -> + let t = Solidity_type.change_type_location LMemory t in replace_annot e (AType (TType t)); - match Solidity_type_conv.explicitly_convertible - ~from:at ~to_:t with - | Some (t) -> t, false - | None -> - error pos "Explicit type conversion not \ - allowed from \"%s\" to \"%s\"" - (Solidity_type_printer.string_of_type at) - (Solidity_type_printer.string_of_type t) - end - - | TType (_), AList (_) -> - error pos "Exactly one argument expected \ - for explicit type conversion" - - | TType (_), ANamed (_) -> - error pos "Type conversion cannot allow named arguments" - - | (TRationalConst _ | TLiteralString _ | - TBool | TInt _ | TUint _ | TFixed _ | TUfixed _ | - TAddress _ | TFixBytes _ | TBytes _ | TString _ | - TEnum _ | TStruct _ | TContract _ | TArray _ | TMapping _ | - TTuple _ | TModifier _ | TArraySlice _ | TMagic _ | TModule _ - - | TAbstract _ - | TOptional _ - | TAny | TDots - ), _ -> - error pos "Type is not callable" - end + let fp = + List.map (fun (fid, ft) -> + (Solidity_type.change_type_location LMemory ft, Some (fid)) + ) sd.struct_fields + in + check_function_application pos "struct constructor" fp args; + t, false + + (* Type conversion *) + | TType (t), AList ([at]) -> + begin + let loc = Solidity_type.get_type_location e.pos at in + let t = Solidity_type.change_type_location loc t in + replace_annot e (AType (TType t)); + match Solidity_type_conv.explicitly_convertible + ~from:at ~to_:t with + | Some (t) -> t, false + | None -> + error pos "Explicit type conversion not \ + allowed from \"%s\" to \"%s\"" + (Solidity_type_printer.string_of_type at) + (Solidity_type_printer.string_of_type t) + end - | CallOptions ( { contents = - IdentifierExpression { contents = id ; _ } ; - _ }, opts) + | TType (_), AList (_) -> + error pos "Exactly one argument expected \ + for explicit type conversion" + + | TType (_), ANamed (_) -> + error pos "Type conversion cannot allow named arguments" + + | (TRationalConst _ | TLiteralString _ | + TBool | TInt _ | TUint _ | TFixed _ | TUfixed _ | + TAddress _ | TFixBytes _ | TBytes _ | TString _ | + TEnum _ | TStruct _ | TContract _ | TArray _ | TMapping _ | + TTuple _ | TModifier _ | TArraySlice _ | TMagic _ | TModule _ + + | TAbstract _ + | TOptional _ + | TAny | TDots + ), _ -> + error pos "Type is not callable" + end + + | CallOptions ( { contents = + IdentifierExpression { contents = id ; _ } ; + _ }, opts) when Ident.to_string id = "@stateInit" -> TMagic ( TStatic @@ -909,95 +908,16 @@ and type_expression_lv opt env exp let type_ = type_expression opt env e in id, type_ ) opts )), false (* TODO *) - | CallOptions (e, opts) -> - begin - match type_expression opt env e with - | TFunction (fd, fo) -> - let is_payable = is_payable fd.function_mutability in - let fo = List.fold_left (fun fo (id, e) -> - let id = strip id in - let fo, already_set = - match Ident.to_string id, fo.kind with - | "value", KExtContractFun when - not !for_freeton && not is_payable -> - error pos "Cannot set option \"value\" \ - on a non-payable function type" - | "value", KNewContract when - not !for_freeton && not is_payable -> - error pos "Cannot set option \"value\", since the \ - constructor of contract is non-payable" - | "value", (KExtContractFun | KNewContract) -> - expect_expression_type opt env e (TUint 256); - { fo with value = true }, fo.value - | "gas", KExtContractFun -> - expect_expression_type opt env e (TUint 256); - { fo with gas = true }, fo.gas - | "salt", KNewContract -> - expect_expression_type opt env e (TFixBytes 32); - { fo with salt = true }, fo.salt - | "gas", KNewContract -> - error pos "Function call option \"%s\" cannot \ - be used with \"new\"" - (Ident.to_string id); - | "salt", KExtContractFun -> - error pos "Function call option \"%s\" can \ - only be used with \"new\"" - (Ident.to_string id); - (* FREETON *) - (* TODO: check that mandatory fields are provided *) - | "pubkey", ( KNewContract | KExtContractFun ) - when !for_freeton -> - expect_expression_type opt env e - ( TOptional (TUint 256)); - fo, false (* TODO *) - | "code", KNewContract when !for_freeton -> - expect_expression_type opt env e (TAbstract TvmCell); - fo, false (* TODO *) - | "flag", KExtContractFun when !for_freeton -> - expect_expression_type opt env e (TUint 8); - fo, false (* TODO *) - | "varInit", KNewContract when !for_freeton -> - fo, false (* TODO *) - | "abiVer", KExtContractFun when !for_freeton -> - expect_expression_type opt env e (TUint 8); - fo, false (* TODO *) - | "extMsg", KExtContractFun when !for_freeton -> - expect_expression_type opt env e TBool ; - fo, false (* TODO *) - | "sign", KExtContractFun when !for_freeton -> - expect_expression_type opt env e TBool ; - fo, false (* TODO *) - | "time", KExtContractFun when !for_freeton -> - expect_expression_type opt env e (TUint 64) ; - fo, false (* TODO *) - | "expire", KExtContractFun when !for_freeton -> - expect_expression_type opt env e (TUint 64) ; - fo, false (* TODO *) - | "callbackId", KExtContractFun when !for_freeton -> - expect_expression_type opt env e (TUint 64) ; - fo, false (* TODO *) - | "onErrorId", KExtContractFun when !for_freeton -> - expect_expression_type opt env e (TUint 64) ; - fo, false (* TODO *) - | _, KOther -> - error pos "Function call options can only be set on \ - external function calls or contract creations" - (Ident.to_string id); - | _ -> - error pos "Unknown option \"%s\". Valid options are \ - \"salt\", \"value\" and \"gas\"" - (Ident.to_string id); - in - if already_set then - error pos "Option \"%s\" has already been set" - (Ident.to_string id); - fo - ) fo opts - in - TFunction (fd, fo), false - | _ -> - error pos "Expected callable expression before call options" - end + | CallOptions (e, opts) -> + begin + match type_expression opt env e with + | TFunction (fd, fo) -> + let is_payable = is_payable fd.function_mutability in + let fo = type_options opt env pos is_payable fo opts in + TFunction (fd, fo), false + | _ -> + error pos "Expected callable expression before call options" + end in set_annot exp (AType t); @@ -1043,6 +963,98 @@ and expect_type pos ~expected ~provided = (Solidity_type_printer.string_of_type provided) (Solidity_type_printer.string_of_type expected) +and type_options opt env pos is_payable fo opts = + List.fold_left (fun fo (id, e) -> + let id = strip id in + let fo, already_set = + match Ident.to_string id, fo.kind with + | "value", KExtContractFun when + not !for_freeton && not is_payable -> + error pos "Cannot set option \"value\" \ + on a non-payable function type" + | "value", KNewContract when + not !for_freeton && not is_payable -> + error pos "Cannot set option \"value\", since the \ + constructor of contract is non-payable" + | "value", (KExtContractFun | KNewContract) -> + expect_expression_type opt env e (TUint 256); + { fo with value = true }, fo.value + | "gas", KExtContractFun -> + expect_expression_type opt env e (TUint 256); + { fo with gas = true }, fo.gas + | "salt", KNewContract -> + expect_expression_type opt env e (TFixBytes 32); + { fo with salt = true }, fo.salt + | "gas", KNewContract -> + error pos "Function call option \"%s\" cannot \ + be used with \"new\"" + (Ident.to_string id); + | "salt", KExtContractFun -> + error pos "Function call option \"%s\" can \ + only be used with \"new\"" + (Ident.to_string id); + (* FREETON *) + (* TODO: check that mandatory fields are provided *) + | "pubkey", ( KNewContract | KExtContractFun ) + when !for_freeton -> + expect_expression_type opt env e + ( TOptional (TUint 256)); + fo, false (* TODO *) + | "code", KNewContract when !for_freeton -> + expect_expression_type opt env e (TAbstract TvmCell); + fo, false (* TODO *) + | "flag", ( KExtContractFun | KNewContract ) when !for_freeton -> + expect_expression_type opt env e (TUint 8); + fo, false (* TODO *) + | "varInit", KNewContract when !for_freeton -> + fo, false (* TODO *) + | "abiVer", KExtContractFun when !for_freeton -> + expect_expression_type opt env e (TUint 8); + fo, false (* TODO *) + | "extMsg", KExtContractFun when !for_freeton -> + expect_expression_type opt env e TBool ; + fo, false (* TODO *) + | "sign", KExtContractFun when !for_freeton -> + expect_expression_type opt env e TBool ; + fo, false (* TODO *) + | "bounce", KExtContractFun when !for_freeton -> + expect_expression_type opt env e TBool ; + fo, false (* TODO *) + | "stateInit", KNewContract when !for_freeton -> + expect_expression_type opt env e (TAbstract TvmCell) ; + fo, false (* TODO *) + | "wid", KNewContract when !for_freeton -> + expect_expression_type opt env e (TUint 8) ; + fo, false (* TODO *) + | "time", KExtContractFun when !for_freeton -> + expect_expression_type opt env e (TUint 64) ; + fo, false (* TODO *) + | "expire", KExtContractFun when !for_freeton -> + expect_expression_type opt env e (TUint 64) ; + fo, false (* TODO *) + | "callbackId", KExtContractFun when !for_freeton -> + expect_expression_type opt env e (TUint 64) ; + fo, false (* TODO *) + | "onErrorId", KExtContractFun when !for_freeton -> + expect_expression_type opt env e (TUint 64) ; + fo, false (* TODO *) + | _, KOther -> + error pos "Function call options can only be set on \ + external function calls or contract creations" + (Ident.to_string id); + | _ -> + error pos "Unknown option \"%s\". Valid options are \ + \"salt\", \"value\" and \"gas\"" + (Ident.to_string id); + in + if already_set then + error pos "Option \"%s\" has already been set" + (Ident.to_string id); + fo + ) fo opts + + + (* Check statements *) let rec type_statement opt env s = @@ -1157,12 +1169,16 @@ let rec type_statement opt env s = List.iter (type_statement opt env') body ) catch_clauses - | Return (e) -> + | Return (e, opts ) -> let annot = match opt.fun_returns with | [t] -> t | tl -> TTuple (List.map Option.some tl) in + let is_payable = true in + let fo = { Solidity_type_builder.new_fun_options + with kind = KExtContractFun } in + let _fo = type_options opt env pos is_payable fo opts in set_annot s (AType annot); begin match (e, opt.fun_returns, opt.in_modifier) with @@ -1183,7 +1199,11 @@ let rec type_statement opt env s = (TTuple (List.map Option.some rtl)) with Failure (s) -> error pos "%s in return" s end - end + end; + + + + | VariableDefinition (def) -> let var_decl_list = @@ -2054,7 +2074,14 @@ let resolve_program_imports p = in List.rev ordered_rev -let type_program p = +let initialized = ref false + +let type_program ?(init = Solidity_primitives.init) p = + + if not !initialized then begin + init (); + initialized := true + end; let ordered_modules = resolve_program_imports p in @@ -2141,7 +2168,3 @@ let type_program p = ) ordered_modules; {p with program_modules = ordered_modules} - - -let () = - Solidity_primitives.init () diff --git a/src/solidity-typechecker/solidity_typechecker.mli b/src/solidity-typechecker/solidity_typechecker.mli index ff9373a..a14cb01 100644 --- a/src/solidity-typechecker/solidity_typechecker.mli +++ b/src/solidity-typechecker/solidity_typechecker.mli @@ -13,4 +13,6 @@ (** Types a program and, if successful, returns the annoted program where the program_modules are ordered wrt. their dependencies. *) -val type_program : Solidity_ast.program -> Solidity_ast.program +val type_program : + ?init:(unit -> unit) -> + Solidity_ast.program -> Solidity_ast.program diff --git a/src/solidity-typechecker/version.mlt b/src/solidity-typechecker/version.mlt index 674bb48..1b5969f 100644 --- a/src/solidity-typechecker/version.mlt +++ b/src/solidity-typechecker/version.mlt @@ -13,7 +13,7 @@ let query cmd = let commit_hash = query "git show -s --pretty=format:%H" let commit_date = query "git show -s --pretty=format:%ci" -let version = "0.3.0" +let version = "0.3.1" let version = match commit_hash with | Some commit_hash ->