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