56 lines
2.4 KiB
Haskell
56 lines
2.4 KiB
Haskell
|
|
module Lambda where
|
|
|
|
import Eval
|
|
import System.IO
|
|
|
|
data Term = Const Int | Prim Card | Seq Term Term | Apply Term Term
|
|
|
|
cI = Prim Card_I
|
|
cGet n = Apply (Prim Card_Get) (Const n)
|
|
cPut = Prim Card_Put
|
|
cS [f, g] = Apply (Apply (Prim Card_S) f) g
|
|
cS [f, g, x] = Apply (Apply (Apply (Prim Card_S) f) g) x
|
|
cK x = Apply (Prim Card_K) x
|
|
cInc i = Apply (Prim Card_Inc) (Const i)
|
|
cDec i = Apply (Prim Card_Dec) (Const i)
|
|
cAttack [i, j] = Apply (Apply (Prim Card_Attack) (Const i)) (Const j)
|
|
cAttack [i, j, n] = Apply (Apply (Apply (Prim Card_Attack) (Const i)) (Const j)) (Const n)
|
|
cHelp [i, j] = Apply (Apply (Prim Card_Help) (Const i)) (Const j)
|
|
cHelp [i, j, n] = Apply (Apply (Apply (Prim Card_Help) (Const i)) (Const j)) (Const n)
|
|
cCopy i = Apply (Prim Card_Copy) (Const i)
|
|
cRevive i = Apply (Prim Card_Revive) (Const i)
|
|
cZombie i x = Apply (Apply (Prim Card_Zombie) (Const i)) x
|
|
|
|
test1 = cAttack [9, 8, 4000]
|
|
|
|
storeInt :: Int -> Int -> [Move]
|
|
storeInt pos = _store where
|
|
_store :: Int -> [Move]
|
|
_store 0 = [MoveLeft Card_Zero pos, MoveRight pos Card_Zero]
|
|
_store n = if (n `mod` 2 == 0) then _store (n `div` 2) ++ [MoveLeft Card_Dbl pos] else _store (n-1) ++ [MoveLeft Card_Succ pos]
|
|
|
|
command (Apply f x) = Apply (Apply (Prim Card_S) (Apply (Prim Card_K) f)) (Apply (Prim Card_K) x)
|
|
callresult t = cS [t, cI]
|
|
|
|
loop :: Term -> [Move]
|
|
loop cmd = store 0 (cS [cmd, callresult $ Prim Card_Get]) ++ c1 where
|
|
c1 = copyTo 1 0 ++ (MoveRight 0 Card_Zero):c1
|
|
|
|
copyTo :: Int -> Int -> [Move]
|
|
copyTo src dst = if (src == dst) then [] else storeInt dst src ++ [MoveLeft Card_Get dst]
|
|
|
|
store :: Int -> Term -> [Move]
|
|
store pos (Const n) = storeInt pos n
|
|
store pos (Apply (Prim c) t) = store pos t ++ [MoveLeft c pos]
|
|
store pos (Apply t (Prim c)) = store pos t ++ [MoveRight pos c]
|
|
store pos (Prim c) = [MoveLeft Card_Zero pos, MoveRight pos c]
|
|
store pos (Seq a b) = store pos (Apply (Apply (Apply (Prim Card_S) a) b) (Prim Card_Zero))
|
|
store pos (Apply a b) = if (pos == 0) then store 1 (Apply a b) ++ copyTo 1 0 else store pos a ++ store (pos+1) b ++ copyTo (pos+1) 0 ++ [MoveLeft Card_K pos, MoveLeft Card_S pos, MoveRight pos Card_Get, MoveRight pos Card_Zero]
|
|
|
|
printMove :: Move -> IO ()
|
|
printMove (MoveLeft c pos) = putStr ("1\n" ++ show c ++ "\n" ++ show pos ++ "\n") >> hFlush stdout
|
|
printMove (MoveRight pos c) = putStr ("2\n" ++ show pos ++ "\n" ++ show c ++ "\n") >> hFlush stdout
|
|
|
|
main = (mapM_ printMove $ loop (Prim Card_Dec)) >> mapM_ (const getLine) [0..]
|