From cb1bc95d5960aefad6975d2e64b7d413035d0b99 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Wed, 18 Mar 2020 16:16:43 +0100 Subject: [PATCH] remove E_skip from core --- src/passes/6-sugar_to_core/sugar_to_core.ml | 3 +-- src/passes/8-typer-new/typer.ml | 4 ---- src/passes/8-typer-old/typer.ml | 2 +- src/stages/3-ast_core/PP.ml | 2 -- src/stages/3-ast_core/combinators.ml | 1 - src/stages/3-ast_core/combinators.mli | 1 - src/stages/3-ast_core/misc.ml | 2 +- src/stages/3-ast_core/types.ml | 1 - src/stages/4-ast_typed/types.ml | 2 +- 9 files changed, 4 insertions(+), 14 deletions(-) diff --git a/src/passes/6-sugar_to_core/sugar_to_core.ml b/src/passes/6-sugar_to_core/sugar_to_core.ml index b6138ed7f..c55c2561c 100644 --- a/src/passes/6-sugar_to_core/sugar_to_core.ml +++ b/src/passes/6-sugar_to_core/sugar_to_core.ml @@ -85,7 +85,7 @@ let rec compile_expression : I.expression -> O.expression result = 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);inline;rhs;let_result} - | I.E_skip -> return @@ O.E_skip + | I.E_skip -> ok @@ O.e_unit ~loc:e.location () | I.E_constructor {constructor;element} -> let%bind element = compile_expression element in return @@ O.E_constructor {constructor;element} @@ -270,7 +270,6 @@ let rec uncompile_expression : O.expression -> I.expression result = 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_skip -> return @@ I.E_skip | O.E_constructor {constructor;element} -> let%bind element = uncompile_expression element in return @@ I.E_constructor {constructor;element} diff --git a/src/passes/8-typer-new/typer.ml b/src/passes/8-typer-new/typer.ml index 555ec8ae8..215df7ebd 100644 --- a/src/passes/8-typer-new/typer.ml +++ b/src/passes/8-typer-new/typer.ml @@ -446,10 +446,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression - | E_literal (Literal_void) -> ( failwith "TODO: missing implementation for literal void" ) - | E_skip -> ( - (* E_skip just returns unit *) - return_wrapped (e_unit ()) state @@ Wrap.literal (t_unit ()) - ) (* | E_literal (Literal_string s) -> ( * L.log (Format.asprintf "literal_string option type: %a" PP_helpers.(option O.PP.type_expression) tv_opt) ; * match Option.map Ast_typed.get_type' tv_opt with diff --git a/src/passes/8-typer-old/typer.ml b/src/passes/8-typer-old/typer.ml index 52586508d..bc6924df0 100644 --- a/src/passes/8-typer-old/typer.ml +++ b/src/passes/8-typer-old/typer.ml @@ -423,7 +423,7 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression return (E_variable name) tv'.type_value | E_literal (Literal_bool b) -> return (E_literal (Literal_bool b)) (t_bool ()) - | E_literal Literal_unit | E_skip -> + | E_literal Literal_unit -> return (E_literal (Literal_unit)) (t_unit ()) | E_literal Literal_void -> return (E_literal (Literal_void)) (t_unit ()) (* TODO : IS this really a t_unit ?*) | E_literal (Literal_string s) -> diff --git a/src/stages/3-ast_core/PP.ml b/src/stages/3-ast_core/PP.ml index bd1f13ad5..88d4875c5 100644 --- a/src/stages/3-ast_core/PP.ml +++ b/src/stages/3-ast_core/PP.ml @@ -58,8 +58,6 @@ and expression_content ppf (ec : expression_content) = cases | E_let_in { let_binder ;rhs ; let_result; inline } -> fprintf ppf "let %a = %a%a in %a" option_type_name let_binder expression rhs option_inline inline expression let_result - | E_skip -> - fprintf ppf "skip" | E_ascription {anno_expr; type_annotation} -> fprintf ppf "%a : %a" expression anno_expr type_expression type_annotation diff --git a/src/stages/3-ast_core/combinators.ml b/src/stages/3-ast_core/combinators.ml index 9ea3f592c..ac1ee3798 100644 --- a/src/stages/3-ast_core/combinators.ml +++ b/src/stages/3-ast_core/combinators.ml @@ -121,7 +121,6 @@ let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {mat let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {expr = a; label= Label b} let e_accessor_list ?loc a b = List.fold_left (fun a b -> e_accessor ?loc a b) a b let e_variable ?loc v = make_expr ?loc @@ E_variable v -let e_skip ?loc () = make_expr ?loc @@ E_skip let e_let_in ?loc (binder, ascr) inline rhs let_result = make_expr ?loc @@ E_let_in { let_binder = (binder,ascr) ; rhs ; let_result; inline } let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty} diff --git a/src/stages/3-ast_core/combinators.mli b/src/stages/3-ast_core/combinators.mli index e9d3dd144..b962ce3c6 100644 --- a/src/stages/3-ast_core/combinators.mli +++ b/src/stages/3-ast_core/combinators.mli @@ -83,7 +83,6 @@ val e_matching_bool : ?loc:Location.t -> expression -> expression -> expression val e_accessor : ?loc:Location.t -> expression -> string -> expression val e_accessor_list : ?loc:Location.t -> expression -> string list -> expression val e_variable : ?loc:Location.t -> expression_variable -> expression -val e_skip : ?loc:Location.t -> unit -> expression val e_sequence : ?loc:Location.t -> expression -> expression -> expression val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression diff --git a/src/stages/3-ast_core/misc.ml b/src/stages/3-ast_core/misc.ml index f2094d3ca..a09efa475 100644 --- a/src/stages/3-ast_core/misc.ml +++ b/src/stages/3-ast_core/misc.ml @@ -184,7 +184,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result = | (E_application _, _) | (E_let_in _, _) | (E_recursive _,_) | (E_record_accessor _, _) | (E_look_up _, _) | (E_matching _, _) - | (E_skip, _) -> simple_fail "comparing not a value" + -> simple_fail "comparing not a value" let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b) diff --git a/src/stages/3-ast_core/types.ml b/src/stages/3-ast_core/types.ml index 07a36d361..781214f51 100644 --- a/src/stages/3-ast_core/types.ml +++ b/src/stages/3-ast_core/types.ml @@ -36,7 +36,6 @@ and expression_content = | E_lambda of lambda | E_recursive of recursive | E_let_in of let_in - | E_skip (* Variant *) | E_constructor of constructor (* For user defined constructors *) | E_matching of matching diff --git a/src/stages/4-ast_typed/types.ml b/src/stages/4-ast_typed/types.ml index b5a35061f..a0d7c067a 100644 --- a/src/stages/4-ast_typed/types.ml +++ b/src/stages/4-ast_typed/types.ml @@ -40,8 +40,8 @@ and expression_content = | E_variable of expression_variable | E_application of application | E_lambda of lambda - | E_let_in of let_in | E_recursive of recursive + | E_let_in of let_in (* Variant *) | E_constructor of constructor (* For user defined constructors *) | E_matching of matching