git.iko.soy/elk
on defb40c help sign in
elk/src/AST/Declaration.hs
184 lines 4.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module AST.Declaration where
4import Data.Binary
5import qualified AST.Expression.General as General
6import qualified AST.Expression.Source as Source
7import qualified AST.Expression.Valid as Valid
8import qualified AST.Expression.Canonical as Canonical
9import qualified AST.Type as T
10import qualified AST.Variable as Var
11import AST.PrettyPrint
12import Text.PrettyPrint as P
15-- DECLARATIONS
17data Declaration' port def var expr
18 = Definition def
19 | Datatype String [String] [(String, [T.Type var])]
20 | TypeAlias String [String] (T.Type var)
21 | Port port
22 | Fixity Assoc Int String
25data Assoc = L | N | R
26 deriving (Eq)
29-- DECLARATION PHASES
31type SourceDecl =
32 Declaration' SourcePort Source.Def Var.Raw Source.Expr
35type ValidDecl =
36 Declaration' ValidPort Valid.Def Var.Raw Valid.Expr
39type CanonicalDecl =
40 Declaration' CanonicalPort Canonical.Def Var.Canonical Canonical.Expr
43-- PORTS
45data SourcePort
46 = PortAnnotation String T.RawType
47 | PortDefinition String Source.Expr
50data ValidPort
51 = In String T.RawType
52 | Out String Valid.Expr T.RawType
55newtype CanonicalPort
56 = CanonicalPort (General.PortImpl Canonical.Expr Var.Canonical)
59validPortName :: ValidPort -> String
60validPortName port =
61 case port of
62 In name _ -> name
63 Out name _ _ -> name
66-- BINARY CONVERSION
68instance Binary Assoc where
69 get =
70 do n <- getWord8
71 return $ case n of
72 0 -> L
73 1 -> N
74 2 -> R
75 _ -> error "Error reading valid associativity from serialized string"
77 put assoc =
78 putWord8 $
79 case assoc of
80 L -> 0
81 N -> 1
82 R -> 2
85-- PRETTY STRINGS
87assocToString :: Assoc -> String
88assocToString assoc =
89 case assoc of
90 L -> "left"
91 N -> "non"
92 R -> "right"
95instance (Pretty port, Pretty def, Pretty var, Var.ToString var, Pretty expr) =>
96 Pretty (Declaration' port def var expr) where
97 pretty decl =
98 case decl of
99 Definition def -> pretty def
101 Datatype tipe tvars ctors ->
102 P.hang
103 (P.text "type" <+> P.text tipe <+> P.hsep (map P.text tvars))
104 4
105 (P.sep $ zipWith (<+>) seperators (map prettyCtor ctors))
106 where
107 seperators =
108 map P.text ("=" : repeat "|")
110 prettyCtor (name, tipes) =
111 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
113 TypeAlias name tvars tipe ->
114 P.hang
115 (P.text "type" <+> P.text "alias" <+> name' <+> P.equals)
116 4
117 (pretty tipe)
118 where
119 name' =
120 P.text name <+> P.hsep (map P.text tvars)
122 Port port ->
123 pretty port
125 Fixity assoc prec op ->
126 P.text "infix" <> assoc' <+> P.int prec <+> P.text op
127 where
128 assoc' =
129 case assoc of
130 L -> P.text "l"
131 N -> P.empty
132 R -> P.text "r"
135instance Pretty SourcePort where
136 pretty port =
137 case port of
138 PortAnnotation name tipe ->
139 prettyPortType name tipe
141 PortDefinition name expr ->
142 prettyPortDef name expr
145instance Pretty ValidPort where
146 pretty port =
147 case port of
148 In name tipe ->
149 prettyPortType name tipe
151 Out name expr tipe ->
152 prettyPort name expr tipe
155instance Pretty CanonicalPort where
156 pretty (CanonicalPort impl) =
157 case impl of
158 General.In name tipe ->
159 prettyPortType name tipe
161 General.Out name expr tipe ->
162 prettyPort name expr tipe
164 General.Task name expr tipe ->
165 prettyPort name expr tipe
169prettyPort :: (Pretty expr, Pretty tipe) => String -> expr -> tipe -> P.Doc
170prettyPort name expr tipe =
171 P.vcat
172 [ prettyPortType name tipe
173 , prettyPortDef name expr
174 ]
177prettyPortType :: (Pretty tipe) => String -> tipe -> P.Doc
178prettyPortType name tipe =
179 P.text "port" <+> P.text name <+> P.colon <+> pretty tipe
182prettyPortDef :: (Pretty expr) => String -> expr -> P.Doc
183prettyPortDef name expr =
184 P.hang (P.text "port" <+> P.text name <+> P.equals) 4 (pretty expr)