1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
module CC.AST.Source(
module CC.AST.Source,
module CC.Types
) where
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import CC.Pretty
import CC.Types
data Program = Program [Decl]
deriving (Show, Read)
data Decl = DeclFunc FuncDef
| DeclType TypeDef
| DeclAlias AliasDef
deriving (Show, Read)
data FuncDef =
FuncDef (Maybe Type)
(Name, SourceRange)
[(Name, SourceRange)]
Expr
deriving (Show, Read)
-- Named type with named arguments
data TypeDef = TypeDef (Name, SourceRange) [(Name, SourceRange)] Type
deriving (Show, Read)
data AliasDef = AliasDef (Name, SourceRange) [(Name, SourceRange)] Type
deriving (Show, Read)
data Type = TFun Type Type
| TInt
| TTup [Type]
| TNamed Name [Type] -- named type with type arguments
| TUnion (Set Type)
| TyVar Name
deriving (Eq, Ord, 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]
| Var SourceRange Name
| Constr SourceRange Name -- type constructor
| Annot SourceRange Expr Type
deriving (Show, Read)
instance Semigroup Program where Program p1 <> Program p2 = Program (p1 <> p2)
instance Monoid Program where mempty = Program mempty
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) ++ ")"
prettyPrec _ (TNamed n ts) =
n ++ "[" ++ intercalate ", " (map pretty ts) ++ "]"
prettyPrec _ (TUnion ts) =
"{" ++ intercalate " | " (map pretty (Set.toList ts)) ++ "}"
prettyPrec _ (TyVar n) = "<" ++ n ++ ">"
instance HasRange Expr where
range (Lam sr _ _) = sr
range (Let sr _ _ _) = sr
range (Call sr _ _) = sr
range (Int sr _) = sr
range (Tup sr _) = sr
range (Var sr _) = sr
range (Constr sr _) = sr
range (Annot sr _ _) = sr
|
