From c46210b656040c9e7a306d7f62b23a319e0eca08 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Wed, 8 Apr 2020 18:00:03 +0200 Subject: [PATCH] fix order --- .../2-concrete_to_imperative/cameligo.ml | 12 +- .../imperative_to_sugar.ml | 273 +++++++++--------- src/stages/2-ast_sugar/combinators.ml | 2 +- src/stages/2-ast_sugar/combinators.mli | 2 +- 4 files changed, 150 insertions(+), 139 deletions(-) diff --git a/src/passes/2-concrete_to_imperative/cameligo.ml b/src/passes/2-concrete_to_imperative/cameligo.ml index b4b35187f..a0a8a55bd 100644 --- a/src/passes/2-concrete_to_imperative/cameligo.ml +++ b/src/passes/2-concrete_to_imperative/cameligo.ml @@ -634,15 +634,15 @@ let rec compile_expression : | ESeq s -> ( let (s , loc) = r_split s in let items : Raw.expr list = pseq_to_list s.elements in - (match items with + (match List.rev items with [] -> return @@ e_skip ~loc () | expr::more -> let expr' = compile_expression expr in - let apply (e1: Raw.expr) (e2: expression Trace.result) = - let%bind a = compile_expression e1 in - let%bind e2' = e2 in - return @@ e_sequence a e2' - in List.fold_right apply more expr') + let apply e1 e2 = + let%bind a = compile_expression e2 in + let%bind e1' = e1 in + return @@ e_sequence a e1' + in List.fold_left apply expr' more) ) | ECond c -> ( let (c , loc) = r_split c in diff --git a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml index 75f8906fb..055f53ed4 100644 --- a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml +++ b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml @@ -102,12 +102,14 @@ and store_mutable_variable (free_vars : I.expression_variable list) = let aux var = (O.Label (Var.to_name var), O.e_variable var) in O.e_record @@ O.LMap.of_list (List.map aux free_vars) -and restore_mutable_variable (expr : O.expression->O.expression_content) (free_vars : O.expression_variable list) (env : O.expression_variable) = +and restore_mutable_variable (expr : O.expression->O.expression) (free_vars : O.expression_variable list) (env : O.expression_variable) = let aux (f: O.expression -> O.expression) (ev: O.expression_variable) = fun expr -> f (O.e_let_in (ev,None) true false (O.e_record_accessor (O.e_variable env) (Label (Var.to_name ev))) expr) in let ef = List.fold_left aux (fun e -> e) free_vars in - expr (ef (O.e_skip ())) + fun e -> match e with + | None -> expr (ef (O.e_skip ())) + | Some e -> expr (ef e) let rec compile_type_expression : I.type_expression -> O.type_expression result = @@ -189,79 +191,88 @@ and compile_type_operator : I.type_operator -> O.type_operator result = let rec compile_expression : I.expression -> O.expression result = fun e -> - let return expr = ok @@ O.make_e ~loc:e.location expr in + let%bind e = compile_expression' e in + ok @@ e None + +and compile_expression' : I.expression -> (O.expression option -> O.expression) result = + fun e -> + let return expr = ok @@ function + | None -> expr + | Some e -> O.e_sequence expr e + in + let loc = e.location in match e.expression_content with - | I.E_literal literal -> return @@ O.E_literal literal + | I.E_literal literal -> return @@ O.e_literal ~loc literal | I.E_constant {cons_name;arguments} -> let%bind arguments = bind_map_list compile_expression arguments in - return @@ O.E_constant {cons_name;arguments} - | I.E_variable name -> return @@ O.E_variable name + return @@ O.e_constant ~loc cons_name arguments + | I.E_variable name -> return @@ O.e_variable ~loc name | I.E_application {lamb;args} -> let%bind lamb = compile_expression lamb in let%bind args = compile_expression args in - return @@ O.E_application {lamb;args} + return @@ O.e_application ~loc lamb args | I.E_lambda lambda -> let%bind lambda = compile_lambda lambda in - return @@ O.E_lambda lambda + return @@ O.make_e ~loc (O.E_lambda lambda) | I.E_recursive {fun_name;fun_type;lambda} -> let%bind fun_type = compile_type_expression fun_type in let%bind lambda = compile_lambda lambda in - return @@ O.E_recursive {fun_name;fun_type;lambda} + return @@ O.e_recursive ~loc fun_name fun_type lambda | I.E_let_in {let_binder;inline;rhs;let_result} -> let (binder,ty_opt) = let_binder in let%bind ty_opt = bind_map_option compile_type_expression ty_opt in let%bind rhs = compile_expression rhs in let%bind let_result = compile_expression let_result in - return @@ O.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result} + return @@ O.e_let_in ~loc (binder,ty_opt) false inline rhs let_result | I.E_constructor {constructor;element} -> let%bind element = compile_expression element in - return @@ O.E_constructor {constructor;element} + return @@ O.e_constructor ~loc constructor element | I.E_matching m -> let%bind m = compile_matching m in - return @@ m + ok @@ m | I.E_record record -> let record = I.LMap.to_kv_list record in let%bind record = bind_map_list (fun (k,v) -> - let%bind v =compile_expression v in + let%bind v = compile_expression v in ok @@ (k,v) ) record in - return @@ O.E_record (O.LMap.of_list record) + return @@ O.e_record ~loc (O.LMap.of_list record) | I.E_record_accessor {record;path} -> let%bind record = compile_expression record in - return @@ O.E_record_accessor {record;path} + return @@ O.e_record_accessor ~loc record path | I.E_record_update {record;path;update} -> let%bind record = compile_expression record in let%bind update = compile_expression update in - return @@ O.E_record_update {record;path;update} + return @@ O.e_record_update ~loc record path update | I.E_map map -> let%bind map = bind_map_list ( bind_map_pair compile_expression ) map in - return @@ O.E_map map + return @@ O.e_map ~loc map | I.E_big_map big_map -> let%bind big_map = bind_map_list ( bind_map_pair compile_expression ) big_map in - return @@ O.E_big_map big_map + return @@ O.e_big_map ~loc big_map | I.E_list lst -> let%bind lst = bind_map_list compile_expression lst in - return @@ O.E_list lst + return @@ O.e_list ~loc lst | I.E_set set -> let%bind set = bind_map_list compile_expression set in - return @@ O.E_set set + return @@ O.e_set ~loc set | I.E_look_up look_up -> - let%bind look_up = bind_map_pair compile_expression look_up in - return @@ O.E_look_up look_up + let%bind (a,b) = bind_map_pair compile_expression look_up in + return @@ O.e_look_up ~loc a b | I.E_ascription {anno_expr; type_annotation} -> let%bind anno_expr = compile_expression anno_expr in let%bind type_annotation = compile_type_expression type_annotation in - return @@ O.E_ascription {anno_expr; type_annotation} + return @@ O.e_annotation ~loc anno_expr type_annotation | I.E_cond {condition;then_clause;else_clause} -> - let%bind condition = compile_expression condition in + let%bind condition = compile_expression condition in let%bind then_clause' = compile_expression then_clause in let%bind else_clause' = compile_expression else_clause in let env = Var.fresh () in @@ -274,71 +285,73 @@ let rec compile_expression : I.expression -> O.expression result = if (List.length free_vars != 0) then let cond_expr = O.e_cond condition then_clause else_clause in let return_expr = fun expr -> - O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars); - let_result=O.e_let_in (env,None) false false cond_expr @@ + O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@ + O.e_let_in (env,None) false false cond_expr @@ expr - } in - return @@ restore_mutable_variable return_expr free_vars env + ok @@ restore_mutable_variable return_expr free_vars env else - return @@ O.E_cond {condition; then_clause=then_clause'; else_clause=else_clause'} + return @@ O.e_cond ~loc condition then_clause' else_clause' | I.E_sequence {expr1; expr2} -> - let%bind expr1 = compile_expression expr1 in - let%bind expr2 = compile_expression expr2 in - ok @@ add_to_end expr1 expr2 - | I.E_skip -> return @@ O.E_skip + let%bind expr1 = compile_expression' expr1 in + let%bind expr2 = compile_expression' expr2 in + ok @@ fun e -> (match e with + | None -> expr1 (Some (expr2 None)) + | Some e -> expr1 (Some (expr2 (Some e))) + ) + | I.E_skip -> return @@ O.e_skip ~loc () | I.E_tuple tuple -> let%bind tuple = bind_map_list compile_expression tuple in - return @@ O.E_tuple (tuple) + return @@ O.e_tuple ~loc tuple | I.E_tuple_accessor {tuple;path} -> let%bind tuple = compile_expression tuple in - return @@ O.E_tuple_accessor {tuple;path} + return @@ O.e_tuple_accessor ~loc tuple path | I.E_tuple_update {tuple;path;update} -> let%bind tuple = compile_expression tuple in let%bind update = compile_expression update in - return @@ O.E_tuple_update {tuple;path;update} - | I.E_assign ass -> - let%bind content = compile_assign ass @@ O.e_skip () in - return @@ content + return @@ O.e_tuple_update ~loc tuple path update + | I.E_assign {variable; access_path; expression} -> + let accessor ?loc s a = + match a with + I.Access_tuple _i -> failwith "adding tuple soon" + | I.Access_record a -> ok @@ O.e_record_accessor ?loc s (Label a) + | I.Access_map k -> + let%bind k = compile_expression k in + ok @@ O.e_constant ?loc C_MAP_FIND_OPT [k;s] + in + let update ?loc (s:O.expression) a e = + match a with + I.Access_tuple _i -> failwith "adding tuple soon" + | I.Access_record a -> ok @@ O.e_record_update ?loc s (Label a) e + | I.Access_map k -> + let%bind k = compile_expression k in + ok @@ O.e_constant ?loc C_UPDATE [k;O.e_some (e);s] + in + let aux (s, e : O.expression * _) lst = + let%bind s' = accessor ~loc:s.location s lst in + let e' = fun expr -> + let%bind u = update ~loc:s.location s lst (expr) + in e u + in + ok @@ (s',e') + in + let%bind (_,rhs) = bind_fold_list aux (O.e_variable variable, fun e -> ok @@ e) access_path in + let%bind expression = compile_expression expression in + let%bind rhs = rhs @@ expression in + ok @@ fun expr -> (match expr with + | None -> O.e_let_in ~loc (variable,None) true false rhs (O.e_skip ()) + | Some e -> O.e_let_in ~loc (variable, None) true false rhs e + ) | I.E_for f -> let%bind f = compile_for f in - return @@ f + ok @@ f | I.E_for_each fe -> let%bind fe = compile_for_each fe in - return @@ fe + ok @@ fe | I.E_while w -> let%bind w = compile_while w in - return @@ w + ok @@ w -and compile_assign {variable; access_path; expression} expr = - let accessor ?loc s a = - match a with - I.Access_tuple _i -> failwith "adding tuple soon" - | I.Access_record a -> ok @@ O.e_record_accessor ?loc s (Label a) - | I.Access_map k -> - let%bind k = compile_expression k in - ok @@ O.e_constant ?loc C_MAP_FIND_OPT [k;s] - in - let update ?loc (s:O.expression) a e = - match a with - I.Access_tuple _i -> failwith "adding tuple soon" - | I.Access_record a -> ok @@ O.e_record_update ?loc s (Label a) e - | I.Access_map k -> - let%bind k = compile_expression k in - ok @@ O.e_constant ?loc C_UPDATE [k;O.e_some (e);s] - in - let aux (s, e : O.expression * _) lst = - let%bind s' = accessor ~loc:s.location s lst in - let e' = fun expr -> - let%bind u = update ~loc:s.location s lst (expr) - in e u - in - ok @@ (s',e') - in - let%bind (_,rhs) = bind_fold_list aux (O.e_variable variable, fun e -> ok @@ e) access_path in - let%bind expression = compile_expression expression in - let%bind rhs = rhs @@ expression in - ok @@ O.E_let_in {let_binder=(variable,None); mut=true; rhs; let_result=expr;inline = false} and compile_lambda : I.lambda -> O.lambda result = fun {binder;input_type;output_type;result}-> @@ -347,8 +360,12 @@ and compile_lambda : I.lambda -> O.lambda result = let%bind result = compile_expression result in ok @@ O.{binder;input_type;output_type;result} -and compile_matching : I.matching -> O.expression_content result = +and compile_matching : I.matching -> (O.expression option -> O.expression) result = fun {matchee;cases} -> + let return expr = ok @@ function + | None -> expr + | Some e -> O.e_sequence expr e + in let%bind matchee = compile_expression matchee in match cases with | I.Match_bool {match_true;match_false} -> @@ -364,14 +381,13 @@ and compile_matching : I.matching -> O.expression_content result = if (List.length free_vars != 0) then let match_expr = O.e_matching matchee (O.Match_bool {match_true; match_false}) in let return_expr = fun expr -> - O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars); - let_result=O.e_let_in (env,None) false false match_expr @@ + O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@ + O.e_let_in (env,None) false false match_expr @@ expr - } in ok @@ restore_mutable_variable return_expr free_vars env else - ok @@ O.E_matching {matchee;cases=O.Match_bool {match_true=match_true';match_false=match_false'}} + return @@ O.e_matching matchee @@ O.Match_bool {match_true=match_true';match_false=match_false'} | I.Match_option {match_none;match_some} -> let%bind match_none' = compile_expression match_none in let (n,expr,tv) = match_some in @@ -385,14 +401,13 @@ and compile_matching : I.matching -> O.expression_content result = if (List.length free_vars != 0) then let match_expr = O.e_matching matchee (O.Match_option {match_none; match_some=(n,expr,tv)}) in let return_expr = fun expr -> - O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars); - let_result=O.e_let_in (env,None) false false match_expr @@ + O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@ + O.e_let_in (env,None) false false match_expr @@ expr - } in ok @@ restore_mutable_variable return_expr free_vars env else - ok @@ O.E_matching {matchee; cases=O.Match_option {match_none=match_none'; match_some=(n,expr',tv)}} + return @@ O.e_matching matchee @@ O.Match_option {match_none=match_none'; match_some=(n,expr',tv)} | I.Match_list {match_nil;match_cons} -> let%bind match_nil' = compile_expression match_nil in let (hd,tl,expr,tv) = match_cons in @@ -406,17 +421,16 @@ and compile_matching : I.matching -> O.expression_content result = if (List.length free_vars != 0) then let match_expr = O.e_matching matchee (O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}) in let return_expr = fun expr -> - O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars); - let_result=O.e_let_in (env,None) false false match_expr @@ + O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@ + O.e_let_in (env,None) false false match_expr @@ expr - } in ok @@ restore_mutable_variable return_expr free_vars env else - ok @@ O.E_matching {matchee;cases=O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr',tv)}} + return @@ O.e_matching matchee @@ O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr',tv)} | I.Match_tuple ((lst,expr), tv) -> let%bind expr = compile_expression expr in - ok @@ O.E_matching {matchee; cases=O.Match_tuple ((lst,expr), tv)} + return @@ O.e_matching matchee @@ O.Match_tuple ((lst,expr), tv) | I.Match_variant (lst,tv) -> let env = Var.fresh () in let aux fv ((c,n),expr) = @@ -429,15 +443,14 @@ and compile_matching : I.matching -> O.expression_content result = let free_vars = List.sort_uniq Var.compare @@ List.concat fv in if (List.length free_vars == 0) then ( let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in - ok @@ O.E_matching{matchee; cases=O.Match_variant (cases,tv)} + return @@ O.e_matching matchee @@ O.Match_variant (cases,tv) ) else ( let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in let match_expr = O.e_matching matchee @@ O.Match_variant (cases,tv) in let return_expr = fun expr -> - O.E_let_in {let_binder=(env,None); mut=false; inline=false; rhs=(store_mutable_variable free_vars); - let_result=O.e_let_in (env,None) false false match_expr @@ + O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@ + O.e_let_in (env,None) false false match_expr @@ expr - } in ok @@ restore_mutable_variable return_expr free_vars env ) @@ -469,11 +482,10 @@ and compile_while I.{condition;body} = let loop = O.e_constant C_FOLD_WHILE [aux_func; O.e_variable env_rec] in let let_binder = (env_rec,None) in let return_expr = fun expr -> - O.E_let_in {let_binder; mut=false; inline=false; rhs=init_rec; let_result= + O.e_let_in let_binder false false init_rec @@ O.e_let_in let_binder false false loop @@ O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) (Label"0")) @@ expr - } in ok @@ restore_mutable_variable return_expr captured_name_list env_rec @@ -515,12 +527,11 @@ and compile_for I.{binder;start;final;increment;body} = let%bind start = compile_expression start in let let_binder = (env_rec,None) in let return_expr = fun expr -> - O.E_let_in {let_binder=(binder, Some (O.t_int ()));mut=false; inline=false;rhs=start;let_result= + O.e_let_in (binder, Some (O.t_int ())) false false start @@ O.e_let_in let_binder false false init_rec @@ O.e_let_in let_binder false false loop @@ O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) (Label "0")) @@ expr - } in ok @@ restore_mutable_variable return_expr captured_name_list env_rec @@ -555,10 +566,10 @@ and compile_for_each I.{binder;collection;collection_type; body} = | Map -> ok @@ O.C_MAP_FOLD | Set -> ok @@ O.C_SET_FOLD | List -> ok @@ O.C_LIST_FOLD in let fold = fun expr -> - O.E_let_in {let_binder=(env,None);mut=false; inline=false;rhs=(O.e_constant op_name [lambda; collect ; init_record]); - let_result=expr;} + O.e_let_in (env,None) false false (O.e_constant op_name [lambda; collect ; init_record]) expr in ok @@ restore_mutable_variable fold free_vars env + let compile_declaration : I.declaration Location.wrap -> _ = fun {wrap_content=declaration;location} -> let return decl = ok @@ Location.wrap ~loc:location decl in @@ -639,18 +650,18 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result = let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in ok @@ I.TC_arrow (i,o) -let rec uncompile_expression : O.expression -> I.expression result = +let rec uncompile_expression' : O.expression -> I.expression result = fun e -> let return expr = ok @@ I.make_e ~loc:e.location expr in match e.expression_content with O.E_literal lit -> return @@ I.E_literal lit | O.E_constant {cons_name;arguments} -> - let%bind arguments = bind_map_list uncompile_expression arguments in + let%bind arguments = bind_map_list uncompile_expression' arguments in return @@ I.E_constant {cons_name;arguments} | O.E_variable name -> return @@ I.E_variable name | O.E_application {lamb; args} -> - let%bind lamb = uncompile_expression lamb in - let%bind args = uncompile_expression args in + let%bind lamb = uncompile_expression' lamb in + let%bind args = uncompile_expression' args in return @@ I.E_application {lamb; args} | O.E_lambda lambda -> let%bind lambda = uncompile_lambda lambda in @@ -662,75 +673,75 @@ let rec uncompile_expression : O.expression -> I.expression result = | O.E_let_in {let_binder;inline;rhs;let_result} -> let (binder,ty_opt) = let_binder in let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in - let%bind rhs = uncompile_expression rhs in - let%bind let_result = uncompile_expression let_result in + let%bind rhs = uncompile_expression' rhs in + let%bind let_result = uncompile_expression' let_result in return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result} | O.E_constructor {constructor;element} -> - let%bind element = uncompile_expression element in + let%bind element = uncompile_expression' element in return @@ I.E_constructor {constructor;element} | O.E_matching {matchee; cases} -> - let%bind matchee = uncompile_expression matchee in + let%bind matchee = uncompile_expression' matchee in let%bind cases = uncompile_matching cases in return @@ I.E_matching {matchee;cases} | O.E_record record -> let record = I.LMap.to_kv_list record in let%bind record = bind_map_list (fun (k,v) -> - let%bind v = uncompile_expression v in + let%bind v = uncompile_expression' v in ok @@ (k,v) ) record in return @@ I.E_record (O.LMap.of_list record) | O.E_record_accessor {record;path} -> - let%bind record = uncompile_expression record in + let%bind record = uncompile_expression' record in return @@ I.E_record_accessor {record;path} | O.E_record_update {record;path;update} -> - let%bind record = uncompile_expression record in - let%bind update = uncompile_expression update in + let%bind record = uncompile_expression' record in + let%bind update = uncompile_expression' update in return @@ I.E_record_update {record;path;update} | O.E_tuple tuple -> - let%bind tuple = bind_map_list uncompile_expression tuple in + let%bind tuple = bind_map_list uncompile_expression' tuple in return @@ I.E_tuple tuple | O.E_tuple_accessor {tuple;path} -> - let%bind tuple = uncompile_expression tuple in + let%bind tuple = uncompile_expression' tuple in return @@ I.E_tuple_accessor {tuple;path} | O.E_tuple_update {tuple;path;update} -> - let%bind tuple = uncompile_expression tuple in - let%bind update = uncompile_expression update in + let%bind tuple = uncompile_expression' tuple in + let%bind update = uncompile_expression' update in return @@ I.E_tuple_update {tuple;path;update} | O.E_map map -> let%bind map = bind_map_list ( - bind_map_pair uncompile_expression + bind_map_pair uncompile_expression' ) map in return @@ I.E_map map | O.E_big_map big_map -> let%bind big_map = bind_map_list ( - bind_map_pair uncompile_expression + bind_map_pair uncompile_expression' ) big_map in return @@ I.E_big_map big_map | O.E_list lst -> - let%bind lst = bind_map_list uncompile_expression lst in + let%bind lst = bind_map_list uncompile_expression' lst in return @@ I.E_list lst | O.E_set set -> - let%bind set = bind_map_list uncompile_expression set in + let%bind set = bind_map_list uncompile_expression' set in return @@ I.E_set set | O.E_look_up look_up -> - let%bind look_up = bind_map_pair uncompile_expression look_up in + let%bind look_up = bind_map_pair uncompile_expression' look_up in return @@ I.E_look_up look_up | O.E_ascription {anno_expr; type_annotation} -> - let%bind anno_expr = uncompile_expression anno_expr in + let%bind anno_expr = uncompile_expression' anno_expr in let%bind type_annotation = uncompile_type_expression type_annotation in return @@ I.E_ascription {anno_expr; type_annotation} | O.E_cond {condition;then_clause;else_clause} -> - let%bind condition = uncompile_expression condition in - let%bind then_clause = uncompile_expression then_clause in - let%bind else_clause = uncompile_expression else_clause in + let%bind condition = uncompile_expression' condition in + let%bind then_clause = uncompile_expression' then_clause in + let%bind else_clause = uncompile_expression' else_clause in return @@ I.E_cond {condition; then_clause; else_clause} | O.E_sequence {expr1; expr2} -> - let%bind expr1 = uncompile_expression expr1 in - let%bind expr2 = uncompile_expression expr2 in + let%bind expr1 = uncompile_expression' expr1 in + let%bind expr2 = uncompile_expression' expr2 in return @@ I.E_sequence {expr1; expr2} | O.E_skip -> return @@ I.E_skip @@ -738,32 +749,32 @@ and uncompile_lambda : O.lambda -> I.lambda result = fun {binder;input_type;output_type;result}-> let%bind input_type = bind_map_option uncompile_type_expression input_type in let%bind output_type = bind_map_option uncompile_type_expression output_type in - let%bind result = uncompile_expression result in + let%bind result = uncompile_expression' result in ok @@ I.{binder;input_type;output_type;result} and uncompile_matching : O.matching_expr -> I.matching_expr result = fun m -> match m with | O.Match_bool {match_true;match_false} -> - let%bind match_true = uncompile_expression match_true in - let%bind match_false = uncompile_expression match_false in + let%bind match_true = uncompile_expression' match_true in + let%bind match_false = uncompile_expression' match_false in ok @@ I.Match_bool {match_true;match_false} | O.Match_list {match_nil;match_cons} -> - let%bind match_nil = uncompile_expression match_nil in + let%bind match_nil = uncompile_expression' match_nil in let (hd,tl,expr,tv) = match_cons in - let%bind expr = uncompile_expression expr in + let%bind expr = uncompile_expression' expr in ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)} | O.Match_option {match_none;match_some} -> - let%bind match_none = uncompile_expression match_none in + let%bind match_none = uncompile_expression' match_none in let (n,expr,tv) = match_some in - let%bind expr = uncompile_expression expr in + let%bind expr = uncompile_expression' expr in ok @@ I.Match_option {match_none; match_some=(n,expr,tv)} | O.Match_tuple ((lst,expr), tv) -> - let%bind expr = uncompile_expression expr in + let%bind expr = uncompile_expression' expr in ok @@ O.Match_tuple ((lst,expr), tv) | O.Match_variant (lst,tv) -> let%bind lst = bind_map_list ( fun ((c,n),expr) -> - let%bind expr = uncompile_expression expr in + let%bind expr = uncompile_expression' expr in ok @@ ((c,n),expr) ) lst in diff --git a/src/stages/2-ast_sugar/combinators.ml b/src/stages/2-ast_sugar/combinators.ml index 99f4072b5..a02e0ba71 100644 --- a/src/stages/2-ast_sugar/combinators.ml +++ b/src/stages/2-ast_sugar/combinators.ml @@ -118,7 +118,7 @@ let e_lambda ?loc binder input_type output_type result : expression = make_e ?lo let e_recursive ?loc fun_name fun_type lambda = make_e ?loc @@ E_recursive {fun_name; fun_type; lambda} let e_let_in ?loc (binder, ascr) mut inline rhs let_result = make_e ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline; mut } -let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = Constructor s; element = a} +let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = s; element = a} let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b} let e_record ?loc map : expression = make_e ?loc @@ E_record map diff --git a/src/stages/2-ast_sugar/combinators.mli b/src/stages/2-ast_sugar/combinators.mli index c91279fa9..7cd4b7921 100644 --- a/src/stages/2-ast_sugar/combinators.mli +++ b/src/stages/2-ast_sugar/combinators.mli @@ -68,7 +68,7 @@ val e_some : ?loc:Location.t -> expression -> expression val e_none : ?loc:Location.t -> unit -> expression val e_variable : ?loc:Location.t -> expression_variable -> expression -val e_constructor : ?loc:Location.t -> string -> expression -> expression +val e_constructor : ?loc:Location.t -> constructor' -> expression -> expression val e_constant : ?loc:Location.t -> constant' -> expression list -> expression val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression