{-# Language OverloadedStrings, BlockArguments #-}
module Cryptol.REPL.Browse (BrowseHow(..), browseModContext) where

import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe(mapMaybe)
import Data.List(sortBy)
import Data.Void (Void)
import qualified Prettyprinter as PP

import Cryptol.Parser.AST(Pragma(..))
import qualified Cryptol.TypeCheck.Type as T

import Cryptol.Utils.PP
import Cryptol.Utils.Ident (OrigName(..), modPathIsNormal, identIsNormal)

import Cryptol.ModuleSystem.Env(ModContext(..),ModContextParams(..))
import Cryptol.ModuleSystem.NamingEnv(namingEnvNames)
import Cryptol.ModuleSystem.Name
import Cryptol.ModuleSystem.Interface

data BrowseHow = BrowseExported | BrowseInScope

browseModContext :: BrowseHow -> ModContext -> PP.Doc Void
browseModContext :: BrowseHow -> ModContext -> Doc Void
browseModContext BrowseHow
how ModContext
mc =
  NameDisp -> Doc -> Doc Void
runDoc (DispInfo -> NameDisp
env DispInfo
disp) ([Doc] -> Doc
vcat [Doc]
sections)
  where
  sections :: [Doc]
sections = [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ NameDisp -> ModContextParams -> [Doc]
browseMParams (DispInfo -> NameDisp
env DispInfo
disp) (ModContext -> ModContextParams
mctxParams ModContext
mc)
    , DispInfo -> IfaceDecls -> [Doc]
browseSignatures DispInfo
disp IfaceDecls
decls
    , DispInfo -> IfaceDecls -> [Doc]
browseMods DispInfo
disp IfaceDecls
decls
    , DispInfo -> IfaceDecls -> [Doc]
browseFunctors DispInfo
disp IfaceDecls
decls
    , DispInfo -> IfaceDecls -> [Doc]
browseTSyns DispInfo
disp IfaceDecls
decls
    , DispInfo -> IfaceDecls -> [Doc]
browsePrimTys DispInfo
disp IfaceDecls
decls
    , DispInfo -> IfaceDecls -> [Doc]
browseNominalTypes DispInfo
disp IfaceDecls
decls
    , DispInfo -> IfaceDecls -> [Doc]
browseVars DispInfo
disp IfaceDecls
decls
    ]

  disp :: DispInfo
disp     = DispInfo { dispHow :: BrowseHow
dispHow = BrowseHow
how, env :: NameDisp
env = ModContext -> NameDisp
mctxNameDisp ModContext
mc }
  decls :: IfaceDecls
decls    = (Name -> Bool) -> IfaceDecls -> IfaceDecls
filterIfaceDecls (Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
visNames) (ModContext -> IfaceDecls
mctxDecls ModContext
mc)
  allNames :: Set Name
allNames = NamingEnv -> Set Name
namingEnvNames (ModContext -> NamingEnv
mctxNames ModContext
mc)
  notAnon :: Name -> Bool
notAnon Name
nm = Ident -> Bool
identIsNormal (Name -> Ident
nameIdent Name
nm) Bool -> Bool -> Bool
&&
               case Name -> Maybe ModPath
nameModPathMaybe Name
nm of
                  Just ModPath
p -> ModPath -> Bool
modPathIsNormal ModPath
p
                  Maybe ModPath
_      -> Bool
True    -- shouldn't happen?
  visNames :: Set Name
visNames = (Name -> Bool) -> Set Name -> Set Name
forall a. (a -> Bool) -> Set a -> Set a
Set.filter Name -> Bool
notAnon
             case BrowseHow
how of
               BrowseHow
BrowseInScope  -> Set Name
allNames
               BrowseHow
BrowseExported -> ModContext -> Set Name
mctxExported ModContext
mc

data DispInfo = DispInfo { DispInfo -> BrowseHow
dispHow :: BrowseHow, DispInfo -> NameDisp
env :: NameDisp }

--------------------------------------------------------------------------------


browseMParams :: NameDisp -> ModContextParams -> [Doc]
browseMParams :: NameDisp -> ModContextParams -> [Doc]
browseMParams NameDisp
disp ModContextParams
pars =
  case ModContextParams
pars of
    ModContextParams
NoParams -> []
    FunctorParams FunctorParams
params ->
      String -> [Doc] -> [Doc]
ppSectionHeading String
"Module Parameters"
      ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [ Doc
"parameter" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. PP a => a -> Doc
pp (ModParam -> Ident
T.mpName ModParam
p) Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+>
          Doc
"interface" Doc -> Doc -> Doc
<+> ImpName Name -> Doc
forall a. PP a => a -> Doc
pp (ModParam -> ImpName Name
T.mpIface ModParam
p) Doc -> Doc -> Doc
$$
           Int -> Doc -> Doc
indent Int
2 ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            (ModTParam -> Doc) -> [ModTParam] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModTParam -> Doc
ppParamTy (NameDisp -> [(Name, ModTParam)] -> [ModTParam]
forall a. NameDisp -> [(Name, a)] -> [a]
sortByName NameDisp
disp (Map Name ModTParam -> [(Name, ModTParam)]
forall k a. Map k a -> [(k, a)]
Map.toList (ModParamNames -> Map Name ModTParam
T.mpnTypes ModParamNames
names))) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
            (ModVParam -> Doc) -> [ModVParam] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModVParam -> Doc
ppParamFu (NameDisp -> [(Name, ModVParam)] -> [ModVParam]
forall a. NameDisp -> [(Name, a)] -> [a]
sortByName NameDisp
disp (Map Name ModVParam -> [(Name, ModVParam)]
forall k a. Map k a -> [(k, a)]
Map.toList (ModParamNames -> Map Name ModVParam
T.mpnFuns  ModParamNames
names)))
           )
        | ModParam
p <- FunctorParams -> [ModParam]
forall k a. Map k a -> [a]
Map.elems FunctorParams
params
        , let names :: ModParamNames
names = ModParam -> ModParamNames
T.mpParameters ModParam
p
        ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
        [Doc
"   "]
    InterfaceParams ModParamNames
ps -> [ModParamNames -> Doc
forall a. PP a => a -> Doc
pp ModParamNames
ps] -- XXX
  where
  ppParamTy :: ModTParam -> Doc
ppParamTy ModTParam
p = Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
sep [Doc
"type", Name -> Doc
forall a. PP a => a -> Doc
pp (ModTParam -> Name
T.mtpName ModTParam
p) Doc -> Doc -> Doc
<+> Doc
":", Kind -> Doc
forall a. PP a => a -> Doc
pp (ModTParam -> Kind
T.mtpKind ModTParam
p)])
  ppParamFu :: ModVParam -> Doc
ppParamFu ModVParam
p = Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
sep [Name -> Doc
forall a. PP a => a -> Doc
pp (ModVParam -> Name
T.mvpName ModVParam
p) Doc -> Doc -> Doc
<+> Doc
":", Schema -> Doc
forall a. PP a => a -> Doc
pp (ModVParam -> Schema
T.mvpType ModVParam
p)])
  -- XXX: should we print the constraints somewhere too?


browseMods :: DispInfo -> IfaceDecls -> [Doc]
browseMods :: DispInfo -> IfaceDecls -> [Doc]
browseMods DispInfo
disp IfaceDecls
decls =
  DispInfo
-> String
-> (IfaceNames Name -> Doc)
-> Map Name (IfaceNames Name)
-> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Submodules" IfaceNames Name -> Doc
forall {a}. PP a => IfaceNames a -> Doc
ppM (IfaceDecls -> Map Name (IfaceNames Name)
ifModules IfaceDecls
decls)
  where
  ppM :: IfaceNames a -> Doc
ppM IfaceNames a
m = a -> Doc
forall a. PP a => a -> Doc
pp (IfaceNames a -> a
forall name. IfaceNames name -> name
ifsName IfaceNames a
m)

browseFunctors :: DispInfo -> IfaceDecls -> [Doc]
browseFunctors :: DispInfo -> IfaceDecls -> [Doc]
browseFunctors DispInfo
disp IfaceDecls
decls =
  DispInfo
-> String
-> (IfaceG Name -> Doc)
-> Map Name (IfaceG Name)
-> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Parameterized Submodules" IfaceG Name -> Doc
forall {a}. PP a => IfaceG a -> Doc
ppM (IfaceDecls -> Map Name (IfaceG Name)
ifFunctors IfaceDecls
decls)
  where
  ppM :: IfaceG a -> Doc
ppM IfaceG a
m = a -> Doc
forall a. PP a => a -> Doc
pp (IfaceG a -> a
forall name. IfaceG name -> name
ifModName IfaceG a
m)




browseSignatures :: DispInfo -> IfaceDecls -> [Doc]
browseSignatures :: DispInfo -> IfaceDecls -> [Doc]
browseSignatures DispInfo
disp IfaceDecls
decls =
  DispInfo
-> String
-> ((Name, ModParamNames) -> Doc)
-> Map Name (Name, ModParamNames)
-> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Interface Submodules"
    (Name, ModParamNames) -> Doc
forall {a} {b}. PP a => (a, b) -> Doc
ppS ((Name -> ModParamNames -> (Name, ModParamNames))
-> Map Name ModParamNames -> Map Name (Name, ModParamNames)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (,) (IfaceDecls -> Map Name ModParamNames
ifSignatures IfaceDecls
decls))
  where
  ppS :: (a, b) -> Doc
ppS (a
x,b
_s) = a -> Doc
forall a. PP a => a -> Doc
pp a
x


browseTSyns :: DispInfo -> IfaceDecls -> [Doc]
browseTSyns :: DispInfo -> IfaceDecls -> [Doc]
browseTSyns DispInfo
disp IfaceDecls
decls =
     DispInfo -> String -> (TySyn -> Doc) -> Map Name TySyn -> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Type Synonyms" TySyn -> Doc
forall a. PP a => a -> Doc
pp Map Name TySyn
tss
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ DispInfo -> String -> (TySyn -> Doc) -> Map Name TySyn -> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Constraint Synonyms" TySyn -> Doc
forall a. PP a => a -> Doc
pp Map Name TySyn
cts
  where
  (Map Name TySyn
cts,Map Name TySyn
tss)  = (TySyn -> Bool)
-> Map Name TySyn -> (Map Name TySyn, Map Name TySyn)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition TySyn -> Bool
isCtrait (IfaceDecls -> Map Name TySyn
ifTySyns IfaceDecls
decls)
  isCtrait :: TySyn -> Bool
isCtrait TySyn
t = Kind -> Kind
T.kindResult (Type -> Kind
forall t. HasKind t => t -> Kind
T.kindOf (TySyn -> Type
T.tsDef TySyn
t)) Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
T.KProp

browsePrimTys :: DispInfo -> IfaceDecls -> [Doc]
browsePrimTys :: DispInfo -> IfaceDecls -> [Doc]
browsePrimTys DispInfo
disp IfaceDecls
decls =
  DispInfo
-> String -> (NominalType -> Doc) -> Map Name NominalType -> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Primitive Types" NominalType -> Doc
ppA Map Name NominalType
ats
  where
  ats :: Map Name NominalType
ats = (NominalType -> Bool)
-> Map Name NominalType -> Map Name NominalType
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter NominalType -> Bool
T.nominalTypeIsAbstract (IfaceDecls -> Map Name NominalType
ifNominalTypes IfaceDecls
decls)
  ppA :: NominalType -> Doc
ppA NominalType
a = Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
sep [Name -> Doc
forall a. PP a => a -> Doc
pp (NominalType -> Name
T.ntName NominalType
a) Doc -> Doc -> Doc
<+> Doc
":", Kind -> Doc
forall a. PP a => a -> Doc
pp (NominalType -> Kind
forall t. HasKind t => t -> Kind
T.kindOf NominalType
a)])

browseNominalTypes :: DispInfo -> IfaceDecls -> [Doc]
browseNominalTypes :: DispInfo -> IfaceDecls -> [Doc]
browseNominalTypes DispInfo
disp IfaceDecls
decls =
  DispInfo
-> String -> (NominalType -> Doc) -> Map Name NominalType -> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Nominal Types" NominalType -> Doc
T.ppNominalShort
    ((NominalType -> Bool)
-> Map Name NominalType -> Map Name NominalType
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (NominalType -> Bool) -> NominalType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalType -> Bool
T.nominalTypeIsAbstract) (IfaceDecls -> Map Name NominalType
ifNominalTypes IfaceDecls
decls))

browseVars :: DispInfo -> IfaceDecls -> [Doc]
browseVars :: DispInfo -> IfaceDecls -> [Doc]
browseVars DispInfo
disp IfaceDecls
decls =
     DispInfo
-> String -> (IfaceDecl -> Doc) -> Map Name IfaceDecl -> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Properties" IfaceDecl -> Doc
ppVar Map Name IfaceDecl
props
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ DispInfo
-> String -> (IfaceDecl -> Doc) -> Map Name IfaceDecl -> [Doc]
forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
"Symbols"    IfaceDecl -> Doc
ppVar Map Name IfaceDecl
syms
  where
  isProp :: IfaceDecl -> Bool
isProp IfaceDecl
p     = Pragma
PragmaProperty Pragma -> [Pragma] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` IfaceDecl -> [Pragma]
ifDeclPragmas IfaceDecl
p
  (Map Name IfaceDecl
props,Map Name IfaceDecl
syms) = (IfaceDecl -> Bool)
-> Map Name IfaceDecl -> (Map Name IfaceDecl, Map Name IfaceDecl)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition IfaceDecl -> Bool
isProp (IfaceDecls -> Map Name IfaceDecl
ifDecls IfaceDecls
decls)

  ppVar :: IfaceDecl -> Doc
ppVar IfaceDecl
d      = Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
sep [Name -> Doc
forall a. PP a => a -> Doc
pp (IfaceDecl -> Name
ifDeclName IfaceDecl
d) Doc -> Doc -> Doc
<+> Doc
":", Schema -> Doc
forall a. PP a => a -> Doc
pp (IfaceDecl -> Schema
ifDeclSig IfaceDecl
d)])

--------------------------------------------------------------------------------

ppSection :: DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection :: forall a. DispInfo -> String -> (a -> Doc) -> Map Name a -> [Doc]
ppSection DispInfo
disp String
heading a -> Doc
ppThing Map Name a
mp =
  String -> [Doc] -> [Doc]
ppSectionHeading String
heading
  case DispInfo -> BrowseHow
dispHow DispInfo
disp of
    BrowseHow
BrowseExported | [(ModPath
_,[a]
xs)] <- [(ModPath, [a])]
grouped -> [a] -> [Doc]
ppThings [a]
xs
    BrowseHow
_ -> ((ModPath, [a]) -> [Doc]) -> [(ModPath, [a])] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModPath, [a]) -> [Doc]
forall {a}. PP a => (a, [a]) -> [Doc]
ppMod [(ModPath, [a])]
grouped
  where
  grouped :: [(ModPath, [a])]
grouped = NameDisp -> Map Name a -> [(ModPath, [a])]
forall a. NameDisp -> Map Name a -> [(ModPath, [a])]
groupDecls (DispInfo -> NameDisp
env DispInfo
disp) Map Name a
mp

  ppThings :: [a] -> [Doc]
ppThings [a]
xs = (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
ppThing [a]
xs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
" "]

  ppMod :: (a, [a]) -> [Doc]
ppMod (a
nm,[a]
things) =
    [ Doc
"From" Doc -> Doc -> Doc
<+> a -> Doc
forall a. PP a => a -> Doc
pp a
nm
    , Doc
"-----" Doc -> Doc -> Doc
<.> String -> Doc
text ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
'-') (Doc Void -> String
forall a. Show a => a -> String
show (NameDisp -> Doc -> Doc Void
runDoc (DispInfo -> NameDisp
env DispInfo
disp) (a -> Doc
forall a. PP a => a -> Doc
pp a
nm))))
    , Doc
"     "
    , Int -> Doc -> Doc
indent Int
2 ([Doc] -> Doc
vcat ([a] -> [Doc]
ppThings [a]
things))
    ]

ppSectionHeading :: String -> [Doc] -> [Doc]
ppSectionHeading :: String -> [Doc] -> [Doc]
ppSectionHeading String
heading [Doc]
body
  | [Doc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
body = []
  | Bool
otherwise =
     [ String -> Doc
text String
heading
     , String -> Doc
text ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
'=') String
heading)
     , Doc
"    "
     , Int -> Doc -> Doc
indent Int
2 ([Doc] -> Doc
vcat [Doc]
body)
     ]




-- | Organize by module where defined, then sort by name.
groupDecls :: NameDisp -> Map Name a -> [(ModPath,[a])]
groupDecls :: forall a. NameDisp -> Map Name a -> [(ModPath, [a])]
groupDecls NameDisp
disp = Map ModPath [a] -> [(ModPath, [a])]
forall k a. Map k a -> [(k, a)]
Map.toList
                (Map ModPath [a] -> [(ModPath, [a])])
-> (Map Name a -> Map ModPath [a])
-> Map Name a
-> [(ModPath, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Name, a)] -> [a]) -> Map ModPath [(Name, a)] -> Map ModPath [a]
forall a b. (a -> b) -> Map ModPath a -> Map ModPath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NameDisp -> [(Name, a)] -> [a]
forall a. NameDisp -> [(Name, a)] -> [a]
sortByName NameDisp
disp)
                (Map ModPath [(Name, a)] -> Map ModPath [a])
-> (Map Name a -> Map ModPath [(Name, a)])
-> Map Name a
-> Map ModPath [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Name, a)] -> [(Name, a)] -> [(Name, a)])
-> [(ModPath, [(Name, a)])] -> Map ModPath [(Name, a)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [(Name, a)] -> [(Name, a)] -> [(Name, a)]
forall a. [a] -> [a] -> [a]
(++)
                ([(ModPath, [(Name, a)])] -> Map ModPath [(Name, a)])
-> (Map Name a -> [(ModPath, [(Name, a)])])
-> Map Name a
-> Map ModPath [(Name, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, a) -> Maybe (ModPath, [(Name, a)]))
-> [(Name, a)] -> [(ModPath, [(Name, a)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name, a) -> Maybe (ModPath, [(Name, a)])
forall {b}. (Name, b) -> Maybe (ModPath, [(Name, b)])
toEntry
                ([(Name, a)] -> [(ModPath, [(Name, a)])])
-> (Map Name a -> [(Name, a)])
-> Map Name a
-> [(ModPath, [(Name, a)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name a -> [(Name, a)]
forall k a. Map k a -> [(k, a)]
Map.toList
  where
  toEntry :: (Name, b) -> Maybe (ModPath, [(Name, b)])
toEntry (Name
n,b
a) =
    case Name -> NameInfo
nameInfo Name
n of
      GlobalName NameSource
_ OrigName
og -> (ModPath, [(Name, b)]) -> Maybe (ModPath, [(Name, b)])
forall a. a -> Maybe a
Just (OrigName -> ModPath
ogModule OrigName
og,[(Name
n,b
a)])
      NameInfo
_               -> Maybe (ModPath, [(Name, b)])
forall a. Maybe a
Nothing


sortByName :: NameDisp -> [(Name,a)] -> [a]
sortByName :: forall a. NameDisp -> [(Name, a)] -> [a]
sortByName NameDisp
disp = ((Name, a) -> a) -> [(Name, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Name, a) -> a
forall a b. (a, b) -> b
snd ([(Name, a)] -> [a])
-> ([(Name, a)] -> [(Name, a)]) -> [(Name, a)] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, a) -> (Name, a) -> Ordering) -> [(Name, a)] -> [(Name, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Name, a) -> (Name, a) -> Ordering
forall {b} {b}. (Name, b) -> (Name, b) -> Ordering
cmpByDispName
  where
  cmpByDispName :: (Name, b) -> (Name, b) -> Ordering
cmpByDispName (Name
x,b
_) (Name
y,b
_) =  NameDisp -> Name -> Name -> Ordering
cmpNameDisplay NameDisp
disp Name
x Name
y