Difference between revisions of "Haskell Quiz/Bytecode Compiler/Solution Justin Bailey"

This solution isn't the cleanest or quite tested, but if you load it in hugs and run:

```compile \$ parse \$ tokenize \$ stmt1
compile \$ parse \$ tokenize \$ stmt2
...
compile \$ parse \$ tokenize \$ stmt8
```

You'll see the byte codes generated. I didn't implement any optimizations (i.e. using SWAP).

The code below is literate Haskell.

```\begin{code}
import Data.Char(isAlpha, isDigit, isSeparator)

data Op = Plus | Minus | Mult | Div | Pow | Mod
deriving (Show, Eq)

data Token = RightParen
| LeftParen
| Number Integer
| Operator Op
deriving (Show, Eq)

data Expression = Statement Op Expression Expression
| Val Integer
| Empty
deriving (Show)

data Bytecode = NOOP | CONST Integer | LCONST Integer
| SUB
| MUL
| POW
| DIV
| MOD
| SWAP
deriving (Show)

expr1 = Statement Plus (Val 1) (Val 2)
expr2 = Statement Mult (Statement Plus (Val 1) (Val 2))  (Val 3)

-- Take a statement and evaluate
eval (Val n) = n
eval (Statement op left right)
| op == Mult = eval left * eval right
| op == Minus = eval left - eval right
| op == Plus = eval left + eval right
| op == Div = eval left `div` eval right
| op == Pow = eval left ^ eval right
| op == Mod = eval left `mod` eval right

-- Take a string and tokenize it
tokenize [] = []
tokenize ('(':xs) = LeftParen : tokenize xs
tokenize (')':xs) = RightParen : tokenize xs
tokenize (x:xs) | isDigit x = let (val, remaining) = span isDigit (x:xs)
in Number (read val) : tokenize remaining
| isOperator x = toOperator x : tokenize xs
| isSeparator x = tokenize (dropWhile isSeparator xs)
where
makeOp '+' = Just \$ Operator Plus
makeOp '-' = Just \$ Operator Minus
makeOp '*' = Just \$ Operator Mult
makeOp '/' = Just \$ Operator Div
makeOp '^' = Just \$ Operator Pow
makeOp '%' = Just \$ Operator Mod
makeOp _ = Nothing
toOperator x = case makeOp x of
Just x -> x
isOperator x = case makeOp x of
Just x -> True
_ -> False

stmt1 = "1 + 2" -- 3
stmt2 = "1 + 2 * 3" -- 7
stmt3 = "(1 + 2) * 3" -- 9
stmt4 = "4 - 5 * 2" -- -6
stmt5 = "5 * (2 - 4)" -- -10
stmt6 = "(1*3)*4*(5*6)" -- 360
stmt7 = "2^(2+(3/2)^2)" -- 8
stmt8 = "(10%3)*(2+2)" -- 4

{-
Based on http://www.engr.mun.ca/~theo/Misc/exp_parsing.htm

E -> E + E
E -> E * E
E -> E / E
E -> E - E
E -> E % E
E -> E ^ E
E -> ( E )
E -> n

Transform to

E --> Exp(0)
Exp(p) --> P {B Exp(q)}
P --> "(" E ")" | v
B --> "+" | "-"  | "*" |"/" | "^" | "%"

Precedence

^       3
*, /, % 2
+, -    1

-}

-- define precdence of operators
precedence Plus = 1
precedence Minus = 1
precedence Mult = 2
precedence Div = 3
precedence Mod = 2
precedence Pow = 3

-- Precedence comparison - gets precedence of
-- given operator and determines if its greater than the value given.
(>*) op val = precedence op >= val

-- Precedence addition - for left associative operators,
-- return its precedence + 1. For righ associative, just return the operators
-- precedence.
prec_add p = 1 + precedence p

parse [] = error "Can't parse empty list of tokens"
parse tokens = fst \$ parseE tokens 0
where parseE tokens prec
= let (p, remaining) = parseP tokens prec
in
if remaining == []
then (p, remaining)
Operator op ->
if op >* prec
then
let (right, rest) = parseE (tail remaining) \$ prec_add op
in (Statement op p right, rest)
else let (left, rest) = parseE (tail remaining) \$ prec
in (Statement op left p, rest)
_ -> (p, remaining)
parseP ((Number n):ts) prec = (Val n, ts)
parseP ((LeftParen):ts) prec
= let (e, remaining) = parseE ts 0
in (e, tail remaining)

compile stmt = compile' stmt []

compile' (Statement op left right) instr =
let li = compile' left instr
ri = compile' right instr
lri = li ++ ri
in case op of