module Curry.Syntax.Extension
(
Extension (..), KnownExtension (..), classifyExtension, kielExtensions
, 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
data Extension
= KnownExtension SpanInfo KnownExtension
| UnknownExtension SpanInfo String
deriving (Eq, Read, Show)
instance HasSpanInfo Extension where
getSpanInfo (KnownExtension spi _) = spi
getSpanInfo (UnknownExtension spi _) = spi
setSpanInfo spi (KnownExtension _ ke) = KnownExtension spi ke
setSpanInfo spi (UnknownExtension _ s) = UnknownExtension spi s
instance HasPosition Extension where
getPosition = getStartPosition
setPosition = setStartPosition
instance Binary Extension where
put (KnownExtension p e) = putWord8 0 >> put p >> put e
put (UnknownExtension p e) = putWord8 1 >> put p >> put e
get = do
x <- getWord8
case x of
0 -> liftM2 KnownExtension get get
1 -> liftM2 UnknownExtension get get
_ -> fail "Invalid encoding for Extension"
instance Binary KnownExtension where
put AnonFreeVars = putWord8 0
put CPP = putWord8 1
put FunctionalPatterns = putWord8 2
put NegativeLiterals = putWord8 3
put NoImplicitPrelude = putWord8 4
get = do
x <- getWord8
case x of
0 -> return AnonFreeVars
1 -> return CPP
2 -> return FunctionalPatterns
3 -> return NegativeLiterals
4 -> return NoImplicitPrelude
_ -> fail "Invalid encoding for KnownExtension"
data KnownExtension
= AnonFreeVars
| CPP
| FunctionalPatterns
| NegativeLiterals
| NoImplicitPrelude
deriving (Eq, Read, Show, Enum, Bounded)
classifyExtension :: Ident -> Extension
classifyExtension i = case reads extName of
[(e, "")] -> KnownExtension (getSpanInfo i) e
_ -> UnknownExtension (getSpanInfo i) extName
where extName = idName i
kielExtensions :: [KnownExtension]
kielExtensions = [AnonFreeVars, FunctionalPatterns]
data Tool = KICS2 | PAKCS | CYMAKE | FRONTEND | UnknownTool String
deriving (Eq, Read, Show)
instance Binary Tool where
put KICS2 = putWord8 0
put PAKCS = putWord8 1
put CYMAKE = putWord8 2
put FRONTEND = putWord8 3
put (UnknownTool s) = putWord8 4 >> put s
get = do
x <- getWord8
case x of
0 -> return KICS2
1 -> return PAKCS
2 -> return CYMAKE
3 -> return FRONTEND
4 -> fmap UnknownTool get
_ -> fail "Invalid encoding for Tool"
classifyTool :: String -> Tool
classifyTool str = case reads (map toUpper str) of
[(t, "")] -> t
_ -> UnknownTool str