Haskell Quiz/Bytecode Compiler/Solution Pepe Iborra
Revision as of 18:34, 10 November 2006
This extremely simple solution declares the type of Expressions as an instance of Num, thus don't really need to define a parser as long as the compiler is launched interpreted via 'ghc -e' . This trick is inspired from the Ruby solution.As far as I know it passes all the tests in the original suite, but due to the parsing trick some expressions need parentization. Namely expressions with negations such as
In order to launch the compiler from the command line you should use the script:
ghc bytecode.hs -fno-warn-missing-methods -e "process ($1)"
sh compiler.sh 1+2
import Data.Bits import Prelude hiding ((**), mod,div,const) process :: Exp -> String process = output . flip generate  data Exp = Exp :+ Exp | Exp :/ Exp | Exp :* Exp | Exp :- Exp | Exp :^ Exp | Exp :% Exp | Val Int deriving (Show, Eq) data ByteCode = Const Int | LConst Int | ADD | SUB | MUL | POW | DIV | MOD | SWAP deriving (Show,Eq) type Stack = [ByteCode] ------------------- -- The "Parser" ------------------- instance Fractional Exp where (/) = (:/) instance Num (Exp) where (+) = (:+) (-) = (:-) (*) = (:*) negate (Val i) = Val (negate i) fromInteger = Val . fromIntegral (**) = (:^) (%) = (:%) ---------------------- -- Smart constructors ---------------------- min_small = -32768 max_small = 32767 i `inBounds` (min,max) = i >= min && i <= max add,sub,mul,pow,div,mod,swap :: Stack -> Stack const i = if i `inBounds` (min_small,max_small) then Const i else LConst i add = (++[ADD]) sub = (++[SUB]) mul = (++[MUL]) pow = (++[POW]) div = (++[DIV]) mod = (++[MOD]) swap = (++[SWAP]) --------------------- generate :: Exp -> Stack -> Stack generate (Val i) = (++[const i]) generate (x :+ y) = binaryOp x y add generate (x :- y) = binaryOp x y sub generate (x :* y) = binaryOp x y mul generate (x :/ y) = binaryOp x y div generate (x :^ y) = binaryOp x y pow generate (x :% y) = binaryOp x y mod binaryOp :: Exp -> Exp -> (Stack -> Stack) -> Stack -> Stack binaryOp x y f = f . generate y . generate x bytes :: Int -> [Int] bytes a = a .&. 255 : bytes (a `shiftR` 8) represent :: ByteCode -> [Int] represent (Const i) = 1 : reverse( take 2 (bytes i)) represent (LConst i) = 2 : reverse( take 4 (bytes i)) represent ADD =  represent SUB =  represent MUL =  represent POW =  represent DIV =  represent MOD =  represent SWAP=  output :: Stack -> String output = show . concatMap represent