jutememo

foldr3 _     z []      k = k z
foldr3 f_cps z (x:xs ) k = f_cps x (foldr3 f_cps z xs k) $ \y -> k y

main = do print $ foldr3 (\x y k -> k $ x + y) 0 [1..3] id 
          print $ foldr3 (\x y k -> k $ x + y) 0 [1..3] (* 2)

jutememo

foldr2'cps _ z []     p k _ = k z
foldr2'cps f z (x:xs) p k k' 
    | p x       = k' x
    | otherwise = foldr2'cps f z xs p (\y -> k $ f x y) k'

main = do print $ foldr2'cps (++) [] [[1,2],[3,4],[5,6]] 
                    (== []) id id
          print $ foldr2'cps (++) [] [[1,2],[3,4],[],[5,6]] 
                    (== []) id id
          print $ foldr2'cps (+) 0 [1..10] (== 0) id id

jutememo

foldr2' _ z []     k = k z
foldr2' f z (x:xs) k = foldr2' f z xs $ \y -> 
                       if x == [] then [] else k $ f x y 
 
main = do print $ foldr2' (++) [] [[1,2],[3,4],[5,6]] id
          print $ foldr2' (++) [] [[1,2],[3,4],[],[5,6]] id

jutememo

foldr2 _ z []     k = k z
foldr2 f z (x:xs) k = foldr2 f z xs $ \y -> k $ f x y 

main = do print $ foldr2 (+) 0 [1..10] id 
          print $ foldr2 (+) 0 [1..10] (* 2)  
          print $ foldr2 (++) [] [[1,2],[3,4],[],[5,6]] id

jutememo

concat'cps []       k = k []
concat'cps ([]:_)   k = []
concat'cps (xs:xss) k = concat'cps xss $ \xss' -> k $ xs ++ xss' 

main = print $ concat'cps [[1,2],[3,4],[],[5,6]] id

jutememo

data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving Show

t = Branch 
    (Branch 
     (Leaf 1) 
     (Leaf 2))
    (Branch
     (Leaf 3)
     (Branch 
      (Leaf 4)

jutememo

import Control.Monad.State

update :: Int -> a -> State [a] ()
update i x = modify $ \xs -> take i xs ++ x : drop (i+1) xs

swapS i j = do xs <- get
               update i (xs!!j)
               update j (xs!!i)

swap i j xs = (execState $ swapS i j) xs

jutememo

import Control.Monad.State

type Ary a = [a]
type Temp a = a

type Vars a = (Ary a, Temp a)

toTemp :: Int -> State (Vars a) ()
toTemp i = modify $ \(xs, tmp) -> (xs, xs!!i)

jutememo

swap 0 j (x:xs) = idxAt (j-1) xs : set x (j-1) xs
    where
      idxAt 0 (x:_) = x
      idxAt j (_:xs) = idxAt (j-1) xs

      set x 0 (_:ys) = x:ys
      set x j (y:ys) = y:set x (j-1) ys

swap i j (x:xs) = x : swap (i-1) (j-1) xs

jutememo

swap i j xs = swap' withIdx
    where
      withIdx = zip [0..] xs
      
      swap' = map f
          where
            f (idx, x) | idx == i  = xs !! j
                       | idx == j  = xs !! i
                       | otherwise = x