git.iko.soy/elk
on 306a7ee help sign in
elk/src/AST/Declaration.hs
108 lines 2.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' portType def var
17 = Definition def
18 | Datatype String [String] [(String, [T.Type var])]
19 | TypeAlias String [String] (T.Type var)
20 | Port String portType
21 | Fixity Assoc Int String
24data Assoc = L | N | R
25 deriving (Eq)
28-- DECLARATION PHASES
30type SourceDecl =
31 Declaration' T.RawType Source.Def Var.Raw
34type ValidDecl =
35 Declaration' T.RawType Valid.Def Var.Raw
38type CanonicalDecl =
39 Declaration' (T.PortType Var.Canonical) Canonical.Def Var.Canonical
42-- BINARY CONVERSION
44instance Binary Assoc where
45 get =
46 do n <- getWord8
47 return $ case n of
48 0 -> L
49 1 -> N
50 2 -> R
51 _ -> error "Error reading valid associativity from serialized string"
53 put assoc =
54 putWord8 $
55 case assoc of
56 L -> 0
57 N -> 1
58 R -> 2
61-- PRETTY STRINGS
63assocToString :: Assoc -> String
64assocToString assoc =
65 case assoc of
66 L -> "left"
67 N -> "non"
68 R -> "right"
71instance (Pretty portType, Pretty def, Pretty var, Var.ToString var) =>
72 Pretty (Declaration' portType def var) where
73 pretty decl =
74 case decl of
75 Definition def -> pretty def
77 Datatype tipe tvars ctors ->
78 P.hang
79 (P.text "type" <+> P.text tipe <+> P.hsep (map P.text tvars))
80 4
81 (P.sep $ zipWith (<+>) seperators (map prettyCtor ctors))
82 where
83 seperators =
84 map P.text ("=" : repeat "|")
86 prettyCtor (name, tipes) =
87 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
89 TypeAlias name tvars tipe ->
90 P.hang
91 (P.text "type" <+> P.text "alias" <+> name' <+> P.equals)
92 4
93 (pretty tipe)
94 where
95 name' =
96 P.text name <+> P.hsep (map P.text tvars)
98 Port name tipe ->
99 P.text "port" <+> P.text name <+> P.colon <+> pretty tipe
101 Fixity assoc prec op ->
102 P.text "infix" <> assoc' <+> P.int prec <+> P.text op
103 where
104 assoc' =
105 case assoc of
106 L -> P.text "l"
107 N -> P.empty
108 R -> P.text "r"