git.iko.soy/elk
on 21ccfbc help sign in
elk/src/AST/Declaration.hs
154 lines 3.6 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
14-- DECLARATIONS
16data Declaration' port def var expr
17 = Definition def
18 | Datatype String [String] [(String, [T.Type var])]
19 | TypeAlias String [String] (T.Type var)
20 | Port port
21 | Fixity Assoc Int String
24data Assoc = L | N | R
25 deriving (Eq)
28-- DECLARATION PHASES
30type SourceDecl =
31 Declaration' RawPort Source.Def Var.Raw Source.Expr
34type ValidDecl =
35 Declaration' (Port Valid.Expr T.RawType) Valid.Def Var.Raw Valid.Expr
38type CanonicalDecl =
39 Declaration' CanonicalPort Canonical.Def Var.Canonical Canonical.Expr
42-- PORTS
44data RawPort
45 = PortAnnotation String T.RawType
46 | PortDefinition String Source.Expr
49data Port expr tipe
50 = Inbound String tipe
51 | Outbound String expr tipe
54type CanonicalPort =
55 Port Canonical.Expr (T.PortType Var.Canonical)
58getName :: Port expr tipe -> String
59getName port =
60 case port of
61 Inbound name _ -> name
62 Outbound name _ _ -> name
65-- BINARY CONVERSION
67instance Binary Assoc where
68 get =
69 do n <- getWord8
70 return $ case n of
71 0 -> L
72 1 -> N
73 2 -> R
74 _ -> error "Error reading valid associativity from serialized string"
76 put assoc =
77 putWord8 $
78 case assoc of
79 L -> 0
80 N -> 1
81 R -> 2
84-- PRETTY STRINGS
86assocToString :: Assoc -> String
87assocToString assoc =
88 case assoc of
89 L -> "left"
90 N -> "non"
91 R -> "right"
94instance (Pretty port, Pretty def, Pretty var, Var.ToString var, Pretty expr) =>
95 Pretty (Declaration' port def var expr) where
96 pretty decl =
97 case decl of
98 Definition def -> pretty def
100 Datatype tipe tvars ctors ->
101 P.hang
102 (P.text "type" <+> P.text tipe <+> P.hsep (map P.text tvars))
103 4
104 (P.sep $ zipWith (<+>) seperators (map prettyCtor ctors))
105 where
106 seperators =
107 map P.text ("=" : repeat "|")
109 prettyCtor (name, tipes) =
110 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
112 TypeAlias name tvars tipe ->
113 P.hang
114 (P.text "type" <+> P.text "alias" <+> name' <+> P.equals)
115 4
116 (pretty tipe)
117 where
118 name' =
119 P.text name <+> P.hsep (map P.text tvars)
121 Port port ->
122 pretty port
124 Fixity assoc prec op ->
125 P.text "infix" <> assoc' <+> P.int prec <+> P.text op
126 where
127 assoc' =
128 case assoc of
129 L -> P.text "l"
130 N -> P.empty
131 R -> P.text "r"
134instance Pretty RawPort where
135 pretty port =
136 case port of
137 PortAnnotation name tipe ->
138 P.text "port" <+> P.text name <+> P.colon <+> pretty tipe
140 PortDefinition name expr ->
141 P.text "port" <+> P.text name <+> P.equals <+> pretty expr
144instance (Pretty expr, Pretty tipe) => Pretty (Port expr tipe) where
145 pretty port =
146 case port of
147 Inbound name tipe ->
148 P.text "port" <+> P.text name <+> P.colon <+> pretty tipe
150 Outbound name expr tipe ->
151 P.vcat
152 [ P.text "port" <+> P.text name <+> P.colon <+> pretty tipe
153 , P.hang (P.text "port" <+> P.text name <+> P.equals) 4 (pretty expr)
154 ]