From 0503dcb2998ab9dcd0f39e6f264f482a3d2cc7f7 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Sat, 25 Jul 2020 21:51:37 +0200
Subject: Support Let

---
 ast/CC/AST/Source.hs | 2 ++
 ast/CC/AST/Typed.hs  | 8 ++++++++
 2 files changed, 10 insertions(+)

(limited to 'ast/CC/AST')

diff --git a/ast/CC/AST/Source.hs b/ast/CC/AST/Source.hs
index 11b7bc6..e648759 100644
--- a/ast/CC/AST/Source.hs
+++ b/ast/CC/AST/Source.hs
@@ -27,6 +27,7 @@ data Type = TFun Type Type
   deriving (Show, Read)
 
 data Expr = Lam SourceRange [(Name, SourceRange)] Expr
+          | Let SourceRange (Name, SourceRange) Expr Expr
           | Call SourceRange Expr Expr
           | Int SourceRange Int
           | Tup SourceRange [Expr]
@@ -43,6 +44,7 @@ instance Pretty Type where
 
 instance HasRange Expr where
     range (Lam sr _ _) = sr
+    range (Let sr _ _ _) = sr
     range (Call sr _ _) = sr
     range (Int sr _) = sr
     range (Tup sr _) = sr
diff --git a/ast/CC/AST/Typed.hs b/ast/CC/AST/Typed.hs
index 26f7b5c..b12b30a 100644
--- a/ast/CC/AST/Typed.hs
+++ b/ast/CC/AST/Typed.hs
@@ -25,6 +25,7 @@ data TypeScheme = TypeScheme [Int] Type
   deriving (Show, Read)
 
 data Expr = Lam Type Occ Expr
+          | Let Occ Expr Expr
           | Call Type Expr Expr
           | Int Int
           | Tup [Expr]
@@ -36,6 +37,7 @@ data Occ = Occ Name Type
 
 exprType :: Expr -> Type
 exprType (Lam typ _ _) = typ
+exprType (Let _ _ body) = exprType body
 exprType (Call typ _ _) = typ
 exprType (Int _) = TInt
 exprType (Tup es) = TTup (map exprType es)
@@ -60,6 +62,12 @@ instance Pretty Expr where
         precParens p 2 $
             "(\\(" ++ n ++ " :: " ++ pretty t ++ ") -> "
                 ++ prettyPrec 2 e ++ ") :: " ++ pretty ty
+    prettyPrec p (Let (Occ n t) rhs e) =
+        precParens p 2 $
+            "let (" ++ n ++ " :: " ++ pretty t ++ ") = " ++ pretty rhs ++ " " ++
+                (case e of
+                   Let _ _ _ -> pretty e
+                   _ -> "in " ++ pretty e)
     prettyPrec p (Call ty e1 e2) =
         precParens p 2 $
             prettyPrec 3 e1 ++ " " ++ prettyPrec 3 e2 ++ " :: " ++ pretty ty
-- 
cgit v1.2.3-70-g09d2