    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE ViewPatterns #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.StgToJS.Linker.Opt
    -- 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>
    -- Stability   :  experimental
    --
    -- Optimization pass at link time
    --
    --
    --
    -----------------------------------------------------------------------------
    module GHC.StgToJS.Linker.Opt
      ( pretty
      , optRenderJs
      )
    where

    import GHC.Prelude
    import GHC.Int
    import GHC.Exts

    import GHC.JS.Syntax
    import GHC.JS.Ppr

    import GHC.Utils.Outputable
    import GHC.Data.FastString
    import GHC.Types.Unique.Map

    import Data.List (sortOn)
    import Data.Char (isAlpha,isDigit,ord)
    import qualified Data.ByteString.Short as SBS

    pretty :: JsRender doc => Bool -> JStat -> doc
    pretty :: forall doc. JsRender doc => Bool -> JStat -> doc
    pretty Bool
    render_pretty = \case
      BlockStat []      -> doc
    forall doc. IsOutput doc => doc
    empty
      JStat
    s | Bool
    render_pretty -> RenderJs doc -> [JStat] -> doc
    forall doc. JsRender doc => RenderJs doc -> [JStat] -> doc
    forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
    jsToDocR RenderJs doc
    forall doc. RenderJs doc
    defaultRenderJs [JStat
    s]
        | Bool
    otherwise     -> RenderJs doc -> [JStat] -> doc
    forall doc. JsRender doc => RenderJs doc -> [JStat] -> doc
    forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
    jsToDocR RenderJs doc
    forall doc. RenderJs doc
    optRenderJs [JStat
    s]
                            -- render as a list of statements to ensure that
                            -- semicolons are added.

    -- | Render JS with code size minimization enabled
    optRenderJs :: RenderJs doc
    optRenderJs :: forall doc. RenderJs doc
    optRenderJs = RenderJs doc
    forall doc. RenderJs doc
    defaultRenderJs
      { renderJsV = ghcjsRenderJsV
      , renderJsS = ghcjsRenderJsS
      , renderJsI = ghcjsRenderJsI
      }

    hdd :: SBS.ShortByteString
    hdd :: ShortByteString
    hdd = [Word8] -> ShortByteString
    SBS.pack ((Char -> Word8) -> [Char] -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    ord) [Char]
    "h$$")

    ghcjsRenderJsI :: IsLine doc => RenderJs doc -> Ident -> doc
    ghcjsRenderJsI :: forall doc. IsLine doc => RenderJs doc -> Ident -> doc
    ghcjsRenderJsI RenderJs doc
    _ (Ident -> FastString
    identFS -> FastString
    fs)
      -- Fresh symbols are prefixed with "h$$". They aren't explicitly referred by
      -- name in user code, only in compiled code. Hence we can rename them if we do
      -- it consistently in all the linked code.
      --
      -- These symbols are usually very large because their name includes the
      -- unit-id, the module name, and some unique number. So we rename these
      -- symbols with a much shorter globally unique number.
      --
      -- Here we reuse their FastString unique for this purpose! Note that it only
      -- works if we pretty-print all the JS code linked together at once, which we
      -- currently do. GHCJS used to maintain a CompactorState to support
      -- incremental linking: it contained the mapping between original symbols and
      -- their renaming.
      | ShortByteString
    hdd ShortByteString -> ShortByteString -> Bool
    `SBS.isPrefixOf` FastString -> ShortByteString
    fastStringToShortByteString FastString
    fs
      , Int
    u <- FastString -> Int
    uniqueOfFS FastString
    fs
      = [Char] -> doc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "h$$" doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Word -> doc
    forall doc. IsLine doc => Word -> doc
    hexDoc (Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    u)
      | Bool
    otherwise
      = FastString -> doc
    forall doc. IsLine doc => FastString -> doc
    ftext FastString
    fs

    -- | Render as an hexadecimal number in reversed order (because it's faster and we
    -- don't care about the actual value).
    hexDoc :: IsLine doc => Word -> doc
    hexDoc :: forall doc. IsLine doc => Word -> doc
    hexDoc Word
    0 = Char -> doc
    forall doc. IsLine doc => Char -> doc
    char Char
    '0'
    hexDoc Word
    v = [Char] -> doc
    forall doc. IsLine doc => [Char] -> doc
    text ([Char] -> doc) -> [Char] -> doc
    forall a b. (a -> b) -> a -> b
    $ Word -> [Char]
    go Word
    v
      where
        sym :: Int -> Char
    sym (I# Int#
    i) = Char# -> Char
    C# (Addr# -> Int# -> Char#
    indexCharOffAddr# Addr#
    chars Int#
    i)
        chars :: Addr#
    chars = Addr#
    "0123456789abcdef"#
        go :: Word -> [Char]
    go = \case
          Word
    0 -> []
          Word
    n -> Int -> Char
    sym (Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word
    n Word -> Word -> Word
    forall a. Bits a => a -> a -> a
    .&. Word
    0x0F))
               Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Int -> Char
    sym (Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word
    n Word -> Word -> Word
    forall a. Bits a => a -> a -> a
    .&. Word
    0xF0) Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    4))
               Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Word -> [Char]
    go (Word
    n Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8)

    -- attempt to resugar some of the common constructs
    ghcjsRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc
    ghcjsRenderJsS :: forall doc. JsRender doc => RenderJs doc -> JStat -> doc
    ghcjsRenderJsS RenderJs doc
    r JStat
    s = RenderJs doc -> JsRender doc => RenderJs doc -> JStat -> doc
    forall doc.
    RenderJs doc -> JsRender doc => RenderJs doc -> JStat -> doc
    renderJsS RenderJs doc
    forall doc. RenderJs doc
    defaultRenderJs RenderJs doc
    r JStat
    s

    -- don't quote keys in our object literals, so closure compiler works
    ghcjsRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc
    ghcjsRenderJsV :: forall doc. JsRender doc => RenderJs doc -> JVal -> doc
    ghcjsRenderJsV RenderJs doc
    r (JHash UniqMap FastString JExpr
    m)
      | UniqMap FastString JExpr -> Bool
    forall k a. UniqMap k a -> Bool
    isNullUniqMap UniqMap FastString JExpr
    m = [Char] -> doc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "{}"
      | Bool
    otherwise       = doc -> doc
    forall doc. JsRender doc => doc -> doc
    braceNest (doc -> doc)
    -> ([(FastString, JExpr)] -> doc) -> [(FastString, JExpr)] -> doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [doc] -> doc
    forall doc. IsLine doc => [doc] -> doc
    fsep ([doc] -> doc)
    -> ([(FastString, JExpr)] -> [doc]) -> [(FastString, JExpr)] -> doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . doc -> [doc] -> [doc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate doc
    forall doc. IsLine doc => doc
    comma ([doc] -> [doc])
    -> ([(FastString, JExpr)] -> [doc])
    -> [(FastString, JExpr)]
    -> [doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                              ((FastString, JExpr) -> doc) -> [(FastString, JExpr)] -> [doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(FastString
    x,JExpr
    y) -> FastString -> doc
    forall doc. IsLine doc => FastString -> doc
    quoteIfRequired FastString
    x doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> doc
    forall doc. IsLine doc => doc
    colon doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> RenderJs doc -> JExpr -> doc
    forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
    forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
    jsToDocR RenderJs doc
    r JExpr
    y)
                              -- nonDetEltsUniqMap doesn't introduce non-determinism here because
                              -- we sort the elements lexically
                              ([(FastString, JExpr)] -> [doc])
    -> ([(FastString, JExpr)] -> [(FastString, JExpr)])
    -> [(FastString, JExpr)]
    -> [doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((FastString, JExpr) -> LexicalFastString)
    -> [(FastString, JExpr)] -> [(FastString, JExpr)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (FastString -> LexicalFastString
    LexicalFastString (FastString -> LexicalFastString)
    -> ((FastString, JExpr) -> FastString)
    -> (FastString, JExpr)
    -> LexicalFastString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FastString, JExpr) -> FastString
    forall a b. (a, b) -> a
    fst) ([(FastString, JExpr)] -> doc) -> [(FastString, JExpr)] -> doc
    forall a b. (a -> b) -> a -> b
    $ UniqMap FastString JExpr -> [(FastString, JExpr)]
    forall k a. UniqMap k a -> [(k, a)]
    nonDetUniqMapToList UniqMap FastString JExpr
    m
      where
        quoteIfRequired :: IsLine doc => FastString -> doc
        quoteIfRequired :: forall doc. IsLine doc => FastString -> doc
    quoteIfRequired FastString
    x
          | FastString -> Bool
    isUnquotedKey FastString
    x = FastString -> doc
    forall doc. IsLine doc => FastString -> doc
    ftext FastString
    x
          | Bool
    otherwise       = Char -> doc
    forall doc. IsLine doc => Char -> doc
    char Char
    '\'' doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> FastString -> doc
    forall doc. IsLine doc => FastString -> doc
    ftext FastString
    x doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> doc
    forall doc. IsLine doc => Char -> doc
    char Char
    '\''

        isUnquotedKey :: FastString -> Bool
        isUnquotedKey :: FastString -> Bool
    isUnquotedKey FastString
    fs = case FastString -> [Char]
    unpackFS FastString
    fs of
          []       -> Bool
    False
          s :: [Char]
    s@(Char
    c:[Char]
    cs) -> (Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isDigit [Char]
    s Bool -> Bool -> Bool
    || (Char -> Bool
    validFirstIdent Char
    c Bool -> Bool -> Bool
    && (Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    validOtherIdent [Char]
    cs)

        validFirstIdent :: Char -> Bool
    validFirstIdent Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '$' Bool -> Bool -> Bool
    || Char -> Bool
    isAlpha Char
    c
        validOtherIdent :: Char -> Bool
    validOtherIdent Char
    c = Char -> Bool
    isAlpha Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isDigit Char
    c

    ghcjsRenderJsV RenderJs doc
    r JVal
    v = RenderJs doc -> JsRender doc => RenderJs doc -> JVal -> doc
    forall doc.
    RenderJs doc -> JsRender doc => RenderJs doc -> JVal -> doc
    renderJsV RenderJs doc
    forall doc. RenderJs doc
    defaultRenderJs RenderJs doc
    r JVal
    v