git.iko.soy/elk
on 368e33e help sign in
elk/compiler/SourceSyntax/Declaration.hs
106 lines 3.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module SourceSyntax.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 SourceSyntax.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
19 deriving (Show)
21data Assoc = L | N | R
22 deriving (Eq)
24data RawPort
25 = PPAnnotation String (T.Type Var.Raw)
26 | PPDef String Source.Expr
27 deriving (Show)
29data Port expr var
30 = Out String expr (T.Type var)
31 | In String (T.Type var)
32 deriving (Show)
34type SourceDecl = Declaration' RawPort Source.Def Var.Raw
35type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
36type CanonicalDecl = Declaration' (Port Canonical.Expr Var.Canonical)
37 Canonical.Def
38 Var.Canonical
40portName :: Port expr var -> String
41portName port =
42 case port of
43 Out name _ _ -> name
44 In name _ -> name
46instance Show Assoc where
47 show assoc =
48 case assoc of
49 L -> "left"
50 N -> "non"
51 R -> "right"
53instance Binary Assoc where
54 get = do n <- getWord8
55 return $ case n of
56 0 -> L
57 1 -> N
58 2 -> R
59 _ -> error "Error reading valid associativity from serialized string"
61 put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
63instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
64 Pretty (Declaration' port def var) where
65 pretty decl =
66 case decl of
67 Definition def -> pretty def
69 Datatype tipe tvars ctors ->
70 P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
71 (P.sep $ zipWith join ("=" : repeat "|") ctors)
72 where
73 join c ctor = P.text c <+> prettyCtor ctor
74 prettyCtor (name, tipes) =
75 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
77 TypeAlias name tvars tipe ->
78 P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
79 where
80 name' = P.text name <+> P.hsep (map P.text tvars)
82 Port port -> pretty port
84 Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
85 where
86 assoc' = case assoc of
87 L -> P.text "l"
88 N -> P.empty
89 R -> P.text "r"
91instance Pretty RawPort where
92 pretty port =
93 case port of
94 PPAnnotation name tipe -> prettyPort name ":" tipe
95 PPDef name expr -> prettyPort name "=" expr
97instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
98 pretty port =
99 case port of
100 In name tipe -> prettyPort name ":" tipe
101 Out name expr tipe -> P.vcat [ prettyPort name ":" tipe
102 , prettyPort name "=" expr ]
105prettyPort :: (Pretty a) => String -> String -> a -> Doc
106prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e