balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

remove environments from mini_c

Browse Source
This commit is contained in:
Galfour 2019-05-15 18:16:28 +00:00
parent d433dd85fc
commit 7a5130f51f
6 changed files with 39 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/compiler/compiler_program.ml
View File

@ -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 [

15
src/mini_c/combinators.ml
View File

@ -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

1
src/mini_c/types.ml
View File

@ -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 ;
}

1
src/parser/ligodity/Version.ml Normal file
View File

@ -0,0 +1 @@
let version = "UNKNOWN"

10
src/test/compiler_tests.ml
View File

@ -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

30
src/transpiler/transpiler.ml
View File

@ -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") @@