compiler: preliminary support for guards.

Proper support for guards will take a lot more than this, I think, since
guards can have any level of nested expressions son long as it follows
the rules outlined here: https://erlang.org/doc/reference_manual/expressions.html#guard-expressions

This makes it more likely that we will need to generate an expression,
and traverse it with a function like `is_guard_safe :
Erlang.Ast.expression -> bool`.

For the time being, this should allow most common guards to be written.

We'll improve support after v0.1.

Closes #17

src/compiler/ocaml_to_erlang/error.ml

@@ -20,6 +20,15 @@ This is currently not supported.
 |};
   exit 1
 
+let unsupported_guard_expression () =
+  Format.fprintf ppf
+    {|We have found a guard expression that is not one of the allowlisted Erlang BIFs.
+
+This is currently not supported.
+\n
+|};
+  exit 1
+
 let unsupported_let_shadowing name =
   Format.fprintf ppf
     {|We have found that the variable name %s is being shadowed.

src/compiler/ocaml_to_erlang/fun.ml

@@ -299,16 +299,31 @@ and mk_expression exp ~var_names ~modules ~functions ~module_name =
       let expr =
         mk_expression expr ~var_names ~modules ~functions ~module_name
       in
-      (* NOTE: match on c_guard here to translate guards *)
       let branches =
         List.map
           (fun c ->
             let lhs = mk_pattern ~var_names c.c_lhs in
             let var_names = collect_var_names [ lhs ] @ var_names in
+            let guard =
+              match c.c_guard with
+              | None -> None
+              | Some expr ->
+                  let expr =
+                    mk_expression expr ~var_names ~modules ~functions
+                      ~module_name
+                  in
+                  Erlang.Ast.(
+                    match expr with
+                    | Expr_apply { fa_name = Expr_name name; _ }
+                      when Names.is_guard name ->
+                        ()
+                    | _ -> Error.unsupported_guard_expression ());
+                  Some [ expr ]
+            in
             let rhs =
               mk_expression c.c_rhs ~var_names ~modules ~functions ~module_name
             in
-            FunDecl.case ~lhs:[ lhs ] ~guard:None ~rhs)
+            FunDecl.case ~lhs:[ lhs ] ~guard ~rhs)
           branches
       in
       Erlang.Ast.Expr_case (expr, branches)

src/compiler/ocaml_to_erlang/names.ml

@@ -1,5 +1,44 @@
 open Erlang.Ast_helper
 
+let erlang = Name.atom (Atom.mk "erlang")
+
+let guards =
+  [
+    Name.atom (Atom.mk "!");
+    Name.atom (Atom.mk "*");
+    Name.atom (Atom.mk "+");
+    Name.atom (Atom.mk "++");
+    Name.atom (Atom.mk "-");
+    Name.atom (Atom.mk "--");
+    Name.atom (Atom.mk "/");
+    Name.atom (Atom.mk "/=");
+    Name.atom (Atom.mk ":=");
+    Name.atom (Atom.mk "=/=");
+    Name.atom (Atom.mk "=:=");
+    Name.atom (Atom.mk "=<");
+    Name.atom (Atom.mk "==");
+    Name.atom (Atom.mk ">");
+    Name.atom (Atom.mk ">=");
+    Name.atom (Atom.mk "is_atom");
+    Name.atom (Atom.mk "is_binary");
+    Name.atom (Atom.mk "is_bitstring");
+    Name.atom (Atom.mk "is_boolean");
+    Name.atom (Atom.mk "is_float");
+    Name.atom (Atom.mk "is_integer");
+    Name.atom (Atom.mk "is_list");
+    Name.atom (Atom.mk "is_map");
+    Name.atom (Atom.mk "is_number");
+    Name.atom (Atom.mk "is_pid");
+    Name.atom (Atom.mk "is_port");
+    Name.atom (Atom.mk "is_process_alive");
+    Name.atom (Atom.mk "is_reference");
+    Name.atom (Atom.mk "is_tuple");
+    Name.atom (Atom.mk "is_tuple");
+  ]
+  |> List.concat_map (fun f -> [ f; Name.qualified ~m:erlang ~f ])
+
+let is_guard guard = List.mem guard guards
+
 let translation_table : (Erlang.Ast.name, Erlang.Ast.name) Hashtbl.t =
   let h = Hashtbl.create 1024 in
   [ (("list", "length"), ("erlang", "length")) ]
@@ -114,6 +153,7 @@ let ocaml_to_erlang_primitive_op t =
         ~m:(Name.atom (Atom.mk "caramel"))
         ~f:(Name.atom (Atom.mk "binary_concat"))
   | "<>" -> to_erl_op "=/="
+  | "<=" -> to_erl_op "=<"
   | "=" -> to_erl_op "=:="
   | "==" -> to_erl_op "=="
   | "@" -> to_erl_op "++"

src/erlang/erl_printer.ml

@@ -280,22 +280,34 @@ and pp_if_case_branches prefix ppf branches ~module_ =
     (pp_if_case_branch prefix ~module_)
     ppf branches
 
+and pp_case_guard ppf guard ~module_ =
+  match guard with
+  | None -> ()
+  | Some exprs ->
+      Format.fprintf ppf " when ";
+      Format.pp_print_list
+        ~pp_sep:(fun ppf () -> Format.fprintf ppf " ,")
+        (fun ppf expr -> pp_expression "" ppf expr ~module_)
+        ppf exprs
+
 and pp_case_branches prefix ppf branches ~module_ =
   match branches with
-  | { c_lhs = [ c_lhs ]; c_rhs; _ } :: bs -> (
+  | { c_lhs = [ c_lhs ]; c_rhs; c_guard } :: bs -> (
       let prefix = prefix ^ "  " in
       Format.fprintf ppf "\n%s" prefix;
       pp_pattern_match ppf c_lhs;
+      pp_case_guard ppf c_guard ~module_;
       Format.fprintf ppf " -> ";
       pp_expression "" ppf c_rhs ~module_;
       match bs with
       | [] -> ()
       | bs ->
           bs
           |> List.iter (function
-               | { c_lhs = [ c_lhs ]; c_rhs; _ } ->
+               | { c_lhs = [ c_lhs ]; c_rhs; c_guard } ->
                    Format.fprintf ppf ";\n%s" prefix;
                    pp_pattern_match ppf c_lhs;
+                   pp_case_guard ppf c_guard ~module_;
                    Format.fprintf ppf " -> ";
                    pp_expression "" ppf c_rhs ~module_
                | _ -> raise Invalid_case_branch) )

tests/compiler/functions.t/guard_unsupported.ml

@@ -0,0 +1,9 @@
+open Erlang
+
+let g _ = false
+
+let f x =
+    match x with
+    | y when (g y) -> 3
+    | _ -> 4
+

tests/compiler/functions.t/guards.ml

@@ -0,0 +1,10 @@
+open Erlang
+
+let f x =
+    match x with
+    | y when (is_number y) -> 3
+    | y when Erlang.is_binary y -> 3
+    | y when y > 3 -> 3
+    | y when y <= 3 -> 3
+    | _ -> 4
+

tests/compiler/functions.t/run.t

@@ -1,5 +1,7 @@
   $ ls *.ml *.mli
   basic.ml
+  guard_unsupported.ml
+  guards.ml
   hello_joe.ml
   ignored_arguments.ml
   labeled_arguments.ml
@@ -318,3 +320,31 @@
   $ cat redefine.erl
   cat: redefine.erl: No such file or directory
   [1]
+  $ caramelc compile guards.ml
+  Compiling guards.erl	OK
+  $ cat guards.erl
+  % Source code generated with Caramel.
+  -module(guards).
+
+  -export([f/1]).
+
+  -spec f(integer()) -> integer().
+  f(X) ->
+    case X of
+      Y when is_number(Y) -> 3;
+      Y when erlang:is_binary(Y) -> 3;
+      Y when erlang:'>'(Y, 3) -> 3;
+      Y when erlang:'=<'(Y, 3) -> 3;
+      _ -> 4
+    end.
+
+
+  $ caramelc compile guard_unsupported.ml
+  We have found a guard expression that is not one of the allowlisted Erlang BIFs.
+
+  This is currently not supported.
+  \n
+  [1]
+  $ cat guard_unsupported.erl
+  cat: guard_unsupported.erl: No such file or directory
+  [1]