commit Solidity_primitives.UTILS

Author: Fabrice Le Fessant

src/solidity-typechecker/solidity_checker_TYPES.ml

@@ -102,7 +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_assigns : function_desc list ;
+  mutable variable_ops : ( function_desc * variable_operation ) list ;
 }
 
 and function_desc = {
@@ -117,9 +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_assigns : variable_desc list ;
+  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;

src/solidity-typechecker/solidity_primitives.ml

@@ -24,6 +24,7 @@ let register id p f_desc =
   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;
@@ -36,7 +37,8 @@ let primitive_fun_named ?(returns_lvalue=false)
              function_is_method = false; (* can be true *)
              function_is_primitive = true;
              function_def = None;
-             function_assigns = [];
+             function_ops = [];
+             function_purity = purity;
            }
 
 let make_fun = Solidity_type_builder.primitive_fun

src/solidity-typechecker/solidity_primitives.mli

@@ -23,6 +23,7 @@ module UTILS : sig
     unit
   val primitive_fun_named :
     ?returns_lvalue:bool ->
+    ?purity:Solidity_checker_TYPES.function_purity ->
     (Solidity_checker_TYPES.type_ *
      Solidity_common.IdentSet.elt option)
       list ->
@@ -33,6 +34,7 @@ module UTILS : sig
     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

src/solidity-typechecker/solidity_tenv.ml

@@ -195,7 +195,8 @@ let find_constructor pos { contract_abs_name; contract_env; _ } =
         function_is_method = true;
         function_is_primitive = false;
         function_def = None;
-        function_assigns = [];
+        function_ops = [];
+        function_purity = PurityUnknown;
       }
 
 let has_abstract_function cd =

src/solidity-typechecker/solidity_type_builder.ml

@@ -258,7 +258,8 @@ and function_type_to_desc pos env ft =
     function_is_method = false;
     function_is_primitive = false;
     function_def = None;
-    function_assigns = [];
+    function_ops = [];
+    function_purity = PurityUnknown;
   }
 
 and process_fun_params pos env ~ext params =
@@ -324,7 +325,8 @@ let variable_desc_to_function_desc pos vid variable_abs_name vt :
     function_is_method = true;
     function_is_primitive = false;
     function_def = None;
-    function_assigns = [];
+    function_ops = [];
+    function_purity = PurityUnknown;
   }
 
 (* Build the function corresponding to an event *)
@@ -340,7 +342,8 @@ let event_desc_to_function_desc (ed : event_desc) : function_desc =
     function_is_method = false;
     function_is_primitive = false;
     function_def = None;
-    function_assigns = [];
+    function_ops = [];
+    function_purity = PurityUnknown;
   }
 
 (* Make a ident description for a local variable *)
@@ -354,7 +357,7 @@ let local_variable_desc variable_type : variable_desc =
     variable_getter = None;
     variable_is_primitive = false;
     variable_def = None;
-    variable_assigns = [] ;
+    variable_ops = [] ;
   }
 
 
@@ -404,7 +407,7 @@ let make_variable_desc vlid vd =
     variable_getter = None;
     variable_is_primitive = false;
     variable_def = Some (vd);
-    variable_assigns = [] ;
+    variable_ops = [] ;
   }
 
 let update_variable_desc pos env vd kind_opt =
@@ -439,7 +442,8 @@ let make_function_desc flid fd method_ =
     function_is_method = method_;
     function_is_primitive = false;
     function_def = Some (fd);
-    function_assigns = [];
+    function_ops = [];
+    function_purity = PurityUnknown;
   }
 
 let update_function_desc pos env fd kind_opt =
@@ -480,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;
@@ -492,7 +497,8 @@ let primitive_fun_desc ?(returns_lvalue=false)
     function_is_method = false; (* can be true *)
     function_is_primitive = true;
     function_def = None;
-    function_assigns = [];
+    function_ops = [];
+    function_purity = purity;
   }
 
 let primitive_fun_type ?(kind=KOther) ?(returns_lvalue=false)
@@ -501,9 +507,9 @@ let primitive_fun_type ?(kind=KOther) ?(returns_lvalue=false)
              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)
 
@@ -517,7 +523,7 @@ let primitive_var_desc (*?(is_lvalue=false)*) variable_type =
     variable_getter = None;
     variable_is_primitive = true;
     variable_def = None;
-    variable_assigns = [] ;
+    variable_ops = [] ;
   }
 
 let primitive_var (*?(is_lvalue=false)*) variable_type =

src/solidity-typechecker/solidity_typechecker.ml

@@ -41,6 +41,9 @@ let lv_of_bool = function
   | true -> LeftValue []
   | false -> RightValue
 
+(* Currently, FieldExpression does not fill the variable_desc correctly
+   in the LeftValue list *)
+
 let check_lv pos opt lv =
   match lv with
   | RightValue ->
@@ -51,8 +54,8 @@ let check_lv pos opt lv =
       | Some fd ->
           List.iter (function
               | AVariable (vd, _) ->
-                  vd.variable_assigns <- fd :: vd.variable_assigns;
-                  fd.function_assigns <- vd :: fd.function_assigns;
+                  vd.variable_ops <- ( fd, OpAssign ) :: vd.variable_ops;
+                  fd.function_ops <- ( vd, OpAssign ) :: fd.function_ops;
               | _ -> ()
             ) list
 
@@ -302,7 +305,7 @@ let get_variable_getter pos vd =
   | Some (fd) -> fd
   | None -> error pos "Variable is missing a getter !"
 
-let type_and_annot_of_id_desc pos base_t_opt idd is_uf =
+let type_and_annot_of_id_desc pos opt base_t_opt idd is_uf =
   match idd with
   | Type (td) ->
       (* Note: user types have their storage location
@@ -331,6 +334,12 @@ let type_and_annot_of_id_desc pos base_t_opt idd is_uf =
           LeftValue [annot]
         else RightValue
       in
+      (match opt.in_function with
+       | None -> ()
+       | Some in_fd ->
+           in_fd.function_ops <- (vd, OpAccess) :: in_fd.function_ops ;
+           vd.variable_ops <- (in_fd, OpAccess) :: vd.variable_ops
+      );
       vd.variable_type, lv, annot
   | Function (fd) when is_uf ->
       assert (using_for_allowed base_t_opt);
@@ -599,7 +608,7 @@ let type_ident opt env base_t_opt id_node =
   let idd, is_uf = resolve_overloads pos opt base_t_opt id iddl uf_iddl in
 
   (* Finally, retrieve the type and annotation for this ident *)
-  let t, lv, a = type_and_annot_of_id_desc id_node.pos base_t_opt idd is_uf in
+  let t, lv, a = type_and_annot_of_id_desc id_node.pos opt base_t_opt idd is_uf in
   set_annot id_node a;
   t, lv
 
@@ -868,19 +877,42 @@ and type_expression_lv opt env exp
         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
+        let t, lv1 = type_expression_lv opt env e in
+        let t, lv2 = type_ident opt env (Some t) id_node in
+        let lv = match lv1, lv2 with
+          | LeftValue x, LeftValue y -> LeftValue ( x @ y )
+          | _, _ -> lv2
+        in
+        t, lv
 
     | 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
+        let t, lv = type_expression_lv
+            { 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 lv with
+                | RightValue -> ()
+                | LeftValue list ->
+                    List.iter (function
+                        | AVariable ( vd, _ ) ->
+                            begin
+                              match opt.in_function with
+                              | None -> ()
+                              | Some in_fd ->
+                                  in_fd.function_ops <-
+                                    ( vd, OpCall fd ) :: in_fd.function_ops
+                            end
+                        | _ -> ()) list
+              end;
+
               begin
                 match fd.function_returns with
                 | [t, _id_opt] ->
@@ -1949,7 +1981,8 @@ let preprocess_free_function_definition menv (mlid : absolute LongIdent.t) fd =
       function_is_method = false;
       function_is_primitive = false;
       function_def = Some (fd);
-      function_assigns = [] ;
+      function_ops = [] ;
+      function_purity = PurityUnknown;
     }
   in
   Solidity_tenv_builder.add_module_ident menv id (Function (fd'));