Commit 30dbd0e4 authored by Finn Teegen's avatar Finn Teegen
Browse files

Add external data declarations

parent 46ef60e0
......@@ -237,13 +237,18 @@ topDecls :: Parser a Token [Decl ()]
topDecls = topDecl `sepBy` semicolon
topDecl :: Parser a Token (Decl ())
topDecl = choice [ dataDecl, newtypeDecl, typeDecl, classDecl, instanceDecl
, defaultDecl, foreignDecl, infixDecl, functionDecl ]
topDecl = choice [ dataDecl, externalDataDecl, newtypeDecl, typeDecl
, classDecl, instanceDecl, defaultDecl
, foreignDecl, infixDecl, functionDecl ]
dataDecl :: Parser a Token (Decl ())
dataDecl = typeDeclLhs DataDecl KW_data <*> constrs <*> deriv
where constrs = equals <-*> constrDecl `sepBy1` bar `opt` []
externalDataDecl :: Parser a Token (Decl ())
externalDataDecl = decl <$> tokenPos KW_external <*> typeDeclLhs (,,) KW_data
where decl p (_, tc, tvs) = ExternalDataDecl p tc tvs
newtypeDecl :: Parser a Token (Decl ())
newtypeDecl = typeDeclLhs NewtypeDecl KW_newtype <*-> equals <*> newConstrDecl
<*> deriv
......
......@@ -92,10 +92,11 @@ ppSepBlock = vcat . map (\d -> text "" $+$ ppDecl d)
-- |Pretty print a declaration
ppDecl :: Decl a -> Doc
ppDecl (InfixDecl _ fix p ops) = ppPrec fix p <+> list (map ppInfixOp ops)
ppDecl (DataDecl _ tc tvs cs clss) =
ppDecl (DataDecl _ tc tvs cs clss) =
sep (ppTypeDeclLhs "data" tc tvs :
map indent (zipWith (<+>) (equals : repeat vbar) (map ppConstr cs) ++
[ppDeriving clss]))
ppDecl (ExternalDataDecl _ tc tvs) = ppTypeDeclLhs "external data" tc tvs
ppDecl (NewtypeDecl _ tc tvs nc clss) =
sep (ppTypeDeclLhs "newtype" tc tvs <+> equals :
map indent [ppNewConstr nc, ppDeriving clss])
......
......@@ -138,6 +138,12 @@ showsDecl (DataDecl pos ident idents consdecls classes)
. showsList showsConsDecl consdecls . space
. showsList showsQualIdent classes
. showsString ")"
showsDecl (ExternalDataDecl pos ident idents)
= showsString "(ExternalDataDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsList showsIdent idents
. showsString ")"
showsDecl (NewtypeDecl pos ident idents newconsdecl classes)
= showsString "(NewtypeDecl "
. showsPosition pos . space
......
......@@ -149,19 +149,20 @@ data KindExpr
-- |Declaration in a module
data Decl a
= InfixDecl Position Infix (Maybe Precedence) [Ident] -- infixl 5 (op), `fun`
| DataDecl Position Ident [Ident] [ConstrDecl] [QualIdent] -- data C a b = C1 a | C2 b deriving (D, ...)
| NewtypeDecl Position Ident [Ident] NewConstrDecl [QualIdent] -- newtype C a b = C a b deriving (D, ...)
| TypeDecl Position Ident [Ident] TypeExpr -- type C a b = D a b
| TypeSig Position [Ident] QualTypeExpr -- f, g :: Bool
| FunctionDecl Position a Ident [Equation a] -- f True = 1 ; f False = 0
| ForeignDecl Position CallConv (Maybe String) a Ident TypeExpr -- foreign ccall "lib.h" fun :: Int
| ExternalDecl Position [Var a] -- f, g external
| PatternDecl Position (Pattern a) (Rhs a) -- Just x = ...
| FreeDecl Position [Var a] -- x, y free
| DefaultDecl Position [TypeExpr] -- default (Int, Float)
| ClassDecl Position Context Ident Ident [Decl a] -- class C a => D a where {TypeSig|InfixDecl|FunctionDecl}
| InstanceDecl Position Context QualIdent InstanceType [Decl a] -- instance C a => M.D (N.T a b c) where {FunctionDecl}
= InfixDecl Position Infix (Maybe Precedence) [Ident] -- infixl 5 (op), `fun`
| DataDecl Position Ident [Ident] [ConstrDecl] [QualIdent] -- data C a b = C1 a | C2 b deriving (D, ...)
| ExternalDataDecl Position Ident [Ident]
| NewtypeDecl Position Ident [Ident] NewConstrDecl [QualIdent] -- newtype C a b = C a b deriving (D, ...)
| TypeDecl Position Ident [Ident] TypeExpr -- type C a b = D a b
| TypeSig Position [Ident] QualTypeExpr -- f, g :: Bool
| FunctionDecl Position a Ident [Equation a] -- f True = 1 ; f False = 0
| ForeignDecl Position CallConv (Maybe String) a Ident TypeExpr -- foreign ccall "lib.h" fun :: Int
| ExternalDecl Position [Var a] -- f, g external
| PatternDecl Position (Pattern a) (Rhs a) -- Just x = ...
| FreeDecl Position [Var a] -- x, y free
| DefaultDecl Position [TypeExpr] -- default (Int, Float)
| ClassDecl Position Context Ident Ident [Decl a] -- class C a => D a where {TypeSig|InfixDecl|FunctionDecl}
| InstanceDecl Position Context QualIdent InstanceType [Decl a] -- instance C a => M.D (N.T a b c) where {FunctionDecl}
deriving (Eq, Read, Show)
-- ---------------------------------------------------------------------------
......@@ -355,6 +356,7 @@ instance Functor Module where
instance Functor Decl where
fmap _ (InfixDecl p fix prec ops) = InfixDecl p fix prec ops
fmap _ (DataDecl p tc tvs cs clss) = DataDecl p tc tvs cs clss
fmap _ (ExternalDataDecl p tc tvs) = ExternalDataDecl p tc tvs
fmap _ (NewtypeDecl p tc tvs nc clss) = NewtypeDecl p tc tvs nc clss
fmap _ (TypeDecl p tc tvs ty) = TypeDecl p tc tvs ty
fmap _ (TypeSig p fs qty) = TypeSig p fs qty
......
......@@ -74,10 +74,11 @@ isInfixDecl _ = False
-- |Is the declaration a type declaration?
isTypeDecl :: Decl a -> Bool
isTypeDecl (DataDecl _ _ _ _ _) = True
isTypeDecl (NewtypeDecl _ _ _ _ _) = True
isTypeDecl (TypeDecl _ _ _ _) = True
isTypeDecl _ = False
isTypeDecl (DataDecl _ _ _ _ _) = True
isTypeDecl (ExternalDataDecl _ _ _) = True
isTypeDecl (NewtypeDecl _ _ _ _ _) = True
isTypeDecl (TypeDecl _ _ _ _) = True
isTypeDecl _ = False
-- |Is the declaration a default declaration?
isDefaultDecl :: Decl a -> Bool
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment