[Git][ghc/ghc][wip/js-staging] JS.Linker: removes FIXMEs
doyougnu (@doyougnu)
gitlab at gitlab.haskell.org
Thu Aug 25 18:10:57 UTC 2022
doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
1c44a5a5 by doyougnu at 2022-08-25T14:10:29-04:00
JS.Linker: removes FIXMEs
JS.Linker.Linker: remove FIXMEs, clean dead code
StgToJS.Linker.Utils: remove FIXMEs
Compactor: Remove FIXMEs
StgToJS.Linker.Types: Remove FIXMEs
JS.Linker.Archive/Dynamic: remove FIXMEs
StgToJS.Linker.Shims: remove FIXMEs
- - - - -
6 changed files:
- compiler/GHC/StgToJS/Linker/Archive.hs
- compiler/GHC/StgToJS/Linker/Compactor.hs
- compiler/GHC/StgToJS/Linker/Dynamic.hs
- compiler/GHC/StgToJS/Linker/Shims.hs
- compiler/GHC/StgToJS/Linker/Types.hs
- compiler/GHC/StgToJS/Linker/Utils.hs
Changes:
=====================================
compiler/GHC/StgToJS/Linker/Archive.hs
=====================================
@@ -14,10 +14,6 @@
-- Josh Meredith <josh.meredith at iohk.io>
-- Stability : experimental
--
--- FIXME: Jeff(2022,04): Remove this module completely, its only consumer is
--- GHC.StgToJS.Linker.Dynamic and is likely no longer necessary with the new
--- GHC Api. I simply decided adapting this module was faster/easier than
--- removing it and figuring out GHC.StgToJS.Linker.Dynamic with the new API
-----------------------------------------------------------------------------
module GHC.StgToJS.Linker.Archive
( Entry(..), Index, IndexEntry(..), Meta(..)
=====================================
compiler/GHC/StgToJS/Linker/Compactor.hs
=====================================
@@ -31,7 +31,6 @@
module GHC.StgToJS.Linker.Compactor
( compact
- -- FIXME (Sylvain 2022-04): remove or use these exports
, collectGlobals
, debugShowStat
, packStrings
@@ -300,14 +299,8 @@ renameInternals ln_cfg cfg cs0 rtsDeps stats0a = (cs, stats, meta)
renamed :: State CompactorState ([JStat], JStat)
renamed
- -- \| csDebugAlloc cfg || csProf cfg = do -- FIXME: Jeff (2022,03): Move these Way flags into JSLinkConfig
-
- -- FIXME (Sylvain, 2022-05): forced for now until packStrings creates a
- -- proper string table.
- -- NOTE (Jeff, 2022-06): I've commented out the block of code for the
- -- otherwise case in the below guard. This is to silence warnings about
- -- the redundant pattern match. Once packStrings works make sure to
- -- re-enable and remove this comment and previous fixme
+ -- \| csDebugAlloc cfg || csProf cfg = do
+
| True = do
cs <- get
let renamedStats = map (identsS' (lookupRenamed cs) . lu_js_code) stats0
@@ -332,7 +325,6 @@ renameInternals ln_cfg cfg cs0 rtsDeps stats0a = (cs, stats, meta)
-- sort our entries, store the results
-- propagate all renamings throughtout the code
cs <- get
- -- FIXME: Jeff (2022,03): Is this workaround still needed?
-- Safari on iOS 10 (64 bit only?) crashes on very long arrays
-- safariCrashWorkaround :: [Ident] -> JExpr
-- safariCrashWorkaround xs =
@@ -411,19 +403,10 @@ staticDeclStat (StaticInfo si sv _) =
ssu (StaticUnboxedDouble d) = app "h$p" [toJExpr (unSaneDouble d)]
ssu (StaticUnboxedString str) = ApplExpr (initStr str) []
ssu StaticUnboxedStringOffset {} = 0
- -- FIXME, we shouldn't do h$di, we need to record the statement to init the thunks
in maybe (appS "h$di" [toJExpr si']) (\v -> DeclStat si' `mappend` (toJExpr si' |= v)) (ssv sv)
initStr :: BS.ByteString -> JExpr
initStr str = app "h$str" [ValExpr (JStr . mkFastString . BSC.unpack $! str)]
- --TODO: Jeff (2022,03): This function used to call @decodeModifiedUTF8 in
- --Gen2.Utils. I've removed the call site and opted to keep the Just case.
- --We'll need to double check to see if we indeed do need to decoded the
- --UTF8 strings and implement a replace function on bytestrings once the
- --Linker is up.
- -- Nothing -> app "h$rstr" [toJExpr $ map toInteger (BS.unpack str)]
- -- error "initStr"
- -- [je| h$rstr(`map toInteger (B.unpack str)`) |]
-- | rename a heap object, which means adding it to the
-- static init table in addition to the renamer
@@ -682,7 +665,6 @@ encodeStatic0 cs (StaticInfo _to sv _)
-- encodeArg x = panic ("encodeArg: unexpected: " ++ show x)
-- encodeChar = ord -- fixme make characters more readable
--- FIXME: Jeff (2022,03): Use FastString or ShortByteString and remove this
-- serialization/deserialization
encodeString :: FastString -> [Int]
encodeString = encodeBinary . BSC.pack . unpackFS
@@ -784,7 +766,6 @@ compact ln_cfg cfg cs0 rtsDeps0 input0
let rtsDeps1 = rtsDeps0 ++
map (<> "_e") rtsDeps0 ++
map (<> "_con_e") rtsDeps0
- -- FIXME (Sylvain, 2022-05): disabled (again)
-- (cs1, input1) = packStrings ln_cfg cs0 input0
in renameInternals ln_cfg cfg cs0 rtsDeps1 input0
@@ -1143,7 +1124,6 @@ fixHashes hashes = fmap (second (map replaceHash)) hashes
sccs = map fromSCC $
G.stronglyConnComp (map (\(k, (_bs, deps)) -> (k, LexicalFastString k, deps)) kvs)
kvs = List.sortOn (LexicalFastString . fst) $ nonDetEltsUniqMap hashes -- sort lexically to avoid non-determinism
- -- FIXME: Can we make this more efficient by avoiding lists and staying in GHC Unique collections?
ks = fst $ unzip kvs
invDeps = listToUniqMap_C (++) (concatMap mkInvDeps kvs)
mkInvDeps (k, (_, ds)) = map (\(LexicalFastString d) -> (d,[k])) ds
@@ -1223,8 +1203,6 @@ fixHashesIter n invDeps allKeys checkKeys sccs hashes finalHashes
makeFinalHash :: BS.ByteString -> [BS.ByteString] -> BS.ByteString
makeFinalHash b bs = mconcat (b:bs)
--- FIXME: Jeff (2022,03): I've removed the SHA256.hash function which would be
--- producing this final bytestring. Do we need it? If so how to replace it?
-- do not deduplicate thunks
ignoreStatic :: StaticInfo -> Bool
@@ -1232,7 +1210,6 @@ ignoreStatic (StaticInfo _ StaticThunk {} _) = True
ignoreStatic _ = False
-- combine hashes from x and y, leaving only those which have an entry in both
--- FIXME: Make users of this function consume a UniqMap
combineHashes :: [(FastString, HashBuilder)]
-> [(FastString, HashBuilder)]
-> [(FastString, HashBuilder)]
@@ -1315,13 +1292,6 @@ hashSingleDefinition globals (TxtI i) expr = (i, ht 0 <> render st <> mconcat (m
render = htxt . mkFastString. show . pretty
--- FIXME: Jeff (2022,03): reduce the redundancy between these idents functions
--- and the idents functions in GHC.JS.Transform These helper functions also
--- exist in non-ticked for, e.g., @identsE@ in GHC.JS.Transform. These are
--- essential Functor instances over the JS syntax tree. We rewrite them here for
--- consumers like hashSingleDefinition. Had we used the Transform version we'll
--- end up with a compiler error in @expr'@ since AssignStat takes an Expr, but
--- Transform.IdentsE returns [Ident]
identsE' :: (Ident -> Ident) -> JExpr -> JExpr
identsE' f (ValExpr v) = ValExpr $! identsV' f v
identsE' f (SelExpr e i) = SelExpr (identsE' f e) i -- do not rename properties
@@ -1436,8 +1406,6 @@ hashSaneDouble (SaneDouble sd) = hd sd
finalizeHash :: HashBuilder -> Hash
finalizeHash (HashBuilder hb tt) =
--- FIXME: Jeff (2022,03): I've removed the SHA256.hash function which would be
--- producing h. Do we need it? If so how to replace it?
let h = (BL.toStrict $ BB.toLazyByteString hb)
in h `seq` (h, map LexicalFastString tt)
@@ -1445,8 +1413,5 @@ finalizeHash' :: HashBuilder -> (Int, BS.ByteString, [FastString])
finalizeHash' (HashBuilder hb tt) =
let b = BL.toStrict (BB.toLazyByteString hb)
bl = BS.length b
--- FIXME: Jeff (2022,03): I've removed the SHA256.hash function which would be
--- producing h. So it is purposeful that `h = b` looks unnecessary. Do we need
--- it? If so how to replace it?
h = b
in h `seq` bl `seq` (bl, h, tt)
=====================================
compiler/GHC/StgToJS/Linker/Dynamic.hs
=====================================
@@ -16,36 +16,6 @@
--
-- Various utilities for building and loading dynamic libraries, to make
-- Template Haskell work in GHCJS
---
------------------------------ FIXMEs -------------------------------------------
--- FIXME: Jeff (2022,04): This module may be completely redundant and consist of
--- duplicate code. Before we can remove it we must understand how it alters the
--- link code in the GHC.Linker directory. Thus for the time being we live with
--- it. In particular cases where we have duplicated functions in
--- GHC.Driver.Pipeline and GHC.Linker.Static, I've prefixed these with "js"
--- except for @link@ and @link'@, for example GHC.Linker.Static.linkStaticLib
--- becomes GHC.StgToJS.Linker.Dynamic.jsLinkStaticLib.
---
--- FIXME: Jeff (2022,04): In jsLinkBinary I've commented out a line that
--- dispatches to different systools based on a boolean flag. This line seems to
--- be a relic of the old ghc api but I left it in since it will require
--- attention to be verified correct. I suspect that entire function is made
--- redundant by the corresponding GHC.Linker.Static.linkBinary anyhow. Please
--- see the fixme comment in jsLinkBinary
---
--- FIXME: Jeff (2022,04): You'll notice that the APIs for the linking functions,
--- @link@, @link'@ etc are quite hairy with lots of inputs, and over half of
--- those inputs are environments of some sort including DynFlags. Of course this
--- is insanity. The API is forced due a let expression in
--- @GHC.StgToJS.Linker.Dynamic.link'@ which requires all linking functions to
--- have the same interface as GHC.Linker.Static.linkBinary. To Fix this we
--- should begin removing these environments by refining JSLinkConfig. For
--- example:
--- 1. Move any required flags from StgToJSConfig to JSLinkConfig
--- 2. Remove DynFlags by removing any opts needed for linking and add them to
--- JSLinkConfig
--- 3. Similar for HscEnv, we might need to decouple GHCs Linker from DynFlags in
--- order to have a proper api
-----------------------------------------------------------------------------
module GHC.StgToJS.Linker.Dynamic
=====================================
compiler/GHC/StgToJS/Linker/Shims.hs
=====================================
@@ -165,8 +165,6 @@ tryReadShimFile :: Logger -> TmpFs -> DynFlags -> UnitEnv -> FilePath -> IO Shim
tryReadShimFile logger tmpfs dflags unit_env file = do
if needsCpp file
then do
- -- FIXME (Sylvain 2022-06): we should get profiling from the codegen options
- -- (was GHCJS_PROF CPP define)
let profiling = False
use_cpp_and_not_cc_dash_E = False
extra_opts = []
=====================================
compiler/GHC/StgToJS/Linker/Types.hs
=====================================
@@ -30,15 +30,6 @@
--
-- The base contains a CompactorState for consistent renaming of private names
-- and packed initialization of info tables and static closures.
-
------------------------------ FIXMEs -------------------------------------------
--- - Find a better data structure for linkerArchiveDeps
--- - Specialize Functor instances for helpers
--- - Better name for Base
--- - Remove unsafeShowSDoc
--- - Better implementation for Monoid JSLinkConfig
--- - Should we use (Messages String) or parameterize over (Messages e) in ThRunner?
--- - Fix name collision between LinkableUnit type in this module and the LinkableUnit type in StgToJS.Types
-----------------------------------------------------------------------------
module GHC.StgToJS.Linker.Types where
@@ -94,9 +85,6 @@ renamedVars = map (\(TxtI xs) -> TxtI ("h$$"<>xs)) newLocals
-- CompactorState
--------------------------------------------------------------------------------
--- FIXME: Jeff (2022,03): These maps should be newtyped so we cannot confuse
--- them and thus accidently construct hard to understand bugs. When we newtype
--- we should use deriving via to avoid boilerplate
data CompactorState = CompactorState
{ csIdentSupply :: [Ident] -- ^ ident supply for new names
, csNameMap :: !(UniqMap FastString Ident) -- ^ renaming mapping for internal names
@@ -138,8 +126,6 @@ instance DB.Binary StringTable where
emptyStringTable :: StringTable
emptyStringTable = StringTable (listArray (0,-1) []) M.empty emptyUniqMap
--- FIXME: Jeff: (2022,03): Each of these helper functions carry a Functor f
--- constraint. We should specialize these once we know how they are used
entries :: Functor f
=> (UniqMap FastString Int -> f (UniqMap FastString Int))
-> CompactorState
@@ -298,9 +284,6 @@ addLabel new cs =
-- Base
--------------------------------------------------------------------------------
--- FIXME: Jeff (2022,03): Pick a better name than Base, and should baseUnits be
--- Set UnitId and basePkgs be [PackageId]? I'm unsure if this should hold
--- UnitIds or UnitInfos or PackageIds or PackageNames
-- | The Base bundle. Used for incremental linking it maintains the compactor
-- state the base packages and units.
data Base = Base { baseCompactorState :: CompactorState
@@ -315,8 +298,7 @@ instance DB.Binary Base where
showBase :: Base -> String
showBase b = unlines
[ "Base:"
- , " packages: " ++ showSDocUnsafe (ppr (basePkgs b)) -- FIXME: Jeff (2022,03): Either use the sdoc context in the StgToJS
- -- config or find a better way than showSDocUnsafe
+ , " packages: " ++ showSDocUnsafe (ppr (basePkgs b))
, " number of units: " ++ show (S.size $ baseUnits b)
, " renaming table size: " ++
show (sizeUniqMap . csNameMap . baseCompactorState $ b)
@@ -338,7 +320,7 @@ putBase (Base cs packages funs) = do
pi :: Int -> DB.Put
pi = DB.putWord32le . fromIntegral
uniq :: Ord a => [a] -> [a]
- uniq = S.toList . S.fromList -- FIXME: Ick! Just use the Set in the first place!
+ uniq = S.toList . S.fromList
-- pkgs = uniq (map fst $ S.toList funs)
-- pkgsM = M.fromList (zip pkgs [(0::Int)..])
mods = uniq (map fst $ S.toList funs)
@@ -477,16 +459,7 @@ generateAllJs s
| NoBase <- lcUseBase s = not (lcOnlyOut s) && not (lcNoRts s)
| otherwise = False
-{-
- -- FIXME: Jeff (2022,03): This instance is supposed to capture overriding
- -- settings, where one group comes from the environment (env vars, config
- -- files) and the other from the command line. (env `mappend` cmdLine) should
- -- give the combined settings, but it doesn't work very well. find something
- -- better.
- -}
instance Monoid JSLinkConfig where
- -- FIXME: Jeff (2022,03): Adding no hs main to config, should False be default
- -- here?
mempty = JSLinkConfig False False False False False
Nothing Nothing Nothing False
False False Nothing NoBase
@@ -515,12 +488,9 @@ instance Semigroup JSLinkConfig where
--------------------------------------------------------------------------------
-- Linker Environment
--- TODO: Jeff: (2022,03): Move to separate module, same as Config?
--------------------------------------------------------------------------------
-- | A LinkableUnit is a pair of a module and the index of the block in the
-- object file
--- FIXME: Jeff: (2022,03): Refactor to avoid name collision between
--- StgToJS.Linker.Types.LinkableUnit and StgToJS.Types.LinkableUnit
type LinkableUnit = (Module, Int)
data LinkedUnit = LinkedUnit
@@ -529,7 +499,6 @@ data LinkedUnit = LinkedUnit
, lu_statics :: ![StaticInfo]
}
--- TODO: Jeff: (2022,03): Where to move LinkedObj
-- | An object file that's either already in memory (with name) or on disk
data LinkedObj = ObjFile FilePath -- ^ load from this file
| ObjLoaded String BL.ByteString -- ^ already loaded: description and payload
@@ -537,16 +506,8 @@ data LinkedObj = ObjFile FilePath -- ^ load from this file
data GhcjsEnv = GhcjsEnv
{ compiledModules :: MVar (Map Module ByteString) -- ^ keep track of already compiled modules so we don't compile twice for dynamic-too
- , thRunners :: MVar THRunnerState -- (Map String ThRunner) -- ^ template haskell runners
+ , thRunners :: MVar THRunnerState -- ^ template haskell runners
, thSplice :: MVar Int
- -- FIXME: Jeff a Map keyed on a Set is going to be quite costly. The Eq
- -- instance over Sets _can_ be fast if the sets are different sizes, this
- -- would be O(1), however if they are equal size then we incur a costly
- -- converstion to an Ascending List O(n) and then perform the element wise
- -- check hence O(mn) where m is the cost of the element check. Thus, we should
- -- fix this data structure and use something more efficient, HashMap if
- -- available, IntMap if possible. Nested maps, in particular, seem like a
- -- design smell.
, linkerArchiveDeps :: MVar (Map (Set FilePath)
(Map Module (Deps, DepsLocation)
, [LinkableUnit]
@@ -572,9 +533,6 @@ data THRunner =
, thrHandleIn :: Handle
, thrHandleErr :: Handle
, thrBase :: MVar Base
- -- FIXME: Jeff (2022,03): Is String the right type here? I chose it
- -- because it was easy but I am unsure what the needs of its consumer
- -- are.
, thrRecover :: MVar [Messages String]
, thrExceptions :: MVar (I.IntMap E.SomeException)
}
=====================================
compiler/GHC/StgToJS/Linker/Utils.hs
=====================================
@@ -13,9 +13,6 @@
--
-- Various utilies used in the JS Linker
--
------------------------------ FIXMEs -------------------------------------------
--- - resolve macOS comment in @writeBinaryFile@
--- - remove redundant function @jsExeFileName@
-----------------------------------------------------------------------------
module GHC.StgToJS.Linker.Utils where
@@ -39,14 +36,6 @@ import Prelude
import GHC.Platform
import Data.List (isPrefixOf)
-{-
- macOS has trouble writing more than 2GiB at once to a file
- (tested with 10.14.6), and the base library doesn't work around this
- problem yet (tested with GHC 8.6), so we work around it here.
-
- in this workaround we write a binary file in chunks of 1 GiB
- FIXME: Jeff (2022,03): Is this still true?
- -}
writeBinaryFile :: FilePath -> ByteString -> IO ()
writeBinaryFile file bs =
withBinaryFile file WriteMode $ \h -> mapM_ (B.hPut h) (chunks bs)
@@ -80,9 +69,6 @@ commonCppDefs_vanilla, commonCppDefs_profiled :: ByteString
commonCppDefs_vanilla = genCommonCppDefs False
commonCppDefs_profiled = genCommonCppDefs True
--- FIXME (Sylvain 2022-06): many of these strings should be derived from
--- wired-in names and using the JS dsl (e.g. for field names of JS heap
--- objects).
genCommonCppDefs :: Bool -> ByteString
genCommonCppDefs profiling = mconcat
[
@@ -149,8 +135,6 @@ genCommonCppDefs profiling = mconcat
else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n"
-- GHC.Integer.GMP.Internals
- -- FIXME (Sylvain 2022-06): this is wrong since ghc-bignum. integer-wired-in
- -- is ghc-bignum now
, "#define IS_INTEGER_S(cl) ((cl).f === h$integerzmwiredzminZCGHCziIntegerziTypeziSzh_con_e)\n"
, "#define IS_INTEGER_Jp(cl) ((cl).f === h$integerzmwiredzminZCGHCziIntegerziTypeziJpzh_con_e)\n"
, "#define IS_INTEGER_Jn(cl) ((cl).f === h$integerzmwiredzminZCGHCziIntegerziTypeziJnzh_con_e)\n"
@@ -173,7 +157,7 @@ genCommonCppDefs profiling = mconcat
, "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n"
, "#define IS_JUST(cl) ((cl).f === h$baseZCGHCziMaybeziJust_con_e)\n"
, "#define JUST_VAL(jj) ((jj).d1)\n"
- -- "#define HS_NOTHING h$nothing\n" -- FIXME (Sylvain 2022-06): just remove?
+ -- "#define HS_NOTHING h$nothing\n"
, if profiling
then "#define MK_JUST(val) (h$c1(h$baseZCGHCziMaybeziJust_con_e, (val), h$CCS_SYSTEM))\n"
else "#define MK_JUST(val) (h$c1(h$baseZCGHCziMaybeziJust_con_e, (val)))\n"
@@ -262,7 +246,7 @@ genCommonCppDefs profiling = mconcat
]
-- unboxed tuple returns
- -- , "#define RETURN_UBX_TUP1(x) return x;\n" FIXME (Sylvain 2022-06): remove?
+ -- , "#define RETURN_UBX_TUP1(x) return x;\n"
, "#define RETURN_UBX_TUP2(x1,x2) { h$ret1 = (x2); return (x1); }\n"
, "#define RETURN_UBX_TUP3(x1,x2,x3) { h$ret1 = (x2); h$ret2 = (x3); return (x1); }\n"
, "#define RETURN_UBX_TUP4(x1,x2,x3,x4) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); return (x1); }\n"
@@ -284,15 +268,12 @@ 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"
]
--- FIXME: Jeff (2022,04): remove this function since it is a duplicate of
--- GHC.Linker.Static.Utils.exeFileName
jsExeFileName :: DynFlags -> FilePath
jsExeFileName dflags
| Just s <- outputFile_ dflags =
-- unmunge the extension
let s' = dropPrefix "js_" (drop 1 $ takeExtension s)
- -- FIXME: add this check when support for Windows check is added
- in if Prelude.null s' -- \|\| (Platform.isWindows && map toLower s' == "exe")
+ in if Prelude.null s'
then dropExtension s <.> jsexeExtension
else dropExtension s <.> s'
| otherwise =
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c44a5a58e7d1f4610a861f6ff18d5206acc1788
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c44a5a58e7d1f4610a861f6ff18d5206acc1788
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/20220825/b9340ac0/attachment-0001.html>
More information about the ghc-commits
mailing list