Why is one fold tail-recursive and the other one is not? - sml

fun fold1 f acc lst =
case lst of
[] => acc
| hd::tl => fold1 f (f (acc,hd)) tl
fun fold2 f acc lst =
case lst of
[] => acc
| hd::tl => f (fold2 f acc tl, hd)
Why first one is tail-recursive and the other is not?
I think both of them are tail-recursive.

The first one is tail-recursive because the recursive call (to fold1) appears at the end of the function body (it forms the "tail"):
fold1 f (f (acc,hd)) tl
calls f (acc,hd) first, then passes the result (along with f and tl) to fold1. This is the last thing the function does; the result of the recursive fold1 call is passed through to our caller.
The second one is not tail-recursive because the recursive call (to foldl2) is not the last thing the function does:
f (fold2 f acc tl, hd)
calls fold2 f acc tl first, then makes a tuple from the result and hd, then passes that tuple to f.
There are two things that happen after the recursive fold2 call: Tuple construction ((..., hd)) and another function call (f ...). In particular, the result of calling fold2 is not passed straight through to our caller. That's why this code is not tail-recursive.

Why first one is tail-recursive and the other is not?
Given a definition of tail-recursive,
A function call is said to be tail recursive if there is nothing to do after the function returns except return its value.
In the first function,
fun fold1 f acc lst =
case lst of
[] => acc
| hd::tl => fold1 f (f (acc,hd)) tl
all other computation (f (acc, hd)) is performed as an argument to fold1, meaning there is nothing to do after the function returns except return its value.
In the second function,
fun fold2 f acc lst =
case lst of
[] => acc
| hd::tl => f (fold2 f acc tl, hd)
all other computation (f (..., hd)) is performed after fold2 f acc tl has executed, meaning there is something to do after the function returns, namely compute f (..., hd).
Tail-recursive functions have the defining characteristic that the outermost expression of its recursive function body is a call to itself. If anything else is computed in the function, it should happen before this call is made, e.g. as a function argument, or in a let-binding.
For example, the following refactoring of fold1 is also tail-recursive:
fun fold1 f acc0 [] = acc0
| fold1 f acc0 (x::xs) =
let val acc1 = f (acc0, x)
in fold1 f acc1 xs
end
and the following refactoring of fold2 isn't:
fun fold2 f acc0 [] = acc0
| fold2 f acc0 (x::xs) =
let val acc1 = fold2 f acc0 xs
in f (acc1, x)
end
Because there is nothing else to do after fold1 f acc1 xs, the context of the function call (the stack frame) can safely be discarded. A simpler example of non-tail-recursive vs. tail-recursive are:
fun length [] = 0
| length (_::xs) = 1 + length xs
fun length xs =
let fun go [] count = count
| go (_::ys) count = go ys (1 + count)
in go xs 0
end

TL;DR
If it is a tail recursion, it must locate at tail position. Arguments are not tail position.
In your case:
case lst of
[] => e1
| hd::tl => e2
e1 and e2 are both tail case, because there are no other expressions after evaluating the value of the two expression(IOW, they locate at tail position). That's why fold1 is tail recursion.
As for f (fold2 f acc tl, hd), f(...) do locate at tail position. But fold2 here is not at tail position, because after evaluating its value, you still need to invoke f. So f is tail recursion while fold2 is not.

Related

Understanding function which implements foldr and foldl

There is some case where I don't understand how foldr and foldl are used in function.
Here is a couple of example, I then explain why I don't understand them:
-- Two implementation of filter and map
map' f = foldr (\x acc -> (f x):acc) []
map'' f xs = foldl (\acc x -> acc ++ [(f x)]) [] xs
filter' f xs = foldr(\x acc -> if(f x) then x:acc else acc) [] xs
filter'' f = foldl(\acc x -> if(f x) then acc++[x] else acc) []
Why does map'' makes the use of xs but non map'? Shouldn't map' need a list for the list comprehension formula as well?
Same case for filter' vs filter''.
Here is an implementation which insert elements in a sorted sequence:
insert e [] = [e]
insert e (x:xs)
| e > x = x: insert e xs
| otherwise = e:x:xs
sortInsertion xs = foldr insert [] xs
sortInsertion'' xs = foldl (flip insert) [] xs
Why are the argument for insert flipped in sortInsertion ([] xs) (empty list and list) compare to the definition of insert(e []) (element and empty list)
Why does map'' makes the use of xs but non map'? Shouldn't map' need a list for the list comprehension formula as well? Same case for filter' vs filter''.
This is called “eta-reduction” and it’s a common way of omitting redundant parameter names (“point-free style”). Essentially whenever you have a function whose body is just an application of a function to its argument, you can reduce away the argument:
add :: Int -> Int -> Int
add x y = x + y
-- “To add x and y, call (+) on x and y.”
add :: (Int) -> (Int) -> (Int)
add x y = ((+) x) y
-- “To add x, call (+) on x.”
add :: (Int) -> (Int -> Int)
add x = (+) x
-- “To add, call (+).”
add :: (Int -> Int -> Int)
add = (+)
More precisely, if you have f x = g x where x does not appear in g, then you can write f = g.
A common mistake is then wondering why f x = g . h x can’t be written as f = g . h. It doesn’t fit the pattern because the (.) operator is the top-level expression in the body of f: it’s actually f x = (.) g (h x). You can write this as f x = (((.) g) . h) x and then reduce it to f = (.) g . h or f = fmap g . h using the Functor instance for ->, but this isn’t considered very readable.
Why are the argument for insert flipped in sortInsertion
The functional parameters of foldr and foldl have different argument order:
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
Or, with more verbose type variable names:
foldr
:: (Foldable container)
=> (element -> accumulator -> accumulator)
-> accumulator -> container element -> accumulator
foldl
:: (Foldable container)
=> (accumulator -> element -> accumulator)
-> accumulator -> container element -> accumulator
This is just a mnemonic for the direction that the fold associates:
foldr f z [a, b, c, d]
==
f a (f b (f c (f d z))) -- accumulator on the right (second argument)
foldl f z [a, b, c, d]
==
f (f (f (f z a) b) c) d -- accumulator on the left (first argument)
That is partial function application.
map' f = foldr (\x acc -> (f x):acc) []
is just the same as
map' f xs = foldr (\x acc -> (f x):acc) [] xs
if you omit xs on both sides.
However, beside this explanation, I think you need a beginner book for Haskell. Consider LYAH.

Return a list of all the even elements in the orginal list - how can I write this function without using recursion?

This function takes a list and returns a list of all the even elements from the original list. I'm trying to figure out how to do this using foldl, foldr, or map instead but I can't seem to figure it out.
fun evens [] = []
| evens (x::xs) =
if
x mod 2 = 0
then
x::evens(xs)
else
evens(xs);
Since you want fewer elements than you start with, map is out.
If you copy a list using both foldl and foldr,
- foldl (op ::) [] [1,2,3];
val it = [3,2,1] : int list
- foldr (op ::) [] [1,2,3];
val it = [1,2,3] : int list
you see that foldl reverses it, so foldr is a pretty natural choice if you want to maintain the order.
Now all you need is a function that conses a number to a list if it is even, and just produces the list otherwise.
Like this one:
fun cons_if_even (x, xs) = if x mod 2 = 0 then x::xs else xs
And then you have
fun evens xs = foldr cons_if_even [] xs
or inlined,
fun evens xs = foldr (fn (y, ys) => if y mod 2 = 0 then y::ys else ys) [] xs
It's more "natural" to use the standard filtering function, though:
fun evens xs = filter (fn x => x mod 2 = 0) xs

Are list comprehensions with for and yield! tail-recursive in F#?

I wrote this little function, I'll repeat it here for ease-of-reference:
/// Take a list of lists, go left-first, and return each combination,
/// then apply a function to the resulting sublists, each length of main list
let rec nestedApply f acc inp =
match inp with
| [] -> f acc
| head::tail ->
[
for x in head do
yield! nestedApply f (x::acc) tail
]
It made me wonder whether using yield! in this context, or in general with list comprehensions, is tail-recursive. I actually think it isn't, which makes that the above function would create a stack-depth equal to the size of the main list.
If it isn't, how can I write this same code in a tail-recursive way? I've tried with List.collect (a rolled out idea is in the referred-to question), but I didn't quite get there.
No, it's not tail-recursive, and will in fact blow up the stack:
let lists =
[1 .. 10000]
|> List.map (fun i -> List.replicate 100 i)
nestedApply id [] lists
You could make nestedApply tail-recursive by rewriting it in continuation-passing style, but isn't it just an n-ary cartesian product followed by a map?
To simplify things I am going to separate the multiplication of lists from the mapping of the function. So nestedApply will look like this:
let nestedApply f lsts = mult lsts |> List.collect f
Where mult does the multiplication of the lists and returns all the combinations.
I usually find that to do tail recursion is better to start with the simple recursion first:
let rec mult lsts =
match lsts with
| [ ] -> [[]]
| h :: rest -> let acc = mult rest
h |> List.collect (fun e -> acc |> List.map (fun l -> e :: l ) )
So this version of mult does the job but it does not use tail recursion.
It does serves as a template to create the tail recursion version and I can check that both return the same value:
let mult lsts =
let rec multT lsts acc =
match lsts with
| h :: rest -> h
|> List.collect (fun e -> acc |> List.map (fun l -> e :: l ) )
|> multT rest
| [ ] -> acc
multT (List.rev lsts) [[]]
The tail recursion version multT uses an internal accumulator parameter. To hide it, I nest the recursive part inside the function mult. I also reverse the list because this version works backwards.
Many times when you have a tail recursive function you can eliminate the recursion by using the fold function:
let mult lsts =
List.rev lsts
|> List.fold (fun acc h ->
h
|> List.collect (fun e -> acc |> List.map (fun l -> e :: l ) )
) [[]]
or foldBack:
let mult lsts =
List.foldBack (fun h acc ->
h
|> List.collect (fun e -> acc |> List.map (fun l -> e :: l ) )
) lsts [[]]
Notice the similarities.
Here is the solution in fiddle:
https://dotnetfiddle.net/sQOI7q

Rewriting zipWith function using list comprehension

I've rewritten the zipWith function using recursion, and now I am trying to rewrite it using list comprehension. I have run into quite a few binding errors and I know that my second line is incorrect. This is the function I have that works like zipWith using recursion:
zipW :: (a -> b -> c) -> [a] -> [b] -> [c]
zipW _ [] _ = []
zipW _ _ [] = []
zipW f (x:xs) (y:ys) = f x y : zipW f xs ys
And this is my attempt to rewrite it as list comprehension:
zipW2 :: (a -> b -> c) -> [a] -> [b] -> [c]
zipW2 f xs ys = [f x y | (x, y) <- zipW2 f xs ys]
I am not sure how to correct the second statement so that it works like zipWith and allows me to choose the operator.
You will need Parallel List Comprehensions extension:
{-# LANGUAGE ParallelListComp #-}
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' f xs ys = [f x y | x <- xs | y <- ys]
The original zipWith has three cases:
when the first list is empty
when the second list is empty
when the neither list is empty
The third case recursively calls zipWith on the tails of the arguments, which does the case analysis again.
In your definition, you only have one case - the list comprehension, so any recursive calls are going to wrap right back to that. And without case analysis, you could loop forever here:
>>> let myZipWith f xs ys = [ f x y | (x,y) <- myZipWith f xs ys ]
>>> myZipWith (,) [] []
^CInterrupted.
Furthermore because you're using f in the recursive call but requiring that the recursive output be a pair, you're placing the implicit requirement that f x y produce a pair:
>>> :t myZipWith
myZipWith :: (t2 -> t3 -> (t2, t3)) -> t -> t1 -> [(t2, t3)]
The solution is to not recurse, but instead to consider each pair directly.
You can use behzad.nouri's solution of enabling the ParallelListComp language extension:
>>> :set -XParallelListComp
>>> let myZipWith f xs ys = [ f x y | x <- xs | y <- ys ]
>>> myZipWith (+) [1,2,4] [0,10,20]
[1,12,24]
ParallelListComp makes the second (and later) vertical pipe characters (|) in a list comprehension legal syntax, stepping through those lists in parallel (zip-like) with earlier lists.
It's good to know how this differs from normal list comprehensions, where you separate each list you draw from with commas. Using commas does nested iteration which is flattened out in the resulting list:
>>> let notZipWith f xs ys = [ f x y | x <- xs, y <- ys ]
>>> notZipWith (+) [1,2,4] [0,10,20]
[1,11,21,2,12,22,4,14,24]
Using the ParallelListComp extension is really just syntatical sugar for the original zipWith, so you may consider it cheating.
You could also just rely on the original zip:
>>> let myZipWith f xs ys = [ f x y | (x,y) <- zip xs ys ]
>>> myZipWith (+) [1,2,4] [0,10,20]
[1,12,24]
But since zip is defined as zipWith (,), that's probably cheating too.
Another way you could go is to use indices:
>>> let myZipWith f xs ys = [ f x y | i <- [0..min (length xs) (length ys) - 1], let x = xs !! i, let y = ys !! i ]
>>> myZipWith (+) [1,2,4] [0,10,20]
[1,12,24]
But this is going to be horrendously inefficient, as !! is a linear-time operation, making myZipWith quadratic, while zipWith is linear:
>>> :set +s
>>> last $ myZipWith (+) (replicate 10000000 1) (replicate 10000000 2)
3
(4.80 secs, 3282337752 bytes)
>>> last $ zipWith (+) (replicate 10000000 1) (replicate 10000000 2)
3
(0.40 secs, 2161935928 bytes)
I'm sure there's other bad ways to create an equivalent to zipWith with a list comprehension, but I'm not terribly convinced that there's a good way, even from the ones above.

What does this list permutations implementation in Haskell exactly do?

I am studying the code in the Data.List module and can't exactly wrap my head around this implementation of permutations:
permutations :: [a] -> [[a]]
permutations xs0 = xs0 : perms xs0 []
where
perms [] _ = []
perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
where interleave xs r = let (_,zs) = interleave' id xs r in zs
interleave' _ [] r = (ts, r)
interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
in (y:us, f (t:y:us) : zs)
Can somebody explain in detail how these nested functions connect/work with each other?
Sorry about the late answer, it took a bit longer to write down than expected.
So, first of all to maximize lazyness in a list function like this there are two goals:
Produce as many answers as possible before inspecting the next element of the input list
The answers themselves must be lazy, and so there the same must hold.
Now consider the permutation function. Here maximal lazyness means:
We should determine that there are at least n! permutations after inspecting just n elements of input
For each of these n! permutations, the first n elements should depend only on the first n elements of the input.
The first condition could be formalized as
length (take (factorial n) $ permutations ([1..n] ++ undefined))) `seq` () == ()
David Benbennick formalized the second condition as
map (take n) (take (factorial n) $ permutations [1..]) == permutations [1..n]
Combined, we have
map (take n) (take (factorial n) $ permutations ([1..n] ++ undefined)) == permutations [1..n]
Let's start with some simple cases. First permutation [1..]. We must have
permutations [1..] = [1,???] : ???
And with two elements we must have
permutations [1..] = [1,2,???] : [2,1,???] : ???
Note that there is no choice about the order of the first two elements, we can't put [2,1,...] first, since we already decided that the first permutation must start with 1. It should be clear by now that the first element of permutations xs must be equal to xs itself.
Now on to the implementation.
First of all, there are two different ways to make all permutations of a list:
Selection style: keep picking elements from the list until there are none left
permutations [] = [[]]
permutations xxs = [(y:ys) | (y,xs) <- picks xxs, ys <- permutations xs]
where
picks (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- picks xs]
Insertion style: insert or interleave each element in all possible places
permutations [] = [[]]
permutations (x:xs) = [y | p <- permutations xs, y <- interleave p]
where
interleave [] = [[x]]
interleave (y:ys) = (x:y:ys) : map (y:) (interleave ys)
Note that neither of these is maximally lazy. The first case, the first thing this function does is pick the first element from the entire list, which is not lazy at all. In the second case we need the permutations of the tail before we can make any permutation.
To start, note that interleave can be made more lazy. The first element of interleave yss list is [x] if yss=[] or (x:y:ys) if yss=y:ys. But both of these are the same as x:yss, so we can write
interleave yss = (x:yss) : interleave' yss
interleave' [] = []
interleave' (y:ys) = map (y:) (interleave ys)
The implementation in Data.List continues on this idea, but uses a few more tricks.
It is perhaps easiest to go through the mailing list discussion. We start with David Benbennick's version, which is the same as the one I wrote above (without the lazy interleave). We already know that the first elment of permutations xs should be xs itself. So, let's put that in
permutations xxs = xxs : permutations' xxs
permutations' [] = []
permutations' (x:xs) = tail $ concatMap interleave $ permutations xs
where interleave = ..
The call to tail is of course not very nice. But if we inline the definitions of permutations and interleave we get
permutations' (x:xs)
= tail $ concatMap interleave $ permutations xs
= tail $ interleave xs ++ concatMap interleave (permutations' xs)
= tail $ (x:xs) : interleave' xs ++ concatMap interleave (permutations' xs)
= interleave' xs ++ concatMap interleave (permutations' xs)
Now we have
permutations xxs = xxs : permutations' xxs
permutations' [] = []
permutations' (x:xs) = interleave' xs ++ concatMap interleave (permutations' xs)
where
interleave yss = (x:yss) : interleave' yss
interleave' [] = []
interleave' (y:ys) = map (y:) (interleave ys)
The next step is optimization. An important target would be to eliminate the (++) calls in interleave. This is not so easy, because of the last line, map (y:) (interleave ys). We can't immediately use the foldr/ShowS trick of passing the tail as a parameter. The way out is to get rid of the map. If we pass a parameter f as the function that has to be mapped over the result at the end, we get
permutations' (x:xs) = interleave' id xs ++ concatMap (interleave id) (permutations' xs)
where
interleave f yss = f (x:yss) : interleave' f yss
interleave' f [] = []
interleave' f (y:ys) = interleave (f . (y:)) ys
Now we can pass in the tail,
permutations' (x:xs) = interleave' id xs $ foldr (interleave id) [] (permutations' xs)
where
interleave f yss r = f (x:yss) : interleave' f yss r
interleave' f [] r = r
interleave' f (y:ys) r = interleave (f . (y:)) ys r
This is starting to look like the one in Data.List, but it is not the same yet. In particular, it is not as lazy as it could be.
Let's try it out:
*Main> let n = 4
*Main> map (take n) (take (factorial n) $ permutations ([1..n] ++ undefined))
[[1,2,3,4],[2,1,3,4],[2,3,1,4],[2,3,4,1]*** Exception: Prelude.undefined
Uh oh, only the first n elements are correct, not the first factorial n.
The reason is that we still try to place the first element (the 1 in the above example) in all possible locations before trying anything else.
Yitzchak Gale came up with a solution. Considered all ways to split the input into an initial part, a middle element, and a tail:
[1..n] == [] ++ 1 : [2..n]
== [1] ++ 2 : [3..n]
== [1,2] ++ 3 : [4..n]
If you haven't seen the trick to generate these before before, you can do this with zip (inits xs) (tails xs).
Now the permutations of [1..n] will be
[] ++ 1 : [2..n] aka. [1..n], or
2 inserted (interleaved) somewhere into a permutation of [1], followed by [3..n]. But not 2 inserted at the end of [1], since we already go that result in the previous bullet point.
3 interleaved into a permutation of [1,2] (not at the end), followed by [4..n].
etc.
You can see that this is maximally lazy, since before we even consider doing something with 3, we have given all permutations that start with some permutation of [1,2]. The code that Yitzchak gave was
permutations xs = xs : concat (zipWith newPerms (init $ tail $ tails xs)
(init $ tail $ inits xs))
where
newPerms (t:ts) = map (++ts) . concatMap (interleave t) . permutations3
interleave t [y] = [[t, y]]
interleave t ys#(y:ys') = (t:ys) : map (y:) (interleave t ys')
Note the recursive call to permutations3, which can be a variant that doesn't have to be maximally lazy.
As you can see this is a bit less optimized than what we had before. But we can apply some of the same tricks.
The first step is to get rid of init and tail. Let's look at what zip (init $ tail $ tails xs) (init $ tail $ inits xs) actually is
*Main> let xs = [1..5] in zip (init $ tail $ tails xs) (init $ tail $ inits xs)
[([2,3,4,5],[1]),([3,4,5],[1,2]),([4,5],[1,2,3]),([5],[1,2,3,4])]
The init gets rid of the combination ([],[1..n]), while the tail gets rid of the combination ([1..n],[]). We don't want the former, because that would fail the pattern match in newPerms. The latter would fail interleave. Both are easy to fix: just add a case for newPerms [] and for interleave t [].
permutations xs = xs : concat (zipWith newPerms (tails xs) (inits xs))
where
newPerms [] is = []
newPerms (t:ts) is = map (++ts) (concatMap (interleave t) (permutations is))
interleave t [] = []
interleave t ys#(y:ys') = (t:ys) : map (y:) (interleave t ys')
Now we can try to inline tails and inits. Their definition is
tails xxs = xxs : case xxs of
[] -> []
(_:xs) -> tails xs
inits xxs = [] : case xxs of
[] -> []
(x:xs) -> map (x:) (inits xs)
The problem is that inits is not tail recursive. But since we are going to take a permutation of the inits anyway, we don't care about the order of the elements. So we can use an accumulating parameter,
inits' = inits'' []
where
inits'' is xxs = is : case xxs of
[] -> []
(x:xs) -> inits'' (x:is) xs
Now we make newPerms a function of xxs and this accumulating parameter, instead of tails xxs and inits xxs.
permutations xs = xs : concat (newPerms' xs [])
where
newPerms' xxs is =
newPerms xxs is :
case xxs of
[] -> []
(x:xs) -> newPerms' xs (x:is)
newPerms [] is = []
newPerms (t:ts) is = map (++ts) (concatMap (interleave t) (permutations3 is))
inlining newPerms into newPerms' then gives
permutations xs = xs : concat (newPerms' xs [])
where
newPerms' [] is = [] : []
newPerms' (t:ts) is =
map (++ts) (concatMap (interleave t) (permutations is)) :
newPerms' ts (t:is)
inlining and unfolding concat, and moving the final map (++ts) into interleave,
permutations xs = xs : newPerms' xs []
where
newPerms' [] is = []
newPerms' (t:ts) is =
concatMap interleave (permutations is) ++
newPerms' ts (t:is)
where
interleave [] = []
interleave (y:ys) = (t:y:ys++ts) : map (y:) (interleave ys)
Then finally, we can reapply the foldr trick to get rid of the (++):
permutations xs = xs : newPerms' xs []
where
newPerms' [] is = []
newPerms' (t:ts) is =
foldr (interleave id) (newPerms' ts (t:is)) (permutations is)
where
interleave f [] r = r
interleave f (y:ys) r = f (t:y:ys++ts) : interleave (f . (y:)) ys r
Wait, I said get rid of the (++). We got rid of one of them, but not the one in interleave.
For that, we can see that we are always concatenating some tail of yys to ts. So, we can unfold the calculating (ys++ts) along with the recursion of interleave, and have the function interleave' f ys r return the tuple (ys++ts, interleave f ys r). This gives
permutations xs = xs : newPerms' xs []
where
newPerms' [] is = []
newPerms' (t:ts) is =
foldr interleave (newPerms' ts (t:is)) (permutations is)
where
interleave ys r = let (_,zs) = interleave' id ys r in zs
interleave' f [] r = (ts,r)
interleave' f (y:ys) r =
let (us,zs) = interleave' (f . (y:)) ys r
in (y:us, f (t:y:us) : zs)
And there you have it, Data.List.permutations in all its maximally lazy optimized glory.
Great write-up by Twan! I (#Yitz) will just add a few references:
The original email thread where Twan developed this algorithm, linked above by Twan, is fascinating reading.
Knuth classifies all possible algorithms that satisfy these criteria in Vol. 4 Fasc. 2 Sec. 7.2.1.2.
Twan's permutations3 is essentially the same as Knuth's "Algorithm P". As far as Knuth knows, that algorithm was first published by English church bell ringers in the 1600's.
The basic algorithm is based on the idea of taking one item from the list at a time, finding every permutation of items including that new one, and then repeating.
To explain what this looks like, [1..] will mean a list from one up, where no values (no even the first) have been examined yet. It is the parameter to the function. The resulting list is something like:
[[1..]] ++
[[2,1,3..]] ++
[[3,2,1,4..], [2,3,1,4..]] ++ [[3,1,2,4..], [1,3,2,4..]]
[[4,3,2,1,5..], etc
The clustering above reflects the core idea of the algorithm... each row represents a new item taken from the input list, and added to the set of items that are being permuted. Furthermore, it is recursive... on each new row, it takes all the existing permutations, and places the item in each place it hasn't been yet (all the places other then the last one). So, on the third row, we have the two permutations [2,1] and [1,2], and then we take place 3 in both available slots, so [[3,2,1], [2,3,1]] and [[3,1,2], [1,3,2]] respectively, and then append whatever the unobserved part is.
Hopefully, this at least clarifies the algorithm a little. However, there are some optimizations and implementation details to explain.
(Side note: There are two central performance optimizations that are used: first, if you want to repeatedly prepend some items to multiple lists, map (x:y:z:) list is a lot faster then matching some conditional or pattern matching, because it has not branch, just a calculated jump. Second, and this one is used a lot, it is cheap (and handy) to build lists from the back to the front, by repeatedly prepending items; this is used in a few places.
The first thing the function does is establish a two bases cases: first, every list has one permutation at least: itself. This can be returned with no evaluation whatsoever. This could be thought of as the "take 0" case.
The outer loop is the part that looks like the following:
perms (t:ts) is = <prepend_stuff_to> (perms ts (t:is))
ts is the "untouched" part of the list, that we are not yet permuting and haven't even examined yet, and is initially the entire input sequence.
t is the new item we will be sticking in between the permutations.
is is the list of items that we will permute, and then place t in between, and is initially empty.
Each time we calculate one of the above rows, we reach the end of the items we have prepended to the thunk containing (perms ts (t:is)) and will recurse.
The second loop in is a foldr. It for each permutation of is (the stuff before the current item in the original list), it interleaves the item into that list, and prepends it to the thunk.
foldr interleave <thunk> (permutations is)
The third loop is one of the most complex. We know that it prepends each possible interspersing of our target item t in a permutation, followed by the unobserved tail onto the result sequence. It does this with a recursive call, where it folds the permutation into a stack of functions as it recurses, and then as it returns, it executes what amounts to a two little state machines to build the results.
Lets look at an example: interleave [<thunk>] [1,2,3] where t = 4 and is = [5..]
First, as interleave' is called recursively, it builds up ys and fs on the stack, like this:
y = 1, f = id
y = 2, f = (id . (1:))
y = 3, f = ((id . (1:)) . (2:))
(the functions are conceptually the same as ([]++), ([1]++), and ([1,2]++) respectively)
Then, as we go back up, we return and evalute a tuple containing two values, (us, zs).
us is the list to which we prepend the ys after our target t.
zs is the result accumulator, where each time we get a new permutation, we prepend it to the results lists.
Thus, to finish the example, f (t:y:us) gets evaluated and returned as a result for each level of the stack above.
([1,2]++) (4:3:[5..]) === [1,2,4,3,5..]
([1]++) (4:2[3,5..]) === [1,4,2,3,5..]
([]++) (4:1[2,3,5..]) === [4,1,2,3,5..]
Hopefully that helps, or at least supplements the material linked in the author's comment above.
(Thanks to dfeuer for bringing this up on IRC and discussing it for a few hours)