    {-# LANGUAGE DerivingStrategies         #-}
    {-# LANGUAGE OverloadedStrings          #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.JS.JStg.Monad
    -- Copyright   :  (c) The University of Glasgow 2001
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Jeffrey Young  <jeffrey.young@iohk.io>
    --                Luite Stegeman <luite.stegeman@iohk.io>
    --                Sylvain Henry  <sylvain.henry@iohk.io>
    --                Josh Meredith  <josh.meredith@iohk.io>
    -- Stability   :  experimental
    --
    --
    -- * Domain and Purpose
    --
    --     GHC.JS.JStg.Monad defines the computational environment for the eDSL that
    --     we use to write the JS Backend's RTS. Its purpose is to ensure unique
    --     identifiers are generated throughout the backend and that we can use the
    --     host language to ensure references are not mixed.
    --
    -- * Strategy
    --
    --     The monad is a straightforward state monad which holds an environment
    --     holds a pointer to a prefix to tag identifiers with and an infinite
    --     stream of identifiers.
    --
    -- * Usage
    --
    --     One should almost never need to directly use the functions in this
    --     module. Instead one should opt to use the combinators in 'GHC.JS.Make',
    --     the sole exception to this is the @withTag@ function which is used to
    --     change the prefix of identifiers for a given computation. For example,
    --     the rts uses this function to tag all identifiers generated by the RTS
    --     code as RTS_N, where N is some unique.
    -----------------------------------------------------------------------------
    module GHC.JS.JStg.Monad
      ( runJSM
      , JSM
      , withTag
      , newIdent
      , initJSM
      ) where

    import Prelude

    import GHC.JS.Ident

    import GHC.Types.Unique
    import GHC.Types.Unique.Supply
    import Control.Monad.Trans.State.Strict
    import GHC.Data.FastString

    --------------------------------------------------------------------------------
    --                            JSM Monad
    --------------------------------------------------------------------------------

    -- | Environment for the JSM Monad. We maintain the prefix of each ident in the
    -- environment to allow consumers to tag idents with a new prefix. See @withTag@
    data JEnv = JEnv { JEnv -> FastString
    prefix :: !FastString -- ^ prefix for generated names, e.g.,
                                             -- prefix = "RTS" will generate names
                                             -- such as 'h$RTS_jUt'
                     , JEnv -> UniqSupply
    ids    :: UniqSupply  -- ^ The supply of uniques for names
                                             -- generated by the JSM monad.
                     }

    type JSM a = State JEnv a

    runJSM :: JEnv -> JSM a -> a
    runJSM :: forall a. JEnv -> JSM a -> a
    runJSM JEnv
    env JSM a
    m = JSM a -> JEnv -> a
    forall s a. State s a -> s -> a
    evalState JSM a
    m JEnv
    env

    -- | create a new environment using the input tag.
    initJSMState :: FastString -> UniqSupply -> JEnv
    initJSMState :: FastString -> UniqSupply -> JEnv
    initJSMState FastString
    tag UniqSupply
    supply = JEnv { prefix :: FastString
    prefix = FastString
    tag
                                   , ids :: UniqSupply
    ids    = UniqSupply
    supply
                                   }
    initJSM :: IO JEnv
    initJSM :: IO JEnv
    initJSM = do supply <- Char -> IO UniqSupply
    mkSplitUniqSupply Char
    'j'
                 return (initJSMState "js" supply)

    update_stream :: UniqSupply -> JSM ()
    update_stream :: UniqSupply -> JSM ()
    update_stream UniqSupply
    new = (JEnv -> JEnv) -> JSM ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify' ((JEnv -> JEnv) -> JSM ()) -> (JEnv -> JEnv) -> JSM ()
    forall a b. (a -> b) -> a -> b
    $ \JEnv
    env -> JEnv
    env {ids = new}

    -- | generate a fresh Ident
    newIdent :: JSM Ident
    newIdent :: JSM Ident
    newIdent = do env <- StateT JEnv Identity JEnv
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
                  let tag    = JEnv -> FastString
    prefix JEnv
    env
                      supply = JEnv -> UniqSupply
    ids    JEnv
    env
                      (id,rest) = takeUniqFromSupply supply
                  update_stream rest
                  return  $ mk_ident tag id

    mk_ident :: FastString -> Unique -> Ident
    mk_ident :: FastString -> Unique -> Ident
    mk_ident FastString
    t Unique
    i = FastString -> Ident
    name ([FastString] -> FastString
    forall a. Monoid a => [a] -> a
    mconcat [FastString
    t, FastString
    "_", String -> FastString
    mkFastString (Unique -> String
    forall a. Show a => a -> String
    show Unique
    i)])

    -- | Set the tag for @Ident@s for all remaining computations.
    tag_names :: FastString -> JSM ()
    tag_names :: FastString -> JSM ()
    tag_names FastString
    tag = (JEnv -> JEnv) -> JSM ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify' (\JEnv
    env -> JEnv
    env {prefix = tag})

    -- | tag the name generater with a prefix for the monadic action.
    withTag
      :: FastString -- ^ new name to tag with
      -> JSM a      -- ^ action to run with new tags
      -> JSM a      -- ^ result
    withTag :: forall a. FastString -> JSM a -> JSM a
    withTag FastString
    tag JSM a
    go = do
      old <- (JEnv -> FastString) -> StateT JEnv Identity FastString
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets JEnv -> FastString
    prefix
      tag_names tag
      result <- go
      tag_names old
      return result