To study the details of the State monad, I'm trying to create myself a complete desugared version of a simple state monad function, completing the thought started in How does 'get' actually /get/ the initial state in Haskell?, in the answer by J Cooper.
The example state monad function simply swaps the state and the input value, so that (conceptually) if the input is (v, s) then the output is (s, v). I show three translations, first from do notation to desugared >>= and >>, then placing those operators in function position, and finally attempting to replace them and get/put with their definitions.
The 'do' version and the first two translations work, but the final translation does not. Problems:
Upon loading the module, GHCi reports that z1 is not in scope.
I've not figured out exactly how to represent omitting the argument passing in the >> translation.
How should these be fixed?
FWIW, current Haskell platform (GHC 7.4.2).
Thanks!
-- simpleswap
import Control.Monad.State
-- =============================================
-- 'Do' version
simpleswap1 :: String -> State String String
simpleswap1 inp = do
z1 <- get
put inp
return z1
-- =============================================
-- Desugared to >>= and >>
simpleswap2 :: String -> State String String
simpleswap2 inp =
get >>=
\z1 -> put inp >>
return z1
-- =============================================
-- >>= and >> changed to function position
simpleswap3 :: String -> State String String
simpleswap3 inp =
(>>=) get
(\z1 -> (>>) (put inp) (return z1) )
-- =============================================
-- Attempt to translate >>=, >>, get and put
simpleswap4 :: String -> State String String
simpleswap4 inp =
state $ \s1 ->
-- (>>=)
let (a2, s2) = runState ( {- get -} state $ \sg -> (sg,sg) ) s1
in runState (rhs1 a2) s2
where
rhs1 a2 = \z1 ->
-- (>>)
state $ \s3 ->
let (a4, s4) = runState ( {- put inp -} state $ \_ -> (inp, ()) ) s3
in runState (rhs2 a4) s4
where
rhs2 a4 = return z1
-- =============================================
main = do
putStrLn "version 1004"
let v = "vvv"
let s = "sss"
putStrLn ("Before val: " ++ v ++ " state: " ++ s)
let (v2, s2) = runState (simpleswap4 v) s
putStrLn ("After val: " ++ v2 ++ " state: " ++ s2)
-- =============================================
There are a few minor mistakes in simpleswap4. Here is a corrected version:
simpleswap4 :: String -> State String String
simpleswap4 inp =
state $ \s1 ->
-- (>>=)
let (z1, s2) = runState ( {- get -} state $ \sg -> (sg,sg) ) s1
in runState (rhs1 z1) s2
where
rhs1 z1 =
-- (>>)
state $ \s3 ->
let (_, s4) = runState ( {- put inp -} state $ \_ -> ((), inp) ) s3
in runState rhs2 s4
where
rhs2 = return z1
I've renamed a2 to z1 (in lines 5 and 6). This doesn't change the semantics, but emphasized that the first component of the pair returned by the desugared get call is actually the result that gets bound to z1 in the previous versions of simpleswap.
The type of rhs1 should be String -> State String String. In your version, it gets an additional lambda-bound variable. It's unclear what the difference between a2 and z1 should be in your version. Removing the lambda (in line 8) also has the advantage of fixing your scoping problem. You are using z1 in the nested where-clause, but the where can only see variables bound on the left hand side of the declaration it is attached to.
In line 11, I've replaced a4 with _. This is to emphasize that (>>) does discard the result of the first action. As a consequence, rhs2 is not parameterized over this result either.
Related
So ... I messed up a recording in CSV format:
23,95489,0,20,9888
Due to language settings floating point numbers were written with commas as seperator ... in a comma separated value file ...
Problem is that the file does not have a nice formatting for every float. Some have no point at all and the number of numbers behind the point varies too.
My idea was to build a MegaParsec parser that would try to read every possible floating point formatting, move on and if back track if it finds an error.
Eg for the example above:
read 23,95489 -> good
read 0,20 -> good (so far)
read 9888 -> error (because value is too high for column (checked by guard))
(back tracking to 2.) read 0 -> good again
read 20,9888 -> good
done
I've implemented that as (pseudo code here):
floatP = try pointyFloatP <|> unpointyFloatP
lineP = (,,) <$> floatP <* comma <*> floatP <* comma <*> floatP <* comma
My problem is that apparently the try only works in the 'current' float. There is no backtracking to previous positions. Is this correct?
And if so ... how would I go about implementing further back tracking?
How far does “try” back track?
The parser try p consumes exactly as much input as p if p parses successfully, otherwise it does not consume any input at all. So if you look at that in terms of backtracking, it backtracks to the point where you were when you invoked it.
My problem is that apparently the try only works in the 'current' float. There is no backtracking to previous positions. Is this correct?
Yes, try does not "unconsume" input. All it does is to recover from a failure in the parser you give it without consuming any input. It does not undo the effects of any parsers that you've applied previously, nor does it affect subsequent parsers that you apply after try p succeeded.
And if so ... how would I go about implementing further back tracking?
Basically what you want is to not only know whether pointyFloatP succeeds on the current input, but also whether the rest of your lineP would succeed after successfully pointyFloatP - and if it doesn't you want to backtrack back to before you applied pointyFloatP. So basically you want the parser for the whole remaining line in the try, not just the float parser.
To achieve that you can make floatP take the parser for the remaining line as an argument like this:
floatP restP = try (pointyFloatP <*> restP) <|> unpointyFloatP <*> restP
Note that this kind of backtracking isn't going to be very efficient (but I assume you knew that going in).
Update: Include a custom monadic parser for more complex rows.
Using the List Monad for Simple Parsing
The list monad makes a better backtracking "parser" than Megaparsec. For example, to parse the cells:
row :: [String]
row = ["23", "95489", "0", "20", "9888"]
into exactly three columns of values satisfying a particular bound (e.g., less than 30), you can generate all possible parses with:
{-# OPTIONS_GHC -Wall #-}
import Control.Monad
import Control.Applicative
rowResults :: [String] -> [[Double]]
rowResults = cols 3
where cols :: Int -> [String] -> [[Double]]
cols 0 [] = pure [] -- good, finished on time
cols 0 _ = empty -- bad, didn't use all the data
-- otherwise, parse exactly #n# columns from cells #xs#
cols n xs = do
-- form #d# from one or two cells
(d, ys) <- num1 xs <|> num2 xs
-- only accept #d < 30#
guard $ d < 30
ds <- cols (n-1) ys
return $ d : ds
-- read number from a single cell
num1 (x:xs) | ok1 x = pure (read x, xs)
num1 _ = empty
-- read number from two cells
num2 (x:y:zs) | ok1 x && ok2 y = pure (read (x ++ "." ++ y), zs)
num2 _ = empty
-- first cell: "0" is okay, but otherwise can't start with "0"
ok1 "0" = True
ok1 (c:_) | c /= '0' = True
ok1 _ = False
-- second cell: can't end with "0" (or *be* "0")
ok2 xs = last xs /= '0'
The above list-based parser tries to reduce ambiguity by assuming that if "xxx,yyy" is a number, the "xxx" won't start with zeros (unless it's just "0"), and the "yyy" won't end with a zero (or, for that matter, be a single "0"). If this isn't right, just modify ok1 and ok2 as appropriate.
Applied to row, this gives the single unambiguous parse:
> rowResults row
[[23.95489,0.0,20.9888]]
Applied to an ambiguous row, it gives all parses:
> rowResults ["0", "12", "5", "0", "8601"]
[[0.0,12.5,0.8601],[0.0,12.5,0.8601],[0.12,5.0,0.8601]]
Anyway, I'd suggest using a standard CSV parser to parse your file into a matrix of String cells like so:
dat :: [[String]]
dat = [ ["23", "95489", "0", "20", "9888"]
, ["0", "12", "5", "0", "8601"]
, ["23", "2611", "2", "233", "14", "422"]
]
and then use rowResults above get the row numbers of rows that were ambiguous:
> map fst . filter ((>1) . snd) . zip [1..] . map (length . rowResults) $ dat
[2]
>
or unparsable:
> map fst . filter ((==0) . snd) . zip [1..] . map (length . rowResults) $ dat
[]
>
Assuming there are no unparsable rows, you can regenerate one possible fixed file, even if some rows are ambiguous, but just grabbing the first successful parse for each row:
> putStr $ unlines . map (intercalate "," . map show . head . rowResults) $ dat
23.95489,0.0,20.9888
0.0,12.5,0.8601
23.2611,2.233,14.422
>
Using a Custom Monad based on the List Monad for More Complex Parsing
For more complex parsing, for example if you wanted to parse a row like:
type Stream = [String]
row0 :: Stream
row0 = ["Apple", "15", "1", "5016", "2", "5", "3", "1801", "11/13/2018", "X101"]
with a mixture of strings and numbers, it's actually not that difficult to write a monadic parser, based on the list monad, that generates all possible parses.
The key idea is to define a parser as a function that takes a stream and generates a list of possible parses, with each possible parse represented as a tuple of the object successfully parsed from the beginning of the stream paired with the remainder of the stream. Wrapped in a newtype, our parallel parser would look like:
newtype PParser a = PParser (Stream -> [(a, Stream)]) deriving (Functor)
Note the similarity to the type ReadS from Text.ParserCombinators.ReadP, which is also technically an "all possible parses" parser (though you usually only expect one, unambiguous parse back from a reads call):
type ReadS a = String -> [(a, String)]
Anyway, we can define a Monad instance for PParser like so:
instance Applicative PParser where
pure x = PParser (\s -> [(x, s)])
(<*>) = ap
instance Monad PParser where
PParser p >>= f = PParser $ \s1 -> do -- in list monad
(x, s2) <- p s1
let PParser q = f x
(y, s3) <- q s2
return (y, s3)
There's nothing too tricky here: pure x returns a single possible parse, namely the result x with an unchanged stream s, while p >>= f applies the first parser p to generate a list of possible parses, takes them one by one within the list monad to calculate the next parser q to use (which, as per usual for a monadic operation, can depend on the result of the first parse), and generates a list of possible final parses that are returned.
The Alternative and MonadPlus instances are pretty straightforward -- they just lift emptiness and alternation from the list monad:
instance Alternative PParser where
empty = PParser (const empty)
PParser p <|> PParser q = PParser $ \s -> p s <|> q s
instance MonadPlus PParser where
To run our parser, we have:
parse :: PParser a -> Stream -> [a]
parse (PParser p) s = map fst (p s)
and now we can introduce primitives:
-- read a token as-is
token :: PParser String
token = PParser $ \s -> case s of
(x:xs) -> pure (x, xs)
_ -> empty
-- require an end of stream
eof :: PParser ()
eof = PParser $ \s -> case s of
[] -> pure ((), s)
_ -> empty
and combinators:
-- combinator to convert a String to any readable type
convert :: (Read a) => PParser String -> PParser a
convert (PParser p) = PParser $ \s1 -> do
(x, s2) <- p s1 -- for each possible String
(y, "") <- reads x -- get each possible full read
-- (normally only one)
return (y, s2)
and parsers for various "terms" in our CSV row:
-- read a string from a single cell
str :: PParser String
str = token
-- read an integer (any size) from a single cell
int :: PParser Int
int = convert (mfilter ok1 token)
-- read a double from one or two cells
dbl :: PParser Double
dbl = dbl1 <|> dbl2
where dbl1 = convert (mfilter ok1 token)
dbl2 = convert $ do
t1 <- mfilter ok1 token
t2 <- mfilter ok2 token
return $ t1 ++ "." ++ t2
-- read a double that's < 30
dbl30 :: PParser Double
dbl30 = do
x <- dbl
guard $ x < 30
return x
-- rules for first cell of numbers:
-- "0" is okay, but otherwise can't start with "0"
ok1 :: String -> Bool
ok1 "0" = True
ok1 (c:_) | c /= '0' = True
ok1 _ = False
-- rules for second cell of numbers:
-- can't be "0" or end in "0"
ok2 :: String -> Bool
ok2 xs = last xs /= '0'
Then, for a particular row schema, we can write a row parser as we normally would with a monadic parser:
-- a row
data Row = Row String Int Double Double Double
Int String String deriving (Show)
rowResults :: PParser Row
rowResults = Row <$> str <*> int <*> dbl30 <*> dbl30 <*> dbl30
<*> int <*> str <*> str <* eof
and get all possible parses:
> parse rowResults row0
[Row "Apple" 15 1.5016 2.0 5.3 1801 "11/13/2018" "X101"
,Row "Apple" 15 1.5016 2.5 3.0 1801 "11/13/2018" "X101"]
>
The full program is:
{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Monad
import Control.Applicative
type Stream = [String]
newtype PParser a = PParser (Stream -> [(a, Stream)]) deriving (Functor)
instance Applicative PParser where
pure x = PParser (\s -> [(x, s)])
(<*>) = ap
instance Monad PParser where
PParser p >>= f = PParser $ \s1 -> do -- in list monad
(x, s2) <- p s1
let PParser q = f x
(y, s3) <- q s2
return (y, s3)
instance Alternative PParser where
empty = PParser (const empty)
PParser p <|> PParser q = PParser $ \s -> p s <|> q s
instance MonadPlus PParser where
parse :: PParser a -> Stream -> [a]
parse (PParser p) s = map fst (p s)
-- read a token as-is
token :: PParser String
token = PParser $ \s -> case s of
(x:xs) -> pure (x, xs)
_ -> empty
-- require an end of stream
eof :: PParser ()
eof = PParser $ \s -> case s of
[] -> pure ((), s)
_ -> empty
-- combinator to convert a String to any readable type
convert :: (Read a) => PParser String -> PParser a
convert (PParser p) = PParser $ \s1 -> do
(x, s2) <- p s1 -- for each possible String
(y, "") <- reads x -- get each possible full read
-- (normally only one)
return (y, s2)
-- read a string from a single cell
str :: PParser String
str = token
-- read an integer (any size) from a single cell
int :: PParser Int
int = convert (mfilter ok1 token)
-- read a double from one or two cells
dbl :: PParser Double
dbl = dbl1 <|> dbl2
where dbl1 = convert (mfilter ok1 token)
dbl2 = convert $ do
t1 <- mfilter ok1 token
t2 <- mfilter ok2 token
return $ t1 ++ "." ++ t2
-- read a double that's < 30
dbl30 :: PParser Double
dbl30 = do
x <- dbl
guard $ x < 30
return x
-- rules for first cell of numbers:
-- "0" is okay, but otherwise can't start with "0"
ok1 :: String -> Bool
ok1 "0" = True
ok1 (c:_) | c /= '0' = True
ok1 _ = False
-- rules for second cell of numbers:
-- can't be "0" or end in "0"
ok2 :: String -> Bool
ok2 xs = last xs /= '0'
-- a row
data Row = Row String Int Double Double Double
Int String String deriving (Show)
rowResults :: PParser Row
rowResults = Row <$> str <*> int <*> dbl30 <*> dbl30 <*> dbl30
<*> int <*> str <*> str <* eof
row0 :: Stream
row0 = ["Apple", "15", "1", "5016", "2", "5", "3", "1801", "11/13/2018", "X101"]
main = print $ parse rowResults row0
Off-the-shelf Solutions
I find it a little surprising I can't find an existing parser library out there that provides this kind of "all possible parses" parser. The stuff in Text.ParserCombinators.ReadP takes the right approach, but it assumes that you're parsing characters from a String rather than arbitrary tokens from some other stream (in our case, Strings from a [String]).
Maybe someone else can point out an off-the-shelf solution that would save you from having to role your own parser type, instances, and primitives.
The do notation allows us to express monadic code without overwhelming nestings, so that
main = getLine >>= \ a ->
getLine >>= \ b ->
putStrLn (a ++ b)
can be expressed as
main = do
a <- getLine
b <- getLine
putStrLn (a ++ b)
Suppose, though, the syntax allows ... #expression ... to stand for do { x <- expression; return (... x ...) }. For example, foo = f a #(b 1) c would be desugared as: foo = do { x <- b 1; return (f a x c) }. The code above could, then, be expressed as:
main = let a = #getLine in
let b = #getLine in
putStrLn (a ++ b)
Which would be desugared as:
main = do
x <- getLine
let a = x in
return (do
x' <- getLine
let b = x' in
return (putStrLn (a ++ b)))
That is equivalent. This syntax is appealing to me because it seems to offer the same functionality as the do-notation, while also allowing some shorter expressions such as:
main = putStrLn (#(getLine) ++ #(getLine))
So, I wonder if there is anything defective with this proposed syntax, or if it is indeed complete and equivalent to the do-notation.
putStrLn is already String -> IO (), so your desugaring ... return (... return (putStrLn (a ++ b))) ends up having type IO (IO (IO ())), which is likely not what you wanted: running this program won't print anything!
Speaking more generally, your notation can't express any do-block which doesn't end in return. [See Derek Elkins' comment.]
I don't believe your notation can express join, which can be expressed with do without any additional functions:
join :: Monad m => m (m a) -> m a
join mx = do { x <- mx; x }
However, you can express fmap constrained to Monad:
fmap' :: Monad m => (a -> b) -> m a -> m b
fmap' f mx = f #mx
and >>= (and thus everything else) can be expressed using fmap' and join. So adding join would make your notation complete, but still not convenient in many cases, because you end up needing a lot of joins.
However, if you drop return from the translation, you get something quite similar to Idris' bang notation:
In many cases, using do-notation can make programs unnecessarily verbose, particularly in cases such as m_add above where the value bound is used once, immediately. In these cases, we can use a shorthand version, as follows:
m_add : Maybe Int -> Maybe Int -> Maybe Int
m_add x y = pure (!x + !y)
The notation !expr means that the expression expr should be evaluated and then implicitly bound. Conceptually, we can think of ! as being a prefix function with the following type:
(!) : m a -> a
Note, however, that it is not really a function, merely syntax! In practice, a subexpression !expr will lift expr as high as possible within its current scope, bind it to a fresh name x, and replace !expr with x. Expressions are lifted depth first, left to right. In practice, !-notation allows us to program in a more direct style, while still giving a notational clue as to which expressions are monadic.
For example, the expression:
let y = 42 in f !(g !(print y) !x)
is lifted to:
let y = 42 in do y' <- print y
x' <- x
g' <- g y' x'
f g'
Adding it to GHC was discussed, but rejected (so far). Unfortunately, I can't find the threads discussing it.
How about this:
do a <- something
b <- somethingElse a
somethingFinal a b
In order to understand how to use monad transformers, I wrote the following code without one. It reads standard input line by line and displays each line reversed until an empty line is encountered. It also counts the lines using State and in the end displays the total number.
import Control.Monad.State
main = print =<< fmap (`evalState` 0) go where
go :: IO (State Int Int)
go = do
l <- getLine
if null l
then return get
else do
putStrLn (reverse l)
-- another possibility: fmap (modify (+1) >>) go
rest <- go
return $ do
modify (+1)
rest
I wanted to add the current line number before each line. I was able to do it with StateT:
import Control.Monad.State
main = print =<< evalStateT go 0 where
go :: StateT Int IO Int
go = do
l <- lift getLine
if null l
then get
else do
n <- get
lift (putStrLn (show n ++ ' ' : reverse l))
modify (+1)
go
My question is: how to do the same in the version without monad transformers?
The problem you're having is that the hand-unrolling of StateT s IO a is s -> IO (s, a), not IO (s -> (s, a))! Once you have this insight, it's pretty easy to see how to do it:
go :: Int -> IO (Int, Int)
go s = do
l <- getLine
if null l
then return (s, s)
else do
putStrLn (show s ++ ' ' : reverse l)
go (s+1)
You'd just need to run the accumulated state computation on every line. This is O(n²) time, but since your first program is already using O(n) space, that's not too terrible. Of course, the StateT approach is superior in pretty much every way! If you really want to do it "by hand" and not pay an efficiency price, just manage the state by hand instead of building a state transformer at all. You're really not getting any benefit by using State instead of Int in the first program.
Maybe this is what you are looking for?
main = print =<< fmap (`evalState` 0) (go get) where
go :: State Int Int -> IO (State Int Int)
go st = do
l <- getLine
if null l
then return (st >>= \_ -> get)
else do
let ln = evalState st 0
putStrLn(show ln ++ ' ' : reverse l)
go (st >>= \_ -> modify (+1) >>= \_ -> get)
The idea here is to make go tail recursive, building up your state computation, which you can then evaluate at each step.
EDIT
This version will bound the size of the state computation to a constant size, although under lazy evaluation, when the previous state computation is forced, we should be able to reuse it without re-evaluating it, so I'm guessing that these are essentially the same...
main = print =<< fmap (`evalState` 0) (go get) where
go :: State Int Int -> IO (State Int Int)
go st = do
l <- getLine
if null l
then return st
else do
let ln = evalState st 0
putStrLn(show ln ++ ' ' : reverse l)
go (modify (\s -> s+ln+1) >>= \_ -> get)
So, I need to write a function evalS :: Statement -> Store -> Store that takes as input a statement and a store and returns a possibly modified store.
The following case has been given to me:
evalS w#(While e s1) s = case (evalE e s) of
(BoolVal True,s') -> let s'' = evalS s1 s' in evalS w s''
(BoolVal False,s') -> s'
_ -> error "Condition must be a BoolVal
And I need to write:
evalS Skip s = ...
evalS (Expr e) s = ...
evalS (Sequence s1 s2) s = ...
evalS (If e s1 s2) s = ...
In the If case, if e evaluates to a non-boolean value, I need to throw an error using the error function.
Sample input/output:
> run stmtParser "x=1+1" evalS
fromList [("x",2)]
> run stmtParser "x = 2; x = x + 3" evalS
fromList [("x",5)]
> run stmtParser "if true then x = 1 else x = 2 end" evalS
fromList [("x",1)]
> run stmtParser "x=2; y=x + 3; if y < 4 then z = true else z = false end" evalS
fromList [("x",2),("y",5),("z",false)]
> run stmtParser "x = 1; while x < 3 do x = x + 1 end" evalS
fromList [("x",3)]
> run stmtParser "x = 1 ; y = 1; while x < 5 do x = x + 1 ; y = y * x end" evalS
fromList [("x",5),("y",120)]
Code for stmtParser:
-- Sequence of statements
stmtParser :: Parser Statement
stmtParser = stmtParser1 `chainl1` (P.semi lexer >> return Sequence)
-- Single statements
stmtParser1 :: Parser Statement
stmtParser1 = (Expr <$> exprParser)
<|> do
P.reserved lexer "if"
cond <- exprParser
P.reserved lexer "then"
the <- stmtParser
P.reserved lexer "else"
els <- stmtParser
P.reserved lexer "end"
return (If cond the els)
<|> do
P.reserved lexer "while"
cond <- exprParser
P.reserved lexer "do"
body <- stmtParser
P.reserved lexer "end"
return (While cond body)
WHAT I'VE TRIED:
I am not sure if I need to use evalE in this problem or not. I have written it in a previous problem. The signature for evalE is evalE :: Expression -> Store -> (Value, Store) and asked me to write:
evalE (Var x) s = ...
evalE (Val v) s = ...
evalE (Assignment x e) s = ...
I have done the above, already.
ATTEMPT:
evalS Skip s = show s -- I am assuming that since Skip returns an empty String, I just need to return an empty String.
evalS (Sequence s1 s2) s = evalS s1 >> evalS s2 -- sequence1 then sequence2. I am not quite sure what to do with the s.
evalS (Expr e) s = ... Not sure what to do, here.
evalS (If e s1 s2) s = do
x <- evalE e
case x of
BoolVal True -> evalS s1
BoolVal False -> evalS s2
I am having trouble writing the above statements.
For reference, here is the entire skeleton that was given to me to work with:
-- Necessary imports
import Control.Applicative ((<$>),liftA,liftA2)
import Data.Map
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.Language (emptyDef)
import Text.Parsec.String (Parser)
import qualified Text.Parsec.Token as P
--------- AST Nodes ---------
-- Variables are identified by their name as string
type Variable = String
-- Values are either integers or booleans
data Value = IntVal Int -- Integer value
| BoolVal Bool -- Boolean value
-- Expressions are variables, literal values, unary and binary operations
data Expression = Var Variable -- e.g. x
| Val Value -- e.g. 2
| BinOp Op Expression Expression -- e.g. x + 3
| Assignment Variable Expression -- e.g. x = 3
-- Statements are expressions, conditionals, while loops and sequences
data Statement = Expr Expression -- e.g. x = 23
| If Expression Statement Statement -- if e then s1 else s2 end
| While Expression Statement -- while e do s end
| Sequence Statement Statement -- s1; s2
| Skip -- no-op
-- All binary operations
data Op = Plus -- + :: Int -> Int -> Int
| Minus -- - :: Int -> Int -> Int
| Times -- * :: Int -> Int -> Int
| GreaterThan -- > :: Int -> Int -> Bool
| Equals -- == :: Int -> Int -> Bool
| LessThan -- < :: Int -> Int -> Bool
-- The `Store` is an associative map from `Variable` to `Value` representing the memory
type Store = Map Variable Value
--------- Parser ---------
-- The Lexer
lexer = P.makeTokenParser (emptyDef {
P.identStart = letter,
P.identLetter = alphaNum,
P.reservedOpNames = ["+", "-", "*", "!", ">", "=", "==", "<"],
P.reservedNames = ["true", "false", "if", "in", "then", "else", "while", "end", "to", "do", "for"]
})
-- The Parser
-- Number literals
numberParser :: Parser Value
numberParser = (IntVal . fromIntegral) <$> P.natural lexer
-- Boolean literals
boolParser :: Parser Value
boolParser = (P.reserved lexer "true" >> return (BoolVal True))
<|> (P.reserved lexer "false" >> return (BoolVal False))
-- Literals and Variables
valueParser :: Parser Expression
valueParser = Val <$> (numberParser <|> boolParser)
<|> Var <$> P.identifier lexer
-- -- Expressions
exprParser :: Parser Expression
exprParser = liftA2 Assignment
(try (P.identifier lexer >>= (\v ->
P.reservedOp lexer "=" >> return v)))
exprParser
<|> buildExpressionParser table valueParser
where table = [[Infix (op "*" (BinOp Times)) AssocLeft]
,[Infix (op "+" (BinOp Plus)) AssocLeft]
,[Infix (op "-" (BinOp Minus)) AssocLeft]
,[Infix (op ">" (BinOp GreaterThan)) AssocLeft]
,[Infix (op "==" (BinOp Equals)) AssocLeft]
,[Infix (op "<" (BinOp LessThan)) AssocLeft]]
op name node = (P.reservedOp lexer name) >> return node
-- Sequence of statements
stmtParser :: Parser Statement
stmtParser = stmtParser1 `chainl1` (P.semi lexer >> return Sequence)
-- Single statements
stmtParser1 :: Parser Statement
stmtParser1 = (Expr <$> exprParser)
<|> do
P.reserved lexer "if"
cond <- exprParser
P.reserved lexer "then"
the <- stmtParser
P.reserved lexer "else"
els <- stmtParser
P.reserved lexer "end"
return (If cond the els)
<|> do
P.reserved lexer "while"
cond <- exprParser
P.reserved lexer "do"
body <- stmtParser
P.reserved lexer "end"
return (While cond body)
-------- Helper functions --------
-- Lift primitive operations on IntVal and BoolVal values
liftIII :: (Int -> Int -> Int) -> Value -> Value -> Value
liftIII f (IntVal x) (IntVal y) = IntVal $ f x y
liftIIB :: (Int -> Int -> Bool) -> Value -> Value -> Value
liftIIB f (IntVal x) (IntVal y) = BoolVal $ f x y
-- Apply the correct primitive operator for the given Op value
applyOp :: Op -> Value -> Value -> Value
applyOp Plus = liftIII (+)
applyOp Minus = liftIII (-)
applyOp Times = liftIII (*)
applyOp GreaterThan = liftIIB (>)
applyOp Equals = liftIIB (==)
applyOp LessThan = liftIIB (<)
-- Parse and print (pp) the given WHILE programs
pp :: String -> IO ()
pp input = case (parse stmtParser "" input) of
Left err -> print err
Right x -> print x
-- Parse and run the given WHILE programs
run :: (Show v) => (Parser n) -> String -> (n -> Store -> v) -> IO ()
run parser input eval = case (parse parser "" input) of
Left err -> print err
Right x -> print (eval x empty)
It's a little difficult to answer your question, because you didn't actually ask one. Let me just pick out a few of the things that you've said, in order to give you a few clues.
I am not sure if I need to use evalE in this problem or not. I have written it in a previous problem. The signature for evalE is evalE :: Expression -> Store -> (Value, Store)
evalS (Expr e) s = ... Not sure what to do, here.
What does it mean to execute a statement which consists of an expression? If it has something to do with evaluating the expression, then the fact that you have an expression evaluator available might help with "what to do, here".
Next, compare the code you've been given for "while" (which contains a fine example of a sensible thing to do with an expression, by the way)...
evalS w#(While e s1) s = case (evalE e s) of`
(BoolVal True,s') -> let s'' = evalS s1 s' in evalS w s''
(BoolVal False,s') -> s'
_ -> error "Condition must be a BoolVal"
...and compare it with your code for "if"
evalS (If e s1 s2) s = do
x <- evalE e
case x of
BoolVal True -> evalS s1
BoolVal False -> evalS s2
Your code is in a rather different style — the "monadic" style. Where are you getting that from? It would make sense if the types of the evaluators were something like
evalE :: Expression -> State Store Value
evalS :: Statement -> State Store ()
The monadic style is a very nice way to thread the mutating store through the evaluation process without talking about it too much. E.g., your x <- evalE e means "let x be the result of evaluating e (quietly receiving the initial store and passing along the resulting store)". It's a good way to work which I expect you'll explore in due course.
But those aren't the types you've been given, and the monadic style is not appropriate. You have
evalE :: Expression -> Store -> (Value, Store)
evalS :: Statement -> Store -> Store
and the example code threads the store explicitly. Look again
evalS w#(While e s1) s = case (evalE e s) of`
(BoolVal True,s') -> let s'' = evalS s1 s' in evalS w s''
(BoolVal False,s') -> s'
_ -> error "Condition must be a BoolVal"
See? evalS receives its initial store, s, explicitly, and uses it explicitly in evalE e s. The resulting new store is called s' in both case branches. If the loop is over, then s' is given back as the final store. Otherwise, s' is used as the store for one pass through the loop body, s1, and the store s'' resulting from that is used for the next time around the loop, w.
Your code will need to be similarly explicit in the way it names and uses the store at each stage of evaluation. Let's walk through.
evalS Skip s = show s -- I am assuming that since Skip returns an empty String, I just need to return an empty String.
You assume incorrectly. The evalS function does not return a String, empty or otherwise: it returns a Store. Now, which Store? Your initial store is s: how will the store after "skip" relate to s?
evalS (Sequence s1 s2) s = evalS s1 >> evalS s2 -- sequence1 then sequence2. I am not quite sure what to do with the s.
Again, that's a monadic approach which does not fit with this question. You need to thread the store, intially s, through the process of evaluating statements s1 and s2 in sequence. The "while" case has a good example of how to do something like that.
evalS (Expr e) s = ... Not sure what to do, here.
Again, the "while" example shows you one way to extract a value and an updated store by evaluating an expression. Food for thought, isn't it?
evalS (If e s1 s2) s = ...
Now "if" starts out by evaluating a condition, rather a lot like "while", no?
So, my advice amounts to this:
drop the monadic style code for now, but come back to it later when it's appropriate;
read the example implementation of "while" and understand how it treats expressions and sequences of statements, passing the store explicitly;
deploy the similar techniques to implement the other constructs.
The person who set the question has been kind enough to give you code which gives an example of everything you will need. Please reciprocate that kindness by comprehending and then taking the hint!
Since this looks as homework I'll just provide a few small hints, leaving the real work for you.
I am not sure if I need to use evalE in this problem or not.
Yes, you'll have to. In your language, an expression e modifies the store and returns a value: you can tell that from evalE returning a pair (Value,Store)
By comparison, the statement Expr e modifies the store without returning a value. To obtain the latter (statement evaluation) from the former (expression) all you need to do is to throw away what you do not need.
About your attempt:
evalS Skip s = show s -- I am assuming that since Skip returns an empty String, I just need to return an empty String.
Why a string? Does evalS return strings? If not, what it returns? You are doing far more work than you have to, here.
evalS (Sequence s1 s2) s = evalS s1 >> evalS s2 -- sequence1 then sequence2. I am not quite sure what to do with the s.
OK, the idea is right but the code is not. Forget about monads and >>, just think about the stores. You make two recursive calls evalS s1 and evalS s2: these look wrong because evalS expects two arguments (statement and store), and you only provide one.
And -- before you try it -- no, passing s to both of them would still be wrong. In which store is the first statement evaluated? What about the second?
evalS (Expr e) s = ... Not sure what to do, here.
See the discussion above.
evalS (If e s1 s2) s = do
x <- evalE e
case x of
BoolVal True -> evalS s1
BoolVal False -> evalS s2
Avoid monad-related operations, do and <-. There might be a way to use those to solve this task, but I'd not recommend to try that path to a beginner.
You can use let if you want to name intermediate results.
evalE takes two arguments, not one. Mind that it returns a pair, not a value. evalS takes two arguments.
I want a function that looks something like this
readFunc :: String -> (Float -> Float)
which operates something like this
>(readFunc "sin") (pi/2)
>1.0
>(readFunc "(+2)") 3.0
>5.0
>(readFunc "(\x -> if x > 5.0 then 5.0 else x)") 2.0
>2.0
>(readFunc "(\x -> if x > 5.0 then 5.0 else x)") 7.0
>5.0
The incredibly naive approach (note this must be compiled with {-# LANGUAGE FlexibleContexts #-})
readFunc :: (Read (Float -> Float)) => String -> (Float -> Float)
readFunc s = read s
gives
No instance for (Read (Float -> Float)) ...
Which makes sense since no such instance exists. I understand that I can parse the input string character by character by writing a map from String to Float -> Float but I want to be able to parse at least the most common functions from prelude, and even that would be way more work than I want to commit to. Is there an easy way of doing this?
Just one solution using hint
import Language.Haskell.Interpreter hiding (typeOf)
import Data.Typeable (typeOf)
data Domain = Dom Float Float Float Float Domain
| SDom Float Float Float Float
deriving (Show, Read)
--gets all the points that will appear in the domain
points (SDom a b c d) m = [(x, y)|x <- [a, a+m .. b], y <- [c, c+m .. d]]
points (Dom a b c d next) m = points next m ++ [(x, y)|x <- [a, a+m .. b], y <- [c, c+m .. d]]
readFunc = do
putStrLn "Enter a domain (as Dom x-min x-max y-min y-max subdomain, or, SDom x-min x-max y-min y-max)"
domain' <- getLine
let domain = (read domain') :: Domain
--
putStrLn "Enter a mesh size"
meshSize' <- getLine
let meshSize = (read meshSize') :: Float
--
putStrLn "Enter an initial value function (as f(x,y))"
func' <- getLine
values' <- runInterpreter $ setImports["Prelude"] >>
eval ("map (\\(x,y) -> " ++ func' ++ ")" ++ show (points domain meshSize))
let values = (\(Right v) -> (read v)::([Float])) values'
--the haskell expression being evaluated
putStrLn $ ("map (\\(x,y) -> " ++ func' ++ ")" ++ show (points domain meshSize))
--prints the actual values
putStrLn $ show values
--the type is indeed [float]
putStrLn $ show $ typeOf values
You can use the hint package, or plugins. I'll show you the former (partly because my Windows installation is clearly a little broken in that cabal doesn't share my belief that I have C installed, so cabal install plugins fails).
String -> Function is easy:
import Language.Haskell.Interpreter
getF :: String -> IO (Either InterpreterError (Float -> Float))
getF xs = runInterpreter $ do
setImports ["Prelude"]
interpret xs (as :: Float -> Float)
You may want to add additional modules to the imports list. This tests out as
ghci> getF "sin" >>= \(Right f) -> print $ f (3.1415927/2)
1.0
ghci> getF "(\\x -> if x > 5.0 then 5.0 else x)" >>= \(Right f) -> print $ f 7
5.0
(Notice the escaping of the escape character \.)
Error messages
As you may have noticed, the result is wrapped in the Either data type. Right f is correct output, whereas Left err gives an InterpreterError message, which is quite helpful:
ghci> getF "sinhh" >>= \(Left err) -> print err
WontCompile [GhcError {errMsg = "Not in scope: `sinhh'\nPerhaps you meant `sinh' (imported from Prelude)"}]
Example toy program
Of course, you can use either with your code to deal with this. Let's make a fake example respond. Your real one will contain all the maths of your program.
respond :: (Float -> Float) -> IO ()
respond f = do
-- insert cunning numerical method instead of
let result = f 5
print result
A simple, one-try, unhelpful version of your program could then be
main =
putStrLn "Enter your function please:"
>> getLine
>>= getF
>>= either print respond
Example sessions
ghci> main
Enter your function please:
\x -> x^2 + 4
29.0
ghci> main
Enter your function please:
ln
WontCompile [GhcError {errMsg = "Not in scope: `ln'"}]
It does type checking for you:
ghci> main
Enter your function please:
(:"yo")
WontCompile [GhcError {errMsg = "Couldn't match expected type `GHC.Types.Float'\n with actual type `GHC.Types.Char'"}]