Haskell Quiz/Bytecode Compiler/Solution Michael Sloan: Difference between revisions
No edit summary |
No edit summary |
||
| Line 11: | Line 11: | ||
show (G xs) = '[' : (concatMap (\x -> show x) xs) ++ "]" | show (G xs) = '[' : (concatMap (\x -> show x) xs) ++ "]" | ||
parse xs = stripG $ prec '+' $ prec '-' $ prec '*' $ prec '/' $ prec '^' $ pToks $ parseNOp $ map (\ch -> C ch) xs | |||
parse xs = prec '+' $ prec '-' $ prec '*' $ prec '/' $ prec '^' $ | |||
parseNOp [] = [] | parseNOp [] = [] | ||
| Line 23: | Line 20: | ||
parseNOp (a:inp) = a : (parseNOp inp) | parseNOp (a:inp) = a : (parseNOp inp) | ||
--Groups an array of tokens if it needs to be | |||
g (x:xs) | null xs = x | |||
g xs = G xs | |||
--Returns parsed tokens/stream remainder | |||
pToks = fst . parseG | pToks = fst . parseG | ||
pRem = snd . parseG | pRem = snd . parseG | ||
| Line 32: | Line 34: | ||
parseG (i:inp) = (i : (pToks inp), pRem inp) | parseG (i:inp) = (i : (pToks inp), pRem inp) | ||
--Traverses groups, applies operators to their immediate arguments | |||
prec mo [] = [] | prec mo [] = [] | ||
prec mo ((G xs):inp) = (g $ prec mo xs) : (prec mo inp) | prec mo ((G xs):inp) = (g $ prec mo xs) : (prec mo inp) | ||
| Line 38: | Line 41: | ||
prec mo (x:inp) = x : (prec mo inp) | prec mo (x:inp) = x : (prec mo inp) | ||
--Removes any vestigial grouping | |||
stripG (App a o b) = App (stripG a) o (stripG b) | 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)) | null xs = error $ "error: " ++ show (x:xs) ++ " <- improper infix nesting here" | ||
| Line 43: | Line 47: | ||
stripG x = x | stripG x = x | ||
--Converts to a byte format | |||
bytes (C x) = error ("Invalid character: " ++ [x]) | 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 (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 (Op ch) = case ch of '+' -> [10]; '*' -> [11]; '^' -> [12]; '/' -> [14]; '%' -> [15] | ||
bytes (App a o b) = (bytes a) ++ (bytes b) ++ (bytes o) | bytes (App a o b) = (bytes a) ++ (bytes b) ++ (bytes o) | ||
bytes x = error ("Error, invalid: " ++ show x)</haskell> | bytes x = error ("Error, invalid: " ++ show x) | ||
toByteArray x n = map (\i -> (x `div` 2^(i*8)) `mod` 256 ) [(n-1),(n-2)..0]</haskell> | |||
Revision as of 05:23, 6 November 2006
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) ++ "]"
parse xs = stripG $ prec '+' $ prec '-' $ prec '*' $ prec '/' $ prec '^' $ pToks $ 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)
--Groups an array of tokens if it needs to be
g (x:xs) | null xs = x
g xs = G xs
--Returns parsed tokens/stream remainder
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)
--Traverses groups, applies operators to their immediate arguments
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)
--Removes any vestigial grouping
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
--Converts to a byte format
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)
toByteArray x n = map (\i -> (x `div` 2^(i*8)) `mod` 256 ) [(n-1),(n-2)..0]