suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reorder provides in lang-core.rkt

Browse Source
This commit is contained in:
Patrick Mahoney 2012-08-03 16:53:53 -04:00 committed by Gregory Cooper
parent fa740ebfcf
commit 182cf25bfa
1 changed files with 23 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/frtime/lang-core.rkt
View File

@ -22,13 +22,13 @@
(or (pred? (vector-ref vec i)) (or (pred? (vector-ref vec i))
(loop1 pred? vec (add1 i) len)))))) (loop1 pred? vec (add1 i) len))))))
(lambda (pred? vec) (lambda (pred? vec)
(loop1 pred? vec 0 (vector-length vec))))) (loop1 pred? vec 0 (vector-length vec)))))
;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;
;; Fundamental Macros ;; ;; Fundamental Macros ;;
;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax frp:letrec (define-syntax frp:letrec
(syntax-rules () (syntax-rules ()
[(_ ([id val] ...) expr ...) [(_ ([id val] ...) expr ...)
@ -71,7 +71,7 @@
[(_ ([vars expr] ...) body0 body1 ...) [(_ ([vars expr] ...) body0 body1 ...)
(let-values ([vars (split-multiple expr)] ...) (let-values ([vars (split-multiple expr)] ...)
body0 body1 ...)])) body0 body1 ...)]))
(define-for-syntax (get-rest-arg arglist-stx) (define-for-syntax (get-rest-arg arglist-stx)
(syntax-case arglist-stx () (syntax-case arglist-stx ()
[var [var
@ -88,8 +88,8 @@
(let ([the-rest-arg (get-rest-arg #'bindings)]) (let ([the-rest-arg (get-rest-arg #'bindings)])
(if the-rest-arg (if the-rest-arg
#`(bindings #`(bindings
(let ([#,the-rest-arg (frp:copy-list #,the-rest-arg)]) (let ([#,the-rest-arg (frp:copy-list #,the-rest-arg)])
body0 body1 ...)) body0 body1 ...))
#'(bindings body0 body1 ...)))])) #'(bindings body0 body1 ...)))]))
(define-syntax (frp:lambda stx) (define-syntax (frp:lambda stx)
@ -179,7 +179,7 @@
(define (public-dvn obj) (define (public-dvn obj)
(do-in-manager-after (do-in-manager-after
(deep-value-now obj empty))) (deep-value-now obj empty)))
(define any-spinal-reactivity? (define any-spinal-reactivity?
(opt-lambda (lst [mem empty]) (opt-lambda (lst [mem empty])
(cond (cond
@ -301,15 +301,15 @@
(lambda (_) (lambda (_)
(loop (unbox (signal:switching-current v)))) (loop (unbox (signal:switching-current v))))
(signal:switching-trigger v))] (signal:switching-trigger v))]
[(undefined? v) undefined] [(undefined? v) undefined]
[else (acc v)])))) [else (acc v)]))))
(define frp:car (define frp:car
(make-accessor car)) (make-accessor car))
(define frp:cdr (define frp:cdr
(make-accessor cdr)) (make-accessor cdr))
(define frp:pair? (lambda (arg) (if (signal:compound? arg) (define frp:pair? (lambda (arg) (if (signal:compound? arg)
(pair? (signal:compound-content arg)) (pair? (signal:compound-content arg))
(lift #t pair? arg)))) (lift #t pair? arg))))
@ -330,7 +330,7 @@
[(empty? lst) (ef)] [(empty? lst) (ef)]
[else (error "list-match: expected a list, got ~a" lst)])) [else (error "list-match: expected a list, got ~a" lst)]))
lst)) lst))
(define frp:append (define frp:append
(case-lambda (case-lambda
[() ()] [() ()]
@ -427,14 +427,14 @@
[(_ s (field ...)) [(_ s (field ...))
#'(frp:define-struct (s #f) (field ...) (current-inspector))])) #'(frp:define-struct (s #f) (field ...) (current-inspector))]))
(define (find pred lst) (define (find pred lst)
(cond (cond
[(empty? lst) #f] [(empty? lst) #f]
[(pred (first lst)) (first lst)] [(pred (first lst)) (first lst)]
[else (find pred (rest lst))])) [else (find pred (rest lst))]))
(define (ensure-no-signal-args val name)
(define (ensure-no-signal-args val name)
(if (procedure? val) (if (procedure? val)
(lambda args (lambda args
(cond (cond
@ -442,7 +442,7 @@
=> =>
(lambda (v) (lambda (v)
(raise-type-error name "non-signal" (raise-type-error name "non-signal"
(format "#<signal: ~a>" (signal-value v))))] (format "#<signal: ~a>" (signal-value v))))]
[else (apply val args)])))) [else (apply val args)]))))
@ -534,7 +534,7 @@
#'(begin clause ... (require require-spec))])])) #'(begin clause ... (require require-spec))])]))
#'(begin) #'(begin)
(syntax->list #'clauses))])) (syntax->list #'clauses))]))
@ -545,12 +545,17 @@
#%plain-module-begin #%plain-module-begin
#%module-begin #%module-begin
#%top-interaction #%top-interaction
raise-reactivity raise-reactivity
raise-list-for-apply raise-list-for-apply
(rename public-dvn deep-value-now)
any-nested-reactivity? any-nested-reactivity?
compound-lift compound-lift
list-match list-match
frp:copy-list
frp:->boolean
(rename public-dvn deep-value-now)
(rename frp:if if) (rename frp:if if)
(rename frp:lambda lambda) (rename frp:lambda lambda)
(rename frp:case-lambda case-lambda) (rename frp:case-lambda case-lambda)
@ -571,6 +576,4 @@
(rename frp:make-struct-field-mutator make-struct-field-mutator) (rename frp:make-struct-field-mutator make-struct-field-mutator)
(rename frp:define-struct define-struct) (rename frp:define-struct define-struct)
(rename frp:provide provide) (rename frp:provide provide)
(rename frp:require require) (rename frp:require require)))
frp:copy-list
frp:->boolean))