Jun25.hs

-- |
module Main where
import Control.Monad.State

data Closure i o = R (i -> (o, Closure i o))
data Mark = X | O deriving (Show, Read, Ord)

instance Eq Mark where
  X == X = True
  O == O = True
  _ == _ = False

inc :: Closure () Int
inc = go 0 where
  go n = R $ \_ -> (n, go (n +1))

q :: i -> Closure i o -> (o, Closure i o)
q i (R f) = f i

data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show)
type Table a = [a]

numTree :: Eq a => Tree a -> State (Table a) (Tree Int)
numTree Nil = return Nil
numTree (Node x t v)
  = do
      num <- numberNode x
      t'  <- numTree t
      v'  <- numTree v
      return (Node num t' v')

    where
      numberNode :: Eq a => a -> State (Table a) (Int)
      numberNode x =
        do
          table <- get
          (newTable, x') <- return (nNode x table)
          put newTable
          return x'

      nNode :: Eq a => a -> Table a -> (Table a, Int)
      nNode x table =
        case findInTable ( == x) table
        of
         Nothing -> (table ++ [x], length table)
         Just i  -> (table, i)

      findInTable :: (a -> Bool) -> Table a -> Maybe Int
      findInTable
        = findInTableHelper inc
        where
          findInTableHelper _ _ [] = Nothing
          findInTableHelper incr f (t:ts)
            =
            if (f t) then Just count
            else findInTableHelper c' f ts
            where
              (count,c') = q () incr


nTree :: Eq a => Tree a -> Tree Int
nTree tree = evalState (numTree tree) []

append :: [a] -> a -> [a]
append
  = (. return) . (++)

tTree :: Tree Mark
tTree = Node X (Node O Nil Nil) (Node O Nil (Node X Nil Nil))