aboutsummaryrefslogtreecommitdiff
path: root/src/Haskell/AST.hs
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2019-03-10 18:26:30 +0100
committertomsmeding <tom.smeding@gmail.com>2019-03-10 18:26:30 +0100
commit48d6f83c36f55471ba66281e6d9b272fb4b336f2 (patch)
tree0d605ad7140861e30af21c7489d5ea4957ef1c50 /src/Haskell/AST.hs
parent34d9f21c6ab529e415f38a5a886b1b612bcbd3bc (diff)
Enough to prove functoriality of Parser
Diffstat (limited to 'src/Haskell/AST.hs')
-rw-r--r--src/Haskell/AST.hs79
1 files changed, 67 insertions, 12 deletions
diff --git a/src/Haskell/AST.hs b/src/Haskell/AST.hs
index 8326440..e1fd1e4 100644
--- a/src/Haskell/AST.hs
+++ b/src/Haskell/AST.hs
@@ -1,38 +1,40 @@
module Haskell.AST where
+import Data.List
+
type Name = String
type TyVar = String
data AST = AST [Toplevel]
- deriving (Show)
+ deriving (Show, Eq)
data Toplevel = TopDef Def
| TopDecl Decl
| TopData Data
| TopClass Class
| TopInst Inst
- deriving (Show)
+ deriving (Show, Eq)
data Def = Def Name Expr
- deriving (Show)
+ deriving (Show, Eq)
data Expr = App Expr [Expr]
| Ref Name
- | LitNum Integer
+ | Num Integer
| Tup [Expr]
| Lam [Name] Expr
- | Case Name [(Pat, Expr)]
- deriving (Show)
+ | Case Expr [(Pat, Expr)]
+ deriving (Show, Eq)
data Pat = PatAny
| PatVar Name
| PatCon Name [Pat]
| PatTup [Pat]
- deriving (Show)
+ deriving (Show, Eq)
data Decl = Decl Name Type
- deriving (Show)
+ deriving (Show, Eq)
data Type = TyTup [Type]
| TyInt
@@ -40,13 +42,66 @@ data Type = TyTup [Type]
| TyRef Name [Type]
| TyVar Name
| TyVoid
- deriving (Show)
+ deriving (Show, Eq)
data Data = Data Name [TyVar] [(Name, [Type])]
- deriving (Show)
+ deriving (Show, Eq)
data Class = Class Name [TyVar] [Decl]
- deriving (Show)
+ deriving (Show, Eq)
data Inst = Inst Name Type [Def]
- deriving (Show)
+ deriving (Show, Eq)
+
+
+class Pretty a where
+ pretty :: a -> String
+
+instance Pretty AST where
+ pretty (AST tops) = intercalate "\n" (map pretty tops)
+
+instance Pretty Toplevel where
+ pretty (TopDef x) = pretty x
+ pretty (TopDecl x) = pretty x
+ pretty (TopData x) = pretty x
+ pretty (TopClass x) = pretty x
+ pretty (TopInst x) = pretty x
+
+instance Pretty Def where
+ pretty (Def n e) = n ++ " = " ++ pretty e
+
+instance Pretty Expr where
+ pretty (App e as) = "(" ++ intercalate " " (map pretty (e:as)) ++ ")"
+ pretty (Ref n) = n
+ pretty (Num n) = show n
+ pretty (Tup es) = "(" ++ intercalate ", " (map pretty es) ++ ")"
+ pretty (Lam as e) = "(\\" ++ intercalate " " as ++ " -> " ++ pretty e ++ ")"
+ pretty (Case e arms) = "(case " ++ pretty e ++ " of { " ++ intercalate ";" (map go arms) ++ " })"
+ where go (p, e') = pretty p ++ " -> " ++ pretty e'
+
+instance Pretty Pat where
+ pretty PatAny = "_"
+ pretty (PatVar n) = n
+ pretty (PatCon n ps) = "(" ++ n ++ " " ++ intercalate " " (map pretty ps) ++ ")"
+ pretty (PatTup ps) = "(" ++ intercalate ", " (map pretty ps) ++ ")"
+
+instance Pretty Decl where
+ pretty (Decl n t) = n ++ " :: " ++ pretty t
+
+instance Pretty Type where
+ pretty (TyTup ts) = "(" ++ intercalate ", " (map pretty ts) ++ ")"
+ pretty TyInt = "Int"
+ pretty (TyFun t u) = "(" ++ pretty t ++ " -> " ++ pretty u ++ ")"
+ pretty (TyRef n as) = "(" ++ n ++ " " ++ intercalate " " (map pretty as) ++ ")"
+ pretty (TyVar n) = n
+ pretty TyVoid = "#Void"
+
+instance Pretty Data where
+ pretty (Data n as cs) = "data " ++ n ++ " " ++ intercalate " " as ++ " = " ++ intercalate " | " (map go cs)
+ where go (m, ts) = m ++ " " ++ intercalate " " (map pretty ts)
+
+instance Pretty Class where
+ pretty (Class n as ds) = "class " ++ n ++ " " ++ intercalate " " as ++ " where { " ++ intercalate " ; " (map pretty ds) ++ "}"
+
+instance Pretty Inst where
+ pretty (Inst n t ds) = "instance " ++ n ++ " " ++ pretty t ++ " where { " ++ intercalate " ; " (map pretty ds) ++ " }"