67 lines
1.4 KiB
Haskell
67 lines
1.4 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 = string s $> ()
|
|
|
|
kwIf :: Parser a ()
|
|
kwIf = kw "if"
|
|
|
|
kwThen :: Parser a ()
|
|
kwThen = kw "then"
|
|
|
|
kwElse :: Parser a ()
|
|
kwElse = kw "else"
|
|
|
|
kwState :: Parser a ()
|
|
kwState = kw "state"
|
|
|
|
kwEffect :: Parser a ()
|
|
kwEffect = kw "effect"
|
|
|
|
kwCombine :: Parser a ()
|
|
kwCombine = kw "combine"
|
|
|
|
kwRand :: Parser a ()
|
|
kwRand = kw "rand"
|
|
|
|
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
|
|
|
|
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
|