Tuples or Record

Keith Wansbrough Keith.Wansbrough@cl.cam.ac.uk
Mon, 18 Aug 2003 16:21:46 +0100


> Hello,
> When I have started my project, I use a Tuples but i would know if it
> is possible to create a record such C or Ocaml provide. I mean creating
> a structure  where variables are accessible by a '.' or something
> like that.

Yes.  Like this:

  data Tree a = Node { key :: Int,
                       val :: a,
                       left, right :: Tree a }
              | Nil deriving Show
  
  inorder :: Tree a -> [(Int,a)]
  inorder (Node {key = k, val = v, left = l, right = r})
    = inorder l ++ [(k,v)] ++ inorder r
  inorder Nil
    = []
  
  inorder' :: Tree a -> [(Int,a)]
  inorder' n@(Node {}) = inorder' (left n) ++ [(key n,val n)] ++ inorder' (right n)
  inorder' Nil = []
  
  insert :: Tree a -> (Int,a) -> Tree a
  insert Nil (k,v)
    = Node { key = k, val = v, left = Nil, right = Nil }
  insert n@(Node {}) (k,v)
    = if k < key n then
        n { left = insert (left n) (k,v) }
      else
        n { right = insert (right n) (k,v) }
  
  t :: Tree String
  t = foldl insert Nil [(3,"three"),(1,"one"),(4,"two"),(5,"five")]

Note that field access is by "key n", rather than by "n.key" as in
other languages.  "key" is just a function, like any other: it has
type "Tree a -> Int".  Records can be constructed directly, as in the
Nil case of insert, or based on another record with changes specified,
as in the Node case of insert.  Pattern-matching can match none, some,
or all of the fields, in any order.

Because field names become functions, they live in the global name
space.  This means you can't use the same field name in two different
data types - so it is usual to prefix the field name with an
abbreviation of the data type name, such as

  data BinTree a = BinTree { btKey :: Int }

But you can use the same field in multiple constructors of the *same*
data type, as in:

  data Shape a = Point   { loc :: (Int,Int) }
               | Square  { loc :: (Int,Int),
                           size :: Int }
               | Circle  { loc :: (Int,Int),
                           size :: Int }
               | Ellipse { loc :: (Int,Int),
                           size :: Int,
                           eccentricity :: Float
                         }

HTH.

--KW 8-)