diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs
index 169c4d1a6..7ddd26625 100644
--- a/src/Text/Pandoc/Definition.hs
+++ b/src/Text/Pandoc/Definition.hs
@@ -33,19 +33,19 @@ module Text.Pandoc.Definition where
 
 import Data.Generics
 
-data Pandoc = Pandoc Meta [Block] deriving (Eq, Read, Show, Typeable, Data)
+data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data)
 
 -- | Bibliographic information for the document:  title, authors, date.
 data Meta = Meta { docTitle   :: [Inline]
                  , docAuthors :: [[Inline]]
                  , docDate    :: [Inline] }
-            deriving (Eq, Show, Read, Typeable, Data)
+            deriving (Eq, Ord, Show, Read, Typeable, Data)
 
 -- | Alignment of a table column.
 data Alignment = AlignLeft 
                | AlignRight 
                | AlignCenter 
-               | AlignDefault deriving (Eq, Show, Read, Typeable, Data)
+               | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data)
 
 -- | List attributes.
 type ListAttributes = (Int, ListNumberStyle, ListNumberDelim)
@@ -56,13 +56,13 @@ data ListNumberStyle = DefaultStyle
                      | LowerRoman 
                      | UpperRoman
                      | LowerAlpha 
-                     | UpperAlpha deriving (Eq, Show, Read, Typeable, Data)
+                     | UpperAlpha deriving (Eq, Ord, Show, Read, Typeable, Data)
 
 -- | Delimiter of list numbers.
 data ListNumberDelim = DefaultDelim
                      | Period
                      | OneParen 
-                     | TwoParens deriving (Eq, Show, Read, Typeable, Data)
+                     | TwoParens deriving (Eq, Ord, Show, Read, Typeable, Data)
 
 -- | Attributes: identifier, classes, key-value pairs
 type Attr = (String, [String], [(String, String)])
@@ -90,16 +90,16 @@ data Block
                             -- column headers (each a list of blocks), and
                             -- rows (each a list of lists of blocks)
     | Null                  -- ^ Nothing
-    deriving (Eq, Read, Show, Typeable, Data)
+    deriving (Eq, Ord, Read, Show, Typeable, Data)
 
 -- | Type of quotation marks to use in Quoted inline.
-data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Read, Typeable, Data)
+data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Ord, Read, Typeable, Data)
 
 -- | Link target (URL, title).
 type Target = (String, String)
 
 -- | Type of math element (display or inline).
-data MathType = DisplayMath | InlineMath deriving (Show, Eq, Read, Typeable, Data)
+data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data)
 
 -- | Inline elements.
 data Inline 
@@ -126,7 +126,7 @@ data Inline
     | Image [Inline] Target -- ^ Image:  alt text (list of inlines), target
                             -- and target
     | Note [Block]          -- ^ Footnote or endnote 
-    deriving (Show, Eq, Read, Typeable, Data)
+    deriving (Show, Eq, Ord, Read, Typeable, Data)
 
 -- | Applies a transformation on @a@s to matching elements in a @b@.
 processWith :: (Data a, Data b) => (a -> a) -> b -> b
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index bc8e7cd43..a6d383fca 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -32,6 +32,7 @@ module Text.Pandoc.Readers.Markdown (
                                     ) where
 
 import Data.List ( transpose, isSuffixOf, sortBy, findIndex, intercalate )
+import qualified Data.Map as M
 import Data.Ord ( comparing )
 import Data.Char ( isAlphaNum )
 import Data.Maybe
@@ -202,10 +203,10 @@ referenceKey = try $ do
   tit <- option "" referenceTitle
   blanklines
   endPos <- getPosition
-  let newkey = (lab, (escapeURI $ removeTrailingSpace src,  tit))
+  let target = (escapeURI $ removeTrailingSpace src,  tit)
   st <- getState
   let oldkeys = stateKeys st
-  updateState $ \s -> s { stateKeys = newkey : oldkeys }
+  updateState $ \s -> s { stateKeys = M.insert (Key lab) target oldkeys }
   -- return blanks so line count isn't affected
   return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
 
@@ -1216,7 +1217,7 @@ referenceLink lab = do
                          optional (newline >> skipSpaces) >> reference))
   let ref' = if null ref then lab else ref
   state <- getState
-  case lookupKeySrc (stateKeys state) ref' of
+  case lookupKeySrc (stateKeys state) (Key ref') of
      Nothing     -> fail "no corresponding key" 
      Just target -> return target 
 
@@ -1301,7 +1302,7 @@ inlineCitation = try $ do
 chkCit :: Target -> GenParser Char ParserState (Maybe Target)
 chkCit t = do
   st <- getState
-  case lookupKeySrc (stateKeys st) [Str $ fst t] of
+  case lookupKeySrc (stateKeys st) (Key [Str $ fst t]) of
      Just  _ -> fail "This is a link"
      Nothing -> if elem (fst t) $ stateCitations st
                    then return $ Just t
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 5e7ea512e..7b4b5eee8 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -34,7 +34,9 @@ import Text.Pandoc.Definition
 import Text.Pandoc.Shared 
 import Text.ParserCombinators.Parsec
 import Control.Monad ( when, unless, liftM )
-import Data.List ( findIndex, delete, intercalate, transpose )
+import Data.List ( findIndex, intercalate, transpose, sort )
+import qualified Data.Map as M
+import Text.Printf ( printf )
 
 -- | Parse reStructuredText string and return Pandoc document.
 readRST :: ParserState -- ^ Parser state, including options for parser
@@ -93,9 +95,6 @@ parseRST = do
   docMinusKeys <- manyTill (referenceKey <|> lineClump) eof >>= return . concat
   setInput docMinusKeys
   setPosition startPos
-  st <- getState
-  let reversedKeys = stateKeys st
-  updateState $ \s -> s { stateKeys = reverse reversedKeys }
   -- now parse it for real...
   blocks <- parseBlocks 
   let blocks' = filter (/= Null) blocks
@@ -540,10 +539,10 @@ referenceName = quotedReferenceName <|>
 referenceKey :: GenParser Char ParserState [Char]
 referenceKey = do
   startPos <- getPosition
-  key <- choice [imageKey, anonymousKey, regularKey]
+  (key, target) <- choice [imageKey, anonymousKey, regularKey]
   st <- getState
   let oldkeys = stateKeys st
-  updateState $ \s -> s { stateKeys = key : oldkeys }
+  updateState $ \s -> s { stateKeys = M.insert key target oldkeys }
   optional blanklines
   endPos <- getPosition
   -- return enough blanks to replace key
@@ -558,28 +557,29 @@ targetURI = do
   blanklines
   return $ escapeURI $ removeLeadingTrailingSpace $ contents
 
-imageKey :: GenParser Char ParserState ([Inline], (String, [Char]))
+imageKey :: GenParser Char ParserState (Key, Target)
 imageKey = try $ do
   string ".. |"
   ref <- manyTill inline (char '|')
   skipSpaces
   string "image::"
   src <- targetURI
-  return (normalizeSpaces ref, (src, ""))
+  return (Key (normalizeSpaces ref), (src, ""))
 
-anonymousKey :: GenParser Char st ([Inline], (String, [Char]))
+anonymousKey :: GenParser Char st (Key, Target)
 anonymousKey = try $ do
   oneOfStrings [".. __:", "__"]
   src <- targetURI
-  return ([Str "_"], (src, ""))
+  pos <- getPosition
+  return (Key [Str $ "_" ++ printf "%09d" (sourceLine pos)], (src, ""))
 
-regularKey :: GenParser Char ParserState ([Inline], (String, [Char]))
+regularKey :: GenParser Char ParserState (Key, Target)
 regularKey = try $ do
   string ".. _"
   ref <- referenceName
   char ':'
   src <- targetURI
-  return (normalizeSpaces ref, (src, ""))
+  return (Key (normalizeSpaces ref), (src, ""))
 
 --
 -- tables
@@ -889,17 +889,21 @@ explicitLink = try $ do
 referenceLink :: GenParser Char ParserState Inline
 referenceLink = try $ do
   label' <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_'
-  key <- option label' (do{char '_'; return [Str "_"]}) -- anonymous link
   state <- getState
   let keyTable = stateKeys state
+  let isAnonKey (Key [Str ('_':_)]) = True
+      isAnonKey _ = False
+  key <- option (Key label') $
+                do char '_'
+                   let anonKeys = sort $ filter isAnonKey $ M.keys keyTable
+                   if null anonKeys
+                      then pzero
+                      else return (head anonKeys)
   (src,tit) <- case lookupKeySrc keyTable key of
                     Nothing     -> fail "no corresponding key"
                     Just target -> return target
-  -- if anonymous link, remove first anon key so it won't be used again
-  let keyTable' = if (key == [Str "_"]) -- anonymous link? 
-                    then delete ([Str "_"], (src,tit)) keyTable -- remove first anon key 
-                    else keyTable                    
-  setState $ state { stateKeys = keyTable' }
+  -- if anonymous link, remove key so it won't be used again
+  when (isAnonKey key) $ updateState $ \s -> s{ stateKeys = M.delete key keyTable }
   return $ Link (normalizeSpaces label') (src, tit) 
 
 autoURI :: GenParser Char ParserState Inline
@@ -922,7 +926,7 @@ image = try $ do
   ref <- manyTill inline (char '|')
   state <- getState
   let keyTable = stateKeys state
-  (src,tit) <- case lookupKeySrc keyTable ref of
+  (src,tit) <- case lookupKeySrc keyTable (Key ref) of
                      Nothing     -> fail "no corresponding key"
                      Just target -> return target
   return $ Image (normalizeSpaces ref) (src, tit)
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index c43839d40..88eccb96c 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -88,6 +88,7 @@ module Text.Pandoc.Shared (
                      QuoteContext (..),
                      NoteTable,
                      KeyTable,
+                     Key (..),
                      lookupKeySrc,
                      refsMatch,
                      -- * Prettyprinting
@@ -127,6 +128,7 @@ import System.FilePath ( (</>) )
 import Data.Generics (Typeable, Data)
 import qualified Control.Monad.State as S
 import Control.Monad (join)
+import qualified Data.Map as M
 import Paths_pandoc (getDataFileName)
 
 --
@@ -704,7 +706,7 @@ defaultParserState =
                   stateParserContext   = NullState,
                   stateQuoteContext    = NoQuote,
                   stateSanitizeHTML    = False,
-                  stateKeys            = [],
+                  stateKeys            = M.empty,
 #ifdef _CITEPROC
                   stateCitations       = [],
 #endif
@@ -739,15 +741,23 @@ data QuoteContext
 
 type NoteTable = [(String, String)]
 
-type KeyTable = [([Inline], Target)]
+newtype Key = Key [Inline] deriving (Show, Read)
+
+instance Eq Key where
+  Key a == Key b = refsMatch a b
+
+instance Ord Key where
+  compare (Key a) (Key b) = if a == b then EQ else compare a b
+
+type KeyTable = M.Map Key Target
 
 -- | Look up key in key table and return target object.
 lookupKeySrc :: KeyTable  -- ^ Key table
-             -> [Inline]  -- ^ Key
+             -> Key       -- ^ Key
              -> Maybe Target
-lookupKeySrc table key = case find (refsMatch key . fst) table of
-                           Nothing       -> Nothing
-                           Just (_, src) -> Just src
+lookupKeySrc table key = case M.lookup key table of
+                           Nothing  -> Nothing
+                           Just src -> Just src
 
 -- | Returns @True@ if keys match (case insensitive).
 refsMatch :: [Inline] -> [Inline] -> Bool
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index fe8e0c2de..d6876d239 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -40,7 +40,7 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )
 import Control.Monad.State
 
 type Notes = [[Block]]
-type Refs = KeyTable
+type Refs = [([Inline], Target)]
 data WriterState = WriterState { stNotes :: Notes
                                , stRefs :: Refs
                                , stPlain :: Bool }
@@ -94,7 +94,7 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
   st <- get
   notes' <- notesToMarkdown opts (reverse $ stNotes st)
   st' <- get  -- note that the notes may contain refs
-  refs' <- keyTableToMarkdown opts (reverse $ stRefs st')
+  refs' <- refsToMarkdown opts (reverse $ stRefs st')
   let main = render $ body $+$ text "" $+$ notes' $+$ text "" $+$ refs'
   let context  = writerVariables opts ++
                  [ ("toc", render toc)
@@ -109,8 +109,8 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
      else return main
 
 -- | Return markdown representation of reference key table.
-keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc
-keyTableToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
+refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc
+refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
  
 -- | Return markdown representation of a reference key. 
 keyToMarkdown :: WriterOptions 
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index f4dfb2aa6..680ec7749 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -39,10 +39,12 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )
 import Control.Monad.State
 import Control.Applicative ( (<$>) )
 
+type Refs = [([Inline], Target)]
+
 data WriterState = 
   WriterState { stNotes     :: [[Block]]
-              , stLinks     :: KeyTable
-              , stImages    :: KeyTable
+              , stLinks     :: Refs
+              , stImages    :: Refs
               , stHasMath   :: Bool
               , stOptions   :: WriterOptions
               }
@@ -65,8 +67,8 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
   body <- blockListToRST blocks
   notes <- liftM (reverse . stNotes) get >>= notesToRST
   -- note that the notes may contain refs, so we do them first
-  refs <- liftM (reverse . stLinks) get >>= keyTableToRST
-  pics <- liftM (reverse . stImages) get >>= pictTableToRST
+  refs <- liftM (reverse . stLinks) get >>= refsToRST
+  pics <- liftM (reverse . stImages) get >>= pictRefsToRST
   hasMath <- liftM stHasMath get
   let main = render $ body $+$ notes $+$ text "" $+$ refs $+$ pics
   let context = writerVariables opts ++
@@ -80,8 +82,8 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
      else return main
 
 -- | Return RST representation of reference key table.
-keyTableToRST :: KeyTable -> State WriterState Doc
-keyTableToRST refs = mapM keyToRST refs >>= return . vcat
+refsToRST :: Refs -> State WriterState Doc
+refsToRST refs = mapM keyToRST refs >>= return . vcat
  
 -- | Return RST representation of a reference key. 
 keyToRST :: ([Inline], (String, String)) 
@@ -107,8 +109,8 @@ noteToRST num note = do
   return $ marker $$ nest 3 contents
 
 -- | Return RST representation of picture reference table.
-pictTableToRST :: KeyTable -> State WriterState Doc
-pictTableToRST refs = mapM pictToRST refs >>= return . vcat
+pictRefsToRST :: Refs -> State WriterState Doc
+pictRefsToRST refs = mapM pictToRST refs >>= return . vcat
  
 -- | Return RST representation of a picture substitution reference. 
 pictToRST :: ([Inline], (String, String))