Commit f48f1d38 authored by Matthias Böhm's avatar Matthias Böhm
Browse files

Merge branch 'typeclassesAndModules' into correctImportExport

parents 00797910 fac966ce
......@@ -40,7 +40,7 @@ module Curry.Base.Ident
-- * Predefined simple identifiers
-- ** Identifiers for modules
, emptyMIdent, mainMIdent, preludeMIdent
, emptyMIdent, mainMIdent, preludeMIdent, tcPreludeMIdent
-- ** Identifiers for types
, unitId, boolId, charId, intId, floatId, listId, ioId, successId, arrowId
-- ** Identifiers for constructors
......@@ -389,6 +389,10 @@ mainMIdent = ModuleIdent NoPos ["main"]
preludeMIdent :: ModuleIdent
preludeMIdent = ModuleIdent NoPos ["Prelude"]
-- | 'ModuleIdent' for type classes Prelude
tcPreludeMIdent :: ModuleIdent
tcPreludeMIdent = ModuleIdent NoPos ["TCPrelude"]
-- ---------------------------------------------------------------------------
-- Identifiers for types
-- ---------------------------------------------------------------------------
......
......@@ -83,7 +83,7 @@ data Category
| KW_case
| KW_class
| KW_data
-- | KW_deriving -- not supported yet
| KW_deriving
| KW_do
| KW_else
| KW_external
......@@ -235,6 +235,7 @@ instance Show Token where
showsPrec _ (Token KW_case _) = showsEscaped "case"
showsPrec _ (Token KW_class _) = showsEscaped "class"
showsPrec _ (Token KW_data _) = showsEscaped "data"
showsPrec _ (Token KW_deriving _) = showsEscaped "deriving"
showsPrec _ (Token KW_do _) = showsEscaped "do"
showsPrec _ (Token KW_else _) = showsEscaped "else"
showsPrec _ (Token KW_external _) = showsEscaped "external"
......@@ -347,6 +348,7 @@ keywords = Map.fromList
[ ("case" , KW_case )
, ("class" , KW_class )
, ("data" , KW_data )
, ("deriving", KW_deriving)
, ("do" , KW_do )
, ("else" , KW_else )
, ("external", KW_external)
......
......@@ -278,11 +278,13 @@ infixDeclLhs f = f <$> position <*> tokenOps infixKW
infixKW = [(KW_infix, Infix), (KW_infixl, InfixL), (KW_infixr, InfixR)]
dataDecl :: Parser Token Decl a
dataDecl = typeDeclLhs DataDecl KW_data <*> constrs
dataDecl = typeDeclLhsWithDeriving DataDecl KW_data <*> constrs
<*> optionMaybe deriving0
where constrs = equals <-*> constrDecl `sepBy1` bar `opt` []
newtypeDecl :: Parser Token Decl a
newtypeDecl = typeDeclLhs NewtypeDecl KW_newtype <*-> equals <*> newConstrDecl
newtypeDecl = typeDeclLhsWithDeriving NewtypeDecl KW_newtype <*-> equals <*> newConstrDecl
<*> optionMaybe deriving0
typeDecl :: Parser Token Decl a
typeDecl = typeDeclLhs TypeDecl KW_type <*-> equals <*> type0 True
......@@ -291,6 +293,14 @@ typeDeclLhs :: (Position -> Ident -> [Ident] -> a) -> Category
-> Parser Token a b
typeDeclLhs f kw = f <$> tokenPos kw <*> tycon <*> many anonOrTyvar
typeDeclLhsWithDeriving :: (Position -> Ident -> [Ident] -> a -> Maybe Deriving -> Decl)
-> Category -> Parser Token (a -> Maybe Deriving -> Decl) b
typeDeclLhsWithDeriving f kw = f <$> tokenPos kw <*> tycon <*> many anonOrTyvar
deriving0 :: Parser Token Deriving a
deriving0 = Deriving <$>
(token KW_deriving <-*> (parens (qIdent `sepBy` comma) <|> (:[]) <$> qIdent))
constrDecl :: Parser Token ConstrDecl a
constrDecl = position <**> (existVars <**> constr)
where
......
......@@ -71,11 +71,13 @@ ppSepBlock = vcat . map (\d -> text "" $+$ ppDecl d)
-- |Pretty print a declaration
ppDecl :: Decl -> Doc
ppDecl (InfixDecl _ fix p ops) = ppPrec fix p <+> list (map ppInfixOp ops)
ppDecl (DataDecl _ tc tvs cs) =
ppDecl (DataDecl _ tc tvs cs der) =
sep (ppTypeDeclLhs "data" tc tvs :
map indent (zipWith (<+>) (equals : repeat vbar) (map ppConstr cs)))
ppDecl (NewtypeDecl _ tc tvs nc) =
$$ nest 2 (if isJust der then ppDeriving (fromJust der) else empty)
ppDecl (NewtypeDecl _ tc tvs nc der) =
sep [ppTypeDeclLhs "newtype" tc tvs <+> equals,indent (ppNewConstr nc)]
$$ nest 2 (if isJust der then ppDeriving (fromJust der) else empty)
ppDecl (TypeDecl _ tc tvs ty) =
sep [ppTypeDeclLhs "type" tc tvs <+> equals,indent (ppTypeExpr 0 ty)]
ppDecl (TypeSig _ _ fs cx ty) =
......@@ -141,6 +143,11 @@ ppLocalDefs ds
| null ds = empty
| otherwise = indent (text "where" <+> ppBlock ds)
ppDeriving :: Deriving -> Doc
ppDeriving (Deriving qids) =
text "deriving" <+>
parens (hsep $ punctuate comma (map ppQIdent qids))
-- ---------------------------------------------------------------------------
-- Interfaces
-- ---------------------------------------------------------------------------
......
......@@ -102,19 +102,21 @@ showsDecl (InfixDecl pos infx prec idents)
. shows prec . space
. showsList showsIdent idents
. showsString ")"
showsDecl (DataDecl pos ident idents consdecls)
showsDecl (DataDecl pos ident idents consdecls der)
= showsString "(DataDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsList showsIdent idents . space
. showsList showsConsDecl consdecls
. showsDeriving der
. showsString ")"
showsDecl (NewtypeDecl pos ident idents newconsdecl)
showsDecl (NewtypeDecl pos ident idents newconsdecl der)
= showsString "(NewtypeDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsList showsIdent idents . space
. showsNewConsDecl newconsdecl
. showsDeriving der
. showsString ")"
showsDecl (TypeDecl pos ident idents typ)
= showsString "(TypeDecl "
......@@ -200,6 +202,13 @@ showsNewConsDecl (NewConstrDecl pos idents ident typ)
. showsTypeExpr typ
. showsString ")"
showsDeriving :: Maybe Deriving -> ShowS
showsDeriving (Just (Deriving clss))
= showsString "(Just (Deriving "
. showsList showsQualIdent clss
. showsString "))"
showsDeriving (Nothing) = showsString "Nothing"
showsTypeExpr :: TypeExpr -> ShowS
showsTypeExpr (ConstructorType qident types)
= showsString "(ConstructorType "
......
......@@ -23,7 +23,7 @@ module Curry.Syntax.Type
-- * Interface
, Interface (..), IImportDecl (..), IDecl (..)
-- * Declarations
, Decl (..), Infix (..), ConstrDecl (..), NewConstrDecl (..)
, Decl (..), Infix (..), ConstrDecl (..), NewConstrDecl (..), Deriving (..)
, CallConv (..), TypeExpr (..)
, Equation (..), Lhs (..), Rhs (..), CondExpr (..)
, Literal (..), Pattern (..), Expression (..), InfixOp (..)
......@@ -125,8 +125,8 @@ type Id = Int
-- |Declaration in a module
data Decl
= InfixDecl Position Infix Integer [Ident] -- infixl 5 (op), `fun` -- TODO: Make precedence optional and change to int
| DataDecl Position Ident [Ident] [ConstrDecl] -- data C a b = C1 a | C2 b
| NewtypeDecl Position Ident [Ident] NewConstrDecl -- newtype C a b = C a b
| DataDecl Position Ident [Ident] [ConstrDecl] (Maybe Deriving) -- data C a b = C1 a | C2 b [deriving Eq]
| NewtypeDecl Position Ident [Ident] NewConstrDecl (Maybe Deriving) -- newtype C a b = C a b [deriving Eq]
| TypeDecl Position Ident [Ident] TypeExpr -- type C a b = D a b
-- |as in the compile process, we pass along both expanded and unexpanded
-- type signatures, we have to provide a flag that indicates whether
......@@ -145,6 +145,10 @@ data Decl
| InstanceDecl Position SContext QualIdent TypeConstructor [Ident] [Decl] -- instance Foo a => Module1.Bar (Module2.TyCon a b c) where {FunctionDecl}
deriving (Read, Show, Data, Typeable)
-- | deriving declaration for data/newtype declarations
data Deriving = Deriving [QualIdent]
deriving (Eq, Read, Show, Data, Typeable)
-- ---------------------------------------------------------------------------
-- Infix declaration
-- ---------------------------------------------------------------------------
......@@ -424,10 +428,10 @@ instance Eq Expression where
instance Eq Decl where
(InfixDecl p1 f1 i1 ids1) == (InfixDecl p2 f2 i2 ids2)
= p1 == p2 && f1 == f2 && i1 == i2 && ids1 == ids2
(DataDecl p1 i1 ids1 cs1) == (DataDecl p2 i2 ids2 cs2)
= p1 == p2 && i1 == i2 && ids1 == ids2 && cs1 == cs2
(NewtypeDecl p1 i1 ids1 n1) == (NewtypeDecl p2 i2 ids2 n2)
= p1 == p2 && i1 == i2 && ids1 == ids2 && n1 == n2
(DataDecl p1 i1 ids1 cs1 d1) == (DataDecl p2 i2 ids2 cs2 d2)
= p1 == p2 && i1 == i2 && ids1 == ids2 && cs1 == cs2 && d1 == d2
(NewtypeDecl p1 i1 ids1 n1 d1) == (NewtypeDecl p2 i2 ids2 n2 d2)
= p1 == p2 && i1 == i2 && ids1 == ids2 && n1 == n2 && d1 == d2
(TypeDecl p1 id1 ids1 t1) == (TypeDecl p2 id2 ids2 t2)
= p1 == p2 && id1 == id2 && ids1 == ids2 && t1 == t2
(TypeSig p1 _ ids1 cx1 t1) == (TypeSig p2 _ ids2 cx2 t2)
......
......@@ -48,10 +48,10 @@ isInfixDecl _ = False
-- |Is the declaration a type declaration?
isTypeDecl :: Decl -> Bool
isTypeDecl (DataDecl _ _ _ _) = True
isTypeDecl (NewtypeDecl _ _ _ _) = True
isTypeDecl (TypeDecl _ _ _ _) = True
isTypeDecl _ = False
isTypeDecl (DataDecl _ _ _ _ _) = True
isTypeDecl (NewtypeDecl _ _ _ _ _) = True
isTypeDecl (TypeDecl _ _ _ _) = True
isTypeDecl _ = False
-- |Is the declaration a type signature?
isTypeSig :: Decl -> Bool
......@@ -95,12 +95,12 @@ isPatternDecl _ = False
-- |Is the declaration a data declaration?
isDataDecl :: Decl -> Bool
isDataDecl (DataDecl _ _ _ _) = True
isDataDecl (DataDecl _ _ _ _ _) = True
isDataDecl _ = False
-- |Is the declaration a newtype declaration?
isNewtypeDecl :: Decl -> Bool
isNewtypeDecl (NewtypeDecl _ _ _ _) = True
isNewtypeDecl (NewtypeDecl _ _ _ _ _) = True
isNewtypeDecl _ = False
-- |Convert an infix operator into an expression, preserving the type annotation!
......
data A0 a = A0 a
data A1 a = A1 a
deriving ()
data A2 a = A2 a
deriving Eq
data A3 a = A3 a
deriving (Eq)
data A4 a = A4 a
deriving (Eq, Ord)
data A5 a = A5 a
deriving (Eq, Ord, Show)
newtype A6 a = A6 a
newtype A7 a = A7 a
deriving ()
newtype A8 a = A8 a
deriving Eq
newtype A9 a = A9 a
deriving (Eq)
newtype A10 a = A10 a
deriving (Eq, Ord)
newtype A11 a = A11 a
deriving (Eq, Ord, Show)
data A12 a = A12 a
deriving (Prelude.Eq, P.Ord, Show)
{-
type X a = X a
deriving (Eq)
-}
\ No newline at end of file
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