diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index adc729f31edd48e2167bfbb66e295098f69360c4..a612a395d263ae1aa31386e387448bdf58607d10 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -33,6 +33,7 @@ module GHC.Linker.Loader
    , modifyLoaderState
    , initLinkDepsOpts
    , partitionLinkable
+   , getGccSearchDirectory
    )
 where
 
@@ -1491,12 +1492,11 @@ searchForLibUsingGcc logger dflags so dirs = do
 --   libraries and components. See Note [Fork/Exec Windows].
 getGCCPaths :: Logger -> DynFlags -> OS -> IO [FilePath]
 getGCCPaths logger dflags os
-  = case os of
-      OSMinGW32 ->
+  | os == OSMinGW32 || platformArch (targetPlatform dflags) == ArchWasm32 =
         do gcc_dirs <- getGccSearchDirectory logger dflags "libraries"
            sys_dirs <- getSystemDirectories
            return $ nub $ gcc_dirs ++ sys_dirs
-      _         -> return []
+  | otherwise = return []
 
 -- | Cache for the GCC search directories as this can't easily change
 --   during an invocation of GHC. (Maybe with some env. variable but we'll)
@@ -1529,7 +1529,7 @@ getGccSearchDirectory logger dflags key = do
                   modifyIORef' gccSearchDirCache ((key, dirs):)
                   return val
       where split :: FilePath -> [FilePath]
-            split r = case break (==';') r of
+            split r = case break (`elem` [';', ':']) r of
                         (s, []    ) -> [s]
                         (s, (_:xs)) -> s : split xs