From b5b044ceb4c178a656c0ddc27adec4a719b35893 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Fri, 24 Jul 2020 21:53:41 +0200
Subject: Support tuples

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

(limited to 'ast/CC')

diff --git a/ast/CC/Source.hs b/ast/CC/Source.hs
index 080b850..c10f910 100644
--- a/ast/CC/Source.hs
+++ b/ast/CC/Source.hs
@@ -1,5 +1,7 @@
 module CC.Source(module CC.Source, module CC.Types) where
 
+import Data.List
+
 import CC.Pretty
 import CC.Types
 
@@ -18,11 +20,13 @@ data Def = Function (Maybe Type)
 
 data Type = TFun Type Type
           | TInt
+          | TTup [Type]
   deriving (Show, Read)
 
 data Expr = Lam SourceRange [(Name, SourceRange)] Expr
           | Call SourceRange Expr Expr
           | Int SourceRange Int
+          | Tup SourceRange [Expr]
           | Var SourceRange Name
           | Annot SourceRange Expr Type
   deriving (Show, Read)
@@ -31,10 +35,13 @@ instance Pretty Type where
     prettyPrec _ TInt = "Int"
     prettyPrec p (TFun a b) =
         precParens p 2 (prettyPrec 3 a ++ " -> " ++ prettyPrec 2 b)
+    prettyPrec _ (TTup ts) =
+        "(" ++ intercalate ", " (map pretty ts) ++ ")"
 
 instance HasRange Expr where
     range (Lam sr _ _) = sr
     range (Call sr _ _) = sr
     range (Int sr _) = sr
+    range (Tup sr _) = sr
     range (Var sr _) = sr
     range (Annot sr _ _) = sr
diff --git a/ast/CC/Typed.hs b/ast/CC/Typed.hs
index 535fd31..53caa29 100644
--- a/ast/CC/Typed.hs
+++ b/ast/CC/Typed.hs
@@ -3,6 +3,8 @@ module CC.Typed(
     module CC.Types
 ) where
 
+import Data.List
+
 import CC.Pretty
 import CC.Types
 
@@ -15,12 +17,14 @@ data DefT = DefT Name ExprT
 
 data TypeT = TFunT TypeT TypeT
            | TIntT
+           | TTupT [TypeT]
            | TyVar Int
   deriving (Show, Read)
 
 data ExprT = LamT TypeT Occ ExprT
            | CallT TypeT ExprT ExprT
            | IntT Int
+           | TupT [ExprT]
            | VarT Occ
   deriving (Show, Read)
 
@@ -31,12 +35,15 @@ exprType :: ExprT -> TypeT
 exprType (LamT typ _ _) = typ
 exprType (CallT typ _ _) = typ
 exprType (IntT _) = TIntT
+exprType (TupT es) = TTupT (map exprType es)
 exprType (VarT (Occ _ typ)) = typ
 
 instance Pretty TypeT where
     prettyPrec _ TIntT = "Int"
     prettyPrec p (TFunT a b) =
         precParens p 2 (prettyPrec 3 a ++ " -> " ++ prettyPrec 2 b)
+    prettyPrec _ (TTupT ts) =
+        "(" ++ intercalate ", " (map pretty ts) ++ ")"
     prettyPrec _ (TyVar i) = 't' : show i
 
 instance Pretty ExprT where
@@ -48,6 +55,7 @@ instance Pretty ExprT where
         precParens p 2 $
             prettyPrec 3 e1 ++ " " ++ prettyPrec 3 e2 ++ " :: " ++ pretty ty
     prettyPrec _ (IntT i) = show i
+    prettyPrec _ (TupT es) = "(" ++ intercalate ", " (map pretty es) ++ ")"
     prettyPrec p (VarT (Occ n t)) =
         precParens p 2 $
             show n ++ " :: " ++ pretty t
-- 
cgit v1.2.3-54-g00ecf