diff --git a/src/anormal.ml b/src/anormal.ml index f4635b2..35e6855 100644 --- a/src/anormal.ml +++ b/src/anormal.ml @@ -25,19 +25,6 @@ let application_mut mut = function | Bop _ | HashFind | Caller -> Abi.stronger_mutability View mut | _ -> Abi.stronger_mutability Nonpayable mut -let rename_cexp rename e mut = - match e with - | AVal (Var id) -> ( - match List.find_opt (fun (x, _) -> x = id) rename with - | Some (_, ids) -> (ATuple (List.map (fun x -> Var x) ids), mut) - | None -> (AVal (Var id), mut)) - | AApp (f, args, t) -> - let mut = application_mut mut f in - (AApp (f, rename_avals rename args, t), mut) - | ATuple el -> (ATuple (rename_avals rename el), mut) - | AIf _ -> assert false - | _ -> (e, mut) - let cexp_to_exp e = match e with | AVal v -> Rexp (RVal v) @@ -54,11 +41,33 @@ let cexp_to_exp e = | ATuple el -> Rexp (RTuple el) | AIf _ -> assert false -let rec remove_tuple rename e mut = +let rename_cexp rename e mut = + match e with + | AVal (Var id) -> ( + match List.find_opt (fun (x, _) -> x = id) rename with + | Some (_, ids) -> (ATuple (List.map (fun x -> Var x) ids), mut) + | None -> (AVal (Var id), mut)) + | AApp (f, args, t) -> + let mut = application_mut mut f in + (AApp (f, rename_avals rename args, t), mut) + | ATuple el -> (ATuple (rename_avals rename el), mut) + | AIf (v, e1, e2) -> + let v2 = match v with + | Var id -> ( + let v2' = match List.find_opt (fun (x, _) -> x = id) rename with + | Some (_, ids) -> (match ids with [v] -> Var v | _ -> assert false) + | None -> Var id in v2') + | _ -> v in + (AIf (v2, e1, e2), mut) + | _ -> (e, mut) + +let rec remove_tuple rename e mut : exp * Abi.state_mutability = match e with | ACexp e' -> let e, mut = rename_cexp rename e' mut in - (cexp_to_exp e, mut) + (match e with + | AIf _ -> (cexp_to_exp e, mut) + | _ -> (cexp_to_exp e, mut)) | ASeq (e1, e2) -> ( match rename_cexp rename e1 mut with | AApp (f, args, _), mut -> @@ -80,7 +89,10 @@ let rec remove_tuple rename e mut = (gen_tuple_let (vars, el), mut) | AVal arg -> (Letin (vars, LVal arg, e2'), mut) | AApp (f, args, _) -> (Letin (vars, LApp (f, args), e2'), mut) - | AIf _ -> assert false) + | AIf (v, e1'', e2'') -> + let e3, mut1 = remove_tuple rename e1'' mut in + let e4, mut2 = remove_tuple rename e2'' mut in + (Letin (vars, LIf(v, e3, e4), e2'), Abi.stronger_mutability mut1 mut2)) let normalize { name = func_name; arg_pats = args; body; mutability = mut } = let renames, args = diff --git a/src/anormal_ir.ml b/src/anormal_ir.ml index 84e11ed..1fcb5fc 100644 --- a/src/anormal_ir.ml +++ b/src/anormal_ir.ml @@ -35,7 +35,7 @@ let pdot_to_aval p s = | _ -> assert false (* The first argument p is a storage. To check whether the storage changes, it is needed. - The last argument k is a continue. A first argument of k is hole, and a first element of a return value is AST with the hole.*) + The last argument k is a continuation. A first argument of k is hole, and a first element of a return value is AST with the hole.*) let rec normalize_aux p { exp_desc = e; exp_type = t; _ } k :aexp * bool= match e with | Texp_ident (Pident s, _, _) -> @@ -105,13 +105,10 @@ let rec normalize_aux p { exp_desc = e; exp_type = t; _ } k :aexp * bool= let a, b = normalize_aux p e2 (fun (x, _, b) -> (ACexp x, b)) in let e3' = match e3 with Some e -> e | _ -> assert false in let a2, b2 = normalize_aux p e3' (fun (x, _, b) -> (ACexp x, b)) in - normalize_name e1 (fun x -> k (AIf(x, a, a2), t, b && b2 )) + let a, b = normalize_name e1 (fun x -> k (AIf(x, a, a2), t, b && b2 )) in + a, b | _ -> assert false - (* | A.If(e1,e2,e3) -> - normalize_name e1 (fun x -> - k (A.If(x, normalize e2 id, normalize e3 id))) *) - (* when a new variable is needed *) and normalize_name e k = normalize_aux None e (fun (e', t, _) -> diff --git a/src/normalized_ast.ml b/src/normalized_ast.ml index 1b36a5c..5805c4c 100644 --- a/src/normalized_ast.ml +++ b/src/normalized_ast.ml @@ -1,12 +1,17 @@ open Normalized_common_ast -type letexp = LVal of value | LApp of (value * value list) +exception Whoo of int + type resexp = RVal of value | RTuple of value list -type exp = +type letexp = LVal of value | LApp of (value * value list) | LIf of value * exp * exp + +and exp = | Rexp of resexp | Seq of letexp * exp | Letin of string list * letexp * exp + | If of value * exp * exp + type decl = { name : Ident.t; @@ -15,12 +20,6 @@ type decl = { mutability : Abi.state_mutability; } -let string_of_letexp = function - | LVal v -> string_of_value v - | LApp (f, xs) -> - string_of_value f - ^ List.fold_left (fun acc x -> acc ^ " " ^ string_of_value x) "" xs - let string_of_resexp = function | RVal v -> string_of_value v | RTuple vs -> @@ -28,7 +27,13 @@ let string_of_resexp = function ^ List.fold_left (fun acc x -> acc ^ ", " ^ string_of_value x) "" vs ^ ")" -let rec string_of_exp e = +let rec string_of_letexp = function + | LVal v -> string_of_value v + | LApp (f, xs) -> + string_of_value f + ^ List.fold_left (fun acc x -> acc ^ " " ^ string_of_value x) "" xs + | LIf (v, e1, e2) -> "if " ^ string_of_value v ^ " then " ^ string_of_exp e1 ^ " else " ^ string_of_exp e2 +and string_of_exp e = match e with | Rexp e -> string_of_resexp e | Seq (e1, e2) -> string_of_letexp e1 ^ "; " ^ string_of_exp e2 @@ -36,6 +41,9 @@ let rec string_of_exp e = "let" ^ List.fold_left (fun acc x -> acc ^ ", " ^ x) "" vars ^ " = " ^ string_of_letexp e1 ^ " in " ^ string_of_exp e2 + | If (v, e1, e2) -> "if " ^ string_of_value v ^ " then " ^ string_of_exp e1 ^ " else " ^ string_of_exp e2 + + let string_of_decl { name = func_name; arg_ids = args; body = e; mutability = mut } = diff --git a/src/normalized_ast.mli b/src/normalized_ast.mli index fef94e6..c81a7ca 100644 --- a/src/normalized_ast.mli +++ b/src/normalized_ast.mli @@ -1,15 +1,17 @@ open Normalized_common_ast -(** expressions that can be placed at the right-hand side of a let-binding *) -type letexp = LVal of value | LApp of (value * value list) + (** expressions that can be placed at the last of let-binding sequences *) type resexp = RVal of value | RTuple of value list +(** expressions that can be placed at the right-hand side of a let-binding *) +type letexp = LVal of value | LApp of (value * value list) | LIf of value * exp * exp -type exp = +and exp = | Rexp of resexp | Seq of letexp * exp | Letin of string list * letexp * exp + | If of value * exp * exp (** a function declaration with stateMutability field of ABI *) type decl = {