{- |
Module      :  ./HasCASL/HToken.hs
Description :  parsers for HasCASL tokens
Copyright   :  (c) Christian Maeder and Uni Bremen 2002-2004
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

parser for HasCASL IDs extending "Common.Keywords" and "Common.Token"
-}

module HasCASL.HToken where

import Common.Id
import Common.Keywords
import Common.Lexer
import Common.Parsec
import Common.Token

import Text.ParserCombinators.Parsec

-- * HasCASL keyword handling

-- | HasCASL's reserved symbols in lambda terms and patterns
hascasl_reserved_ops :: [String]
hascasl_reserved_ops :: [String]
hascasl_reserved_ops =
    [String
dotS String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exMark, String
cDot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exMark, String
asP, String
lamS] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
casl_reserved_ops

-- | HasCASL's reserved symbols in function types
hascasl_type_ops :: [String]
hascasl_type_ops :: [String]
hascasl_type_ops = [String
funS, String
pFun, String
contFun, String
pContFun, String
prodS, String
timesS, String
quMark]

-- | HasCASL's reserved words
hascasl_reserved_words :: [String]
hascasl_reserved_words :: [String]
hascasl_reserved_words =
    [String
asS, String
inS, String
functS, String
functS String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sS, String
classS, String
classS String -> String -> String
forall a. [a] -> [a] -> [a]
++ "es", String
instanceS,
     String
instanceS String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sS, String
programS, String
programS String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sS, String
caseS, String
ofS, String
letS,
     String
derivingS, String
internalS, String
whereS] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
casl_reserved_words

-- | HasCASL's identifier words ('scanAnyWords')
scanHCWords :: GenParser Char st String
scanHCWords :: GenParser Char st String
scanHCWords = [String] -> GenParser Char st String -> GenParser Char st String
forall st. [String] -> CharParser st String -> CharParser st String
reserved [String]
hascasl_reserved_words GenParser Char st String
forall st. CharParser st String
scanAnyWords

-- | HasCASL's identifier signs ('scanAnySigns')
scanHCSigns :: GenParser Char st String
scanHCSigns :: GenParser Char st String
scanHCSigns = [String] -> GenParser Char st String -> GenParser Char st String
forall st. [String] -> CharParser st String -> CharParser st String
reserved [String]
hascasl_reserved_ops GenParser Char st String
forall st. CharParser st String
scanAnySigns

-- | symbols illegal in types and variables
hascasl_reserved_tops :: [String]
hascasl_reserved_tops :: [String]
hascasl_reserved_tops = String
assignS String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
lessS String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
barS String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
formula_ops

-- | symbols illegal in types, variables and constructors
hcKeysFew :: ([String], [String])
hcKeysFew :: ([String], [String])
hcKeysFew =
  ([String]
hascasl_reserved_tops [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
hascasl_reserved_ops, [String]
hascasl_reserved_words)

-- * HasCASL 'Id' parsers

-- | non-type variables
var :: GenParser Char st Id
var :: GenParser Char st Id
var = ([Token] -> Id)
-> ParsecT String st Identity [Token] -> GenParser Char st Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Token] -> Id
mkId (ParsecT String st Identity [Token] -> GenParser Char st Id)
-> ParsecT String st Identity [Token] -> GenParser Char st Id
forall a b. (a -> b) -> a -> b
$ ([String], [String]) -> ParsecT String st Identity [Token]
forall st. ([String], [String]) -> GenParser Char st [Token]
start ([String], [String])
hcKeysFew

-- | the HasCASL keys for 'mixId'
hcKeys :: ([String], [String])
hcKeys :: ([String], [String])
hcKeys = ([String]
hascasl_reserved_ops, [String]
hascasl_reserved_words)

-- | if-then-else-identifier
ite :: GenParser Char st [Token]
ite :: GenParser Char st [Token]
ite = do
    Token
i <- CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
pToken (CharParser st String -> CharParser st Token)
-> CharParser st String -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ CharParser st String -> CharParser st String
forall st a. CharParser st a -> CharParser st a
keyWord (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
ifS
    Token
p <- CharParser st Token
forall st. CharParser st Token
placeT
    Token
t <- CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
pToken (CharParser st String -> CharParser st Token)
-> CharParser st String -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ CharParser st String -> CharParser st String
forall st a. CharParser st a -> CharParser st a
keyWord (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
thenS
    let ts :: [Token]
ts = [Token
i, Token
p , Token
t]
    [Token]
es <- [Token] -> GenParser Char st [Token] -> GenParser Char st [Token]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Token]
ts (GenParser Char st [Token] -> GenParser Char st [Token])
-> GenParser Char st [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ GenParser Char st [Token] -> GenParser Char st [Token]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st [Token] -> GenParser Char st [Token])
-> GenParser Char st [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ do
      Token
q <- CharParser st Token
forall st. CharParser st Token
placeT
      Token
e <- CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
pToken (CharParser st String -> CharParser st Token)
-> CharParser st String -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ CharParser st String -> CharParser st String
forall st a. CharParser st a -> CharParser st a
keyWord (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
elseS
      [Token] -> GenParser Char st [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token] -> GenParser Char st [Token])
-> [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ [Token]
ts [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
q, Token
e]
    [Token] -> GenParser Char st [Token] -> GenParser Char st [Token]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Token]
es (GenParser Char st [Token] -> GenParser Char st [Token])
-> GenParser Char st [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ do
      Token
r <- CharParser st Token
forall st. CharParser st Token
placeT
      [Token] -> GenParser Char st [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token] -> GenParser Char st [Token])
-> [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ [Token]
es [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
r]

-- | operation 'Id' (reserved stuff excluded)
opId :: GenParser Char st Id
opId :: GenParser Char st Id
opId = ([String], [String])
-> ([String], [String]) -> GenParser Char st Id
forall st.
([String], [String])
-> ([String], [String]) -> GenParser Char st Id
mixId ([String], [String])
hcKeys ([String], [String])
hcKeys GenParser Char st Id -> String -> GenParser Char st Id
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "id"

-- | constructor 'Id'
hconsId :: GenParser Char st Id
hconsId :: GenParser Char st Id
hconsId = ([String], [String])
-> ([String], [String]) -> GenParser Char st Id
forall st.
([String], [String])
-> ([String], [String]) -> GenParser Char st Id
mixId (String
barS String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
hascasl_reserved_ops, [String]
hascasl_reserved_words) ([String], [String])
hcKeys

-- | simple 'Id' without compound list (only a words)
typeVar :: GenParser Char st Id
typeVar :: GenParser Char st Id
typeVar = (Token -> Id)
-> ParsecT String st Identity Token -> GenParser Char st Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token -> Id
simpleIdToId (ParsecT String st Identity Token -> GenParser Char st Id)
-> ParsecT String st Identity Token -> GenParser Char st Id
forall a b. (a -> b) -> a -> b
$ CharParser st String -> ParsecT String st Identity Token
forall st. CharParser st String -> CharParser st Token
pToken CharParser st String
forall st. CharParser st String
scanHCWords

-- | simple 'Id' possibly with compound list
classId :: GenParser Char st Id
classId :: GenParser Char st Id
classId = do
    Token
s <- CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
pToken CharParser st String
forall st. CharParser st String
scanHCWords
    (c :: [Id]
c, p :: Range
p) <- ([Id], Range)
-> ParsecT String st Identity ([Id], Range)
-> ParsecT String st Identity ([Id], Range)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([], Range
nullRange) (ParsecT String st Identity ([Id], Range)
 -> ParsecT String st Identity ([Id], Range))
-> ParsecT String st Identity ([Id], Range)
-> ParsecT String st Identity ([Id], Range)
forall a b. (a -> b) -> a -> b
$ ([String], [String]) -> ParsecT String st Identity ([Id], Range)
forall st. ([String], [String]) -> GenParser Char st ([Id], Range)
comps ([String], [String])
hcKeys
    Id -> GenParser Char st Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> GenParser Char st Id) -> Id -> GenParser Char st Id
forall a b. (a -> b) -> a -> b
$ [Token] -> [Id] -> Range -> Id
Id [Token
s] [Id]
c Range
p