Can this function be written in point-free style?

问题:

One related question is this, but some of the answer say that almost anything can be made point free, so what is wrong with this function?

\[x] -> x

http://pointfree.io/ doesn't seem to be able to write it in point-free style. Does this mean that it cannot be written that way? If so, what is the theoretical reason for it?

I can only observe that the function above is a "crippled" version of head (or last, fwiw) which can only operate on singleton lists. Indeed, applied on non singleton lists, it errors this way in ghci:

*** Exception: <interactive>:380:5-13: Non-exhaustive patterns in lambda

Maybe the "non-exhaustivity" on the pattern is the reason why some functions cannot be written in point-free style?

Edit in the light of the answers:

I did not expect that the answers to my question could be so complex (I feel I just thought that the short answer was no, it cannot, actually), so I need to find some time to read them carefully, experiment a bit, and wrap my mind around them, otherwise I cannot decide which one should be accepted. For the time being, +1 to Jon Purdy's answer, which I could easily understand up to This is where I would stop in ordinary code.

回答1:

Sure, pretty much anything can be made pointfree. The tricky thing is what functions you'll allow in the resulting expression. If we pattern match, we generally need a fold function to do the matching instead. So, for instance, if we pattern matched on a Maybe a, we'd need to replace that with maybe. Similarly, Either a b patterns can be written in terms of either.

Note the pattern in the signatures

data Maybe a = Nothing | Just a

maybe :: b -> (a -> b) -> (Maybe a -> b)

Maybe a has two constructors, one which takes no arguments and the other which takes an a. So maybe takes two arguments: one which is a 0-ary function (b), and one which takes an a (a -> b), and then returns a function from Maybe a -> b. The same pattern is present in either

data Either a b = Left a | Right b

either :: (a -> c) -> (b -> c) -> (Either a b -> c)

Two cases. The first takes an a and produces whatever c we want. The second takes a b and produces whatever c we want. In every case, we want one function for each possible term in the sum type.

In order to systematically pointfree a function like \[x] -> x, we'd need a similar fold. [a] is declared as, essentially

data [a] = [] | a : [a]

So we'd need a function with this signature

list :: b -> (a -> [a] -> b) -> ([a] -> b)

Now, flip foldr comes close

flip foldr :: b -> (a -> b -> b) -> ([a] -> b)

But it's recursive. It calls its provided function on the [a] part of a : [a]. We want a true fold, which isn't provided by Haskell's base libraries. A quick Hoogle search tells us that this function does exist in a package though, called extra. Of course, for this small example we can just write it ourselves very easily.

list :: b -> (a -> [a] -> b) -> ([a] -> b)
list f g x = case x of
               [] -> f
               (y:ys) -> g y ys

Now we can apply it to your \[x] -> x easily. First, let's write what your function really does, including all of the messy undefined cases (I'll use undefined rather than a long error message here, for brevity)

func :: [a] -> a
func x = case x of
           [] -> undefined
           (y:ys) -> case ys of
                       [] -> y
                       (_:_) -> undefined

Now every case statement exactly matches each constructor once. This is ripe for transformation into a fold.

func :: [a] -> a
func x = case x of
         [] -> undefined
         (y:ys) -> list y undefined ys

And now we transform the outer case as well

func :: [a] -> a
func x = list undefined (\y -> list y undefined) x

So we have

func :: [a] -> a
func = list undefined (\y -> list y undefined)

Or, if we want to be truly crazy about it

func :: [a] -> a
func = list undefined (flip list undefined)

But this function isn't in base

Yeah, that's true. We kind of cheated by using a fold that didn't exist. If we want to do it systematically, we need that fold operator. But without it, we can still kludge it together with foldr1, which suffices for our particular purposes.

func' :: [a] -> a
func' = foldr1 (const (const undefined))

So, to answer your question, we can't always systematically replace pattern matching like in your example with pointfree, unless we have a fold function with the right signature. Fortunately, that function can always be written, for any Haskell 98 data type (possibly GADTs as well, but I haven't considered that possibility in any depth). But even without that support, we can still make it work, kind of.

回答2:

Well, a data type isn't a function. As long as your function isn't unwrapping any data values (i.e. it's just shuffling them between functions/constructors), you can write it point free, but there's simply no syntax for point free matching. However, you only ever need one non-point-free function per data type: the fold. In Haskell, data types are pretty much defined by their folds. Taking the folds of the relevant data types as primitives, you can rewrite any function point free. Note that there are actually several possible "folds". For [a], the recursive one (which comes from the Church/Böhm-Berarducci encoding) is foldr :: (a -> b -> b) -> b -> [a] -> b. Another possible fold is the "case-but-it's-a-function" one, (a -> [a] -> b) -> b -> [a] -> b, which comes from the Scott encoding (recursion can then be recovered with fix, which is another "pointful pointfree primitive"), but, as @SilvioMayolo notes, there isn't such a function in the standard library. Either would do, but we don't have the latter predefined so let's just use foldr.

\[x] -> x

can be written

fst . foldr (\x f -> (snd f x, \_ -> error "got (_ : _ : _) wanted [x]")) (error "got [] wanted [x]", id)
-- I don't care enough to replicate the exact exceptions.
-- this is "flattened" from
let fold [] = (error "got [] wanted [x]", id)
    fold (x : xs) = (snd (fold xs) x, \_ -> error "got (_ : _ : _) wanted [x]")
in  fst . fold

fold returns a pair, basically (what to return if this was the entire list, how to transform the head if it wasn't). For [], we want to return an error if that was the entire list, but otherwise pass through the element right before we hit []. For x : xs, if there is an element preceding it, we want to ignore it and return an error, and if there isn't, we want to pass it to snd (fold xs), which checks if xs = [] or else gives an error. We've eliminated all matches, so just shove this through pointfree.io to get the \x f -> _ in the argument to foldr out:

behead = fst . foldr (flip flip (const (error "got (_ : _ : _) wanted [x]")) . ((,) .) . flip snd) (error "got [] wanted [x]", id)
ghci> :t behead
behead :: Foldable t => t c -> c
ghci> behead []
*** Exception: got [] wanted [x]
ghci> behead [1]
1
ghci> behead [1, 2]
*** Exception: got (_ : _ : _) wanted [x]
ghci> behead [1..]
*** Exception: got (_ : _ : _) wanted [x]

Lovely.

Note: a previous version of this answer used an "inlined" auxiliary data type, basically because it just "came to me" as I was writing it. However, it failed to handle infinite lists properly (behead [1..] would hang). This version uses the built in pairs as the auxiliary data type, which have sufficient library support that I don't have to inline them to make it pointfree. It is slightly harder to inline (,), thereby eliminating the pointfullness inside the implementations of fst and snd, but it is still possible, using this newtype:

newtype Pair a b = Pair { unPair :: forall r. (a -> b -> r) -> r }

Alternatively, cheat on the types a bit and use this:

-- residual pointfullness can be reduced by pointfree.io
\xs -> foldr (\x r f -> f (r (const id) x) (\_ -> error "got (_ : _ : _) wanted [x]")) (\f -> f (error "got [] wanted [x]") id) xs (\x _ _ -> x) undefined

回答3:

A simple way to write this in pointfree form is to use a fold, where the accumulator state is one of the following:

• Empty: We haven’t seen an element yet; keep it

• Full: We have seen an element; raise an error

If the final state is Empty, we also raise an error. This accumulator can be represented naturally with Maybe:

fromSingleton :: (Foldable t) => t a -> a
fromSingleton
  = fromMaybe (error "empty list")
  . foldr (flip maybe (error "plural list") . Just) Nothing

This is where I would stop in ordinary code. But…

If you don’t want to use an auxiliary data type, you can get rid of the Maybe by representing it with Böhm–Berarducci encoding:

type Maybe' r a
  = r          -- ‘Nothing’ continuation
  -> (a -> r)  -- ‘Just’ continuation
  -> r         -- Result

just' :: a -> Maybe' r a
-- just' = \ x _n j -> j x
just'
  = const     -- Ignore ‘Nothing’ continuation
  . flip ($)  -- Apply ‘Just’ continuation to value

nothing' :: Maybe' r a
-- nothing' = \ n _j -> n
nothing' = const  -- Ignore ‘Just’ continuation

maybe' :: r -> (a -> r) -> Maybe' r a -> r
-- maybe' = \ n j k -> k n j
maybe'
  = flip      -- Apply to ‘Just’ continuation
  . flip ($)  -- Apply to ‘Nothing’ continuation

fromMaybe' :: r -> Maybe' r r -> r
-- fromMaybe' = \ n k -> k n id
fromMaybe' = flip maybe' id  -- Pass ‘id’ as ‘Just’ continuation

However, we can’t just do a wholesale replacement of Just with just', maybe with maybe', and so on; the types won’t work out:

> :t fromMaybe' (error "empty list") . foldr (flip maybe' (error "plural list") . just') nothing'

<interactive>:…:…: error:
    • Occurs check: cannot construct the infinite type: c ~ Maybe' c c
      Expected type: c -> Maybe' c c -> Maybe' c c
        Actual type: c -> Maybe' (Maybe' c c) c -> Maybe' c c
    • In the first argument of ‘foldr’, namely
        ‘(flip maybe' (error "plural list") . just')’
      In the second argument of ‘(.)’, namely
        ‘foldr (flip maybe' (error "plural list") . just') nothing'’
      In the expression:
        fromMaybe' (error "empty list")
          . foldr (flip maybe' (error "plural list") . just') nothing'

The problem is that we’re returning a Maybe' from a Maybe' continuation, and the compiler is trying to unify the two result types. One solution is to first eta-expand to let the typechecker know where we want to construct a distinct function:

> :t fromMaybe' (error "empty list") . foldr (\ x acc -> \ n j -> maybe' (just' x n j) (error "plural list") acc) nothing'

fromMaybe' (error "empty list") . foldr (\ x acc -> \ n j -> maybe' (just' x n j) (error "plural list") acc) nothing'
  :: Foldable t => t c -> c

Then we can incrementally rewrite to pointfree form:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (\ x acc
      -> \ n j
        -> maybe'
          (just' x n j)
          (error "plural list")
          acc)
    nothing'

-- Move ‘n’ & ‘j’ past ‘error …’ with ‘flip’:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (\ x acc
      -> \ n j
        -> flip maybe'
           ----
          (error "plural list")
          (just' x n j)
          acc)
    nothing'

-- Move ‘n’ & ‘j’ past ‘acc’ with ‘flip’ again:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (\ x acc
      -> \ n j
        -> flip (flip maybe' (error "plural list")) acc
           ----
          (just' x n j))
    nothing'

-- Eta-reduce ‘j’ with composition:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (\ x acc
      -> \ n
        -> flip (flip maybe' (error "plural list")) acc
          . just' x n)
          --
    nothing'

-- Eta-reduce ‘n’ with ‘fmap’ (to map “under” an argument):

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (\ x acc
      -> fmap (flip (flip maybe' (error "plural list")) acc)
         ----
        . just' x)
    nothing'

-- Move ‘x’ rightward with ‘flip’ on the outside:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (flip (\ acc x
     ----
      -> fmap (flip (flip maybe' (error "plural list")) acc)
        . just' x))
    nothing'

-- Replace composition with ‘fmap’:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (flip (\ acc x
      -> fmap (fmap (flip (flip maybe' (error "plural list")) acc))
         ----
        (just' x)))
    nothing'

-- Eta-reduce ‘x’ with composition:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (flip (\ acc
      -> fmap (fmap (flip (flip maybe' (error "plural list")) acc))
        . just'))
        --
    nothing'

-- Replace composition with ‘fmap’:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (flip (\ acc
      -> fmap (fmap (fmap (flip (flip maybe' (error "plural list")) acc)))
         ----
        just'))
    nothing'

-- Move ‘acc’ rightward with ‘flip’:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (flip (\ acc
      -> flip fmap just'
         ----
        (fmap (fmap (flip (flip maybe' (error "plural list")) acc)))))
    nothing'

-- Eta-reduce with composition:

fromSingleton
  = fromMaybe' (error "empty list")
  . foldr
    (flip
      (flip fmap just'
        . fmap . fmap . flip (flip maybe' (error "plural list"))))
        --     -      -
    nothing'

This is fully pointfree as well (far less readable than our original code, but better than what pointfree generates). In fact it’s good practice in pointfree code to use many small auxiliary definitions like fromMaybe' instead of inlining everything, but we can proceed to inline their definitions.

However, you can’t inline them naïvely and get exactly the same type—if you do, you’ll arrive at (Foldable t) => t (a -> b) -> a -> b. It could be a good exercise to work through where you need to eta-expand and rewrite in order to obtain the expected type, (Foldable t) => t a -> a.