Ella.hs

Ella

module Bee where

import Fresh
import Control.Monad.Trans
import Control.Monad.Writer
import Data.Monoid

data Op
 = Add | Sub | Mul
 deriving (Eq, Show)

data E
 = N Int
 | O Op E E
 deriving (Eq, Show)

--

type Cell = Int
cells = [1..]

data It reg
 = Register reg
 | Deref reg
 | Cell Int
 | Num Int
 deriving (Eq, Show)

data A reg
 = AAdd (It reg) (It reg)
 | ASub (It reg) (It reg)
 | AMul (It reg) (It reg)
 
 | AMov (It reg) (It reg)
 deriving (Eq, Show)

aop Add = AAdd
aop Sub = ASub
aop Mul = AMul

ella :: E -> It () -> WriterT [A ()] (Fresh Int) ()
ella (N i) r = tell [AMov r (Num i)]
ella (O op x y) r = do
 a <- lift $ fresh
 ella y (Cell a)
 ella x (Register ())
 tell [aop op (Register ()) (Cell a)]
 if r == Register ()
    then return ()
    else tell [AMov r (Register ())]

runElla exp = snd $ runFresh (runWriterT $ ella exp (Register ())) [0..]

{-

*Bee> mapM_ print $ runElla (O Add (O Add (N 2) (N 5)) (N 3))
AMov (Cell 0) (Num 3)
AMov (Cell 1) (Num 5)
AMov (Register ()) (Num 2)
AAdd (Register ()) (Cell 1)
AAdd (Register ()) (Cell 0)

*Bee> mapM_ print $ runElla (O Add (N 5) (O Add (N 2) (N 3)))
AMov (Cell 1) (Num 3)
AMov (Register ()) (Num 2)
AAdd (Register ()) (Cell 1)
AMov (Cell 0) (Register ())
AMov (Register ()) (Num 5)
AAdd (Register ()) (Cell 0)

-}