git.iko.soy/elk
on d10f370 help sign in
elk/compiler/SourceSyntax/Declaration.hs
99 lines 2.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module SourceSyntax.Declaration where
4import Data.Binary
5import qualified SourceSyntax.Expression as Expr
6import qualified SourceSyntax.Type as T
7import SourceSyntax.PrettyPrint
8import Text.PrettyPrint as P
10data Declaration' port def
11 = Definition def
12 | Datatype String [String] [(String,[T.Type])]
13 | TypeAlias String [String] T.Type
14 | Port port
15 | Fixity Assoc Int String
16 deriving (Show)
18data Assoc = L | N | R
19 deriving (Eq)
21data ParsePort
22 = PPAnnotation String T.Type
23 | PPDef String Expr.ParseExpr
24 deriving (Show)
26data Port
27 = Out String Expr.Expr T.Type
28 | In String T.Type
29 deriving (Show)
31portName :: Port -> String
32portName port =
33 case port of
34 Out name _ _ -> name
35 In name _ -> name
37type ParseDeclaration = Declaration' ParsePort Expr.ParseDef
38type Declaration = Declaration' Port Expr.Def
40instance Show Assoc where
41 show assoc =
42 case assoc of
43 L -> "left"
44 N -> "non"
45 R -> "right"
47instance Binary Assoc where
48 get = do n <- getWord8
49 return $ case n of
50 0 -> L
51 1 -> N
52 2 -> R
53 _ -> error "Error reading valid associativity from serialized string"
55 put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
57instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where
58 pretty decl =
59 case decl of
60 Definition def -> pretty def
62 Datatype tipe tvars ctors ->
63 P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
64 (P.sep $ zipWith join ("=" : repeat "|") ctors)
65 where
66 join c ctor = P.text c <+> prettyCtor ctor
67 prettyCtor (name, tipes) =
68 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
70 TypeAlias name tvars tipe ->
71 P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
72 where
73 name' = P.text name <+> P.hsep (map P.text tvars)
75 Port port -> pretty port
77 Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
78 where
79 assoc' = case assoc of
80 L -> P.text "l"
81 N -> P.empty
82 R -> P.text "r"
84instance Pretty ParsePort where
85 pretty port =
86 case port of
87 PPAnnotation name tipe -> prettyPort name ":" tipe
88 PPDef name expr -> prettyPort name "=" expr
90instance Pretty Port where
91 pretty port =
92 case port of
93 In name tipe -> prettyPort name ":" tipe
94 Out name expr tipe -> P.vcat [ prettyPort name ":" tipe
95 , prettyPort name "=" expr ]
98prettyPort :: (Pretty a) => String -> String -> a -> Doc
99prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e