Polymorphic lists...

Ralf Laemmel Ralf.Laemmel at cwi.nl
Mon Mar 8 21:34:58 EST 2004


I would like to see your code indeed ...
it seems the attachment was missing.

Anyway, I am not sure if it obvious or not,
but heterogenously typed lists can be nicely
modelled with Data.Typeable (!!!) I guess we
should add something like this to the module?

See http://www.cs.vu.nl/boilerplate/testsuite/hlist.hs
or the inlined code below

Regards,
Ralf

-- Heterogeneously typed lists
data HList = HNil
            | forall a. Typeable a => HCons a HList

-- The empty list
initHList :: HList
initHList = HNil

-- Add an entry
addHList :: Typeable a => a -> HList -> HList
addHList a l = HCons a l

-- Test for an empty list
nullHList :: HList -> Bool
nullHList HNil = True
nullHList (HCons _ _) = False

-- Retrieve head by type case
headHList :: Typeable a => HList -> Maybe a
headHList HNil = Nothing
headHList (HCons a _) = cast a

-- Retrieve head by type case
tailHList :: HList -> HList
tailHList HNil = error "tailHList"
tailHList (HCons _ l) = l

-- Access per index; starts at 1
nth1HList :: Typeable a => Int -> HList -> Maybe a
nth1HList i l | i < 1 || i == 0 && nullHList l = error "nth1HList"
nth1HList 1 l = headHList l
nth1HList i l = nth1HList (i-1) (tailHList l)

----------------------------------------------------------------------------

-- A demo list
mylist = addHList (1::Int)       $
          addHList (True::Bool)   $
          addHList ("42"::String) $
          initHList

-- Main function for testing
main = print   ( show (nth1HList 1 mylist :: Maybe Int)    -- shows Maybe 1
              , ( show (nth1HList 1 mylist :: Maybe Bool)   -- shows Nothing
              , ( show (nth1HList 2 mylist :: Maybe Bool)   -- shows
Maybe True
              , ( show (nth1HList 3 mylist :: Maybe String) -- shows
Maybe "42"
              ))))


MR K P SCHUPKE wrote:

> I needed a list which could handle items of different types for the 
> database code I am writing. I have written a module implementing such 
> a list based on dependant types (from Conor McBride: Faking It; 
> Simulating Depandant Types in Haskell). Although McBride does not 
> mention lists/vectors with items of differing types, the solution to 
> implementing them came from his 'nthFront' function for re-arranging 
> the order of arguments to a function.
>
> Any type can be inserted into the list, which supports 
> head/tail/init/last, as well as indexed lookup, and a 
> cartesian-product (concatenating two lists together). I have included 
> fromTuple/toTuple as well.
>
> This seems quite a useful construct, and if there is nothing similar 
> in the standard libraries at the moment, do you think this is worth 
> including?
>
>    Regards,
>    Keean Schupke.
> _______________________________________________
> Glasgow-haskell-users mailing list
> Glasgow-haskell-users at haskell.org
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users






More information about the Glasgow-haskell-users mailing list