{-# LANGUAGE TemplateHaskell #-}
module Demangler.Context
  (
    Context
  , Coord
  , newDemangling
  , contextFindOrAdd
  , contextStr
  , WithContext(..)
  , sayableConstraints
  )
where

import           Data.Sequence ( (|>) )
import qualified Data.Sequence as Seq
import           Data.Text ( Text )
import qualified Language.Haskell.TH as TH

import Text.Sayable


-- | The Context provides a persistent information and collection over a set of
-- demangling calls.  This allows for additional efficiency in memory storage.

-- Note that it can be observed that the stored data here is identifiers, and
-- therefore there are 64 initial characters ('A-Za-z0-9_' + 1 bucket for all
-- others).  This might lead to the use of an Array of Seq or an IntMap of Seq.
-- Both of these were tested in both single and batched mode against
-- approximately 13,000 demanglings: there was no significant different between
-- those more complicated forms and this simple Seq in either time, memory
-- consumption, or garbage collection, so this simplest form is sufficient.

data Context = Context (Seq.Seq Text)

-- | Return an initial Context useable for calls to 'demangle'.

newDemangling :: Context
newDemangling :: Context
newDemangling = Seq Text -> Context
Context forall a. Monoid a => a
mempty

type Coord = Int


contextFindOrAdd :: Text -> Context -> (Coord, Context)
contextFindOrAdd :: Text -> Context -> (Coord, Context)
contextFindOrAdd Text
s c :: Context
c@(Context Seq Text
l) =
  case forall a. Eq a => a -> Seq a -> Maybe Coord
Seq.elemIndexL Text
s Seq Text
l of
    Just Coord
n -> (Coord
n, Context
c)
    Maybe Coord
Nothing -> (forall a. Seq a -> Coord
Seq.length Seq Text
l, Seq Text -> Context
Context forall a b. (a -> b) -> a -> b
$ Seq Text
l forall a. Seq a -> a -> Seq a
|> Text
s)

contextStr :: Context -> Coord -> Text
contextStr :: Context -> Coord -> Text
contextStr (Context Seq Text
l) Coord
i = Seq Text
l forall a. Seq a -> Coord -> a
`Seq.index` Coord
i

data WithContext a = WC a Context

sayableConstraints :: TH.Name -> TH.PredQ
sayableConstraints :: Name -> PredQ
sayableConstraints Name
forTy = do
  let rTy :: Type
rTy = Name -> Type
TH.ConT Name
forTy
  Type
wctxt <- [t|WithContext|]
  ConstrM () -> PredQ
sayableSubConstraints forall a b. (a -> b) -> a -> b
$ do Name -> ConstrM ()
ofType Name
forTy
                             Type -> ConstrM ()
paramTH Type
rTy
                             (Name -> Bool) -> ConstrM ()
subElemFilter (Bool -> Bool
not
                                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"Context"
                                                      , String
"Bool"
                                                      , String
"Natural"
                                                      , String
"Float"
                                                      ])
                                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
TH.nameBase)
                             Type -> ConstrM ()
subWrapper Type
wctxt
                             String -> ConstrM ()
tagVar String
"saytag"