fork download
copy 
  1. {-# LANGUAGE NoMonomorphismRestriction #-}
  2. {-# LANGUAGE GADTs #-}
  3. import Data.Maybe
  4. import Text.Parsec
  5. import Text.Parsec.Pos
  6. import Control.Monad
  7. import Control.Arrow
  8. import Control.Applicative ((<*>), (<$>), (*>), (<*), (<$))
  9.  
  10. -------------------------------------------------------------------------------
  11. -- A couple of rewritten combinators for Chars
  12. -------------------------------------------------------------------------------
  13.  
  14. -- Parse a lexeme which satisfies a predicate
  15. satisfyP :: (Show a, Stream s m a) => (a -> Bool) -> ParsecT s u m a
  16. satisfyP f = tokenPrim (\c -> show c)
  17.                        (\pos c _cs -> updatePosString pos $ show c)
  18.                        (\c -> if f c then Just c else Nothing)
  19.  
  20. -- Parse a lexeme which is equivalent to the given one
  21. charP    :: (Show c, Eq c, Stream s m c) => c -> ParsecT s u m c
  22. charP c   = satisfyP (== c) <?> show c 
  23.  
  24. -- Parse any lexeme
  25. anyCharP :: (Show c, Stream s m c) => ParsecT s u m c
  26. anyCharP  = satisfyP $ const True
  27.  
  28. -- Parse a list of lexemes
  29. stringP  :: (Eq c, Show c, Stream s m c) => [c] -> ParsecT s u m [c]
  30. stringP s = tokens (concat . map show) (\p cs -> updatePosString p $ concat . map show $ cs) s
  31.  
  32. -------------------------------------------------------------------------------
  33. -- Example of a lexer
  34. -------------------------------------------------------------------------------
  35.  
  36. data Lex = LInt { getInt :: Integer} | LOper Char | LBraceL | LBraceR
  37. 	deriving (Eq, Show)
  38.  
  39. lexer    = many (lexeme <* many space) <* eof
  40. lexeme   = choice [l_int, l_oper, l_lbrace, l_rbrace]
  41. l_int    = (LInt 0 <$ char '0' <|> conv <$> digit1 <*> many digit) <* notFollowedBy letter where
  42. 	conv x xs = LInt . read $ x : xs
  43. digit1   = satisfy (\c -> '1' <= c && c <= '9')
  44. l_oper   = LOper <$> oneOf "+-*/"
  45. l_lbrace = LBraceL <$ char '('
  46. l_rbrace = LBraceR <$ char ')'
  47.  
  48. -- Get an integer literal lexeme from input
  49. -- User-defined combinator
  50. intLit = satisfyP isIntLit where
  51. 	isIntLit (LInt _) = True
  52. 	isIntLit _ = False
  53.  
  54. -------------------------------------------------------------------------------
  55. -- Example of a parser
  56. -------------------------------------------------------------------------------
  57.  
  58. data OpType = OAdd | OSub | OMul | ODiv
  59. 	deriving (Eq, Show)
  60. data Expr = EInt Integer | EOper OpType Expr Expr
  61. 	deriving (Eq, Show)
  62.  
  63. parser = expr0 <* eof
  64. expr0 = expr1 `chainl1` (EOper OAdd <$ charP (LOper '+') <|> EOper OSub <$ charP (LOper '-'))
  65. expr1 = expr2 `chainl1` (EOper OMul <$ charP (LOper '*') <|> EOper ODiv <$ charP (LOper '/'))
  66. expr2 = EInt . getInt <$> intLit <|> charP LBraceL *> expr0 <* charP LBraceR
  67.  
  68. -------------------------------------------------------------------------------
  69. -- Evaluator
  70. -------------------------------------------------------------------------------
  71.  
  72. div' x (Just 0) = Nothing
  73. div' x y = liftM2 div x y
  74.  
  75. table = [(OAdd, liftM2 (+)), (OSub, liftM2 (-)), (OMul, liftM2 (*)), (ODiv, div')]
  76.  
  77. eval :: Expr -> Maybe Integer
  78. eval (EInt x) = return x
  79. eval (EOper op l r) = do
  80. 	oper <- lookup op table
  81. 	eval l `oper` eval r
  82.  
  83. -------------------------------------------------------------------------------
  84. -- Run it all.
  85. -------------------------------------------------------------------------------
  86.  
  87. lexparse l p s = act lr where
  88. 	act (Right lr) = parse p "" lr
  89. 	act (Left e) = Left e
  90. 	lr = parse l "" s
  91.  
  92. res e = show e ++ " = " ++ show (eval e)
  93.  
  94. main = do
  95. 	test <- getLine
  96. 	let expr = lexparse lexer parser test
  97. 	putStrLn $ show ||| res $ expr
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
(1 + 2) * 3
compilation info 
prog.hs:5:8:
    Could not find module `Text.Parsec.Pos'
    Use -v to see a list of the files searched for.
stdout
copy 
Standard output is empty
https://ideone.com/iQSQoC
language:
Haskell (ghc 8.4.4)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!