Personal tools

Haskell Quiz/Bytecode Compiler/Solution Pepe Iborra

From HaskellWiki

< Haskell Quiz | Bytecode Compiler(Difference between revisions)
Jump to: navigation, search
Current revision (11:10, 13 January 2007) (edit) (undo)
(+cat)
 
(3 intermediate revisions not shown.)
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.
+
[[Category:Haskell Quiz solutions|Bytecode Compiler]]
 +
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)".
+
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 <hask>1*-1</hask>, which needs to be expressed as <hask>1*(-1)</hask>.
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-warn-missing-methods -e "process ($1)"
</code>
</code>
 +
And then:
 +
<code>
 +
sh compiler.sh 1+2
 +
</code>
 +
 +
The solution:
 +
<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>

Current revision

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
Retrieved from "http://www.haskell.org/haskellwiki/Haskell_Quiz/Bytecode_Compiler/Solution_Pepe_Iborra"

Category: Haskell Quiz solutions