Move Concurrency.Raw to new FFI

libs/base/System/Concurrency/Raw.idr

@@ -1,55 +1,83 @@
 module System.Concurrency.Raw
 
+-- At the moment this is pretty fundamentally tied to the Scheme RTS
+-- Given that different back ends will have entirely different threading
+-- models, it might be unavoidable, but we might want to think about possible
+-- primitives that back ends should support.
+
+%foreign "scheme:blodwen-thisthread"
+prim__threadID : PrimIO ThreadID
+%foreign "scheme:blodwen-set-thread-data"
+prim__setThreadData : {a : Type} -> a -> PrimIO ()
+%foreign "scheme:blodwen-get-thread-data"
+prim__getThreadData : (a : Type) -> PrimIO a
+
 -- Mutexes and condition variables.
 
 export
 threadID : IO ThreadID
-threadID = schemeCall ThreadID "blodwen-thisthread" []
+threadID = primIO prim__threadID
 
 export
 setThreadData : {a : Type} -> a -> IO ()
-setThreadData val = schemeCall () "blodwen-set-thread-data" [val]
+setThreadData val = primIO (prim__setThreadData val)
 
 export
 getThreadData : (a : Type) -> IO a
-getThreadData a = schemeCall a "blodwen-get-thread-data" []
+getThreadData a = primIO (prim__getThreadData a)
 
 export
-data Mutex : Type where
+data Mutex : Type where [external]
+
+%foreign "scheme:blodwen-mutex"
+prim__makeMutex : PrimIO Mutex
+%foreign "scheme:blodwen-lock"
+prim__mutexAcquire : Mutex -> PrimIO ()
+%foreign "scheme:blodwen-unlock"
+prim__mutexRelease : Mutex -> PrimIO ()
 
 export
 makeMutex : IO Mutex
-makeMutex = schemeCall Mutex "blodwen-mutex" []
+makeMutex = primIO prim__makeMutex
 
 export
 mutexAcquire : Mutex -> IO ()
-mutexAcquire m = schemeCall () "blodwen-lock" [m]
+mutexAcquire m = primIO (prim__mutexAcquire m)
 
 export
 mutexRelease : Mutex -> IO ()
-mutexRelease m = schemeCall () "blodwen-unlock" [m]
+mutexRelease m = primIO (prim__mutexRelease m)
 
 export
-data Condition : Type where
+data Condition : Type where [external]
+
+%foreign "scheme:blodwen-condition"
+prim__makeCondition : PrimIO Condition
+%foreign "scheme:blodwen-condition-wait"
+prim__conditionWait : Condition -> Mutex -> PrimIO ()
+%foreign "scheme:blodwen-condition-wait-timoue"
+prim__conditionWaitTimeout : Condition -> Mutex -> Int -> PrimIO ()
+%foreign "scheme:blodwen-condition-signal"
+prim__conditionSignal : Condition -> PrimIO ()
+%foreign "scheme:blodwen-condition-broadcast"
+prim__conditionBroadcast : Condition -> PrimIO ()
 
 export
 makeCondition : IO Condition
-makeCondition = schemeCall Condition "blodwen-condition" []
+makeCondition = primIO prim__makeCondition
 
 export
 conditionWait : Condition -> Mutex -> IO ()
-conditionWait c m = schemeCall () "blodwen-condition-wait" [c, m]
+conditionWait c m = primIO (prim__conditionWait c m)
 
 export
 conditionWaitTimeout : Condition -> Mutex -> Int -> IO ()
-conditionWaitTimeout c m t
-    = schemeCall () "blodwen-condition-wait-timeout" [c, m, t]
+conditionWaitTimeout c m t = primIO (prim__conditionWaitTimeout c m t)
 
 export
 conditionSignal : Condition -> IO ()
-conditionSignal c = schemeCall () "blodwen-condition-signal" [c]
+conditionSignal c = primIO (prim__conditionSignal c)
 
 export
 conditionBroadcast : Condition -> IO ()
-conditionBroadcast c = schemeCall () "blodwen-condition-broadcast" [c]
-
+conditionBroadcast c = primIO (prim__conditionBroadcast c)

support/chez/support.ss

@@ -80,7 +80,7 @@
 (define (blodwen-thread p)
     (fork-thread (lambda () (p (vector 0)))))
 
-(define (blodwen-get-thread-data)
+(define (blodwen-get-thread-data ty)
   (blodwen-thread-data))
 
 (define (blodwen-set-thread-data a)

support/gambit/support.scm

@@ -78,15 +78,15 @@
 (define (blodwen-get-char p)
   (if (input-port? p)
       (let ((chr (read-char p)))
-        (if (eof-object? chr) #\null chr))
-      #\null))
+        (if (eof-object? chr) #\nul chr))
+      #\nul))
 
 ;; Threads
 
 (define (blodwen-thread p)
   (thread-start! (make-thread (lambda () (p #(0))))))
 
-(define (blodwen-get-thread-data)
+(define (blodwen-get-thread-data ty)
   (let ((data (thread-specific (current-thread))))
     (if (eq? data #!void) #f data)))
 

support/racket/support.rkt

@@ -77,7 +77,7 @@
 (define (blodwen-thread p)
     (thread (lambda () (p (vector 0)))))
 
-(define (blodwen-get-thread-data)
+(define (blodwen-get-thread-data ty)
   (thread-cell-ref blodwen-thread-data))
 
 (define (blodwen-set-thread-data a)