CSE 230 Winter 2015 HW2

Hw2.lhs

---
title: Homework #2, Due Friday 2/13/15
---

> {-# LANGUAGE TypeSynonymInstances #-}
> {-# OPTIONS -Wall -fno-warn-unused-do-bind #-}

> module Hw2 where
> import Control.Applicative hiding (empty, (<|>))
> import Data.Map hiding (foldl, foldr)
> import Control.Monad.State hiding (when)
> import Text.Parsec hiding (State, between)
> import Text.Parsec.Combinator hiding (between)
> import Text.Parsec.Char
> import Text.Parsec.String

This week's homework is presented as a literate Haskell file,
just like the lectures. This means that every line beginning with
`>` is interpreted as Haskell code by the compiler, while every other
line is ignored. (Think of this as the comments and code being reversed
from what they usually are.)

You can load this file into `ghci` and compile it with `ghc`
just like any other Haskell file, so long as you remember to save
it with a `.lhs` suffix.

To complete this homework, download [this file as plain text](Hw2.lhs) and
answer each question, filling in code where noted (i.e. where it says `error
"TBD"`).

Your code *must* typecheck against the given type signatures.
Feel free to add your own tests to this file to exercise the functions
you write.  Submit your homework by sending this file, filled in
appropriately, to `cse230@goto.ucsd.edu` with the subject "HW2"; you
will receive a confirmation email after submitting. 

Before starting this assignment:

1. Install `parsec3` via the command `cabal install parsec3`
2. Learn to read the [documentation](http://hackage.haskell.org)
3. Download the test files 
   [test.imp](http://cseweb.ucsd.edu/classes/wi15/cse230-a/static/test.imp),
   [fact.imp](http://cseweb.ucsd.edu/classes/wi15/cse230-a/static/fact.imp), 
   [abs.imp](http://cseweb.ucsd.edu/classes/wi15/cse230-a/static/abs.imp), 
   [times.imp](http://cseweb.ucsd.edu/classes/wi15/cse230-a/static/times.imp).

Problem 0: All About You
========================


Tell us your name, email and student ID, by replacing the respective
strings below

> myName  = "Martin Bjeldbak Madsen"
> myEmail = "ax003222@acsmail.ucsd.edu"
> mySID   = "U06616356"


Problem 1: All About `foldl`
============================

Define the following functions by filling in the "error" portion:

1. Describe `foldl` and give an implementation:

I have started to think about foldl as taking the right element of a list and recursively solving the left hand side of the list, applying some function `f` between the current element and the "stuff" on the left. It left-parenthasises elements of a list, so if `(+)` was the operator, and `[1, 2, 3, 4, 5]` was the list, `foldl (+) 0 [1, 2, 3, 4, 5]` would return `(((((0 + 1) + 2) + 3) + 4) + 5)`.Whereas with `foldr`, the parenthasises would begin from the right.

> myFoldl            :: (a -> b -> a) -> a -> [b] -> a
> myFoldl _ a []     = a
> myFoldl f a (b:bs) = myFoldl f (f a b) bs

2. Using the standard `foldl` (not `myFoldl`), define the list reverse function:

> myReverse    :: [a] -> [a]
> myReverse xs = foldl (\x y -> y : x) [] xs
> -- myReverse xs = foldl (flip (:)) [] xs

3. Define `foldr` in terms of `foldl`:

> myFoldr :: (a -> b -> b) -> b -> [a] -> b
> myFoldr f b as = foldl (\g x y -> g (f x y)) id as b

4. Define `foldl` in terms of the standard `foldr` (not `myFoldr`):

> myFoldl2 :: (a -> b -> a) -> a -> [b] -> a
> myFoldl2 f b as = foldr (\x g y -> g (f y x)) id as b

5. Try applying `foldl` to a gigantic list. Why is it so slow?
   Try using `foldl'` (from [Data.List](http://www.haskell.org/ghc/docs/latest/html/libraries/base/Data-List.html#3))
   instead; can you explain why it's faster?

It has to evaluate the operator given to type check its arguments, since Haskell is strictly typed. This means it has to type check all operators, requiring it to go through each call and keep the results on the stack.

Part 2: Binary Search Trees
===========================

Recall the following type of binary search trees:

> data BST k v = Emp 
>              | Bind k v (BST k v) (BST k v) 
>              deriving (Show)

Define a `delete` function for BSTs of this type:

I don't know what the point of the `v` thing is, so I'm ignoring it in my algorithms. As it has been a long time since an algorithms course, I had to look up how to delete, remembering it was the more complicated operation. I found the explaination in Introduction to Algorithms a little tough, so I looked it up on Wikipedia and got to this result.

First, an algorithm to find the in-order predecessor of the BST given to copy the value of the predecessor (i.e. the minimum key) by simply going as left as possible until we hit Emp, and returning the key `k` and value `v` which we are at.

> minKeyVal :: (Ord k) => BST k v -> (k, v)
> minKeyVal (Bind k v Emp _) = (k, v)
> minKeyVal (Bind _ _ l _) = minKeyVal l
> minKeyVal Emp            = error "Cannot find the min (k,v) in empty tree"

Now, the delete function. There the following cases:
  1. When we are given an empty node, there is no node to delete, so just return an empty BST.
  2. When we are given a leaf and the leaf's key matches the key we want to delete, return `Emp`, otherwise just return the leaf.
  3a. If the tree we're looking at has two children, figure out which child to recursively call `delete` in that subtree
  3b. If none of the children match, check the key with the node we're looking at. If the key we wish to delete is the node's key, then find the node's in-order successor in the right subtree, replace the node's key and value with that node, and recursively delete the in-order successor from the right subtree.

> delete :: (Ord k) => k -> BST k v -> BST k v
> delete _ Emp = Emp -- delete anything from an empty tree is empty
> delete k (Bind k' v Emp Emp)
>  | k == k'   = Emp 
>  | otherwise = (Bind k' v Emp Emp)
> delete k (Bind k' v l Emp)
>  | k > k'  = (Bind k' v l Emp) -- key not matched, do nothing
>  | k < k'  = Bind k' v (Hw2.delete k l) Emp -- recursively delete in left tree
>  | k == k' = l -- push left tree up
> delete k (Bind k' v Emp r)
>  | k < k'  = (Bind k' v Emp r)
>  | k > k'  = Bind k' v (Hw2.delete k r) Emp
>  | k == k' = r
> delete k (Bind k' v l r)
>  | k < k'  = Bind k' v (Hw2.delete k l) r
>  | k > k'  = Bind k' v l (Hw2.delete k r)
>  | k == k' = Bind mink minv l r' 
>      where (mink, minv) = minKeyVal r
>            r'           = Hw2.delete mink r
>-- delete _ _   = error "Delete has to be of Emp or Bind"
>
>-- t = (Bind 8 8 (Bind 3 3 (Bind 1 1 Emp Emp) (Bind 6 6 (Bind 4 4 Emp Emp) (Bind 7 7 Emp Emp))) (Bind 10 10 Emp (Bind 14 14 (Bind 13 13 Emp Emp) Emp)))

Part 3: An Interpreter for WHILE 
================================

Next, you will use monads to build an evaluator for
a simple *WHILE* language. In this language, we will
represent different program variables as 

> type Variable = String

Programs in the language are simply values of the type

> data Statement =
>     Assign Variable Expression          -- x = e
>   | If Expression Statement Statement   -- if (e) {s1} else {s2}
>   | While Expression Statement          -- while (e) {s}
>   | Sequence Statement Statement        -- s1; s2
>   | Skip                                -- no-op
>   deriving (Show)

where expressions are variables, constants or 
binary operators applied to sub-expressions

> data Expression =
>     Var Variable                        -- x
>   | Val Value                           -- v 
>   | Op  Bop Expression Expression
>   deriving (Show)

and binary operators are simply two-ary functions

> data Bop = 
>     Plus     -- +  :: Int  -> Int  -> Int
>   | Minus    -- -  :: Int  -> Int  -> Int
>   | Times    -- *  :: Int  -> Int  -> Int
>   | Divide   -- /  :: Int  -> Int  -> Int
>   | Gt       -- >  :: Int -> Int -> Bool 
>   | Ge       -- >= :: Int -> Int -> Bool
>   | Lt       -- <  :: Int -> Int -> Bool
>   | Le       -- <= :: Int -> Int -> Bool
>   deriving (Show)

> data Value =
>     IntVal Int
>   | BoolVal Bool
>   deriving (Show)

We will represent the *store* i.e. the machine's memory, as an associative
map from `Variable` to `Value` 

> type Store = Map Variable Value

**Note:** we don't have exceptions (yet), so if a variable
is not found (eg because it is not initialized) simply return 
the value `0`. In future assignments, we will add this as a 
case where exceptions are thrown (the other case being type errors.)

We will use the standard library's `State` 
[monad](http://hackage.haskell.org/packages/archive/mtl/latest/doc/html/Control-Monad-State-Lazy.html#g:2)
to represent the world-transformer.
Intuitively, `State s a` is equivalent to the world-transformer 
`s -> (a, s)`. See the above documentation for more details. 
You can ignore the bits about `StateT` for now.

Expression Evaluator
--------------------

First, write a function 

> evalE :: Expression -> State Store Value

that takes as input an expression and returns a world-transformer that
returns a value. Yes, right now, the transformer doesnt really transform
the world, but we will use the monad nevertheless as later, the world may
change, when we add exceptions and such.

**Hint:** The value `get` is of type `State Store Store`. Thus, to extract 
the value of the "current store" in a variable `s` use `s <- get`.

> evalE (Var x)      = do s <- get -- load store
>                         let v = Data.Map.lookup x s -- lookup variable x in s
>                         case v of
>                           Just k  -> return k -- if x found in store
>                           Nothing -> return $ IntVal 0 -- return value 0
> evalE (Val v)      = return v
> evalE (Op o e1 e2) = do l <- evalE e1
>                         r <- evalE e2
>                         return $ evalOp o l r

Where the `evalOp` function takes a `Bop` operation along with two values, and returns another value as a result of running the operation on the two values, as shown below. 

> evalOp :: Bop -> Value -> Value -> Value
> evalOp Plus   = useOp (+)
> evalOp Minus  = useOp (-)
> evalOp Times  = useOp (*)
> evalOp Divide = useOp div
> evalOp Gt     = useBoolOp (>)
> evalOp Ge     = useBoolOp (>=)
> evalOp Lt     = useBoolOp (<)
> evalOp Le     = useBoolOp (<=)

Unfortunately, by the nature of how the assignment is formed and the type of values passed around, the only solution I see is to have the two functions shown below: one that runs integer operators, and another that runs boolean operators. The base cases are each defined as specified in [this](https://piazza.com/class/i4kkvjdaoqj7aj?cid=51) Piazza post.

> useOp :: (Int -> Int -> Int) -> Value -> Value -> Value 
> useOp op (IntVal l) (IntVal r) = IntVal $ l `op` r
> useOp _ _ _                    = IntVal 0

> useBoolOp :: (Int -> Int -> Bool) -> Value -> Value -> Value
> useBoolOp op (IntVal l) (IntVal r) = BoolVal $ l `op` r
> useBoolOp _ _ _                    = BoolVal False

Statement Evaluator
-------------------

Next, write a function

> evalS :: Statement -> State Store ()

that takes as input a statement and returns a world-transformer that
returns a unit. Here, the world-transformer should in fact update the input
store appropriately with the assignments executed in the course of
evaluating the `Statement`.

**Hint:** The value `put` is of type `Store -> State Store ()`. 
Thus, to "update" the value of the store with the new store `s'` 
do `put s`.

> evalS w@(While e s)    = do e' <- evalE e
>                             case e' of
>                               BoolVal True  -> evalS s >> evalS w
>                               _             -> evalS Skip -- could return err
> evalS Skip             = return () -- no-op
> evalS (Sequence s1 s2) = evalS s1 >> evalS s2
> evalS (Assign x e)     = do s  <- get -- get store
>                             e' <- evalE e -- evaluate expression
>                             put $ Data.Map.insert x e' s -- ass. store, update
> evalS (If e s1 s2)     = do e' <- evalE e -- evaluate expression
>                             case e' of
>                               BoolVal True  -> evalS s1
>                               BoolVal False -> evalS s2
>                               IntVal _      -> evalS Skip

In the `If` case, if `e` evaluates to a non-boolean value, just skip both
the branches. (We will convert it into a type error in the next homework.)

Assuming the same goes for the `While` case.

Finally, write a function (I filled it in)

> execS            :: Statement -> Store -> Store
> execS stmt store = execState (evalS stmt) store

such that `execS stmt store` returns the new `Store` that results
from evaluating the command `stmt` from the world `store`. 
**Hint:** You may want to use the library function 

~~~~~{.haskell}
execState :: State s a -> s -> s
~~~~~

When you are done with the above, the following function will 
"run" a statement starting with the `empty` store (where no 
variable is initialized). Running the program should print 
the value of all variables at the end of execution.

> run      :: Statement -> IO ()
> run stmt = do putStrLn "Output Store:" 
>               putStrLn $ show $ execS stmt empty

Here are a few "tests" that you can use to check your implementation.

> w_test = (Sequence (Assign "X" (Op Plus (Op Minus (Op Plus (Val (IntVal 1)) (Val (IntVal 2))) (Val (IntVal 3))) (Op Plus (Val (IntVal 1)) (Val (IntVal 3))))) (Sequence (Assign "Y" (Val (IntVal 0))) (While (Op Gt (Var "X") (Val (IntVal 0))) (Sequence (Assign "Y" (Op Plus (Var "Y") (Var "X"))) (Assign "X" (Op Minus (Var "X") (Val (IntVal 1))))))))

> w_fact = (Sequence (Assign "N" (Val (IntVal 2))) (Sequence (Assign "F" (Val (IntVal 1))) (While (Op Gt (Var "N") (Val (IntVal 0))) (Sequence (Assign "X" (Var "N")) (Sequence (Assign "Z" (Var "F")) (Sequence (While (Op Gt (Var "X") (Val (IntVal 1))) (Sequence (Assign "F" (Op Plus (Var "Z") (Var "F"))) (Assign "X" (Op Minus (Var "X") (Val (IntVal 1)))))) (Assign "N" (Op Minus (Var "N") (Val (IntVal 1))))))))))

As you can see, it is rather tedious to write the above tests! They
correspond to the code in the files `test.imp` and `fact.imp`. When you are
done, you should get

~~~~~{.haskell}
ghci> run w_test
Output Store:
fromList [("X",IntVal 0),("Y",IntVal 10)]

ghci> run w_fact
Output Store:
fromList [("F",IntVal 2),("N",IntVal 0),("X",IntVal 1),("Z",IntVal 2)]
~~~~~

Problem 4: A Parser for WHILE 
=============================

It is rather tedious to have to specify individual programs as Haskell
values. For this problem, you will use parser combinators to build a parser
for the WHILE language from the previous problem.

Parsing Constants
-----------------

First, we will write parsers for the `Value` type

> valueP :: Parser Value
> valueP = intP <|> boolP

To do so, fill in the implementations of

> intP :: Parser Value
> intP = do ds <- many1 digit
>           return $ IntVal (read ds)
>      <?> "number"

Next, define a parser that will accept a 
particular string `s` as a given value `x`

> constP :: String -> a -> Parser a
> constP s x = string s >>
>              notFollowedBy alphaNum >>
>              return x
>            <?> "string to 'Value' mapping"

and use the above to define a parser for boolean values 
where `"true"` and `"false"` should be parsed appropriately.

> boolP :: Parser Value
> boolP =   try (constP "true"  (BoolVal True))
>       <|> try (constP "false" (BoolVal False))
>       <?> "'true' or 'false'"

Continue to use the above to parse the binary operators

> opP :: Parser Bop 
> opP =   try (constP "+" Plus)
>     <|> try (constP "-" Minus)
>     <|> try (constP "*" Times)
>     <|> try (constP "/" Divide)
>     <|> try (constP ">" Gt)
>     <|> try (constP ">=" Ge)
>     <|> try (constP "<" Lt)
>     <|> try (constP "<=" Le)
>     <?> "a boolean operator"

Parsing Expressions 
-------------------

Next, the following is a parser for variables, where each 
variable is one-or-more uppercase letters. 

> varP :: Parser Variable
> varP = many1 upper

Use the above to write a parser for `Expression` values

Assuming all operators have equal precedence with right association, as per [this](https://piazza.com/class/i4kkvjdaoqj7aj?cid=54) Piazza response by TA Eric Seidel.

I introduce three new functions to parse the different Expression types, starting attempting to parse an operation, then a variable, then a value.

> exprP :: Parser Expression
> exprP =     try opExprP
>         <|> try parenExprP
>         <|> try valVarExprP
>         <?> "any expression"

> parenExprP :: Parser Expression
> parenExprP = do char '('
>                 spaces
>                 e <- exprP
>                 spaces
>                 char ')'
>                 return e
>            <?> "parameterised expression"
 
Below are parsers to turn variables and values into expressions. I use the `liftM` library function to promote the `Var` constructor function to a `Parser` monad with the `varP` and `valueP` `Parser` monads, respectively.

> varExprP :: Parser Expression
> varExprP = liftM Var varP
>          <?> "variable"

> valExprP :: Parser Expression
> valExprP = liftM Val valueP
>          <?> "value"

Combining these two gives the parser `valVarExprP` for both `Val` and `Var` `Expression`s:

> valVarExprP :: Parser Expression
> valVarExprP =   try varExprP
>             <|> try valExprP

Finally the operation parser, `opExprP`, is constructed as shown below. It it is right-recursive (to avoid infinite loops), meaning the expression will be right-associative. It first looks to try to find a `Val`, `Var`, or parameterized `Expression` on the left-hand side. Then it looks for a boolean operator, then finally a right-hand side expression (can be parenthasized or not):

> opExprP :: Parser Expression
> opExprP = do l <- try valVarExprP <|> try parenExprP
>              spaces
>              bop <- opP
>              spaces
>              r <- exprP
>              return $ Op bop l r
>         <?> "operation"

Parsing Statements
------------------

Next, use the expression parsers to build a statement parser

> statementP :: Parser Statement
> statementP =   try seqP
>            <|> try assignP
>            <|> try ifP
>            <|> try whileP
>            <|> try skipP
>            <?> "statement"

> skipP :: Parser Statement
> skipP = do string "skip"
>            return $ Skip
>       <?> "skip"

> seqP :: Parser Statement
> seqP = do s1 <- try assignP <|> try ifP <|> try whileP <|> try skipP
>           char ';'
>           spaces
>           s2 <- statementP
>           return $ Sequence s1 s2
>       <?> "sequence"

> whileP :: Parser Statement
> whileP = do string "while"
>             spaces
>             e <- exprP
>             spaces
>             string "do"
>             spaces
>             s <- statementP
>             spaces
>             string "endwhile"
>             return $ While e s
>        <?> "while"

> ifP :: Parser Statement
> ifP = do string "if"
>          spaces
>          e <- exprP
>          spaces
>          string "then"
>          spaces
>          t <- statementP
>          spaces
>          string "else"
>          spaces
>          f <- statementP
>          spaces
>          string "endif"
>          return $ If e t f
>       <?> "if"

> assignP :: Parser Statement
> assignP = do v <- varP
>              spaces
>              string ":="
>              spaces
>              e <- exprP
>              return $ Assign v e
>         <?> "assignment"

When you are done, we can put the parser and evaluator together 
in the end-to-end interpreter function

> runFile s = do p <- parseFromFile statementP s
>                case p of
>                  Left err   -> print err
>                  Right stmt -> run stmt

When you are done you should see the following at the ghci prompt

~~~~~{.haskell}
ghci> runFile "test.imp"
Output Store:
fromList [("X",IntVal 0),("Y",IntVal 10)]

ghci> runFile "fact.imp" 
Output Store:
fromList [("F",IntVal 2),("N",IntVal 0),("X",IntVal 1),("Z",IntVal 2)]

ghci> runFile "abs.imp"
Output Store:
fromList [("X",IntVal 3)]

ghci> runFile "times.imp"
Output Store:
fromList [("X",IntVal 0),("Y",IntVal 3),("Z",IntVal 30)]
~~~~~