git.iko.soy/elk
on fcbd7fd help sign in
elk/compiler/SourceSyntax/Declaration.hs
73 lines 2.3 kB history raw
1module SourceSyntax.Declaration where
3import Data.Binary
4import qualified SourceSyntax.Expression as Expr
5import SourceSyntax.Type
6import SourceSyntax.PrettyPrint
7import Text.PrettyPrint as P
9data Declaration tipe var
10 = Definition (Expr.Def tipe var)
11 | Datatype String [String] [(String,[Type])] [Derivation]
12 | TypeAlias String [String] Type [Derivation]
13 | ImportEvent String (Expr.LExpr tipe var) String Type
14 | ExportEvent String String Type
15 | Fixity Assoc Int String
16 deriving (Eq, Show)
18data Assoc = L | N | R
19 deriving (Eq)
21data Derivation = Json | Binary | RecordConstructor
22 deriving (Eq, Show)
24instance Binary Derivation where
25 get = do n <- getWord8
26 return $ case n of
27 0 -> Json
28 1 -> Binary
29 2 -> RecordConstructor
31 put derivation =
32 case derivation of
33 Json -> putWord8 0
34 Binary -> putWord8 1
35 RecordConstructor -> putWord8 2
37instance Show Assoc where
38 show assoc =
39 case assoc of
40 L -> "left"
41 N -> "non"
42 R -> "right"
44instance Pretty (Declaration t v) where
45 pretty decl =
46 case decl of
47 Definition def -> pretty def
49 Datatype tipe tvars ctors deriveables ->
50 P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
51 (P.sep $ zipWith join ("=" : repeat "|") ctors) <+> prettyDeriving deriveables
52 where
53 join c ctor = P.text c <+> prettyCtor ctor
54 prettyCtor (name, tipes) =
55 P.hang (P.text name) 2 (P.sep (map prettyParens tipes))
57 TypeAlias name tvars tipe deriveables ->
58 alias <+> prettyDeriving deriveables
59 where
60 name' = P.text name <+> P.hsep (map P.text tvars)
61 alias = P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
63 -- TODO: Actually write out the contained data in these cases.
64 ImportEvent _ _ _ _ -> P.text (show decl)
65 ExportEvent _ _ _ -> P.text (show decl)
66 Fixity _ _ _ -> P.text (show decl)
68prettyDeriving deriveables =
69 case deriveables of
70 [] -> P.empty
71 [d] -> P.text "deriving" <+> P.text (show d)
72 ds -> P.text "deriving" <+>
73 P.parens (P.hsep $ P.punctuate P.comma $ map (P.text . show) ds)