{-# OPTIONS_GHC -fglasgow-exts -fno-warn-unused-imports -fallow-undecidable-instances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Trie.General.ListGT
-- Copyright   :  (c) Adrian Hey 2007
-- License     :  BSD3
--
-- Maintainer  :  http://homepages.nildram.co.uk/~ahey/em.png
-- Stability   :  provisional
-- Portability :  Multi-parameter type classes, Functional dependencies
--
-- A 'GT' instance for keys of type @GT map k => [k]@
--
-- If a key type is an instance of GT then so is a 'List' of those keys.
-----------------------------------------------------------------------------
module Data.Trie.General.ListGT
(-- * ListGT type
 ListGT

 -- * Standard GT API for ListGTs
 -- | These functions all have the same names as the corresponding GT class methods,
 -- but with the \"ListGT\" suffix.
,emptyListGT
,singletonListGT
,fromAssocsAscendingListGT
,fromAssocsDescendingListGT
,fromAssocsAscendingLListGT
,fromAssocsDescendingLListGT
,pairListGT
,isEmptyListGT
,isSingletonListGT
,nonEmptyListGT
,statusListGT
,addSizeListGT
,lookupListGT
,lookupContListGT
,insertListGT
,insertListGT'
,insertListGT''
,insertMaybeListGT
,insertMaybeListGT'
,deleteListGT
,deleteMaybeListGT
,alterListGT
,unionListGT
,unionListGT'
,unionMaybeListGT
,intersectionListGT
,intersectionListGT'
,intersectionMaybeListGT
,differenceListGT
,differenceMaybeListGT
,isSubsetOfListGT
,isSubmapOfListGT
,mapListGT
,mapListGT'
,mapMaybeListGT
,mapWithKeyListGT
,mapWithKeyListGT'
,filterListGT
,foldrElemsAscendingListGT
,foldrElemsDescendingListGT
,foldrKeysAscendingListGT
,foldrKeysDescendingListGT
,foldrAssocsAscendingListGT
,foldrAssocsDescendingListGT
,foldrElemsAscendingListGT'
,foldrElemsDescendingListGT'
,foldrKeysAscendingListGT'
,foldrKeysDescendingListGT'
,foldrAssocsAscendingListGT'
,foldrAssocsDescendingListGT'
,foldElemsUINTListGT
,validListGT
) where

{- ToDo:
Implement properly:
 fromAssocsAscendingListGT,fromAssocsDescendingListGT
 fromAssocsAscendingLListGT,fromAssocsDescendingLListGT
-}

import Prelude hiding (foldr,map,filter,lookup)
import Data.Trie.General.Types

import qualified Data.Monoid as M (Monoid(..))
import qualified Data.Foldable as F (Foldable(..))
import Data.Typeable
-- -fno-warn-unused-imports used because ghc currently gives spurious warning with this import
-- See Tickets 1074 and 1148
import qualified Data.List as L (foldr,foldl')

#ifdef __GLASGOW_HASKELL__
import GHC.Base hiding (map)
import qualified Text.Read as R (Read(..),Lexeme(..),parens,prec,lexP,readListPrecDefault)
#include "ghcdefs.h"
#else
#include "h98defs.h"
#endif

--------------------------------------------------------------------------------------------
--                     GT Type for lists and various helper functions                     --
--------------------------------------------------------------------------------------------

-- | The 'GT' type for keys of form @'GT' map k => [k]@.
data ListGT map k a
 = Empt                                  -- Empty special, never appears in non-empty ListGT!
 | BraF ![k] a !(map (ListGT map k a))   -- Full branch, tail map may be empty or singleton
 | BraE ![k]   !(map (ListGT map k a))   -- Empty branch, no empty or singletons allowed.

-- Invariants are:
-- * Tail maps must not contain 'Empt' ListGT elements.
-- * The tail map of a 'BraE' node must contain at least 2 entries.
--   (Empty and singleton tail maps are degenerate cases which are normalised appropriately.)
-- Smart constructor for BraE. Ensures tail is not empty or singleton map.
braE :: GT map k => [k] -> map (ListGT map k a) -> ListGT map k a
braE ks mp = case status mp of
             None                   -> Empt
             One _  Empt            -> error "braE: Empty ListGT in tail map."
             One k (BraF ks' a mp') -> BraF (ks ++ k:ks') a mp'
             One k (BraE ks'   mp') -> BraE (ks ++ k:ks')   mp'
             Many                   -> BraE ks mp

-- | ListGT is an instance of GT.
instance GT map k => GT (ListGT map k) [k] where
 empty                 = emptyListGT
 singleton             = singletonListGT
 fromAssocsAscending   = fromAssocsAscendingListGT
 fromAssocsDescending  = fromAssocsDescendingListGT
 fromAssocsAscendingL  = fromAssocsAscendingLListGT
 fromAssocsDescendingL = fromAssocsDescendingLListGT
 pair                  = pairListGT
 isEmpty               = isEmptyListGT
 isSingleton           = isSingletonListGT
 nonEmpty              = nonEmptyListGT
 status                = statusListGT
 addSize               = addSizeListGT
 lookup                = lookupListGT
 lookupCont            = lookupContListGT
 insert                = insertListGT
 insert'               = insertListGT'
 insert''              = insertListGT''
 insertMaybe           = insertMaybeListGT
 insertMaybe'          = insertMaybeListGT'
 delete                = deleteListGT
 deleteMaybe           = deleteMaybeListGT
 alter                 = alterListGT
 union                 = unionListGT
 union'                = unionListGT'
 unionMaybe            = unionMaybeListGT
 intersection          = intersectionListGT
 intersection'         = intersectionListGT'
 intersectionMaybe     = intersectionMaybeListGT
 difference            = differenceListGT
 differenceMaybe       = differenceMaybeListGT
 isSubsetOf            = isSubsetOfListGT
 isSubmapOf            = isSubmapOfListGT
 map                   = mapListGT
 map'                  = mapListGT'
 mapMaybe              = mapMaybeListGT
 mapWithKey            = mapWithKeyListGT
 mapWithKey'           = mapWithKeyListGT'
 filter                = filterListGT
 foldrElemsAscending   = foldrElemsAscendingListGT
 foldrElemsDescending  = foldrElemsDescendingListGT
 foldrKeysAscending    = foldrKeysAscendingListGT
 foldrKeysDescending   = foldrKeysDescendingListGT
 foldrAssocsAscending  = foldrAssocsAscendingListGT
 foldrAssocsDescending = foldrAssocsDescendingListGT
 foldrElemsAscending'  = foldrElemsAscendingListGT'
 foldrElemsDescending' = foldrElemsDescendingListGT'
 foldrKeysAscending'   = foldrKeysAscendingListGT'
 foldrKeysDescending'  = foldrKeysDescendingListGT'
 foldrAssocsAscending' = foldrAssocsAscendingListGT'
 foldrAssocsDescending'= foldrAssocsDescendingListGT'
 foldElemsUINT         = foldElemsUINTListGT
 valid                 = validListGT

-- Strict ++
infixr 5 +!+
(+!+) :: [a] -> [a] -> [a]
[]     +!+ ys = ys
(x:xs) +!+ ys = let xs' = xs +!+ ys in xs' `seq` x:xs'
{- (not used currently)
xs +!+ [] = xs
xs +!+ ys = f xs where f []      = ys
                       f (x:xs') = let xs'' = f xs' in xs'' `seq` x:xs''
-}

-- Local Utility for reverse join: revTo xs ys = (reverse xs) ++ ys
revTo :: [a] -> [a] -> [a]
revTo []     ys = ys
revTo (x:xs) ys = revTo xs (x:ys)

-- Take the first N elements of a list.
-- Gives an error if list is not long enough to do this!
takeN :: UINT -> [k] -> [k]
takeN L(0) _      = []
takeN _    []     = error "Data.Trie.General.ListGT.takeN: List is too short."
takeN n    (k:ks) = let ks_ = takeN DECINT1(n) ks in ks_ `seq` k:ks_

-- Return type of the match function
-- Do we need the UINT in Sfx and Sfy constructors ??
data Match map k a =
   Mat                    -- Input lists match and have same length (I.E. they are identical)
 | Frk UINT (ListGT map k a -> ListGT map k a -> map (ListGT map k a)) [k] [k]       -- n f xs ys
 | Sfx UINT k [k]         -- Input lists match but xs has remaining non-empty suffix -- n x xs
 | Sfy UINT k [k]         -- Input lists match but ys has remaining non-empty suffix -- n y ys
-- Try to match two lists of keys
match :: GT map k => [k] -> [k] -> Match map k a
match xs0 ys0 = m L(0) xs0 ys0
 where m _ []     []     = Mat
       m n []     (y:ys) = Sfy n y ys
       m n (x:xs) []     = Sfx n x xs
       m n (x:xs) (y:ys) = case pair x y of
                           Just f  -> Frk n f xs ys
                           Nothing -> m INCINT1(n) xs ys   -- x == y

-- Common error message associated with (supposedly) sorted associations lists.
-- Can be caused by: Improper sorting (including duplicate keys)
--                   Incorrect lengths
badAssocs :: String
badAssocs = "Data.Trie.General.ListGT: Bad sorted association List."
--------------------------------------------------------------------------------------------

-- | See 'GT' class method 'empty'.
emptyListGT :: ListGT map k a
emptyListGT = Empt
{-# INLINE emptyListGT #-}

-- | See 'GT' class method 'singleton'.
singletonListGT :: GT map k => [k] -> a -> ListGT map k a
singletonListGT ks a = BraF ks a empty
{-# INLINE singletonListGT #-}

-- | See 'GT' class method 'fromAssocsAscending'.
fromAssocsAscendingListGT :: GT map k => [([k],a)] -> ListGT map k a
fromAssocsAscendingListGT assocs = L.foldl' ins emptyListGT assocs -- Temporary Hack!!
 where ins mp (ks,a) = insertListGT (\_ -> error badAssocs) ks a mp

-- | See 'GT' class method 'fromAssocsDescending'.
fromAssocsDescendingListGT :: GT map k => [([k],a)] -> ListGT map k a
fromAssocsDescendingListGT assocs = L.foldl' ins emptyListGT assocs -- Temporary Hack!!
 where ins mp (ks,a) = insertListGT (\_ -> error badAssocs) ks a mp

-- | See 'GT' class method 'fromAssocsAscendingL'.
-- N.B. This function is no faster than 'fromAssocsAscendingListGT' (length is not needed).
fromAssocsAscendingLListGT :: GT map k => Int -> [([k],a)] -> ListGT map k a
fromAssocsAscendingLListGT _ assocs = fromAssocsAscendingListGT assocs -- Temporary Hack!!

-- | See 'GT' class method 'fromAssocsDescendingL'.
-- N.B. This function is no faster than 'fromAssocsDescendingListGT' (length is not needed).
fromAssocsDescendingLListGT :: GT map k => Int -> [([k],a)] -> ListGT map k a
fromAssocsDescendingLListGT _ assocs = fromAssocsDescendingListGT assocs -- Temporary Hack!!

-- | See 'GT' class method 'pair'.
pairListGT :: GT map k => [k] -> [k] -> Maybe (a -> a -> ListGT map k a)
pairListGT xs0 ys0 = pr L(0) xs0 ys0 where
 pr _ []     []     = Nothing
 pr _ []     (y:ys) = Just (\ax ay -> BraF xs0 ax (singleton y (BraF ys ay empty)))
 pr _ (x:xs) []     = Just (\ax ay -> BraF ys0 ay (singleton x (BraF xs ax empty)))
 pr n (x:xs) (y:ys) = case pair x y of
                      Just f  -> Just (\ax ay -> BraE (takeN n xs0) (f (BraF xs ax empty) (BraF ys ay empty)))
                      Nothing -> pr INCINT1(n) xs ys

-- | See 'GT' class method 'isEmpty'.
isEmptyListGT :: ListGT map k a -> Bool
isEmptyListGT Empt = True
isEmptyListGT _    = False
{-# INLINE isEmptyListGT #-}

-- | See 'GT' class method 'isSingleton'.
isSingletonListGT :: GT map k => ListGT map k a -> Bool
isSingletonListGT  Empt         = False
isSingletonListGT (BraF _ _ mp) = isEmpty mp
isSingletonListGT (BraE _   _ ) = False
{-# INLINE isSingletonListGT #-}

-- | See 'GT' class method 'nonEmpty'.
nonEmptyListGT :: ListGT map k a -> Maybe (ListGT map k a)
nonEmptyListGT Empt = Nothing
nonEmptyListGT lgt  = Just lgt
{-# INLINE nonEmptyListGT #-}

-- | See 'GT' class method 'status'.
statusListGT :: GT map k => ListGT map k a -> Status [k] a
statusListGT  Empt          = None
statusListGT (BraF ks a mp) = if (isEmpty mp) then (One ks a) else Many
statusListGT (BraE _    _ ) = Many
{-# INLINE statusListGT #-}

-- | See 'GT' class method 'addSize'.
addSizeListGT :: GT map k => ListGT map k a -> UINT -> UINT
addSizeListGT  Empt         n = n
addSizeListGT (BraF _ _ mp) n = foldElemsUINT addSizeListGT mp INCINT1(n)
addSizeListGT (BraE _   mp) n = foldElemsUINT addSizeListGT mp n

-- | See 'GT' class method 'lookup'.
lookupListGT :: GT map k => [k] -> ListGT map k a -> Maybe a
lookupListGT ks0 lgt0 = lmb ks0 lgt0 where
 lmb _ Empt = Nothing
------------------------------
 lmb ks (BraF ks' a mp) = pre ks ks' where
  pre []     []     = Just a
  pre []     (_:_ ) = Nothing
  pre (x:xs) []     = case lookup x mp of
                      Just lgt -> lmb xs lgt
                      Nothing  -> Nothing
  pre (x:xs) (y:ys) = if x == y then pre xs ys else Nothing
------------------------------
 lmb ks (BraE ks' mp) = pre ks ks' where
  pre []     _      = Nothing
  pre (x:xs) []     = case lookup x mp of
                      Just lgt -> lmb xs lgt
                      Nothing  -> Nothing
  pre (x:xs) (y:ys) = if x == y then pre xs ys else Nothing
------------------------------

-- | See 'GT' class method 'lookupCont'.
lookupContListGT :: GT map k => (a -> Maybe b) -> [k] -> ListGT map k a -> Maybe b
-- Convention below is xs is the search key list and ys is the key list fragment from the Trie (ListGT)
lookupContListGT j ks0 lgt0 = lmb ks0 lgt0 where
 lmb _ Empt = Nothing
------------------------------
 lmb ks (BraF ks' a mp) = pre ks ks' where
  pre []     []     = j a
  pre []     (_:_ ) = Nothing
  pre (x:xs) []     = lookupCont (lmb xs) x mp
  pre (x:xs) (y:ys) = if x == y then pre xs ys else Nothing
------------------------------
 lmb ks (BraE ks' mp) = pre ks ks' where
  pre []     _      = Nothing
  pre (x:xs) []     = lookupCont (lmb xs) x mp
  pre (x:xs) (y:ys) = if x == y then pre xs ys else Nothing
------------------------------

-- | See 'GT' class method 'delete'.
deleteListGT :: GT map k => [k] -> ListGT map k a -> ListGT map k a
deleteListGT = deleteMaybeListGT (const Nothing)
{-# INLINE deleteListGT #-}

-- | See 'GT' class method 'deleteMaybe'.
deleteMaybeListGT :: GT map k => (a -> Maybe a) -> [k] -> ListGT map k a -> ListGT map k a
-- Convention below is xs is the search key list and ys is the key list fragment from the Trie (ListGT)
deleteMaybeListGT f ks0 lgt0 = dmb ks0 lgt0 where
 dmb _ Empt = Empt
------------------------------
 dmb ks bf@(BraF ks' a mp) = pre ks ks' where
  pre []     []     = case f a of Just a' -> BraF  ks' a' mp
                                  Nothing -> braE  ks'    mp
  pre []     (_:_ ) = bf
  pre (x:xs) []     = BraF ks' a (deleteMaybe (\lgt -> nonEmptyListGT (dmb xs lgt)) x mp)
  pre (x:xs) (y:ys) = if x == y then pre xs ys else bf
------------------------------
 dmb ks be@(BraE ks' mp) = pre ks ks' where
  pre []     _      = be
  pre (x:xs) []     = braE ks' (deleteMaybe (\lgt -> nonEmptyListGT (dmb xs lgt)) x mp)
  pre (x:xs) (y:ys) = if x == y then pre xs ys else be
------------------------------

-- | See 'GT' class method 'alter'.
alterListGT :: GT map k => (Maybe a -> Maybe a) -> [k] -> ListGT map k a -> ListGT map k a
-- N.B. One day we will have a more efficient implementation of this
alterListGT f k mp = case lookupListGT k mp of
                     j@(Just _) -> case f j of
                                   Just a  -> insertListGT' (const a) k a mp
                                   Nothing -> deleteListGT k mp
                     Nothing    -> case f Nothing of
                                   Just a  -> insertListGT' (const a) k a mp
                                   Nothing -> mp

-- |  See 'GT' class method 'union'.
unionListGT ::  GT map k => (a -> a -> a) -> ListGT map k a -> ListGT map k a -> ListGT map k a
unionListGT f lgt0 lgt1 = u lgt0 lgt1 where
 u Empt lgt  = lgt
 u lgt  Empt = lgt
------------------------------------------
 u (BraF xs0 ax mpx) (BraF ys0 ay mpy) = case match xs0 ys0 of
  Mat            -> BraF xs0 (f ax ay) (union' u mpx mpy) -- N.B. Use of strict union'
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraF xs ax mpx) (BraF ys ay mpy))
  Sfx _ x xs     -> BraF ys0 ay (insert' f' x braFx mpy) -- N.B. Use of strict insert'
                    where f' lgt = u braFx lgt
                          braFx  = BraF xs ax mpx
  Sfy _ y ys     -> BraF xs0 ax (insert' f' y braFy mpx) -- N.B. Use of strict insert'
                    where f' lgt = u lgt braFy
                          braFy  = BraF ys ay mpy
------------------------------------------
 u (BraF xs0 ax mpx) (BraE ys0 mpy) = case match xs0 ys0 of
  Mat            -> BraF xs0 ax (union' u mpx mpy) -- N.B. Use of strict union'
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraF xs ax mpx) (BraE ys mpy))
  Sfx _ x xs     -> BraE ys0 (insert' f' x braFx mpy) -- N.B. Use of strict insert'
                    where f' lgt = u braFx lgt
                          braFx  = BraF xs ax mpx
  Sfy _ y ys     -> BraF xs0 ax (insert' f' y braEy mpx) -- N.B. Use of strict insert'
                    where f' lgt = u lgt braEy
                          braEy  = BraE ys mpy
------------------------------------------
 u (BraE xs0 mpx) (BraF ys0 ay mpy) = case match xs0 ys0 of
  Mat            -> BraF xs0 ay (union' u mpx mpy) -- N.B. Use of strict union'
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraE xs mpx) (BraF ys ay mpy))
  Sfx _ x xs     -> BraF ys0 ay (insert' f' x braEx mpy) -- N.B. Use of strict insert'
                    where f' lgt = u braEx lgt
                          braEx  = BraE xs mpx
  Sfy _ y ys     -> BraE xs0 (insert' f' y braFy mpx) -- N.B. Use of strict insert'
                    where f' lgt = u lgt braFy
                          braFy  = BraF ys ay mpy
------------------------------------------
 u (BraE xs0 mpx) (BraE ys0 mpy) = case match xs0 ys0 of
  Mat            -> BraE xs0 (union' u mpx mpy) -- N.B. Use of strict union'
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraE xs mpx) (BraE ys mpy))
  Sfx _ x xs     -> BraE ys0 (insert' f' x braEx mpy) -- N.B. Use of strict insert'
                    where f' lgt = u braEx lgt
                          braEx  = BraE xs mpx
  Sfy _ y ys     -> BraE xs0 (insert' f' y braEy mpx) -- N.B. Use of strict insert'
                    where f' lgt = u lgt braEy
                          braEy  = BraE ys mpy
------------------------------------------


-- |  See 'GT' class method 'union''.
unionListGT' ::  GT map k => (a -> a -> a) -> ListGT map k a -> ListGT map k a -> ListGT map k a
unionListGT' f lgt0 lgt1 = u lgt0 lgt1 where
 u Empt lgt  = lgt
 u lgt  Empt = lgt
------------------------------------------
 u (BraF xs0 ax mpx) (BraF ys0 ay mpy) = case match xs0 ys0 of
  Mat            -> let a = f ax ay in a `seq` BraF xs0 a (union' u mpx mpy) -- N.B. Use of strict union'
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraF xs ax mpx) (BraF ys ay mpy))
  Sfx _ x xs     -> BraF ys0 ay (insert' f' x braFx mpy) -- N.B. Use of strict insert'
                    where f' lgt = u braFx lgt
                          braFx  = BraF xs ax mpx
  Sfy _ y ys     -> BraF xs0 ax (insert' f' y braFy mpx) -- N.B. Use of strict insert'
                    where f' lgt = u lgt braFy
                          braFy  = BraF ys ay mpy
------------------------------------------
 u (BraF xs0 ax mpx) (BraE ys0 mpy) = case match xs0 ys0 of
  Mat            -> BraF xs0 ax (union' u mpx mpy) -- N.B. Use of strict union'
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraF xs ax mpx) (BraE ys mpy))
  Sfx _ x xs     -> BraE ys0 (insert' f' x braFx mpy) -- N.B. Use of strict insert'
                    where f' lgt = u braFx lgt
                          braFx  = BraF xs ax mpx
  Sfy _ y ys     -> BraF xs0 ax (insert' f' y braEy mpx) -- N.B. Use of strict insert'
                    where f' lgt = u lgt braEy
                          braEy  = BraE ys mpy
------------------------------------------
 u (BraE xs0 mpx) (BraF ys0 ay mpy) = case match xs0 ys0 of
  Mat            -> BraF xs0 ay (union' u mpx mpy) -- N.B. Use of strict union'
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraE xs mpx) (BraF ys ay mpy))
  Sfx _ x xs     -> BraF ys0 ay (insert' f' x braEx mpy) -- N.B. Use of strict insert'
                    where f' lgt = u braEx lgt
                          braEx  = BraE xs mpx
  Sfy _ y ys     -> BraE xs0 (insert' f' y braFy mpx) -- N.B. Use of strict insert'
                    where f' lgt = u lgt braFy
                          braFy  = BraF ys ay mpy
------------------------------------------
 u (BraE xs0 mpx) (BraE ys0 mpy) = case match xs0 ys0 of
  Mat            -> BraE xs0 (union' u mpx mpy) -- N.B. Use of strict union'
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraE xs mpx) (BraE ys mpy))
  Sfx _ x xs     -> BraE ys0 (insert' f' x braEx mpy) -- N.B. Use of strict insert'
                    where f' lgt = u braEx lgt
                          braEx  = BraE xs mpx
  Sfy _ y ys     -> BraE xs0 (insert' f' y braEy mpx) -- N.B. Use of strict insert'
                    where f' lgt = u lgt braEy
                          braEy  = BraE ys mpy
------------------------------------------


-- |  See 'GT' class method 'unionMaybe'.
unionMaybeListGT ::  GT map k => (a -> a -> Maybe a) -> ListGT map k a -> ListGT map k a -> ListGT map k a
unionMaybeListGT f lgt0 lgt1 = u lgt0 lgt1 where
 uNE lgtx lgty = nonEmptyListGT (u lgtx lgty) -- unionMaybe can yield empty maps !!
------------------------------------------
 u Empt lgt  = lgt
 u lgt  Empt = lgt
------------------------------------------
 u (BraF xs0 ax mpx) (BraF ys0 ay mpy) = case match xs0 ys0 of
  Mat            -> case f ax ay of
                    Just a  -> BraF xs0 a (unionMaybe uNE mpx mpy)
                    Nothing -> braE xs0   (unionMaybe uNE mpx mpy) -- N.B Use of braE, not BraE !!
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraF xs ax mpx) (BraF ys ay mpy))
  Sfx _ x xs     -> BraF ys0 ay (insertMaybe f' x braFx mpy)
                    where f' lgt = uNE braFx lgt
                          braFx  = BraF xs ax mpx
  Sfy _ y ys     -> BraF xs0 ax (insertMaybe f' y braFy mpx)
                    where f' lgt = uNE lgt braFy
                          braFy  = BraF ys ay mpy
------------------------------------------
 u (BraF xs0 ax mpx) (BraE ys0 mpy) = case match xs0 ys0 of
  Mat            -> BraF xs0 ax (unionMaybe uNE mpx mpy)
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraF xs ax mpx) (BraE ys mpy))
  Sfx _ x xs     -> braE ys0 (insertMaybe f' x braFx mpy) -- N.B Use of braE, not BraE !!
                    where f' lgt = uNE braFx lgt
                          braFx  = BraF xs ax mpx
  Sfy _ y ys     -> BraF xs0 ax (insertMaybe f' y braEy mpx)
                    where f' lgt = uNE lgt braEy
                          braEy  = BraE ys mpy
------------------------------------------
 u (BraE xs0 mpx) (BraF ys0 ay mpy) = case match xs0 ys0 of
  Mat            -> BraF xs0 ay (unionMaybe uNE mpx mpy)
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraE xs mpx) (BraF ys ay mpy))
  Sfx _ x xs     -> BraF ys0 ay (insertMaybe f' x braEx mpy)
                    where f' lgt = uNE braEx lgt
                          braEx  = BraE xs mpx
  Sfy _ y ys     -> braE xs0 (insertMaybe f' y braFy mpx) -- N.B Use of braE, not BraE !!
                    where f' lgt = uNE lgt braFy
                          braFy  = BraF ys ay mpy
------------------------------------------
 u (BraE xs0 mpx) (BraE ys0 mpy) = case match xs0 ys0 of
  Mat            -> braE xs0 (unionMaybe uNE mpx mpy)  -- N.B Use of braE, not BraE !!
  Frk n f' xs ys -> BraE (takeN n xs0) (f' (BraE xs mpx) (BraE ys mpy))
  Sfx _ x xs     -> braE ys0 (insertMaybe f' x braEx mpy) -- N.B Use of braE, not BraE !!
                    where f' lgt = uNE braEx lgt
                          braEx  = BraE xs mpx
  Sfy _ y ys     -> braE xs0 (insertMaybe f' y braEy mpx) -- N.B Use of braE, not BraE !!
                    where f' lgt = uNE lgt braEy
                          braEy  = BraE ys mpy
------------------------------------------


-- |  See 'GT' class method 'intersection'.
intersectionListGT ::  GT map k => (a -> b -> c) -> ListGT map k a -> ListGT map k b -> ListGT map k c
intersectionListGT f lgt0 lgt1 = i lgt0 lgt1 where
 iNE lgtx lgty = nonEmptyListGT (i lgtx lgty) -- intersection can yield empty maps !!
------------------------------------------
 i Empt _    = Empt
 i _    Empt = Empt
------------------------------------------
 i (BraF xs0 a mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = BraF xs0 (f a b) (intersectionMaybe iNE mpx mpy)
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraF xs a mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraF ys b mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraF xs0 a mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraF xs a mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraE ys mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraE xs0 mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraE xs mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraF ys b mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraE xs0 mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraE xs mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraE ys mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------


-- |  See 'GT' class method 'intersection''.
intersectionListGT' ::  GT map k => (a -> b -> c) -> ListGT map k a -> ListGT map k b -> ListGT map k c
intersectionListGT' f lgt0 lgt1 = i lgt0 lgt1 where
 iNE lgtx lgty = nonEmptyListGT (i lgtx lgty) -- intersection can yield empty maps !!
------------------------------------------
 i Empt _    = Empt
 i _    Empt = Empt
------------------------------------------
 i (BraF xs0 a mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = let c = f a b in c `seq` BraF xs0 c (intersectionMaybe iNE mpx mpy)
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraF xs a mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraF ys b mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraF xs0 a mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraF xs a mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraE ys mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraE xs0 mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraE xs mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraF ys b mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraE xs0 mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraE xs mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraE ys mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------


-- |  See 'GT' class method 'intersectionMaybe'.
intersectionMaybeListGT ::  GT map k => (a -> b -> Maybe c) -> ListGT map k a -> ListGT map k b -> ListGT map k c
intersectionMaybeListGT f lgt0 lgt1 = i lgt0 lgt1 where
 iNE lgtx lgty = nonEmptyListGT (i lgtx lgty) -- intersection can yield empty maps !!
------------------------------------------
 i Empt _    = Empt
 i _    Empt = Empt
------------------------------------------
 i (BraF xs0 a mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = case f a b of
                    Just c  -> BraF xs0 c (intersectionMaybe iNE mpx mpy)
                    Nothing -> braE xs0   (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraF xs a mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraF ys b mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraF xs0 a mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraF xs a mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraE ys mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraE xs0 mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraE xs mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraF ys b mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------
 i (BraE xs0 mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (intersectionMaybe iNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> Empt
                                         Just lgtb -> case i (BraE xs mpx) lgtb of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (ys0 +!+ x:zs) c mpz
                                                      BraE zs   mpz -> BraE (ys0 +!+ x:zs)   mpz
  m []     (y:ys) = case lookup y mpx of Nothing   -> Empt
                                         Just lgta -> case i lgta (BraE ys mpy) of
                                                      Empt          -> Empt
                                                      BraF zs c mpz -> BraF (xs0 +!+ y:zs) c mpz
                                                      BraE zs   mpz -> BraE (xs0 +!+ y:zs)   mpz
  m (x:xs) (y:ys) = if x == y then m xs ys else Empt
------------------------------------------


-- | See 'GT' class method 'difference'.
differenceListGT :: GT map k => ListGT map k a -> ListGT map k b -> ListGT map k a
differenceListGT lgt0 lgt1 = d lgt0 lgt1 where
 dNE lgtx lgty = nonEmptyListGT (d lgtx lgty) -- difference can yield empty maps !!
------------------------------------------
 d Empt _    = Empt
 d lgtx Empt = lgtx
------------------------------------------
 d lgtx@(BraF xs0 a mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (differenceMaybe dNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> lgtx
                                         Just lgtb -> case d (BraF xs a mpx) lgtb of
                                                      Empt           -> Empt
                                                      BraF zs a' mpz -> BraF (ys0 +!+ x:zs) a' mpz
                                                      BraE zs    mpz -> BraE (ys0 +!+ x:zs)    mpz
  m []     (y:ys) = BraF xs0 a (deleteMaybe (\lgta -> dNE lgta (BraF ys b mpy)) y mpx)
  m (x:xs) (y:ys) = if x==y then m xs ys else lgtx
------------------------------------------
 d lgtx@(BraF xs0 a mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = BraF xs0 a (differenceMaybe dNE mpx mpy)
  m (x:xs) []     = case lookup x mpy of Nothing   -> lgtx
                                         Just lgtb -> case d (BraF xs a mpx) lgtb of
                                                      Empt           -> Empt
                                                      BraF zs a' mpz -> BraF (ys0 +!+ x:zs) a' mpz
                                                      BraE zs    mpz -> BraE (ys0 +!+ x:zs)    mpz
  m []     (y:ys) = BraF xs0 a (deleteMaybe (\lgta -> dNE lgta (BraE ys mpy)) y mpx)
  m (x:xs) (y:ys) = if x==y then m xs ys else lgtx
------------------------------------------
 d lgtx@(BraE xs0 mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (differenceMaybe dNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> lgtx
                                         Just lgtb -> case d (BraE xs mpx) lgtb of
                                                      Empt           -> Empt
                                                      BraF zs a' mpz -> BraF (ys0 +!+ x:zs) a' mpz
                                                      BraE zs    mpz -> BraE (ys0 +!+ x:zs)    mpz
  m []     (y:ys) = braE xs0 (deleteMaybe (\lgta -> dNE lgta (BraF ys b mpy)) y mpx) -- Note use of braE!
  m (x:xs) (y:ys) = if x==y then m xs ys else lgtx
------------------------------------------
 d lgtx@(BraE xs0 mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (differenceMaybe dNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> lgtx
                                         Just lgtb -> case d (BraE xs mpx) lgtb of
                                                      Empt           -> Empt
                                                      BraF zs a' mpz -> BraF (ys0 +!+ x:zs) a' mpz
                                                      BraE zs    mpz -> BraE (ys0 +!+ x:zs)    mpz
  m []     (y:ys) = braE xs0 (deleteMaybe (\lgta -> dNE lgta (BraE ys mpy)) y mpx) -- Note use of braE!
  m (x:xs) (y:ys) = if x==y then m xs ys else lgtx
------------------------------------------


-- | See 'GT' class method 'differenceMaybe'.
differenceMaybeListGT :: GT map k => (a -> b -> Maybe a) -> ListGT map k a -> ListGT map k b -> ListGT map k a
differenceMaybeListGT f lgt0 lgt1 = d lgt0 lgt1 where
 dNE lgtx lgty = nonEmptyListGT (d lgtx lgty) -- difference can yield empty maps !!
------------------------------------------
 d Empt _    = Empt
 d lgtx Empt = lgtx
------------------------------------------
 d lgtx@(BraF xs0 a mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = case f a b of
                    Nothing -> braE xs0    (differenceMaybe dNE mpx mpy) -- Note use of braE!
                    Just a' -> BraF xs0 a' (differenceMaybe dNE mpx mpy)
  m (x:xs) []     = case lookup x mpy of Nothing   -> lgtx
                                         Just lgtb -> case d (BraF xs a mpx) lgtb of
                                                      Empt           -> Empt
                                                      BraF zs a' mpz -> BraF (ys0 +!+ x:zs) a' mpz
                                                      BraE zs    mpz -> BraE (ys0 +!+ x:zs)    mpz
  m []     (y:ys) = BraF xs0 a (deleteMaybe (\lgta -> dNE lgta (BraF ys b mpy)) y mpx)
  m (x:xs) (y:ys) = if x==y then m xs ys else lgtx
------------------------------------------
 d lgtx@(BraF xs0 a mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = BraF xs0 a (differenceMaybe dNE mpx mpy)
  m (x:xs) []     = case lookup x mpy of Nothing   -> lgtx
                                         Just lgtb -> case d (BraF xs a mpx) lgtb of
                                                      Empt           -> Empt
                                                      BraF zs a' mpz -> BraF (ys0 +!+ x:zs) a' mpz
                                                      BraE zs    mpz -> BraE (ys0 +!+ x:zs)    mpz
  m []     (y:ys) = BraF xs0 a (deleteMaybe (\lgta -> dNE lgta (BraE ys mpy)) y mpx)
  m (x:xs) (y:ys) = if x==y then m xs ys else lgtx
------------------------------------------
 d lgtx@(BraE xs0 mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (differenceMaybe dNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> lgtx
                                         Just lgtb -> case d (BraE xs mpx) lgtb of
                                                      Empt           -> Empt
                                                      BraF zs a' mpz -> BraF (ys0 +!+ x:zs) a' mpz
                                                      BraE zs    mpz -> BraE (ys0 +!+ x:zs)    mpz
  m []     (y:ys) = braE xs0 (deleteMaybe (\lgta -> dNE lgta (BraF ys b mpy)) y mpx) -- Note use of braE!
  m (x:xs) (y:ys) = if x==y then m xs ys else lgtx
------------------------------------------
 d lgtx@(BraE xs0 mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = braE xs0 (differenceMaybe dNE mpx mpy) -- Note use of braE!
  m (x:xs) []     = case lookup x mpy of Nothing   -> lgtx
                                         Just lgtb -> case d (BraE xs mpx) lgtb of
                                                      Empt           -> Empt
                                                      BraF zs a' mpz -> BraF (ys0 +!+ x:zs) a' mpz
                                                      BraE zs    mpz -> BraE (ys0 +!+ x:zs)    mpz
  m []     (y:ys) = braE xs0 (deleteMaybe (\lgta -> dNE lgta (BraE ys mpy)) y mpx) -- Note use of braE!
  m (x:xs) (y:ys) = if x==y then m xs ys else lgtx
------------------------------------------


-- | See 'GT' class method 'isSubsetOf'.
isSubsetOfListGT :: GT map k => ListGT map k a -> ListGT map k b -> Bool
-- This is basically finding out if (differenceListGT lgt0 lgt1 == Empt)
-- If so, lgt0 is a submap of lgt1.
------------------------------------------
isSubsetOfListGT Empt _    = True
isSubsetOfListGT _    Empt = False
------------------------------------------
isSubsetOfListGT (BraF xs0 a mpx) (BraF ys0 _ mpy) = m xs0 ys0 where
  m []     []     = isSubmapOf isSubsetOfListGT mpx mpy
  m (x:xs) []     = case lookup x mpy of Nothing   -> False
                                         Just lgtb -> isSubsetOfListGT (BraF xs a mpx) lgtb
  m []     (_:_ ) = False
  m (x:xs) (y:ys) = if x==y then m xs ys else False
------------------------------------------
isSubsetOfListGT (BraF xs0 a mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = False
  m (x:xs) []     = case lookup x mpy of Nothing   -> False
                                         Just lgtb -> isSubsetOfListGT (BraF xs a mpx) lgtb
  m []     (_:_ ) = False
  m (x:xs) (y:ys) = if x==y then m xs ys else False
------------------------------------------
isSubsetOfListGT (BraE xs0 mpx) (BraF ys0 _ mpy) = m xs0 ys0 where
  m []     []     = isSubmapOf isSubsetOfListGT mpx mpy
  m (x:xs) []     = case lookup x mpy of Nothing   -> False
                                         Just lgtb -> isSubsetOfListGT (BraE xs mpx) lgtb
  m []     (_:_ ) = False -- mpx must contain at least 2 entries
  m (x:xs) (y:ys) = if x==y then m xs ys else False
------------------------------------------
isSubsetOfListGT (BraE xs0 mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = isSubmapOf isSubsetOfListGT mpx mpy
  m (x:xs) []     = case lookup x mpy of Nothing   -> False
                                         Just lgtb -> isSubsetOfListGT (BraE xs mpx) lgtb
  m []     (_:_ ) = False -- mpx must contain at least 2 entries
  m (x:xs) (y:ys) = if x==y then m xs ys else False
------------------------------------------


-- | See 'GT' class method 'isSubmapOf'.
isSubmapOfListGT :: GT map k => (a -> b -> Bool) -> ListGT map k a -> ListGT map k b -> Bool
isSubmapOfListGT p lgt0 lgt1 = d lgt0 lgt1 where
------------------------------------------
 d Empt _    = True
 d _    Empt = False
------------------------------------------
 d (BraF xs0 a mpx) (BraF ys0 b mpy) = m xs0 ys0 where
  m []     []     = if p a b then isSubmapOf d mpx mpy else False
  m (x:xs) []     = case lookup x mpy of Nothing   -> False
                                         Just lgtb -> d (BraF xs a mpx) lgtb
  m []     (_:_ ) = False
  m (x:xs) (y:ys) = if x==y then m xs ys else False
------------------------------------------
 d (BraF xs0 a mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = False
  m (x:xs) []     = case lookup x mpy of Nothing   -> False
                                         Just lgtb -> d (BraF xs a mpx) lgtb
  m []     (_:_ ) = False
  m (x:xs) (y:ys) = if x==y then m xs ys else False
------------------------------------------
 d (BraE xs0 mpx) (BraF ys0 _ mpy) = m xs0 ys0 where
  m []     []     = isSubmapOf d mpx mpy
  m (x:xs) []     = case lookup x mpy of Nothing   -> False
                                         Just lgtb -> d (BraE xs mpx) lgtb
  m []     (_:_ ) = False -- mpx must contain at least 2 entries
  m (x:xs) (y:ys) = if x==y then m xs ys else False
------------------------------------------
 d (BraE xs0 mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = isSubmapOf d mpx mpy
  m (x:xs) []     = case lookup x mpy of Nothing   -> False
                                         Just lgtb -> d (BraE xs mpx) lgtb
  m []     (_:_ ) = False -- mpx must contain at least 2 entries
  m (x:xs) (y:ys) = if x==y then m xs ys else False
------------------------------------------


-- | See 'GT' class method 'insert'.
insertListGT :: GT map k => (a -> a) -> [k] -> a -> ListGT map k a -> ListGT map k a
-- Convention below is xs is the search key list and ys is the key list fragment from the Trie (ListGT)
-- N.B We always use the Strict insert' method here!
insertListGT f xs0 ax lgt0 = iw xs0 lgt0 where
 iw xs Empt = BraF xs ax empty
------------------------------
 iw xs (BraF ys ay mp) = case match xs ys of
   Mat              -> BraF ys (f ay) mp  -- xs == ys
   Frk n f' xs' ys' -> BraE (takeN n ys) (f' (BraF xs' ax empty) (BraF ys' ay mp))
   Sfy _ y' ys'     -> BraF xs ax (singleton y' (BraF ys' ay mp))
   Sfx _ x' xs'     -> BraF ys ay (insert' (iw xs') x' (BraF xs' ax empty) mp)
------------------------------
 iw xs (BraE ys mp) = case match xs ys of
   Mat              -> BraF ys ax mp   -- xs == ys
   Frk n f' xs' ys' -> BraE (takeN n ys) (f' (BraF xs' ax empty) (BraE ys' mp))
   Sfy _ y' ys'     -> BraF xs ax (singleton y' (BraE ys' mp))
   Sfx _ x' xs'     -> BraE ys (insert' (iw xs') x' (BraF xs' ax empty) mp)
------------------------------

-- | See 'GT' class method 'insert''.
insertListGT' :: GT map k => (a -> a) -> [k] -> a -> ListGT map k a -> ListGT map k a
-- Convention below is xs is the search key list and ys is the key list fragment from the Trie (ListGT)
-- N.B We always use the Strict insert' method here!
insertListGT' f xs0 ax lgt0 = iw xs0 lgt0 where
 iw xs Empt = BraF xs ax empty
------------------------------
 iw xs (BraF ys ay mp) = case match xs ys of
   Mat              -> let ay' = f ay in ay' `seq` BraF ys ay mp  -- xs == ys
   Frk n f' xs' ys' -> BraE (takeN n ys) (f' (BraF xs' ax empty) (BraF ys' ay mp))
   Sfy _ y' ys'     -> BraF xs ax (singleton y' (BraF ys' ay mp))
   Sfx _ x' xs'     -> BraF ys ay (insert' (iw xs') x' (BraF xs' ax empty) mp)
------------------------------
 iw xs (BraE ys mp) = case match xs ys of
   Mat              -> BraF ys ax mp   -- xs == ys
   Frk n f' xs' ys' -> BraE (takeN n ys) (f' (BraF xs' ax empty) (BraE ys' mp))
   Sfy _ y' ys'     -> BraF xs ax (singleton y' (BraE ys' mp))
   Sfx _ x' xs'     -> BraE ys (insert' (iw xs') x' (BraF xs' ax empty) mp)
------------------------------

-- | See 'GT' class method 'insert'''.
insertListGT'' :: GT map k => (a -> a) -> [k] -> a -> ListGT map k a -> ListGT map k a
-- Convention below is xs is the search key list and ys is the key list fragment from the Trie (ListGT)
-- N.B We always use the Stricter insert'' method here!
insertListGT'' f xs0 ax lgt0 = iw xs0 lgt0 where
 iw xs Empt = ax `seq` BraF xs ax empty
------------------------------
 iw xs (BraF ys ay mp) = case match xs ys of
   Mat              -> let ay' = f ay in ay' `seq` BraF ys ay mp  -- xs == ys
   Frk n f' xs' ys' -> ax `seq` BraE (takeN n ys) (f' (BraF xs' ax empty) (BraF ys' ay mp))
   Sfy _ y' ys'     -> ax `seq` BraF xs ax (singleton y' (BraF ys' ay mp))
   Sfx _ x' xs'     -> BraF ys ay (insert'' (iw xs') x' (ax `seq` (BraF xs' ax empty)) mp) -- N.B.!!
------------------------------
 iw xs (BraE ys mp) = case match xs ys of
   Mat              -> ax `seq` BraF ys ax mp   -- xs == ys
   Frk n f' xs' ys' -> ax `seq` BraE (takeN n ys) (f' (BraF xs' ax empty) (BraE ys' mp))
   Sfy _ y' ys'     -> ax `seq` BraF xs ax (singleton y' (BraE ys' mp))
   Sfx _ x' xs'     -> BraE ys (insert'' (iw xs') x' (ax `seq` (BraF xs' ax empty)) mp) -- N.B.!!
------------------------------


-- | See 'GT' class method 'insertMaybe'.
insertMaybeListGT :: GT map k => (a -> Maybe a) -> [k] -> a -> ListGT map k a -> ListGT map k a
-- Convention below is xs is the search key list and ys is the key list fragment from the Trie (ListGT)
insertMaybeListGT f xs0 ax lgt0 = iw xs0 lgt0 where
 iwNE xs lgt = nonEmptyListGT (iw xs lgt) -- insertMaybe can yield empty maps !!
------------------------------
 iw xs Empt = BraF xs ax empty
------------------------------
 iw xs (BraF ys ay mp) = case match xs ys of
   Mat              -> case f ay of   -- xs == ys
                       Just ay' -> BraF ys ay' mp
                       Nothing  -> braE ys     mp -- N.B. Use of braE, not BraE
   Frk n f' xs' ys' -> BraE (takeN n ys) (f' (BraF xs' ax empty) (BraF ys' ay mp))
   Sfy _ y' ys'     -> BraF xs ax (singleton y' (BraF ys' ay mp))
   Sfx _ x' xs'     -> BraF ys ay (insertMaybe (iwNE xs') x' (BraF xs' ax empty) mp)
------------------------------
 iw xs (BraE ys mp) = case match xs ys of
   Mat              -> BraF ys ax mp   -- xs == ys
   Frk n f' xs' ys' -> BraE (takeN n ys) (f' (BraF xs' ax empty) (BraE ys' mp))
   Sfy _ y' ys'     -> BraF xs ax (singleton y' (BraE ys' mp))
   Sfx _ x' xs'     -> braE ys (insertMaybe (iwNE xs') x' (BraF xs' ax empty) mp)  -- N.B. Use of braE, not BraE
------------------------------


-- | See 'GT' class method 'insertMaybe''.
insertMaybeListGT' :: GT map k => (a -> Maybe a) -> [k] -> a -> ListGT map k a -> ListGT map k a
-- Convention below is xs is the search key list and ys is the key list fragment from the Trie (ListGT)
insertMaybeListGT' f xs0 ax lgt0 = iw xs0 lgt0 where
 iwNE xs lgt = nonEmptyListGT (iw xs lgt) -- insertMaybe' can yield empty maps !!
------------------------------
 iw xs Empt = BraF xs ax empty
------------------------------
 iw xs (BraF ys ay mp) = case match xs ys of
   Mat              -> case f ay of   -- xs == ys
                       Just ay' -> BraF ys ay' mp
                       Nothing  -> braE ys     mp -- N.B. Use of braE, not BraE
   Frk n f' xs' ys' -> ax `seq` BraE (takeN n ys) (f' (BraF xs' ax empty) (BraF ys' ay mp))
   Sfy _ y' ys'     -> ax `seq` BraF xs ax (singleton y' (BraF ys' ay mp))
   Sfx _ x' xs'     -> BraF ys ay (insertMaybe' (iwNE xs') x' (ax `seq` (BraF xs' ax empty)) mp)
------------------------------
 iw xs (BraE ys mp) = case match xs ys of
   Mat              -> ax `seq` BraF ys ax mp   -- xs == ys
   Frk n f' xs' ys' -> ax `seq` BraE (takeN n ys) (f' (BraF xs' ax empty) (BraE ys' mp))
   Sfy _ y' ys'     -> ax `seq` BraF xs ax (singleton y' (BraE ys' mp))
   Sfx _ x' xs'     -> braE ys (insertMaybe' (iwNE xs') x' (ax `seq` (BraF xs' ax empty)) mp)  -- N.B. Use of braE, not BraE
------------------------------


-- | See 'GT' class method 'foldrElemsAscending'.
foldrElemsAscendingListGT :: GT map k => (a -> b -> b) -> ListGT map k a -> b -> b
foldrElemsAscendingListGT f lgt0 b0 = fld lgt0 b0 where
 fld  Empt         b = b
 fld (BraF _ a mp) b = f a (foldrElemsAscending fld mp b)
 fld (BraE _   mp) b =      foldrElemsAscending fld mp b

-- | See 'GT' class method 'foldrElemsDescending'.
foldrElemsDescendingListGT :: GT map k => (a -> b -> b) -> ListGT map k a -> b -> b
foldrElemsDescendingListGT f lgt0 b0 = fld lgt0 b0 where
 fld  Empt         b = b
 fld (BraF _ a mp) b = foldrElemsDescending fld mp (f a b)
 fld (BraE _   mp) b = foldrElemsDescending fld mp      b

-- | See 'GT' class method 'foldrKeysAscending'.
foldrKeysAscendingListGT :: GT map k => ([k] -> b -> b) -> ListGT map k a -> b -> b
foldrKeysAscendingListGT f lgt0 b0 = fld [] lgt0 b0 where
 fld _    Empt          b = b
 fld rks (BraF ks _ mp) b = f (revTo rks ks) (foldrAssocsAscending f' mp b)
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'
 fld rks (BraE ks   mp) b = foldrAssocsAscending f' mp b
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'

-- | See 'GT' class method 'foldrKeysDescending'.
foldrKeysDescendingListGT :: GT map k => ([k] -> b -> b) -> ListGT map k a -> b -> b
foldrKeysDescendingListGT f lgt0 b0 = fld [] lgt0 b0 where
 fld _    Empt          b = b
 fld rks (BraF ks _ mp) b = foldrAssocsDescending f' mp (f (revTo rks ks) b)
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'
 fld rks (BraE ks   mp) b = foldrAssocsDescending f' mp b
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'

-- | See 'GT' class method 'foldrAssocsAscending'.
foldrAssocsAscendingListGT :: GT map k => ([k] -> a -> b -> b) -> ListGT map k a -> b -> b
foldrAssocsAscendingListGT f lgt0 b0 = fld [] lgt0 b0 where
 fld _    Empt          b = b
 fld rks (BraF ks a mp) b = f (revTo rks ks) a (foldrAssocsAscending f' mp b)
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'
 fld rks (BraE ks   mp) b = foldrAssocsAscending f' mp b
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'

-- | See 'GT' class method 'foldrAssocsDescending'.
foldrAssocsDescendingListGT :: GT map k => ([k] -> a -> b -> b) -> ListGT map k a -> b -> b
foldrAssocsDescendingListGT f lgt0 b0 = fld [] lgt0 b0 where
 fld _    Empt          b = b
 fld rks (BraF ks a mp) b = foldrAssocsDescending f' mp (f (revTo rks ks) a b)
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'
 fld rks (BraE ks   mp) b = foldrAssocsDescending f' mp b
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'

-- | See 'GT' class method 'foldrElemsAscending''.
foldrElemsAscendingListGT' :: GT map k => (a -> b -> b) -> ListGT map k a -> b -> b
foldrElemsAscendingListGT' f lgt0 b0 = fld lgt0 b0 where
 fld  Empt         b = b
 fld (BraF _ a mp) b = let b' = foldrElemsAscending' fld mp b  in b' `seq` f a b'
 fld (BraE _   mp) b =          foldrElemsAscending' fld mp b

-- | See 'GT' class method 'foldrElemsDescending''.
foldrElemsDescendingListGT' :: GT map k => (a -> b -> b) -> ListGT map k a -> b -> b
foldrElemsDescendingListGT' f lgt0 b0 = fld lgt0 b0 where
 fld  Empt         b = b
 fld (BraF _ a mp) b = let b' = f a b in b' `seq` foldrElemsDescending' fld mp b'
 fld (BraE _   mp) b =                            foldrElemsDescending' fld mp b

-- | See 'GT' class method 'foldrKeysAscending''.
foldrKeysAscendingListGT' :: GT map k => ([k] -> b -> b) -> ListGT map k a -> b -> b
foldrKeysAscendingListGT' f lgt0 b0 = fld [] lgt0 b0 where
 fld _    Empt          b = b
 fld rks (BraF ks _ mp) b = b'' `seq` f (revTo rks ks) b''
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'
                                  b''         = foldrAssocsAscending' f' mp b
 fld rks (BraE ks   mp) b = foldrAssocsAscending' f' mp b
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'

-- | See 'GT' class method 'foldrKeysDescending''.
foldrKeysDescendingListGT' :: GT map k => ([k] -> b -> b) -> ListGT map k a -> b -> b
foldrKeysDescendingListGT' f lgt0 b0 = fld [] lgt0 b0 where
 fld _    Empt          b = b
 fld rks (BraF ks _ mp) b = b'' `seq` foldrAssocsDescending' f' mp b''
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'
                                  b''         = f (revTo rks ks) b
 fld rks (BraE ks   mp) b = foldrAssocsDescending' f' mp b
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'

-- | See 'GT' class method 'foldrAssocsAscending''.
foldrAssocsAscendingListGT' :: GT map k => ([k] -> a -> b -> b) -> ListGT map k a -> b -> b
foldrAssocsAscendingListGT' f lgt0 b0 = fld [] lgt0 b0 where
 fld _    Empt          b = b
 fld rks (BraF ks a mp) b = b'' `seq` f (revTo rks ks) a b''
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'
                                  b''         = foldrAssocsAscending' f' mp b
 fld rks (BraE ks   mp) b = foldrAssocsAscending' f' mp b
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'

-- | See 'GT' class method 'foldrAssocsDescending''.
foldrAssocsDescendingListGT' :: GT map k => ([k] -> a -> b -> b) -> ListGT map k a -> b -> b
foldrAssocsDescendingListGT' f lgt0 b0 = fld [] lgt0 b0 where
 fld _    Empt          b = b
 fld rks (BraF ks a mp) b = b'' `seq` foldrAssocsDescending' f' mp b''
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'
                                  b''         = f (revTo rks ks) a b
 fld rks (BraE ks   mp) b = foldrAssocsDescending' f' mp b
                            where f' k lgt b' = fld (k : revTo ks rks) lgt b'

-- | See 'GT' class method 'foldElemsUINT'.
foldElemsUINTListGT :: GT map k => (a -> UINT -> UINT) -> ListGT map k a -> UINT -> UINT
foldElemsUINTListGT f lgt0 n0 = fld lgt0 n0 where
#ifdef __GLASGOW_HASKELL__
 fld  Empt         n = n
 fld (BraF _ a mp) n = foldElemsUINT fld mp (f a n)
 fld (BraE _   mp) n = foldElemsUINT fld mp n
#else
 fld  Empt         n = n
 fld (BraF _ a mp) n = foldElemsUINT fld mp $! f a n
 fld (BraE _   mp) n = foldElemsUINT fld mp n
#endif

-- | See 'GT' class method 'map'.
mapListGT :: GT map k => (a -> b) -> ListGT map k a -> ListGT map k b
mapListGT _  Empt          = Empt
mapListGT f (BraF ks a mp) = BraF ks (f a) (map' (mapListGT f) mp) -- Note use of strict map'
mapListGT f (BraE ks   mp) = BraE ks       (map' (mapListGT f) mp) -- Note use of strict map'

-- | See 'GT' class method 'map''.
mapListGT' :: GT map k => (a -> b) -> ListGT map k a -> ListGT map k b
mapListGT' _  Empt          = Empt
mapListGT' f (BraF ks a mp) = let b = f a in b `seq` BraF ks b (map' (mapListGT' f) mp) -- Note use of strict map'
mapListGT' f (BraE ks   mp) =                        BraE ks   (map' (mapListGT' f) mp) -- Note use of strict map'

-- | See 'GT' class method 'mapMaybe'.
mapMaybeListGT :: GT map k => (a -> Maybe b) -> ListGT map k a -> ListGT map k b
mapMaybeListGT _  Empt          = Empt
mapMaybeListGT f (BraF ks a mp) = let mp' = mapMaybe (\lgt -> nonEmptyListGT (mapMaybeListGT f lgt)) mp
                                  in case f a of Just b  -> BraF ks b mp'
                                                 Nothing -> braE ks   mp'
mapMaybeListGT f (BraE ks   mp) = let mp' = mapMaybe (\lgt -> nonEmptyListGT (mapMaybeListGT f lgt)) mp
                                  in braE ks mp'

-- | See 'GT' class method 'mapWithKey'.
mapWithKeyListGT :: GT map k => ([k] -> a -> b) -> ListGT map k a -> ListGT map k b
mapWithKeyListGT f mp = mwk [] mp where
 mwk _    Empt           = Empt
 mwk rks (BraF ks a mp') = BraF ks (f (revTo rks ks) a) (mapWithKey' f' mp') -- Note use of strict mapWithKey'
                           where f' k lgt = mwk (k : revTo ks rks) lgt
 mwk rks (BraE ks   mp') = BraE ks (mapWithKey' f' mp') -- Note use of strict mapWithKey'
                           where f' k lgt = mwk (k : revTo ks rks) lgt

-- | See 'GT' class method 'mapWithKey''.
mapWithKeyListGT' :: GT map k => ([k] -> a -> b) -> ListGT map k a -> ListGT map k b
mapWithKeyListGT' f mp = mwk [] mp where
 mwk _    Empt           = Empt
 mwk rks (BraF ks a mp') = let b = f (revTo rks ks) a
                           in  b `seq` BraF ks b (mapWithKey' f' mp') -- Note use of strict mapWithKey'
                           where f' k lgt = mwk (k: revTo ks rks) lgt
 mwk rks (BraE ks   mp') = BraE ks (mapWithKey' f' mp') -- Note use of strict mapWithKey'
                           where f' k lgt = mwk (k: revTo ks rks) lgt

-- | See 'GT' class method 'mapMaybe'.
filterListGT :: GT map k => (a -> Bool) -> ListGT map k a -> ListGT map k a
filterListGT p lgt0 = flt lgt0 where
 flt     Empt          = Empt
 flt    (BraF ks a mp) = let mp' = mapMaybe (\lgt -> nonEmptyListGT (flt lgt)) mp
                         in if p a then BraF ks a mp'
                                   else braE ks   mp'
 flt    (BraE ks   mp) = let mp' = mapMaybe (\lgt -> nonEmptyListGT (flt lgt)) mp
                         in braE ks mp'


-- | See 'GT' class method 'valid'.
validListGT :: GT map k => ListGT map k a -> Maybe String
validListGT  Empt = Nothing
validListGT  lgt  = validListGT' lgt
-- Disallows Empt
validListGT' :: GT map k => ListGT map k a -> Maybe String
validListGT'  Empt         = Just "ListGT: Non-empty map contains Empt node."
-- Empty and singleton sub-maps are OK
validListGT' (BraF _ _ mp) = case valid mp of
                             Nothing -> foldrElemsAscending valAccum mp Nothing
                             Just s  -> Just ("ListGT:" ++ s)
-- Empty and singleton sub-maps are invalid
validListGT' (BraE _   mp) = case valid mp of
                             Nothing -> case status mp of
                                        None    -> Just ("ListGT: Empty branch map in BraE node.")
                                        One _ _ -> Just ("ListGT: Singleton branch map in BraE node.")
                                        Many    -> foldrElemsAscending valAccum mp Nothing
                             Just s  -> Just ("ListGT:" ++ s)
-- Accumulating valid (does not accept empty ListGTs)
valAccum :: GT map k => ListGT map k a -> Maybe String -> Maybe String
valAccum lgt Nothing = validListGT' lgt
valAccum _   just    = just

--------------------------------------------------------------------------
--                         OTHER INSTANCES                              --
--------------------------------------------------------------------------

--------
-- Eq --
--------
-- Needs -fallow-undecidable-instances
instance (Eq k, Eq a, Eq (map (ListGT map k a))) => Eq (ListGT map k a) where
 Empt            == Empt            = True
 BraF ks0 a0 mp0 == BraF ks1 a1 mp1 = (ks0==ks1) && (a0==a1) && (mp0==mp1)
 BraE ks0    mp0 == BraE ks1    mp1 = (ks0==ks1) && (mp0==mp1)
 _               == _               = False

---------
-- Ord --
---------
-- Needs -fallow-undecidable-instances
instance (GT map k, Ord a, Ord (map (ListGT map k a))) => Ord (ListGT map k a) where
 compare Empt Empt = EQ
 compare Empt _    = LT
 compare _    Empt = GT
-----------------------
 compare (BraF xs0 ax mpx) (BraF ys0 ay mpy) = m xs0 ys0 where
  m []     []     = case compare ax ay of
                    LT -> LT
                    EQ -> compare mpx mpy
                    GT -> GT
  m (_:_ ) []     = GT
  m []     (_:_ ) = LT
  m (x:xs) (y:ys) = case compare x y of
                    LT -> LT
                    EQ -> m xs ys
                    GT -> GT
-----------------------
 compare (BraF xs0 ax mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     _      = LT
  m (x:xs) []     = let sx = singleton x (BraF xs ax mpx) in sx `seq` compare sx mpy
  m (x:xs) (y:ys) = case compare x y of
                    LT -> LT
                    EQ -> m xs ys
                    GT -> GT
-----------------------
 compare (BraE xs0 mpx) (BraF ys0 ay mpy) = m xs0 ys0 where
  m _      []     = GT
  m []     (y:ys) = let sy = singleton y (BraF ys ay mpy) in sy `seq` compare mpx sy
  m (x:xs) (y:ys) = case compare x y of
                    LT -> LT
                    EQ -> m xs ys
                    GT -> GT
-----------------------
 compare (BraE xs0 mpx) (BraE ys0 mpy) = m xs0 ys0 where
  m []     []     = compare mpx mpy
  m (x:xs) []     = let sx = singleton x (BraE xs mpx) in sx `seq` compare sx mpy
  m []     (y:ys) = let sy = singleton y (BraE ys mpy) in sy `seq` compare mpx sy
  m (x:xs) (y:ys) = case compare x y of
                    LT -> LT
                    EQ -> m xs ys
                    GT -> GT
-----------------------

----------
-- Show --
----------
instance (GT map k, Show k, Show a) => Show (ListGT map k a) where
  showsPrec d mp  = showParen (d > 10) $
    showString "fromAssocsAscending " . shows (assocsAscending mp)

----------
-- Read --
----------
#ifdef __GLASGOW_HASKELL__
instance (GT map k, R.Read k, R.Read a) => R.Read (ListGT map k a) where
 readPrec = R.parens $ R.prec 10 $ do R.Ident "fromAssocsAscending" <- R.lexP
                                      xs <- R.readPrec
                                      return (fromAssocsAscending xs)
 readListPrec = R.readListPrecDefault
#else
instance (GT map k, Read k, Read a) => Read (ListGT map k a) where
  readsPrec p = readParen (p > 10) $ \ r -> do ("fromAssocsAscending",s) <- lex r
                                               (xs,t) <- reads s
                                               return (fromAssocsAscending xs,t)
#endif

------------------------
-- Typeable/Typeable1 --
------------------------
instance (Typeable1 map,Typeable k) => Typeable1 (ListGT map k) where
 typeOf1 mp = mkTyConApp (mkTyCon "Data.Trie.General.ListGT.ListGT") [typeOf1 m, typeOf k]
  where BraF [k] _ m = mp -- This is just to get types for k & m !!
--------------
instance (Typeable1 (ListGT map k), Typeable a) => Typeable (ListGT map k a) where
 typeOf = typeOfDefault

-------------
-- Functor --
-------------
instance GT map k => Functor (ListGT map k) where
-- fmap :: (a -> b) -> ListGT map k a -> ListGT map k b
   fmap = mapListGT -- The lazy version

-----------------
-- Data.Monoid --
-----------------
instance (GT map k, M.Monoid a) => M.Monoid (ListGT map k a) where
-- mempty :: ListGT map k a
   mempty = emptyListGT
-- mappend :: ListGT map k a -> ListGT map k a -> ListGT map k a
   mappend map0 map1 = unionListGT M.mappend map0 map1
-- mconcat :: [ListGT map k a] -> ListGT map k a
   mconcat maps = L.foldr (unionListGT M.mappend) emptyListGT maps

-------------------
-- Data.Foldable --
-------------------
instance GT map k => F.Foldable (ListGT map k) where
-- fold :: Monoid m => ListGT map k m -> m
   fold mp = foldrElemsAscendingListGT M.mappend mp M.mempty
-- foldMap :: Monoid m => (a -> m) -> ListGT map k a -> m
   foldMap f mp = foldrElemsAscendingListGT (\a b -> M.mappend (f a) b) mp M.mempty
-- foldr :: (a -> b -> b) -> b -> ListGT map k a -> b
   foldr f b0 mp = foldrElemsAscendingListGT f mp b0
-- foldl :: (a -> b -> a) -> a -> ListGT map k b -> a
   foldl f b0 mp = foldrElemsDescendingListGT (flip f) mp b0
{- ToDo: Implement properly. Meantime Foldable class has suitable defaults via lists.
-- foldr1 :: (a -> a -> a) -> ListGT map k a -> a
   foldr1 = undefined
-- foldl1 :: (a -> a -> a) -> ListGT map k a -> a
   foldl1 = undefined
-}