diff --git a/named-records.cabal b/named-records.cabal
--- a/named-records.cabal
+++ b/named-records.cabal
@@ -1,5 +1,5 @@
 Name:           named-records
-Version:        0.2.3
+Version:        0.3
 Synopsis:       Flexible records with named fields.
 Description:    Flexible records with named fields.
                 .
@@ -15,6 +15,8 @@
                 [@v0.2.3@] Cabal package tidied up and basic
                     documentation added (also fixed a bug regarding
                     definition of default values).
+                .
+                [@v0.3@] Records can now extend other records.
                 
 License:        MIT
 License-File:   LICENSE
@@ -33,7 +35,7 @@
 Source-Repository head
     type: darcs
     location: hub.darcs.net:names
-    tag: v0.2.3
+    tag: v0.3
 
 
 Library
diff --git a/src/Data/NamedRecord.hs b/src/Data/NamedRecord.hs
--- a/src/Data/NamedRecord.hs
+++ b/src/Data/NamedRecord.hs
@@ -107,6 +107,44 @@
 >                            := [e| \x -> answer x |]
 >     `has` "config" := ''Config := [e| newConfig |]
 
+It is furthermore possible to extend existing records
+(but due to stage restrictions in GHCs implementation of
+Template Haskell, two records of which one extends the other
+can not be contained in the same module):
+
+> module Sample2 where
+> 
+> import qualified Data.Name
+> import Data.NamedRecord
+> import Data.Word
+> 
+> record "Account"
+>     `has` "id"        := ''Word64
+> 
+>     `has` "loginName" := ''String
+>     `has` "password"  := ''String
+> 
+> record "Person"
+>     `has` "id"        := ''Word64
+> 
+>     `has` "firstName" := ''String
+>     `has` "lastName"  := ''String
+
+> module Sample where
+> 
+> import qualified Data.Name
+> import Data.NamedRecord
+> import Data.Word
+> 
+> import Sample2
+> 
+> record "User"
+>     `extends` __Person
+>     `extends` __Account
+> 
+>     `has` "id"           := ''Word64
+>     `has` "emailAddress" := ''String
+
 -}
 module Data.NamedRecord (
     Property (get, set),
@@ -121,28 +159,33 @@
     -- See the examples.
     record,
 
+    extends,
+
     -- | Declares a field of a record. Use as infix operators.
     -- See the examples.
     has,
 
-    RecordTemplate (..),
-
     -- ** Names
     -- For convenience, this module re-exports name TH name functions.
     name, nameT, nameV
 ) where
 
+
+import Control.Monad
+import Data.Data
+import Data.Function (on)
 import Data.List
 import qualified Data.Name
 import Data.Name (name, nameT, nameV)
+import Data.Typeable
 import Language.Haskell.TH
+import Language.Haskell.TH.Quote
 import Language.Haskell.TH.Syntax (Lift (..))
 
 
-
 data a := b = a := b deriving Show
 
-infixl 3 :=
+infixr 3 :=
 
 
 data a :+ b = a :+ b deriving Show
@@ -151,7 +194,6 @@
 
 
 class Property o n v | o n -> v where
-    
     get :: o -> n -> v
     set :: o -> n := v -> o
 
@@ -166,128 +208,152 @@
 
 
 instance Property (n := v) n v where
-
     get (_ := v) _ = v
     set _ v = v
 
-
 instance Property ((n := v) :+ b) n v where
-
     get (a :+ b) n = get a n
     set (a :+ b) p = (set a p) :+ b
 
-
 instance Property b n v => Property (a :+ b) n v where
-
     get (a :+ b) n = get b n
     set (a :+ b) p = a :+ (set b p)
 
 
+class ToExp a where
+    toExp' :: a -> Q Exp
 
-data Record = Record String
+instance ToExp (Q Exp) where
+    toExp' = id
 
-record :: String -> Record
-record = Record
+instance Lift a => ToExp a where
+    toExp' = lift
 
 
-class ToType a where toType :: a -> Q Type
+class Field a where
+    toExp :: a -> Maybe (Q Exp)
+    toType :: a -> Q Type
 
-instance ToType (Q Type) where toType = id
-instance ToType Name where toType = return . ConT
+    toExp _ = Nothing
 
+instance ToExp e => Field (Q Type := e) where
+    toExp (_ := e) = Just $ toExp' e
+    toType (v := _) = v
 
-class ToExp a where toExp :: a -> Q Exp
+instance ToExp e => Field (Name := e) where
+    toExp (_ := e) = Just $ toExp' e
+    toType (v := _) = return $ ConT v
 
-instance ToExp (Q Exp) where toExp = id
-instance Lift a => ToExp a where toExp = lift
+instance Field Name where
+    toType = return . ConT
 
+instance Field (Q Type) where
+    toType = id
 
+instance (Data a, Typeable a) => Field a where
+    toExp = Just . dataToExpQ (const Nothing)
+    toType e = qType typeName
+      where
+        typeName = show (typeOf e)
+
+        qType typeName = case typeName of
+
+            -- This is a dirty hack. It would be much better
+            -- to resolve all type synonyms to their real types.
+            -- This would have to be done in (~>)
+            "[Char]" -> return $ ConT ''String
+
+            ('[':xs) -> do
+                t <- qType (init xs)
+                return $ AppT ListT t
+
+            ('M':'a':'y':'b':'e':' ':xs) -> do
+                t <- qType xs
+                m <- [t| Maybe |]
+                return $ AppT m t
+
+            name -> lookupTypeName name >>= typeFor
+
+        typeFor (Just n) = return $ ConT n
+        typeFor Nothing = fail $ "The type \"" ++ typeName
+            ++ "\" can not be handled by Data.NamedRecord TH sugar"
+            ++ " (you might to import the module where it's from)."
+
+
 class RecordTemplate a b c | a b -> c where
     (~>) :: a -> b -> c
 
-
-instance (ToType v, ToType w) => RecordTemplate
+instance (Field v, Field w) => RecordTemplate
         (String := v)
         (String := w)
         [(String, Q Type, Maybe (Q Exp))] where
-    (n := v) ~> (m := w) = [(n, toType v, Nothing),
-                            (m, toType w, Nothing)]
+    (n := v) ~> (m := w) = [(n, toType v, toExp v),
+                            (m, toType w, toExp w)]
 
-instance (ToType v, ToType w, ToExp e) => RecordTemplate
+instance Field v => RecordTemplate
         (String := v)
-        (String := w := e)
+        [(String, Q Type, Maybe (Q Exp))]
         [(String, Q Type, Maybe (Q Exp))] where
-    (n := v) ~> (m := w := e) = [(n, toType v, Nothing),
-                                 (m, toType w, Just $ toExp e)]
+    (n := v) ~> xs = (n, toType v, toExp v) : xs
 
-instance (ToType v, ToType w, ToExp d) => RecordTemplate
-        (String := v := d)
-        (String := w)
-        [(String, Q Type, Maybe (Q Exp))] where
-    (n := v := d) ~> (m := w) = [(n, toType v, Just $ toExp d),
-                                 (m, toType w, Nothing)]
+instance Field v => RecordTemplate Record (String := v) (Q [Dec]) where
+    r ~> (n := v) = r ~> [(n, toType v, toExp v)]
 
-instance (ToType v, ToType w, ToExp d, ToExp e) => RecordTemplate
-        (String := v := d)
-        (String := w := e)
-        [(String, Q Type, Maybe (Q Exp))] where
-    (n := v := d) ~> (m := w := e) = [(n, toType v, Just $ toExp d),
-                                      (m, toType w, Just $ toExp e)]
+instance RecordTemplate
+        Record [(String, Q Type, Maybe (Q Exp))] (Q [Dec]) where
 
-instance ToType v => RecordTemplate
-        (String := v)
-        [(String, Q Type, Maybe (Q Exp))]
-        [(String, Q Type, Maybe (Q Exp))] where
-    (n := v) ~> xs = (n, toType v, Nothing) : xs
+    Record name xs ~> fs = do
+        let typeD typ = TySynD (mkName name) [] typ
 
-instance (ToType v, ToExp d) => RecordTemplate
-        (String := v := d)
-        [(String, Q Type, Maybe (Q Exp))]
-        [(String, Q Type, Maybe (Q Exp))] where
-    (n := v := d) ~> xs = (n, toType v, Just $ toExp d) : xs
+            noValue = VarE 'value
 
+            normalize (n, v, d) = do
+                v' <- v
+                d' <- maybe (return noValue) id d
+                return (n, (v', d'))
 
-instance ToType v => RecordTemplate Record (String := v) (Q [Dec]) where
-    r ~> (n := v) = r ~> [(n, toType v, Nothing :: Maybe (Q Exp))]
+        nFields <- mapM normalize fs
+                    >>= return . sortBy (compare `on` fst)
 
-instance (ToType v, ToExp d) =>
-        RecordTemplate Record (String := v := d) (Q [Dec]) where
-    r ~> (n := v := d) = r ~> [(n, toType v, Just $ toExp d)]
+        let fs' = sortBy (compare `on` fst) (concat (nFields : xs))
 
+            unify sss@(s:ss) =
+                if all id (zipWith ((==) `on` (fst . snd)) ss sss)
+                    then return $ select sss
+                    else fail $ "Types for the named field \""
+                        ++ fst s ++ "\" could not be unified."
+                        ++ "\n    The conflicting types are: \n"
+                        ++ unlines (map (show . fst . snd) sss)
 
-instance RecordTemplate
-        Record [(String, Q Type, Maybe (Q Exp))] (Q [Dec]) where
+            select (x:[]) = x
+            select (x@(_, (_, d)) : xs)
+                | d == noValue = select xs
+                | otherwise    = x
 
-    Record name ~> fs = do
-        let typeD typ = TySynD (mkName name) [] typ
+            mkDef (n, (v, d)) = do
+                name <- nameT n
+                return (AppT (AppT (ConT ''(:=)) name) v, d)
 
-            func (name, valType, defaultVal) = do
-                nameType <- nameT name
-                valueType <- valType
-                defaultValue <- maybe (return $ VarE 'value) id defaultVal
-                return $ ( AppT (AppT (ConT ''(:=)) nameType) valueType
-                         , defaultValue )
+        nFields <- mapM unify (groupBy ((==) `on` fst) fs')
+        fields  <- mapM mkDef nFields
+        rExp    <- dataToExpQ (const Nothing) nFields
 
-        fields <- mapM func
-            $ sortBy (\(x, _, _) (y, _, _) -> compare x y) fs
+        let reflD = ValD (VarP (mkName ("__" ++ name))) (NormalB rExp) []
 
-        let syn = foldr (\(x, _) xs -> AppT (AppT (ConT ''(:+)) x) xs)
+            syn = foldr (\(x, _) xs -> AppT (AppT (ConT ''(:+)) x) xs)
                         (fst $ last fields) (init fields)
 
             cName = mkName ("new" ++ name)
-
-            sigD = SigD cName (ConT (mkName name))
-
+            sigD  = SigD cName (ConT (mkName name))
             funcD = ValD (VarP cName) (NormalB funcB) []
             funcB = foldr join (field $ last fields) (init fields)
               where
                 join x xs = InfixE (Just $ field x) (ConE '(:+)) (Just xs)
-
-            field (_, x) = InfixE (Just (VarE '_type))
-                             (ConE '(:=))
-                             (Just x)
+                field (_, x) = InfixE (Just (VarE '_type))
+                                      (ConE '(:=))
+                                      (Just x)
 
-        return [typeD syn, sigD, funcD]
+        return [typeD syn, sigD, funcD, reflD]
 
 
 _type = error $ "NamedRecord field type unwrapped!"
@@ -301,5 +367,44 @@
 
 infixr 1 ~>
 infixr 1 `has`
+
+
+class RecordExtends a where
+    (<:) :: Record -> a -> Record
+
+instance RecordExtends [(String, (Type, Exp))] where
+    Record name xs <: x = Record name (x:xs)
+
+extends :: RecordExtends a => Record -> a -> Record
+extends = (<:)
+
+infixl 2 <:
+infixl 2 `extends`
+
+
+data Record = Record String [[(String, (Type, Exp))]]
+
+record :: String -> Record
+record name = Record name []
+
+
+-- Playground below
+
+fieldNames :: FieldNames a => a -> [String]
+fieldNames = _fieldNames []
+
+
+class FieldNames a where
+    _fieldNames :: [String] -> a -> [String]
+
+instance (Show n, FieldNames r) =>
+        FieldNames (n := ns :+ r) where
+
+    _fieldNames xs (n := _ :+ r) = _fieldNames (show n : xs) r
+
+instance (Show n) => FieldNames (n := ns) where
+
+    _fieldNames xs (n := _) = show n : xs
+