From df1916a1b957efa653bc58c770cb97a8f99fb12b Mon Sep 17 00:00:00 2001 From: Galfour Date: Wed, 15 May 2019 21:05:09 +0000 Subject: [PATCH 1/3] normalizing renaming --- src/compiler/compiler_program.ml | 13 ++++++++++--- src/mini_c/PP.ml | 3 ++- src/mini_c/types.ml | 3 ++- src/transpiler/transpiler.ml | 2 +- 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/compiler/compiler_program.ml b/src/compiler/compiler_program.ml index 311095250..f5d808df5 100644 --- a/src/compiler/compiler_program.ml +++ b/src/compiler/compiler_program.ml @@ -117,7 +117,7 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m trace (error (thunk "compiling expression") error_message) @@ match expr' with - | E_capture_environment c -> + | E_environment_capture c -> let%bind code = Compiler_environment.pack_select env c in return @@ code | E_literal v -> @@ -173,8 +173,15 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m | _ -> simple_fail "E_applicationing something not appliable" ) | E_variable x -> - let%bind code = Compiler_environment.get env x in - return code + let%bind code = Compiler_environment.get env x in + return code + | E_sequence (a , b) -> + let%bind (a' , env_a) = translate_expression a env in + let%bind (b' , env_b) = translate_expression b env_a in + return ~env':env_b @@ seq [ + a' ; + b' ; + ] | E_constant(str, lst) -> let module L = Logger.Stateful() in let%bind lst' = diff --git a/src/mini_c/PP.ml b/src/mini_c/PP.ml index a12804f1c..f3506d97d 100644 --- a/src/mini_c/PP.ml +++ b/src/mini_c/PP.ml @@ -61,7 +61,7 @@ and value_assoc ppf : (value * value) -> unit = fun (a, b) -> fprintf ppf "%a -> %a" value a value b and expression' ppf (e:expression') = match e with - | E_capture_environment s -> fprintf ppf "capture(%a)" (list_sep string (const " ; ")) s + | E_environment_capture s -> fprintf ppf "capture(%a)" (list_sep string (const " ; ")) s | E_variable v -> fprintf ppf "%s" v | E_application(a, b) -> fprintf ppf "(%a)@(%a)" expression a expression b | E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst @@ -73,6 +73,7 @@ and expression' ppf (e:expression') = match e with | E_if_none (c, n, ((name, _) , s)) -> fprintf ppf "%a ?? %a : %s -> %a" expression c expression n name expression s | E_if_left (c, ((name_l, _) , l), ((name_r, _) , r)) -> fprintf ppf "%a ?? %s -> %a : %s -> %a" expression c name_l expression l name_r expression r + | E_sequence (a , b) -> fprintf ppf "%a ; %a" expression a expression b | E_let_in ((name , _) , expr , body) -> fprintf ppf "let %s = %a in %a" name expression expr expression body diff --git a/src/mini_c/types.ml b/src/mini_c/types.ml index d6c631a04..fd1b820ce 100644 --- a/src/mini_c/types.ml +++ b/src/mini_c/types.ml @@ -53,7 +53,7 @@ and selector = var_name list and expression' = | E_literal of value - | E_capture_environment of selector + | E_environment_capture of selector | E_constant of string * expression list | E_application of expression * expression | E_variable of var_name @@ -64,6 +64,7 @@ and expression' = | E_if_none of expression * expression * ((var_name * type_value) * expression) | E_if_left of expression * ((var_name * type_value) * expression) * ((var_name * type_value) * expression) | E_let_in of ((var_name * type_value) * expression * expression) + | E_sequence of (expression * expression) and expression = { content : expression' ; diff --git a/src/transpiler/transpiler.ml b/src/transpiler/transpiler.ml index 92046c2db..96192c01b 100644 --- a/src/transpiler/transpiler.ml +++ b/src/transpiler/transpiler.ml @@ -448,7 +448,7 @@ and translate_lambda_deep : Mini_c.Environment.t -> AST.lambda -> Mini_c.express let expr = Expression.make_tpl (E_literal f_literal , tv) in ok (expr , raw_input , output) in let%bind c_expr = - ok @@ Expression.make_tpl (E_capture_environment fv , c_tv) in + ok @@ Expression.make_tpl (E_environment_capture fv , c_tv) in let expr = Expression.pair f_expr c_expr in let tv = Mini_c.t_deep_closure c_env input_tv output_tv in ok @@ Expression.make_tpl (expr , tv) From 32ecf8cfcaaa769ae3e7e74d4fb9deb793332657 Mon Sep 17 00:00:00 2001 From: Galfour Date: Wed, 15 May 2019 22:00:18 +0000 Subject: [PATCH 2/3] add expression constructions to mini_c --- src/compiler/compiler_program.ml | 56 +++++++++++++++++++++++++++++--- src/mini_c/PP.ml | 4 +++ src/mini_c/types.ml | 7 ++-- 3 files changed, 58 insertions(+), 9 deletions(-) diff --git a/src/compiler/compiler_program.ml b/src/compiler/compiler_program.ml index f5d808df5..20ec11cb9 100644 --- a/src/compiler/compiler_program.ml +++ b/src/compiler/compiler_program.ml @@ -86,10 +86,14 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m let (expr' , ty) = Combinators.Expression.(get_content expr , get_type expr) in let error_message () = Format.asprintf "%a" PP.expression expr in - let return ?env' code = - let env' = - let default = env in - Environment.add ("_tmp_expression" , ty) @@ Option.unopt ~default env' in + let return ?prepend_env ?end_env code = + let%bind env' = + match (prepend_env , end_env) with + | (Some _ , Some _) -> simple_fail ("two args to return at " ^ __LOC__) + | None , None -> ok @@ Environment.add ("_tmp_expression" , ty) env + | Some prepend_env , None -> + ok @@ Environment.add ("_tmp_expression" , ty) prepend_env + | None , Some end_env -> ok end_env in let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment env in let%bind output_type = Compiler_type.type_ ty in let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment env' in @@ -120,6 +124,18 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m | E_environment_capture c -> let%bind code = Compiler_environment.pack_select env c in return @@ code + | E_environment_load (expr , load_env) -> + let%bind (expr' , _) = translate_expression expr env in + let%bind clear = Compiler_environment.select env [] in + let%bind unpack = Compiler_environment.unpack load_env in + return ~end_env:load_env @@ seq [ + expr' ; + dip clear ; + unpack ; + ] + | E_environment_select sub_env -> + let%bind code = Compiler_environment.select_env env sub_env in + return ~end_env:sub_env code | E_literal v -> let%bind v = translate_value v in let%bind t = Compiler_type.type_ ty in @@ -178,7 +194,7 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m | E_sequence (a , b) -> let%bind (a' , env_a) = translate_expression a env in let%bind (b' , env_b) = translate_expression b env_a in - return ~env':env_b @@ seq [ + return ~prepend_env:env_b @@ seq [ a' ; b' ; ] @@ -292,6 +308,36 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m ]) in return code ) + | E_assignment (name , lrs , expr) -> ( + let%bind (expr' , env') = translate_expression expr env in + let%bind get_code = Compiler_environment.get env' name in + let modify_code = + let aux acc step = match step with + | `Left -> seq [dip i_unpair ; acc ; i_pair] + | `Right -> seq [dip i_unpiar ; acc ; i_piar] + in + let init = dip i_drop in + List.fold_right' aux init lrs + in + let%bind set_code = Compiler_environment.set env name in + let error = + let title () = "michelson type-checking patch" in + let content () = + let aux ppf = function + | `Left -> Format.fprintf ppf "left" + | `Right -> Format.fprintf ppf "right" in + Format.asprintf "Sub path: %a\n" + PP_helpers.(list_sep aux (const " , ")) lrs + in + error title content in + trace error @@ + return ~end_env:env @@ seq [ + expr' ; + get_code ; + i_swap ; modify_code ; + set_code ; + ] + ) and translate_statement ((s', w_env) as s:statement) : michelson result = let error_message () = Format.asprintf "%a" PP.statement s in diff --git a/src/mini_c/PP.ml b/src/mini_c/PP.ml index f3506d97d..01c058891 100644 --- a/src/mini_c/PP.ml +++ b/src/mini_c/PP.ml @@ -62,6 +62,8 @@ and value_assoc ppf : (value * value) -> unit = fun (a, b) -> and expression' ppf (e:expression') = match e with | E_environment_capture s -> fprintf ppf "capture(%a)" (list_sep string (const " ; ")) s + | E_environment_load (expr , env) -> fprintf ppf "load %a in %a" expression expr environment env + | E_environment_select env -> fprintf ppf "select %a" environment env | E_variable v -> fprintf ppf "%s" v | E_application(a, b) -> fprintf ppf "(%a)@(%a)" expression a expression b | E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst @@ -76,6 +78,8 @@ and expression' ppf (e:expression') = match e with | E_sequence (a , b) -> fprintf ppf "%a ; %a" expression a expression b | E_let_in ((name , _) , expr , body) -> fprintf ppf "let %s = %a in %a" name expression expr expression body + | E_assignment (r , path , e) -> + fprintf ppf "%s.%a := %a" r (list_sep lr (const ".")) path expression e and expression : _ -> expression -> _ = fun ppf e -> expression' ppf e.content diff --git a/src/mini_c/types.ml b/src/mini_c/types.ml index fd1b820ce..dfe4066ab 100644 --- a/src/mini_c/types.ml +++ b/src/mini_c/types.ml @@ -54,6 +54,8 @@ and selector = var_name list and expression' = | E_literal of value | E_environment_capture of selector + | E_environment_select of environment + | E_environment_load of (expression * environment) | E_constant of string * expression list | E_application of expression * expression | E_variable of var_name @@ -65,6 +67,7 @@ and expression' = | E_if_left of expression * ((var_name * type_value) * expression) * ((var_name * type_value) * expression) | E_let_in of ((var_name * type_value) * expression * expression) | E_sequence of (expression * expression) + | E_assignment of (string * [`Left | `Right] list * expression) and expression = { content : expression' ; @@ -98,10 +101,6 @@ and anon_function = { result : expression ; } -and capture = - | No_capture (* For functions that don't capture their environments. Quotes. *) - | Deep_capture of environment (* Retrieves only the values it needs. Multiple SETs on init. Lighter GETs and SETs at use. *) - and block' = statement list and block = block' * environment_wrap From 4e76b5344d3ef5da55e3e4e5e8e4a48e617b09b6 Mon Sep 17 00:00:00 2001 From: Galfour Date: Thu, 16 May 2019 08:12:53 +0000 Subject: [PATCH 3/3] add last expressions in mini_c --- src/compiler/compiler_program.ml | 12 ++++++++++++ src/mini_c/PP.ml | 2 ++ src/mini_c/types.ml | 1 + 3 files changed, 15 insertions(+) diff --git a/src/compiler/compiler_program.ml b/src/compiler/compiler_program.ml index 20ec11cb9..2e572fe98 100644 --- a/src/compiler/compiler_program.ml +++ b/src/compiler/compiler_program.ml @@ -338,6 +338,18 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m set_code ; ] ) + | E_while (expr, block) -> ( + let%bind (expr' , env') = translate_expression expr env in + let%bind (block' , env'') = translate_expression block env' in + let%bind restrict_block = Compiler_environment.select_env env'' env' in + return @@ seq [ + expr' ; + prim ~children:[seq [ + block' ; + restrict_block ; + expr']] I_LOOP ; + ] + ) and translate_statement ((s', w_env) as s:statement) : michelson result = let error_message () = Format.asprintf "%a" PP.statement s in diff --git a/src/mini_c/PP.ml b/src/mini_c/PP.ml index 01c058891..6209a624a 100644 --- a/src/mini_c/PP.ml +++ b/src/mini_c/PP.ml @@ -80,6 +80,8 @@ and expression' ppf (e:expression') = match e with fprintf ppf "let %s = %a in %a" name expression expr expression body | E_assignment (r , path , e) -> fprintf ppf "%s.%a := %a" r (list_sep lr (const ".")) path expression e + | E_while (e , b) -> + fprintf ppf "while (%a) %a" expression e expression b and expression : _ -> expression -> _ = fun ppf e -> expression' ppf e.content diff --git a/src/mini_c/types.ml b/src/mini_c/types.ml index dfe4066ab..456770d23 100644 --- a/src/mini_c/types.ml +++ b/src/mini_c/types.ml @@ -68,6 +68,7 @@ and expression' = | E_let_in of ((var_name * type_value) * expression * expression) | E_sequence of (expression * expression) | E_assignment of (string * [`Left | `Right] list * expression) + | E_while of expression * expression and expression = { content : expression' ;