git.iko.soy/elk
on 578dfb8 help sign in
elk/compiler/SourceSyntax/Declaration.hs
81 lines 2.6 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 | Port String Type (Maybe (Expr.LExpr tipe var))
14 | Fixity Assoc Int String
15 deriving (Eq, Show)
17data Assoc = L | N | R
18 deriving (Eq)
20data Derivation = Json | Binary | RecordConstructor
21 deriving (Eq, Show)
23instance Binary Derivation where
24 get = do n <- getWord8
25 return $ case n of
26 0 -> Json
27 1 -> Binary
28 2 -> RecordConstructor
30 put derivation =
31 case derivation of
32 Json -> putWord8 0
33 Binary -> putWord8 1
34 RecordConstructor -> putWord8 2
36instance Show Assoc where
37 show assoc =
38 case assoc of
39 L -> "left"
40 N -> "non"
41 R -> "right"
43instance Pretty (Declaration t v) where
44 pretty decl =
45 case decl of
46 Definition def -> pretty def
48 Datatype tipe tvars ctors deriveables ->
49 P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
50 (P.sep $ zipWith join ("=" : repeat "|") ctors) <+> prettyDeriving deriveables
51 where
52 join c ctor = P.text c <+> prettyCtor ctor
53 prettyCtor (name, tipes) =
54 P.hang (P.text name) 2 (P.sep (map prettyParens tipes))
56 TypeAlias name tvars tipe deriveables ->
57 alias <+> prettyDeriving deriveables
58 where
59 name' = P.text name <+> P.hsep (map P.text tvars)
60 alias = P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
62 Port name tipe maybeExpr ->
63 let port = P.text "port" <+> P.text name in
64 P.vcat [ port <+> P.colon <+> pretty tipe
65 , maybe P.empty (\expr -> port <+> P.equals <+> pretty expr) maybeExpr
66 ]
68 Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
69 where
70 assoc' = case assoc of
71 L -> P.text "l"
72 N -> P.empty
73 R -> P.text "r"
75prettyDeriving :: [Derivation] -> Doc
76prettyDeriving deriveables =
77 case deriveables of
78 [] -> P.empty
79 [d] -> P.text "deriving" <+> P.text (show d)
80 ds -> P.text "deriving" <+>
81 P.parens (P.hsep $ P.punctuate P.comma $ map (P.text . show) ds)