{-# LANGUAGE FlexibleInstances #-}

module AufgabeFFP6
where

import Data.Array

type F = Array Int Int
type Op = Int -> Int -> Int
type G = Array Int (Op)
type W = Int

--------------------------------------------------------------------------------

(./.) :: Int -> Int -> Int
(./.) = div

myfoldl :: [(a -> b -> a)] -> a -> [b] -> a
myfoldl _ f1 [] = f1
myfoldl (g:gs) f1 (f2:fs)  = myfoldl gs (g f1 f2) fs

myfoldl' :: [(a -> a -> a)] -> [a] -> a
myfoldl' g (f:fs) = myfoldl g f fs

eval :: F -> G -> W
eval f g = myfoldl' (elems g) (elems f)

--------------------------------------------------------------------------------

yield :: F -> W -> [G]
yield = yield_bt
-- yield = yield_gtf

--------------------------------------------------------------------------------

type Node = ([Int], [Int], W, [Op])

goal_yield_bt :: Node -> Bool
goal_yield_bt (f, f', w, g)
  | length g == 0  = False -- no operators
  | length f' == 0 = eval (listArray (1, length f) f) (listArray (1, length g) g) == w
  | otherwise      = False

succ_yield_bt :: Node -> [Node]
succ_yield_bt (_, [], _, _) = []
succ_yield_bt (f, f', w, g) = [(f_new, f'_new, w, g ++ [g_new]) | g_new <- ops]
  where
    f_new  = f ++ [head f']
    f'_new = tail f'
    ops    = [(+), (-), (*), (./.)]

data Stack a = EmptyStk
               | Stk a (Stack a)

push :: a -> Stack a -> Stack a
push x s = Stk x s

pop :: Stack a -> Stack a
pop EmptyStk = error "pop from an empty stack"
pop (Stk _ s) = s

top :: Stack a -> a
top EmptyStk = error "top from an empty stack"
top (Stk x _) = x

emptyStack :: Stack a
emptyStack = EmptyStk

stackEmpty :: Stack a -> Bool
stackEmpty EmptyStk = True
stackEmpty _  = False

searchDfs :: (node -> [node]) -> (node -> Bool) -> node -> [node]
searchDfs succ goal x = search' (push x emptyStack)
  where
    search' s
      | stackEmpty s = []
      | goal (top s) = top s : search' (pop s)
      | otherwise =
        let x = top s
        in search' (foldr push (pop s) (succ x))

yield_bt :: F -> W -> [G]
yield_bt f w = map (\(_, _, _, g) -> listArray (1, length g) g) nodes
  where
    f_elem1 = head (elems f)
    f_tail  = tail (elems f)
    nodes   = searchDfs succ_yield_bt goal_yield_bt ([f_elem1], f_tail, w, [])

--------------------------------------------------------------------------------

-- yield_gtf :: Array Int Int -> Int -> [Array Int (Int -> Int -> Int)]

--------------------------------------------------------------------------------

instance Show (Integer -> Integer -> Integer) where
  show op = case (3 `op` 3) of
    6 ->  "plus"
    0 ->  "minus"
    9 ->  "times"
    1 ->  "div"
    _ ->  "unknown"

instance Show (Int -> Int -> Int) where
  show op = case (3 `op` 3) of
    6 ->  "plus"
    0 ->  "minus"
    9 ->  "times"
    1 ->  "div"
    _ ->  "unknown"