Haskell Quiz/Bytecode Compiler/Solution Michael Sloan

import Data.Map (Map)
import qualified Data.Map as Map
import Data.List (intersect)
import Maybe
import Char(digitToInt)

data Op = Add | Sub | Mul | Div | Pow | Mod | Psh Int | LPar | RPar
  deriving (Show, Eq)

instance Ord Op where
  x <= y  =  precedence x <= precedence y 

precedence (Psh _) = 5
precedence Add = 1
precedence Sub = 1
precedence Mul = 2
precedence Mod = 2
precedence Div = 3
precedence Pow = 3
precedence LPar = 4
precedence RPar = 4
opFromChar '+' = Add
opFromChar '-' = Sub
opFromChar '*' = Mul
opFromChar '/' = Div
opFromChar '^' = Pow
opFromChar '%' = Mod
opFromChar '(' = LPar
opFromChar ')' = RPar

leftAssoc Pow = False
leftAssoc RPar = False
leftAssoc _   = True

parse = infixParse [] []
infixParse o s [] = if (length $ intersect [LPar, RPar] o) > 0 then error "Mismatched parenthesis" else reverse s ++ o
infixParse (RPar:LPar:o) s xs = infixParse o s xs
infixParse o s (x:xs)
 | x `elem` "+-*/^%)" = if not (null o) && (if leftAssoc op then (<=) else (<)) op (o !! 0) then infixParse (tail o) ((o !! 0):s) (x:xs) else infixParse (op:o) s xs
 | x `elem` "0123456789" = case (if null s then Add else s !! 0) of
      (Psh cur) -> infixParse ((Psh $ cur * 10 + digitToInt x) : (tail o)) s xs
      _         -> infixParse ((Psh $ digitToInt x):o) s xs
 | x == '(' = infixParse (LPar:o) s xs
 | x `elem` " \t\r\n" = infixParse o s xs
   where op = opFromChar x

getByte v i = (v `div` 2^(i*8)) `mod` 256 
toByteArray x n = map (\i -> getByte x i) [(n-1),(n-2)..0]

bytecode [] = []
bytecode (op:xs) = (case op of Add -> [10]; Mul -> [11]; Pow -> [12]; Div -> [14]; Mod -> [15]; (Psh x) -> if (abs x < 2^15) then (1 : toByteArray x 2) else (2 : toByteArray x 4)) ++ bytecode xs