I am trying to write a function that performs capture-avoiding substitution in Lambda calculus. The code compiles but does not spit out the correct answer. I've written what I expect the code to do, is my comprehension correct?
For example, I should get the following output for this input (numeral 0 is the Church numeral 0)
*Main> substitute "b" (numeral 0) example -- \a. \x. ((\y. a) x) b
\c. \a. (\a. c) a (\f. \x. x)
-- The incorrect result I actually got
\c. \c. (\f. \x. x) (x (\b. a))
NB \y is renamed to \a due to the substitution (\y.a)[N/b] (I think I have this covered in the code I have written, but please let me know if I am wrong.)
import Data.Char
import Data.List
type Var = String
data Term =
Variable Var
| Lambda Var Term
| Apply Term Term
-- deriving Show
instance Show Term where
show = pretty
example :: Term -- \a. \x. ((\y. a) x) b
example = Lambda "a"
(Lambda "x" (Apply (Apply (Lambda "y" (Variable "a"))
(Variable "x"))
(Variable "b")))
pretty :: Term -> String
pretty = f 0
where
f i (Variable x) = x
f i (Lambda x m) = if i /= 0 then "(" ++ s ++ ")" else s
where s = "\\" ++ x ++ ". " ++ f 0 m
f i (Apply n m) = if i == 2 then "(" ++ s ++ ")" else s
where s = f 1 n ++ " " ++ f 2 m
substitute :: Var -> Term -> Term -> Term
substitute x n (Variable y)
--if y = x, then leave n alone
| y == x = n
-- otherwise change to y
| otherwise = Variable y
substitute x n (Lambda y m)
--(\y.M)[N/x] = \y.M if y = x
| y == x = Lambda y m
--otherwise \z.(M[z/y][N/x]), where `z` is a fresh variable name
--generated by the `fresh` function, `z` must not be used in M or N,
--and `z` cannot be equal `x`. The `used` function checks if a
--variable name has been used in `Lambda y m`
| otherwise = Lambda newZ newM
where newZ = fresh(used(Lambda y m))
newM = substitute x n m
substitute x n (Apply m2 m1) = Apply newM2 newM1
where newM1 = substitute x n m2
newM2 = substitute x n m1
used :: Term -> [Var]
used (Variable n) = [n]
used (Lambda n t) = merge [n] (used t)
used (Apply t1 t2) = merge (used t1) (used t2)
variables :: [Var]
variables = [l:[] | l <- ['a'..'z']] ++
[l:show x | x <- [1..], l <- ['a'..'z']]
filterFreshVariables :: [Var] -> [Var] -> [Var]
filterFreshVariables lst = filter ( `notElem` lst)
fresh :: [Var] -> Var
fresh lst = head (filterFreshVariables lst variables)
recursiveNumeral :: Int -> Term
recursiveNumeral i
| i == 0 = Variable "x"
| i > 0 = Apply(Variable "f")(recursiveNumeral(i-1))
numeral :: Int -> Term
numeral i = Lambda "f" (Lambda "x" (recursiveNumeral i))
merge :: Ord a => [a] -> [a] -> [a]
merge (x : xs) (y : ys)
| x < y = x : merge xs (y : ys)
| otherwise = y : merge (x : xs) ys
merge xs [] = xs
merge [] ys = ys
This part in substitute x n (Lambda y m) is not correct:
the comment says "z must not be used in M or N", but there is nothing preventing that. newZ could be a variable in n, which leads to a problematic capture
the substitution z/y has not been done
| otherwise = Lambda newZ newM
where newZ = fresh(used(Lambda y m))
newM = substitute x n m
Fix:
"z must not be used in M or N":
newZ = fresh(used m `merge` used n)
"M[z/y][N/x]":
newM = substitute x n (substitute y (Variable newZ) m)
Put together:
| otherwise = Lambda newZ newM
where
newZ = fresh(used m `merge` used n)
newM = substitute x n (substitute y (Variable newZ) m)
Note that refreshing all bindings as done above makes it difficult to understand the result and to debug substitution. Actually y only needs to be refreshed if y is in n. Otherwise you can keep y, adding this clause:
| y `notElem` used n = Lambda y (substitute x n m)
Another idea would be to modify fresh to pick a name similar to the old one, e.g., by appending numbers until one doesn't clash.
There is still a bug I missed: newZ should also not be equal to x (the variable originally being substituted).
-- substitute [a -> \f. \x. x] in (\g. g), should be (\g. g)
ghci> substitute "a" (numeral 0) (Lambda "g" (Variable "g"))
\a. \g. \x. x
Two ways to address this:
add x to the set of variables to exclude newZ from:
newZ = fresh ([x] `merge` used m `merge` used n)
if you think about it, this bug only manifests itself when x is not in m, in which case there is nothing to substitute, so another way is to add one more branch skipping the work:
| x `notElem` used m = Lambda y m
Put together:
substitute x n (Lambda y m)
--(\y.M)[N/x] = \y.M if y = x
| y == x = Lambda y m
| x `notElem` used m = Lambda y m
| y `notElem` used n = Lambda y (substitute x n m)
| otherwise = Lambda newZ newM
where newZ = fresh(used m `merge` used n)
newM = substitute x n (substitute y (Variable newZ) m)
Output
ghci> example
\a. \x. (\y. a) x b
ghci> numeral 0
\f. \x. x
ghci> substitute "b" (numeral 0) example
\a. \c. (\y. a) c (\f. \x. x)
Note: I haven't tried to prove this code correct (exercise for the reader: define "correct"), there may still be bugs I missed. There must be some course about lambda calculus that has all the details and pitfalls but I haven't bothered to look.
My Haskell project includes an expression evaluator, which for the purposes of this question can be simplified to:
data Expression a where
I :: Int -> Expression Int
B :: Bool -> Expression Bool
Add :: Expression Int -> Expression Int -> Expression Int
Mul :: Expression Int -> Expression Int -> Expression Int
Eq :: Expression Int -> Expression Int -> Expression Bool
And :: Expression Bool -> Expression Bool -> Expression Bool
Or :: Expression Bool -> Expression Bool -> Expression Bool
If :: Expression Bool -> Expression a -> Expression a -> Expression a
-- Reduces an Expression down to the simplest representation.
reduce :: Expression a -> Expression a
-- ... implementation ...
The straightforward approach to implementing this is to write a case expression to recursively evaluate and pattern match, like so:
reduce (Add x y) = case (reduce x, reduce y) of
(I x', I y') -> I $ x' + y'
(x', y') -> Add x' y'
reduce (Mul x y) = case (reduce x, reduce y) of
(I x', I y') -> I $ x' * y'
(x', y') -> Mul x' y'
reduce (And x y) = case (reduce x, reduce y) of
(B x', B y') -> B $ x' && y'
(x', y') -> And x' y'
-- ... and similarly for other cases.
To me, that definition looks somewhat awkward, so I then rewrote the definition using pattern guards, like so:
reduce (Add x y) | I x' <- reduce x
, I y' <- reduce y
= I $ x' + y'
I think this definition looks cleaner compared to the case expression, but when defining multiple patterns for different constructors, the pattern is repeated multiple times.
reduce (Add x y) | I x' <- reduce x
, I y' <- reduce y
= I $ x' + y'
reduce (Mul x y) | I x' <- reduce x
, I y' <- reduce y
= I $ x' * y'
Noting these repeated patterns, I was hoping there would be some syntax or structure that could cut down on the repetition in the pattern matching. Is there a generally accepted method to simplify these definitions?
Edit: after reviewing the pattern guards, I've realised they don't work as a drop-in replacement here. Although they provide the same result when x and y can be reduced to I _, they do not reduce any values when the pattern guards do not match. I would still like reduce to simplify subexpressions of Add et al.
One partial solution, which I've used in a similar situation, is to extract the logic into a "lifting" function that takes a normal Haskell operation and applies it to your language's values. This abstracts over the wrappping/unwrapping and resulting error handling.
The idea is to create two typeclasses for going to and from your custom type, with appropriate error handling. Then you can use these to create a liftOp function that could look like this:
liftOp :: (Extract a, Extract b, Pack c) => (a -> b -> c) ->
(Expression a -> Expression b -> Expression c)
liftOp err op a b = case res of
Nothing -> err a' b'
Just res -> pack res
where res = do a' <- extract $ reduce' a
b' <- extract $ reduce' b
return $ a' `op` b'
Then each specific case looks like this:
Mul x y -> liftOp Mul (*) x y
Which isn't too bad: it isn't overly redundant. It encompasses the information that matters: Mul gets mapped to *, and in the error case we just apply Mul again.
You would also need instances for packing and unpacking, but these are useful anyhow. One neat trick is that these can also let you embed functions in your DSL automatically, with an instance of the form (Extract a, Pack b) => Pack (a -> b).
I'm not sure this will work exactly for your example, but I hope it gives you a good starting point. You might want to wire additional error handling through the whole thing, but the good news is that most of that gets folded into the definition of pack, unpack and liftOp, so it's still pretty centralized.
I wrote up a similar solution for a related (but somewhat different) problem. It's also a way to handle going back and forth between native Haskell values and an interpreter, but the interpreter is structured differently. Some of the same ideas should still apply though!
This answer is inspired by rampion's follow-up question, which suggests the following function:
step :: Expression a -> Expression a
step x = case x of
Add (I x) (I y) -> I $ x + y
Mul (I x) (I y) -> I $ x * y
Eq (I x) (I y) -> B $ x == y
And (B x) (B y) -> B $ x && y
Or (B x) (B y) -> B $ x || y
If (B b) x y -> if b then x else y
z -> z
step looks at a single term, and reduces it if everything needed to reduce it is present. Equiped with step, we only need a way to replace a term everywhere in the expression tree. We can start by defining a way to apply a function inside every term.
{-# LANGUAGE RankNTypes #-}
emap :: (forall a. Expression a -> Expression a) -> Expression x -> Expression x
emap f x = case x of
I a -> I a
B a -> B a
Add x y -> Add (f x) (f y)
Mul x y -> Mul (f x) (f y)
Eq x y -> Eq (f x) (f y)
And x y -> And (f x) (f y)
Or x y -> Or (f x) (f y)
If x y z -> If (f x) (f y) (f z)
Now, we need to apply a function everywhere, both to the term and everywhere inside the term. There are two basic possibilities, we could apply the function to the term before applying it inside or we could apply the function afterwards.
premap :: (forall a. Expression a -> Expression a) -> Expression x -> Expression x
premap f = emap (premap f) . f
postmap :: (forall a. Expression a -> Expression a) -> Expression x -> Expression x
postmap f = f . emap (postmap f)
This gives us two possibilities for how to use step, which I will call shorten and reduce.
shorten = premap step
reduce = postmap step
These behave a little differently. shorten removes the innermost level of terms, replacing them with literals, shortening the height of the expression tree by one. reduce completely evaluates the expression tree to a literal. Here's the result of iterating each of these on the same input
"shorten"
If (And (B True) (Or (B False) (B True))) (Add (I 1) (Mul (I 2) (I 3))) (I 0)
If (And (B True) (B True)) (Add (I 1) (I 6)) (I 0)
If (B True) (I 7) (I 0)
I 7
"reduce"
If (And (B True) (Or (B False) (B True))) (Add (I 1) (Mul (I 2) (I 3))) (I 0)
I 7
Partial reduction
Your question implies that you sometimes expect that expressions can't be reduced completely. I'll extend your example to include something to demonstrate this case, by adding a variable, Var.
data Expression a where
Var :: Expression Int
...
We will need to add support for Var to emap:
emap f x = case x of
Var -> Var
...
bind will replace the variable, and evaluateFor performs a complete evaluation, traversing the expression only once.
bind :: Int -> Expression a -> Expression a
bind a x = case x of
Var -> I a
z -> z
evaluateFor :: Int -> Expression a -> Expression a
evaluateFor a = postmap (step . bind a)
Now reduce iterated on an example containing a variable produces the following output
"reduce"
If (And (B True) (Or (B False) (B True))) (Add (I 1) (Mul Var (I 3))) (I 0)
Add (I 1) (Mul Var (I 3))
If the output expression from the reduction is evaluated for a specific value of Var, we can reduce the expression all the way to a literal.
"evaluateFor 5"
Add (I 1) (Mul Var (I 3))
I 16
Applicative
emap can instead be written in terms of an Applicative Functor, and postmap can be made into a generic piece of code suitable for other data types than expressions. How to do so is described in this answer to rampion's follow-up question.
I was trying to solve the maximal subsequence sum problem and came up with a neato solution
msss :: (Ord a, Num a) => [a] -> a
msss = f 0 0
f gmax _ [] = gmax
f gmax lmax (x:xs) =
let g = max (lmax + x)
in f (g gmax) (g 0) xs
You call the wrapper function msss, which then calls f, which in turn actually does the work.
The solution is good and afaik working correctly. If for some reason I had to solve the maximal subsequence sum problem in production code, that is how I would do it.
However that wrapper function really bugs me. I love it how in haskell, if you are persistent enough you can write your entire program on a single line, to truly drive home the point that a program is pretty much just one big expression. So I figured I'd try and eliminate the wrapper function for the extra challenge.
It's now I run into the classic problem: How to do anonymous recursion? How do you do recursion when you can't give names to functions? Thankfully the fathers of computing solved this problem ages ago by discovering Fixed-Point Combinators, with the most popular being the Y Combinator.
I've made various attempts to get a Y combinator set up, but they can't get past the compiler.
msss' :: [Int] -> Int
msss' = (\y f x -> f (y y f) x)
(\y f x -> f (y y f) x)
(\g' gmax lmax list -> if list == []
then gmax
else g' (max gmax lmax + head list)
(max 0 lmax + head list)
tail list)
just gives
Prelude> :l C:\maxsubseq.hs
[1 of 1] Compiling Main ( C:\maxsubseq.hs, interpreted )
C:\maxsubseq.hs:10:29:
Occurs check: cannot construct the infinite type:
t0 = t0 -> (([Int] -> Int) -> [Int] -> Int) -> [Int] -> Int
In the first argument of `y', namely `y'
In the first argument of `f', namely `(y y f)'
In the expression: f (y y f) x
C:\maxsubseq.hs:11:29:
Occurs check: cannot construct the infinite type:
t0 = t0 -> (([Int] -> Int) -> [Int] -> Int) -> [Int] -> Int
In the first argument of `y', namely `y'
In the first argument of `f', namely `(y y f)'
In the expression: f (y y f) x
C:\maxsubseq.hs:12:14:
The lambda expression `\ g' gmax lmax list -> ...'
has four arguments,
but its type `([Int] -> Int) -> [Int] -> Int' has only two
In the second argument of `\ y f x -> f (y y f) x', namely
`(\ g' gmax lmax list
-> if list == [] then
gmax
else
g' (max gmax lmax + head list) (max 0 lmax + head list) tail list)'
In the expression:
(\ y f x -> f (y y f) x)
(\ y f x -> f (y y f) x)
(\ g' gmax lmax list
-> if list == [] then
gmax
else
g' (max gmax lmax + head list) (max 0 lmax + head list) tail list)
In an equation for `msss'':
msss'
= (\ y f x -> f (y y f) x)
(\ y f x -> f (y y f) x)
(\ g' gmax lmax list
-> if list == [] then
gmax
else
g' (max gmax lmax + head list) (max 0 lmax + head list) tail list)
Failed, modules loaded: none.
Changing from f (y y f) to f (y f) just gives
C:\maxsubseq.hs:11:29:
Couldn't match expected type `[Int] -> Int'
with actual type `[Int]'
Expected type: (([Int] -> Int) -> t1 -> t0) -> t2 -> t0
Actual type: ([Int] -> Int) -> t1 -> t0
In the first argument of `y', namely `f'
In the first argument of `f', namely `(y f)'
Failed, modules loaded: none.
I've tried taking a different approach by just defining the combinator externally, however this still isn't working and doesn't really meet my challenge to do it in one expression.
y f = f (y f)
msss' :: [Int] -> Int
msss' = y (\g' gmax lmax list -> if list == []
then gmax
else g' (max gmax lmax + head list)
(max 0 lmax + head list)
tail list)
Can you spot what's wrong with what I'm doing? I'm at a loss. The complaining about constructing infinite types really ticks me off because I though Haskell was all about that sort of thing. It has infinite data structures, so why the problem with infinite types? I suspect it has something to do with that paradox which showed untyped lambda calculus is inconsistent. I'm not sure though. Would be good if someone could clarify.
Also, I'm under the impression that recursion can always be represented with the fold functions. Can anyone show me how I could do it by just using a fold? The requirement that the code be a single expression still stands though.
You cannot define the Y combinator like that in Haskell. As you noticed, that results in an infinite type. Fortunately, it is already available in Data.Function as fix, where it's defined using a let binding:
fix f = let x = f x in x
Because the Y combinator needs infinite types, you'll need workarounds like this one.
But I'd write your msss function as a one-liner like this:
msss = fst . foldr (\x (gmax, lmax) -> let g = max (lmax + x) in (g gmax, g 0)) (0, 0)
Well let's think about it for a minute. What type does this lambda expression have?
(\y f x -> f (y y f) x)
Well f is a function (a -> b) -> a -> b, and x is some value b. What does that make y? Well given what we just said about f,
(y y f) :: (a -> b)
Also, since we are applying this expression to itself, we know that y has the same type as the entire expression. This is the part where I get a little bit stumped.
So y is some magical higher-order function. And it takes two functions as input. So it's sort of like y :: f1 -> f2 -> f3. f2 has the form of f, and f3 has the result type mentioned above.
y :: f1 -> ((a -> b) -> a -> b) -> (a -> b)
The question is...what is f1? Well, it has to be the same as the type of y. Do you see how this is getting beyond the power of Haskell's type system? The type is defined in terms of itself.
f1 = f1 -> ((a -> b) -> a -> b) -> (a -> b)
If you want a self-contained "one-liner", then take hammar's suggestion instead:
msss' = (\f -> let x = f x in x)
(\g' gmax lmax list -> case list of
[] -> gmax
(x:xs) -> g' (max gmax lmax + x) (max 0 lmax + x) xs
) 0 0
Although imho if max is allowable, then fix from Data.Function should be allowable as well. Unless you are in some Prelude-only contest.
I'm currently on chapter 4 of Real World Haskell, and I'm trying to wrap my head around implementing foldl in terms of foldr.
(Here's their code:)
myFoldl :: (a -> b -> a) -> a -> [b] -> a
myFoldl f z xs = foldr step id xs z
where step x g a = g (f a x)
I thought I'd try to implement zip using the same technique, but I don't seem to be making any progress. Is it even possible?
zip2 xs ys = foldr step done xs ys
where done ys = []
step x zipsfn [] = []
step x zipsfn (y:ys) = (x, y) : (zipsfn ys)
How this works: (foldr step done xs) returns a function that consumes
ys; so we go down the xs list building up a nested composition of
functions that will each be applied to the corresponding part of ys.
How to come up with it: I started with the general idea (from similar
examples seen before), wrote
zip2 xs ys = foldr step done xs ys
then filled in each of the following lines in turn with what it had to
be to make the types and values come out right. It was easiest to
consider the simplest cases first before the harder ones.
The first line could be written more simply as
zip2 = foldr step done
as mattiast showed.
The answer had already been given here, but not an (illustrative) derivation. So even after all these years, perhaps it's worth adding it.
It is actually quite simple. First,
foldr f z xs
= foldr f z [x1,x2,x3,...,xn] = f x1 (foldr f z [x2,x3,...,xn])
= ... = f x1 (f x2 (f x3 (... (f xn z) ...)))
hence by eta-expansion,
foldr f z xs ys
= foldr f z [x1,x2,x3,...,xn] ys = f x1 (foldr f z [x2,x3,...,xn]) ys
= ... = f x1 (f x2 (f x3 (... (f xn z) ...))) ys
As is apparent here, if f is non-forcing in its 2nd argument, it gets to work first on x1 and ys, f x1r1ys where r1 =(f x2 (f x3 (... (f xn z) ...)))= foldr f z [x2,x3,...,xn].
So, using
f x1 r1 [] = []
f x1 r1 (y1:ys1) = (x1,y1) : r1 ys1
we arrange for passage of information left-to-right along the list, by calling r1 with the rest of the input list ys1, foldr f z [x2,x3,...,xn]ys1 = f x2r2ys1, as the next step. And that's that.
When ys is shorter than xs (or the same length), the [] case for f fires and the processing stops. But if ys is longer than xs then f's [] case won't fire and we'll get to the final f xnz(yn:ysn) application,
f xn z (yn:ysn) = (xn,yn) : z ysn
Since we've reached the end of xs, the zip processing must stop:
z _ = []
And this means the definition z = const [] should be used:
zip xs ys = foldr f (const []) xs ys
where
f x r [] = []
f x r (y:ys) = (x,y) : r ys
From the standpoint of f, r plays the role of a success continuation, which f calls when the processing is to continue, after having emitted the pair (x,y).
So r is "what is done with more ys when there are more xs", and z = const [], the nil-case in foldr, is "what is done with ys when there are no more xs". Or f can stop by itself, returning [] when ys is exhausted.
Notice how ys is used as a kind of accumulating value, which is passed from left to right along the list xs, from one invocation of f to the next ("accumulating" step being, here, stripping a head element from it).
Naturally this corresponds to the left fold, where an accumulating step is "applying the function", with z = id returning the final accumulated value when "there are no more xs":
foldl f a xs =~ foldr (\x r a-> r (f a x)) id xs a
Similarly, for finite lists,
foldr f a xs =~ foldl (\r x a-> r (f x a)) id xs a
And since the combining function gets to decide whether to continue or not, it is now possible to have left fold that can stop early:
foldlWhile t f a xs = foldr cons id xs a
where
cons x r a = if t x then r (f a x) else a
or a skipping left fold, foldlWhen t ..., with
cons x r a = if t x then r (f a x) else r a
etc.
I found a way using quite similar method to yours:
myzip = foldr step (const []) :: [a] -> [b] -> [(a,b)]
where step a f (b:bs) = (a,b):(f bs)
step a f [] = []
For the non-native Haskellers here, I've written a Scheme version of this algorithm to make it clearer what's actually happening:
> (define (zip lista listb)
((foldr (lambda (el func)
(lambda (a)
(if (empty? a)
empty
(cons (cons el (first a)) (func (rest a))))))
(lambda (a) empty)
lista) listb))
> (zip '(1 2 3 4) '(5 6 7 8))
(list (cons 1 5) (cons 2 6) (cons 3 7) (cons 4 8))
The foldr results in a function which, when applied to a list, will return the zip of the list folded over with the list given to the function. The Haskell hides the inner lambda because of lazy evaluation.
To break it down further:
Take zip on input: '(1 2 3)
The foldr func gets called with
el->3, func->(lambda (a) empty)
This expands to:
(lambda (a) (cons (cons el (first a)) (func (rest a))))
(lambda (a) (cons (cons 3 (first a)) ((lambda (a) empty) (rest a))))
If we were to return this now, we'd have a function which takes a list of one element
and returns the pair (3 element):
> (define f (lambda (a) (cons (cons 3 (first a)) ((lambda (a) empty) (rest a)))))
> (f (list 9))
(list (cons 3 9))
Continuing, foldr now calls func with
el->3, func->f ;using f for shorthand
(lambda (a) (cons (cons el (first a)) (func (rest a))))
(lambda (a) (cons (cons 2 (first a)) (f (rest a))))
This is a func which takes a list with two elements, now, and zips them with (list 2 3):
> (define g (lambda (a) (cons (cons 2 (first a)) (f (rest a)))))
> (g (list 9 1))
(list (cons 2 9) (cons 3 1))
What's happening?
(lambda (a) (cons (cons 2 (first a)) (f (rest a))))
a, in this case, is (list 9 1)
(cons (cons 2 (first (list 9 1))) (f (rest (list 9 1))))
(cons (cons 2 9) (f (list 1)))
And, as you recall, f zips its argument with 3.
And this continues etc...
The problem with all these solutions for zip is that they only fold over one list or the other, which can be a problem if both of them are "good producers", in the parlance of list fusion. What you actually need is a solution that folds over both lists. Fortunately, there is a paper about exactly that, called "Coroutining Folds with Hyperfunctions".
You need an auxiliary type, a hyperfunction, which is basically a function that takes another hyperfunction as its argument.
newtype H a b = H { invoke :: H b a -> b }
The hyperfunctions used here basically act like a "stack" of ordinary functions.
push :: (a -> b) -> H a b -> H a b
push f q = H $ \k -> f $ invoke k q
You also need a way to put two hyperfunctions together, end to end.
(.#.) :: H b c -> H a b -> H a c
f .#. g = H $ \k -> invoke f $ g .#. k
This is related to push by the law:
(push f x) .#. (push g y) = push (f . g) (x .#. y)
This turns out to be an associative operator, and this is the identity:
self :: H a a
self = H $ \k -> invoke k self
You also need something that disregards everything else on the "stack" and returns a specific value:
base :: b -> H a b
base b = H $ const b
And finally, you need a way to get a value out of a hyperfunction:
run :: H a a -> a
run q = invoke q self
run strings all of the pushed functions together, end to end, until it hits a base or loops infinitely.
So now you can fold both lists into hyperfunctions, using functions that pass information from one to the other, and assemble the final value.
zip xs ys = run $ foldr (\x h -> push (first x) h) (base []) xs .#. foldr (\y h -> push (second y) h) (base Nothing) ys where
first _ Nothing = []
first x (Just (y, xys)) = (x, y):xys
second y xys = Just (y, xys)
The reason why folding over both lists matters is because of something GHC does called list fusion, which is talked about in the GHC.Base module, but probably should be much more well-known. Being a good list producer and using build with foldr can prevent lots of useless production and immediate consumption of list elements, and can expose further optimizations.
I tried to understand this elegant solution myself, so I tried to derive the types and evaluation myself. So, we need to write a function:
zip xs ys = foldr step done xs ys
Here we need to derive step and done, whatever they are. Recall foldr's type, instantiated to lists:
foldr :: (a -> state -> state) -> state -> [a] -> state
However our foldr invocation must be instantiated to something like below, because we must accept not one, but two list arguments:
foldr :: (a -> ? -> ?) -> ? -> [a] -> [b] -> [(a,b)]
Because -> is right-associative, this is equivalent to:
foldr :: (a -> ? -> ?) -> ? -> [a] -> ([b] -> [(a,b)])
Our ([b] -> [(a,b)]) corresponds to state type variable in the original foldr type signature, therefore we must replace every occurrence of state with it:
foldr :: (a -> ([b] -> [(a,b)]) -> ([b] -> [(a,b)]))
-> ([b] -> [(a,b)])
-> [a]
-> ([b] -> [(a,b)])
This means that arguments that we pass to foldr must have the following types:
step :: a -> ([b] -> [(a,b)]) -> [b] -> [(a,b)]
done :: [b] -> [(a,b)]
xs :: [a]
ys :: [b]
Recall that foldr (+) 0 [1,2,3] expands to:
1 + (2 + (3 + 0))
Therefore if xs = [1,2,3] and ys = [4,5,6,7], our foldr invocation would expand to:
1 `step` (2 `step` (3 `step` done)) $ [4,5,6,7]
This means that our 1 `step` (2 `step` (3 `step` done)) construct must create a recursive function that would go through [4,5,6,7] and zip up the elements. (Keep in mind, that if one of the original lists is longer, the excess values are thrown away). IOW, our construct must have the type [b] -> [(a,b)].
3 `step` done is our base case, where done is an initial value, like 0 in foldr (+) 0 [1..3]. We don't want to zip anything after 3, because 3 is the final value of xs, so we must terminate the recursion. How do you terminate the recursion over list in the base case? You return empty list []. But recall done type signature:
done :: [b] -> [(a,b)]
Therefore we can't return just [], we must return a function that would ignore whatever it receives. Therefore use const:
done = const [] -- this is equivalent to done = \_ -> []
Now let's start figuring out what step should be. It combines a value of type a with a function of type [b] -> [(a,b)] and returns a function of type [b] -> [(a,b)].
In 3 `step` done, we know that the result value that would later go to our zipped list must be (3,6) (knowing from original xs and ys). Therefore 3 `step` done must evaluate into:
\(y:ys) -> (3,y) : done ys
Remember, we must return a function, inside which we somehow zip up the elements, the above code is what makes sense and typechecks.
Now that we assumed how exactly step should evaluate, let's continue the evaluation. Here's how all reduction steps in our foldr evaluation look like:
3 `step` done -- becomes
(\(y:ys) -> (3,y) : done ys)
2 `step` (\(y:ys) -> (3,y) : done ys) -- becomes
(\(y:ys) -> (2,y) : (\(y:ys) -> (3,y) : done ys) ys)
1 `step` (\(y:ys) -> (2,y) : (\(y:ys) -> (3,y) : done ys) ys) -- becomes
(\(y:ys) -> (1,y) : (\(y:ys) -> (2,y) : (\(y:ys) -> (3,y) : done ys) ys) ys)
The evaluation gives rise to this implementation of step (note that we account for ys running out of elements early by returning an empty list):
step x f = \[] -> []
step x f = \(y:ys) -> (x,y) : f ys
Thus, the full function zip is implemented as follows:
zip :: [a] -> [b] -> [(a,b)]
zip xs ys = foldr step done xs ys
where done = const []
step x f [] = []
step x f (y:ys) = (x,y) : f ys
P.S.: If you are inspired by elegance of folds, read Writing foldl using foldr and then Graham Hutton's A tutorial on the universality and expressiveness of fold.
A simple approach:
lZip, rZip :: Foldable t => [b] -> t a -> [(a, b)]
-- implement zip using fold?
lZip xs ys = reverse.fst $ foldl f ([],xs) ys
where f (zs, (y:ys)) x = ((x,y):zs, ys)
-- Or;
rZip xs ys = fst $ foldr f ([],reverse xs) ys
where f x (zs, (y:ys)) = ((x,y):zs, ys)