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