Skip to content

Remove GHCJS's Objectable type class, replacing its usage with GHC Binary

Josh Meredith requested to merge JoshMeredith/ghc:wip/js-binary into wip/js-staging

This patch removes the now-redundant Objectable type class from the GHCJS backend in favour of GHC's standard Binary utility class.

Notably, to retain the structure of the GHCJS CodeGen module (which orders sub-sections of its generated code by using ByteString concatenation), we introduce helper functions to convert between GHC's BinHandle binary buffers and ByteStrings:

packBinBuffer :: BinHandle -> IO ByteString
unpackBinBuffer :: Int -> ByteString -> IO BinHandle

It is expected that this perhaps won't provide the JavaScript backend with the same performance as a full conversion to GHC's Binary idioms would, but it does make a step towards that by removing a redundant serialisation mechanism, and, since this involves replacing Objectable's use of ByteString builder monads (for the subsections) with GHC's performant binary buffers, I believe that there likely isn't a performance regression.

Leading on from this, there are two main changes to GHC.StgToJS.Object:

First, its entry points for (de)serialisation are changed, introducing the explicit BinHandle argument, as well as adding IO:

-- Old
type PutSM = St.StateT SymbolTable DB.PutM
type PutS  = PutSM ()
type GetS  = ReaderT ObjEnv DB.Get

runGetS :: HasDebugCallStack => String -> SymbolTableR -> GetS a -> ByteString -> a
runPutS :: SymbolTable -> PutS -> (SymbolTable, ByteString)

-- New 
runGetS :: HasDebugCallStack => String -> SymbolTableR -> (BinHandle -> IO a) -> ByteString -> IO a
runPutS :: SymbolTable -> (BinHandle -> IO ()) -> IO (SymbolTable, ByteString)

Secondly, the use of State/Reader monads for the symbol table is replaced by GHC's UserData FastString dictionary. UserData stores functions to read/write FastStrings, and these are accessed by instance Binary FastString. During serialisation, the SymbolTable is stored in a mutable reference (as is idiomatic for UserData functions), and GHCJS's existing helper functions are used to update it. GHCJS's Objectable instance for FastString previously stored them in the SymbolTable along with ShortText, so the combination of the two is not a problem.

Question for @luite:

data SymbolTableR = SymbolTableR
  { strText   :: Array Int ShortText
  , strString :: Array Int String
  }

The reading SymbolTableR type has two lookup arrays, and the instances for String (which FastStrings were converted to in Objectable) seem to use the ShortText table for serialisation, but read out from the strString array on deserialisation - is this intended behaviour that needs to be maintained?

As a consequence of introducing IO into runGetS/runPutS, various helper functions in Object also gained IO, which also requires the addition of IO to GHCJS's CodeGen G monad:

type G = StateT GenState IO

as well as basic refactoring in the CodeGen module of converting let/where to do/<-.

Merge request reports