    {-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveFunctor, GADTs,
                 GeneralizedNewtypeDeriving, LambdaCase, RecordWildCards,
                 ScopedTypeVariables, TupleSections, ViewPatterns #-}

    module Output.Types(writeTypes, searchTypes, searchFingerprintsDebug) where

    {-
    Approach:
    Each signature is stored, along with a fingerprint
    A quick search finds the most promising 100 fingerprints
    A slow search ranks the 100 items, excluding some
    -}

    import Control.Applicative
    import Control.Monad.Extra
    import Control.Monad.ST
    import Control.Monad.Trans.Class
    import Control.Monad.Trans.State.Strict
    import Data.Binary hiding (get, put)
    import qualified Data.ByteString.Char8 as BS
    import Data.Data
    import Data.Generics.Uniplate.Data
    import Data.List.Extra
    import qualified Data.Map.Strict as Map
    import Data.Maybe
    import qualified Data.Set as Set
    import Data.STRef
    import Data.Tuple.Extra
    import qualified Data.Vector.Storable as V
    import qualified Data.Vector.Storable.Mutable as VM
    import Foreign.Storable
    import Numeric.Extra
    import Prelude
    import System.FilePath
    import System.IO.Extra
    import Safe

    import General.IString
    import General.Store
    import General.Str
    import General.Util
    import Input.Item

    writeTypes :: StoreWrite -> Maybe FilePath -> [(Maybe TargetId, Item)] -> IO ()
    writeTypes :: StoreWrite -> Maybe FilePath -> [(Maybe TargetId, Item)] -> IO ()
    writeTypes StoreWrite
    store Maybe FilePath
    debug [(Maybe TargetId, Item)]
    xs = do
        let debugger :: FilePath -> FilePath -> IO ()
    debugger FilePath
    ext FilePath
    body = Maybe FilePath -> (FilePath -> IO ()) -> IO ()
    forall (m :: * -> *) a.
    Applicative m =>
    Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe FilePath
    debug ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    file -> FilePath -> FilePath -> IO ()
    writeFileUTF8 (FilePath
    file FilePath -> FilePath -> FilePath
    <.> FilePath
    ext) FilePath
    body
        inst <- Map Str Int -> IO (Map Str Int)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map Str Int -> IO (Map Str Int))
    -> Map Str Int -> IO (Map Str Int)
    forall a b. (a -> b) -> a -> b
    $ (Int -> Int -> Int) -> [(Str, Int)] -> Map Str Int
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) [(IString -> Str
    fromIString IString
    x,Int
    1) | (Maybe TargetId
    _, IInstance (Sig [Ctx IString]
    _ [TCon IString
    x [Ty IString]
    _])) <- [(Maybe TargetId, Item)]
    xs]
        xs <- writeDuplicates store [(i, fromIString <$> t) | (Just i, ISignature t) <- xs]
        names <- writeNames store debugger inst xs
        xs <- pure $ map (lookupNames names (error "Unknown name in writeTypes")) xs
        writeFingerprints store xs
        writeSignatures store xs

    searchTypes :: StoreRead -> Sig String -> [TargetId]
    searchTypes :: StoreRead -> Sig FilePath -> [TargetId]
    searchTypes StoreRead
    store Sig FilePath
    q =
        Int -> [TargetId] -> [TargetId]
    forall a. Int -> [a] -> [a]
    take Int
    nMatches ([[TargetId]] -> [TargetId]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [(Int, (Int, SigLoc, Fingerprint))] -> Sig Name -> [TargetId]
    search [(Int, (Int, SigLoc, Fingerprint))]
    fps Sig Name
    qry' | [Sig Name -> [Sig Name]]
    variantClass <- [[Sig Name -> [Sig Name]]]
    variants
                                                , Sig Name
    fpSig <- case [Sig Name -> [Sig Name]] -> Sig Name -> [Sig Name]
    forall a. HasCallStack => [a] -> a
    headErr [Sig Name -> [Sig Name]]
    variantClass Sig Name
    qry of
                                                              (Sig Name
    f:[Sig Name]
    _) -> [Sig Name
    f]
                                                              []    -> []
                                                , let fps :: [(Int, (Int, SigLoc, Fingerprint))]
    fps = [(SigLoc, Fingerprint)]
    -> Int -> Sig Name -> [(Int, (Int, SigLoc, Fingerprint))]
    bestByFingerprint [(SigLoc, Fingerprint)]
    db Int
    nMatches Sig Name
    fpSig
                                                , Sig Name -> [Sig Name]
    variant <- [Sig Name -> [Sig Name]]
    variantClass
                                                , Sig Name
    qry' <- Sig Name -> [Sig Name]
    variant Sig Name
    qry
                                                ])
        where
            nMatches :: Int
    nMatches = Int
    100
            qry :: Sig Name
    qry = Names -> Name -> Sig Str -> Sig Name
    lookupNames Names
    names Name
    name0 (FilePath -> Str
    strPack (FilePath -> Str) -> Sig FilePath -> Sig Str
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Sig FilePath
    q) -- map unknown fields to name0, i.e. _
            names :: Names
    names = StoreRead -> Names
    readNames StoreRead
    store
            search :: [(Int, (Int, SigLoc, Fingerprint))] -> Sig Name -> [TargetId]
    search [(Int, (Int, SigLoc, Fingerprint))]
    fps Sig Name
    sig = (Int -> [TargetId]) -> [Int] -> [TargetId]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Duplicates -> Int -> [TargetId]
    expandDuplicates (Duplicates -> Int -> [TargetId])
    -> Duplicates -> Int -> [TargetId]
    forall a b. (a -> b) -> a -> b
    $ StoreRead -> Duplicates
    readDuplicates StoreRead
    store)
                             ([Int] -> [TargetId]) -> [Int] -> [TargetId]
    forall a b. (a -> b) -> a -> b
    $ [(Int, (Int, SigLoc, Fingerprint))]
    -> (SigLoc -> Sig Name) -> Name -> Int -> Sig Name -> [Int]
    searchTypeMatch [(Int, (Int, SigLoc, Fingerprint))]
    fps SigLoc -> Sig Name
    getSig Name
    arrow Int
    nMatches Sig Name
    sig
            db :: [(SigLoc, Fingerprint)]
    db  = [SigLoc] -> [Fingerprint] -> [(SigLoc, Fingerprint)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (StoreRead -> [SigLoc]
    readSignatureIndex StoreRead
    store)
                      (Vector Fingerprint -> [Fingerprint]
    forall a. Storable a => Vector a -> [a]
    V.toList (Vector Fingerprint -> [Fingerprint])
    -> Vector Fingerprint -> [Fingerprint]
    forall a b. (a -> b) -> a -> b
    $ StoreRead
    -> TypesFingerprints (Vector Fingerprint) -> Vector Fingerprint
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store TypesFingerprints (Vector Fingerprint)
    TypesFingerprints :: [Fingerprint])
            getSig :: SigLoc -> Sig Name
    getSig = StoreRead -> SigLoc -> Sig Name
    readSignatureAt StoreRead
    store
            arrow :: Name
    arrow = StoreRead -> Names -> FilePath -> Name
    lookupCtor StoreRead
    store Names
    names FilePath
    "->"

            -- Different variations on the search query. Each variation is run in turn until we've gathered
            -- 100 hits or run out of variations to try.
            -- As an optimization, these are grouped by variants that have the same fingerprint, saving
            -- redundant scans through the fingerprint data.
            variants :: [[Sig Name -> [Sig Name]]]
    variants = [ [ Sig Name -> [Sig Name]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure, Sig Name -> [Sig Name]
    forall {n}. Sig n -> [Sig n]
    permuted ],
                         [ Sig Name -> [Sig Name]
    partial, Sig Name -> [Sig Name]
    partial (Sig Name -> [Sig Name])
    -> (Sig Name -> [Sig Name]) -> Sig Name -> [Sig Name]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Sig Name -> [Sig Name]
    forall {n}. Sig n -> [Sig n]
    permuted ] ]

            -- Permute the arguments of a two-argument query.
            permuted :: Sig n -> [Sig n]
    permuted Sig n
    qq = case Sig n -> [Ty n]
    forall n. Sig n -> [Ty n]
    sigTy Sig n
    qq of
                [Ty n
    a1, Ty n
    a2, Ty n
    r] -> [ Sig n
    qq { sigTy = [a2, a1, r] } ]
                [Ty n]
    _           -> []

            -- Add a `Maybe` to the query's result type.
            partial :: Sig Name -> [Sig Name]
    partial  Sig Name
    qq = case Sig Name -> [Ty Name]
    forall n. Sig n -> [Ty n]
    sigTy Sig Name
    qq of
                []  -> []
                [Ty Name]
    tys -> [ Sig Name
    qq { sigTy = init tys ++ [TCon maybeCtor [last tys]] } ]

            maybeCtor :: Name
    maybeCtor = StoreRead -> Names -> FilePath -> Name
    lookupCtor StoreRead
    store Names
    names FilePath
    "Maybe"

    lookupCtor :: StoreRead -> Names -> String -> Name
    lookupCtor :: StoreRead -> Names -> FilePath -> Name
    lookupCtor StoreRead
    store Names
    names FilePath
    c =
        case Sig Name -> [Ty Name]
    forall n. Sig n -> [Ty n]
    sigTy (Names -> Name -> Sig Str -> Sig Name
    lookupNames Names
    names Name
    name0 Sig Str
    s) of
            [TCon Name
    n [Ty Name]
    _] -> Name
    n
            [Ty Name]
    _          -> Name
    name0
        where
          s :: Sig Str
    s = FilePath -> Str
    strPack (FilePath -> Str) -> Sig FilePath -> Sig Str
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Sig { sigCtx :: [Ctx FilePath]
    sigCtx = [], sigTy :: [Ty FilePath]
    sigTy = [FilePath -> [Ty FilePath] -> Ty FilePath
    forall n. n -> [Ty n] -> Ty n
    TCon FilePath
    c []] }

    searchFingerprintsDebug :: StoreRead -> (String, Sig String) -> [(String, Sig String)] -> [String]
    searchFingerprintsDebug :: StoreRead
    -> (FilePath, Sig FilePath)
    -> [(FilePath, Sig FilePath)]
    -> [FilePath]
    searchFingerprintsDebug StoreRead
    store (FilePath, Sig FilePath)
    query [(FilePath, Sig FilePath)]
    answers = [FilePath] -> [[FilePath]] -> [FilePath]
    forall a. [a] -> [[a]] -> [a]
    intercalate [FilePath
    ""] ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $
        Bool -> FilePath -> (FilePath, Sig FilePath) -> [FilePath]
    f Bool
    False FilePath
    "Query" (FilePath, Sig FilePath)
    query [FilePath] -> [[FilePath]] -> [[FilePath]]
    forall a. a -> [a] -> [a]
    : (Integer -> (FilePath, Sig FilePath) -> [FilePath])
    -> Integer -> [(FilePath, Sig FilePath)] -> [[FilePath]]
    forall a b c. Enum a => (a -> b -> c) -> a -> [b] -> [c]
    zipWithFrom (\Integer
    i -> Bool -> FilePath -> (FilePath, Sig FilePath) -> [FilePath]
    f Bool
    True (FilePath
    "Answer " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    i)) Integer
    1 [(FilePath, Sig FilePath)]
    answers
        where
            qsig :: Sig Name
    qsig = Names -> Name -> Sig Str -> Sig Name
    lookupNames Names
    names Name
    name0 (Sig Str -> Sig Name) -> Sig Str -> Sig Name
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Str
    strPack (FilePath -> Str) -> Sig FilePath -> Sig Str
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FilePath, Sig FilePath) -> Sig FilePath
    forall a b. (a, b) -> b
    snd (FilePath, Sig FilePath)
    query
            names :: Names
    names = StoreRead -> Names
    readNames StoreRead
    store

            f :: Bool -> FilePath -> (FilePath, Sig FilePath) -> [FilePath]
    f Bool
    match FilePath
    name (FilePath
    raw, Sig FilePath
    sig) =
                [FilePath
    name FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ": " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    raw
                ,FilePath
    "Sig String: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Sig FilePath -> FilePath
    prettySig Sig FilePath
    sig
                ,FilePath
    "Sig Name: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Sig FilePath -> FilePath
    prettySig ((Name -> FilePath) -> Sig Name -> Sig FilePath
    forall a b. (a -> b) -> Sig a -> Sig b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> FilePath
    prettyName Sig Name
    sn)
                ,FilePath
    "Fingerprint: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Fingerprint -> FilePath
    prettyFingerprint Fingerprint
    fp] [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++
                if Bool -> Bool
    not Bool
    match then [] else
                [FilePath
    "Cost: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> (Int -> FilePath) -> Maybe Int -> FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe FilePath
    "X, no match" Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Sig Name -> Fingerprint -> Maybe Int
    matchFingerprint Sig Name
    qsig Fingerprint
    fp)
                ,FilePath
    "Explain: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ [Either FilePath (FilePath, Int)] -> FilePath
    showExplain (Sig Name -> Fingerprint -> [Either FilePath (FilePath, Int)]
    matchFingerprintDebug Sig Name
    qsig Fingerprint
    fp)]
                where
                    sn :: Sig Name
    sn = Names -> Name -> Sig Str -> Sig Name
    lookupNames Names
    names Name
    name0 (Sig Str -> Sig Name) -> Sig Str -> Sig Name
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Str
    strPack (FilePath -> Str) -> Sig FilePath -> Sig Str
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Sig FilePath
    sig
                    fp :: Fingerprint
    fp = Sig Name -> Fingerprint
    toFingerprint Sig Name
    sn

                    showExplain :: [Either FilePath (FilePath, Int)] -> FilePath
    showExplain = FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate FilePath
    ", " ([FilePath] -> FilePath)
    -> ([Either FilePath (FilePath, Int)] -> [FilePath])
    -> [Either FilePath (FilePath, Int)]
    -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Either FilePath (FilePath, Int) -> FilePath)
    -> [Either FilePath (FilePath, Int)] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map Either FilePath (FilePath, Int) -> FilePath
    forall {a}. Show a => Either FilePath (FilePath, a) -> FilePath
    g ([Either FilePath (FilePath, Int)] -> [FilePath])
    -> ([Either FilePath (FilePath, Int)]
        -> [Either FilePath (FilePath, Int)])
    -> [Either FilePath (FilePath, Int)]
    -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Either FilePath (FilePath, Int) -> Int)
    -> [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn ((FilePath -> Int)
    -> ((FilePath, Int) -> Int)
    -> Either FilePath (FilePath, Int)
    -> Int
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Int -> FilePath -> Int
    forall a b. a -> b -> a
    const Int
    forall a. Bounded a => a
    minBound) (Int -> Int
    forall a. Num a => a -> a
    negate (Int -> Int) -> ((FilePath, Int) -> Int) -> (FilePath, Int) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath, Int) -> Int
    forall a b. (a, b) -> b
    snd))
                    g :: Either FilePath (FilePath, a) -> FilePath
    g (Left FilePath
    s) = FilePath
    "X " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    s
                    g (Right (FilePath
    s, a
    x)) = a -> FilePath
    forall a. Show a => a -> FilePath
    show a
    x FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    s

    ---------------------------------------------------------------------
    -- NAME/CTOR INFORMATION

    data TypesNames a where TypesNames :: TypesNames (BStr0, V.Vector Name) deriving Typeable

    -- At around 7000 packages, Word16 becomes insufficient
    -- because there are more than 2^16 Names, so we use Word32.
    type NameWord = Word32

    -- Must be a unique Name per String.
    -- First 0-99 are variables, rest are constructors.
    -- More popular type constructors have higher numbers.
    -- There are currently about 14K names, so about 25% of the bit patterns are taken
    newtype Name = Name NameWord deriving (Name -> Name -> Bool
    (Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Name -> Name -> Bool
    == :: Name -> Name -> Bool
    $c/= :: Name -> Name -> Bool
    /= :: Name -> Name -> Bool
    Eq,Eq Name
    Eq Name =>
    (Name -> Name -> Ordering)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Name)
    -> (Name -> Name -> Name)
    -> Ord Name
    Name -> Name -> Bool
    Name -> Name -> Ordering
    Name -> Name -> Name
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Name -> Name -> Ordering
    compare :: Name -> Name -> Ordering
    $c< :: Name -> Name -> Bool
    < :: Name -> Name -> Bool
    $c<= :: Name -> Name -> Bool
    <= :: Name -> Name -> Bool
    $c> :: Name -> Name -> Bool
    > :: Name -> Name -> Bool
    $c>= :: Name -> Name -> Bool
    >= :: Name -> Name -> Bool
    $cmax :: Name -> Name -> Name
    max :: Name -> Name -> Name
    $cmin :: Name -> Name -> Name
    min :: Name -> Name -> Name
    Ord,Int -> Name -> FilePath -> FilePath
    [Name] -> FilePath -> FilePath
    Name -> FilePath
    (Int -> Name -> FilePath -> FilePath)
    -> (Name -> FilePath)
    -> ([Name] -> FilePath -> FilePath)
    -> Show Name
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> Name -> FilePath -> FilePath
    showsPrec :: Int -> Name -> FilePath -> FilePath
    $cshow :: Name -> FilePath
    show :: Name -> FilePath
    $cshowList :: [Name] -> FilePath -> FilePath
    showList :: [Name] -> FilePath -> FilePath
    Show,Typeable Name
    Typeable Name =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> Name -> c Name)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c Name)
    -> (Name -> Constr)
    -> (Name -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c Name))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name))
    -> ((forall b. Data b => b -> b) -> Name -> Name)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r)
    -> (forall u. (forall d. Data d => d -> u) -> Name -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> Name -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> Name -> m Name)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> Name -> m Name)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> Name -> m Name)
    -> Data Name
    Name -> Constr
    Name -> DataType
    (forall b. Data b => b -> b) -> Name -> Name
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> Name -> u
    forall u. (forall d. Data d => d -> u) -> Name -> [u]
    forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
    forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Name -> m Name
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Name -> m Name
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Name
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Name -> c Name
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Name)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Name -> c Name
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Name -> c Name
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Name
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Name
    $ctoConstr :: Name -> Constr
    toConstr :: Name -> Constr
    $cdataTypeOf :: Name -> DataType
    dataTypeOf :: Name -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Name)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Name)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name)
    $cgmapT :: (forall b. Data b => b -> b) -> Name -> Name
    gmapT :: (forall b. Data b => b -> b) -> Name -> Name
    $cgmapQl :: forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
    gmapQl :: forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
    gmapQr :: forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> Name -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> Name -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Name -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Name -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Name -> m Name
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Name -> m Name
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Name -> m Name
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Name -> m Name
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Name -> m Name
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Name -> m Name
    Data,Typeable,Ptr Name -> IO Name
    Ptr Name -> Int -> IO Name
    Ptr Name -> Int -> Name -> IO ()
    Ptr Name -> Name -> IO ()
    Name -> Int
    (Name -> Int)
    -> (Name -> Int)
    -> (Ptr Name -> Int -> IO Name)
    -> (Ptr Name -> Int -> Name -> IO ())
    -> (forall b. Ptr b -> Int -> IO Name)
    -> (forall b. Ptr b -> Int -> Name -> IO ())
    -> (Ptr Name -> IO Name)
    -> (Ptr Name -> Name -> IO ())
    -> Storable Name
    forall b. Ptr b -> Int -> IO Name
    forall b. Ptr b -> Int -> Name -> IO ()
    forall a.
    (a -> Int)
    -> (a -> Int)
    -> (Ptr a -> Int -> IO a)
    -> (Ptr a -> Int -> a -> IO ())
    -> (forall b. Ptr b -> Int -> IO a)
    -> (forall b. Ptr b -> Int -> a -> IO ())
    -> (Ptr a -> IO a)
    -> (Ptr a -> a -> IO ())
    -> Storable a
    $csizeOf :: Name -> Int
    sizeOf :: Name -> Int
    $calignment :: Name -> Int
    alignment :: Name -> Int
    $cpeekElemOff :: Ptr Name -> Int -> IO Name
    peekElemOff :: Ptr Name -> Int -> IO Name
    $cpokeElemOff :: Ptr Name -> Int -> Name -> IO ()
    pokeElemOff :: Ptr Name -> Int -> Name -> IO ()
    $cpeekByteOff :: forall b. Ptr b -> Int -> IO Name
    peekByteOff :: forall b. Ptr b -> Int -> IO Name
    $cpokeByteOff :: forall b. Ptr b -> Int -> Name -> IO ()
    pokeByteOff :: forall b. Ptr b -> Int -> Name -> IO ()
    $cpeek :: Ptr Name -> IO Name
    peek :: Ptr Name -> IO Name
    $cpoke :: Ptr Name -> Name -> IO ()
    poke :: Ptr Name -> Name -> IO ()
    Storable,Get Name
    [Name] -> Put
    Name -> Put
    (Name -> Put) -> Get Name -> ([Name] -> Put) -> Binary Name
    forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
    $cput :: Name -> Put
    put :: Name -> Put
    $cget :: Get Name
    get :: Get Name
    $cputList :: [Name] -> Put
    putList :: [Name] -> Put
    Binary)

    name0 :: Name
    name0 = Word32 -> Name
    Name Word32
    0 -- use to represent _

    isCon, isVar :: Name -> Bool
    isVar :: Name -> Bool
    isVar (Name Word32
    x) = Word32
    x Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word32
    100
    isCon :: Name -> Bool
    isCon = Bool -> Bool
    not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Bool
    isVar

    prettyName :: Name -> String
    prettyName :: Name -> FilePath
    prettyName x :: Name
    x@(Name Word32
    i)
        | Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    name0 = FilePath
    "_"
        | Name -> Bool
    isVar Name
    x = FilePath
    "v" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word32 -> FilePath
    forall a. Show a => a -> FilePath
    show Word32
    i
        | Bool
    otherwise = FilePath
    "C" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word32 -> FilePath
    forall a. Show a => a -> FilePath
    show Word32
    i

    -- | Give a name a popularity, where 0 is least popular, 1 is most popular
    popularityName :: Name -> Double
    popularityName :: Name -> Double
    popularityName (Name Word32
    n) | Name -> Bool
    isVar (Name -> Bool) -> Name -> Bool
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Name
    Name Word32
    n = FilePath -> Double
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "Can't call popularityName on a Var"
                            | Bool
    otherwise = Word32 -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    n Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    100) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Word32 -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    forall a. Bounded a => a
    maxBound Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    100 :: NameWord)

    newtype Names = Names {Names -> Str -> Maybe Name
    lookupName :: Str -> Maybe Name}

    lookupNames :: Names -> Name -> Sig Str -> Sig Name
    lookupNames :: Names -> Name -> Sig Str -> Sig Name
    lookupNames Names{Str -> Maybe Name
    lookupName :: Names -> Str -> Maybe Name
    lookupName :: Str -> Maybe Name
    ..} Name
    def (Sig [Ctx Str]
    ctx [Ty Str]
    typ) = [Ctx Name] -> [Ty Name] -> Sig Name
    forall n. [Ctx n] -> [Ty n] -> Sig n
    Sig ((Ctx Str -> Ctx Name) -> [Ctx Str] -> [Ctx Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Ctx Str -> Ctx Name
    f [Ctx Str]
    ctx) ((Ty Str -> Ty Name) -> [Ty Str] -> [Ty Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Ty Str -> Ty Name
    g [Ty Str]
    typ)
        where
            vars :: [Str]
    vars = [Str] -> [Str]
    forall a. Ord a => [a] -> [a]
    nubOrd ([Str] -> [Str]) -> [Str] -> [Str]
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Str
    strPack FilePath
    "_" Str -> [Str] -> [Str]
    forall a. a -> [a] -> [a]
    : [Str
    x | Ctx Str
    _ Str
    x <- [Ctx Str]
    ctx] [Str] -> [Str] -> [Str]
    forall a. [a] -> [a] -> [a]
    ++ [Str
    x | TVar Str
    x [Ty Str]
    _ <- [Ty Str] -> [Ty Str]
    forall from to. Biplate from to => from -> [to]
    universeBi [Ty Str]
    typ]
            var :: Str -> Name
    var Str
    x = Word32 -> Name
    Name (Word32 -> Name) -> Word32 -> Name
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Word32 -> Word32
    forall a. Ord a => a -> a -> a
    min Word32
    99 (Word32 -> Word32) -> Word32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> Int
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "lookupNames") (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Str -> [Str] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex Str
    x [Str]
    vars
            con :: Str -> Name
    con = Name -> Maybe Name -> Name
    forall a. a -> Maybe a -> a
    fromMaybe Name
    def (Maybe Name -> Name) -> (Str -> Maybe Name) -> Str -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Str -> Maybe Name
    lookupName

            f :: Ctx Str -> Ctx Name
    f (Ctx Str
    a Str
    b) = Name -> Name -> Ctx Name
    forall n. n -> n -> Ctx n
    Ctx (Str -> Name
    con (Str -> Name) -> Str -> Name
    forall a b. (a -> b) -> a -> b
    $ Char -> Str -> Str
    strCons Char
    '~' Str
    a) (Str -> Name
    var Str
    b)
            g :: Ty Str -> Ty Name
    g (TCon Str
    x [Ty Str]
    xs) = Name -> [Ty Name] -> Ty Name
    forall n. n -> [Ty n] -> Ty n
    TCon (Str -> Name
    con Str
    x) ([Ty Name] -> Ty Name) -> [Ty Name] -> Ty Name
    forall a b. (a -> b) -> a -> b
    $ (Ty Str -> Ty Name) -> [Ty Str] -> [Ty Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Ty Str -> Ty Name
    g [Ty Str]
    xs
            g (TVar Str
    x [Ty Str]
    xs) = Name -> [Ty Name] -> Ty Name
    forall n. n -> [Ty n] -> Ty n
    TVar (Str -> Name
    var Str
    x) ([Ty Name] -> Ty Name) -> [Ty Name] -> Ty Name
    forall a b. (a -> b) -> a -> b
    $ (Ty Str -> Ty Name) -> [Ty Str] -> [Ty Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Ty Str -> Ty Name
    g [Ty Str]
    xs

    writeNames :: StoreWrite -> (String -> String -> IO ()) -> Map.Map Str Int -> [Sig Str] -> IO Names
    writeNames :: StoreWrite
    -> (FilePath -> FilePath -> IO ())
    -> Map Str Int
    -> [Sig Str]
    -> IO Names
    writeNames StoreWrite
    store FilePath -> FilePath -> IO ()
    debug Map Str Int
    inst [Sig Str]
    xs = do
        let sigNames :: Sig Str -> [Str]
    sigNames (Sig [Ctx Str]
    ctx [Ty Str]
    typ) = [Str] -> [Str]
    forall a. Ord a => [a] -> [a]
    nubOrd [Char -> Str -> Str
    strCons Char
    '~' Str
    x | Ctx Str
    x Str
    _ <- [Ctx Str]
    ctx] [Str] -> [Str] -> [Str]
    forall a. [a] -> [a] -> [a]
    ++ [Str] -> [Str]
    forall a. Ord a => [a] -> [a]
    nubOrd [Str
    x | TCon Str
    x [Ty Str]
    _ <- [Ty Str] -> [Ty Str]
    forall from to. Biplate from to => from -> [to]
    universeBi [Ty Str]
    typ]

        -- want to rank highly instances that have a lot of types, and a lot of definitions
        -- eg Eq is used and defined a lot. Constructor is used in 3 places but defined a lot.
        let Map Str Int
    freq :: Map.Map Str Int = -- how many times each identifier occurs
                (Int -> Int -> Int) -> Map Str Int -> Map Str Int -> Map Str Int
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith (\Int
    typ Int
    sig -> Int
    sig Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    sig Int
    typ) ((Str -> Str) -> Map Str Int -> Map Str Int
    forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeysMonotonic (Char -> Str -> Str
    strCons Char
    '~') Map Str Int
    inst) (Map Str Int -> Map Str Int) -> Map Str Int -> Map Str Int
    forall a b. (a -> b) -> a -> b
    $
                (Int -> Int -> Int) -> [(Str, Int)] -> Map Str Int
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) ([(Str, Int)] -> Map Str Int) -> [(Str, Int)] -> Map Str Int
    forall a b. (a -> b) -> a -> b
    $ (Str -> (Str, Int)) -> [Str] -> [(Str, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (,Int
    1::Int) ([Str] -> [(Str, Int)]) -> [Str] -> [(Str, Int)]
    forall a b. (a -> b) -> a -> b
    $ (Sig Str -> [Str]) -> [Sig Str] -> [Str]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Sig Str -> [Str]
    sigNames [Sig Str]
    xs
        let names :: [(Str, Name)]
    names = [(Str, Int)] -> [(Str, Name)]
    forall a. [(a, Int)] -> [(a, Name)]
    spreadNames ([(Str, Int)] -> [(Str, Name)]) -> [(Str, Int)] -> [(Str, Name)]
    forall a b. (a -> b) -> a -> b
    $ Map Str Int -> [(Str, Int)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Str Int
    freq
        FilePath -> FilePath -> IO ()
    debug FilePath
    "names" (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    unlines [Str -> FilePath
    strUnpack Str
    s FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " = " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Name -> FilePath
    forall a. Show a => a -> FilePath
    show Name
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " (" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Map Str Int
    freq Map Str Int -> Str -> Int
    forall k a. Ord k => Map k a -> k -> a
    Map.! Str
    s) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " uses)" | (Str
    s,Name
    n) <- [(Str, Name)]
    names]
        names <- [(Str, Name)] -> IO [(Str, Name)]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([(Str, Name)] -> IO [(Str, Name)])
    -> [(Str, Name)] -> IO [(Str, Name)]
    forall a b. (a -> b) -> a -> b
    $ ((Str, Name) -> Str) -> [(Str, Name)] -> [(Str, Name)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Str, Name) -> Str
    forall a b. (a, b) -> a
    fst [(Str, Name)]
    names
        storeWrite store TypesNames (bstr0Join $ map (strUnpack . fst) names, V.fromList $ map snd names)
        let mp2 = [(Str, Name)] -> Map Str Name
    forall k a. Eq k => [(k, a)] -> Map k a
    Map.fromAscList [(Str, Name)]
    names
        pure $ Names $ \Str
    x -> Str -> Map Str Name -> Maybe Name
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Str
    x Map Str Name
    mp2

    -- | Given a list of names, spread them out uniquely over the range [Name 100 .. Name maxBound]
    --   Aim for something with a count of p to be at position (p / pmax) linear interp over the range
    spreadNames :: [(a, Int)] -> [(a, Name)]
    spreadNames :: forall a. [(a, Int)] -> [(a, Name)]
    spreadNames [] = []
    spreadNames (((a, Int) -> Int) -> [(a, Int)] -> [(a, Int)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Int -> Int
    forall a. Num a => a -> a
    negate (Int -> Int) -> ((a, Int) -> Int) -> (a, Int) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, Int) -> Int
    forall a b. (a, b) -> b
    snd) -> xs :: [(a, Int)]
    xs@((a
    _,Int
    limit):[(a, Int)]
    _)) = [(a, Name)] -> [(a, Name)]
    forall {a}. [(a, Name)] -> [(a, Name)]
    check ([(a, Name)] -> [(a, Name)]) -> [(a, Name)] -> [(a, Name)]
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Word32 -> [(a, Int)] -> [(a, Name)]
    forall a. Word32 -> Word32 -> [(a, Int)] -> [(a, Name)]
    f (Word32
    99 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ([(a, Int)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(a, Int)]
    xs)) Word32
    forall a. Bounded a => a
    maxBound [(a, Int)]
    xs
        where
            check :: [(a, Name)] -> [(a, Name)]
    check [(a, Name)]
    xs | ((a, Name) -> Bool) -> [(a, Name)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Name -> Bool
    isCon (Name -> Bool) -> ((a, Name) -> Name) -> (a, Name) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, Name) -> Name
    forall a b. (a, b) -> b
    snd) [(a, Name)]
    xs Bool -> Bool -> Bool
    && [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Name] -> [Name]
    forall a. Ord a => [a] -> [a]
    nubOrd ([Name] -> [Name]) -> [Name] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ ((a, Name) -> Name) -> [(a, Name)] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, Name) -> Name
    forall a b. (a, b) -> b
    snd [(a, Name)]
    xs) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [(a, Name)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(a, Name)]
    xs = [(a, Name)]
    xs
                     | Bool
    otherwise = FilePath -> [(a, Name)]
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> [(a, Name)]) -> FilePath -> [(a, Name)]
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Invalid spreadNames, length=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show ([(a, Name)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(a, Name)]
    xs)

            -- I can only assign values between mn and mx inclusive
            f :: NameWord -> NameWord -> [(a, Int)] -> [(a, Name)]
            f :: forall a. Word32 -> Word32 -> [(a, Int)] -> [(a, Name)]
    f !Word32
    mn !Word32
    mx [] = []
            f Word32
    mn Word32
    mx ((a
    a,Int
    i):[(a, Int)]
    xs) = (a
    a, Word32 -> Name
    Name Word32
    real) (a, Name) -> [(a, Name)] -> [(a, Name)]
    forall a. a -> [a] -> [a]
    : Word32 -> Word32 -> [(a, Int)] -> [(a, Name)]
    forall a. Word32 -> Word32 -> [(a, Int)] -> [(a, Name)]
    f (Word32
    mnWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    -Word32
    1) (Word32
    realWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    -Word32
    1) [(a, Int)]
    xs
                where real :: Word32
    real = Word32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Word32) -> Word32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Word32 -> Word32
    forall a. Ord a => a -> a -> a
    max Word32
    mn (Word32 -> Word32) -> Word32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Word32 -> Word32
    forall a. Ord a => a -> a -> a
    min Word32
    mx Word32
    ideal
                      ideal :: Word32
    ideal = Word32
    mn Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Double -> Word32
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    commonNameThreshold Int
    i) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Word32 -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    mx Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    mn) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    commonNameThreshold Int
    limit))

    -- WARNING: Magic constant.
    -- Beyond this count names don't accumulate extra points for being common.
    -- Ensures that things like Bool (4523 uses) ranks much higher than ShakeOptions (24 uses) by not having
    -- [] (10237 uses) skew the curve too much and use up all the available bits of discrimination.
    commonNameThreshold :: Int
    commonNameThreshold = Int
    1024

    readNames :: StoreRead -> Names
    readNames :: StoreRead -> Names
    readNames StoreRead
    store = (Str -> Maybe Name) -> Names
    Names ((Str -> Maybe Name) -> Names) -> (Str -> Maybe Name) -> Names
    forall a b. (a -> b) -> a -> b
    $ \Str
    x -> ByteString -> Map ByteString Name -> Maybe Name
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (FilePath -> ByteString
    bstrPack (FilePath -> ByteString) -> FilePath -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Str -> FilePath
    strUnpack Str
    x) Map ByteString Name
    mp
        where mp :: Map ByteString Name
    mp = [(ByteString, Name)] -> Map ByteString Name
    forall k a. Eq k => [(k, a)] -> Map k a
    Map.fromAscList ([(ByteString, Name)] -> Map ByteString Name)
    -> [(ByteString, Name)] -> Map ByteString Name
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> [Name] -> [(ByteString, Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (ByteString -> [ByteString]
    bstr0Split ByteString
    s) ([Name] -> [(ByteString, Name)]) -> [Name] -> [(ByteString, Name)]
    forall a b. (a -> b) -> a -> b
    $ Vector Name -> [Name]
    forall a. Storable a => Vector a -> [a]
    V.toList Vector Name
    n
              (ByteString
    s, Vector Name
    n) = StoreRead
    -> TypesNames (ByteString, Vector Name)
    -> (ByteString, Vector Name)
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store TypesNames (ByteString, Vector Name)
    TypesNames

    ---------------------------------------------------------------------
    -- DUPLICATION INFORMATION

    data TypesDuplicates a where TypesDuplicates :: TypesDuplicates (Jagged TargetId) deriving Typeable

    newtype Duplicates = Duplicates {Duplicates -> Int -> [TargetId]
    expandDuplicates :: Int -> [TargetId]}

    -- writeDuplicates xs == nub (map snd xs)
        -- all duplicates are removed, order of first element is preserved
    -- (i,x) <- zip [0..] (writeDuplicates xs); expandDuplicates i == map fst (filter ((==) x . snd) xs)
        -- given the result at position i, expandDuplicates gives the TargetId's related to it

    writeDuplicates :: Ord a => StoreWrite -> [(TargetId, Sig a)] -> IO [Sig a]
    writeDuplicates :: forall a. Ord a => StoreWrite -> [(TargetId, Sig a)] -> IO [Sig a]
    writeDuplicates StoreWrite
    store [(TargetId, Sig a)]
    xs = do
        -- s=signature, t=targetid, p=popularity (incoing index), i=index (outgoing index)
        xs <- [(Sig a, [TargetId])] -> IO [(Sig a, [TargetId])]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([(Sig a, [TargetId])] -> IO [(Sig a, [TargetId])])
    -> [(Sig a, [TargetId])] -> IO [(Sig a, [TargetId])]
    forall a b. (a -> b) -> a -> b
    $ ((Sig a, (Int, [TargetId])) -> (Sig a, [TargetId]))
    -> [(Sig a, (Int, [TargetId]))] -> [(Sig a, [TargetId])]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Int, [TargetId]) -> [TargetId])
    -> (Sig a, (Int, [TargetId])) -> (Sig a, [TargetId])
    forall b b' a. (b -> b') -> (a, b) -> (a, b')
    second (Int, [TargetId]) -> [TargetId]
    forall a b. (a, b) -> b
    snd) ([(Sig a, (Int, [TargetId]))] -> [(Sig a, [TargetId])])
    -> [(Sig a, (Int, [TargetId]))] -> [(Sig a, [TargetId])]
    forall a b. (a -> b) -> a -> b
    $ ((Sig a, (Int, [TargetId])) -> Int)
    -> [(Sig a, (Int, [TargetId]))] -> [(Sig a, (Int, [TargetId]))]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn ((Int, [TargetId]) -> Int
    forall a b. (a, b) -> a
    fst ((Int, [TargetId]) -> Int)
    -> ((Sig a, (Int, [TargetId])) -> (Int, [TargetId]))
    -> (Sig a, (Int, [TargetId]))
    -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Sig a, (Int, [TargetId])) -> (Int, [TargetId])
    forall a b. (a, b) -> b
    snd) ([(Sig a, (Int, [TargetId]))] -> [(Sig a, (Int, [TargetId]))])
    -> [(Sig a, (Int, [TargetId]))] -> [(Sig a, (Int, [TargetId]))]
    forall a b. (a -> b) -> a -> b
    $ Map (Sig a) (Int, [TargetId]) -> [(Sig a, (Int, [TargetId]))]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Map (Sig a) (Int, [TargetId]) -> [(Sig a, (Int, [TargetId]))])
    -> Map (Sig a) (Int, [TargetId]) -> [(Sig a, (Int, [TargetId]))]
    forall a b. (a -> b) -> a -> b
    $
            ((Int, [TargetId]) -> (Int, [TargetId]) -> (Int, [TargetId]))
    -> [(Sig a, (Int, [TargetId]))] -> Map (Sig a) (Int, [TargetId])
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith (\(Int
    x1,[TargetId]
    x2) (Int
    y1,[TargetId]
    y2) -> (, [TargetId]
    x2 [TargetId] -> [TargetId] -> [TargetId]
    forall a. [a] -> [a] -> [a]
    ++ [TargetId]
    y2) (Int -> (Int, [TargetId])) -> Int -> (Int, [TargetId])
    forall a b. (a -> b) -> a -> b
    $! Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    x1 Int
    y1)
                             [(Sig a
    s,(Int
    p,[TargetId
    t])) | (Int
    p,(TargetId
    t,Sig a
    s)) <- Int -> [(TargetId, Sig a)] -> [(Int, (TargetId, Sig a))]
    forall a b. Enum a => a -> [b] -> [(a, b)]
    zipFrom (Int
    0::Int) [(TargetId, Sig a)]
    xs]
        -- give a list of TargetId's at each index
        storeWrite store TypesDuplicates $ jaggedFromList $ map (reverse . snd) xs
        pure $ map fst xs

    readDuplicates :: StoreRead -> Duplicates
    readDuplicates :: StoreRead -> Duplicates
    readDuplicates StoreRead
    store = (Int -> [TargetId]) -> Duplicates
    Duplicates ((Int -> [TargetId]) -> Duplicates)
    -> (Int -> [TargetId]) -> Duplicates
    forall a b. (a -> b) -> a -> b
    $ Vector TargetId -> [TargetId]
    forall a. Storable a => Vector a -> [a]
    V.toList (Vector TargetId -> [TargetId])
    -> (Int -> Vector TargetId) -> Int -> [TargetId]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Vector TargetId
    ask
        where ask :: Int -> Vector TargetId
    ask = Jagged TargetId -> Int -> Vector TargetId
    forall a. Storable a => Jagged a -> Int -> Vector a
    jaggedAsk (Jagged TargetId -> Int -> Vector TargetId)
    -> Jagged TargetId -> Int -> Vector TargetId
    forall a b. (a -> b) -> a -> b
    $ StoreRead -> TypesDuplicates (Jagged TargetId) -> Jagged TargetId
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store TypesDuplicates (Jagged TargetId)
    TypesDuplicates

    ---------------------------------------------------------------------
    -- FINGERPRINT INFORMATION

    data TypesFingerprints a where TypesFingerprints :: TypesFingerprints (V.Vector Fingerprint) deriving Typeable

    data Fingerprint = Fingerprint
        {Fingerprint -> Name
    fpRare1 :: {-# UNPACK #-} !Name -- Most rare ctor, or 0 if no rare stuff
        ,Fingerprint -> Name
    fpRare2 :: {-# UNPACK #-} !Name -- 2nd rare ctor
        ,Fingerprint -> Name
    fpRare3 :: {-# UNPACK #-} !Name -- 3rd rare ctor
        ,Fingerprint -> Word8
    fpArity :: {-# UNPACK #-} !Word8 -- Artiy, where 0 = CAF
        ,Fingerprint -> Word8
    fpTerms :: {-# UNPACK #-} !Word8 -- Number of terms (where 255 = 255 and above)
        } deriving (Fingerprint -> Fingerprint -> Bool
    (Fingerprint -> Fingerprint -> Bool)
    -> (Fingerprint -> Fingerprint -> Bool) -> Eq Fingerprint
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Fingerprint -> Fingerprint -> Bool
    == :: Fingerprint -> Fingerprint -> Bool
    $c/= :: Fingerprint -> Fingerprint -> Bool
    /= :: Fingerprint -> Fingerprint -> Bool
    Eq,Int -> Fingerprint -> FilePath -> FilePath
    [Fingerprint] -> FilePath -> FilePath
    Fingerprint -> FilePath
    (Int -> Fingerprint -> FilePath -> FilePath)
    -> (Fingerprint -> FilePath)
    -> ([Fingerprint] -> FilePath -> FilePath)
    -> Show Fingerprint
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> Fingerprint -> FilePath -> FilePath
    showsPrec :: Int -> Fingerprint -> FilePath -> FilePath
    $cshow :: Fingerprint -> FilePath
    show :: Fingerprint -> FilePath
    $cshowList :: [Fingerprint] -> FilePath -> FilePath
    showList :: [Fingerprint] -> FilePath -> FilePath
    Show,Typeable)

    prettyFingerprint :: Fingerprint -> String
    prettyFingerprint :: Fingerprint -> FilePath
    prettyFingerprint Fingerprint{Word8
    Name
    fpRare1 :: Fingerprint -> Name
    fpRare2 :: Fingerprint -> Name
    fpRare3 :: Fingerprint -> Name
    fpArity :: Fingerprint -> Word8
    fpTerms :: Fingerprint -> Word8
    fpRare1 :: Name
    fpRare2 :: Name
    fpRare3 :: Name
    fpArity :: Word8
    fpTerms :: Word8
    ..} =
        FilePath
    "arity=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> FilePath
    forall a. Show a => a -> FilePath
    show Word8
    fpArity FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ", terms=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> FilePath
    forall a. Show a => a -> FilePath
    show Word8
    fpTerms FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
        FilePath
    ", rarity=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ [FilePath] -> FilePath
    unwords ((Name -> FilePath) -> [Name] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> FilePath
    prettyName [Name
    fpRare1, Name
    fpRare2, Name
    fpRare3])

    {-# INLINE fpRaresFold #-}
    fpRaresFold :: (b -> b -> b) -> (Name -> b) -> Fingerprint -> b
    fpRaresFold :: forall b. (b -> b -> b) -> (Name -> b) -> Fingerprint -> b
    fpRaresFold b -> b -> b
    g Name -> b
    f Fingerprint{Word8
    Name
    fpRare1 :: Fingerprint -> Name
    fpRare2 :: Fingerprint -> Name
    fpRare3 :: Fingerprint -> Name
    fpArity :: Fingerprint -> Word8
    fpTerms :: Fingerprint -> Word8
    fpRare1 :: Name
    fpRare2 :: Name
    fpRare3 :: Name
    fpArity :: Word8
    fpTerms :: Word8
    ..} = Name -> b
    f Name
    fpRare1 b -> b -> b
    `g` Name -> b
    f Name
    fpRare2 b -> b -> b
    `g` Name -> b
    f Name
    fpRare3

    instance Storable Fingerprint where
        sizeOf :: Fingerprint -> Int
    sizeOf Fingerprint
    _ = Int
    4Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Name -> Int
    forall a. Storable a => a -> Int
    sizeOf Name
    name0
        alignment :: Fingerprint -> Int
    alignment Fingerprint
    _ = Int
    4
        peekByteOff :: forall b. Ptr b -> Int -> IO Fingerprint
    peekByteOff Ptr b
    ptr Int
    i = Name -> Name -> Name -> Word8 -> Word8 -> Fingerprint
    Fingerprint
            (Name -> Name -> Name -> Word8 -> Word8 -> Fingerprint)
    -> IO Name -> IO (Name -> Name -> Word8 -> Word8 -> Fingerprint)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr b -> Int -> IO Name
    forall b. Ptr b -> Int -> IO Name
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    0) IO (Name -> Name -> Word8 -> Word8 -> Fingerprint)
    -> IO Name -> IO (Name -> Word8 -> Word8 -> Fingerprint)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr b -> Int -> IO Name
    forall b. Ptr b -> Int -> IO Name
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w) IO (Name -> Word8 -> Word8 -> Fingerprint)
    -> IO Name -> IO (Word8 -> Word8 -> Fingerprint)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr b -> Int -> IO Name
    forall b. Ptr b -> Int -> IO Name
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w)
            IO (Word8 -> Word8 -> Fingerprint)
    -> IO Word8 -> IO (Word8 -> Fingerprint)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr b -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    3Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w) IO (Word8 -> Fingerprint) -> IO Word8 -> IO Fingerprint
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr b -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    3Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            where w :: Int
    w = Name -> Int
    forall a. Storable a => a -> Int
    sizeOf Name
    name0
        pokeByteOff :: forall b. Ptr b -> Int -> Fingerprint -> IO ()
    pokeByteOff Ptr b
    ptr Int
    i Fingerprint{Word8
    Name
    fpRare1 :: Fingerprint -> Name
    fpRare2 :: Fingerprint -> Name
    fpRare3 :: Fingerprint -> Name
    fpArity :: Fingerprint -> Word8
    fpTerms :: Fingerprint -> Word8
    fpRare1 :: Name
    fpRare2 :: Name
    fpRare3 :: Name
    fpArity :: Word8
    fpTerms :: Word8
    ..} = do
            Ptr b -> Int -> Name -> IO ()
    forall b. Ptr b -> Int -> Name -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    0) Name
    fpRare1 IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Ptr b -> Int -> Name -> IO ()
    forall b. Ptr b -> Int -> Name -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w) Name
    fpRare2 IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Ptr b -> Int -> Name -> IO ()
    forall b. Ptr b -> Int -> Name -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w) Name
    fpRare3
            Ptr b -> Int -> Word8 -> IO ()
    forall b. Ptr b -> Int -> Word8 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    3Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w) Word8
    fpArity IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Ptr b -> Int -> Word8 -> IO ()
    forall b. Ptr b -> Int -> Word8 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr b
    ptr (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    3Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Word8
    fpTerms
            where w :: Int
    w = Name -> Int
    forall a. Storable a => a -> Int
    sizeOf Name
    name0

    toFingerprint :: Sig Name -> Fingerprint
    toFingerprint :: Sig Name -> Fingerprint
    toFingerprint Sig Name
    sig = Fingerprint{Word8
    Name
    fpRare1 :: Name
    fpRare2 :: Name
    fpRare3 :: Name
    fpArity :: Word8
    fpTerms :: Word8
    fpRare1 :: Name
    fpRare2 :: Name
    fpRare3 :: Name
    fpArity :: Word8
    fpTerms :: Word8
    ..}
        where Name
    fpRare1:Name
    fpRare2:Name
    fpRare3:[Name]
    _ = [Name] -> [Name]
    forall a. Ord a => [a] -> [a]
    sort ([Name] -> [Name]
    forall a. Ord a => [a] -> [a]
    nubOrd ([Name] -> [Name]) -> [Name] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ (Name -> Bool) -> [Name] -> [Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Name -> Bool
    isCon ([Name] -> [Name]) -> [Name] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ Sig Name -> [Name]
    forall from to. Biplate from to => from -> [to]
    universeBi Sig Name
    sig) [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [Name
    name0,Name
    name0,Name
    name0]
              fpArity :: Word8
    fpArity = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    255 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => a -> a
    pred (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [Ty Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Ty Name] -> Int) -> [Ty Name] -> Int
    forall a b. (a -> b) -> a -> b
    $ Sig Name -> [Ty Name]
    forall n. Sig n -> [Ty n]
    sigTy Sig Name
    sig
              fpTerms :: Word8
    fpTerms = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    255 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Sig Name -> [Name]
    forall from to. Biplate from to => from -> [to]
    universeBi Sig Name
    sig :: [Name])

    writeFingerprints :: StoreWrite -> [Sig Name] -> IO ()
    writeFingerprints :: StoreWrite -> [Sig Name] -> IO ()
    writeFingerprints StoreWrite
    store [Sig Name]
    xs = StoreWrite
    -> TypesFingerprints (Vector Fingerprint)
    -> Vector Fingerprint
    -> IO ()
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreWrite -> t a -> a -> IO ()
    storeWrite StoreWrite
    store TypesFingerprints (Vector Fingerprint)
    TypesFingerprints (Vector Fingerprint -> IO ()) -> Vector Fingerprint -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Fingerprint] -> Vector Fingerprint
    forall a. Storable a => [a] -> Vector a
    V.fromList ([Fingerprint] -> Vector Fingerprint)
    -> [Fingerprint] -> Vector Fingerprint
    forall a b. (a -> b) -> a -> b
    $ (Sig Name -> Fingerprint) -> [Sig Name] -> [Fingerprint]
    forall a b. (a -> b) -> [a] -> [b]
    map Sig Name -> Fingerprint
    toFingerprint [Sig Name]
    xs

    data MatchFingerprint a ma = MatchFingerprint
        {forall a ma. MatchFingerprint a ma -> a -> a -> a
    mfpAdd :: a -> a -> a
        ,forall a ma. MatchFingerprint a ma -> ma -> ma -> ma
    mfpAddM :: ma -> ma -> ma
        ,forall a ma. MatchFingerprint a ma -> a -> ma
    mfpJust :: a -> ma
        ,forall a ma. MatchFingerprint a ma -> FilePath -> Int -> a
    mfpCost :: String -> Int -> a
        ,forall a ma. MatchFingerprint a ma -> FilePath -> ma
    mfpMiss :: String -> ma
        }

    matchFingerprint :: Sig Name -> Fingerprint -> Maybe Int
    matchFingerprint :: Sig Name -> Fingerprint -> Maybe Int
    matchFingerprint = MatchFingerprint Int (Maybe Int)
    -> Sig Name -> Fingerprint -> Maybe Int
    forall a ma. MatchFingerprint a ma -> Sig Name -> Fingerprint -> ma
    matchFingerprintEx MatchFingerprint{Int -> Maybe Int
    Int -> Int -> Int
    FilePath -> Maybe Int
    FilePath -> Int -> Int
    Maybe Int -> Maybe Int -> Maybe Int
    forall {a}. a -> Maybe a
    forall {p} {a}. p -> Maybe a
    forall {p} {p}. p -> p -> p
    mfpAdd :: Int -> Int -> Int
    mfpAddM :: Maybe Int -> Maybe Int -> Maybe Int
    mfpJust :: Int -> Maybe Int
    mfpCost :: FilePath -> Int -> Int
    mfpMiss :: FilePath -> Maybe Int
    mfpAdd :: Int -> Int -> Int
    mfpAddM :: Maybe Int -> Maybe Int -> Maybe Int
    mfpJust :: forall {a}. a -> Maybe a
    mfpCost :: forall {p} {p}. p -> p -> p
    mfpMiss :: forall {p} {a}. p -> Maybe a
    ..}
        where
            mfpAdd :: Int -> Int -> Int
    mfpAdd = Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+)
            mfpAddM :: Maybe Int -> Maybe Int -> Maybe Int
    mfpAddM = (Int -> Int -> Int) -> Maybe Int -> Maybe Int -> Maybe Int
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+)
            mfpJust :: a -> Maybe a
    mfpJust = a -> Maybe a
    forall {a}. a -> Maybe a
    Just
            mfpCost :: p -> p -> p
    mfpCost p
    _ p
    x = p
    x
            mfpMiss :: p -> Maybe a
    mfpMiss p
    _ = Maybe a
    forall a. Maybe a
    Nothing

    matchFingerprintDebug :: Sig Name -> Fingerprint -> [Either String (String, Int)]
    matchFingerprintDebug :: Sig Name -> Fingerprint -> [Either FilePath (FilePath, Int)]
    matchFingerprintDebug = MatchFingerprint
      [Either FilePath (FilePath, Int)] [Either FilePath (FilePath, Int)]
    -> Sig Name -> Fingerprint -> [Either FilePath (FilePath, Int)]
    forall a ma. MatchFingerprint a ma -> Sig Name -> Fingerprint -> ma
    matchFingerprintEx MatchFingerprint{FilePath -> [Either FilePath (FilePath, Int)]
    FilePath -> Int -> [Either FilePath (FilePath, Int)]
    [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    forall {a}. a -> a
    forall a. [a] -> [a] -> [a]
    forall {a} {b}. a -> [Either a b]
    forall {a} {b} {a}. a -> b -> [Either a (a, b)]
    mfpAdd :: [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    mfpAddM :: [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    mfpJust :: [Either FilePath (FilePath, Int)]
    -> [Either FilePath (FilePath, Int)]
    mfpCost :: FilePath -> Int -> [Either FilePath (FilePath, Int)]
    mfpMiss :: FilePath -> [Either FilePath (FilePath, Int)]
    mfpAdd :: forall a. [a] -> [a] -> [a]
    mfpAddM :: forall a. [a] -> [a] -> [a]
    mfpJust :: forall {a}. a -> a
    mfpCost :: forall {a} {b} {a}. a -> b -> [Either a (a, b)]
    mfpMiss :: forall {a} {b}. a -> [Either a b]
    ..}
        where
            mfpAdd :: [a] -> [a] -> [a]
    mfpAdd = [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++)
            mfpAddM :: [a] -> [a] -> [a]
    mfpAddM = [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++)
            mfpJust :: a -> a
    mfpJust = a -> a
    forall {a}. a -> a
    id
            mfpCost :: a -> b -> [Either a (a, b)]
    mfpCost a
    s b
    x = [(a, b) -> Either a (a, b)
    forall a b. b -> Either a b
    Right (a
    s,b
    x)]
            mfpMiss :: a -> [Either a b]
    mfpMiss a
    s = [a -> Either a b
    forall a b. a -> Either a b
    Left a
    s]

    {-# INLINE matchFingerprintEx #-}
    matchFingerprintEx :: forall a ma . MatchFingerprint a ma -> Sig Name -> Fingerprint -> ma -- lower is better
    matchFingerprintEx :: forall a ma. MatchFingerprint a ma -> Sig Name -> Fingerprint -> ma
    matchFingerprintEx MatchFingerprint{a -> ma
    a -> a -> a
    ma -> ma -> ma
    FilePath -> ma
    FilePath -> Int -> a
    mfpAdd :: forall a ma. MatchFingerprint a ma -> a -> a -> a
    mfpAddM :: forall a ma. MatchFingerprint a ma -> ma -> ma -> ma
    mfpJust :: forall a ma. MatchFingerprint a ma -> a -> ma
    mfpCost :: forall a ma. MatchFingerprint a ma -> FilePath -> Int -> a
    mfpMiss :: forall a ma. MatchFingerprint a ma -> FilePath -> ma
    mfpAdd :: a -> a -> a
    mfpAddM :: ma -> ma -> ma
    mfpJust :: a -> ma
    mfpCost :: FilePath -> Int -> a
    mfpMiss :: FilePath -> ma
    ..} sig :: Sig Name
    sig@(Sig Name -> Fingerprint
    toFingerprint -> Fingerprint
    target) =
        \Fingerprint
    candidate -> Word8 -> ma
    arity (Fingerprint -> Word8
    fpArity Fingerprint
    candidate) ma -> ma -> ma
    `mfpAddM` Word8 -> ma
    terms (Fingerprint -> Word8
    fpTerms Fingerprint
    candidate) ma -> ma -> ma
    `mfpAddM` Fingerprint -> ma
    rarity Fingerprint
    candidate
        where
            -- CAFs must match perfectly, otherwise too many is better than too few
            arity :: Word8 -> ma
    arity | Word8
    ta Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0 = \Word8
    ca -> if Word8
    ca Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0 then a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost FilePath
    "arity equal" Int
    0 else FilePath -> ma
    mfpMiss FilePath
    "arity different and query a CAF" -- searching for a CAF
                  | Bool
    otherwise = \Word8
    ca -> case Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    ca Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    ta of
                        Int
    _ | Word8
    ca Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0 -> FilePath -> ma
    mfpMiss FilePath
    "arity different and answer a CAF" -- searching for a CAF
                        Int
    0  -> a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost FilePath
    "arity equal" Int
    0 -- perfect match
                        -1 -> a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost FilePath
    "arity 1 to remove" Int
    1000 -- not using something the user carefully wrote
                        Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    && Bool
    allowMore -> a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost (FilePath
    "arity " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " to add with wildcard") (Int -> a) -> Int -> a
    forall a b. (a -> b) -> a -> b
    $ Int
    300 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    n -- user will have to make up a lot, but they said _ in their search
                        Int
    1  -> a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost FilePath
    "arity 1 to add" Int
    300  -- user will have to make up an extra param
                        Int
    2  -> a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost FilePath
    "arity 2 to add"  Int
    900  -- user will have to make up two params
                        Int
    _ -> FilePath -> ma
    mfpMiss FilePath
    ""
                where
                    ta :: Word8
    ta = Fingerprint -> Word8
    fpArity Fingerprint
    target
                    allowMore :: Bool
    allowMore = Name -> [Ty Name] -> Ty Name
    forall n. n -> [Ty n] -> Ty n
    TVar Name
    name0 [] Ty Name -> [Ty Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Sig Name -> [Ty Name]
    forall n. Sig n -> [Ty n]
    sigTy Sig Name
    sig

            -- missing terms are a bit worse than invented terms, but it's fairly balanced, clip at large numbers
            terms :: Word8 -> ma
    terms = \Word8
    ct -> case Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    ct Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    tt of
                    Int
    n | Int -> Int
    forall a. Num a => a -> a
    abs Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    20 -> FilePath -> ma
    mfpMiss (FilePath -> ma) -> FilePath -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "terms " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " different" -- too different
                      | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 -> a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost FilePath
    "terms equal" Int
    0
                      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 -> a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost (FilePath
    "terms " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " to add") (Int -> a) -> Int -> a
    forall a b. (a -> b) -> a -> b
    $ Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    10 -- candidate has more terms
                      | Bool
    otherwise -> a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> a
    mfpCost (FilePath
    "terms " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show (-Int
    n) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " to remove") (Int -> a) -> Int -> a
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Num a => a -> a
    abs Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    12 -- candidate has less terms
                where
                    tt :: Word8
    tt = Fingerprint -> Word8
    fpTerms Fingerprint
    target

            -- given two fingerprints, you have three sets:
            -- Those in common; those in one but not two; those in two but not one
            -- those that are different
            rarity :: Fingerprint -> ma
    rarity = \Fingerprint
    cr -> let tr :: Fingerprint
    tr = Fingerprint
    target in a -> ma
    mfpJust (a -> ma) -> a -> ma
    forall a b. (a -> b) -> a -> b
    $
                    Double -> Double -> Fingerprint -> Fingerprint -> a
    differences Double
    5000 Double
    400 Fingerprint
    tr Fingerprint
    cr a -> a -> a
    `mfpAdd` -- searched for T but its not in the candidate, bad if rare, not great if common
                    Double -> Double -> Fingerprint -> Fingerprint -> a
    differences Double
    1000  Double
    50 Fingerprint
    cr Fingerprint
    tr          -- T is in the candidate but I didn't search for it, bad if rare, OK if common
                where
                    fpRaresElem :: Name -> Fingerprint -> Bool
                    fpRaresElem :: Name -> Fingerprint -> Bool
    fpRaresElem !Name
    x = (Bool -> Bool -> Bool) -> (Name -> Bool) -> Fingerprint -> Bool
    forall b. (b -> b -> b) -> (Name -> b) -> Fingerprint -> b
    fpRaresFold Bool -> Bool -> Bool
    (||) (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    x)

                    differences :: Double -> Double -> Fingerprint -> Fingerprint -> a
                    differences :: Double -> Double -> Fingerprint -> Fingerprint -> a
    differences !Double
    rare !Double
    common !Fingerprint
    want !Fingerprint
    have = (a -> a -> a) -> (Name -> a) -> Fingerprint -> a
    forall b. (b -> b -> b) -> (Name -> b) -> Fingerprint -> b
    fpRaresFold a -> a -> a
    mfpAdd Name -> a
    f Fingerprint
    want
                        where f :: Name -> a
    f Name
    n | Name -> Fingerprint -> Bool
    fpRaresElem Name
    n Fingerprint
    have = FilePath -> Int -> a
    mfpCost (FilePath
    "term in common " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Name -> FilePath
    prettyName Name
    n) Int
    0
                                  | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    name0 = FilePath -> Int -> a
    mfpCost FilePath
    "term _ missing" Int
    0 -- will pay the cost the other way around
                                  | Bool
    otherwise = let p :: Double
    p = Name -> Double
    popularityName Name
    n in FilePath -> Int -> a
    mfpCost (FilePath
    "term " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Name -> FilePath
    prettyName Name
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " (" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> Double -> FilePath
    forall a. RealFloat a => Int -> a -> FilePath
    showDP Int
    2 Double
    p FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ") missing") (Int -> a) -> Int -> a
    forall a b. (a -> b) -> a -> b
    $
                                                Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ (Double
    pDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    common) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + ((Double
    1Double -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    p)Double -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    rare)

    ---------------------------------------------------------------------
    -- SIGNATURES

    data TypesSigPositions a where TypesSigPositions :: TypesSigPositions (V.Vector Word32) deriving Typeable
    data TypesSigData a where TypesSigData :: TypesSigData BS.ByteString deriving Typeable

    writeSignatures :: StoreWrite -> [Sig Name] -> IO ()
    writeSignatures :: StoreWrite -> [Sig Name] -> IO ()
    writeSignatures StoreWrite
    store [Sig Name]
    xs = do
        v <- Int -> IO (MVector (PrimState IO) Word32)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    VM.new (Int -> IO (MVector (PrimState IO) Word32))
    -> Int -> IO (MVector (PrimState IO) Word32)
    forall a b. (a -> b) -> a -> b
    $ [Sig Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Sig Name]
    xs
        forM_ (zipFrom 0 xs) $ \(Int
    i,Sig Name
    x) -> do
            let b :: ByteString
    b = Sig Name -> ByteString
    forall a. Binary a => a -> ByteString
    encodeBS Sig Name
    x
            StoreWrite -> TypesSigData ByteString -> ByteString -> IO ()
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreWrite -> t a -> a -> IO ()
    storeWritePart StoreWrite
    store TypesSigData ByteString
    TypesSigData ByteString
    b
            MVector (PrimState IO) Word32 -> Int -> Word32 -> IO ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    VM.write MVector RealWorld Word32
    MVector (PrimState IO) Word32
    v Int
    i (Word32 -> IO ()) -> Word32 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    BS.length ByteString
    b
        v <- V.freeze v
        storeWrite store TypesSigPositions v

    type SigLoc = (Word32, Word32)

    readSignatureIndex :: StoreRead -> [SigLoc] -- (offset,size) pairs for each field
    readSignatureIndex :: StoreRead -> [SigLoc]
    readSignatureIndex StoreRead
    store = [Word32] -> [Word32] -> [SigLoc]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Word32]
    offsets (Vector Word32 -> [Word32]
    forall a. Storable a => Vector a -> [a]
    V.toList Vector Word32
    sizes)
      where sizes :: Vector Word32
    sizes   = StoreRead -> TypesSigPositions (Vector Word32) -> Vector Word32
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store TypesSigPositions (Vector Word32)
    TypesSigPositions
            offsets :: [Word32]
    offsets = Vector Word32 -> [Word32]
    forall a. Storable a => Vector a -> [a]
    V.toList (Vector Word32 -> [Word32]) -> Vector Word32 -> [Word32]
    forall a b. (a -> b) -> a -> b
    $ (Word32 -> Word32 -> Word32)
    -> Word32 -> Vector Word32 -> Vector Word32
    forall a b.
    (Storable a, Storable b) =>
    (a -> b -> a) -> a -> Vector b -> Vector a
    V.prescanl' Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    (+) Word32
    0 Vector Word32
    sizes

    readSignatureAt :: StoreRead -> SigLoc -> Sig Name
    readSignatureAt :: StoreRead -> SigLoc -> Sig Name
    readSignatureAt StoreRead
    store (Word32
    offset, Word32
    size) = ByteString -> Sig Name
    forall a. Binary a => ByteString -> a
    decodeBS (Int -> ByteString -> ByteString
    BS.take (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    size)
                                                     (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (ByteString, ByteString) -> ByteString
    forall a b. (a, b) -> b
    snd
                                                     ((ByteString, ByteString) -> ByteString)
    -> (ByteString, ByteString) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> (ByteString, ByteString)
    BS.splitAt (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    offset) ByteString
    bs)
      where
        bs :: ByteString
    bs = StoreRead -> TypesSigData ByteString -> ByteString
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store TypesSigData ByteString
    TypesSigData

    ---------------------------------------------------------------------
    -- TYPE SEARCH

    searchTypeMatch :: [ (Int, (Int, SigLoc, Fingerprint)) ]
                    -> (SigLoc -> Sig Name)
                    -> Name
                    -> Int
                    -> Sig Name
                    -> [Int]
    searchTypeMatch :: [(Int, (Int, SigLoc, Fingerprint))]
    -> (SigLoc -> Sig Name) -> Name -> Int -> Sig Name -> [Int]
    searchTypeMatch [(Int, (Int, SigLoc, Fingerprint))]
    possibilities SigLoc -> Sig Name
    getSig Name
    arrow Int
    n Sig Name
    sig =
        ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, Int) -> Int
    forall a b. (a, b) -> b
    snd ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ ((Int, Int) -> Int) -> Int -> [(Int, Int)] -> [(Int, Int)]
    forall k a. Ord k => (a -> k) -> Int -> [a] -> [a]
    takeSortOn (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst Int
    n
          [ (Int
    500 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    v Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    fv, Int
    i) | (Int
    fv, (Int
    i, SigLoc
    sigIdx, Fingerprint
    f)) <- [(Int, (Int, SigLoc, Fingerprint))]
    possibilities
                              , Int
    v  <- Maybe Int -> [Int]
    forall a. Maybe a -> [a]
    maybeToList (Name -> Sig Name -> Sig Name -> Maybe Int
    matchType Name
    arrow Sig Name
    sig (Sig Name -> Maybe Int) -> Sig Name -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ SigLoc -> Sig Name
    getSig SigLoc
    sigIdx)]

    bestByFingerprint :: [(SigLoc, Fingerprint)] -> Int -> Sig Name -> [ (Int, (Int, SigLoc, Fingerprint)) ]
    bestByFingerprint :: [(SigLoc, Fingerprint)]
    -> Int -> Sig Name -> [(Int, (Int, SigLoc, Fingerprint))]
    bestByFingerprint [(SigLoc, Fingerprint)]
    db Int
    n Sig Name
    sig =
      ((Int, (Int, SigLoc, Fingerprint)) -> Int)
    -> Int
    -> [(Int, (Int, SigLoc, Fingerprint))]
    -> [(Int, (Int, SigLoc, Fingerprint))]
    forall k a. Ord k => (a -> k) -> Int -> [a] -> [a]
    takeSortOn (Int, (Int, SigLoc, Fingerprint)) -> Int
    forall a b. (a, b) -> a
    fst (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    5000 Int
    n)
        [ (Int
    fv, (Int
    i, SigLoc
    sigIdx, Fingerprint
    f)) | (Int
    i, (SigLoc
    sigIdx, Fingerprint
    f)) <- Int -> [(SigLoc, Fingerprint)] -> [(Int, (SigLoc, Fingerprint))]
    forall a b. Enum a => a -> [b] -> [(a, b)]
    zipFrom Int
    0 [(SigLoc, Fingerprint)]
    db
                               , Int
    fv <- Maybe Int -> [Int]
    forall a. Maybe a -> [a]
    maybeToList (Fingerprint -> Maybe Int
    matchFp Fingerprint
    f) ]
      where
        matchFp :: Fingerprint -> Maybe Int
    matchFp = Sig Name -> Fingerprint -> Maybe Int
    matchFingerprint Sig Name
    sig

    matchType :: Name -> Sig Name -> Sig Name -> Maybe Int
    matchType :: Name -> Sig Name -> Sig Name -> Maybe Int
    matchType Name
    arr Sig Name
    qry Sig Name
    ans = Work -> Int
    unWork (Work -> Int) -> Maybe Work -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Typ Name, [Ctx Name])
    lhs (Typ Name, [Ctx Name]) -> (Typ Name, [Ctx Name]) -> Maybe Work
    `matches` (Typ Name, [Ctx Name])
    rhs
        where
          lhs :: (Typ Name, [Ctx Name])
    lhs = (Name -> Sig Name -> Typ Name
    toTyp Name
    arr Sig Name
    qry, Sig Name -> [Ctx Name]
    forall n. Sig n -> [Ctx n]
    sigCtx Sig Name
    qry)
          rhs :: (Typ Name, [Ctx Name])
    rhs = (Name -> Sig Name -> Typ Name
    toTyp Name
    arr Sig Name
    ans, Sig Name -> [Ctx Name]
    forall n. Sig n -> [Ctx n]
    sigCtx Sig Name
    ans)

    -- Check if two types-with-context match, returning the amount of work
    -- needed to create the match.
    matches :: (Typ Name, [Ctx Name]) -> (Typ Name, [Ctx Name]) -> Maybe Work
    matches :: (Typ Name, [Ctx Name]) -> (Typ Name, [Ctx Name]) -> Maybe Work
    matches (Typ Name
    lhs, [Ctx Name]
    lctx) (Typ Name
    rhs, [Ctx Name]
    rctx) = (forall s. ST s (Maybe Work)) -> Maybe Work
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Maybe Work)) -> Maybe Work)
    -> (forall s. ST s (Maybe Work)) -> Maybe Work
    forall a b. (a -> b) -> a -> b
    $ StateT Work (ST s) (Maybe Work) -> Work -> ST s (Maybe Work)
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (StateT Work (ST s) Bool -> StateT Work (ST s) (Maybe Work)
    forall {m :: * -> *} {a}.
    Monad m =>
    StateT a m Bool -> StateT a m (Maybe a)
    getWork StateT Work (ST s) Bool
    forall s. StateT Work (ST s) Bool
    go) (Int -> Work
    Work Int
    0)
      where
        go :: forall s. StateT Work (ST s) Bool
        go :: forall s. StateT Work (ST s) Bool
    go = do
            -- Try to unify the answer type with the query type.
            (qry, qryC) <- ST s (Typ (NameRef s), [Ctx (NameRef s)])
    -> StateT Work (ST s) (Typ (NameRef s), [Ctx (NameRef s)])
    forall (m :: * -> *) a. Monad m => m a -> StateT Work m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Bool
    -> Typ Name
    -> [Ctx Name]
    -> ST s (Typ (NameRef s), [Ctx (NameRef s)])
    forall s.
    Bool
    -> Typ Name
    -> [Ctx Name]
    -> ST s (Typ (NameRef s), [Ctx (NameRef s)])
    refTyp Bool
    True  Typ Name
    lhs [Ctx Name]
    lctx)
            (ans, ansC) <- lift (refTyp False rhs rctx)
            unifyTyp qry ans >>= \case
                Bool
    False -> Bool -> StateT Work (ST s) Bool
    forall a. a -> StateT Work (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
                Bool
    True  -> do
                    -- Normalize constraints
                    let normalize :: Ctx (NameRef s) -> t (ST s) (Ctx Name)
    normalize (Ctx NameRef s
    c NameRef s
    a) = ST s (Ctx Name) -> t (ST s) (Ctx Name)
    forall (m :: * -> *) a. Monad m => m a -> t m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Name -> Name -> Ctx Name
    forall n. n -> n -> Ctx n
    Ctx (Name -> Name -> Ctx Name) -> ST s Name -> ST s (Name -> Ctx Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NameRef s -> ST s Name
    forall s. NameRef s -> ST s Name
    getName NameRef s
    c ST s (Name -> Ctx Name) -> ST s Name -> ST s (Ctx Name)
    forall a b. ST s (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> NameRef s -> ST s Name
    forall s. NameRef s -> ST s Name
    getName NameRef s
    a)
                    qryNCs <- [Ctx Name] -> Set (Ctx Name)
    forall a. Ord a => [a] -> Set a
    Set.fromList ([Ctx Name] -> Set (Ctx Name))
    -> StateT Work (ST s) [Ctx Name]
    -> StateT Work (ST s) (Set (Ctx Name))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Ctx (NameRef s) -> StateT Work (ST s) (Ctx Name))
    -> [Ctx (NameRef s)] -> StateT Work (ST s) [Ctx Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Ctx (NameRef s) -> StateT Work (ST s) (Ctx Name)
    forall {t :: (* -> *) -> * -> *} {s}.
    MonadTrans t =>
    Ctx (NameRef s) -> t (ST s) (Ctx Name)
    normalize [Ctx (NameRef s)]
    qryC)
                    ansNCs <- Set.fromList <$> (mapM normalize ansC)

                    nqry <- lift $ normalizeTy qry
                    nans <- lift $ normalizeTy ans

                    -- Discharge constraints; remove any answer-constraint that is also a query-constraint,
                    -- and then remove any remaining answer-constraint that is constraining a concrete type.
                    -- TODO: keep constrained concrete types but weight them differently if they correspond
                    --       to a known instance (e.g. free if we know the instance, rather expensive otherwise).
                    let addl = (Ctx Name -> Bool) -> [Ctx Name] -> [Ctx Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Ctx Name -> Bool
    isAbstract (Set (Ctx Name) -> [Ctx Name]
    forall a. Set a -> [a]
    Set.toList (Set (Ctx Name) -> [Ctx Name]) -> Set (Ctx Name) -> [Ctx Name]
    forall a b. (a -> b) -> a -> b
    $ Set (Ctx Name)
    ansNCs Set (Ctx Name) -> Set (Ctx Name) -> Set (Ctx Name)
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set (Ctx Name)
    qryNCs)
                        isAbstract (Ctx Name
    c Name
    a) = Name -> Bool
    isVar Name
    a

                    workDelta (Work (3 * length addl))

                    pure True

        getWork :: StateT a m Bool -> StateT a m (Maybe a)
    getWork StateT a m Bool
    action = StateT a m Bool
    action StateT a m Bool
    -> (Bool -> StateT a m (Maybe a)) -> StateT a m (Maybe a)
    forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Bool
    True  -> a -> Maybe a
    forall {a}. a -> Maybe a
    Just (a -> Maybe a) -> StateT a m a -> StateT a m (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT a m a
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
            Bool
    False -> Maybe a -> StateT a m (Maybe a)
    forall a. a -> StateT a m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe a
    forall a. Maybe a
    Nothing

        normalizeTy :: Typ (NameRef s) -> ST s (Typ Name)
    normalizeTy = \case
            TyVar NameRef s
    n [Typ (NameRef s)]
    tys -> Name -> [Typ Name] -> Typ Name
    forall n. n -> [Typ n] -> Typ n
    TyVar (Name -> [Typ Name] -> Typ Name)
    -> ST s Name -> ST s ([Typ Name] -> Typ Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NameRef s -> ST s Name
    forall s. NameRef s -> ST s Name
    getName NameRef s
    n ST s ([Typ Name] -> Typ Name) -> ST s [Typ Name] -> ST s (Typ Name)
    forall a b. ST s (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Typ (NameRef s) -> ST s (Typ Name))
    -> [Typ (NameRef s)] -> ST s [Typ Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Typ (NameRef s) -> ST s (Typ Name)
    normalizeTy [Typ (NameRef s)]
    tys
            TyCon NameRef s
    n [Typ (NameRef s)]
    tys -> Name -> [Typ Name] -> Typ Name
    forall n. n -> [Typ n] -> Typ n
    TyCon (Name -> [Typ Name] -> Typ Name)
    -> ST s Name -> ST s ([Typ Name] -> Typ Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NameRef s -> ST s Name
    forall s. NameRef s -> ST s Name
    getName NameRef s
    n ST s ([Typ Name] -> Typ Name) -> ST s [Typ Name] -> ST s (Typ Name)
    forall a b. ST s (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Typ (NameRef s) -> ST s (Typ Name))
    -> [Typ (NameRef s)] -> ST s [Typ Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Typ (NameRef s) -> ST s (Typ Name)
    normalizeTy [Typ (NameRef s)]
    tys
            TyFun [Typ (NameRef s)]
    args Typ (NameRef s)
    retn -> [Typ Name] -> Typ Name -> Typ Name
    forall n. [Typ n] -> Typ n -> Typ n
    TyFun ([Typ Name] -> Typ Name -> Typ Name)
    -> ST s [Typ Name] -> ST s (Typ Name -> Typ Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Typ (NameRef s) -> ST s (Typ Name))
    -> [Typ (NameRef s)] -> ST s [Typ Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Typ (NameRef s) -> ST s (Typ Name)
    normalizeTy [Typ (NameRef s)]
    args ST s (Typ Name -> Typ Name) -> ST s (Typ Name) -> ST s (Typ Name)
    forall a b. ST s (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Typ (NameRef s) -> ST s (Typ Name)
    normalizeTy Typ (NameRef s)
    retn

    -- A slight variation on 'Ty', with a special term for functions.
    data Typ n
        = TyFun [Typ n] (Typ n)
        | TyCon n [Typ n]
        | TyVar n [Typ n]
      deriving (Typ n -> Typ n -> Bool
    (Typ n -> Typ n -> Bool) -> (Typ n -> Typ n -> Bool) -> Eq (Typ n)
    forall n. Eq n => Typ n -> Typ n -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall n. Eq n => Typ n -> Typ n -> Bool
    == :: Typ n -> Typ n -> Bool
    $c/= :: forall n. Eq n => Typ n -> Typ n -> Bool
    /= :: Typ n -> Typ n -> Bool
    Eq, Eq (Typ n)
    Eq (Typ n) =>
    (Typ n -> Typ n -> Ordering)
    -> (Typ n -> Typ n -> Bool)
    -> (Typ n -> Typ n -> Bool)
    -> (Typ n -> Typ n -> Bool)
    -> (Typ n -> Typ n -> Bool)
    -> (Typ n -> Typ n -> Typ n)
    -> (Typ n -> Typ n -> Typ n)
    -> Ord (Typ n)
    Typ n -> Typ n -> Bool
    Typ n -> Typ n -> Ordering
    Typ n -> Typ n -> Typ n
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall n. Ord n => Eq (Typ n)
    forall n. Ord n => Typ n -> Typ n -> Bool
    forall n. Ord n => Typ n -> Typ n -> Ordering
    forall n. Ord n => Typ n -> Typ n -> Typ n
    $ccompare :: forall n. Ord n => Typ n -> Typ n -> Ordering
    compare :: Typ n -> Typ n -> Ordering
    $c< :: forall n. Ord n => Typ n -> Typ n -> Bool
    < :: Typ n -> Typ n -> Bool
    $c<= :: forall n. Ord n => Typ n -> Typ n -> Bool
    <= :: Typ n -> Typ n -> Bool
    $c> :: forall n. Ord n => Typ n -> Typ n -> Bool
    > :: Typ n -> Typ n -> Bool
    $c>= :: forall n. Ord n => Typ n -> Typ n -> Bool
    >= :: Typ n -> Typ n -> Bool
    $cmax :: forall n. Ord n => Typ n -> Typ n -> Typ n
    max :: Typ n -> Typ n -> Typ n
    $cmin :: forall n. Ord n => Typ n -> Typ n -> Typ n
    min :: Typ n -> Typ n -> Typ n
    Ord, (forall a b. (a -> b) -> Typ a -> Typ b)
    -> (forall a b. a -> Typ b -> Typ a) -> Functor Typ
    forall a b. a -> Typ b -> Typ a
    forall a b. (a -> b) -> Typ a -> Typ b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Typ a -> Typ b
    fmap :: forall a b. (a -> b) -> Typ a -> Typ b
    $c<$ :: forall a b. a -> Typ b -> Typ a
    <$ :: forall a b. a -> Typ b -> Typ a
    Functor)

    -- Rebuild a little bit of recursion-schemes machinery for Typ.
    data TypF n t
        = TyFunF [t] t
        | TyConF n [t]
        | TyVarF n [t]
      deriving (TypF n t -> TypF n t -> Bool
    (TypF n t -> TypF n t -> Bool)
    -> (TypF n t -> TypF n t -> Bool) -> Eq (TypF n t)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall n t. (Eq t, Eq n) => TypF n t -> TypF n t -> Bool
    $c== :: forall n t. (Eq t, Eq n) => TypF n t -> TypF n t -> Bool
    == :: TypF n t -> TypF n t -> Bool
    $c/= :: forall n t. (Eq t, Eq n) => TypF n t -> TypF n t -> Bool
    /= :: TypF n t -> TypF n t -> Bool
    Eq, Eq (TypF n t)
    Eq (TypF n t) =>
    (TypF n t -> TypF n t -> Ordering)
    -> (TypF n t -> TypF n t -> Bool)
    -> (TypF n t -> TypF n t -> Bool)
    -> (TypF n t -> TypF n t -> Bool)
    -> (TypF n t -> TypF n t -> Bool)
    -> (TypF n t -> TypF n t -> TypF n t)
    -> (TypF n t -> TypF n t -> TypF n t)
    -> Ord (TypF n t)
    TypF n t -> TypF n t -> Bool
    TypF n t -> TypF n t -> Ordering
    TypF n t -> TypF n t -> TypF n t
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall n t. (Ord t, Ord n) => Eq (TypF n t)
    forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> Bool
    forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> Ordering
    forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> TypF n t
    $ccompare :: forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> Ordering
    compare :: TypF n t -> TypF n t -> Ordering
    $c< :: forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> Bool
    < :: TypF n t -> TypF n t -> Bool
    $c<= :: forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> Bool
    <= :: TypF n t -> TypF n t -> Bool
    $c> :: forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> Bool
    > :: TypF n t -> TypF n t -> Bool
    $c>= :: forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> Bool
    >= :: TypF n t -> TypF n t -> Bool
    $cmax :: forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> TypF n t
    max :: TypF n t -> TypF n t -> TypF n t
    $cmin :: forall n t. (Ord t, Ord n) => TypF n t -> TypF n t -> TypF n t
    min :: TypF n t -> TypF n t -> TypF n t
    Ord, (forall a b. (a -> b) -> TypF n a -> TypF n b)
    -> (forall a b. a -> TypF n b -> TypF n a) -> Functor (TypF n)
    forall a b. a -> TypF n b -> TypF n a
    forall a b. (a -> b) -> TypF n a -> TypF n b
    forall n a b. a -> TypF n b -> TypF n a
    forall n a b. (a -> b) -> TypF n a -> TypF n b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall n a b. (a -> b) -> TypF n a -> TypF n b
    fmap :: forall a b. (a -> b) -> TypF n a -> TypF n b
    $c<$ :: forall n a b. a -> TypF n b -> TypF n a
    <$ :: forall a b. a -> TypF n b -> TypF n a
    Functor)

    unroll :: Typ n -> TypF n (Typ n)
    unroll :: forall n. Typ n -> TypF n (Typ n)
    unroll = \case
        TyFun [Typ n]
    args Typ n
    retn -> [Typ n] -> Typ n -> TypF n (Typ n)
    forall n t. [t] -> t -> TypF n t
    TyFunF [Typ n]
    args Typ n
    retn
        TyCon n
    n [Typ n]
    tys     -> n -> [Typ n] -> TypF n (Typ n)
    forall n t. n -> [t] -> TypF n t
    TyConF n
    n [Typ n]
    tys
        TyVar n
    n [Typ n]
    tys     -> n -> [Typ n] -> TypF n (Typ n)
    forall n t. n -> [t] -> TypF n t
    TyVarF n
    n [Typ n]
    tys

    foldTy :: (TypF n a -> a) -> Typ n -> a
    foldTy :: forall n a. (TypF n a -> a) -> Typ n -> a
    foldTy TypF n a -> a
    phi = TypF n a -> a
    phi (TypF n a -> a) -> (Typ n -> TypF n a) -> Typ n -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Typ n -> a) -> TypF n (Typ n) -> TypF n a
    forall a b. (a -> b) -> TypF n a -> TypF n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((TypF n a -> a) -> Typ n -> a
    forall n a. (TypF n a -> a) -> Typ n -> a
    foldTy TypF n a -> a
    phi) (TypF n (Typ n) -> TypF n a)
    -> (Typ n -> TypF n (Typ n)) -> Typ n -> TypF n a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Typ n -> TypF n (Typ n)
    forall n. Typ n -> TypF n (Typ n)
    unroll

    instance Show n => Show (Typ n) where
        show :: Typ n -> FilePath
    show = (TypF n FilePath -> FilePath) -> Typ n -> FilePath
    forall n a. (TypF n a -> a) -> Typ n -> a
    foldTy ((TypF n FilePath -> FilePath) -> Typ n -> FilePath)
    -> (TypF n FilePath -> FilePath) -> Typ n -> FilePath
    forall a b. (a -> b) -> a -> b
    $ \case
            TyFunF [FilePath]
    typs FilePath
    res -> FilePath
    "<" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate FilePath
    ", " [FilePath]
    typs FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "; " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    res FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ">"
            TyConF n
    n [FilePath]
    args -> [FilePath] -> FilePath
    unwords (n -> FilePath
    forall a. Show a => a -> FilePath
    show n
    n FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : [FilePath]
    args)
            TyVarF n
    n [FilePath]
    args -> [FilePath] -> FilePath
    unwords (n -> FilePath
    forall a. Show a => a -> FilePath
    show n
    n FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : [FilePath]
    args)

    -- Convert a Sig to a Typ.
    toTyp :: Name -> Sig Name -> Typ Name
    toTyp :: Name -> Sig Name -> Typ Name
    toTyp Name
    arrow Sig{[Ty Name]
    [Ctx Name]
    sigTy :: forall n. Sig n -> [Ty n]
    sigCtx :: forall n. Sig n -> [Ctx n]
    sigCtx :: [Ctx Name]
    sigTy :: [Ty Name]
    ..} = case [Ty Name]
    sigTy of
        [] -> FilePath -> Typ Name
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "no types?"
        [Ty Name]
    tys -> let args :: [Ty Name]
    args = [Ty Name] -> [Ty Name]
    forall a. HasCallStack => [a] -> [a]
    init [Ty Name]
    tys
                   retn :: Ty Name
    retn = [Ty Name] -> Ty Name
    forall a. HasCallStack => [a] -> a
    last [Ty Name]
    tys
               in [Typ Name] -> Typ Name -> Typ Name
    forall n. [Typ n] -> Typ n -> Typ n
    TyFun ((Ty Name -> Typ Name) -> [Ty Name] -> [Typ Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Ty Name -> Typ Name
    toTy [Ty Name]
    args) (Ty Name -> Typ Name
    toTy Ty Name
    retn)
      where
        toTy :: Ty Name -> Typ Name
    toTy = \case
          TCon Name
    n []   | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    arrow -> Name -> [Typ Name] -> Typ Name
    forall n. n -> [Typ n] -> Typ n
    TyCon Name
    n [] -- empty function type?!
          TCon Name
    n [Ty Name]
    tys | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    arrow -> [Typ Name] -> Typ Name -> Typ Name
    forall n. [Typ n] -> Typ n -> Typ n
    TyFun ((Ty Name -> Typ Name) -> [Ty Name] -> [Typ Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Ty Name -> Typ Name
    toTy ([Ty Name] -> [Ty Name]
    forall a. HasCallStack => [a] -> [a]
    init [Ty Name]
    tys)) (Ty Name -> Typ Name
    toTy (Ty Name -> Typ Name) -> Ty Name -> Typ Name
    forall a b. (a -> b) -> a -> b
    $ [Ty Name] -> Ty Name
    forall a. HasCallStack => [a] -> a
    last [Ty Name]
    tys)
          TCon Name
    n [Ty Name]
    tys -> Name -> [Typ Name] -> Typ Name
    forall n. n -> [Typ n] -> Typ n
    TyCon Name
    n ((Ty Name -> Typ Name) -> [Ty Name] -> [Typ Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Ty Name -> Typ Name
    toTy [Ty Name]
    tys)
          TVar Name
    n [Ty Name]
    tys -> Name -> [Typ Name] -> Typ Name
    forall n. n -> [Typ n] -> Typ n
    TyVar Name
    n ((Ty Name -> Typ Name) -> [Ty Name] -> [Typ Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Ty Name -> Typ Name
    toTy [Ty Name]
    tys)

    ---------------------------------------------------------------------
    -- UNIFICATION

    -- A union-find data structure for names

    type NameRef s = STRef s (NameInfo s)

    data NameInfo s =
        NameInfo { forall s. NameInfo s -> Maybe (NameRef s)
    niParent :: !(Maybe (NameRef s))
                 , forall s. NameInfo s -> Int
    niRank   :: !Int
                 , forall s. NameInfo s -> Name
    niName   :: !Name
                 , forall s. NameInfo s -> Bool
    niFree   :: !Bool
                 }
      deriving NameInfo s -> NameInfo s -> Bool
    (NameInfo s -> NameInfo s -> Bool)
    -> (NameInfo s -> NameInfo s -> Bool) -> Eq (NameInfo s)
    forall s. NameInfo s -> NameInfo s -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall s. NameInfo s -> NameInfo s -> Bool
    == :: NameInfo s -> NameInfo s -> Bool
    $c/= :: forall s. NameInfo s -> NameInfo s -> Bool
    /= :: NameInfo s -> NameInfo s -> Bool
    Eq

    -- Find the name of the equivalence class's (current) representative.
    getName :: NameRef s -> ST s Name
    getName :: forall s. NameRef s -> ST s Name
    getName NameRef s
    ref = do
        rep <- NameRef s -> ST s (NameRef s)
    forall s. NameRef s -> ST s (NameRef s)
    findRep NameRef s
    ref
        niName <$> readSTRef rep

    -- Create a new name reference from a name. @fixed == True@ means
    -- that the reference cannot be unified with any other fixed refs.
    newNameInfo :: Bool -> Name -> ST s (STRef s (NameInfo s))
    newNameInfo :: forall s. Bool -> Name -> ST s (STRef s (NameInfo s))
    newNameInfo Bool
    fixed Name
    n = NameInfo s -> ST s (STRef s (NameInfo s))
    forall a s. a -> ST s (STRef s a)
    newSTRef (NameInfo s -> ST s (STRef s (NameInfo s)))
    -> NameInfo s -> ST s (STRef s (NameInfo s))
    forall a b. (a -> b) -> a -> b
    $
      NameInfo { niParent :: Maybe (STRef s (NameInfo s))
    niParent = Maybe (STRef s (NameInfo s))
    forall a. Maybe a
    Nothing
               , niRank :: Int
    niRank   = Int
    0
               , niName :: Name
    niName   = Name
    n
               , niFree :: Bool
    niFree   = Bool -> Bool
    not Bool
    fixed Bool -> Bool -> Bool
    && Name -> Bool
    isVar Name
    n
               }

    -- The "find" part of union-find, with path compression.
    findRep :: NameRef s -> ST s (NameRef s)
    findRep :: forall s. NameRef s -> ST s (NameRef s)
    findRep NameRef s
    ref = do
        ni <- NameRef s -> ST s (NameInfo s)
    forall s a. STRef s a -> ST s a
    readSTRef NameRef s
    ref
        case niParent ni of
            Maybe (NameRef s)
    Nothing -> NameRef s -> ST s (NameRef s)
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure NameRef s
    ref
            Just NameRef s
    p  -> do
                root <- NameRef s -> ST s (NameRef s)
    forall s. NameRef s -> ST s (NameRef s)
    findRep NameRef s
    p
                writeSTRef ref (ni { niParent = Just root })
                pure root

    -- The "union" part of union-find, with union-by-rank.
    -- Each unification is given a cost of 1 work unit.
    unifyName :: NameRef s -> NameRef s -> StateT Work (ST s) Bool
    unifyName :: forall s. NameRef s -> NameRef s -> StateT Work (ST s) Bool
    unifyName NameRef s
    lhs NameRef s
    rhs = do
        lhs' <- ST s (NameRef s) -> StateT Work (ST s) (NameRef s)
    forall (m :: * -> *) a. Monad m => m a -> StateT Work m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s (NameRef s) -> StateT Work (ST s) (NameRef s))
    -> ST s (NameRef s) -> StateT Work (ST s) (NameRef s)
    forall a b. (a -> b) -> a -> b
    $ NameRef s -> ST s (NameRef s)
    forall s. NameRef s -> ST s (NameRef s)
    findRep NameRef s
    lhs
        rhs' <- lift $ findRep rhs
        lInfo <- lift $ readSTRef lhs'
        rInfo <- lift $ readSTRef rhs'
        let lFree = NameInfo s -> Bool
    forall s. NameInfo s -> Bool
    niFree NameInfo s
    lInfo
            rFree = NameInfo s -> Bool
    forall s. NameInfo s -> Bool
    niFree NameInfo s
    rInfo
            lName = NameInfo s -> Name
    forall s. NameInfo s -> Name
    niName NameInfo s
    lInfo
            rName = NameInfo s -> Name
    forall s. NameInfo s -> Name
    niName NameInfo s
    rInfo
        let ok = Bool
    lFree Bool -> Bool -> Bool
    || Bool
    rFree Bool -> Bool -> Bool
    || Name
    lName Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    rName
        when (ok && lInfo /= rInfo) $ do
            -- Union by rank, except prefer concrete names over type variables.
            workDelta (Work 1)
            let lRank = NameInfo s -> Int
    forall s. NameInfo s -> Int
    niRank NameInfo s
    lInfo
                rRank = NameInfo s -> Int
    forall s. NameInfo s -> Int
    niRank NameInfo s
    rInfo
            let (root, child) = if not lFree || lRank <= rRank
                                then (lhs', rhs')
                                else (rhs', lhs')
            lift $ modifySTRef' child (\NameInfo s
    n -> NameInfo s
    n { niParent = Just root })
            when (lRank == rRank) $ lift $ modifySTRef' root (\NameInfo s
    n -> NameInfo s
    n { niRank = lRank + 1 })

        pure ok

    -- Allocate new references for each name that appears in the type and context.
    refTyp :: Bool -> Typ Name -> [Ctx Name] -> ST s (Typ (NameRef s), [Ctx (NameRef s)])
    refTyp :: forall s.
    Bool
    -> Typ Name
    -> [Ctx Name]
    -> ST s (Typ (NameRef s), [Ctx (NameRef s)])
    refTyp Bool
    fixed Typ Name
    t [Ctx Name]
    cs =
        StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      (Typ (STRef s (NameInfo s)), [Ctx (STRef s (NameInfo s))])
    -> Map Name (STRef s (NameInfo s))
    -> ST s (Typ (STRef s (NameInfo s)), [Ctx (STRef s (NameInfo s))])
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      (Typ (STRef s (NameInfo s)), [Ctx (STRef s (NameInfo s))])
    go Map Name (STRef s (NameInfo s))
    forall k a. Map k a
    Map.empty
      where
        go :: StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      (Typ (STRef s (NameInfo s)), [Ctx (STRef s (NameInfo s))])
    go = do
            ty  <- Typ Name
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)))
    mkRefs Typ Name
    t
            ctx <- forM cs $ \(Ctx Name
    c Name
    a) -> STRef s (NameInfo s)
    -> STRef s (NameInfo s) -> Ctx (STRef s (NameInfo s))
    forall n. n -> n -> Ctx n
    Ctx (STRef s (NameInfo s)
     -> STRef s (NameInfo s) -> Ctx (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (STRef s (NameInfo s) -> Ctx (STRef s (NameInfo s)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    getRef Name
    c StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      (STRef s (NameInfo s) -> Ctx (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Ctx (STRef s (NameInfo s)))
    forall a b.
    StateT (Map Name (STRef s (NameInfo s))) (ST s) (a -> b)
    -> StateT (Map Name (STRef s (NameInfo s))) (ST s) a
    -> StateT (Map Name (STRef s (NameInfo s))) (ST s) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Name
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    getRef Name
    a
            pure (ty, ctx)

        mkRefs :: Typ Name
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)))
    mkRefs = (TypF
       Name
       (StateT
          (Map Name (STRef s (NameInfo s)))
          (ST s)
          (Typ (STRef s (NameInfo s))))
     -> StateT
          (Map Name (STRef s (NameInfo s)))
          (ST s)
          (Typ (STRef s (NameInfo s))))
    -> Typ Name
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)))
    forall n a. (TypF n a -> a) -> Typ n -> a
    foldTy ((TypF
        Name
        (StateT
           (Map Name (STRef s (NameInfo s)))
           (ST s)
           (Typ (STRef s (NameInfo s))))
      -> StateT
           (Map Name (STRef s (NameInfo s)))
           (ST s)
           (Typ (STRef s (NameInfo s))))
     -> Typ Name
     -> StateT
          (Map Name (STRef s (NameInfo s)))
          (ST s)
          (Typ (STRef s (NameInfo s))))
    -> (TypF
          Name
          (StateT
             (Map Name (STRef s (NameInfo s)))
             (ST s)
             (Typ (STRef s (NameInfo s))))
        -> StateT
             (Map Name (STRef s (NameInfo s)))
             (ST s)
             (Typ (STRef s (NameInfo s))))
    -> Typ Name
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)))
    forall a b. (a -> b) -> a -> b
    $ \case
            TyVarF Name
    n [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    args    -> STRef s (NameInfo s)
    -> [Typ (STRef s (NameInfo s))] -> Typ (STRef s (NameInfo s))
    forall n. n -> [Typ n] -> Typ n
    TyVar (STRef s (NameInfo s)
     -> [Typ (STRef s (NameInfo s))] -> Typ (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         ([Typ (STRef s (NameInfo s))] -> Typ (STRef s (NameInfo s)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    getRef Name
    n StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      ([Typ (STRef s (NameInfo s))] -> Typ (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         [Typ (STRef s (NameInfo s))]
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)))
    forall a b.
    StateT (Map Name (STRef s (NameInfo s))) (ST s) (a -> b)
    -> StateT (Map Name (STRef s (NameInfo s))) (ST s) a
    -> StateT (Map Name (STRef s (NameInfo s))) (ST s) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         [Typ (STRef s (NameInfo s))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    args
            TyConF Name
    n [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    args    -> STRef s (NameInfo s)
    -> [Typ (STRef s (NameInfo s))] -> Typ (STRef s (NameInfo s))
    forall n. n -> [Typ n] -> Typ n
    TyCon (STRef s (NameInfo s)
     -> [Typ (STRef s (NameInfo s))] -> Typ (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         ([Typ (STRef s (NameInfo s))] -> Typ (STRef s (NameInfo s)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    getRef Name
    n StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      ([Typ (STRef s (NameInfo s))] -> Typ (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         [Typ (STRef s (NameInfo s))]
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)))
    forall a b.
    StateT (Map Name (STRef s (NameInfo s))) (ST s) (a -> b)
    -> StateT (Map Name (STRef s (NameInfo s))) (ST s) a
    -> StateT (Map Name (STRef s (NameInfo s))) (ST s) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         [Typ (STRef s (NameInfo s))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    args
            TyFunF [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    args StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      (Typ (STRef s (NameInfo s)))
    retn -> [Typ (STRef s (NameInfo s))]
    -> Typ (STRef s (NameInfo s)) -> Typ (STRef s (NameInfo s))
    forall n. [Typ n] -> Typ n -> Typ n
    TyFun ([Typ (STRef s (NameInfo s))]
     -> Typ (STRef s (NameInfo s)) -> Typ (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         [Typ (STRef s (NameInfo s))]
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)) -> Typ (STRef s (NameInfo s)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         [Typ (STRef s (NameInfo s))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [StateT
       (Map Name (STRef s (NameInfo s)))
       (ST s)
       (Typ (STRef s (NameInfo s)))]
    args StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      (Typ (STRef s (NameInfo s)) -> Typ (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)))
    -> StateT
         (Map Name (STRef s (NameInfo s)))
         (ST s)
         (Typ (STRef s (NameInfo s)))
    forall a b.
    StateT (Map Name (STRef s (NameInfo s))) (ST s) (a -> b)
    -> StateT (Map Name (STRef s (NameInfo s))) (ST s) a
    -> StateT (Map Name (STRef s (NameInfo s))) (ST s) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      (Typ (STRef s (NameInfo s)))
    retn

        getRef :: Name
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    getRef Name
    n = do
            known <- StateT
      (Map Name (STRef s (NameInfo s)))
      (ST s)
      (Map Name (STRef s (NameInfo s)))
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
            case Map.lookup n known of
                Just STRef s (NameInfo s)
    ref -> STRef s (NameInfo s)
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    forall a. a -> StateT (Map Name (STRef s (NameInfo s))) (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure STRef s (NameInfo s)
    ref
                Maybe (STRef s (NameInfo s))
    Nothing  -> do
                    ref <- ST s (STRef s (NameInfo s))
    -> StateT
         (Map Name (STRef s (NameInfo s))) (ST s) (STRef s (NameInfo s))
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Name (STRef s (NameInfo s))) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Bool -> Name -> ST s (STRef s (NameInfo s))
    forall s. Bool -> Name -> ST s (STRef s (NameInfo s))
    newNameInfo Bool
    fixed Name
    n)
                    put (Map.insert n ref known)
                    pure ref

    -- Unify two types.
    unifyTyp :: Typ (NameRef s) -> Typ (NameRef s) -> StateT Work (ST s) Bool
    unifyTyp :: forall s.
    Typ (NameRef s) -> Typ (NameRef s) -> StateT Work (ST s) Bool
    unifyTyp Typ (NameRef s)
    lhs Typ (NameRef s)
    rhs = case (Typ (NameRef s)
    lhs, Typ (NameRef s)
    rhs) of
        (TyCon NameRef s
    n [Typ (NameRef s)]
    tys, TyVar NameRef s
    n' [Typ (NameRef s)]
    tys') | [Typ (NameRef s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Typ (NameRef s)]
    tys Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Typ (NameRef s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Typ (NameRef s)]
    tys' -> do
                ok <- NameRef s -> NameRef s -> StateT Work (ST s) Bool
    forall s. NameRef s -> NameRef s -> StateT Work (ST s) Bool
    unifyName NameRef s
    n NameRef s
    n'
                if not ok
                  then pure False
                  else and <$> zipWithM unifyTyp tys tys'

        (TyCon NameRef s
    n [Typ (NameRef s)]
    tys, TyCon NameRef s
    n' [Typ (NameRef s)]
    tys') | [Typ (NameRef s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Typ (NameRef s)]
    tys Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Typ (NameRef s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Typ (NameRef s)]
    tys' -> do
                ok <- NameRef s -> NameRef s -> StateT Work (ST s) Bool
    forall s. NameRef s -> NameRef s -> StateT Work (ST s) Bool
    unifyName NameRef s
    n NameRef s
    n'
                if not ok
                  then pure False
                  else and <$> zipWithM unifyTyp tys tys'

        (TyVar NameRef s
    n [Typ (NameRef s)]
    tys, TyVar NameRef s
    n' [Typ (NameRef s)]
    tys') | [Typ (NameRef s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Typ (NameRef s)]
    tys Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Typ (NameRef s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Typ (NameRef s)]
    tys' -> do
                ok <- NameRef s -> NameRef s -> StateT Work (ST s) Bool
    forall s. NameRef s -> NameRef s -> StateT Work (ST s) Bool
    unifyName NameRef s
    n NameRef s
    n'
                if not ok
                  then pure False
                  else and <$> zipWithM unifyTyp tys tys'

        (TyFun [Typ (NameRef s)]
    args Typ (NameRef s)
    ret, TyFun [Typ (NameRef s)]
    args' Typ (NameRef s)
    ret') | [Typ (NameRef s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Typ (NameRef s)]
    args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Typ (NameRef s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Typ (NameRef s)]
    args' -> do
                ok <- Typ (NameRef s) -> Typ (NameRef s) -> StateT Work (ST s) Bool
    forall s.
    Typ (NameRef s) -> Typ (NameRef s) -> StateT Work (ST s) Bool
    unifyTyp Typ (NameRef s)
    ret Typ (NameRef s)
    ret'
                if not ok
                  then pure False
                  else and <$> zipWithM unifyTyp args args'

        (Typ (NameRef s), Typ (NameRef s))
    _ -> Bool -> StateT Work (ST s) Bool
    forall a. a -> StateT Work (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False

    -- The total cost of a unification operation.
    newtype Work = Work Int

    unWork :: Work -> Int
    unWork :: Work -> Int
    unWork (Work Int
    w) = Int
    w

    workDelta :: Monad m => Work -> StateT Work m ()
    workDelta :: forall (m :: * -> *). Monad m => Work -> StateT Work m ()
    workDelta (Work Int
    dw) = (Work -> Work) -> StateT Work m ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify' (\(Work Int
    w) -> Int -> Work
    Work (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    dw))