Merge pull request #18 from lefessan/z-2021-06-15-solidity-for-freeton

solidity for freeton

src/solidity-common/solidity_common.ml

@@ -87,10 +87,10 @@ module Ident = struct
   let to_string id = id
   let of_string id = id
   let printf fmt id = Format.fprintf fmt "%s" id
-  let constructor = "#"
-  let onBounce = "!"
-  let receive = "@"
-  let fallback = "*"
+  let constructor = ":constructor"
+  let onBounce = ":onBounce"
+  let receive = ":receive"
+  let fallback = ":fallback"
 end
 
 module LongIdent = struct

src/solidity-typechecker/solidity_checker_TYPES.ml

@@ -102,6 +102,7 @@ and variable_desc = {
   mutable variable_getter : function_desc option; (* when the variable has a getter*)
   variable_is_primitive : bool;
   variable_def : Solidity_ast.state_variable_definition option; (* module/contract*)
+  mutable variable_ops : ( function_desc * variable_operation ) list ;
 }
 
 and function_desc = {
@@ -116,8 +117,21 @@ and function_desc = {
   function_is_method : bool;
   function_is_primitive : bool;
   function_def : Solidity_ast.function_definition option; (* Primitives have no definition *)
+  mutable function_ops : ( variable_desc * variable_operation ) list ;
+  mutable function_purity : function_purity ;
 }
 
+and function_purity = (* whether it modifies its contract *)
+  | PurityUnknown
+  | PurityPure
+  | PurityView
+  | PurityMute
+
+and variable_operation =
+  | OpAssign
+  | OpAccess
+  | OpCall of function_desc
+
 and modifier_desc = {
   modifier_abs_name : absolute LongIdent.t;
   mutable modifier_params : (type_ * Ident.t option) list;
@@ -241,7 +255,7 @@ type options = {
   call_args: args option;   (* could just have an in_lvalue flag *)
   fun_returns : type_ list;
   in_loop: bool;
-  in_function: bool;
+  in_function: function_desc option;
   in_modifier: bool;
   current_hierarchy: absolute LongIdent.t list;
   current_contract: contract_desc option;

src/solidity-typechecker/solidity_primitives.ml

@@ -17,10 +17,29 @@ open Solidity_exceptions
 
 let error = type_error
 
+module UTILS = struct
+
 let register id p f_desc =
   Solidity_common.add_primitive id p;
   Solidity_tenv.add_primitive_desc id f_desc
 
+let primitive_fun_named ?(returns_lvalue=false)
+    ?(purity=PurityPure)
+    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;
+             function_ops = [];
+             function_purity = purity;
+           }
 
 let make_fun = Solidity_type_builder.primitive_fun
 
@@ -47,6 +66,8 @@ let preprocess_arg_1 pos t atl_opt =
       error pos "Need at least 1 argument for function \
                  call, but provided only 0"
 
+end
+open UTILS
 
 let register_primitives () =
 

src/solidity-typechecker/solidity_primitives.mli

@@ -11,3 +11,39 @@
 (**************************************************************************)
 
 val init : unit -> unit
+
+module UTILS : sig
+  val register :
+    int ->
+    Solidity_common.primitive ->
+    (Solidity_common.pos ->
+     Solidity_checker_TYPES.options ->
+     Solidity_checker_TYPES.type_ option ->
+     Solidity_checker_TYPES.ident_desc option) ->
+    unit
+  val primitive_fun_named :
+    ?returns_lvalue:bool ->
+    ?purity:Solidity_checker_TYPES.function_purity ->
+    (Solidity_checker_TYPES.type_ *
+     Solidity_common.IdentSet.elt option)
+      list ->
+    Solidity_checker_TYPES.type_ list ->
+    Solidity_ast.fun_mutability -> Solidity_checker_TYPES.ident_desc
+
+  val make_var :
+    Solidity_checker_TYPES.type_ -> Solidity_checker_TYPES.ident_desc
+  val make_fun :
+    ?returns_lvalue:bool ->
+    ?purity:Solidity_checker_TYPES.function_purity ->
+    Solidity_checker_TYPES.type_ list ->
+    Solidity_checker_TYPES.type_ list ->
+    Solidity_ast.fun_mutability -> Solidity_checker_TYPES.ident_desc
+  val make_prim_args :
+    Solidity_common.pos ->
+    Solidity_checker_TYPES.options ->
+    Solidity_checker_TYPES.type_ list option
+  val preprocess_arg_0 : 'a -> 'b list option -> 'b list
+  val preprocess_arg_1 :
+    Solidity_common.pos -> 'a -> 'a list option -> 'a list
+
+end

src/solidity-typechecker/solidity_tenv.ml

@@ -194,7 +194,10 @@ let find_constructor pos { contract_abs_name; contract_env; _ } =
         function_selector = None;
         function_is_method = true;
         function_is_primitive = false;
-        function_def = None; }
+        function_def = None;
+        function_ops = [];
+        function_purity = PurityUnknown;
+      }
 
 let has_abstract_function cd =
   let exception Found of Ident.t in

src/solidity-typechecker/solidity_type_builder.ml

@@ -257,7 +257,10 @@ and function_type_to_desc pos env ft =
     function_selector = None;
     function_is_method = false;
     function_is_primitive = false;
-    function_def = None; }
+    function_def = None;
+    function_ops = [];
+    function_purity = PurityUnknown;
+  }
 
 and process_fun_params pos env ~ext params =
   List.map (fun (t, loc_opt, name_opt) ->
@@ -321,7 +324,10 @@ let variable_desc_to_function_desc pos vid variable_abs_name vt :
     function_selector;
     function_is_method = true;
     function_is_primitive = false;
-    function_def = None; }
+    function_def = None;
+    function_ops = [];
+    function_purity = PurityUnknown;
+  }
 
 (* Build the function corresponding to an event *)
 let event_desc_to_function_desc (ed : event_desc) : function_desc =
@@ -335,7 +341,10 @@ let event_desc_to_function_desc (ed : event_desc) : function_desc =
     function_selector = None;
     function_is_method = false;
     function_is_primitive = false;
-    function_def = None; }
+    function_def = None;
+    function_ops = [];
+    function_purity = PurityUnknown;
+  }
 
 (* Make a ident description for a local variable *)
 let local_variable_desc variable_type : variable_desc =
@@ -347,7 +356,9 @@ let local_variable_desc variable_type : variable_desc =
     variable_override = None;
     variable_getter = None;
     variable_is_primitive = false;
-    variable_def = None; }
+    variable_def = None;
+    variable_ops = [] ;
+  }
 
 
 
@@ -395,7 +406,9 @@ let make_variable_desc vlid vd =
     variable_override = None;
     variable_getter = None;
     variable_is_primitive = false;
-    variable_def = Some (vd); }
+    variable_def = Some (vd);
+    variable_ops = [] ;
+  }
 
 let update_variable_desc pos env vd kind_opt =
   let vd' =
@@ -428,7 +441,10 @@ let make_function_desc flid fd method_ =
     function_selector = None;
     function_is_method = method_;
     function_is_primitive = false;
-    function_def = Some (fd); }
+    function_def = Some (fd);
+    function_ops = [];
+    function_purity = PurityUnknown;
+  }
 
 let update_function_desc pos env fd kind_opt =
   let fd' =
@@ -468,6 +484,7 @@ let update_struct_fields sd fields =
 (* Functions to build primitive types/desc *)
 
 let primitive_fun_desc ?(returns_lvalue=false)
+    ?(purity=PurityPure)
     arg_types ret_types function_mutability =
   { function_abs_name = LongIdent.empty;
     function_params = List.map (fun t -> (t, None)) arg_types;
@@ -479,17 +496,20 @@ let primitive_fun_desc ?(returns_lvalue=false)
     function_selector = None;
     function_is_method = false; (* can be true *)
     function_is_primitive = true;
-    function_def = None; }
+    function_def = None;
+    function_ops = [];
+    function_purity = purity;
+  }
 
 let primitive_fun_type ?(kind=KOther) ?(returns_lvalue=false)
     arg_types ret_types function_mutability =
   let fd = primitive_fun_desc ~returns_lvalue
              arg_types ret_types function_mutability in
   TFunction (fd, { new_fun_options with kind })
 
-let primitive_fun ?(returns_lvalue=false)
+let primitive_fun ?(returns_lvalue=false) ?purity
     arg_types ret_types function_mutability =
-  let fd = primitive_fun_desc ~returns_lvalue
+  let fd = primitive_fun_desc ~returns_lvalue ?purity
              arg_types ret_types function_mutability in
   Function (fd)
 
@@ -502,7 +522,9 @@ let primitive_var_desc (*?(is_lvalue=false)*) variable_type =
     variable_override = None;
     variable_getter = None;
     variable_is_primitive = true;
-    variable_def = None; }
+    variable_def = None;
+    variable_ops = [] ;
+  }
 
 let primitive_var (*?(is_lvalue=false)*) variable_type =
   let vd = primitive_var_desc variable_type in