Merge pull request #85 from amesgen/wasi

FFI changes to support the GHC WASM/WASI backend
corsis · Apr 30, 2023 · fad77ab · fad77ab
2 parents 11e4ac9 + a6b5977
commit fad77ab
Show file tree

Hide file tree

Showing 2 changed files with 85 additions and 14 deletions.
diff --git a/.github/workflows/other.yml b/.github/workflows/other.yml
@@ -0,0 +1,30 @@
+on:
+  push:
+  pull_request:
+jobs:
+  wasi:
+    runs-on: ubuntu-latest
+    env:
+      GHC_WASM_META_REV: 5a5c10c3b7e2f9f55bb2f40601cb20c9eb599bb5
+      FLAVOUR: '9.6'
+    steps:
+    - name: Setup WASI GHC
+      run: |
+        cd $(mktemp -d)
+        curl -L --retry 5 https://gitlab.haskell.org/ghc/ghc-wasm-meta/-/archive/$GHC_WASM_META_REV/ghc-wasm-meta-master.tar.gz | tar xz --strip-components=1
+        ./setup.sh
+        ~/.ghc-wasm/add_to_github_path.sh
+    - uses: actions/checkout@v3
+
+    - uses: actions/cache@v3
+      with:
+        path: |
+          ~/.ghc-wasm/.cabal/store
+          dist-newstyle
+        key: build-wasi-${{ runner.os }}-wasm-meta-${{ env.GHC_WASM_META_REV }}-flavour-${{ env.FLAVOUR }}-${{ github.sha }}
+        restore-keys: |
+          build-wasi-${{ runner.os }}-wasm-meta-${{ env.GHC_WASM_META_REV }}-flavour-${{ env.FLAVOUR }}-
+
+    - name: Build
+      run: |
+        wasm32-wasi-cabal build
diff --git a/System/Clock.hsc b/System/Clock.hsc
@@ -3,6 +3,7 @@
 --   1003.1-2008: <http://www.opengroup.org/onlinepubs/9699919799/>,
 --   <http://www.opengroup.org/onlinepubs/9699919799/functions/clock_getres.html#>
 
+{-# LANGUAGE CApiFFI #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 -- To allow importing Data.Int and Data.Word indiscriminately on all platforms,
 -- since we can't systematically predict what typedef's expand to.
@@ -34,11 +35,17 @@ import GHC.Generics (Generic)
 
 #if defined(_WIN32)
 #  include "hs_clock_win32.c"
+#  define HS_CLOCK_HAVE_PROCESS_CPUTIME
+#  define HS_CLOCK_HAVE_THREAD_CPUTIME
 #else
 #  include <time.h>
-#  ifndef CLOCK_PROCESS_CPUTIME_ID
-#    define CLOCK_PROCESS_CPUTIME_ID 15
+#  ifdef CLOCK_PROCESS_CPUTIME_ID
+#    define HS_CLOCK_HAVE_PROCESS_CPUTIME
 #  endif
+#  ifdef CLOCK_THREAD_CPUTIME_ID
+#    define HS_CLOCK_HAVE_THREAD_CPUTIME
+#  endif
+import System.Posix.Types
 #endif
 
 #if __GLASGOW_HASKELL__ < 800
@@ -71,15 +78,19 @@ data Clock
     -- @CLOCK_REALTIME@ (macOS - @CALENDAR_CLOCK@, Windows - @GetSystemTimeAsFileTime@)
   | Realtime
 
+#ifdef HS_CLOCK_HAVE_PROCESS_CPUTIME
     -- | The identifier of the CPU-time clock associated with the calling
     --   process. For this clock, the value returned by 'getTime' represents the
     --   amount of execution time of the current process.
   | ProcessCPUTime
+#endif
 
+#ifdef HS_CLOCK_HAVE_THREAD_CPUTIME
     -- | The identifier of the CPU-time clock associated with the calling OS
     --   thread. For this clock, the value returned by 'getTime' represents the
     --   amount of execution time of the current OS thread.
   | ThreadCPUTime
+#endif
 
 #if defined (CLOCK_MONOTONIC_RAW)
     -- | (since Linux 2.6.28, macOS 10.12)
@@ -132,28 +143,58 @@ foreign import ccall unsafe hs_clock_win32_getres_realtime :: Ptr TimeSpec -> IO
 foreign import ccall unsafe hs_clock_win32_getres_processtime :: Ptr TimeSpec -> IO ()
 foreign import ccall unsafe hs_clock_win32_getres_threadtime :: Ptr TimeSpec -> IO ()
 #else
-foreign import ccall unsafe clock_gettime :: #{type clockid_t} -> Ptr TimeSpec -> IO CInt
-foreign import ccall unsafe clock_getres  :: #{type clockid_t} -> Ptr TimeSpec -> IO CInt
+#if MIN_VERSION_base(4,10,0)
+type ClockId = CClockId
+#else
+type ClockId = #{type clockid_t}
 #endif
 
-#if !defined(_WIN32)
-clockToConst :: Clock -> #{type clockid_t}
-clockToConst Monotonic = #const CLOCK_MONOTONIC
-clockToConst  Realtime = #const CLOCK_REALTIME
-clockToConst ProcessCPUTime = #const CLOCK_PROCESS_CPUTIME_ID
-clockToConst  ThreadCPUTime = #const CLOCK_THREAD_CPUTIME_ID
+foreign import ccall unsafe clock_gettime :: ClockId -> Ptr TimeSpec -> IO CInt
+foreign import ccall unsafe clock_getres  :: ClockId -> Ptr TimeSpec -> IO CInt
+
+foreign import capi unsafe "time.h value CLOCK_MONOTONIC" clock_MONOTONIC :: ClockId
+foreign import capi unsafe "time.h value CLOCK_REALTIME" clock_REALTIME :: ClockId
+#if defined (CLOCK_PROCESS_CPUTIME_ID)
+foreign import capi unsafe "time.h value CLOCK_PROCESS_CPUTIME_ID" clock_PROCESS_CPUTIME_ID :: ClockId
+#endif
+#if defined (CLOCK_THREAD_CPUTIME_ID)
+foreign import capi unsafe "time.h value CLOCK_THREAD_CPUTIME_ID" clock_THREAD_CPUTIME_ID :: ClockId
+#endif
+#if defined (CLOCK_MONOTONIC_RAW)
+foreign import capi unsafe "time.h value CLOCK_MONOTONIC_RAW" clock_MONOTONIC_RAW :: ClockId
+#endif
+#if defined (CLOCK_BOOTTIME)
+foreign import capi unsafe "time.h value CLOCK_BOOTTIME" clock_BOOTTIME :: ClockId
+#endif
+#if defined (CLOCK_MONOTONIC_COARSE)
+foreign import capi unsafe "time.h value CLOCK_MONOTONIC_COARSE" clock_MONOTONIC_COARSE :: ClockId
+#endif
+#if defined (CLOCK_REALTIME_COARSE)
+foreign import capi unsafe "time.h value CLOCK_REALTIME_COARSE" clock_REALTIME_COARSE :: ClockId
+#endif
+#endif
 
+#if !defined(_WIN32)
+clockToConst :: Clock -> ClockId
+clockToConst Monotonic = clock_MONOTONIC
+clockToConst  Realtime = clock_REALTIME
+#if defined (CLOCK_PROCESS_CPUTIME_ID)
+clockToConst ProcessCPUTime = clock_PROCESS_CPUTIME_ID
+#endif
+#if defined (CLOCK_THREAD_CPUTIME_ID)
+clockToConst  ThreadCPUTime = clock_THREAD_CPUTIME_ID
+#endif
 #if defined (CLOCK_MONOTONIC_RAW)
-clockToConst    MonotonicRaw = #const CLOCK_MONOTONIC_RAW
+clockToConst    MonotonicRaw = clock_MONOTONIC_RAW
 #endif
 #if defined (CLOCK_BOOTTIME)
-clockToConst        Boottime = #const CLOCK_BOOTTIME
+clockToConst        Boottime = clock_BOOTTIME
 #endif
 #if defined (CLOCK_MONOTONIC_COARSE)
-clockToConst MonotonicCoarse = #const CLOCK_MONOTONIC_COARSE
+clockToConst MonotonicCoarse = clock_MONOTONIC_COARSE
 #endif
 #if defined (CLOCK_REALTIME_COARSE)
-clockToConst  RealtimeCoarse = #const CLOCK_REALTIME_COARSE
+clockToConst  RealtimeCoarse = clock_REALTIME_COARSE
 #endif
 #endif