blob: f606d222ed5320e0f9bf31b5c70920df8567fe1e (
plain)
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
78
79
80
81
82
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
module HSVIS.AST where
import Data.List.NonEmpty (NonEmpty)
import HSVIS.Pretty
newtype Name = Name String
deriving (Show, Eq)
data Program t = Program [DataDef] [FunDef t]
deriving (Show)
data DataDef = DataDef Name [Name] [(Name, [Type])]
deriving (Show)
data FunDef t = FunDef Name (Maybe Type) (NonEmpty (FunEq t))
deriving (Show)
data FunEq t = FunEq t Name [Pattern t] (RHS t)
deriving (Show)
data TypeStage = TSTC | TSNormal
deriving (Show)
data GType (stage :: TypeStage) where
TApp :: GType s -> [GType s] -> GType s
TTup :: [GType s] -> GType s
TList :: GType s -> GType s
TFun :: GType s -> GType s -> GType s
TCon :: Name -> GType s
TVar :: Name -> GType s
-- Type constructor used only while type checking
TUniVar :: Int -> GType 'TSTC
deriving instance Show (GType stage)
type TCType = GType 'TSTC
type Type = GType 'TSNormal
data Pattern t
= PWildcard t
| PVar t Name
| PAs t Name (Pattern t)
| PCon t Name [Pattern t]
| POp t (Pattern t) Operator (Pattern t)
| PList t [Pattern t]
| PTup t [Pattern t]
deriving (Show)
data RHS t
= Guarded [(Expr t, Expr t)] -- currently not parsed
| Plain (Expr t)
deriving (Show)
data Expr t
= ELit t Literal
| EVar t Name
| ECon t Name
| EList t [Expr t]
| ETup t [Expr t]
| EApp t (Expr t) [Expr t]
| EOp t (Expr t) Operator (Expr t)
| EIf t (Expr t) (Expr t) (Expr t)
| ECase t (Expr t) [(Pattern t, RHS t)]
| ELet t [FunDef t] (Expr t)
| EParseError
deriving (Show)
data Literal = LInt Integer | LFloat Rational | LChar Char | LString String
deriving (Show)
data Operator = OAdd | OSub | OMul | ODiv | OMod | OEqu | OPow
| OCons
deriving (Show)
instance Pretty Name where
prettysPrec _ (Name n) = showString ("\"" ++ n ++ "\"")
|
