50 lines
1.5 KiB
Haskell
50 lines
1.5 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module CombParse (runParser, parseExpr, parseAtom, parseVal, Value (..), Expr (..), toComblang) where
|
|
|
|
import Text.ParserCombinators.ReadP (ReadP, between, char, choice, eof, many1, munch, munch1, optional, readP_to_S, satisfy, skipSpaces, (+++), (<++))
|
|
import Unicode.Char (isDigit)
|
|
import Unicode.Char.Identifiers (isXIDContinue, isXIDStart)
|
|
|
|
data Value = Str String | Id String | Numb Int deriving (Show, Eq)
|
|
|
|
data Expr = Var Value | Comb Expr Expr | Param Int | Op String Expr deriving (Show, Eq)
|
|
|
|
toComblang :: Expr -> String
|
|
toComblang (Comb e1 e2) = "(" ++ toComblang e1 ++ " " ++ toComblang e2 ++ ")"
|
|
toComblang (Var (Id str)) = str
|
|
toComblang (Var (Str str)) = '"' : str ++ "\""
|
|
toComblang (Var (Numb n)) = show n
|
|
toComblang _ = error "passed a compile time parameter to a parse time function"
|
|
|
|
token :: ReadP a -> ReadP a
|
|
token = (skipSpaces +++ (optional (char '\r') <* char '\n') *>)
|
|
|
|
parseVal :: ReadP Value
|
|
parseVal =
|
|
choice
|
|
[ Str <$> between (char '"') (char '"') (munch (/= '"')),
|
|
Numb . read <$> munch1 isDigit,
|
|
Id <$> ((:) <$> satisfy isXIDStart <*> munch isXIDContinue)
|
|
]
|
|
|
|
parseAtom :: ReadP Expr
|
|
parseAtom = token $ (Var <$> parseVal) <++ between (token $ char '(') (char ')') parseExpr
|
|
|
|
parseExpr :: ReadP Expr
|
|
parseExpr = foldl1 Comb <$> many1 parseAtom
|
|
|
|
runParser :: ReadP a -> String -> Maybe a
|
|
runParser =
|
|
( \case
|
|
[] -> Nothing
|
|
x -> Just $ fst $ last x
|
|
)
|
|
.: readP_to_S
|
|
. (<* token eof)
|
|
. token
|
|
|
|
infixr 9 .:
|
|
|
|
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
|
|
(.:) = (.) . (.)
|