Merge branch 'ast/e_cond_sugar' into 'dev'

Add E_cond as sugar (if .. then .. else ..) for match_bool

See merge request ligolang/ligo!536

src/passes/3-self_ast_imperative/helpers.ml

@@ -76,6 +76,11 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   | E_recursive { lambda={result=e;_}; _} ->
       let%bind res = self init' e in
       ok res
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind res = self init' condition in
+      let%bind res = self res then_clause in
+      let%bind res = self res else_clause in
+      ok res
   | E_sequence {expr1;expr2} ->
       let ab = (expr1,expr2) in
       let%bind res = bind_fold_pair self init' ab in
@@ -217,6 +222,11 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind args = bind_map_list self c.arguments in
       return @@ E_constant {c with arguments=args}
     )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind condition   = self condition in
+      let%bind then_clause = self then_clause in
+      let%bind else_clause = self else_clause in
+      return @@ E_cond {condition;then_clause;else_clause}
   | E_sequence {expr1;expr2} -> (
       let%bind (expr1,expr2) = bind_map_pair self (expr1,expr2) in
       return @@ E_sequence {expr1;expr2}
@@ -396,6 +406,11 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,args) = bind_fold_map_list self init' c.arguments in
       ok (res, return @@ E_constant {c with arguments=args})
     )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind res,condition   = self init' condition in
+      let%bind res,then_clause = self res then_clause in
+      let%bind res,else_clause = self res else_clause in
+      ok (res, return @@ E_cond {condition;then_clause;else_clause})
   | E_sequence {expr1;expr2} -> (
       let%bind (res,(expr1,expr2)) = bind_fold_map_pair self init' (expr1,expr2) in
       ok (res, return @@ E_sequence {expr1;expr2})

src/passes/4-imperative_to_sugar/imperative_to_sugar.ml

@@ -234,6 +234,28 @@ let rec compile_expression : I.expression -> O.expression result =
       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}
+    | I.E_cond {condition;then_clause;else_clause} ->
+      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
+      let%bind ((_,free_vars_true), then_clause) = repair_mutable_variable_in_matching then_clause' [] env in
+      let%bind ((_,free_vars_false), else_clause) = repair_mutable_variable_in_matching else_clause' [] env in
+      let then_clause  = add_to_end then_clause (O.e_variable env) in
+      let else_clause = add_to_end else_clause (O.e_variable env) in
+
+      let free_vars = List.sort_uniq Var.compare @@ free_vars_true @ free_vars_false in
+      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 @@
+          expr 
+          }
+        in
+        return @@ restore_mutable_variable return_expr free_vars env
+      else
+        return @@ O.E_cond {condition; then_clause=then_clause'; else_clause=else_clause'}
     | I.E_sequence {expr1; expr2} ->
       let%bind expr1 = compile_expression expr1 in
       let%bind expr2 = compile_expression expr2 in
@@ -672,6 +694,11 @@ let rec uncompile_expression : O.expression -> I.expression result =
     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
+    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

src/passes/5-self_ast_sugar/helpers.ml

@@ -56,6 +56,11 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
       let%bind res = self res let_result in
       ok res
     )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind res = self init' condition in
+      let%bind res = self res then_clause in
+      let%bind res = self res else_clause in
+      ok res
   | E_recursive { lambda={result=e;_}; _} ->
       let%bind res = self init' e in
       ok res
@@ -189,6 +194,11 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind args = bind_map_list self c.arguments in
       return @@ E_constant {c with arguments=args}
     )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind condition   = self condition in
+      let%bind then_clause = self then_clause in
+      let%bind else_clause = self else_clause in
+      return @@ E_cond {condition;then_clause;else_clause}
   | E_sequence {expr1;expr2} -> (
       let%bind (expr1,expr2) = bind_map_pair self (expr1,expr2) in
       return @@ E_sequence {expr1;expr2}
@@ -365,6 +375,11 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,args) = bind_fold_map_list self init' c.arguments in
       ok (res, return @@ E_constant {c with arguments=args})
     )
+  | E_cond {condition; then_clause; else_clause} ->
+      let%bind res,condition   = self init' condition in
+      let%bind res,then_clause = self res then_clause in
+      let%bind res,else_clause = self res else_clause in
+      ok (res, return @@ E_cond {condition;then_clause;else_clause})
   | E_sequence {expr1;expr2} -> (
       let%bind (res,(expr1,expr2)) = bind_fold_map_pair self init' (expr1,expr2) in
       ok (res, return @@ E_sequence {expr1;expr2})

src/passes/6-sugar_to_core/sugar_to_core.ml

@@ -154,6 +154,11 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind anno_expr = compile_expression anno_expr in
       let%bind type_annotation = idle_type_expression type_annotation in
       return @@ O.E_ascription {anno_expr; type_annotation}
+    | I.E_cond {condition; then_clause; else_clause} ->
+      let%bind matchee = compile_expression condition in
+      let%bind match_true = compile_expression then_clause in
+      let%bind match_false = compile_expression else_clause in
+      return @@ O.E_matching {matchee; cases=Match_bool{match_true;match_false}}
     | I.E_sequence {expr1; expr2} ->
       let%bind expr1 = compile_expression expr1 in
       let%bind expr2 = compile_expression expr2 in

src/stages/1-ast_imperative/PP.ml

@@ -96,6 +96,11 @@ and expression_content ppf (ec : expression_content) =
   | E_ascription {anno_expr; type_annotation} ->
       fprintf ppf "%a : %a" expression anno_expr type_expression
         type_annotation
+  | E_cond {condition; then_clause; else_clause} ->
+      fprintf ppf "if %a then %a else %a"
+        expression condition
+        expression then_clause
+        expression else_clause
   | E_sequence {expr1;expr2} ->
       fprintf ppf "{ %a; @. %a}" expression expr1 expression expr2
   | E_skip ->

src/stages/1-ast_imperative/combinators.ml

@@ -131,7 +131,7 @@ let e_while ?loc condition body = make_expr ?loc @@ E_while {condition; body}
 let e_for ?loc binder start final increment body = make_expr ?loc @@ E_for {binder;start;final;increment;body}
 let e_for_each ?loc binder collection collection_type body = make_expr ?loc @@ E_for_each {binder;collection;collection_type;body}
 
-let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false})
+let e_cond ?loc condition then_clause else_clause = make_expr ?loc @@ E_cond {condition;then_clause;else_clause}
 (*
 let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*)
 *)

src/stages/1-ast_imperative/misc.ml

@@ -204,7 +204,8 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | (E_application _, _) | (E_let_in _, _)
   | (E_recursive _,_) 
   | (E_record_accessor _, _) | (E_tuple_accessor _, _)
-  | (E_look_up _, _) | (E_matching _, _)
+  | (E_look_up _, _) 
+  | (E_matching _, _) | (E_cond _, _)
   | (E_sequence _, _) | (E_skip, _) 
   | (E_assign _, _)
   | (E_for _, _) | (E_for_each _, _)

src/stages/1-ast_imperative/types.ml

@@ -60,6 +60,7 @@ and expression_content =
   (* Advanced *)
   | E_ascription of ascription
   (* Sugar *)
+  | E_cond of conditional
   | E_sequence of sequence
   | E_skip
   | E_tuple of expression list
@@ -118,6 +119,13 @@ and matching =
   }
 
 and ascription = {anno_expr: expression; type_annotation: type_expression}
+
+and conditional = {
+  condition : expression ;
+  then_clause : expression ;
+  else_clause : expression ;
+}
+
 and sequence = {
   expr1: expression ;
   expr2: expression ;

src/stages/2-ast_sugar/PP.ml

@@ -93,10 +93,15 @@ and expression_content ppf (ec : expression_content) =
         expression rhs 
         option_inline inline 
         expression let_result
-  | E_sequence {expr1;expr2} ->
-      fprintf ppf "{ %a; @. %a}" expression expr1 expression expr2
   | E_ascription {anno_expr; type_annotation} ->
       fprintf ppf "%a : %a" expression anno_expr type_expression type_annotation
+  | E_cond {condition; then_clause; else_clause} ->
+      fprintf ppf "if %a then %a else %a"
+        expression condition
+        expression then_clause
+        expression else_clause
+  | E_sequence {expr1;expr2} ->
+      fprintf ppf "{ %a; @. %a}" expression expr1 expression expr2
   | E_skip ->
       fprintf ppf "skip"
   | E_tuple t ->

src/stages/2-ast_sugar/combinators.ml

@@ -122,6 +122,7 @@ let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; ar
 
 let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty}
 
+let e_cond ?loc condition then_clause else_clause = make_expr ?loc @@ E_cond {condition;then_clause;else_clause}
 let e_sequence ?loc expr1 expr2 = make_expr ?loc @@ E_sequence {expr1; expr2}
 let e_skip ?loc () = make_expr ?loc @@ E_skip
 
@@ -153,7 +154,6 @@ let make_option_typed ?loc e t_opt =
   | None -> e
   | Some t -> e_annotation ?loc e t
 
-let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false})
 let e_tuple ?loc lst : expression = e_record_ez ?loc (tuple_to_record lst)
 let e_pair ?loc a b  : expression = e_tuple ?loc [a;b]
 

src/stages/2-ast_sugar/combinators.mli

@@ -84,6 +84,7 @@ val e_record_accessor_list : ?loc:Location.t -> expression -> string list -> exp
 
 val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
 
+val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
 val e_sequence : ?loc:Location.t -> expression -> expression -> expression
 val e_skip : ?loc:Location.t -> unit -> expression
 
@@ -109,7 +110,6 @@ val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list  -> ty
 val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression
 
 val e_record_ez : ?loc:Location.t -> (string * expression) list -> expression
-val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
 val e_tuple : ?loc:Location.t -> expression list -> expression
 val e_pair : ?loc:Location.t -> expression -> expression -> expression
 

src/stages/2-ast_sugar/misc.ml

@@ -204,7 +204,8 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | (E_application _, _) | (E_let_in _, _)
   | (E_recursive _,_) 
   | (E_record_accessor _, _) | (E_tuple_accessor _, _)
-  | (E_look_up _, _) | (E_matching _, _)
+  | (E_look_up _, _) 
+  | (E_matching _, _) | (E_cond _, _)
   | (E_sequence _, _) | (E_skip, _) -> simple_fail "comparing not a value"
 
 let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)

src/stages/2-ast_sugar/types.ml

@@ -60,6 +60,7 @@ and expression_content =
   (* Advanced *)
   | E_ascription of ascription
   (* Sugar *)
+  | E_cond of conditional
   | E_sequence of sequence
   | E_skip
   | E_tuple of expression list
@@ -113,6 +114,12 @@ and matching =
   }
 
 and ascription = {anno_expr: expression; type_annotation: type_expression}
+
+and conditional = {
+  condition : expression ;
+  then_clause : expression ;
+  else_clause : expression ;
+}
 and sequence = {
   expr1: expression ;
   expr2: expression ;