{-
  Purpose:
    Compare outputs from the foldl'r function from:
      [THI10]
        http://code.haskell.org/~thielema/utility/src/Data/List/HT/Private.hs
    based on the method used to implement foldl in terms of foldr as described
    on page 13 of:
      [HUT99]
        http://www.cs.nott.ac.uk/~gmh/fold.pdf
    and another function, if_recur_foldlr, using a function, if_recur, modelled 
    after f in section 12.5 of:
      [BAC77]
         http://www.thocp.net/biographies/papers/backus_turingaward_lecture.pdf
-}
module HutBacFoldlr where

import Assoc
import Data.Graph.Inductive.Query.Monad(mapFst) --renamed from [THI10] 

-- {*foldl'r from [THI10]
foldl'r
  :: (b -> a -> b) -> b -- foldl function, start value
  -> (c -> d -> d) -> d -- foldr function, start value
  -> [(a,c)] 
  -> (b,d)

foldl'r 
  fl b0 
  fr d0 
  = mapFst ($b0) .
    foldr 
      (\(a,c) ~(k,d) -> (\b -> k $! fl b a, fr c d)) 
      (id,d0)

-- }*foldl'r from [THI10]

test_inp = [(1,'a'),(2,'b'),(3,'c')]

foldl'r_out = foldl'r AsLeft AsNull AsRight AsNull test_inp

foldl'r_foldr = foldr (\(a,c) ~(k,d) -> (\b -> k $! AsLeft b a, AsRight c d)) (id,AsNull) test_inp

foldl'r_fst = (fst foldl'r_foldr) AsNull
foldl'r_snd = snd foldl'r_foldr

-- {*if_recur from [BAC77]

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_     -- ::state_down -> Bool (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 from [BAC77]

if_recur_foldlr
  :: (b -> a -> b) -> b --foldl function, start value
  -> (c -> d -> d) -> d --foldr function, start value
  -> [(a,c)]
  -> (b,d)

if_recur_foldlr
  fl b0
  fr d0
  ac_pairs
  = if_recur
      (ac_pairs,(b0,d0))  --state_now
      (not.null.fst) --recur_
      (\((a0,c0):ac_pairs,(bn,dn)) -> (ac_pairs,(fl bn a0,d0))) --then_down
      (\((a0,c0):ac_pairs,(bn,dn)) -> c0) --save_state
      (\(c0,(bn,dn)) -> (bn,fr c0 dn))--now_up
      (\(ac_pairs,(bn,dn)) -> (bn,dn)) --else_

if_recur_out = if_recur_foldlr AsLeft AsNull AsRight AsNull test_inp

test = sequence_
       [ putStrLn "***test_inp:"
       , print test_inp
       , putStrLn "***foldl'r AsLeft AsNull AsRight AsNull test_inp:"
       , print foldl'r_out
       , putStrLn "***if_recur_foldlr AsLeft AsNull AsRight AsNull test_inp:"
       , print if_recur_out
       , putStrLn "---foldl'r_fst:"
       , print foldl'r_fst
       , putStrLn "---foldl'r_snd:"
       , print foldl'r_snd
       ]