anormal revise

README.md

@@ -9,6 +9,7 @@ The compiler that:
 
 ## How to Build
 
+At First, do `dune build` (this only needs to be done at the first build).
 By `dune exec ocamyulc <parent>/<dirname>/<filename>.ml`, 
 `.json` file for `<filename>.ml` is generated and saved in `<parent>/contracts` directory.
 

sample/src/simple_hash_if.ml

@@ -0,0 +1,31 @@
+open OCamYul.Primitives
+
+module SimpleHashIf : sig
+  type storage
+  type mut_storage
+
+  val set : address * uint -> storage -> mut_storage -> unit * storage
+  val get : address -> storage -> mut_storage -> uint * storage
+  val set_caller : uint -> storage -> mut_storage -> unit * storage
+end = struct
+  type storage = unit
+  type mut_storage = (address, uint) Hashtbl.t
+
+  let set (x, y) () h =
+    (if true then let a = UInt 2 in let b = UInt 3 in let c = a +^ b in Hashtbl.replace h x y else ()); let a = if false then SInt 1 else SInt 2 in let b = SInt 2 in let c = a + b in 
+    ((), ())
+
+  let get x () h = 
+    let a = 
+      if let c = true in c 
+        then SInt 1 
+        else let b = if false 
+          then SInt 3
+          else SInt 4 in b + b
+    in (Hashtbl.find h x, ())
+
+
+  let set_caller x () h =
+    Hashtbl.replace h (caller ()) x;
+    ((), ())
+end

src/anormal.ml

@@ -26,18 +26,23 @@ let application_mut mut = function
   | _ -> Abi.stronger_mutability Nonpayable mut
 
 let cexp_to_exp e =
+  let open Types in
   match e with
   | AVal v -> Rexp (RVal v)
   | AApp (f, args, t) -> (
-      match Utils.count_vars_in_type t with
-      | Some vars ->
-          Letin
-            ( vars,
-              LApp (f, args),
-              Rexp (RTuple (List.map (fun x -> Var x) vars)) )
-      | None ->
-          let res_var = Utils.fresh_var () in
-          Letin ([ res_var ], LApp (f, args), Rexp (RVal (Var res_var))))
+      let x = (match get_desc t with Tconstr (Path.Pident p, [], _) -> if Ident.name p = "unit" then Some (Seq(LApp (f, args),Rexp (RVal UnitV))) else None| _ -> None) in
+      match x with 
+      Some x' -> x'
+      | _ ->(
+        match Utils.count_vars_in_type t with
+        | Some vars ->
+            Letin
+              ( vars,
+                LApp (f, args),
+                Rexp (RTuple (List.map (fun x -> Var x) vars)) )
+        | None ->
+            let res_var = Utils.fresh_var () in
+            Letin ([ res_var ], LApp (f, args), Rexp (RVal (Var res_var)))))
   | ATuple el -> Rexp (RTuple el)
   | AIf _ -> assert false
 
@@ -66,13 +71,21 @@ let rec remove_tuple rename e mut : exp * Abi.state_mutability =
   | ACexp e' ->
       let e, mut = rename_cexp rename e' mut in
       (match e with 
-      | AIf _ -> (cexp_to_exp e, mut)
+      | AIf (v, e1, e2) -> (
+        let e1', mut1 = remove_tuple rename e1 mut in
+        let e2', mut2 = remove_tuple rename e2 mut in
+        (If(v, e1', e2'), Abi.stronger_mutability mut1 mut2))
       | _ -> (cexp_to_exp e, mut))
   | ASeq (e1, e2) -> (
       match rename_cexp rename e1 mut with
       | AApp (f, args, _), mut ->
           let e, mut = remove_tuple rename e2 mut in
           (Seq (LApp (f, args), e), mut)
+      | AIf (v, e11, e12), mut -> 
+        let e11', mut1 = remove_tuple rename e11 mut in
+        let e12', mut2 = remove_tuple rename e12 mut in 
+        let e, mut = remove_tuple rename e2 (Abi.stronger_mutability mut1 mut2) in
+        (Seq (LIf (v, e11', e12'), e), mut)
       | _ -> assert false)
   | ALetin ((vars, new_rename), e1, e2) -> (
       let rename = new_rename @ rename in

src/normalized_ast.ml

@@ -1,7 +1,5 @@
 open Normalized_common_ast
 
-exception Whoo of int
-
 type resexp = RVal of value | RTuple of value list
 
 type letexp = LVal of value | LApp of (value * value list) | LIf of value * exp * exp

src/ocamyul.ml

@@ -509,7 +509,7 @@ let backend source_file Typedtree.{ structure; _ } =
                            ((dispatcher :: funcs) @ get_default_function_defs ()),
                          None )) )
             in
-            (* print_endline (string_of_yul yul_code) *)
+            (* print_endline (string_of_yul yul_code); *)
             let result_json = json_of_yul abis yul_code contract_name in
             write_json_contract source_file contract_name result_json
         | _ -> raise Not_implemented

src/yul_compile.ml

@@ -12,6 +12,22 @@ let aval_to_yul = function
 let translate_aval_args v =
   match v with UnitV -> None | _ -> Some (aval_to_yul v)
 
+(* The case is divided by whether new variables for the return values are needed.
+   If ret_vars is empty, new variables are needed, and if not, ret_vars is the list of names of return values. *)
+let return_exp vals acc (ret_vars:id list (*option*)) =
+  let vals = List.filter (fun x -> not (x = UnitV)) vals in
+  let rec assign_rets vals acc_exp acc_rets ret_vars'=
+    match vals with
+    | [] -> (acc_exp, acc_rets)
+    | v :: vs ->
+        let ret, ret_vars' = (match ret_vars' with [] -> Utils.fresh_var (), [] | hd :: tl -> hd, tl ) in
+        assign_rets vs
+          (Assign ((ret, []), aval_to_yul v) :: acc_exp)
+          (ret :: acc_rets)
+          ret_vars'
+  in
+  assign_rets vals acc [] ret_vars
+
 let letexp_to_yul = function
   | LVal v -> aval_to_yul v
   | LApp (Var s, vals) ->
@@ -51,34 +67,47 @@ let letexp_to_yul = function
   | LApp (Caller, [ UnitV ]) -> EVM Caller
   | _ -> assert false
 
-let return_exp vals acc =
-  let vals = List.filter (fun x -> not (x = UnitV)) vals in
-  let rec assign_rets vals acc_exp acc_rets =
-    match vals with
-    | [] -> (acc_exp, acc_rets)
-    | v :: vs ->
-        let ret = Utils.fresh_var () in
-        assign_rets vs
-          (Assign ((ret, []), aval_to_yul v) :: acc_exp)
-          (ret :: acc_rets)
-  in
-  assign_rets vals acc []
-
-let rec translate_body_aux e acc =
+  (* an argument "ret_vars" denotes the list of names of return variables.
+  if ret_vars is empty, it means we have to make new variables.*)
+let rec translate_body_aux e acc ret_vars=
   match e with
   | Rexp e' -> (
       match e' with
-      | RTuple vals -> return_exp vals acc
-      | RVal v -> return_exp [ v ] acc)
+      | RTuple vals -> return_exp vals acc ret_vars
+      | RVal v -> return_exp [ v ] acc ret_vars)
   | Seq (e1, e2) ->
-      let acc = Exp (letexp_to_yul e1) :: acc in
-      translate_body_aux e2 acc
+      let acc = (match e1 with LIf (v, e1', e2') -> 
+        let e1_block, _ = translate_body_aux e1' [] [] in
+        let e1_block = List.rev e1_block in
+        let e2_block, _ = translate_body_aux e2' [] ret_vars in
+        let e2_block = List.rev e2_block in
+        let v = aval_to_yul v in
+        Switch (v, [Case(Dec 1, e1_block); Case(Dec 0, e2_block)], Default []) :: acc   (*initialization with 0*)
+        | _ -> Exp (letexp_to_yul e1) :: acc) in
+      (* let acc = Exp (letexp_to_yul e1) :: acc in *)
+      translate_body_aux e2 acc ret_vars
   | Letin (vars, e1, e2) ->
-      let acc = Let ((List.hd vars, List.tl vars), letexp_to_yul e1) :: acc in
-      translate_body_aux e2 acc
+      let a = (match e1 with LIf (v, e1', e2') -> 
+        let e1_block, _ = translate_body_aux e1' [] vars in
+        let e1_block = List.rev e1_block in
+        let e2_block, _ = translate_body_aux e2' [] vars in
+        let e2_block = List.rev e2_block in
+        let v = aval_to_yul v in  
+        let acc = Switch (v, [Case(Dec 1, e1_block); Case(Dec 0, e2_block)], Default []) :: (Let((List.hd vars, List.tl vars), Literal (Dec 0))) :: acc in   (*initialization with 0*)
+        translate_body_aux e2 acc ret_vars
+        |_ -> let acc = Let ((List.hd vars, List.tl vars), letexp_to_yul e1) :: acc in
+        translate_body_aux e2 acc ret_vars) in a
+  | If (v, e1, e2) -> 
+      let e1', vars1 = translate_body_aux e1 acc ret_vars in
+      let e1' = List.rev e1' in
+      let e2', vars2 = translate_body_aux e2 acc vars1 in
+      let e2' = List.rev e2' in
+      assert (vars1 = vars2);
+      let v = aval_to_yul v in
+      Switch (v, [Case(Dec 1, e1'); Case(Dec 0, e2')], Default []) :: acc, vars1
 
 let translate_function_body e =
-  let statements, return_vars = translate_body_aux e [] in
+  let statements, return_vars = translate_body_aux e [] [] in
   (List.rev statements, List.rev return_vars)
 
 let translate_function