TABA convolution Danvy / GoldBerg

TABA.hs

#!/usr/bin/env stack
-- stack --resolver lts-17.10 script

(.>) :: (a -> b) -> (b -> c) -> (a -> c)
f .> g = g . f

-- Convolution from "There and back again" Danvy GoldBerg --  https://www.brics.dk/RS/01/39/BRICS-RS-01-39.pdf

convWalk xs ys = walk xs (\_ b -> b)
  where
    walk (x : xs) k = walk xs (\(y : ys) -> ((x, y) :) .> k ys)
    walk [] k = k ys []

-- >>> convWalk [1,2,3,4] [1,2,3,4]
-- [(1,4),(2,3),(3,2),(4,1)]

-- .. walk is
foldL c z (x : xs) = foldL c (c z x) xs
foldL c z [] = z

convFoldL :: [a] -> [b] -> [(a, b)]
convFoldL xs ys = foldL walkAlg1 walkAlg0 xs ys []
  where
    walkAlg1 k {-suite d'en haut-} x = \(y : ys {- phase suivante d'en bas -}) -> ((x, y) :) .> k ys
    walkAlg0 _ rs = rs

-- >>> convFoldL [1,2,3,4] [1,2,3,4]
-- [(1,4),(2,3),(3,2),(4,1)]

main :: IO ()
main = print $ convFoldL [1, 2, 3, 4] [1, 2, 3, 4]