{-
  Purpose:
    create a function, if_recur, like the f in section 12.5 of:
      [BAC77]
         http://www.thocp.net/biographies/papers/backus_turingaward_lecture.pdf
-}

module IfRecur where

-- {*if_recur
  if_recur :: state_down
           -> (state_down -> Bool) 
           -> (state_down -> state_down)
           -> (state_down -> state_saved)
           -> ((state_saved,state_up) -> state_up) 
           -> (state_down -> state_up)
           -> state_up
  
  if_recur state_now  -- current state
           recur_     -- continue recursion?
           then_down  -- ::state_down -> state_down
           save_state -- ::state_down -> state_saved
           now_up     -- ::((state_saved,state_up)->state_up
           else_      -- ::state_down -> state_up
           {- The following table shows the corresponndence
              between the f in section 12.5 of [BAC77]
              and the arguments to this function:

                  [BAC77]       [if_recur]
                  =======       ==========
                    p           recur_
                    g           else_
                    j           then_down
                    i           save_state
                    h           now_up
           -}
           = if recur_ state_now
             then now_up
                  ( save_state state_now
                  , if_recur (then_down state_now)
                             recur_
                             then_down
                             save_state
                             now_up
                             else_
                  )
             else else_ state_now

-- }*if_recur

{--}
  palindrome :: [a] -> [a]

  palindrome x = if_recur 
                   (x,[]) --state_now
                   (not.null.fst) --recur_
                   (\(sn,cd) -> (tail sn,(head sn):cd)) --then_down
                   (\(sn,cd) -> head sn) --save_state
                   (\(ss,cu) -> ss:cu) --now_up
                   (\(sn,cd) -> cd) --else_

  if_recur_foldl :: [a] -> [a]

  if_recur_foldl x = if_recur 
                   (x,[]) --state_now
                   (not.null.fst) --recur_
                   (\(sn,cd) -> (tail sn,(head sn):cd)) --then_down
                   (\(sn,cd) -> ()) --save_state
                   (\(ss,cu) -> cu) --now_up
                   (\(sn,cd) -> cd) --else_

  if_recur_foldr :: [a] -> [a]

  if_recur_foldr x = if_recur 
                   (x,[]) --state_now
                   (not.null.fst) --recur_
                   (\(sn,cd) -> (tail sn,cd)) --then_down
                   (\(sn,cd) -> head sn) --save_state
                   (\(ss,cu) -> ss:cu) --now_up
                   (\(sn,cd) -> cd) --else_

  test = sequence
         [ print "palindrome [1,2,3]:"
         , print (palindrome [1,2,3])
         , print "if_recur_foldl [1,2,3]:"
         , print (if_recur_foldl [1,2,3])
         , print "(foldl (flip(:)) [] [1,2,3]):"
         , print (foldl (flip(:)) [] [1,2,3])
         , print "if_recur_foldr [1,2,3]:"
         , print (if_recur_foldr [1,2,3])
         , print "(foldr (:) [] [1,2,3]):"
         , print (foldr (:) [] [1,2,3])
         ]
{--}