2013-06-14 01:00:24 +00:00
|
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
module SourceSyntax.Declaration where
|
|
|
|
|
|
|
|
import Data.Data
|
|
|
|
import qualified SourceSyntax.Expression as Expr
|
2013-07-07 16:13:40 +00:00
|
|
|
import SourceSyntax.Type
|
2013-10-19 14:39:23 +00:00
|
|
|
import SourceSyntax.PrettyPrint
|
|
|
|
import Text.PrettyPrint as P
|
2013-06-14 01:00:24 +00:00
|
|
|
|
2013-06-14 03:25:00 +00:00
|
|
|
data Declaration tipe var
|
|
|
|
= Definition (Expr.Def tipe var)
|
2013-07-07 16:13:40 +00:00
|
|
|
| Datatype String [String] [(String,[Type])]
|
|
|
|
| TypeAlias String [String] Type
|
2013-06-14 03:25:00 +00:00
|
|
|
| ImportEvent String (Expr.LExpr tipe var) String Type
|
2013-06-14 01:00:24 +00:00
|
|
|
| ExportEvent String String Type
|
2013-06-14 01:35:37 +00:00
|
|
|
| Fixity Assoc Int String
|
2013-07-07 16:13:40 +00:00
|
|
|
deriving (Eq, Show)
|
2013-06-14 01:35:37 +00:00
|
|
|
|
|
|
|
data Assoc = L | N | R
|
2013-09-05 00:18:02 +00:00
|
|
|
deriving (Eq)
|
|
|
|
|
|
|
|
instance Show Assoc where
|
|
|
|
show assoc =
|
|
|
|
case assoc of
|
|
|
|
L -> "left"
|
|
|
|
N -> "non"
|
2013-10-19 14:39:23 +00:00
|
|
|
R -> "right"
|
|
|
|
|
|
|
|
instance Pretty (Declaration t v) where
|
|
|
|
pretty decl =
|
|
|
|
case decl of
|
|
|
|
Definition def -> pretty def
|
|
|
|
|
|
|
|
Datatype tipe tvars ctors ->
|
|
|
|
P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
|
|
|
|
(P.sep $ zipWith join ("=" : repeat "|") ctors)
|
|
|
|
where
|
|
|
|
join c ctor = P.text c <+> prettyCtor ctor
|
|
|
|
prettyCtor (name, tipes) =
|
|
|
|
P.hang (P.text name) 2 (P.sep (map prettyParens tipes))
|
|
|
|
|
|
|
|
TypeAlias name tvars tipe ->
|
|
|
|
let alias = P.text name <+> P.hsep (map P.text tvars) in
|
|
|
|
P.hang (P.text "type" <+> alias <+> P.equals) 4 (pretty tipe)
|
|
|
|
|
|
|
|
-- TODO: actually write out the other cases. They are currently unused, but
|
|
|
|
-- this is probably going to be a bug someday.
|
|
|
|
_ -> P.text (show decl)
|