From 84b9d6c6fe720ae8cdbc4cea70cdd576f8bc964b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Abigail=20Magalh=C3=A3es?=
 <magalhaes.alcantara@pucpr.edu.br>
Date: Wed, 20 May 2020 19:59:25 -0300
Subject: [PATCH] add if expressions (and work around a bug in amc)

---
 compile.ml     | 3 +++
 lib/parsers.ml | 8 +++++---
 parser.ml      | 8 +++++++-
 tc.ml          | 6 +++++-
 4 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/compile.ml b/compile.ml
index e99c3fc..977f2c2 100644
--- a/compile.ml
+++ b/compile.ml
@@ -98,6 +98,7 @@ let rec lambda_lift strict = function
       (v,) <$> lambda_lift false e
     let! e = lambda_lift true e
     pure (Let (vs, e))
+  | If _ -> error "if expression in lambda-lifting"
 
 let rec eta_contract = function
   | Decl (n, a, e) as dec ->
@@ -172,6 +173,8 @@ let rec compile_lazy (env : M.t string slot) = function
     f # x # (Mkap ::)
   | Lam _ ->
       error "Can not compile lambda expression, did you forget to lift?"
+  | If _ ->
+      error "Can not compile if expression, did you forget to TC?"
   | Case _ ->
       error "Case expression in lazy context"
   | Lit i -> (Push (Int i) ::)
diff --git a/lib/parsers.ml b/lib/parsers.ml
index 67b7eed..dea9f4a 100644
--- a/lib/parsers.ml
+++ b/lib/parsers.ml
@@ -224,11 +224,13 @@ and sep_end_by sep p =
 
 let chainr1 p op =
   let rec scan =
-    let! x = p
-    rest x
+    lazy (
+      let! x = p
+      rest x
+    )
   and rest x =
     ( let! f = op
-      let! y = scan
+      let! y = force scan
       pure (f x y)
     ) <|> pure x
   let _ = rest (* shut up, amc *)
diff --git a/parser.ml b/parser.ml
index df0e0df..c12f823 100644
--- a/parser.ml
+++ b/parser.ml
@@ -47,7 +47,13 @@ and expr : forall 'm. monad 'm => parser_t 'm expr =
     let! _ = keyword "in"
     let! b = expr
     pure (Let (bs, b))
-  try lam <|> try case <|> try hslet <+> fexp
+  let hsif =
+    let! _ = keyword "if"
+    let! c = fexp <* keyword "then"
+    let! t = expr <* keyword "else"
+    let! e = expr
+    pure (If (c, t, e))
+  try lam <|> try case <|> try hslet <|> try hsif <+> fexp
 
 let rec ty_atom : forall 'm. monad 'm => parser_t 'm hstype =
   map Tyvar (try varid)
diff --git a/tc.ml b/tc.ml
index d06fef6..61199e0 100644
--- a/tc.ml
+++ b/tc.ml
@@ -329,6 +329,11 @@ and check dt_info level scope wanted = function
         (con, args, check dt_info level scope' wanted expr)
 
       Case (scrutinee, zip_with go_arm data patterns)
+  | If (cond, e_then, e_else) ->
+      let cond = check dt_info level scope (T_con "Bool") cond
+      let e_t = check dt_info level scope wanted e_then
+      let e_e = check dt_info level scope wanted e_else
+      Case (cond, [ ("True", [], e_t), ("False", [], e_e) ])
   | x ->
       let (x, t) = infer dt_info level scope x
       is_subtype t wanted
@@ -383,7 +388,6 @@ let dependency_graph defs =
           |> M.insert name S.empty
           |> (, define name x defs)
   let (graph, defs) = foldl go (M.empty, M.empty) defs
-  G.dot_of_graph graph |> put_line
   (G.groups_of_sccs graph, defs)
 
 let mk_lam args body = foldr (curry Lam) body args