Evalprime/breezewiki
1
0
Fork 0
forked from cadence/breezewiki
Code Pull requests Activity

Replace thread-let with thread-utils

Browse source
This commit is contained in:
Cadence Ember 2023-02-12 13:55:33 +13:00
parent 5fa6e2fb9e
commit 501dcaa3fc
Signed by untrusted user: cadence
GPG key ID: BC1C2C61CF521B17
9 changed files with 255 additions and 215 deletions
Download patch file Download diff file Expand all files Collapse all files

52
lib/syntax.rkt
View file

@ -4,8 +4,6 @@
(provide
; help make a nested if. if/in will gain the same false form of its containing if/out.
if/out
; let, but the value for each variable is evaluated within a thread
thread-let
; cond, but values can be defined between conditions
cond/var
; wrap sql statements into lambdas so they can be executed during migration
@ -25,7 +23,6 @@
(provide
transform-if/out
transform-thread-let
transform/out-cond/var)
(define (transform-if/out stx)
@ -51,26 +48,6 @@
[#t node])))
(datum->syntax stx (cons 'if result)))
(define (transform-thread-let stx)
(define tree (cdr (syntax->datum stx)))
(define defs (car tree))
(define forms (cdr tree))
(when (eq? (length forms) 0)
(error (format "thread-let: bad syntax (need some forms to execute after the threads)~n forms: ~a" forms)))
(define counter (build-list (length defs) values))
(datum->syntax
stx
`(let ([chv (build-vector ,(length defs) (λ (_) (make-channel)))])
,@(map (λ (n)
(define def (list-ref defs n))
`(thread (λ () (channel-put (vector-ref chv ,n) (let _ () ,@(cdr def))))))
counter)
(let ,(map (λ (n)
(define def (list-ref defs n))
`(,(car def) (channel-get (vector-ref chv ,n))))
counter)
,@forms))))
(define (transform/out-cond/var stx)
(define tree (transform-cond/var (cdr (syntax->datum stx))))
(datum->syntax
@ -119,35 +96,6 @@
(check-equal? (if/out #t (if/in #f 'yes) 'no) 'no)
(check-equal? (if/out #f (if/in #f 'yes) 'no) 'no))
(define-syntax (thread-let stx)
(transform-thread-let stx))
(module+ test
; check that it is transformed as expected
(check-syntax-equal?
(transform-thread-let
#'(thread-let ([a (hey "this is a")]
[b (hey "this is b")])
(list a b)))
#'(let ([chv (build-vector 2 (λ (_) (make-channel)))])
(thread (λ () (channel-put (vector-ref chv 0) (let _ () (hey "this is a")))))
(thread (λ () (channel-put (vector-ref chv 1) (let _ () (hey "this is b")))))
(let ([a (channel-get (vector-ref chv 0))]
[b (channel-get (vector-ref chv 1))])
(list a b))))
; check that they actually execute concurrently
(define ch (make-channel))
(check-equal? (thread-let ([a (begin
(channel-put ch 'a)
(channel-get ch))]
[b (begin0
(channel-get ch)
(channel-put ch 'b))])
(list a b))
'(b a))
; check that it assigns the correct value to the correct variable
(check-equal? (thread-let ([a (sleep 0) 'a] [b 'b]) (list a b))
'(a b)))
(define-syntax (cond/var stx)
(transform/out-cond/var stx))
(module+ test