Haskell Quiz/Bytecode Compiler/Solution Michael Sloan
Jump to navigation
Jump to search
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