git.iko.soy/elk
on ed22dbd help sign in
elk/src/AST/Declaration.hs
144 lines 3.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module AST.Declaration where
4import Data.Binary
5import qualified AST.Expression.Source as Source
6import qualified AST.Expression.Valid as Valid
7import qualified AST.Expression.Canonical as Canonical
8import qualified AST.Type as T
9import qualified AST.Variable as Var
10import AST.PrettyPrint
11import Text.PrettyPrint as P
15data Declaration' port def var
16 = Definition def
17 | Datatype String [String] [(String, [T.Type var])]
18 | TypeAlias String [String] (T.Type var)
19 | Port port
20 | Fixity Assoc Int String
23data Assoc = L | N | R
24 deriving (Eq)
27data RawPort
28 = PPAnnotation String T.RawType
29 | PPDef String Source.Expr
32data Port expr var
33 = Out String expr (T.Type var)
34 | In String (T.Type var)
37type SourceDecl = Declaration' RawPort Source.Def Var.Raw
38type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
39type CanonicalDecl = Declaration' (Port Canonical.Expr Var.Canonical)
40 Canonical.Def
41 Var.Canonical
44portName :: Port expr var -> String
45portName port =
46 case port of
47 Out name _ _ -> name
48 In name _ -> name
51assocToString :: Assoc -> String
52assocToString assoc =
53 case assoc of
54 L -> "left"
55 N -> "non"
56 R -> "right"
59-- BINARY CONVERSION
61instance Binary Assoc where
62 get =
63 do n <- getWord8
64 return $ case n of
65 0 -> L
66 1 -> N
67 2 -> R
68 _ -> error "Error reading valid associativity from serialized string"
70 put assoc =
71 putWord8 $
72 case assoc of
73 L -> 0
74 N -> 1
75 R -> 2
78-- PRETTY STRINGS
80instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
81 Pretty (Declaration' port def var) where
82 pretty decl =
83 case decl of
84 Definition def -> pretty def
86 Datatype tipe tvars ctors ->
87 P.hang
88 (P.text "type" <+> P.text tipe <+> P.hsep (map P.text tvars))
89 4
90 (P.sep $ zipWith (<+>) seperators (map prettyCtor ctors))
91 where
92 seperators =
93 map P.text ("=" : repeat "|")
95 prettyCtor (name, tipes) =
96 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
98 TypeAlias name tvars tipe ->
99 P.hang
100 (P.text "type" <+> P.text "alias" <+> name' <+> P.equals)
101 4
102 (pretty tipe)
103 where
104 name' =
105 P.text name <+> P.hsep (map P.text tvars)
107 Port port -> pretty port
109 Fixity assoc prec op ->
110 P.text "infix" <> assoc' <+> P.int prec <+> P.text op
111 where
112 assoc' =
113 case assoc of
114 L -> P.text "l"
115 N -> P.empty
116 R -> P.text "r"
119instance Pretty RawPort where
120 pretty port =
121 case port of
122 PPAnnotation name tipe ->
123 prettyPort name ":" tipe
125 PPDef name expr ->
126 prettyPort name "=" expr
129instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
130 pretty port =
131 case port of
132 In name tipe ->
133 prettyPort name ":" tipe
135 Out name expr tipe ->
136 P.vcat
137 [ prettyPort name ":" tipe
138 , prettyPort name "=" expr
139 ]
142prettyPort :: (Pretty a) => String -> String -> a -> Doc
143prettyPort name op e =
144 P.text "port" <+> P.text name <+> P.text op <+> pretty e