Language extension idea (was Re: [Haskell-cafe] Re: OCaml list
sees...)
Jon Fairbairn
Jon.Fairbairn at cl.cam.ac.uk
Tue Oct 12 12:17:34 EDT 2004
On 2004-10-10 at 11:20BST Malcolm Wallace wrote:
> As an example, instead of the following list-only code,
>
> f :: List a -> ...
> f [] = ...
> f (h:t) = ...
>
> you could write this more general version, which assumes only some
> class Sequence with operations null, head, tail, etc.
>
> f :: Sequence s => s a -> ...
> f list | null list = ...
> | h <- head list, t <- tail list = ...
>
> Although slightly more verbose, it still achieves something like the
> clarity of pattern-matching.
Here's my take on this:
> module SQC where
> import Array
Split the reading from the writing, and allow the avoidance
of head and tail wherever possible:
> class Sequential f where
> examine :: f a -> Maybe (a, f a)
the next three aren't really necessary
> first :: f a -> a
> rest :: f a -> f a
> isEmpty:: f a -> Bool
The default method for first and rest typify the usage. I
think this is slightly prettier than using head and tail:
> first l | Nothing <- e = error "ugh"
> | Just (hd, tl) <- e = hd
> where e = examine l
> rest l | Nothing <- e = error "agh"
> | Just (hd, tl) <- e = tl
> where e = examine l
>
> isEmpty l | Nothing <- examine l = True
> | otherwise = False
>
> class Sequential s =>
> Sequence s where
> cons :: a -> s a -> s a
> nils :: s a
With the reading and "writing" separated, we can do things
like map and filter without requiring the thing being read
from to have all the properties of a list:
> mapS:: (Sequential s, Sequence t) => (a -> b) -> s a -> t b
> mapS f l | Nothing <- e = nils
> | Just (h, t) <- e = cons (f h) (mapS f t)
> where e = examine l
> filterS:: (Sequential s, Sequence t) => (a -> Bool) -> s a -> t a
> filterS p l | Nothing <- e = nils
> | Just (h, t) <- e, p h = cons h (filterS p t)
> | Just (h, t) <- e = filterS p t
> where e = examine l
The instances for [] are straightforward
> instance Sequential [] where
> first = head
> rest = tail
> examine [] = Nothing
> examine (a:b) = Just (a,b)
> instance Sequence [] where
> cons = (:)
> nils = []
Actually, in Ponder, the list type was just a (recursive)
synonym for something similar to List t = Maybe (t, List t),
so examine would just have been the identity -- which
suggests that this ought to be cheap to implement.
We can give a read-only instance for (part of) an array:
> data ArrayTail i e = AT i (Array i e) deriving Show
> instance (Enum i, Ix i) => Sequential (ArrayTail i)
> where examine (AT i a) | inRange (bounds a) i = Just (a!i, AT (succ i) a)
> | otherwise = Nothing
so that
filterS ((==0).(`rem`2)) (AT 1 (array (1,10) ([1..10]`zip`[20..30])))::[Int]
=> [20,22,24,26,28]
which might be handy for selecting stuff from an array
represented sequence without having to build an array for
the result.
Jón
--
Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk
More information about the Haskell-Cafe
mailing list