From 7a5130f51fa2d03448407038a07be208891286db Mon Sep 17 00:00:00 2001 From: Galfour Date: Wed, 15 May 2019 18:16:28 +0000 Subject: [PATCH] remove environments from mini_c --- src/compiler/compiler_program.ml | 21 ++++++++++++--------- src/mini_c/combinators.ml | 15 ++++++--------- src/mini_c/types.ml | 1 - src/parser/ligodity/Version.ml | 1 + src/test/compiler_tests.ml | 10 +++++----- src/transpiler/transpiler.ml | 30 +++++++++++++++--------------- 6 files changed, 39 insertions(+), 39 deletions(-) create mode 100644 src/parser/ligodity/Version.ml diff --git a/src/compiler/compiler_program.ml b/src/compiler/compiler_program.ml index 174f5d684..f7b66b3b7 100644 --- a/src/compiler/compiler_program.ml +++ b/src/compiler/compiler_program.ml @@ -233,11 +233,12 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m ]) in return code ) - | E_if_none (c, n, (_ , s)) -> ( + | E_if_none (c, n, (ntv , s)) -> ( let%bind (c' , _env') = translate_expression c env in - let%bind (n' , _) = translate_expression n n.environment in - let%bind (s' , _) = translate_expression s s.environment in - let%bind restrict_s = Compiler_environment.select_env s.environment env in + let%bind (n' , _) = translate_expression n env in + let s_env = Environment.add ntv env in + let%bind (s' , _) = translate_expression s s_env in + let%bind restrict_s = Compiler_environment.select_env s_env env in let%bind code = ok (seq [ c' ; i_if_none n' (seq [ @@ -248,12 +249,14 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m ]) in return code ) - | E_if_left (c, (_ , l), (_ , r)) -> ( + | E_if_left (c, (l_ntv , l), (r_ntv , r)) -> ( let%bind (c' , _env') = translate_expression c env in - let%bind (l' , _) = translate_expression l l.environment in - let%bind (r' , _) = translate_expression r r.environment in - let%bind restrict_l = Compiler_environment.select_env l.environment env in - let%bind restrict_r = Compiler_environment.select_env r.environment env in + let l_env = Environment.add l_ntv env in + let%bind (l' , _) = translate_expression l l_env in + let r_env = Environment.add r_ntv env in + let%bind (r' , _) = translate_expression r r_env in + let%bind restrict_l = Compiler_environment.select_env l_env env in + let%bind restrict_r = Compiler_environment.select_env r_env env in let%bind code = ok (seq [ c' ; i_if_left (seq [ diff --git a/src/mini_c/combinators.ml b/src/mini_c/combinators.ml index 5f5a061fb..e076cce53 100644 --- a/src/mini_c/combinators.ml +++ b/src/mini_c/combinators.ml @@ -7,20 +7,17 @@ module Expression = struct let get_content : t -> t' = fun e -> e.content let get_type : t -> type_value = fun e -> e.type_value - let get_environment : t -> environment = fun e -> e.environment let is_toplevel : t -> bool = fun e -> e.is_toplevel - let make = fun ?(itl = false) e' t env -> { + let make = fun ?(itl = false) e' t -> { content = e' ; type_value = t ; - environment = env ; is_toplevel = itl ; } - let make_tpl = fun ?(itl = false) (e' , t , env) -> { + let make_tpl = fun ?(itl = false) (e' , t) -> { content = e' ; type_value = t ; - environment = env ; is_toplevel = itl ; } @@ -145,15 +142,15 @@ let quote binder input output body result : anon_function = } let basic_quote i o b : anon_function result = - let%bind (_, e) = get_last_statement b in - let r : expression = Expression.make_tpl (E_variable "output", o, e.post_environment) in + let%bind (_, _e) = get_last_statement b in + let r : expression = Expression.make_tpl (E_variable "output", o) in ok @@ quote "input" i o b r let basic_int_quote b : anon_function result = basic_quote t_int t_int b -let e_int expr env : expression = Expression.make_tpl (expr, t_int, env) -let e_var_int name env : expression = e_int (E_variable name) env +let e_int expr : expression = Expression.make_tpl (expr, t_int) +let e_var_int name : expression = e_int (E_variable name) let d_unit : value = D_unit diff --git a/src/mini_c/types.ml b/src/mini_c/types.ml index d37fb4daf..d8971c9ca 100644 --- a/src/mini_c/types.ml +++ b/src/mini_c/types.ml @@ -68,7 +68,6 @@ and expression' = and expression = { content : expression' ; type_value : type_value ; - environment : environment ; (* Environment in which the expressions are evaluated *) is_toplevel : bool ; } diff --git a/src/parser/ligodity/Version.ml b/src/parser/ligodity/Version.ml new file mode 100644 index 000000000..d89964cb1 --- /dev/null +++ b/src/parser/ligodity/Version.ml @@ -0,0 +1 @@ +let version = "UNKNOWN" diff --git a/src/test/compiler_tests.ml b/src/test/compiler_tests.ml index c13fcb997..a6db44def 100644 --- a/src/test/compiler_tests.ml +++ b/src/test/compiler_tests.ml @@ -12,7 +12,7 @@ let run_entry_int (e:anon_function) (n:int) : int result = let identity () : unit result = let e = basic_int_quote_env in - let s = statement (S_declaration ("output", e_var_int "input" e)) e in + let s = statement (S_declaration ("output", e_var_int "input")) e in let%bind b = block [s] in let%bind f = basic_int_quote b in let%bind result = run_entry_int f 42 in @@ -27,10 +27,10 @@ let multiple_vars () : unit result = Yes. One could do a monad. Feel free when we have the time. *) let ss = statements [ - (fun e -> statement (S_declaration ("a", e_var_int "input" e)) e) ; - (fun e -> statement (S_declaration ("b", e_var_int "input" e)) e) ; - (fun e -> statement (S_declaration ("c", e_var_int "a" e)) e) ; - (fun e -> statement (S_declaration ("output", e_var_int "c" e)) e) ; + (fun e -> statement (S_declaration ("a", e_var_int "input")) e) ; + (fun e -> statement (S_declaration ("b", e_var_int "input")) e) ; + (fun e -> statement (S_declaration ("c", e_var_int "a")) e) ; + (fun e -> statement (S_declaration ("output", e_var_int "c")) e) ; ] e in let%bind b = block ss in let%bind f = basic_int_quote b in diff --git a/src/transpiler/transpiler.ml b/src/transpiler/transpiler.ml index 0f029f47c..658b4da9c 100644 --- a/src/transpiler/transpiler.ml +++ b/src/transpiler/transpiler.ml @@ -230,9 +230,9 @@ and tree_of_sum : AST.type_value -> (type_name * AST.type_value) Append_tree.t r and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_expression) : expression result = let%bind tv = translate_type ae.type_annotation in - let return ?(tv = tv) ?(env = env) expr = + let return ?(tv = tv) expr = (* let%bind env' = transpile_environment ae.environment in *) - ok @@ Combinators.Expression.make_tpl (expr, tv, env) in + ok @@ Combinators.Expression.make_tpl (expr, tv) in let f = translate_annotated_expression env in match ae.expression with | E_failwith ae -> ( @@ -269,8 +269,8 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express match (a, b) with | (None, a), (None, b) -> ok (None, T_or (a, b)) | (Some _, _), (Some _, _) -> simple_fail "several identical constructors in the same variant (shouldn't happen here)" - | (Some v, a), (None, b) -> ok (Some (E_constant ("LEFT", [Combinators.Expression.make_tpl (v, a, env)])), T_or (a, b)) - | (None, a), (Some v, b) -> ok (Some (E_constant ("RIGHT", [Combinators.Expression.make_tpl (v, b, env)])), T_or (a, b)) + | (Some v, a), (None, b) -> ok (Some (E_constant ("LEFT", [Combinators.Expression.make_tpl (v, a)])), T_or (a, b)) + | (None, a), (Some v, b) -> ok (Some (E_constant ("RIGHT", [Combinators.Expression.make_tpl (v, b)])), T_or (a, b)) in let%bind (ae_opt, tv) = Append_tree.fold_ne leaf node node_tv in let%bind ae = @@ -297,7 +297,7 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express let c = match lr with | `Left -> "CAR" | `Right -> "CDR" in - Combinators.Expression.make_tpl (E_constant (c, [pred]) , ty , env) in + Combinators.Expression.make_tpl (E_constant (c, [pred]) , ty) in let%bind tpl' = translate_annotated_expression env tpl in let expr = List.fold_left aux tpl' path in ok expr @@ -321,7 +321,7 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express let c = match lr with | `Left -> "CAR" | `Right -> "CDR" in - Combinators.Expression.make_tpl (E_constant (c, [pred]) , ty , env) in + Combinators.Expression.make_tpl (E_constant (c, [pred]) , ty) in let%bind record' = translate_annotated_expression env record in let expr = List.fold_left aux record' path in ok expr @@ -396,24 +396,24 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express List.find_opt (fun ((constructor_name' , _) , _) -> constructor_name' = constructor_name) lst in let env' = Environment.(add (name , tv) env) in let%bind body' = translate_annotated_expression env' body in - return ~env @@ E_let_in ((name , tv) , top , body') + return @@ E_let_in ((name , tv) , top , body') ) | ((`Node (a , b)) , tv) -> let%bind a' = let%bind a_ty = get_t_left tv in let a_var = "left" , a_ty in let env' = Environment.(add a_var env) in - let%bind e = aux (((Expression.make (E_variable "left") a_ty env')) , env') a in + let%bind e = aux (((Expression.make (E_variable "left") a_ty)) , env') a in ok (a_var , e) in let%bind b' = let%bind b_ty = get_t_right tv in let b_var = "right" , b_ty in let env' = Environment.(add b_var env) in - let%bind e = aux (((Expression.make (E_variable "right") b_ty env')) , env') b in + let%bind e = aux (((Expression.make (E_variable "right") b_ty)) , env') b in ok (b_var , e) in - return ~env @@ E_if_left (top , a' , b') + return @@ E_if_left (top , a' , b') in aux (expr' , env) tree'' ) @@ -437,7 +437,7 @@ and translate_lambda_deep : Mini_c.Environment.t -> AST.lambda -> Mini_c.express let%bind (statements , body_env) = translate_block init_env body in let body = let load_env = Environment.(add ("closure_arg" , input) empty) in - let load_expr = Expression.make_tpl (E_variable "closure_arg" , input , load_env) in + let load_expr = Expression.make_tpl (E_variable "closure_arg" , input) in let load_st = Mini_c.statement (S_environment_load (load_expr , init_env)) load_env in let statements' = load_st :: statements in (statements' , body_env) @@ -445,13 +445,13 @@ and translate_lambda_deep : Mini_c.Environment.t -> AST.lambda -> Mini_c.express let%bind result = translate_annotated_expression body_env.post_environment result in let tv = Mini_c.t_function input output in let f_literal = D_function { binder ; input ; output ; body ; result } in - let expr = Expression.make_tpl (E_literal f_literal , tv , env) in + 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 , env) in + ok @@ Expression.make_tpl (E_capture_environment 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 , env) + ok @@ Expression.make_tpl (expr , tv) and translate_lambda env l = let { binder ; input_type ; output_type ; body ; result } : AST.lambda = l in @@ -473,7 +473,7 @@ and translate_lambda env l = let%bind output = translate_type output_type in let tv = Combinators.t_function input output in let content = D_function {binder;input;output;body=body';result=result'} in - ok @@ Combinators.Expression.make_tpl (E_literal content, tv, env) + ok @@ Combinators.Expression.make_tpl (E_literal content, tv) ) | _ -> ( trace (simple_error "translate lambda deep") @@