{- |
    Module      :  $Header$
    Description :  Curry language extensions
    Copyright   :  (c) 2013 - 2014 Björn Peemöller
                       2016        Finn Teegen
    License     :  BSD-3-clause

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

    This module provides the data structures for Curry language extensions.
-}

module Curry.Syntax.Extension
  ( -- * Extensions
    Extension (..), KnownExtension (..), classifyExtension, kielExtensions
    -- * Tools
  , Tool (..), classifyTool
  ) where

import Data.Binary
import Data.Char           (toUpper)
import Control.Monad

import Curry.Base.Ident    (Ident (..))
import Curry.Base.Position
import Curry.Base.SpanInfo

-- |Specified language extensions, either known or unknown.
data Extension
  = KnownExtension   SpanInfo KnownExtension -- ^ a known extension
  | UnknownExtension SpanInfo String         -- ^ an unknown extension
    deriving (Extension -> Extension -> Bool
(Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool) -> Eq Extension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extension -> Extension -> Bool
$c/= :: Extension -> Extension -> Bool
== :: Extension -> Extension -> Bool
$c== :: Extension -> Extension -> Bool
Eq, ReadPrec [Extension]
ReadPrec Extension
Int -> ReadS Extension
ReadS [Extension]
(Int -> ReadS Extension)
-> ReadS [Extension]
-> ReadPrec Extension
-> ReadPrec [Extension]
-> Read Extension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Extension]
$creadListPrec :: ReadPrec [Extension]
readPrec :: ReadPrec Extension
$creadPrec :: ReadPrec Extension
readList :: ReadS [Extension]
$creadList :: ReadS [Extension]
readsPrec :: Int -> ReadS Extension
$creadsPrec :: Int -> ReadS Extension
Read, Int -> Extension -> ShowS
[Extension] -> ShowS
Extension -> String
(Int -> Extension -> ShowS)
-> (Extension -> String)
-> ([Extension] -> ShowS)
-> Show Extension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extension] -> ShowS
$cshowList :: [Extension] -> ShowS
show :: Extension -> String
$cshow :: Extension -> String
showsPrec :: Int -> Extension -> ShowS
$cshowsPrec :: Int -> Extension -> ShowS
Show)

instance HasSpanInfo Extension where
  getSpanInfo :: Extension -> SpanInfo
getSpanInfo (KnownExtension   spi :: SpanInfo
spi _) = SpanInfo
spi
  getSpanInfo (UnknownExtension spi :: SpanInfo
spi _) = SpanInfo
spi
  
  setSpanInfo :: SpanInfo -> Extension -> Extension
setSpanInfo spi :: SpanInfo
spi (KnownExtension   _ ke :: KnownExtension
ke) = SpanInfo -> KnownExtension -> Extension
KnownExtension SpanInfo
spi KnownExtension
ke
  setSpanInfo spi :: SpanInfo
spi (UnknownExtension _ s :: String
s)  = SpanInfo -> String -> Extension
UnknownExtension SpanInfo
spi String
s

instance HasPosition Extension where
  getPosition :: Extension -> Position
getPosition = Extension -> Position
forall a. HasSpanInfo a => a -> Position
getStartPosition
  setPosition :: Position -> Extension -> Extension
setPosition = Position -> Extension -> Extension
forall a. HasSpanInfo a => Position -> a -> a
setStartPosition

instance Binary Extension where
  put :: Extension -> Put
put (KnownExtension   p :: SpanInfo
p e :: KnownExtension
e) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SpanInfo -> Put
forall t. Binary t => t -> Put
put SpanInfo
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KnownExtension -> Put
forall t. Binary t => t -> Put
put KnownExtension
e
  put (UnknownExtension p :: SpanInfo
p e :: String
e) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SpanInfo -> Put
forall t. Binary t => t -> Put
put SpanInfo
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
e

  get :: Get Extension
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> (SpanInfo -> KnownExtension -> Extension)
-> Get SpanInfo -> Get KnownExtension -> Get Extension
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SpanInfo -> KnownExtension -> Extension
KnownExtension Get SpanInfo
forall t. Binary t => Get t
get Get KnownExtension
forall t. Binary t => Get t
get
      1 -> (SpanInfo -> String -> Extension)
-> Get SpanInfo -> Get String -> Get Extension
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SpanInfo -> String -> Extension
UnknownExtension Get SpanInfo
forall t. Binary t => Get t
get Get String
forall t. Binary t => Get t
get
      _ -> String -> Get Extension
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for Extension"

instance Binary KnownExtension where
  put :: KnownExtension -> Put
put AnonFreeVars       = Word8 -> Put
putWord8 0
  put CPP                = Word8 -> Put
putWord8 1
  put FunctionalPatterns = Word8 -> Put
putWord8 2
  put NegativeLiterals   = Word8 -> Put
putWord8 3
  put NoImplicitPrelude  = Word8 -> Put
putWord8 4

  get :: Get KnownExtension
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
AnonFreeVars
      1 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
CPP
      2 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
FunctionalPatterns
      3 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
NegativeLiterals
      4 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
NoImplicitPrelude
      _ -> String -> Get KnownExtension
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for KnownExtension"

-- |Known language extensions of Curry.
data KnownExtension
  = AnonFreeVars              -- ^ anonymous free variables
  | CPP                       -- ^ C preprocessor
  | FunctionalPatterns        -- ^ functional patterns
  | NegativeLiterals          -- ^ negative literals
  | NoImplicitPrelude         -- ^ no implicit import of the prelude
    deriving (KnownExtension -> KnownExtension -> Bool
(KnownExtension -> KnownExtension -> Bool)
-> (KnownExtension -> KnownExtension -> Bool) -> Eq KnownExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KnownExtension -> KnownExtension -> Bool
$c/= :: KnownExtension -> KnownExtension -> Bool
== :: KnownExtension -> KnownExtension -> Bool
$c== :: KnownExtension -> KnownExtension -> Bool
Eq, ReadPrec [KnownExtension]
ReadPrec KnownExtension
Int -> ReadS KnownExtension
ReadS [KnownExtension]
(Int -> ReadS KnownExtension)
-> ReadS [KnownExtension]
-> ReadPrec KnownExtension
-> ReadPrec [KnownExtension]
-> Read KnownExtension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KnownExtension]
$creadListPrec :: ReadPrec [KnownExtension]
readPrec :: ReadPrec KnownExtension
$creadPrec :: ReadPrec KnownExtension
readList :: ReadS [KnownExtension]
$creadList :: ReadS [KnownExtension]
readsPrec :: Int -> ReadS KnownExtension
$creadsPrec :: Int -> ReadS KnownExtension
Read, Int -> KnownExtension -> ShowS
[KnownExtension] -> ShowS
KnownExtension -> String
(Int -> KnownExtension -> ShowS)
-> (KnownExtension -> String)
-> ([KnownExtension] -> ShowS)
-> Show KnownExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KnownExtension] -> ShowS
$cshowList :: [KnownExtension] -> ShowS
show :: KnownExtension -> String
$cshow :: KnownExtension -> String
showsPrec :: Int -> KnownExtension -> ShowS
$cshowsPrec :: Int -> KnownExtension -> ShowS
Show, Int -> KnownExtension
KnownExtension -> Int
KnownExtension -> [KnownExtension]
KnownExtension -> KnownExtension
KnownExtension -> KnownExtension -> [KnownExtension]
KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
(KnownExtension -> KnownExtension)
-> (KnownExtension -> KnownExtension)
-> (Int -> KnownExtension)
-> (KnownExtension -> Int)
-> (KnownExtension -> [KnownExtension])
-> (KnownExtension -> KnownExtension -> [KnownExtension])
-> (KnownExtension -> KnownExtension -> [KnownExtension])
-> (KnownExtension
    -> KnownExtension -> KnownExtension -> [KnownExtension])
-> Enum KnownExtension
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
$cenumFromThenTo :: KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
enumFromTo :: KnownExtension -> KnownExtension -> [KnownExtension]
$cenumFromTo :: KnownExtension -> KnownExtension -> [KnownExtension]
enumFromThen :: KnownExtension -> KnownExtension -> [KnownExtension]
$cenumFromThen :: KnownExtension -> KnownExtension -> [KnownExtension]
enumFrom :: KnownExtension -> [KnownExtension]
$cenumFrom :: KnownExtension -> [KnownExtension]
fromEnum :: KnownExtension -> Int
$cfromEnum :: KnownExtension -> Int
toEnum :: Int -> KnownExtension
$ctoEnum :: Int -> KnownExtension
pred :: KnownExtension -> KnownExtension
$cpred :: KnownExtension -> KnownExtension
succ :: KnownExtension -> KnownExtension
$csucc :: KnownExtension -> KnownExtension
Enum, KnownExtension
KnownExtension -> KnownExtension -> Bounded KnownExtension
forall a. a -> a -> Bounded a
maxBound :: KnownExtension
$cmaxBound :: KnownExtension
minBound :: KnownExtension
$cminBound :: KnownExtension
Bounded)

-- |Classifies a 'String' as an 'Extension'
classifyExtension :: Ident -> Extension
classifyExtension :: Ident -> Extension
classifyExtension i :: Ident
i = case ReadS KnownExtension
forall a. Read a => ReadS a
reads String
extName of
  [(e :: KnownExtension
e, "")] -> SpanInfo -> KnownExtension -> Extension
KnownExtension   (Ident -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo Ident
i) KnownExtension
e
  _         -> SpanInfo -> String -> Extension
UnknownExtension (Ident -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo Ident
i) String
extName
  where extName :: String
extName = Ident -> String
idName Ident
i

-- |'Extension's available by Kiel's Curry compilers.
kielExtensions :: [KnownExtension]
kielExtensions :: [KnownExtension]
kielExtensions = [KnownExtension
AnonFreeVars, KnownExtension
FunctionalPatterns]

-- |Different Curry tools which may accept compiler options.
data Tool = KICS2 | PAKCS | CYMAKE | FRONTEND | UnknownTool String
    deriving (Tool -> Tool -> Bool
(Tool -> Tool -> Bool) -> (Tool -> Tool -> Bool) -> Eq Tool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c== :: Tool -> Tool -> Bool
Eq, ReadPrec [Tool]
ReadPrec Tool
Int -> ReadS Tool
ReadS [Tool]
(Int -> ReadS Tool)
-> ReadS [Tool] -> ReadPrec Tool -> ReadPrec [Tool] -> Read Tool
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tool]
$creadListPrec :: ReadPrec [Tool]
readPrec :: ReadPrec Tool
$creadPrec :: ReadPrec Tool
readList :: ReadS [Tool]
$creadList :: ReadS [Tool]
readsPrec :: Int -> ReadS Tool
$creadsPrec :: Int -> ReadS Tool
Read, Int -> Tool -> ShowS
[Tool] -> ShowS
Tool -> String
(Int -> Tool -> ShowS)
-> (Tool -> String) -> ([Tool] -> ShowS) -> Show Tool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tool] -> ShowS
$cshowList :: [Tool] -> ShowS
show :: Tool -> String
$cshow :: Tool -> String
showsPrec :: Int -> Tool -> ShowS
$cshowsPrec :: Int -> Tool -> ShowS
Show)

instance Binary Tool where
  put :: Tool -> Put
put KICS2           = Word8 -> Put
putWord8 0
  put PAKCS           = Word8 -> Put
putWord8 1
  put CYMAKE          = Word8 -> Put
putWord8 2
  put FRONTEND        = Word8 -> Put
putWord8 3
  put (UnknownTool s :: String
s) = Word8 -> Put
putWord8 4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
s

  get :: Get Tool
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> Tool -> Get Tool
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
KICS2
      1 -> Tool -> Get Tool
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
PAKCS
      2 -> Tool -> Get Tool
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
CYMAKE
      3 -> Tool -> Get Tool
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
FRONTEND
      4 -> (String -> Tool) -> Get String -> Get Tool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Tool
UnknownTool Get String
forall t. Binary t => Get t
get
      _ -> String -> Get Tool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for Tool"

-- |Classifies a 'String' as a 'Tool'
classifyTool :: String -> Tool
classifyTool :: String -> Tool
classifyTool str :: String
str = case ReadS Tool
forall a. Read a => ReadS a
reads ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
str) of
  [(t :: Tool
t, "")] -> Tool
t
  _         -> String -> Tool
UnknownTool String
str