
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. -- BELLOC Frederic EPITA 2005 STUDENT C, socks and sun !

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-)

On Mon, 18 Aug 2003 16:21:46 +0100
Keith Wansbrough
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
hmm, maybe I shouldn't say this, but record syntax does not preclude positional syntax. You can still pattern match and construct Node as if it was defined Node Int a (Tree a) (Tree a), i.e. Node 1 "foo" Nil Nil or f (Node 0 _ _ _) = ... Of course, this brings back all the issues of positional notation, so you may not want to use this... um, ever. However, one issue with records is that it's possible (or rather easier) to make partially defined records. E.g. Node { key = 5 } is legal, and any attempt to use val/left/right will cause a run-time error. So this might be a use for the alternate positional syntax. Code that uses the positional syntax to build records will break when fields are added to the record rather than go on creating broken records (of course, GHC at least, produces a warning for uninitialized fields).
participants (3)
-
Derek Elkins
-
Frederic BELLOC
-
Keith Wansbrough