Integration of language pragmas

src/Checks.hs

@@ -53,11 +53,10 @@ kindCheck _ env (Module ps m es is ds)
 --                 disambiguated, variables are renamed
 -- * Environment:  remains unchanged
 syntaxCheck :: Monad m => Check m Module
-syntaxCheck opts env (Module ps m es is ds)
-  | null msgs = right (env, Module ps m es is ds')
+syntaxCheck opts env mdl
+  | null msgs = right (env, mdl')
   | otherwise = left msgs
-  where (ds', msgs) = SC.syntaxCheck opts (moduleIdent env)
-                      (valueEnv env) (tyConsEnv env) ds
+  where (mdl', msgs) = SC.syntaxCheck opts (valueEnv env) (tyConsEnv env) mdl
 
 -- |Check the precedences of infix operators.
 --

src/Checks/SyntaxCheck.lhs

@@ -56,14 +56,13 @@ generated. Finally, all declarations are checked within the resulting
 environment. In addition, this process will also rename the local variables.
 \begin{verbatim}
 
-> syntaxCheck :: Options -> ModuleIdent -> ValueEnv -> TCEnv -> [Decl]
->             -> ([Decl], [Message])
-> syntaxCheck opts m tyEnv tcEnv decls =
+> syntaxCheck :: Options -> ValueEnv -> TCEnv -> Module -> (Module, [Message])
+> syntaxCheck opts tyEnv tcEnv mdl@(Module _ m _ _ ds) =
 >   case findMultiples $ concatMap constrs typeDecls of
->     []  -> runSC (checkModule decls) state
->     css -> (decls, map errMultipleDataConstructor css)
+>     []  -> runSC (checkModule mdl) state
+>     css -> (mdl, map errMultipleDataConstructor css)
 >   where
->     typeDecls  = filter isTypeDecl decls
+>     typeDecls  = filter isTypeDecl ds
 >     rEnv       = globalEnv $ fmap (renameInfo tcEnv) tyEnv
 >     state      = initState (optExtensions opts) m rEnv
 
@@ -316,13 +315,23 @@ a goal. Note that all declarations in the goal must be considered as
 local declarations.
 \begin{verbatim}
 
-> checkModule :: [Decl] -> SCM [Decl]
-> checkModule decls = do
+> checkModule :: Module -> SCM Module
+> checkModule (Module ps m es is decls) = do
+>   mapM_ checkPragma ps
 >   mapM_ bindTypeDecl (rds ++ dds)
->   liftM2 (++) (mapM checkTypeDecl tds) (checkTopDecls vds)
+>   decls' <- liftM2 (++) (mapM checkTypeDecl tds) (checkTopDecls vds)
+>   return $ Module ps m es is decls'
 >   where (tds, vds) = partition isTypeDecl decls
 >         (rds, dds) = partition isRecordDecl tds
 
+> checkPragma :: ModulePragma -> SCM ()
+> checkPragma (LanguagePragma _ exts) = mapM_ checkExtension exts
+> checkPragma (OptionsPragma  _  _ _) = ok
+
+> checkExtension :: Extension -> SCM ()
+> checkExtension (KnownExtension   _ e) = enableExtension e
+> checkExtension (UnknownExtension p e) = report $ errUnknownExtension p e
+
 > checkTypeDecl :: Decl -> SCM Decl
 > checkTypeDecl rec@(TypeDecl _ r _ (RecordType fs rty)) = do
 >   checkRecordExtension $ idPosition r
@@ -980,22 +989,22 @@ Miscellaneous functions.
 \begin{verbatim}
 
 > checkFuncPatsExtension :: Position -> SCM ()
-> checkFuncPatsExtension p = checkExtension p
+> checkFuncPatsExtension p = checkUsedExtension p
 >   "Functional Patterns" FunctionalPatterns
 
 > checkRecordExtension :: Position -> SCM ()
-> checkRecordExtension p = checkExtension p "Records" Records
+> checkRecordExtension p = checkUsedExtension p "Records" Records
 
 > checkAnonFreeVarsExtension :: Position -> SCM ()
-> checkAnonFreeVarsExtension p = checkExtension p
+> checkAnonFreeVarsExtension p = checkUsedExtension p
 >   "Anonymous free variables" AnonFreeVars
 
-> checkExtension :: Position -> String -> KnownExtension -> SCM ()
-> checkExtension pos msg ext = do
+> checkUsedExtension :: Position -> String -> KnownExtension -> SCM ()
+> checkUsedExtension pos msg ext = do
 >   enabled <- hasExtension ext
 >   unless enabled $ do
 >     report $ errMissingLanguageExtension pos msg ext
->     enableExtension ext
+>     enableExtension ext -- to avoid multiple warnings
 
 > typeArity :: TypeExpr -> Int
 > typeArity (ArrowType _ t2) = 1 + typeArity t2
@@ -1122,6 +1131,10 @@ Error messages.
 >   [ "Expexting", escName anonId, "after", escName (mkIdent "|")
 >   , "in the record pattern" ]
 
+> errUnknownExtension :: Position -> String -> Message
+> errUnknownExtension p e = posMessage p $
+>   text "Unknown language extension:" <+> text e
+
 > errMissingLanguageExtension :: Position -> String -> KnownExtension -> Message
 > errMissingLanguageExtension p what ext = posMessage p $
 >   text what <+> text "are not supported in standard Curry." $+$

src/CurryDeps.hs

@@ -29,7 +29,8 @@ import Curry.Base.Pretty
 import Curry.Files.Filenames
 import Curry.Files.PathUtils
 import Curry.Syntax
-  (Module (..),  ImportDecl (..), parseHeader, patchModuleId)
+  ( Module (..), ImportDecl (..), parseHeader, patchModuleId
+  , hasLanguageExtension)
 
 import Base.Messages
 import Base.SCC (scc)
@@ -90,20 +91,21 @@ sourceDeps opts sEnv fn = readHeader fn >>= moduleDeps opts sEnv fn
 
 -- |Retrieve the dependencies of a given module
 moduleDeps :: Options -> SourceEnv -> FilePath -> Module -> CYIO SourceEnv
-moduleDeps opts sEnv fn (Module _ m _ is _) = case Map.lookup m sEnv of
+moduleDeps opts sEnv fn mdl@(Module _ m _ _ _) = case Map.lookup m sEnv of
   Just  _ -> return sEnv
   Nothing -> do
-    let imps  = imports opts m is
+    let imps  = imports opts mdl
         sEnv' = Map.insert m (Source fn imps) sEnv
     foldM (moduleIdentDeps opts) sEnv' imps
 
 -- |Retrieve the imported modules and add the import of the Prelude
 -- according to the compiler options.
-imports :: Options -> ModuleIdent -> [ImportDecl] -> [ModuleIdent]
-imports opts m ds = nub $
-     [preludeMIdent | m /= preludeMIdent && implicitPrelude]
-  ++ [m' | ImportDecl _ m' _ _ _ <- ds]
-  where implicitPrelude = NoImplicitPrelude `notElem` optExtensions opts
+imports :: Options -> Module -> [ModuleIdent]
+imports opts mdl@(Module _ m _ is _) = nub $
+     [preludeMIdent | m /= preludeMIdent && not noImplicitPrelude]
+  ++ [m' | ImportDecl _ m' _ _ _ <- is]
+  where noImplicitPrelude = NoImplicitPrelude `elem` optExtensions opts
+                              || mdl `hasLanguageExtension` NoImplicitPrelude
 
 -- |Retrieve the dependencies for a given 'ModuleIdent'
 moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> CYIO SourceEnv

test/PragmaError.curry

+{-# LANGUAGE ERROR #-}
+module PragmaError where
+

test/PragmaRecords.curry

+{-# LANGUAGE Records #-}
+module PragmaRecords where
+
+type Rec = { bool :: Bool, int :: Int }