From 820ed868dfa4dd87c878ccf4c29c3ac60fd74e90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20B=C3=BChler?= Date: Sat, 18 Jun 2011 20:51:09 +0200 Subject: [PATCH] next --- AI.hs | 10 +++++++++- GoalTransform.hs | 8 ++++---- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/AI.hs b/AI.hs index 3cfdbf5..0265203 100644 --- a/AI.hs +++ b/AI.hs @@ -6,5 +6,13 @@ import Eval import Lambda import GoalTransform +cannon 1 = "dec" +cannon 2 = "S dec dec" +cannon n = "S(" ++ cannon (n-1) ++ ") dec" + +keepalive func 0 = "S(" ++ func ++ ")(get)0" +keepalive func 1 = "S(K(S(" ++ func ++ ")(get)))(succ)0" +keepalive func slot = "S(" ++ func ++ ")(S (K get) (K " ++ show slot ++ "))0" + aimove :: Turn Goal -aimove = return (Just 0, read "S dec (S get I)") +aimove = return (Just 1, read $ keepalive (cannon 200) 1) diff --git a/GoalTransform.hs b/GoalTransform.hs index 4819608..f91ebab 100644 --- a/GoalTransform.hs +++ b/GoalTransform.hs @@ -34,8 +34,8 @@ evalMoves current pos = _eval where _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]) +copyTo :: Goals -> Int -> Int -> Term -> [(Goals, Move)] +copyTo current src dst t = if (src == dst) then [] else evalMoves current dst Nothing (storeInt dst src) ++ [((dst, t):current,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)] @@ -43,8 +43,8 @@ _subgoals current pos (Apply (Const 0) t) = let m = MoveLeft Card_Zero pos in _s _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 current 0 (Apply a b) = _subgoals current 1 (Apply a b) ++ copyTo ((1, Apply a b):current) 1 0 (Apply a b) +_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 b ++ 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