# Haskell Quiz/Bytecode Compiler/Solution Pepe Iborra

### From HaskellWiki

< Haskell Quiz | Bytecode Compiler(Difference between revisions)

Line 1: | Line 1: | ||

− | This 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. |
+ | 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. |

It passes all the tests 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)". |
It passes all the tests 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)". |
||

Line 5: | Line 5: | ||

In order to launch the compiler from the command line you should use the script: |
In order to launch the compiler from the command line you should use the script: |
||

<code> |
<code> |
||

− | ghc bytecode.hs -fno-implicit-prelude -fno-warn-missing-methods -e 'process ($1)' |
+ | ghc bytecode.hs -fno-implicit-prelude -fno-warn-missing-methods -e "process ($1)" |

</code> |
</code> |
||

+ | And then: |
||

+ | <code> |
||

+ | sh compiler.sh 1+2 |
||

+ | </code> |
||

+ | |||

<haskell> |
<haskell> |
||

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

</haskell> |
</haskell> |

## Revision as of 18:24, 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.

It passes all the tests 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-implicit-prelude -fno-warn-missing-methods -e "process ($1)"
```

And then:
```
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 = [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