@@ -10,6 +10,8 @@ import qualified AST.Variable as Var
1010import AST.PrettyPrint
1111import Text.PrettyPrint as P
1212
13+
14+
1315data Declaration' port def var
1416 = Definition def
1517 | Datatype String [String] [(String, [T.Type var])]
@@ -38,12 +40,14 @@ type CanonicalDecl = Declaration' (Port Canonical.Expr Var.Canonical)
3840 Canonical.Def
3941 Var.Canonical
4042
43+
4144portName :: Port expr var -> String
4245portName port =
4346 case port of
4447 Out name _ _ -> name
4548 In name _ -> name
4649
50+
4751assocToString :: Assoc -> String
4852assocToString assoc =
4953 case assoc of
@@ -51,15 +55,27 @@ assocToString assoc =
5155 N -> "non"
5256 R -> "right"
5357
58+
59+-- BINARY CONVERSION
60+
5461instance 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+ get =
63+ do n <- getWord8
64+ return $ case n of
65+ 0 -> L
66+ 1 -> N
67+ 2 -> R
68+ _ -> error "Error reading valid associativity from serialized string"
6169
62− put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
70+ put assoc =
71+ putWord8 $
72+ case assoc of
73+ L -> 0
74+ N -> 1
75+ R -> 2
76+
77+
78+-- PRETTY STRINGS
6379
6480instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
6581 Pretty (Declaration' port def var) where
@@ -68,40 +84,61 @@ instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
6884 Definition def -> pretty def
6985
7086 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))
87+ P.hang
88+ (P.text "type" <+> P.text tipe <+> P.hsep (map P.text tvars))
89+ 4
90+ (P.sep $ zipWith (<+>) seperators (map prettyCtor ctors))
91+ where
92+ seperators =
93+ map P.text ("=" : repeat "|")
94+
95+ prettyCtor (name, tipes) =
96+ P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
7797
7898 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)
99+ P.hang
100+ (P.text "type" <+> P.text "alias" <+> name' <+> P.equals)
101+ 4
102+ (pretty tipe)
103+ where
104+ name' =
105+ P.text name <+> P.hsep (map P.text tvars)
82106
83107 Port port -> pretty port
84108
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"
109+ Fixity assoc prec op ->
110+ P.text "infix" <> assoc' <+> P.int prec <+> P.text op
111+ where
112+ assoc' =
113+ case assoc of
114+ L -> P.text "l"
115+ N -> P.empty
116+ R -> P.text "r"
117+
91118
92119instance Pretty RawPort where
93120 pretty port =
94121 case port of
95− PPAnnotation name tipe -> prettyPort name ":" tipe
96− PPDef name expr -> prettyPort name "=" expr
122+ PPAnnotation name tipe ->
123+ prettyPort name ":" tipe
124+
125+ PPDef name expr ->
126+ prettyPort name "=" expr
127+
97128
98129instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
99130 pretty port =
100131 case port of
101− In name tipe -> prettyPort name ":" tipe
102− Out name expr tipe -> P.vcat [ prettyPort name ":" tipe
103− , prettyPort name "=" expr ]
132+ In name tipe ->
133+ prettyPort name ":" tipe
134+
135+ Out name expr tipe ->
136+ P.vcat
137+ [ prettyPort name ":" tipe
138+ , prettyPort name "=" expr
139+ ]
104140
105141
106142prettyPort :: (Pretty a) => String -> String -> a -> Doc
107−prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e
143+prettyPort name op e =
144+ P.text "port" <+> P.text name <+> P.text op <+> pretty e