diff --git a/AI.hs b/AI.hs
new file mode 100644
index 0000000..3cfdbf5
--- /dev/null
+++ b/AI.hs
@@ -0,0 +1,10 @@
+
+
+module AI (aimove) where
+
+import Eval
+import Lambda
+import GoalTransform
+
+aimove :: Turn Goal
+aimove = return (Just 0, read "S dec (S get I)")
diff --git a/Client.hs b/Client.hs
new file mode 100644
index 0000000..9134b4d
--- /dev/null
+++ b/Client.hs
@@ -0,0 +1,75 @@
+
+
+module Client where
+
+import Eval
+import Lambda
+import AI
+import GoalTransform
+
+import System.IO
+import System.Environment
+import Control.Monad
+
+import qualified Data.Array.IO as A
+
+readMove :: Turn Move
+readMove = do
+	lr <- liftIO getLine
+	sf <- liftIO getLine
+	st <- liftIO getLine
+	if (lr == "1") then (do
+			let f = read sf :: Card
+			let t = read st :: Int
+			return $ MoveLeft f t
+		) else (do
+			let f = read sf :: Int
+			let t = read st :: Card
+			return $ MoveRight f t
+		)
+
+stepClient :: Turn ()
+stepClient = readMove >>= runMove
+
+stepAI :: Turn Goal -> Turn ()
+stepAI ai = do
+	try (do
+			goal <- ai
+			move <- moveGoal goal
+			liftIO $ printMove move
+			runMove move
+		) (\s -> do
+			liftIO $ hPutStrLn stderr $ "Error calculating move"
+			game <- getGame
+			ownfields <- liftIO $ A.getAssocs (fields $ proponent game)
+			let (a, _):_ = filter (\(_, (_, v)) -> v > 0) ownfields
+			liftIO $ hPutStrLn stderr $ "=> I " ++ show a
+			liftIO $ printMove (MoveLeft Card_I a)
+			runMove (MoveLeft Card_I a)
+		)
+
+run :: Turn Goal -> Bool -> IO ()
+run ai firstPlayer = do
+		hSetBuffering stdin NoBuffering
+		hSetBuffering stdout NoBuffering
+		game <- initGame
+		runTurn _loop1 game
+		return ()
+	where
+		_loop1 :: Turn ()
+		_loop1 = do
+			when (firstPlayer) (stepAI ai)
+			_loop
+		_loop :: Turn ()
+		_loop = do
+			stepClient
+			stepAI ai
+			_loop
+
+
+getArgsFirstPlayer :: IO Bool
+getArgsFirstPlayer = do
+	arg:_ <- getArgs
+	return $ arg == "0"
+
+main = getArgsFirstPlayer >>= run aimove
diff --git a/Eval.hs b/Eval.hs
index bc37afc..43e922b 100644
--- a/Eval.hs
+++ b/Eval.hs
@@ -8,18 +8,23 @@ module Eval (
 	Turn (..),
 	Value (..),
 	Card (..),
+	MonadIO (..),
 	cardNames,
 	pCard,
 	Move (..),
 	card,
 	initGame,
-	run,
+	getGame,
+	try,
+	runMove,
+	runTurn,
 	testMoves,
 	testMoves1
 ) where
 
 import Control.Monad
 import qualified Data.Array.IO as A
+import System.IO
 import System.IO.Unsafe
 import Data.Maybe
 
@@ -29,7 +34,10 @@ import Data.Char
 type Field = (Value, Int)
 type Fields = A.IOArray Int Field
 data Player = Player { fields :: Fields } deriving (Show, Eq)
-data Game = Game { proponent, opponent :: Player, applications :: Int, automode :: Bool, gameturn :: Integer } deriving (Show, Eq)
+
+data AIState = AIState deriving (Show, Eq)
+
+data Game = Game { proponent, opponent :: Player, applications :: Int, automode :: Bool, gameturn :: Integer, aistate :: AIState } deriving (Show, Eq)
 
 data Turn x = Turn { runTurn' :: Game -> IO (Game, Either String x) }
 
@@ -57,11 +65,20 @@ class Monad m => MonadIO m where
 instance MonadIO Turn where
 	liftIO f = Turn $ \game -> f >>= \x -> return (game, Right x)
 
+modifyGame :: (Game -> Game) -> Turn ()
+modifyGame f = Turn $ \game -> return (f game, Right ())
+
+getGame :: Turn Game
+getGame = Turn $ \game -> return (game, Right game)
+
+switchPlayer :: Turn ()
+switchPlayer = modifyGame $ \game -> game { proponent = opponent game, opponent = proponent game, gameturn = 1 + gameturn game }
+
 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 ())
 
 reset :: Turn ()
-reset = Turn $ \game -> return (game {applications = 0}, Right ())
+reset = modifyGame $ \game -> game {applications = 0}
 
 try :: Turn x -> (String -> Turn y) -> Turn ()
 try (Turn action) catch = Turn $ \game -> (action game >>=) $ \(game', r) -> case r of Right _ -> return (game', Right ()); Left s -> case catch s of Turn catch' -> catch' game' >>= (\(game'', r) -> case r of Right _ -> return (game'', Right ()); Left s -> return (game'', Left s))
@@ -148,18 +165,18 @@ reviveSlot player slot = do
 card :: Card -> Value
 card Card_I = take1 "I" $ return
 card Card_Zero = ValInt 0
-card Card_Succ = take1 "Succ" $ getInt >=> return . int . (+1)
-card Card_Dbl = take1 "Dbl" $ getInt >=> return . int . (*2)
-card Card_Get = take1 "Get" $ getAliveSlot proponent >=> \(_, (val, _)) -> return val
-card Card_Put = take1 "Put" $ const $ return $ card Card_I
+card Card_Succ = take1 "succ" $ getInt >=> return . int . (+1)
+card Card_Dbl = take1 "dbl" $ getInt >=> return . int . (*2)
+card Card_Get = take1 "get" $ getAliveSlot proponent >=> \(_, (val, _)) -> return val
+card Card_Put = take1 "put" $ const $ return $ card Card_I
 card Card_S = take3 "S" $ \f g x -> do
 	h <- tryApply f x
 	y <- tryApply g x
 	tryApply h y
 card Card_K = take2 "K" $ \x _ -> return x
-card Card_Inc = take1 "Inc" $ getSlotNo >=> \slot -> autoSwitch (healSlot proponent 1 slot) (pierceSlot proponent 1 slot)
-card Card_Dec = take1 "Dec" $ getSlotNo >=> \slot -> autoSwitch (pierceSlot opponent 1 (255-slot)) (healSlot opponent 1 (255-slot))
-card Card_Attack = take3 "Attack" $ \i j n -> do
+card Card_Inc = take1 "inc" $ getSlotNo >=> \slot -> autoSwitch (healSlot proponent 1 slot) (pierceSlot proponent 1 slot)
+card Card_Dec = take1 "dec" $ getSlotNo >=> \slot -> autoSwitch (pierceSlot opponent 1 (255-slot)) (healSlot opponent 1 (255-slot))
+card Card_Attack = take3 "attack" $ \i j n -> do
 	i <- getSlotNo i
 	n <- getInt n
 	autoSwitch (do
@@ -175,7 +192,7 @@ card Card_Attack = take3 "Attack" $ \i j n -> do
 			j <- getSlotNo j
 			healSlot opponent ((n*9) `div` 10) (255-j)
 		)
-card Card_Help = take3 "Help" $ \i j n -> do
+card Card_Help = take3 "help" $ \i j n -> do
 	i <- getSlotNo i
 	n <- getInt n
 	autoSwitch (do
@@ -191,9 +208,9 @@ card Card_Help = take3 "Help" $ \i j n -> do
 			j <- getSlotNo j
 			pierceSlot proponent ((n*11) `div` 10) (255-j)
 		)
-card Card_Copy = take1 "Copy" $ getSlotNo >=> readSlot opponent >=> \(_, (val, _)) -> return val
-card Card_Revive = take1 "Revive" $ getSlotNo >=> reviveSlot proponent >=> const (return $ card Card_I)
-card Card_Zombie = take2 "Zombie" $ \i x -> do
+card Card_Copy = take1 "copy" $ getSlotNo >=> readSlot opponent >=> \(_, (val, _)) -> return val
+card Card_Revive = take1 "revive" $ getSlotNo >=> reviveSlot proponent >=> const (return $ card Card_I)
+card Card_Zombie = take2 "zombie" $ \i x -> do
 	i <- getSlotNo i
 	(_, (_, vit)) <- readSlot opponent (255-i)
 	when (vit > 0) $ fail "Zombie: slot is still alive"
@@ -202,23 +219,25 @@ card Card_Zombie = take2 "Zombie" $ \i x -> do
 
 runauto :: Turn ()
 runauto = do
-	Turn $ \game -> return (game { automode = True }, Right ())
+	modifyGame $ \game -> game { automode = True }
 	forM_ [0..255] $ \slot -> do
 		(_, (val, vit)) <- readSlot proponent slot
 		when (vit == -1) $ do
-			try (reset >> tryApply val (card Card_I)) (\s -> liftIO $ putStrLn $ "Error for zombie " ++ (show slot) ++ ": " ++ s)
+			try (reset >> tryApply val (card Card_I)) (\s -> liftIO $ hPutStrLn stderr $ "Error for zombie " ++ (show slot) ++ ": " ++ s)
 			writeSlot proponent slot (card Card_I, 0)
-	Turn $ \game -> return (game { automode = False }, Right ())
-
-switchPlayer :: Turn ()
-switchPlayer = Turn $ \game -> return (game { proponent = opponent game, opponent = proponent game, gameturn = 1 + gameturn game }, Right ())
+	modifyGame $ \game -> game { automode = False }
 
 runMove :: Move -> Turn ()
 runMove m = do
-		(l, r, field) <- getmove m
 		runauto
-		try (reset >> tryApply l r >>= writeValue proponent field) (\s -> writeValue proponent field (card Card_I) >> liftIO (putStrLn $ "Error: " ++ s))
-		Turn $ \game -> putStrLn (show game) >> return (game, Right ())
+		try (do
+				(l, r, field) <- getmove m
+				reset
+				try (tryApply l r >>= writeValue proponent field) (\s -> do
+					writeValue proponent field (card Card_I)
+					liftIO (hPutStrLn stderr $ "Error: " ++ s))
+					) (\s -> liftIO (hPutStrLn stderr $ "Fatal Error in '" ++ show m ++ "': " ++ s))
+		getGame >>= \game -> liftIO $ hPutStrLn stderr (show game)
 		switchPlayer
 	where
 		getmove :: Move -> Turn (Value, Value, Int)
@@ -234,22 +253,24 @@ initFields :: IO Fields
 initFields = A.newArray (0, 255) (card Card_I, 10000)
 initPlayer :: IO Player
 initPlayer = initFields >>= return . Player
+initAIState = return AIState
 initGame :: IO Game
 initGame = do
 	p0 <- initPlayer
 	p1 <- initPlayer
-	return $ Game p0 p1 0 False 0
+	ai <- initAIState
+	return $ Game p0 p1 0 False 0 ai
 
 
 runTurn :: Turn () -> Game -> IO Game
 runTurn turn game = runTurn' turn game >>= \res -> case res of
-	(game', Left s) -> (putStrLn $ "Error in turn: " ++ s) >> return game
+	(game', Left s) -> (hPutStrLn stderr $ "Error in turn: " ++ s) >> return game
 	(game', Right _) -> return game
-run :: [Move] -> Game -> IO Game
-run moves game = foldM (flip runTurn) game $ map runMove moves
+runMoves :: [Move] -> Game -> IO Game
+runMoves moves game = foldM (flip runTurn) game $ map runMove moves
 
 testMoves :: [Move] -> IO Game
-testMoves moves = initGame >>= run moves
+testMoves moves = initGame >>= runMoves moves
 
 testMoves1 :: [Move] -> IO Game
 testMoves1 moves = initGame >>= \game -> foldM (\g t -> runTurn (t >> switchPlayer) g) game $ map runMove moves
diff --git a/GoalTransform.hs b/GoalTransform.hs
new file mode 100644
index 0000000..4819608
--- /dev/null
+++ b/GoalTransform.hs
@@ -0,0 +1,87 @@
+
+module GoalTransform (
+	Goal (..),
+	moveGoal,
+	evalMoves,
+	subgoals,
+) where
+
+import Eval
+import Lambda
+
+import System.IO
+import qualified Data.Array.IO as A
+
+type Goal = (Maybe Int, Term)
+
+type Goals = [(Int, Term)]
+
+applyMove :: Term -> Move -> Term
+applyMove t (MoveLeft Card_Zero _) = Prim Card_I
+applyMove t (MoveLeft Card_I _) = t
+applyMove (Const n) (MoveLeft Card_Succ _) = Const (n+1)
+applyMove (Const n) (MoveLeft Card_Dbl _) = Const (n*2)
+applyMove (Prim Card_I) (MoveRight _ Card_Zero) = Const 0
+applyMove (Prim Card_I) (MoveRight _ c) = Prim c
+applyMove (Prim Card_Succ) (MoveRight _ Card_Zero) = Const 1
+applyMove (Prim Card_Dbl) (MoveRight _ Card_Zero) = Const 0
+applyMove t (MoveLeft c _) = Apply (Prim c) t
+applyMove t (MoveRight _ c) = Apply t (Prim c)
+
+evalMoves :: Goals -> Int -> Maybe Term -> [Move] -> [(Goals, Move)]
+evalMoves current pos = _eval where
+	_eval _ [] = []
+	_eval Nothing moves = ((pos, Prim Card_I):current, MoveLeft Card_Zero pos):_eval (Just $ Prim Card_I) moves
+	_eval (Just t) (m:xm) = let t' = (applyMove t m) in ((pos, t'):current, m):_eval (Just t') xm
+
+copyTo :: Goals -> Int -> Int -> [(Goals, Move)]
+copyTo current src dst = if (src == dst) then [] else evalMoves current dst Nothing (storeInt dst src ++ [MoveLeft Card_Get dst])
+
+_subgoals current pos (Const n) = evalMoves current pos Nothing (storeInt pos n)
+_subgoals current pos (Apply (Prim c) t) = let m = MoveLeft c pos in _subgoals current pos t ++ [((pos, applyMove t m):current, m)]
+_subgoals current pos (Apply (Const 0) t) = let m = MoveLeft Card_Zero pos in _subgoals current pos t ++ [((pos, applyMove t m):current, m)]
+_subgoals current pos (Apply t (Prim c)) = let m = MoveRight pos c in _subgoals current pos t ++ [((pos, applyMove t m):current, m)]
+_subgoals current pos (Apply t (Const 0)) = let m = MoveRight pos Card_Zero in _subgoals current pos t ++ [((pos, applyMove t m):current, m)]
+_subgoals current pos (Prim c) = evalMoves current pos Nothing [MoveRight pos c]
+_subgoals current 0 (Apply a b) = _subgoals current 1 (Apply a b) ++ copyTo ((1, Apply a b):current) 1 0
+_subgoals current pos (Apply a b) = _subgoals current pos a ++ _subgoals ((pos,a):current) (pos+1) b ++ copyTo ((pos,a):(pos+1, b):current) (pos+1) 0 ++ evalMoves ((0, b):current) pos (Just a) [MoveLeft Card_K pos, MoveLeft Card_S pos, MoveRight pos Card_Get, MoveRight pos Card_Zero]
+
+subgoals pos t = reverse $ _subgoals [] pos t
+
+termEqVal :: Term -> Value -> Bool
+termEqVal (Const a) (ValInt b) = (a == b)
+termEqVal (Prim Card_Zero) (ValInt 0) = True
+termEqVal t (ValFunction s _) = (show t) == s
+termEqVal _ _ = False
+
+satGoal :: (Int, Term) -> Turn Bool
+satGoal (pos, t) = do
+	game <- getGame
+	(val, vit) <- liftIO $ A.readArray (fields $ proponent game) pos
+	return (vit > 0 && termEqVal t val)
+
+satGoals :: Goals -> Turn Bool
+satGoals [] = return True
+satGoals (g:xg) = satGoal g >>= \r -> if (r) then satGoals xg else return False
+
+_pickMove :: [(Goals, Move)] -> Turn (Maybe Move)
+_pickMove [] = return Nothing
+_pickMove ((g,m):xs) = do
+	found <- satGoals g
+	if (found) then return Nothing else do
+		r <- _pickMove xs
+		case r of Nothing -> return $ Just m; _ -> return r
+
+pickMove :: [(Goals, Move)] -> Turn (Move, Bool)
+pickMove l@((_,m):_) = do
+	r <- _pickMove l
+	case r of Nothing -> return (m, True); Just m -> return (m, False)
+
+moveGoal :: Goal -> Turn Move
+moveGoal (Nothing, t) = moveGoal (Just 0, t)
+moveGoal (Just pos, t) = do
+	let subs = subgoals pos t
+	(move, finished) <- pickMove subs
+	liftIO $ hPutStrLn stderr $ "Trying to reach Goal " ++ show (pos, t)
+	liftIO $ hPutStrLn stderr $ "Next step: " ++ show move
+	return move
diff --git a/Lambda.hs b/Lambda.hs
index 99abf9c..380d137 100644
--- a/Lambda.hs
+++ b/Lambda.hs
@@ -1,17 +1,21 @@
 {-# OPTIONS -XTypeSynonymInstances #-}
 
-module Lambda where
+module Lambda (
+	Term (..),
+	store, storeInt,
+	command, callresult, loop,
+	printMove
+) where
 
 import Eval
-import System.IO
 
+import System.IO
 import Text.ParserCombinators.ReadP
 import Data.Char
 import Control.Monad
 
 data Term = Const Int | Prim Card | Seq Term Term | Apply Term Term
 
-
 ptConst :: ReadP Term
 ptConst = readS_to_P reads >>= return . Const
 ptPrim = do
@@ -38,8 +42,8 @@ instance Show Term where
 	show (Const i) = show i
 	show (Prim c) = show c
 	show (Seq f g) = show f ++ ";" ++ show g
-	show (Apply f (Const i)) = show f ++ " " ++ show i
-	show (Apply f (Prim c)) = show f ++ " " ++ show c
+{-	show (Apply f (Const i)) = show f ++ " " ++ show i
+	show (Apply f (Prim c)) = show f ++ " " ++ show c-}
 	show (Apply f x) = show f ++ "(" ++ show x ++ ")"
 
 instance Read Term where
diff --git a/dummy b/dummy
new file mode 100755
index 0000000..6bb2146
--- /dev/null
+++ b/dummy
@@ -0,0 +1,18 @@
+#!/bin/sh
+
+opp() {
+  read lr
+  case $lr in
+    1) read card; read slot;;
+    2) read slot; read card;;
+  esac
+}
+if [ $1 = "1" ]; then
+  opp
+fi
+while [ true ]; do
+  echo "1"
+  echo "I"
+  echo "0"
+  opp
+done
diff --git a/run b/run
index f69036d..ec22638 100755
--- a/run
+++ b/run
@@ -1,4 +1,4 @@
 #!/bin/sh
 
 cd $(dirname $(readlink -f $0))
-exec runghc Lambda.hs
+exec runghc Client.hs "$@"