[Git][ghc/ghc][wip/js-staging] base: GHCJS.Prim directory --> GHC.JS.Prim
doyougnu (@doyougnu)
gitlab at gitlab.haskell.org
Mon Aug 15 18:24:39 UTC 2022
doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
fe37fe71 by doyougnu at 2022-08-15T14:20:09-04:00
base: GHCJS.Prim directory --> GHC.JS.Prim
- - - - -
6 changed files:
- compiler/GHC/StgToJS/Linker/Linker.hs
- libraries/base/GHCJS/Prim.hs → libraries/base/GHC/JS/Prim.hs
- libraries/base/GHCJS/Prim/Internal.hs → libraries/base/GHC/JS/Prim/Internal.hs
- libraries/base/GHCJS/Prim/Internal/Build.hs → libraries/base/GHC/JS/Prim/Internal/Build.hs
- libraries/base/base.cabal
- libraries/unix
Changes:
=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -707,7 +707,6 @@ readArObject ar_state mod ar_file = do
++ " in "
++ ar_file)
(BL.fromStrict . Ar.filedata) (find matchTag entries)
- -- mapM_ (\e -> putStrLn ("found file: " ++ Ar.filename e)) entries
{- | Static dependencies are symbols that need to be linked regardless
of whether the linked program refers to them. For example
@@ -721,29 +720,6 @@ newtype StaticDeps =
noStaticDeps :: StaticDeps
noStaticDeps = StaticDeps []
-{- | The input file format for static deps is a yaml document with a
- package/module/symbol tree where symbols can be either a list or
- just a single string, for example:
-
- base:
- GHC.Conc.Sync: reportError
- Control.Exception.Base: nonTermination
- ghcjs-prim:
- GHCJS.Prim:
- - JSVal
- - JSException
- -}
--- instance FromJSON StaticDeps where
--- parseJSON (Object v) = StaticDeps . concat <$> mapM (uncurry parseMod) (HM.toList v)
--- where
--- parseMod p (Object v) = concat <$> mapM (uncurry (parseSymb p)) (HM.toList v)
--- parseMod _ _ = mempty
--- parseSymb p m (String s) = pure [(p,m,s)]
--- parseSymb p m (Array v) = mapM (parseSingleSymb p m) (V.toList v)
--- parseSymb _ _ _ = mempty
--- parseSingleSymb p m (String s) = pure (p,m,s)
--- parseSingleSymb _ _ _ = mempty
--- parseJSON _ = mempty
-- | dependencies for the RTS, these need to be always linked
rtsDeps :: [UnitId] -> IO ([UnitId], Set ExportedFun)
@@ -782,7 +758,7 @@ readSystemDeps' file
-- wired-in just like in GHC and thus we should make them top level
-- definitions
| file == "thdeps.yaml" = pure ( [ baseUnitId ]
- , S.fromList $ d baseUnitId "GHCJS.Prim.TH.Eval" ["runTHServer"])
+ , S.fromList $ d baseUnitId "GHC.JS.Prim.TH.Eval" ["runTHServer"])
| file == "rtsdeps.yaml" = pure ( [ baseUnitId
, primUnitId
, bignumUnitId
@@ -800,8 +776,8 @@ readSystemDeps' file
-- FIXME Sylvain (2022,05): no longer valid
-- integer constructors
-- , d bignumUnitId "GHC.Integer.Type" ["S#", "Jp#", "Jn#"]
- , d baseUnitId "GHCJS.Prim" ["JSVal", "JSException", "$fShowJSException", "$fExceptionJSException", "resolve", "resolveIO", "toIO"]
- , d baseUnitId "GHCJS.Prim.Internal" ["wouldBlock", "blockedIndefinitelyOnMVar", "blockedIndefinitelyOnSTM", "ignoreException", "setCurrentThreadResultException", "setCurrentThreadResultValue"]
+ , d baseUnitId "GHC.JS.Prim" ["JSVal", "JSException", "$fShowJSException", "$fExceptionJSException", "resolve", "resolveIO", "toIO"]
+ , d baseUnitId "GHC.JS.Prim.Internal" ["wouldBlock", "blockedIndefinitelyOnMVar", "blockedIndefinitelyOnSTM", "ignoreException", "setCurrentThreadResultException", "setCurrentThreadResultValue"]
]
)
| otherwise = pure (mempty, mempty)
=====================================
libraries/base/GHCJS/Prim.hs → libraries/base/GHC/JS/Prim.hs
=====================================
@@ -5,9 +5,9 @@
UnboxedTuples
#-}
-module GHCJS.Prim ( JSVal(..), JSVal#
- , JSException(..)
- , WouldBlockException(..)
+module GHC.JS.Prim ( JSVal(..), JSVal#
+ , JSException(..)
+ , WouldBlockException(..)
#ifdef js_HOST_ARCH
, toIO
, resolve
@@ -112,9 +112,9 @@ toJSString :: String -> JSVal
toJSString = js_toJSString . unsafeCoerce . seqList
{-# INLINE [0] toJSString #-}
{-# RULES
-"GHCJSPRIM toJSString/literal" forall a.
+"GHC.JS.PRIM toJSString/literal" forall a.
toJSString (GHC.unpackCString# a) = JSVal (unsafeUnpackJSStringUtf8## a)
-"GHCJSPRIM toJSString/literalUtf8" forall a.
+"GHC.JS.PRIM toJSString/literalUtf8" forall a.
toJSString (GHC.unpackCStringUtf8# a) = JSVal (unsafeUnpackJSStringUtf8## a)
#-}
@@ -152,9 +152,9 @@ getProp :: JSVal -> String -> IO JSVal
getProp o p = js_getProp o (unsafeCoerce $ seqList p)
{-# INLINE [0] getProp #-}
{-# RULES
-"GHCJSPRIM getProp/literal" forall o a.
+"GHC.JS.PRIM getProp/literal" forall o a.
getProp o (GHC.unpackCString# a) = getProp# o a
-"GHCJSPRIM getProp/literalUtf8" forall o a.
+"GHC.JS.PRIM getProp/literalUtf8" forall o a.
getProp o (GHC.unpackCStringUtf8# a) = getPropUtf8# o a
#-}
@@ -163,9 +163,9 @@ unsafeGetProp :: JSVal -> String -> JSVal
unsafeGetProp o p = js_unsafeGetProp o (unsafeCoerce $ seqList p)
{-# INLINE [0] unsafeGetProp #-}
{-# RULES
-"GHCJSPRIM unsafeGetProp/literal" forall o a.
+"GHC.JS.PRIM unsafeGetProp/literal" forall o a.
unsafeGetProp o (GHC.unpackCString# a) = unsafeGetProp# o a
-"GHCJSPRIM unsafeGetProp/literalUtf8" forall o a.
+"GHC.JS.PRIM unsafeGetProp/literalUtf8" forall o a.
unsafeGetProp o (GHC.unpackCStringUtf8# a) = unsafeGetPropUtf8# o a
#-}
@@ -173,9 +173,9 @@ getProp' :: JSVal -> JSVal -> IO JSVal
getProp' o p = js_getProp' o p
{-# INLINE [0] getProp' #-}
{-# RULES
-"GHCJSPRIM getProp'/literal" forall o a.
+"GHC.JS.PRIM getProp'/literal" forall o a.
getProp' o (unsafeUnpackJSString# a) = getProp# o a
-"GHCJSPRIM getProp'/literalUtf8" forall o a.
+"GHC.JS.PRIM getProp'/literalUtf8" forall o a.
getProp' o (unsafeUnpackJSStringUtf8# a) = getPropUtf8# o a
#-}
@@ -184,9 +184,9 @@ unsafeGetProp' :: JSVal -> JSVal -> JSVal
unsafeGetProp' o p = js_unsafeGetProp' o p
{-# INLINE [0] unsafeGetProp' #-}
{-# RULES
-"GHCJSPRIM unsafeGetProp'/literal" forall o a.
+"GHC.JS.PRIM unsafeGetProp'/literal" forall o a.
unsafeGetProp' o (unsafeUnpackJSString# a) = unsafeGetPropUtf8# o a
-"GHCJSPRIM unsafeGetProp'/literalUtf8" forall o a.
+"GHC.JS.PRIM unsafeGetProp'/literalUtf8" forall o a.
unsafeGetProp' o (unsafeUnpackJSStringUtf8# a) = unsafeGetPropUtf8# o a
#-}
=====================================
libraries/base/GHCJS/Prim/Internal.hs → libraries/base/GHC/JS/Prim/Internal.hs
=====================================
@@ -2,17 +2,17 @@
-}
-module GHCJS.Prim.Internal ( blockedIndefinitelyOnMVar
- , blockedIndefinitelyOnSTM
- , wouldBlock
- , ignoreException
- , setCurrentThreadResultException
- , setCurrentThreadResultValue
- ) where
+module GHC.JS.Prim.Internal ( blockedIndefinitelyOnMVar
+ , blockedIndefinitelyOnSTM
+ , wouldBlock
+ , ignoreException
+ , setCurrentThreadResultException
+ , setCurrentThreadResultValue
+ ) where
import Control.Exception
-import GHCJS.Prim
+import GHC.JS.Prim
wouldBlock :: SomeException
wouldBlock = toException WouldBlockException
=====================================
libraries/base/GHCJS/Prim/Internal/Build.hs → libraries/base/GHC/JS/Prim/Internal/Build.hs
=====================================
@@ -2,10 +2,10 @@
-- no Template Haskell available yet, generated by utils/genBuildObject.hs
{-# LANGUAGE CPP #-}
#ifndef js_HOST_ARCH
-module GHCJS.Prim.Internal.Build () where
+module GHC.JS.Prim.Internal.Build () where
#else
{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, GHCForeignImportPrim #-}
-module GHCJS.Prim.Internal.Build
+module GHC.JS.Prim.Internal.Build
( buildArrayI
, buildArrayM
, buildObjectI
@@ -140,7 +140,7 @@ module GHCJS.Prim.Internal.Build
, buildObjectM32
) where
-import GHCJS.Prim
+import GHC.JS.Prim
import GHC.Exts
import Unsafe.Coerce
import System.IO.Unsafe
=====================================
libraries/base/base.cabal
=====================================
@@ -461,10 +461,9 @@ Library
if arch(js)
exposed-modules:
- -- FIXME: Luite (2022,05): remove GHCJS name
- GHCJS.Prim
- GHCJS.Prim.Internal
- GHCJS.Prim.Internal.Build
+ GHC.JS.Prim
+ GHC.JS.Prim.Internal
+ GHC.JS.Prim.Internal.Build
-- We need to set the unit id to base (without a version number)
-- as it's magic.
=====================================
libraries/unix
=====================================
@@ -1 +1 @@
-Subproject commit 23edd4537e9051824a5683b324e6fb8abed5d6b3
+Subproject commit f018fe126c5f1dbbd3431c7214337ccbb38230ce
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe37fe7113b42e305bb18703686c07887c1321f9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe37fe7113b42e305bb18703686c07887c1321f9
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/20220815/3a034352/attachment-0001.html>
More information about the ghc-commits
mailing list