-- like name map, but able to return ambiguous namesmodule Data.ANameMap import Core.Nameimport Data.NameMapimport Data.StringMap exportrecord ANameMap a where     constructor MkANameMap     -- for looking up by exact (completely qualified) names     exactNames : NameMap a     -- for looking up by name root or partially qualified (so possibly     -- ambiguous) names. This doesn't store machine generated names.     hierarchy : StringMap (List (Name, a)) exportempty : ANameMap aempty = MkANameMap empty empty ||| Given a Name, and an ANameMap, look up that name exactlyexportlookupExact : Name -> ANameMap a -> Maybe alookupExact n dict = lookup n (exactNames dict) exportlookupName : Name -> ANameMap a -> List (Name, a)lookupName n dict    = case userNameRoot n of           Nothing => case lookupExact n dict of                           Nothing => []                           Just res => [(n, res)]           Just r => case lookup r (hierarchy dict) of                          Nothing => []                          Just ns => filter (matches n) ns	where		-- Name matches if a prefix of the namespace matches a prefix of the    -- namespace in the context    matches : Name -> (Name, a) -> Bool    matches (NS ns _) (NS cns _, _) = ns `isPrefixOf` cns    matches (NS _ _) _ = True -- no in library name, so root doesn't match    matches _ _ = True -- no prefix, so root must match, so good addToHier : Name -> a ->						StringMap (List (Name, a)) -> StringMap (List (Name, a))addToHier n val hier     -- Only add user defined names. Machine generated names can only be		 -- found with the exactNames     = case userNameRoot n of            Nothing => hier            Just root =>                 case lookup root hier of                      Nothing => insert root [(n, val)] hier                      Just ns => insert root (update val ns) hier  where    update : a -> List (Name, a) -> List (Name, a)    update val [] = [(n, val)]    update val (old :: xs)		    = if n == fst old					   then (n, val) :: xs						 else old :: update val xs exportaddName : Name -> a -> ANameMap a -> ANameMap aaddName n val (MkANameMap dict hier)     = let dict' = insert n val dict           hier' = addToHier n val hier in           MkANameMap dict' hier' exporttoList : ANameMap a -> List (Name, a)toList dict = toList (exactNames dict) exportfromList : List (Name, a) -> ANameMap afromList = fromList' empty  where    fromList' : ANameMap a -> List (Name, a) -> ANameMap a    fromList' acc [] = acc    fromList' acc ((k, v) :: ns) = fromList' (addName k v acc) ns -- Merge two contexts, with entries in the second overriding entries in-- the firstexportmerge : ANameMap a -> ANameMap a -> ANameMap amerge ctxt (MkANameMap exact hier)    = insertFrom (toList exact) ctxt  where    insertFrom : List (Name, a) -> ANameMap a -> ANameMap a    insertFrom [] ctxt = ctxt    insertFrom ((n, val) :: cs) ctxt        = insertFrom cs (addName n val ctxt) -- TODO: Update namespaces so 'as' worksexportmergeAs : List String -> List String ->          ANameMap a -> ANameMap a -> ANameMap amergeAs oldns newns ctxt (MkANameMap exact hier)    = insertFrom (toList exact) ctxt  where    insertFrom : List (Name, a) -> ANameMap a -> ANameMap a    insertFrom [] ctxt = ctxt    insertFrom ((n, val) :: cs) ctxt        = insertFrom cs (addName n val ctxt)