Towers of hanoi

data Poles = PLeft | PMiddle | PRight
data Disk  = Disk Int

instance AsmTerm Disk
instance AsmTerm [Disk]
instance AsmTerm Poles

number :: Int
number = 12

call :: Dynamic Int
call = initVal "call" 1

decrDisk :: Disk -> Disk
decrDisk (Disk i) = Disk (i-1)

goal :: Dynamic (Int -> Disk)
goal = initAssocs "goal" [(1,Disk number)]

fromPole :: Dynamic (Int -> Poles)
fromPole = initAssocs "fromPole" [(1,PLeft)]

toPole :: Dynamic (Int -> Poles)
toPole = initAssocs "toPole" [(1,PRight)]

auxPole :: Dynamic (Int -> Poles)
auxPole = initAssocs "auxPole" [(1,PMiddle)]

stack :: Dynamic (Poles -> [Disk])
stack = initAssocs "stack" [ (PLeft,map Disk [1..number])
                           , (PMiddle,[])
                           , (PRight,[])
                           ]

hanoi :: Rule ()
hanoi = do
  if call `inDom` goal
   then if goal call == Disk 0
        then call := call - 1
        else if goal call /= head (stack (fromPole call))
             then do
               call                  := call + 1
               goal (call + 1)       := decrDisk (goal call)
               fromPole (call + 1)   := fromPole call
               toPole (call + 1)     := auxPole call
               auxPole (call + 1)    := toPole call
             else do
               stack (fromPole call) := tail (stack (fromPole call))
               stack (toPole call)   := goal call : stack (toPole call)
               goal call             := decrDisk (goal call)
               fromPole call         := auxPole call
               auxPole call          := fromPole call
   else skip