@@ -1,106 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module SourceSyntax.Declaration where
3−
4−import Data.Binary
5−import qualified AST.Expression.Source as Source
6−import qualified AST.Expression.Valid as Valid
7−import qualified AST.Expression.Canonical as Canonical
8−import qualified AST.Type as T
9−import qualified AST.Variable as Var
10−import SourceSyntax.PrettyPrint
11−import Text.PrettyPrint as P
12−
13−data 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)
20−
21−data Assoc = L | N | R
22− deriving (Eq)
23−
24−data RawPort
25− = PPAnnotation String (T.Type Var.Raw)
26− | PPDef String Source.Expr
27− deriving (Show)
28−
29−data Port expr var
30− = Out String expr (T.Type var)
31− | In String (T.Type var)
32− deriving (Show)
33−
34−type SourceDecl = Declaration' RawPort Source.Def Var.Raw
35−type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
36−type CanonicalDecl = Declaration' (Port Canonical.Expr Var.Canonical)
37− Canonical.Def
38− Var.Canonical
39−
40−portName :: Port expr var -> String
41−portName port =
42− case port of
43− Out name _ _ -> name
44− In name _ -> name
45−
46−instance Show Assoc where
47− show assoc =
48− case assoc of
49− L -> "left"
50− N -> "non"
51− R -> "right"
52−
53−instance 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"
60−
61− put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
62−
63−instance (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
68−
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))
76−
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)
81−
82− Port port -> pretty port
83−
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"
90−
91−instance Pretty RawPort where
92− pretty port =
93− case port of
94− PPAnnotation name tipe -> prettyPort name ":" tipe
95− PPDef name expr -> prettyPort name "=" expr
96−
97−instance (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 ]
103−
104−
105−prettyPort :: (Pretty a) => String -> String -> a -> Doc
106−prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e