{-# LINE 1 "libraries/unix/System/Posix/Env/Internal.hsc" #-}
module System.Posix.Env.Internal where



import Foreign
import Foreign.C

getEnvironmentPrim :: IO [Ptr CChar]
getEnvironmentPrim :: IO [CString]
getEnvironmentPrim = do
  c_environ <- IO (Ptr CString)
getCEnviron
  if c_environ == nullPtr
    then return []
    else do
      peekArray0 nullPtr c_environ

getCEnviron :: IO (Ptr CString)

{-# LINE 25 "libraries/unix/System/Posix/Env/Internal.hsc" #-}
getCEnviron :: IO (Ptr CString)
getCEnviron = IO (Ptr CString)
_getCEnviron

-- N.B. we cannot import `environ` directly in Haskell as it may be a weak symbol
-- which requires special treatment by the compiler, which GHC is not equipped to
-- provide. See GHC #24011.
foreign import ccall unsafe "__hsunix_get_environ"
   _getCEnviron :: IO (Ptr CString)

{-# LINE 33 "libraries/unix/System/Posix/Env/Internal.hsc" #-}