[Git][ghc/ghc][wip/js-staging] StgToJS.Linker: Add docs to utility modules
doyougnu (@doyougnu)
gitlab at gitlab.haskell.org
Fri Sep 23 12:03:46 UTC 2022
doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
5d06a2d6 by doyougnu at 2022-09-23T08:03:21-04:00
StgToJS.Linker: Add docs to utility modules
StgToJS.Linker.Utils: more docs
StgToJS.Linker.Archive: more docs
- - - - -
2 changed files:
- compiler/GHC/StgToJS/Linker/Archive.hs
- compiler/GHC/StgToJS/Linker/Utils.hs
Changes:
=====================================
compiler/GHC/StgToJS/Linker/Archive.hs
=====================================
@@ -13,7 +13,10 @@
-- Josh Meredith <josh.meredith at iohk.io>
-- Stability : experimental
--
+-- Various utilies used in the JS Linker which wrap around ar.
+--
-----------------------------------------------------------------------------
+
module GHC.StgToJS.Linker.Archive
( Entry(..), Index, IndexEntry(..), Meta(..)
, writeArchive
@@ -36,6 +39,7 @@ import GHC.Settings.Constants (hiVersion)
type Index = [IndexEntry]
+-- | An @IndexEntry@ is a payload and an offset into the archive
data IndexEntry = IndexEntry
{ ieEntry :: !Entry -- ^ Entry identifier
, ieOffset :: !(Bin ByteString) -- ^ Offset in the archive
@@ -47,9 +51,10 @@ instance Binary IndexEntry where
put_ bh b
get bh = IndexEntry <$> get bh <*> get bh
+-- | An @Entry@ is either a module or a JavaScript source file.
data Entry
- = Object !ModuleName
- | JsSource !FilePath
+ = Object !ModuleName -- ^ A Haskell Module
+ | JsSource !FilePath -- ^ A JS Source file
deriving (Show)
instance Binary Entry where
@@ -69,9 +74,12 @@ instance Binary Meta where
put_ bh (Meta a) = put_ bh a
get bh = Meta <$> get bh
+-- | A header indicating we are in JS land.
magic :: FixedLengthEncoding Word64
magic = FixedLengthEncoding 0x435241534a434847 -- "GHCJSARC"
+-- | Write payload, entries, to @FilePath@, path, using @Meta@, meta, to
+-- construct the payload header.
writeArchive :: FilePath -> Meta -> [(Entry, ByteString)] -> IO ()
writeArchive path meta entries = do
bh <- openBinMem (4*1024*1000)
@@ -99,6 +107,8 @@ data Header = Header
, hdrHandle :: !BinHandle
}
+-- | Given a binary handle, retrieve the header from the archive. Note this
+-- function is unsafe and may panic.
getArchiveHeader :: BinHandle -> IO Header
getArchiveHeader bh = do
is_magic <- (== magic) <$> get bh
@@ -115,18 +125,22 @@ getArchiveHeader bh = do
, hdrHandle = bh
}
+-- | Read the meta data from an archive pointed to by 'file'.
readMeta :: FilePath -> IO Meta
readMeta file = do
bh <- readBinMem file
hdr <- getArchiveHeader bh
pure $! hdrMeta hdr
+-- | Read the index from an archive pointed to by 'file'.
readIndex :: FilePath -> IO Index
readIndex file = do
bh <- readBinMem file
hdr <- getArchiveHeader bh
pure $! hdrIndex hdr
+-- | Read the all payloads that satisfy the input predicate, 'pred', in the
+-- archive pointed to by 'hdr'.
getArchiveEntries :: Header -> (Entry -> Bool) -> IO [ByteString]
getArchiveEntries hdr pred = mapMaybeM read_entry (hdrIndex hdr)
where
@@ -137,6 +151,9 @@ getArchiveEntries hdr pred = mapMaybeM read_entry (hdrIndex hdr)
Just <$> get bh
| otherwise = pure Nothing
+-- | Get a single payload by searching @IndexEntry at s in 'hdr', returns the first
+-- entry that satisfies the input predicate, 'pred', in the archive pointed to
+-- by 'hdr'. Returns Nothing if 'pred' fails for all entries.
getArchiveEntry :: Header -> (Entry -> Bool) -> IO (Maybe ByteString)
getArchiveEntry hdr pred = go (hdrIndex hdr)
where
=====================================
compiler/GHC/StgToJS/Linker/Utils.hs
=====================================
@@ -37,6 +37,8 @@ import GHC.Platform
import Data.List (isPrefixOf)
import System.Directory (createDirectoryIfMissing)
+-- | Given a FilePath and payload, write a file to disk creating any directories
+-- along the way if needed.
writeBinaryFile :: FilePath -> ByteString -> IO ()
writeBinaryFile file bs = do
createDirectoryIfMissing True (takeDirectory file)
@@ -48,15 +50,19 @@ writeBinaryFile file bs = do
let (b1, b2) = B.splitAt 1073741824 b
in b1 : if B.null b1 then [] else chunks b2
+-- | Retrieve library directories provided by the @UnitId@ in @UnitState@
getInstalledPackageLibDirs :: UnitState -> UnitId -> [FilePath]
getInstalledPackageLibDirs us = fmap unpack . maybe mempty unitLibraryDirs . lookupUnitId us
+-- | Retrieve the names of the libraries provided by @UnitId@
getInstalledPackageHsLibs :: UnitState -> UnitId -> [String]
getInstalledPackageHsLibs us = fmap unpack . maybe mempty unitLibraries . lookupUnitId us
+-- | A constant holding the compiler version
getCompilerVersion :: String
getCompilerVersion = cProjectVersion
+-- | A constant holding the JavaScript executable Filename extension
jsexeExtension :: String
jsexeExtension = "jsexe"
@@ -66,11 +72,14 @@ commonCppDefs profiling = case profiling of
True -> commonCppDefs_profiled
False -> commonCppDefs_vanilla
--- Use CAFs for commonCppDefs_* so that they are shared for every CPP file
+-- | CPP definitions for normal operation and profiling. Use CAFs for
+-- commonCppDefs_* so that they are shared for every CPP file
commonCppDefs_vanilla, commonCppDefs_profiled :: ByteString
commonCppDefs_vanilla = genCommonCppDefs False
commonCppDefs_profiled = genCommonCppDefs True
+-- | Generate CPP Definitions depending on a profiled or normal build. This
+-- occurs at link time.
genCommonCppDefs :: Bool -> ByteString
genCommonCppDefs profiling = mconcat
[
@@ -270,6 +279,8 @@ genCommonCppDefs profiling = mconcat
, "#define CALL_UBX_TUP10(r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; (r7) = h$ret6; (r8) = h$ret7; (r9) = h$ret8; (r10) = h$ret9; }\n"
]
+-- | Construct the Filename for the "binary" of Haskell code compiled to
+-- JavaScript.
jsExeFileName :: DynFlags -> FilePath
jsExeFileName dflags
| Just s <- outputFile_ dflags =
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d06a2d631598615af41b07b476d5ab06d347616
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d06a2d631598615af41b07b476d5ab06d347616
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220923/96546dea/attachment-0001.html>
More information about the ghc-commits
mailing list