Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 13:05:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixed-up make-thread

Browse source
This commit is contained in:
Justin Ethier 2015-12-16 21:59:58 -05:00
parent 7c795f1534
commit d478132d8a
1 changed files with 29 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
scheme/base.sld
View file

@ -103,38 +103,6 @@
quasiquote quasiquote
) )
(begin (begin
;; Threading
(define (thread? obj)
(and (vector? obj)
(> (vector-length obj) 0)
(equal? 'cyc-thread-obj (vector-ref obj 0))))
;; TODO: does not compile. I suspect the let is not getting expanded for some reason...
(define (make-thread thunk . name)
(let ((name-str (if (pair? name)
(car name)
"")))
(vector 'cyc-thread-obj thunk #f name-str #f)))
;; Fields supported so far:
;; - type marker (implementation-specific)
;; - thunk
;; - internal thread id (implementation-specific)
;; - name
;; - specific
; (vector 'cyc-thread-obj thunk #f name #f))
; (vector 'cyc-thread-obj thunk #f 'name-str #f)))
(define (thread-name t) (vector-ref t 3))
(define (thread-specific t) (vector-ref t 4))
(define (thread-specific-set! t obj) (vector-set! t 4 obj))
; TODO:
; current-thread - not sure how to look this up yet... may need a global list of running threads
; (define (thread-start! t)
; (let* ((thunk (vector-ref t 1))
; (mutator-id (Cyc-thread-start! thunk)))
; (vector-set! t 2 mutator-id)))
;; Features implemented by this Scheme ;; Features implemented by this Scheme
(define (features) '(cyclone r7rs exact-closed)) (define (features) '(cyclone r7rs exact-closed))
@ -686,4 +654,33 @@
(else (else
#f)))) #f))))
;; Threading
(define (thread? obj)
(and (vector? obj)
(> (vector-length obj) 0)
(equal? 'cyc-thread-obj (vector-ref obj 0))))
(define (make-thread thunk . name)
(let ((name-str (if (pair? name)
(car name)
"")))
;; Fields supported so far:
;; - type marker (implementation-specific)
;; - thunk
;; - internal thread id (implementation-specific)
;; - name
;; - specific
(vector 'cyc-thread-obj thunk #f name-str #f)))
(define (thread-name t) (vector-ref t 3))
(define (thread-specific t) (vector-ref t 4))
(define (thread-specific-set! t obj) (vector-set! t 4 obj))
; TODO:
; current-thread - not sure how to look this up yet... may need a global list of running threads
; (define (thread-start! t)
; (let* ((thunk (vector-ref t 1))
; (mutator-id (Cyc-thread-start! thunk)))
; (vector-set! t 2 mutator-id)))
)) ))