diff --git a/CHANGELOG.md b/CHANGELOG.md index 4db51a9e86be53f50a9d73ef93906893fa386345..93f22676d2cec61e4dbf5aad00b4a20221e73df1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,8 @@ Under development (0.4.1) * Split checking and expansion of export specification into two subsequent steps (by Yannik Potdevin, fixes #1335) * Consider parenthesized type expressions in the Curry AST (by Katharina Rahf) + * Added syntax extension `ExistentialQuantification` that allows the use + of existentially quantified types in data and newtype constructors Version 0.4.0 ============= diff --git a/src/Checks/SyntaxCheck.hs b/src/Checks/SyntaxCheck.hs index 1c82dbcd0e83ae4b326889284936bd1096b1ed6c..92c0d035dfabf693bf0a9f29038470da737b4475 100644 --- a/src/Checks/SyntaxCheck.hs +++ b/src/Checks/SyntaxCheck.hs @@ -28,7 +28,7 @@ module Checks.SyntaxCheck (syntaxCheck) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>), (<*>)) #endif -import Control.Monad (unless, when) +import Control.Monad ((>=>), unless, when) import qualified Control.Monad.State as S (State, runState, gets, modify) import Data.List (insertBy, intersect, nub, partition) import Data.Maybe (isJust, isNothing) @@ -495,15 +495,30 @@ checkDecls bindDecl ds = do -- -- --------------------------------------------------------------------------- checkDeclRhs :: [Ident] -> Decl -> SCM Decl -checkDeclRhs _ (DataDecl p tc tvs cs) = - DataDecl p tc tvs <$> mapM checkDeclLabels cs -checkDeclRhs bvs (TypeSig p vs ty) = +checkDeclRhs _ (DataDecl p tc tvs cs) = + DataDecl p tc tvs <$> mapM (checkConstrDecl >=> checkDeclLabels) cs +checkDeclRhs _ (NewtypeDecl p tc tvs c) = + NewtypeDecl p tc tvs <$> checkNewconstrDecl c +checkDeclRhs bvs (TypeSig p vs ty) = (\vs' -> TypeSig p vs' ty) <$> mapM (checkLocalVar bvs) vs -checkDeclRhs _ (FunctionDecl p f eqs) = +checkDeclRhs _ (FunctionDecl p f eqs) = FunctionDecl p f <$> mapM checkEquation eqs -checkDeclRhs _ (PatternDecl p t rhs) = +checkDeclRhs _ (PatternDecl p t rhs) = PatternDecl p t <$> checkRhs rhs -checkDeclRhs _ d = return d +checkDeclRhs _ d = return d + +checkConstrDecl :: ConstrDecl -> SCM ConstrDecl +checkConstrDecl c@(ConstrDecl _ evs _ _) = checkExistVars evs >> return c +checkConstrDecl c@(ConOpDecl _ evs _ _ _) = checkExistVars evs >> return c +checkConstrDecl c@(RecordDecl _ evs _ _) = checkExistVars evs >> return c + +checkNewconstrDecl :: NewConstrDecl -> SCM NewConstrDecl +checkNewconstrDecl c@(NewConstrDecl _ evs _ _) = checkExistVars evs >> return c +checkNewConstrDecl c@(NewRecordDecl _ evs _ _) = checkExistVars evs >> return c + +checkExistVars :: [Ident] -> SCM () +checkExistVars [] = ok +checkExistVars (ev:_) = checkExistentialQuantificationExtension $ idPosition ev checkDeclLabels :: ConstrDecl -> SCM ConstrDecl checkDeclLabels rd@(RecordDecl _ _ _ fs) = do @@ -1034,6 +1049,10 @@ checkFPTerm _ (InfixFuncPattern _ _ _) = ok -- do not check again -- Miscellaneous functions -- --------------------------------------------------------------------------- +checkExistentialQuantificationExtension :: Position -> SCM () +checkExistentialQuantificationExtension p = checkUsedExtension p + "Existentially quantified types" ExistentialQuantification + checkFuncPatsExtension :: Position -> SCM () checkFuncPatsExtension p = checkUsedExtension p "Functional Patterns" FunctionalPatterns diff --git a/src/CompilerOpts.hs b/src/CompilerOpts.hs index 9b633b6953181ba905537f31cb7982cde2cacab6..a60231e0d1e4803a0fc65810c39909a71e17c988 100644 --- a/src/CompilerOpts.hs +++ b/src/CompilerOpts.hs @@ -233,6 +233,8 @@ extensions = , "desugar negated literals as negative literal") , ( NoImplicitPrelude , "NoImplicitPrelude" , "do not implicitly import the Prelude") + , ( ExistentialQuantification , "ExistentialQuantification" + , "enable existentially quantified types") ] -- -----------------------------------------------------------------------------