Merge branch 'typeclassesAndModules' into correctImportExport

src/Curry/Base/Ident.hs

@@ -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
 -- ---------------------------------------------------------------------------

src/Curry/Syntax/Lexer.hs

@@ -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)

src/Curry/Syntax/Parser.hs

@@ -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

src/Curry/Syntax/Pretty.hs

@@ -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
 -- ---------------------------------------------------------------------------

src/Curry/Syntax/ShowModule.hs

@@ -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 "

src/Curry/Syntax/Type.hs

@@ -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) 

src/Curry/Syntax/Utils.hs

@@ -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!

test/Parser/Deriving.curry

+
+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