Today I noticed that GHC is more concerned (when using -Wall) about uninitialized fields when those fields have names:

  data A = A {a::Integer}
  data B = B Integer

  x :: A
  x = A{} -- Gives a nice warning: "Fields of `A' not initialised: a"

  y :: B
  y = B{} -- No warning!

Is this on purpose? If so, what is the rationale?

The context in which I encountered this boils down to the following:

  {-# LANGUAGE RecordWildCards #-}

  data C = C {c::Integer}

  f :: C -> C
  f C{..} = C{..}

  g :: C -> Integer
  g (C i) = i

  main :: IO ()
  main =  print (g (f (C 3)))

This code worked fine (and printed "3"), until I made C's Integer nameless. This made it crash with following runtime error instead:

  T: T.hs:6:11-15: Missing field in record construction

The crash and error are perfectly understandable, but it would have been more helpful if GHC had warned about this at compile-time! The reason it didn't, though, is because of its aforementioned cavalier attitude towards uninitialized fields that don't have names... :-)

(I'm using GHC 7.0.4.)

Cheers,

Eelis


_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to