diff --git a/Eval.hs b/Eval.hs index 10bd58f..bc37afc 100644 --- a/Eval.hs +++ b/Eval.hs @@ -51,8 +51,11 @@ instance Monad Turn where return x = Turn $ \game -> return (game, Right x) fail s = Turn $ \game -> return (game, Left s) -liftIO :: IO x -> Turn x -liftIO f = Turn $ \game -> f >>= \x -> return (game, Right x) +class Monad m => MonadIO m where + liftIO :: IO x -> m x + +instance MonadIO Turn where + liftIO f = Turn $ \game -> f >>= \x -> return (game, Right x) apply :: Int -> Turn () apply n = Turn $ \game -> let a = n + (applications game) in let g = game { applications = a } in if a > 1000 then return (g, Left "Application limit exceeded") else return (g, Right ()) diff --git a/Lambda.hs b/Lambda.hs index 8492735..99abf9c 100644 --- a/Lambda.hs +++ b/Lambda.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -XTypeSynonymInstances #-} module Lambda where @@ -81,7 +82,9 @@ copyTo src dst = if (src == dst) then [] else storeInt dst src ++ [MoveLeft Card 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 (Const 0) t) = store pos t ++ [MoveLeft Card_Zero pos] store pos (Apply t (Prim c)) = store pos t ++ [MoveRight pos c] +store pos (Apply t (Const 0)) = store pos t ++ [MoveRight pos Card_Zero] 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]