git.iko.soy/elk
on bdfaa69 help sign in
elk/src/AST/Declaration.hs
107 lines 3.3 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
13data Declaration' port def var
14 = Definition def
15 | Datatype String [String] [(String, [T.Type var])]
16 | TypeAlias String [String] (T.Type var)
17 | Port port
18 | Fixity Assoc Int String
21data Assoc = L | N | R
22 deriving (Eq)
25data RawPort
26 = PPAnnotation String T.RawType
27 | PPDef String Source.Expr
30data Port expr var
31 = Out String expr (T.Type var)
32 | In String (T.Type var)
35type SourceDecl = Declaration' RawPort Source.Def Var.Raw
36type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
37type CanonicalDecl = Declaration' (Port Canonical.Expr Var.Canonical)
38 Canonical.Def
39 Var.Canonical
41portName :: Port expr var -> String
42portName port =
43 case port of
44 Out name _ _ -> name
45 In name _ -> name
47assocToString :: Assoc -> String
48assocToString assoc =
49 case assoc of
50 L -> "left"
51 N -> "non"
52 R -> "right"
54instance Binary Assoc where
55 get = do n <- getWord8
56 return $ case n of
57 0 -> L
58 1 -> N
59 2 -> R
60 _ -> error "Error reading valid associativity from serialized string"
62 put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
64instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
65 Pretty (Declaration' port def var) where
66 pretty decl =
67 case decl of
68 Definition def -> pretty def
70 Datatype tipe tvars ctors ->
71 P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
72 (P.sep $ zipWith join ("=" : repeat "|") ctors)
73 where
74 join c ctor = P.text c <+> prettyCtor ctor
75 prettyCtor (name, tipes) =
76 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
78 TypeAlias name tvars tipe ->
79 P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
80 where
81 name' = P.text name <+> P.hsep (map P.text tvars)
83 Port port -> pretty port
85 Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
86 where
87 assoc' = case assoc of
88 L -> P.text "l"
89 N -> P.empty
90 R -> P.text "r"
92instance Pretty RawPort where
93 pretty port =
94 case port of
95 PPAnnotation name tipe -> prettyPort name ":" tipe
96 PPDef name expr -> prettyPort name "=" expr
98instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
99 pretty port =
100 case port of
101 In name tipe -> prettyPort name ":" tipe
102 Out name expr tipe -> P.vcat [ prettyPort name ":" tipe
103 , prettyPort name "=" expr ]
106prettyPort :: (Pretty a) => String -> String -> a -> Doc
107prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e