Haskell Quiz/Bytecode Compiler/Solution Michael Sloan
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
import Char(digitToInt)
data Tok = C Char | N Int | Op Char | App Tok Tok Tok | G {members :: [Tok]}
--Debugging porpoises
instance Show Tok where
show (C ch) = ch : ""
show (N i) = show i
show (Op ch) = ch : ""
show (App a o b) = '(' : (show a) ++ (show o) ++ (show b) ++ ")"
show (G xs) = '[' : (concatMap (\x -> show x) xs) ++ "]"
g (x:xs) | null xs = x
g xs = G xs
parse xs = prec '+' $ prec '-' $ prec '*' $ prec '/' $ prec '^' $ fst $ parseG $ parseNOp $ map (\ch -> C ch) xs
parseNOp [] = []
parseNOp ((N num):(C ch):inp) | ch `elem` "0123456789" = parseNOp (N (num * 10 + digitToInt ch) : inp)
parseNOp ((C ch):inp) | ch `elem` "0123456789" = parseNOp (N (digitToInt ch) : inp)
parseNOp ((C ch):inp) | ch `elem` "+-*/^%" = parseNOp (Op ch : inp)
parseNOp ((C ch):inp) | ch `elem` " \t\r\n" = parseNOp inp
parseNOp (a:inp) = a : (parseNOp inp)
pToks = fst . parseG
pRem = snd . parseG
parseG [] = ([], [])
parseG [(G ts)] = (ts, [])
parseG ((C '(') : inp) = (g (pToks inp) : (pToks $ pRem inp), [])
parseG ((C ')') : inp) = ([], inp)
parseG (i:inp) = (i : (pToks inp), pRem inp)
prec mo [] = []
prec mo ((G xs):inp) = (g $ prec mo xs) : (prec mo inp)
prec mo (a:(Op o):b:inp) | o == mo = prec mo ((App (g $ prec mo [a]) (Op o) (g $ prec mo [b])) : inp)
prec mo ((App a o b):inp) = (App (g $ prec mo [a]) o (g $ prec mo [b])) : (prec mo inp)
prec mo (x:inp) = x : (prec mo inp)
stripG (App a o b) = App (stripG a) o (stripG b)
stripG (G (x:xs)) | null xs = error $ "error: " ++ show (x:xs) ++ " <- improper infix nesting here"
stripG (G (x:xs)) = stripG x
stripG x = x
toByteArray x n = map (\i -> (x `div` 2^(i*8)) `mod` 256 ) [(n-1),(n-2)..0]
bytes (C x) = error ("Invalid character: " ++ [x])
bytes (N n) = if abs n < 2^15 then 1 : toByteArray n 2 else 2 : toByteArray n 4
bytes (Op ch) = case ch of '+' -> [10]; '*' -> [11]; '^' -> [12]; '/' -> [14]; '%' -> [15]
bytes (App a o b) = (bytes a) ++ (bytes b) ++ (bytes o)
bytes x = error ("Error, invalid: " ++ show x)