I'm following this scheme interpreter tutorial: http://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/
but can't seem to figure out how to setup the REPL or Parsec so I can have the functionality to interpret a whole source file. What I'd like to do is to be able to enter something like this from the REPL:
:l ~/myscheme.scm
And the file would be interpreted. Right now, all it does is parse one expression and it ignores the rest. I can see why this is so -- readExpr reads only 1 expression.
Parser excerpt, whole code can be found here: http://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/Parsing
parseExpr :: Parser LispVal
parseExpr = parseAtom
<|> parseString
<|> parseNumber
<|> parseQuoted
<|> do char '('
x <- try parseList <|> parseDottedList
char ')'
return x
readExpr :: String -> String
readExpr input = case parse parseExpr "lisp" input of
Left err -> "No match: " ++ show err
Right _ -> "Found value"
REPL:
import System.IO
flushStr :: String -> IO ()
flushStr str = putStr str >> hFlush stdout
readPrompt :: String -> IO String
readPrompt prompt = flushStr prompt >> getLine
evalString :: String -> IO String
evalString expr = return $ extractValue $ trapError (liftM show $ readExpr expr >>= eval)
evalAndPrint :: String -> IO ()
evalAndPrint expr = evalString expr >>= putStrLn
until_ :: Monad m => (a -> Bool) -> m a -> (a -> m ()) -> m ()
until_ pred prompt action = do
result <- prompt
if pred result
then return ()
else action result >> until_ pred prompt action
runRepl :: IO ()
runRepl = until_ (== "quit") (readPrompt "Lisp>>> ") evalAndPrint
main :: IO ()
main = do args <- getArgs
case length args of
0 -> runRepl
1 -> evalAndPrint $ args !! 0
otherwise -> putStrLn "Program takes only 0 or 1 argument"
Would appreciate any help!
How about parse (many parseExpr) instead of parse parseExpr?
You then will have to amend the interpreter so that it can interpret a list of expressions.
Related
I would like to parse a predicate such as: "3 > 2" or "MyVar = 0".
Ideally, I would use a small GADT to represent the predicate:
data Expr a where
I :: Int -> Expr Int
B :: Bool -> Expr Bool
Var :: String -> Expr Int
Add :: Expr Int -> Expr Int -> Expr Int
Eq :: Eq a => Expr a -> Expr a -> Expr Bool
Mt :: Eq a => Expr a -> Expr a -> Expr Bool
The expression 3 > 2 would parse as Mt (I 3) (I 2).
I tried to approach the problem with Parsec.
However, the module Text.Parsec.Expr deals only with expressions, with type a -> a -> a.
Any suggestions?
Parsing directly into a GADT is actually kind of tricky. In my experience, it's usually better to parse into an untyped ADT first (where the a -> a -> a types are a natural fit), and then separately "type check" the ADT by transforming it into the desired GADT. The main disadvantage is that you have to define two parallel types for the untyped and typed abstract syntax trees. (You can technically get around this with some type level tricks, but it's not worth it for a small language.) However, the resulting design is easier to work with and generally more flexible.
In other words, I'd suggest using Parsec to parse into the untyped ADT:
data UExpr where
UI :: Int -> UExpr
UB :: Bool -> UExpr
UVar :: String -> UExpr
UAdd :: UExpr -> UExpr -> UExpr
UEq :: UExpr -> UExpr -> UExpr
UMt :: UExpr -> UExpr -> UExpr
and then write a type checker:
tc :: UExpr -> Expr a
Actually, you won't be able to write a tc like that. Instead you'll need to break it up into mutually recursive type checkers for different expression types:
tc_bool :: UExpr -> Expr Bool
tc_int :: UExpr -> Expr Int
and you'll probably want to run them in a Reader monad that provides a list of valid variables. (Type checking normally involves checking the types of variabels. In your case, you only have integer variables, but it still makes sense to ensure the variables are defined at the type checking stage.)
If you get stuck, a full solution follows...
SPOILERS
.
.
.
As I say, I'd first write a Parsec parser for an untyped UExpr ADT. Note that the Text.Parsec.Expr machinery works fine for UExpr -> UExpr -> UExpr operators:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS -Wall -Wno-missing-signatures #-}
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.String
import Text.Parsec.Language
import Control.Monad.Reader
import Control.Exception
import Data.Maybe (fromJust)
import qualified Text.Parsec.Token as P
lexer = P.makeTokenParser haskellDef { P.reservedNames = ["true","false"] }
identifier = P.identifier lexer
integer = P.integer lexer
parens = P.parens lexer
reserved = P.reserved lexer
reservedOp = P.reservedOp lexer
symbol = P.symbol lexer
data UExpr where
UI :: Int -> UExpr
UB :: Bool -> UExpr
UVar :: String -> UExpr
UAdd :: UExpr -> UExpr -> UExpr
UEq :: UExpr -> UExpr -> UExpr
UMt :: UExpr -> UExpr -> UExpr
deriving (Show)
expr :: Parser UExpr
expr = buildExpressionParser
[ [Infix (UAdd <$ reservedOp "+") AssocLeft]
, [Infix (UEq <$ reservedOp "=") AssocNone, Infix (UMt <$ reservedOp ">") AssocNone]
] term
term :: Parser UExpr
term = parens expr
<|> UI . fromIntegral <$> integer
<|> UB True <$ reserved "true"
<|> UB False <$ reserved "false"
<|> UVar <$> identifier
test_parser :: IO ()
test_parser = do
parseTest expr "3 > 2"
parseTest expr "MyVar = 0"
Then, I'd write a type checker, probably something like the following. Note that for type checking, we only need to verify that the variable names exist; we don't need their values. However, I've used a single Ctx type for both type checking and evaluation.
-- variable context (i.e., variable name/value pairs)
type Ctx = [(String, Int)]
data Expr a where
I :: Int -> Expr Int
B :: Bool -> Expr Bool
Var :: String -> Expr Int
Add :: Expr Int -> Expr Int -> Expr Int
Eq :: (Show (Expr a), Eq a) => Expr a -> Expr a -> Expr Bool
Mt :: (Show (Expr a), Ord a) => Expr a -> Expr a -> Expr Bool
deriving instance Show (Expr Bool)
deriving instance Show (Expr Int)
tc_bool :: UExpr -> Reader Ctx (Expr Bool)
tc_bool (UB b) = pure $ B b
tc_bool (UEq x y) = Eq <$> tc_int x <*> tc_int y
tc_bool (UMt x y) = Mt <$> tc_int x <*> tc_int y
tc_bool _ = error "type error: expecting a boolean expression"
tc_int :: UExpr -> Reader Ctx (Expr Int)
tc_int (UI n) = pure $ I n
tc_int (UVar sym)
= do mval <- asks (lookup sym)
case mval of Just _ -> pure $ Var sym
_ -> error "type error: undefined variables"
tc_int (UAdd x y) = Add <$> tc_int x <*> tc_int y
tc_int _ = error "type error: expecting an integer expression"
test_tc :: IO ()
test_tc = do
print $ run_tc_bool (UMt (UI 3) (UI 2))
print $ run_tc_bool (UEq (UVar "MyVar") (UI 0))
-- now some type errors
handle showError $ print $ run_tc_bool (UMt (UB False) (UI 2))
handle showError $ print $ run_tc_bool (UAdd (UEq (UI 1) (UI 1)) (UI 1))
where showError :: ErrorCall -> IO ()
showError e = print e
run_tc_bool e = runReader (tc_bool e) [("MyVar", 42)]
You may be surprised to learn that the most natural way to write a type checker doesn't actually "use" the GADT. It could have been equally easily written using two separate types for boolean and integer expressions. You would have found the same thing if you'd actually tried to parse directly into the GADT. The parser code would need to be pretty cleanly divided between a parser for boolean expressions of type Parser (Expr Bool) and a parser for integer expressions of type Parser (Expr Int), and there'd be no straightforward way to write a single Parser (Expr a).
Really, the advantage of the GADT representation only comes at the evaluation stage where you can write a simple, type-safe evaluator that triggers no "non-exhaustive pattern" warnings, like so:
eval :: Expr a -> Reader Ctx a
eval (I n) = pure n
eval (B b) = pure b
eval (Var sym) = fromJust <$> asks (lookup sym)
eval (Add x y) = (+) <$> eval x <*> eval y
eval (Eq x y) = (==) <$> eval x <*> eval y
eval (Mt x y) = (>) <$> eval x <*> eval y
test_eval :: IO ()
test_eval = do
print $ run_eval (Mt (I 3) (I 2))
print $ run_eval (Eq (Var "MyVar") (I 0))
where run_eval e = runReader (eval e) [("MyVar", 42)]
module Parser where
import Text.Parsec
import Lexer
import AST
type Parser = Parsec [(SourcePos, Token)] ()
tokenP :: (Token -> Maybe a) -> Parser a
tokenP test = token show fst (test . snd)
symbol :: String -> Parser ()
symbol c = tokenP (\t -> case t of
TSym s -> if s == c then Just () else Nothing
_ -> Nothing)
functorP :: Parser (String, [Term]) -- functor and relation have the same parser
functorP = error "not yet implemented"
termP :: Parser Term
termP = do
name <- tokenP (\t -> case t of
(TName s) -> Just (Atom s)
(TVar s) -> Just (Var s)
_ -> Nothing)
case name of -- parser consumes name which can be of atom or functor
(Atom a) -> (fmap (Func a) . between (symbol "(") (symbol ")")
. flip sepBy1 (symbol ",") $ termP) <|> return name
_ -> return name
{- parse a relation or cut in body of clause -}
relP :: Parser Rel
relP = (symbol "!" *> return Cut)
<|> relHeadP
{- parse a relation in head of clause -}
relHeadP :: Parser Rel
relHeadP = fmap (uncurry Rel) functorP
ruleP :: Parser Rule
ruleP = error "not yet implemented"
programP :: Parser Program
programP = fmap Program $ many ruleP
parseProgram :: String -> Either ParseError Program
parseProgram source = do
tokens <- parse (tokensL <* eof) "" source
parse (programP <* eof) "" tokens
parseRel :: String -> Either ParseError Rel
parseRel source = do
tokens <- parse (tokensL <* eof) "" source
parse (relHeadP <* (symbol ".") <* eof) "" tokens
I am not very sure what to do for funtorP and ruleP. can someone explain it with codes? thanks
here is the link for the zip file which includes other package: https://drive.google.com/file/d/1mW7zJdi0UbLPLO9t94A9vbOIgmspUMAE/view?usp=sharing
I am completely new to haskell and seen examples online of how to add error handling but I'm not sure how to incorporate it in my context. Below is an example of the code which works before trying to handle errors.
expr'::Parser Double
expr' = term' `chainl1'` addop
term'::Parser Double
term' = factor' `chainl1` mulop
chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op a = (p `chainl1` op) <|> pure a
chainl1 ::Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 p op = p >>= rest
where
rest a = (do
f <- op
b <- p
rest (f a b)) <|> pure a
addop, mulop :: Parser (Double -> Double -> Double)
I've since expanded this to let addop and mulop return error messages if something irregular is found. This causes the function definition to change to:
addop, mulop :: Parser (Either String (Double -> Double -> Double))
In other programming languages I would check if f <- op is a String and return the string. However I'm not sure how to go about this in Haskell. The idea is that this error message returns all the way back to term'. Hence its function definition also needs to change eventually. This is all in the attempt to build a Monadic Parser.
If you're using parsec then you can make your code more general to work with the ParsecT monad transformer:
import Text.Parsec hiding (chainl1)
import Control.Monad.Trans.Class (lift)
expr' :: ParsecT String () (Either String) Double
expr' = term' `chainl1` addop
term' :: ParsecT String () (Either String) Double
term' = factor' `chainl1` mulop
factor' :: ParsecT String () (Either String) Double
factor' = read <$> many1 digit
chainl1 :: Monad m => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 p op = p >>= rest
where
rest a = (do
f <- op
b <- p
rest (f a b))
<|> pure a
addop, mulop :: ParsecT String () (Either String) (Double -> Double -> Double)
addop = (+) <$ char '+' <|> (-) <$ char '-'
mulop = ((*) <$ char '*' <* lift (Left "error")) <|> (/) <$ char '/' <|> (**) <$ char '^'
I don't know what kind of errors you would want to return, so I've just made an error if an '*' is encountered in the input.
You can run the parser like this:
ghci> runParserT (expr' <* eof) () "buffer" "1+2+3"
Right (Right 6.0)
ghci> runParserT (expr' <* eof) () "buffer" "1+2*3"
Left "error"
The answer based on parsec implementation.
Actually the operator <|> is what you need. It handles any parsing errors. In expression a <|> b if the parser a fails then the parser b will be run (expect if the parser a consume some input before fails; for handle this case you can use combinator try like this: try a <|> b).
But if you want to handle error depending to the kind of error then you should do like #Noughtmare answered. But then I recomend you to do that:
Define your type for errors. It will be bugless to handle errors.
data MyError
= ME_DivByZero
| ...
You can simplify type signature if you define type alias for your parser.
type MyParser = ParsecT String () (Either MyError)
Then signatires will look like this:
expr' :: MyParser Double
addop, mulop :: MyParser (Double -> Double -> Double)
Use throwError to throw your errors and catchError to handle your errors, that will be more idiomatic. So it's look like this:
f <- catchError op $ \case
ME_DivByZero -> ...
ME_... -> ...
err -> throwError err -- rethrow error
I'm practicing writing parsers. I'm using Tsodings JSON Parser video as reference. I'm trying to add to it by being able to parse arithmetic of arbitrary length and I have come up with the following AST.
data HVal
= HInteger Integer -- No Support For Floats
| HBool Bool
| HNull
| HString String
| HChar Char
| HList [HVal]
| HObj [(String, HVal)]
deriving (Show, Eq, Read)
data Op -- There's only one operator for the sake of brevity at the moment.
= Add
deriving (Show, Read)
newtype Parser a = Parser {
runParser :: String -> Maybe (String, a)
}
The following functions is my attempt of implementing the operator parser.
ops :: [Char]
ops = ['+']
isOp :: Char -> Bool
isOp c = elem c ops
spanP :: (Char -> Bool) -> Parser String
spanP f = Parser $ \input -> let (token, rest) = span f input
in Just (rest, token)
opLiteral :: Parser String
opLiteral = spanP isOp
sOp :: String -> Op
sOp "+" = Add
sOp _ = undefined
parseOp :: Parser Op
parseOp = sOp <$> (charP '"' *> opLiteral <* charP '"')
The logic above is similar to how strings are parsed therefore my assumption was that the only difference was looking specifically for an operator rather than anything that's not a number between quotation marks. It does seemingly begin to parse correctly but it then gives me the following error:
λ > runParser parseOp "\"+\""
Just ("+\"",*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:80:14 in base:GHC.Err
undefined, called at /DIRECTORY/parser.hs:110:11 in main:Main
I'm confused as to where the error is occurring. I'm assuming it's to do with sOp mainly due to how the other functions work as intended as the rest of parseOp being a translation of the parseString function:
stringLiteral :: Parser String
stringLiteral = spanP (/= '"')
parseString :: Parser HVal
parseString = HString <$> (charP '"' *> stringLiteral <* charP '"')
The only reason why I have sOp however is that if it was replaced with say Op, I would get the error that the following doesn't exist Op :: String -> Op. When I say this my inclination was that the string coming from the parsed expression would be passed into this function wherein I could return the appropriate operator. This however is incorrect and I'm not sure how to proceed.
charP and Applicative Instance
charP :: Char -> Parser Char
charP x = Parser $ f
where f (y:ys)
| y == x = Just (ys, x)
| otherwise = Nothing
f [] = Nothing
instance Applicative Parser where
pure x = Parser $ \input -> Just (input, x)
(Parser p) <*> (Parser q) = Parser $ \input -> do
(input', f) <- p input
(input', a) <- q input
Just (input', f a)
The implementation of (<*>) is the culprit. You did not use input' in the next call to q, but used input instead. As a result you pass the string to the next parser without "eating" characters. You can fix this with:
instance Applicative Parser where
pure x = Parser $ \input -> Just (input, x)
(Parser p) <*> (Parser q) = Parser $ \input -> do
(input', f) <- p input
(input'', a) <- q input'
Just (input'', f a)
With the updated instance for Applicative, we get:
*Main> runParser parseOp "\"+\""
Just ("",Add)
I'm working on seperating lexing and parsing stages of a parser. After some tests, I realized error messages are less helpful when I'm using some tokens other than Parsec's Char tokens.
Here are some examples of Parsec's error messages while using Char tokens:
ghci> P.parseTest (string "asdf" >> spaces >> string "ok") "asdf wrong"
parse error at (line 1, column 7):
unexpected "w"
expecting space or "ok"
ghci> P.parseTest (choice [string "ok", string "nop"]) "wrong"
parse error at (line 1, column 1):
unexpected "w"
expecting "ok" or "nop"
So, string parser shows what string is expected when found an unexpected string, and choice parser shows what are alternatives.
But when I use same combinators with my tokens:
ghci> Parser.parseTest ((tok $ Ide "asdf") >> (tok $ Ide "ok")) "asdf "
parse error at "test" (line 1, column 1):
unexpected end of input
In this case, it doesn't print what was expected.
ghci> Parser.parseTest (choice [tok $ Ide "ok", tok $ Ide "nop"]) "asdf "
parse error at (line 1, column 1):
unexpected (Ide "asdf","test" (line 1, column 1))
And when I use choice, it doesn't print alternatives.
I expect this behavior to be related with combinator functions, and not with tokens, but seems like I'm wrong. How can I fix this?
Here's the full lexer + parser code:
Lexer:
module Lexer
( Token(..)
, TokenPos(..)
, tokenize
) where
import Text.ParserCombinators.Parsec hiding (token, tokens)
import Control.Applicative ((<*), (*>), (<$>), (<*>))
data Token = Ide String
| Number String
| Bool String
| LBrack
| RBrack
| LBrace
| RBrace
| Keyword String
deriving (Show, Eq)
type TokenPos = (Token, SourcePos)
ide :: Parser TokenPos
ide = do
pos <- getPosition
fc <- oneOf firstChar
r <- optionMaybe (many $ oneOf rest)
spaces
return $ flip (,) pos $ case r of
Nothing -> Ide [fc]
Just s -> Ide $ [fc] ++ s
where firstChar = ['A'..'Z'] ++ ['a'..'z'] ++ "_"
rest = firstChar ++ ['0'..'9']
parsePos p = (,) <$> p <*> getPosition
lbrack = parsePos $ char '[' >> return LBrack
rbrack = parsePos $ char ']' >> return RBrack
lbrace = parsePos $ char '{' >> return LBrace
rbrace = parsePos $ char '}' >> return RBrace
token = choice
[ ide
, lbrack
, rbrack
, lbrace
, rbrace
]
tokens = spaces *> many (token <* spaces)
tokenize :: SourceName -> String -> Either ParseError [TokenPos]
tokenize = runParser tokens ()
Parser:
module Parser where
import Text.Parsec as P
import Control.Monad.Identity
import Lexer
parseTest :: Show a => Parsec [TokenPos] () a -> String -> IO ()
parseTest p s =
case tokenize "test" s of
Left e -> putStrLn $ show e
Right ts' -> P.parseTest p ts'
tok :: Token -> ParsecT [TokenPos] () Identity Token
tok t = token show snd test
where test (t', _) = case t == t' of
False -> Nothing
True -> Just t
SOLUTION:
Ok, after fp4me's answer and reading Parsec's Char source more carefully, I ended up with this:
{-# LANGUAGE FlexibleContexts #-}
module Parser where
import Text.Parsec as P
import Control.Monad.Identity
import Lexer
parseTest :: Show a => Parsec [TokenPos] () a -> String -> IO ()
parseTest p s =
case tokenize "test" s of
Left e -> putStrLn $ show e
Right ts' -> P.parseTest p ts'
type Parser a = Parsec [TokenPos] () a
advance :: SourcePos -> t -> [TokenPos] -> SourcePos
advance _ _ ((_, pos) : _) = pos
advance pos _ [] = pos
satisfy :: (TokenPos -> Bool) -> Parser Token
satisfy f = tokenPrim show
advance
(\c -> if f c then Just (fst c) else Nothing)
tok :: Token -> ParsecT [TokenPos] () Identity Token
tok t = (Parser.satisfy $ (== t) . fst) <?> show t
Now I'm getting same error messages:
ghci> Parser.parseTest (choice [tok $ Ide "ok", tok $ Ide "nop"]) " asdf"
parse error at (line 1, column 1):
unexpected (Ide "asdf","test" (line 1, column 3))
expecting Ide "ok" or Ide "nop"
A beginning of solution can be to define your choice function in the Parser,
use a specific unexpected function to override unexpected error and finally
use the <?> operator to override the expecting message:
mychoice [] = mzero
mychoice (x:[]) = (tok x <|> myUnexpected) <?> show x
mychoice (x:xs) = ((tok x <|> mychoice xs) <|> myUnexpected) <?> show (x:xs)
myUnexpected = do
input <- getInput
unexpected $ (id $ first input )
where
first [] = "eof"
first (x:xs) = show $ fst x
and call your parser like that :
ghci> Parser.parseTest (mychoice [Ide "ok", Ide "nop"]) "asdf "
parse error at (line 1, column 1):
unexpected Ide "asdf"
expecting [Ide "ok",Ide "nop"]