normalizing renaming

This commit is contained in:
Galfour 2019-05-15 21:05:09 +00:00
parent 1029f42aac
commit df1916a1b9
4 changed files with 15 additions and 6 deletions

View File

@ -117,7 +117,7 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
trace (error (thunk "compiling expression") error_message) @@ trace (error (thunk "compiling expression") error_message) @@
match expr' with match expr' with
| E_capture_environment c -> | E_environment_capture c ->
let%bind code = Compiler_environment.pack_select env c in let%bind code = Compiler_environment.pack_select env c in
return @@ code return @@ code
| E_literal v -> | E_literal v ->
@ -173,8 +173,15 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
| _ -> simple_fail "E_applicationing something not appliable" | _ -> simple_fail "E_applicationing something not appliable"
) )
| E_variable x -> | E_variable x ->
let%bind code = Compiler_environment.get env x in let%bind code = Compiler_environment.get env x in
return code 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) -> | E_constant(str, lst) ->
let module L = Logger.Stateful() in let module L = Logger.Stateful() in
let%bind lst' = let%bind lst' =

View File

@ -61,7 +61,7 @@ and value_assoc ppf : (value * value) -> unit = fun (a, b) ->
fprintf ppf "%a -> %a" value a value b fprintf ppf "%a -> %a" value a value b
and expression' ppf (e:expression') = match e with 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_variable v -> fprintf ppf "%s" v
| E_application(a, b) -> fprintf ppf "(%a)@(%a)" expression a expression b | 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 | 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_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)) -> | 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 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) -> | E_let_in ((name , _) , expr , body) ->
fprintf ppf "let %s = %a in %a" name expression expr expression body fprintf ppf "let %s = %a in %a" name expression expr expression body

View File

@ -53,7 +53,7 @@ and selector = var_name list
and expression' = and expression' =
| E_literal of value | E_literal of value
| E_capture_environment of selector | E_environment_capture of selector
| E_constant of string * expression list | E_constant of string * expression list
| E_application of expression * expression | E_application of expression * expression
| E_variable of var_name | E_variable of var_name
@ -64,6 +64,7 @@ and expression' =
| E_if_none of expression * expression * ((var_name * type_value) * 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_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_let_in of ((var_name * type_value) * expression * expression)
| E_sequence of (expression * expression)
and expression = { and expression = {
content : expression' ; content : expression' ;

View File

@ -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 let expr = Expression.make_tpl (E_literal f_literal , tv) in
ok (expr , raw_input , output) in ok (expr , raw_input , output) in
let%bind c_expr = 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 expr = Expression.pair f_expr c_expr in
let tv = Mini_c.t_deep_closure c_env input_tv output_tv in let tv = Mini_c.t_deep_closure c_env input_tv output_tv in
ok @@ Expression.make_tpl (expr , tv) ok @@ Expression.make_tpl (expr , tv)