{- |
    Module      :  $Header$
    Description :  Checks extensions
    Copyright   :  (c)        2016 Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

   First of all, the compiler scans a source file for file-header pragmas
   that may activate language extensions.
-}
module Checks.ExtensionCheck (extensionCheck) where

import qualified Control.Monad.State as S (State, execState, modify)

import Curry.Base.Position
import Curry.Base.Pretty
import Curry.Syntax

import Base.Messages (Message, posMessage)

import CompilerOpts

extensionCheck :: Options -> Module a -> ([KnownExtension], [Message])
extensionCheck :: Options -> Module a -> ([KnownExtension], [Message])
extensionCheck opts :: Options
opts mdl :: Module a
mdl = EXCM () -> EXCState -> ([KnownExtension], [Message])
forall a. EXCM a -> EXCState -> ([KnownExtension], [Message])
execEXC (Module a -> EXCM ()
forall a. Module a -> EXCM ()
checkModule Module a
mdl) EXCState
initState
  where
    initState :: EXCState
initState = [KnownExtension] -> [Message] -> EXCState
EXCState (Options -> [KnownExtension]
optExtensions Options
opts) []

type EXCM = S.State EXCState

data EXCState = EXCState
  { EXCState -> [KnownExtension]
extensions :: [KnownExtension]
  , EXCState -> [Message]
errors     :: [Message]
  }

execEXC :: EXCM a -> EXCState -> ([KnownExtension], [Message])
execEXC :: EXCM a -> EXCState -> ([KnownExtension], [Message])
execEXC ecm :: EXCM a
ecm s :: EXCState
s =
  let s' :: EXCState
s' = EXCM a -> EXCState -> EXCState
forall s a. State s a -> s -> s
S.execState EXCM a
ecm EXCState
s in (EXCState -> [KnownExtension]
extensions EXCState
s', [Message] -> [Message]
forall a. [a] -> [a]
reverse ([Message] -> [Message]) -> [Message] -> [Message]
forall a b. (a -> b) -> a -> b
$ EXCState -> [Message]
errors EXCState
s')

enableExtension :: KnownExtension -> EXCM ()
enableExtension :: KnownExtension -> EXCM ()
enableExtension e :: KnownExtension
e = (EXCState -> EXCState) -> EXCM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((EXCState -> EXCState) -> EXCM ())
-> (EXCState -> EXCState) -> EXCM ()
forall a b. (a -> b) -> a -> b
$ \s :: EXCState
s -> EXCState
s { extensions :: [KnownExtension]
extensions = KnownExtension
e KnownExtension -> [KnownExtension] -> [KnownExtension]
forall a. a -> [a] -> [a]
: EXCState -> [KnownExtension]
extensions EXCState
s }

report :: Message -> EXCM ()
report :: Message -> EXCM ()
report msg :: Message
msg = (EXCState -> EXCState) -> EXCM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((EXCState -> EXCState) -> EXCM ())
-> (EXCState -> EXCState) -> EXCM ()
forall a b. (a -> b) -> a -> b
$ \s :: EXCState
s -> EXCState
s { errors :: [Message]
errors = Message
msg Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: EXCState -> [Message]
errors EXCState
s }

ok :: EXCM ()
ok :: EXCM ()
ok = () -> EXCM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- The extension check iterates over all given pragmas in the module and
-- gathers all extensions mentioned in a language pragma. An error is reported
-- if an extension is unknown.

checkModule :: Module a -> EXCM ()
checkModule :: Module a -> EXCM ()
checkModule (Module _ ps :: [ModulePragma]
ps _ _ _ _) = (ModulePragma -> EXCM ()) -> [ModulePragma] -> EXCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModulePragma -> EXCM ()
checkPragma [ModulePragma]
ps

checkPragma :: ModulePragma -> EXCM ()
checkPragma :: ModulePragma -> EXCM ()
checkPragma (LanguagePragma _ exts :: [Extension]
exts) = (Extension -> EXCM ()) -> [Extension] -> EXCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Extension -> EXCM ()
checkExtension [Extension]
exts
checkPragma (OptionsPragma  _  _ _) = EXCM ()
ok

checkExtension :: Extension -> EXCM ()
checkExtension :: Extension -> EXCM ()
checkExtension (KnownExtension   _ e :: KnownExtension
e) = KnownExtension -> EXCM ()
enableExtension KnownExtension
e
checkExtension (UnknownExtension p :: Position
p e :: String
e) = Message -> EXCM ()
report (Message -> EXCM ()) -> Message -> EXCM ()
forall a b. (a -> b) -> a -> b
$ Position -> String -> Message
errUnknownExtension Position
p String
e

-- ---------------------------------------------------------------------------
-- Error messages
-- ---------------------------------------------------------------------------

errUnknownExtension :: Position -> String -> Message
errUnknownExtension :: Position -> String -> Message
errUnknownExtension p :: Position
p e :: String
e = Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Position
p (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$
  String -> Doc
text "Unknown language extension:" Doc -> Doc -> Doc
<+> String -> Doc
text String
e