Difference between revisions of "Haskell Quiz/Bytecode Compiler/Solution Pepe Iborra"
Jump to navigation
Jump to search
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