git.iko.soy/elk
on 2ec798e help sign in
elk/src/AST/Declaration.hs
152 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
14data Declaration' port def var
15 = Definition def
16 | Datatype String [String] [(String, [T.Type var])]
17 | TypeAlias String [String] (T.Type var)
18 | Port port
19 | Fixity Assoc Int String
22data Assoc = L | N | R
23 deriving (Eq)
26data RawPort
27 = InputAnnotation String T.RawType
28 | OutputAnnotation String T.RawType
29 | OutputDef String Source.Expr
32data Port expr var
33 = Out String expr (T.Type var)
34 | In String (T.Type var)
37type SourceDecl =
38 Declaration' RawPort Source.Def Var.Raw
41type ValidDecl =
42 Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
45type CanonicalDecl =
46 Declaration' (Port Canonical.Expr Var.Canonical) Canonical.Def Var.Canonical
49portName :: Port expr var -> String
50portName port =
51 case port of
52 Out name _ _ -> name
53 In name _ -> name
56assocToString :: Assoc -> String
57assocToString assoc =
58 case assoc of
59 L -> "left"
60 N -> "non"
61 R -> "right"
64-- BINARY CONVERSION
66instance Binary Assoc where
67 get =
68 do n <- getWord8
69 return $ case n of
70 0 -> L
71 1 -> N
72 2 -> R
73 _ -> error "Error reading valid associativity from serialized string"
75 put assoc =
76 putWord8 $
77 case assoc of
78 L -> 0
79 N -> 1
80 R -> 2
83-- PRETTY STRINGS
85instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
86 Pretty (Declaration' port def var) where
87 pretty decl =
88 case decl of
89 Definition def -> pretty def
91 Datatype tipe tvars ctors ->
92 P.hang
93 (P.text "type" <+> P.text tipe <+> P.hsep (map P.text tvars))
94 4
95 (P.sep $ zipWith (<+>) seperators (map prettyCtor ctors))
96 where
97 seperators =
98 map P.text ("=" : repeat "|")
100 prettyCtor (name, tipes) =
101 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
103 TypeAlias name tvars tipe ->
104 P.hang
105 (P.text "type" <+> P.text "alias" <+> name' <+> P.equals)
106 4
107 (pretty tipe)
108 where
109 name' =
110 P.text name <+> P.hsep (map P.text tvars)
112 Port port -> pretty port
114 Fixity assoc prec op ->
115 P.text "infix" <> assoc' <+> P.int prec <+> P.text op
116 where
117 assoc' =
118 case assoc of
119 L -> P.text "l"
120 N -> P.empty
121 R -> P.text "r"
124instance Pretty RawPort where
125 pretty port =
126 case port of
127 InputAnnotation name tipe ->
128 prettyPort "input" name ":" tipe
130 OutputAnnotation name tipe ->
131 prettyPort "output" name ":" tipe
133 OutputDef name expr ->
134 prettyPort "output" name "=" expr
137instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
138 pretty port =
139 case port of
140 In name tipe ->
141 prettyPort "input" name ":" tipe
143 Out name expr tipe ->
144 P.vcat
145 [ prettyPort "output" name ":" tipe
146 , prettyPort "output" name "=" expr
147 ]
150prettyPort :: (Pretty a) => String -> String -> String -> a -> Doc
151prettyPort keyword name op e =
152 P.text keyword <+> P.text name <+> P.text op <+> pretty e