# Haskell Quiz/Bytecode Compiler/Solution Pepe Iborra

From HaskellWiki

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
```