91 lines
1.9 KiB
Haskell
91 lines
1.9 KiB
Haskell
module CommonParsing where
|
|
import Data.Char
|
|
import Data.Functor
|
|
import Text.Parsec
|
|
import Text.Parsec.Char
|
|
import Text.Parsec.Combinator
|
|
|
|
type Parser a b = Parsec String a b
|
|
|
|
kw :: String -> Parser a ()
|
|
kw s = try $ string s <* spaces $> ()
|
|
|
|
kwIf :: Parser a ()
|
|
kwIf = kw "if"
|
|
|
|
kwThen :: Parser a ()
|
|
kwThen = kw "then"
|
|
|
|
kwElse :: Parser a ()
|
|
kwElse = kw "else"
|
|
|
|
kwElsif :: Parser a ()
|
|
kwElsif = kw "elsif"
|
|
|
|
kwWhile :: Parser a ()
|
|
kwWhile = kw "while"
|
|
|
|
kwState :: Parser a ()
|
|
kwState = kw "state"
|
|
|
|
kwEffect :: Parser a ()
|
|
kwEffect = kw "effect"
|
|
|
|
kwCombine :: Parser a ()
|
|
kwCombine = kw "combine"
|
|
|
|
kwRand :: Parser a ()
|
|
kwRand = kw "rand"
|
|
|
|
kwFunction :: Parser a ()
|
|
kwFunction = kw "function"
|
|
|
|
kwSorted :: Parser a ()
|
|
kwSorted = kw "sorted"
|
|
|
|
kwLet :: Parser a ()
|
|
kwLet = kw "let"
|
|
|
|
kwTraverser :: Parser a ()
|
|
kwTraverser = kw "traverser"
|
|
|
|
kwReturn :: Parser a ()
|
|
kwReturn = kw "return"
|
|
|
|
op :: String -> op -> Parser a op
|
|
op s o = string s $> o
|
|
|
|
int :: Parser a Int
|
|
int = read <$> (many1 digit <* spaces)
|
|
|
|
var :: [String] -> Parser a String
|
|
var reserved =
|
|
do
|
|
c <- satisfy $ \c -> isLetter c || c == '_'
|
|
cs <- many (satisfy isLetter <|> digit) <* spaces
|
|
let name = c:cs
|
|
if name `elem` reserved
|
|
then fail "Can't use reserved keyword as identifier"
|
|
else return name
|
|
|
|
list :: Char -> Char -> Char -> Parser a b -> Parser a [b]
|
|
list co cc cd pe = surround co cc $ sepBy pe (char cd >> spaces)
|
|
|
|
surround :: Char -> Char -> Parser a b -> Parser a b
|
|
surround c1 c2 pe =
|
|
do
|
|
char c1 >> spaces
|
|
e <- pe
|
|
spaces >> char c2 >> spaces
|
|
return e
|
|
|
|
level :: (o -> e -> e -> e) -> Parser a o -> Parser a e -> Parser a e
|
|
level c po pe =
|
|
do
|
|
e <- pe <* spaces
|
|
ops <- many $ try $ (flip . c <$> (po <* spaces) <*> pe) <* spaces
|
|
return $ foldl (flip ($)) e ops
|
|
|
|
precedence :: (o -> e -> e -> e) -> Parser a e -> [ Parser a o ] -> Parser a e
|
|
precedence = foldl . flip . level
|