Personal tools

Haskell Quiz/Bytecode Compiler/Solution Pepe Iborra

From HaskellWiki

< Haskell Quiz | Bytecode Compiler
Revision as of 11:10, 13 January 2007 by Quale (Talk | contribs)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search

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
1*-1
, which needs to be expressed as
1*(-1)
.

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)"

And then:

sh compiler.sh 1+2

The solution:

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 = [10]
represent SUB = [11]
represent MUL = [12]
represent POW = [13]
represent DIV = [14]
represent MOD = [15]
represent SWAP= [160]
 
output :: Stack -> String
output = show . concatMap represent