{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
module GHC.StgToJS.Linker.Utils
( jsExeFileName
, getInstalledPackageLibDirs
, getInstalledPackageHsLibs
, commonCppDefs
, decodeModifiedUTF8
)
where
import System.FilePath
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import Data.ByteString (ByteString)
import GHC.Driver.Session
import GHC.Data.ShortText
import GHC.Unit.State
import GHC.Unit.Types
import GHC.StgToJS.Types
import Prelude
import GHC.Platform
import Data.List (isPrefixOf)
import GHC.Builtin.Types
import Language.Haskell.Syntax.Basic
import GHC.Types.Name
import GHC.StgToJS.Ids
import GHC.JS.Ident
import GHC.Core.DataCon
import GHC.Data.FastString
getInstalledPackageLibDirs :: UnitState -> UnitId -> [ShortText]
getInstalledPackageLibDirs :: UnitState -> UnitId -> [ShortText]
getInstalledPackageLibDirs UnitState
us = [ShortText]
-> (GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId))
-> [ShortText])
-> Maybe
(GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId)))
-> [ShortText]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ShortText]
forall a. Monoid a => a
mempty GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId))
-> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs (Maybe
(GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId)))
-> [ShortText])
-> (UnitId
-> Maybe
(GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId))))
-> UnitId
-> [ShortText]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitState
-> UnitId
-> Maybe
(GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId)))
lookupUnitId UnitState
us
getInstalledPackageHsLibs :: UnitState -> UnitId -> [ShortText]
getInstalledPackageHsLibs :: UnitState -> UnitId -> [ShortText]
getInstalledPackageHsLibs UnitState
us = [ShortText]
-> (GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId))
-> [ShortText])
-> Maybe
(GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId)))
-> [ShortText]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ShortText]
forall a. Monoid a => a
mempty GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId))
-> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraries (Maybe
(GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId)))
-> [ShortText])
-> (UnitId
-> Maybe
(GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId))))
-> UnitId
-> [ShortText]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitState
-> UnitId
-> Maybe
(GenericUnitInfo
PackageId
PackageName
UnitId
ModuleName
(GenModule (GenUnit UnitId)))
lookupUnitId UnitState
us
jsexeExtension :: String
jsexeExtension :: [Char]
jsexeExtension = [Char]
"jsexe"
commonCppDefs :: Bool -> ByteString
commonCppDefs :: Bool -> ByteString
commonCppDefs Bool
profiling = case Bool
profiling of
Bool
True -> ByteString
commonCppDefs_profiled
Bool
False -> ByteString
commonCppDefs_vanilla
commonCppDefs_vanilla, commonCppDefs_profiled :: ByteString
commonCppDefs_vanilla :: ByteString
commonCppDefs_vanilla = Bool -> ByteString
genCommonCppDefs Bool
False
commonCppDefs_profiled :: ByteString
commonCppDefs_profiled = Bool -> ByteString
genCommonCppDefs Bool
True
genMkTup :: Bool -> Int -> ByteString
genMkTup :: Bool -> Int -> ByteString
genMkTup Bool
profiling Int
n = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"#define MK_TUP", ByteString
sn
, ByteString
"(", ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," [ByteString]
xs, ByteString
")"
, ByteString
"(h$c", ByteString
sn, ByteString
"("
, FastString -> ByteString
bytesFS FastString
symbol, ByteString
","
, ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
x -> ByteString
"(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")") [ByteString]
xs
, if Bool
profiling then ByteString
",h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM" else ByteString
""
, ByteString
"))\n"
]
where
xs :: [ByteString]
xs = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
n ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (Int -> ByteString) -> [Int] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
"x" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (Int -> ByteString) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
Char8.pack ([Char] -> ByteString) -> (Int -> [Char]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) ([Int
1..] :: [Int])
sn :: ByteString
sn = [Char] -> ByteString
Char8.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
symbol :: FastString
symbol = Ident -> FastString
identFS (Ident -> FastString) -> Ident -> FastString
forall a b. (a -> b) -> a -> b
$ Id -> Maybe Int -> IdType -> GenModule (GenUnit UnitId) -> Ident
makeIdentForId (DataCon -> Id
dataConWorkId (DataCon -> Id) -> DataCon -> Id
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> DataCon
tupleDataCon Boxity
Boxed Int
n) Maybe Int
forall a. Maybe a
Nothing IdType
IdConEntry GenModule (GenUnit UnitId)
mod
name :: Name
name = Boxity -> Int -> Name
tupleDataConName Boxity
Boxed Int
n
mod :: GenModule (GenUnit UnitId)
mod = case Name -> Maybe (GenModule (GenUnit UnitId))
nameModule_maybe Name
name of
Just GenModule (GenUnit UnitId)
m -> GenModule (GenUnit UnitId)
m
Maybe (GenModule (GenUnit UnitId))
Nothing -> [Char] -> GenModule (GenUnit UnitId)
forall a. HasCallStack => [Char] -> a
error [Char]
"Tuple constructor is missing a module"
genCommonCppDefs :: Bool -> ByteString
genCommonCppDefs :: Bool -> ByteString
genCommonCppDefs Bool
profiling = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[
let mk_int_def :: [Char] -> a -> ByteString
mk_int_def [Char]
n a
v = ByteString
"#define " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
Char8.pack [Char]
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" (" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
Char8.pack (a -> [Char]
forall a. Show a => a -> [Char]
show a
v) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")\n"
mk_closure_def :: ClosureType -> ByteString
mk_closure_def ClosureType
t = [Char] -> Int -> ByteString
forall {a}. Show a => [Char] -> a -> ByteString
mk_int_def (ClosureType -> [Char]
ctJsName ClosureType
t) (ClosureType -> Int
ctNum ClosureType
t)
closure_defs :: [ByteString]
closure_defs = (ClosureType -> ByteString) -> [ClosureType] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ClosureType -> ByteString
mk_closure_def [ClosureType
forall a. Bounded a => a
minBound..ClosureType
forall a. Bounded a => a
maxBound]
mk_thread_def :: ThreadStatus -> ByteString
mk_thread_def ThreadStatus
t = [Char] -> Int -> ByteString
forall {a}. Show a => [Char] -> a -> ByteString
mk_int_def (ThreadStatus -> [Char]
threadStatusJsName ThreadStatus
t) (ThreadStatus -> Int
threadStatusNum ThreadStatus
t)
thread_defs :: [ByteString]
thread_defs = (ThreadStatus -> ByteString) -> [ThreadStatus] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ThreadStatus -> ByteString
mk_thread_def [ThreadStatus
forall a. Bounded a => a
minBound..ThreadStatus
forall a. Bounded a => a
maxBound]
in [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString]
closure_defs [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
thread_defs)
, [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ((Int -> ByteString) -> [Int] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Int -> ByteString
genMkTup Bool
profiling) [Int
2..Int
10])
, ByteString
"#define TUP2_1(x) ((x).d1)\n"
, ByteString
"#define TUP2_2(x) ((x).d2)\n"
, if Bool
profiling
then ByteString
"#define MK_JSVAL(x) (h$c1(h$ghczminternalZCGHCziInternalziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n"
else ByteString
"#define MK_JSVAL(x) (h$c1(h$ghczminternalZCGHCziInternalziJSziPrimziJSVal_con_e, (x)))\n"
, ByteString
"#define JSVAL_VAL(x) ((x).d1)\n"
, if Bool
profiling
then ByteString
"#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$ghczminternalZCGHCziInternalziJSziPrimziJSException_con_e,(msg),(hsMsg),h$CCS_SYSTEM))\n"
else ByteString
"#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$ghczminternalZCGHCziInternalziJSziPrimziJSException_con_e,(msg),(hsMsg)))\n"
, ByteString
"#define HS_JSEXCEPTION_EXCEPTION h$ghczminternalZCGHCziInternalziJSziPrimzizdfExceptionJSException\n"
, if Bool
profiling
then ByteString
"#define MK_SOMEEXCEPTION(dict,except) (h$c2(h$ghczminternalZCGHCziInternalziExceptionziTypeziSomeException_con_e,(dict),(except),h$CCS_SYSTEM))\n"
else ByteString
"#define MK_SOMEEXCEPTION(dict,except) (h$c2(h$ghczminternalZCGHCziInternalziExceptionziTypeziSomeException_con_e,(dict),(except)))\n"
, if Bool
profiling
then ByteString
"#define MK_PTR(val,offset) (h$c2(h$ghczminternalZCGHCziInternalziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n"
else ByteString
"#define MK_PTR(val,offset) (h$c2(h$ghczminternalZCGHCziInternalziPtrziPtr_con_e, (val), (offset)))\n"
, ByteString
"#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n"
, ByteString
"#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null); var ro = (a).dv.getInt32(o,true);\n"
, ByteString
"#define HS_NOTHING h$ghczminternalZCGHCziInternalziMaybeziNothing\n"
, ByteString
"#define IS_NOTHING(cl) ((cl).f === h$ghczminternalZCGHCziInternalziMaybeziNothing_con_e)\n"
, ByteString
"#define IS_JUST(cl) ((cl).f === h$ghczminternalZCGHCziInternalziMaybeziJust_con_e)\n"
, ByteString
"#define JUST_VAL(jj) ((jj).d1)\n"
, if Bool
profiling
then ByteString
"#define MK_JUST(val) (h$c1(h$ghczminternalZCGHCziInternalziMaybeziJust_con_e, (val), h$CCS_SYSTEM))\n"
else ByteString
"#define MK_JUST(val) (h$c1(h$ghczminternalZCGHCziInternalziMaybeziJust_con_e, (val)))\n"
, ByteString
"#define HS_NIL h$ghczmprimZCGHCziTypesziZMZN\n"
, ByteString
"#define HS_NIL_CON h$ghczmprimZCGHCziTypesziZMZN_con_e\n"
, ByteString
"#define IS_CONS(cl) ((cl).f === h$ghczmprimZCGHCziTypesziZC_con_e)\n"
, ByteString
"#define IS_NIL(cl) ((cl).f === h$ghczmprimZCGHCziTypesziZMZN_con_e)\n"
, ByteString
"#define CONS_HEAD(cl) ((cl).d1)\n"
, ByteString
"#define CONS_TAIL(cl) ((cl).d2)\n"
, if Bool
profiling
then [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"#define MK_CONS(head,tail) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_CONS_CC(head,tail,cc) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail), (cc)))\n"
]
else [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"#define MK_CONS(head,tail) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail)))\n"
, ByteString
"#define MK_CONS_CC(head,tail,cc) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail)))\n"
]
, ByteString
"#define DATA_TEXT_ARRAY(x) ((x).d1)\n"
, ByteString
"#define DATA_TEXT_OFFSET(x) ((x).d2.d1)\n"
, ByteString
"#define DATA_TEXT_LENGTH(x) ((x).d2.d2)\n"
, ByteString
"#define LAZY_TEXT_IS_CHUNK(x) ((x).f.a === 2)\n"
, ByteString
"#define LAZY_TEXT_IS_NIL(x) ((x).f.a === 1)\n"
, ByteString
"#define LAZY_TEXT_CHUNK_HEAD(x) ((x))\n"
, ByteString
"#define LAZY_TEXT_CHUNK_TAIL(x) ((x).d2.d3)\n"
, ByteString
"#define IS_BLACKHOLE(x) (typeof (x) === 'object' && (x) && (x).f && (x).f.t === CLOSURE_TYPE_BLACKHOLE)\n"
, ByteString
"#define BLACKHOLE_TID(bh) ((bh).d1)\n"
, ByteString
"#define SET_BLACKHOLE_TID(bh,tid) ((bh).d1 = (tid))\n"
, ByteString
"#define BLACKHOLE_QUEUE(bh) ((bh).d2)\n"
, ByteString
"#define SET_BLACKHOLE_QUEUE(bh,val) ((bh).d2 = (val))\n"
, ByteString
"#define MAKE_RESUMABLE(closure,stack) { (closure).f = h$resume_e; (closure).d1 = (stack), (closure).d2 = null; }\n"
, ByteString
"#define MK_UPD_THUNK(closure) h$c1(h$upd_thunk_e,(closure))\n"
, ByteString
"#define IS_THUNK(x) ((x).f.t === CLOSURE_TYPE_THUNK)\n"
, ByteString
"#define CONSTR_TAG(x) ((x).f.a)\n"
, ByteString
"#define IS_WRAPPED_NUMBER(val) ((typeof(val)==='object')&&(val).f === h$unbox_e)\n"
, ByteString
"#define UNWRAP_NUMBER(val) ((typeof(val) === 'number')?(val):(val).d1)\n"
, if Bool
profiling
then [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"#define MK_LAZY(fun) (h$c1(h$lazy_e, (fun), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_LAZY_CC(fun,cc) (h$c1(h$lazy_e, (fun), (cc)))\n"
]
else [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"#define MK_LAZY(fun) (h$c1(h$lazy_e, (fun)))\n"
, ByteString
"#define MK_LAZY_CC(fun,cc) (h$c1(h$lazy_e, (fun)))\n"
]
, if Bool
profiling
then [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"#define MK_DATA1_1(val) (h$c1(h$data1_e, (val), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_DATA1_2(val1,val2) (h$c2(h$data1_e, (val1), (val2), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_DATA2_1(val) (h$c1(h$data2_e, (val), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_DATA2_2(val1,val2) (h$c2(h$data1_e, (val1), (val2), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_SELECT1(val) (h$c1(h$select1_e, (val), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_SELECT2(val) (h$c1(h$select2_e, (val), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_AP1(fun,val) (h$c2(h$ap1_e, (fun), (val), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_AP2(fun,val1,val2) (h$c3(h$ap2_e, (fun), (val1), (val2), h$CCS_SYSTEM))\n"
, ByteString
"#define MK_AP3(fun,val1,val2,val3) (h$c4(h$ap3_e, (fun), (val1), (val2), (val3), h$CCS_SYSTEM))\n"
]
else [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"#define MK_DATA1_1(val) (h$c1(h$data1_e, (val)))\n"
, ByteString
"#define MK_DATA1_2(val1,val2) (h$c2(h$data1_e, (val1), (val2)))\n"
, ByteString
"#define MK_DATA2_1(val) (h$c1(h$data2_e, (val)))\n"
, ByteString
"#define MK_DATA2_2(val1,val2) (h$c2(h$data2_e, (val1), (val2)))\n"
, ByteString
"#define MK_SELECT1(val) (h$c1(h$select1_e, (val)))\n"
, ByteString
"#define MK_SELECT2(val) (h$c1(h$select2_e, (val)))\n"
, ByteString
"#define MK_AP1(fun,val) (h$c2(h$ap1_e,(fun),(val)))\n"
, ByteString
"#define MK_AP2(fun,val1,val2) (h$c3(h$ap2_e,(fun),(val1),(val2)))\n"
, ByteString
"#define MK_AP3(fun,val1,val2,val3) (h$c4(h$ap3_e, (fun), (val1), (val2), (val3)))\n"
]
, ByteString
"#define RETURN_UBX_TUP2(x1,x2) { h$ret1 = (x2); return (x1); }\n"
, ByteString
"#define RETURN_UBX_TUP3(x1,x2,x3) { h$ret1 = (x2); h$ret2 = (x3); return (x1); }\n"
, ByteString
"#define RETURN_UBX_TUP4(x1,x2,x3,x4) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); return (x1); }\n"
, ByteString
"#define RETURN_UBX_TUP5(x1,x2,x3,x4,x5) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); return (x1); }\n"
, ByteString
"#define RETURN_UBX_TUP6(x1,x2,x3,x4,x5,x6) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); return (x1); }\n"
, ByteString
"#define RETURN_UBX_TUP7(x1,x2,x3,x4,x5,x6,x7) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); h$ret6 = (x7); return (x1); }\n"
, ByteString
"#define RETURN_UBX_TUP8(x1,x2,x3,x4,x5,x6,x7,x8) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); h$ret6 = (x7); h$ret7 = (x8); return (x1); }\n"
, ByteString
"#define RETURN_UBX_TUP9(x1,x2,x3,x4,x5,x6,x7,x8,x9) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); h$ret6 = (x7); h$ret7 = (x8); h$ret8 = (x9); return (x1); }\n"
, ByteString
"#define RETURN_UBX_TUP10(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); h$ret6 = (x7); h$ret7 = (x8); h$ret8 = (x9); h$ret9 = (x10); return (x1); }\n"
, ByteString
"#define RETURN_INT64(h,l) RETURN_UBX_TUP2((h)|0,(l)>>>0)\n"
, ByteString
"#define RETURN_WORD64(h,l) RETURN_UBX_TUP2((h)>>>0,(l)>>>0)\n"
, ByteString
"#define RETURN_ADDR(a,o) RETURN_UBX_TUP2(a,o)\n"
, ByteString
"#define CALL_UBX_TUP2(r1,r2,c) { (r1) = (c); (r2) = h$ret1; }\n"
, ByteString
"#define CALL_UBX_TUP3(r1,r2,r3,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; }\n"
, ByteString
"#define CALL_UBX_TUP4(r1,r2,r3,r4,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; }\n"
, ByteString
"#define CALL_UBX_TUP5(r1,r2,r3,r4,r5,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; }\n"
, ByteString
"#define CALL_UBX_TUP6(r1,r2,r3,r4,r5,r6,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; }\n"
, ByteString
"#define CALL_UBX_TUP7(r1,r2,r3,r4,r5,r6,r7,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; (r7) = h$ret6; }\n"
, ByteString
"#define CALL_UBX_TUP8(r1,r2,r3,r4,r5,r6,r7,r8,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; (r7) = h$ret6; (r8) = h$ret7; }\n"
, ByteString
"#define CALL_UBX_TUP9(r1,r2,r3,r4,r5,r6,r7,r8,r9,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; }\n"
, ByteString
"#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"
]
jsExeFileName :: DynFlags -> FilePath
jsExeFileName :: DynFlags -> [Char]
jsExeFileName DynFlags
dflags
| Just [Char]
s <- DynFlags -> Maybe [Char]
outputFile_ DynFlags
dflags =
let s' :: [Char]
s' = [Char] -> [Char] -> [Char]
forall {a}. Eq a => [a] -> [a] -> [a]
dropPrefix [Char]
"js_" (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeExtension [Char]
s)
in if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Char]
s'
then [Char] -> [Char]
dropExtension [Char]
s [Char] -> [Char] -> [Char]
<.> [Char]
jsexeExtension
else [Char] -> [Char]
dropExtension [Char]
s [Char] -> [Char] -> [Char]
<.> [Char]
s'
| Bool
otherwise =
if Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
then [Char]
"main.jsexe"
else [Char]
"a.jsexe"
where
dropPrefix :: [a] -> [a] -> [a]
dropPrefix [a]
prefix [a]
xs
| [a]
prefix [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
prefix) [a]
xs
| Bool
otherwise = [a]
xs
decodeModifiedUTF8 :: B.ByteString -> Maybe FastString
decodeModifiedUTF8 :: ByteString -> Maybe FastString
decodeModifiedUTF8 ByteString
bs
| (Word8 -> Bool) -> ByteString -> Bool
B.any (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==Word8
0) ByteString
bs = Maybe FastString
forall a. Maybe a
Nothing
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
B.isValidUtf8 ByteString
bs = Maybe FastString
forall a. Maybe a
Nothing
| Bool
otherwise = FastString -> Maybe FastString
forall a. a -> Maybe a
Just (FastString -> Maybe FastString)
-> (ByteString -> FastString) -> ByteString -> Maybe FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FastString
mkFastStringByteString (ByteString -> Maybe FastString) -> ByteString -> Maybe FastString
forall a b. (a -> b) -> a -> b
$ ByteString
bs