-- | Module for generating unique names which correspond to given names
-- (of type ref).
module Util.NameMangle(
   NameMangler,
   newNameMangler, -- :: IO (NameMangler ref)
   MangledName, -- synonym for String.  MangledNames are generated by
      -- UniqueString.
   newMangledName, -- :: NameMangler ref -> ref -> IO MangledName
   readMangledName, -- :: NameMangler ref -> MangledName -> IO ref
   ) where

import Util.Registry
import Util.UniqueString

-- ---------------------------------------------------------------------
-- Data types
-- ---------------------------------------------------------------------

type MangledName = String

-- | For now we just do this naively, with a Registry.  Since the names are
-- generated sequentially a dynamic array would be more efficient, perhaps.
data NameMangler ref = NameMangler {
   NameMangler ref -> UniqueStringSource
nameSource :: UniqueStringSource,
   NameMangler ref -> Registry MangledName ref
fromMangledName :: Registry MangledName ref
   }

-- ---------------------------------------------------------------------
-- Functions
-- ---------------------------------------------------------------------

newNameMangler :: IO (NameMangler ref)
newNameMangler :: IO (NameMangler ref)
newNameMangler =
   do
      UniqueStringSource
nameSource <- IO UniqueStringSource
newUniqueStringSource
      Registry MangledName ref
fromMangledName <- IO (Registry MangledName ref)
forall registry. NewRegistry registry => IO registry
newRegistry
      NameMangler ref -> IO (NameMangler ref)
forall (m :: * -> *) a. Monad m => a -> m a
return (NameMangler :: forall ref.
UniqueStringSource -> Registry MangledName ref -> NameMangler ref
NameMangler {nameSource :: UniqueStringSource
nameSource = UniqueStringSource
nameSource,
         fromMangledName :: Registry MangledName ref
fromMangledName = Registry MangledName ref
fromMangledName})

newMangledName :: NameMangler ref -> ref -> IO MangledName
newMangledName :: NameMangler ref -> ref -> IO MangledName
newMangledName (NameMangler {nameSource :: forall ref. NameMangler ref -> UniqueStringSource
nameSource = UniqueStringSource
nameSource,
      fromMangledName :: forall ref. NameMangler ref -> Registry MangledName ref
fromMangledName = Registry MangledName ref
fromMangledName}) ref
str =
   do
      MangledName
name <- UniqueStringSource -> IO MangledName
newUniqueString UniqueStringSource
nameSource
      Registry MangledName ref -> MangledName -> ref -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry MangledName ref
fromMangledName MangledName
name ref
str
      MangledName -> IO MangledName
forall (m :: * -> *) a. Monad m => a -> m a
return MangledName
name

readMangledName :: NameMangler ref -> MangledName -> IO ref
readMangledName :: NameMangler ref -> MangledName -> IO ref
readMangledName (NameMangler {fromMangledName :: forall ref. NameMangler ref -> Registry MangledName ref
fromMangledName = Registry MangledName ref
fromMangledName}) MangledName
name =
   do
      Maybe ref
refOpt <- Registry MangledName ref -> MangledName -> IO (Maybe ref)
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry MangledName ref
fromMangledName MangledName
name
      case Maybe ref
refOpt of
         Maybe ref
Nothing -> MangledName -> IO ref
forall a. HasCallStack => MangledName -> a
error (MangledName
"NameMangle: couldn't retrieve "MangledName -> MangledName -> MangledName
forall a. [a] -> [a] -> [a]
++MangledName
name)
         Just ref
ref -> ref -> IO ref
forall (m :: * -> *) a. Monad m => a -> m a
return ref
ref