Fix lots of indentation mistakes.
(Found by my ayatollah script...)
This commit is contained in:
Eli Barzilay
parent
71d6189132
commit
af6be85ff5
|
|
@ -146,8 +146,11 @@
|
|||
(map (lambda (extra)
|
||||
(if (identifier? extra)
|
||||
(make-a60:type-decl (->stx 'integer) (list extra))
|
||||
(make-a60:switch-decl (car extra) (map (lambda (x)
|
||||
(make-a60:variable (datum->syntax-object #f x) null))
|
||||
(make-a60:switch-decl
|
||||
(car extra)
|
||||
(map (lambda (x)
|
||||
(make-a60:variable (datum->syntax-object #f x)
|
||||
null))
|
||||
(cdr extra)))))
|
||||
extra-decls))
|
||||
(if (null? new-statements)
|
||||
|
|
@ -155,10 +158,7 @@
|
|||
new-statements)))
|
||||
|
||||
(define (simplify stmt ctx)
|
||||
(simplify-statement stmt (lambda (x)
|
||||
(datum->syntax-object
|
||||
ctx
|
||||
x))))
|
||||
(simplify-statement stmt (lambda (x) (datum->syntax-object ctx x))))
|
||||
|
||||
(define (simplify-statement stmt ->stx)
|
||||
(match stmt
|
||||
|
|
|
|||
|
|
@ -116,14 +116,16 @@
|
|||
(let ([init (parameterize ([current-directory dir]
|
||||
[current-load-relative-directory dir]
|
||||
;; Verbose compilation manager:
|
||||
[manager-trace-handler (if verbose?
|
||||
[manager-trace-handler
|
||||
(if verbose?
|
||||
(let ([op (current-output-port)])
|
||||
(lambda (s) (fprintf op "~a\n" s)))
|
||||
(manager-trace-handler))]
|
||||
[manager-compile-notify-handler
|
||||
(lambda (path) ((compile-notify-handler) path))]
|
||||
[manager-skip-file-handler
|
||||
(lambda (path) (and skip-path
|
||||
(lambda (path)
|
||||
(and skip-path
|
||||
(let ([b (path->bytes (simplify-path path #f))]
|
||||
[len (bytes-length skip-path)])
|
||||
(and ((bytes-length b) . > . len)
|
||||
|
|
|
|||
|
|
@ -59,9 +59,7 @@ itself.
|
|||
(define (update-buttons)
|
||||
(send resume-b enable (and current-sampler (not running?)))
|
||||
(send pause-b enable (and current-sampler running?))
|
||||
(send start-stop-b set-label (if current-sampler
|
||||
"Stop"
|
||||
"Start")))
|
||||
(send start-stop-b set-label (if current-sampler "Stop" "Start")))
|
||||
|
||||
(define running? #f)
|
||||
(define current-sampler #f)
|
||||
|
|
|
|||
|
|
@ -931,8 +931,8 @@
|
|||
(λ (adjust)
|
||||
(λ (text event)
|
||||
(when (is-a? text editor:basic<%>)
|
||||
(let ([frame (send text get-top-level-window)])
|
||||
(let ([found-one? #f])
|
||||
(let ([frame (send text get-top-level-window)]
|
||||
[found-one? #f])
|
||||
(let/ec k
|
||||
(let ([go
|
||||
(λ ()
|
||||
|
|
@ -952,7 +952,7 @@
|
|||
;;; or the last editor-canvas had the focus. either way,
|
||||
;;; the next thing should get the focus
|
||||
(set! found-one? #t)
|
||||
(go))))))))]
|
||||
(go)))))))]
|
||||
|
||||
[TeX-compress
|
||||
(let* ([biggest (apply max (map (λ (x) (string-length (car x))) tex-shortcut-table))])
|
||||
|
|
|
|||
|
|
@ -6,10 +6,7 @@
|
|||
(module math frtime/frtime-lang-only
|
||||
(require (only-in racket/math pi sqr sgn conjugate sinh cosh))
|
||||
|
||||
(provide (lifted
|
||||
sqr
|
||||
sgn conjugate
|
||||
sinh cosh))
|
||||
(provide (lifted sqr sgn conjugate sinh cosh))
|
||||
|
||||
(provide pi e)
|
||||
|
||||
|
|
|
|||
|
|
@ -211,7 +211,8 @@
|
|||
[last-x 0]
|
||||
[ticks '()]
|
||||
[last-label-x-extent 0]
|
||||
[remain-segs segs]) ([i (in-range 0 (floor (/ (- (trace-end-time tr)
|
||||
[remain-segs segs])
|
||||
([i (in-range 0 (floor (/ (- (trace-end-time tr)
|
||||
trace-start)
|
||||
DEFAULT-TIME-INTERVAL)))])
|
||||
(define tick-rel-time (* (add1 i) DEFAULT-TIME-INTERVAL))
|
||||
|
|
|
|||
|
|
@ -635,8 +635,7 @@
|
|||
(parse (strip-stops code)))
|
||||
(define parsed (if (parsed-syntax? parsed-original)
|
||||
parsed-original
|
||||
(let-values ([(out rest)
|
||||
(parse parsed-original)])
|
||||
(let-values ([(out rest) (parse parsed-original)])
|
||||
(when (not (empty-syntax? rest))
|
||||
(raise-syntax-error 'parse-all "expected no more syntax" parsed-original))
|
||||
out)))
|
||||
|
|
|
|||
|
|
@ -382,8 +382,7 @@
|
|||
(list (bitmap->pixbuf big-icon))
|
||||
(cdr (car (force icon-pixbufs+glist))))])
|
||||
(atomically
|
||||
(let ([l (for/fold ([l #f]) ([i (cons small-pixbuf
|
||||
big-pixbufs)])
|
||||
(let ([l (for/fold ([l #f]) ([i (cons small-pixbuf big-pixbufs)])
|
||||
(g_list_insert l i -1))])
|
||||
(gtk_window_set_icon_list gtk l)
|
||||
(g_list_free l))))))
|
||||
|
|
|
|||
|
|
@ -345,7 +345,8 @@
|
|||
[(1) 'left-up]
|
||||
[(3) 'right-up]
|
||||
[else 'middle-up])])]
|
||||
[m (let-values ([(x y) (send wx
|
||||
[m (let-values ([(x y)
|
||||
(send wx
|
||||
adjust-event-position
|
||||
(->long ((if motion?
|
||||
GdkEventMotion-x
|
||||
|
|
|
|||
|
|
@ -372,9 +372,7 @@ TO DO:
|
|||
(define-syntax with-failure
|
||||
(syntax-rules ()
|
||||
[(_ thunk body ...)
|
||||
(with-handlers ([exn? (lambda (exn)
|
||||
(thunk)
|
||||
(raise exn))])
|
||||
(with-handlers ([exn? (lambda (exn) (thunk) (raise exn))])
|
||||
body ...)]))
|
||||
|
||||
(define (get-error-message id)
|
||||
|
|
|
|||
|
|
@ -9,7 +9,8 @@
|
|||
|
||||
(provide/contract
|
||||
(build-parser ((string? any/c any/c (listof identifier?) (listof identifier?)
|
||||
(listof identifier?) (union syntax? false/c) syntax?) . ->* .
|
||||
(listof identifier?) (union syntax? false/c) syntax?)
|
||||
. ->* .
|
||||
(any/c any/c any/c any/c))))
|
||||
|
||||
;; fix-check-syntax : (listof identifier?) (listof identifier?) (listof identifier?)
|
||||
|
|
|
|||
|
|
@ -17,10 +17,7 @@
|
|||
(λ (val)
|
||||
(if (pred? val)
|
||||
(out val)
|
||||
(raise-blame-error blame
|
||||
val
|
||||
"non-polymorphic value: ~e"
|
||||
val)))
|
||||
(raise-blame-error blame val "non-polymorphic value: ~e" val)))
|
||||
in))))
|
||||
|
||||
(define-struct ∀∃/c (in out pred? name neg?)
|
||||
|
|
|
|||
|
|
@ -79,8 +79,7 @@
|
|||
[1/10 1]
|
||||
[else (+ 2 (rand 260))])]
|
||||
[bstr (build-list len
|
||||
(λ (x)
|
||||
(rand 256)))])
|
||||
(λ (x) (rand 256)))])
|
||||
(apply bytes bstr)))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -132,10 +132,8 @@
|
|||
(dplace/place-channel-put ch (log-message severity msg)))
|
||||
(syntax-parameterize ([log-to-parent (make-rename-transformer #'log-to-parent-real)])
|
||||
(match msg
|
||||
cases (... ...)
|
||||
))
|
||||
loop)
|
||||
))))
|
||||
cases (... ...)))
|
||||
loop)))))
|
||||
(with-syntax ([mkname (string->id stx (format "make-~a" (id->string #'name)))])
|
||||
(define x
|
||||
#`(begin
|
||||
|
|
@ -156,5 +154,3 @@ x)]))
|
|||
(provide define-remote-server
|
||||
define-named-remote-server
|
||||
log-to-parent)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -143,7 +143,8 @@
|
|||
(define (which cmd)
|
||||
(define path (getenv "PATH"))
|
||||
(and path
|
||||
(exists? (map (lambda (x) (build-path x cmd)) (regexp-split (case (system-type 'os)
|
||||
(exists? (map (lambda (x) (build-path x cmd))
|
||||
(regexp-split (case (system-type 'os)
|
||||
[(unix macosx) ":"]
|
||||
[(windows) "#:;"])
|
||||
path)))))
|
||||
|
|
|
|||
|
|
@ -18,13 +18,14 @@
|
|||
;(place-worker p1)
|
||||
|
||||
(define (main . argv)
|
||||
(define p (place ch
|
||||
(define p
|
||||
(place ch
|
||||
(random-seed (current-seconds))
|
||||
;(define id (place-channel-get ch))
|
||||
;; (define id (place-channel-get ch))
|
||||
(define id "HI")
|
||||
(for ([i (in-range (+ 5 (random 5)))])
|
||||
(displayln (list (current-seconds) id i))
|
||||
(flush-output)
|
||||
;(place-channel-put ch (list (current-seconds) id i))
|
||||
;; (place-channel-put ch (list (current-seconds) id i))
|
||||
#;(sleep 3))))
|
||||
(sync (handle-evt (place-dead-evt p) (lambda (e) (printf "DEAD\n")))))
|
||||
|
|
|
|||
|
|
@ -132,9 +132,9 @@
|
|||
[mapping null]
|
||||
[ready-to-reduce null]
|
||||
[reducing null])
|
||||
;(printf "STATE\n")
|
||||
;(pretty-print (list ts idle-mappers mapping ready-to-reduce reducing))
|
||||
;(flush-output)
|
||||
;; (printf "STATE\n")
|
||||
;; (pretty-print (list ts idle-mappers mapping ready-to-reduce reducing))
|
||||
;; (flush-output)
|
||||
(match (list ts idle-mappers mapping ready-to-reduce reducing)
|
||||
[(list (cons tsh tst) (cons imh imt) mapping rtr r)
|
||||
(*channel-put (second imh) (list 'map mapper sorter (list tsh)))
|
||||
|
|
@ -146,7 +146,8 @@
|
|||
(*channel-put (second rtr) (list 'get-results))
|
||||
(second (*channel-get (second rtr)))]
|
||||
[else ; wait
|
||||
(apply sync/enable-break (for/list ([m (append mapping reducing)])
|
||||
(apply sync/enable-break
|
||||
(for/list ([m (append mapping reducing)])
|
||||
(wrap-evt (second m)
|
||||
(lambda (e)
|
||||
(match e
|
||||
|
|
@ -159,8 +160,3 @@
|
|||
|
||||
(or (and outputer ((apply-dynamic-require outputer) result))
|
||||
result))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -258,10 +258,11 @@
|
|||
(partit num cnt id))
|
||||
|
||||
(define rmpi-build-default-config
|
||||
(make-keyword-procedure (lambda (kws kw-args . rest)
|
||||
(make-keyword-procedure
|
||||
(lambda (kws kw-args . rest)
|
||||
(for/hash ([kw kws]
|
||||
[kwa kw-args])
|
||||
; (displayln (keyword? kw))
|
||||
;; (displayln (keyword? kw))
|
||||
(values kw kwa)))))
|
||||
|
||||
(define (rmpi-launch default config #:no-wait [no-wait #f])
|
||||
|
|
|
|||
|
|
@ -133,8 +133,7 @@
|
|||
|
||||
(define (tests->test-suite-action tests)
|
||||
(lambda (fdown fup fhere seed)
|
||||
(parameterize
|
||||
([current-seed seed])
|
||||
(parameterize ([current-seed seed])
|
||||
(for-each
|
||||
(lambda (t)
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -705,8 +705,7 @@
|
|||
(l! lx x_1) ...
|
||||
(r6rs-subst-many ((x_1 lx) ... e_2))
|
||||
(r6rs-subst-many ((x_1 lx) ... e_3)) ...)
|
||||
(begin0
|
||||
(r6rs-subst-many ((x_1 lx) ... e_1))
|
||||
(begin0 (r6rs-subst-many ((x_1 lx) ... e_1))
|
||||
(reinit ri))
|
||||
...)))
|
||||
"6letrec"
|
||||
|
|
|
|||
|
|
@ -74,7 +74,8 @@
|
|||
; the reduction graph produces a cutoff result; with it
|
||||
; a cylce produces a pending, which is treated identically.
|
||||
(hash-set! cache s (cons c 'pending))
|
||||
(let ([r (cond [(term (halted? ,s))
|
||||
(let ([r
|
||||
(cond [(term (halted? ,s))
|
||||
(make-answer
|
||||
(if (eq? s 'error)
|
||||
'error
|
||||
|
|
|
|||
|
|
@ -422,7 +422,8 @@
|
|||
(define (ybase-sum) (/ yscale-base (- 1 yscale-base)))
|
||||
(define (find-ybase-center)
|
||||
(define mid (/ (ybase-sum) 2))
|
||||
(define sums (for/hash ([i 10]) (values (abs (- mid
|
||||
(define sums (for/hash ([i 10])
|
||||
(values (abs (- mid
|
||||
(apply + (for/list ([k i])
|
||||
(expt yscale-base i)))))
|
||||
i)))
|
||||
|
|
@ -679,7 +680,8 @@
|
|||
(define/private (map-y-int y)
|
||||
(hash-ref map-y-int-memo y
|
||||
(λ ()
|
||||
(define res (if (< 0 y)
|
||||
(define res
|
||||
(if (< 0 y)
|
||||
(+ Y-SHIFT (* (apply + (for/list ([i (in-range 1 y)])
|
||||
(expt yscale-base i)))
|
||||
y-scale))
|
||||
|
|
|
|||
|
|
@ -25,4 +25,3 @@
|
|||
#'@defmethod*[(((method (orig (is-a?/c text%)) (call-inner (-> any)) (x any/c) ...) any) ...)]{
|
||||
Returns the result of invoking @racket[call-super].
|
||||
}]))
|
||||
|
||||
|
|
|
|||
|
|
@ -87,12 +87,13 @@
|
|||
method should be used instead during undoable edit sequences.})
|
||||
|
||||
(define (insertscrolldetails what)
|
||||
@elem{@|what| editor's display is scrolled to show the new selection @techlink{position}.})
|
||||
@elem{@|what| editor's display is scrolled to show the new selection
|
||||
@techlink{position}.})
|
||||
|
||||
(define (insertmovedetails what)
|
||||
@elem{If the insertion @techlink{position} is before
|
||||
or equal to the selection's start/end @techlink{position}, then the selection's
|
||||
start/end @techlink{position} is incremented by @|what|.})
|
||||
or equal to the selection's start/end @techlink{position}, then the
|
||||
selection's start/end @techlink{position} is incremented by @|what|.})
|
||||
|
||||
(define OVD
|
||||
@elem{The result is only valid when the editor is displayed
|
||||
|
|
@ -100,9 +101,10 @@ start/end @techlink{position} is incremented by @|what|.})
|
|||
@method[editor<%> get-admin] returns an administrator (not @racket[#f]).})
|
||||
|
||||
(define (FCAX c details)
|
||||
@elem{@|c|alling this method may force the recalculation of @techlink{location}
|
||||
information@|details|, even if the editor currently has delayed refreshing (see
|
||||
@method[editor<%> refresh-delayed?]).})
|
||||
@elem{
|
||||
@|c|alling this method may force the recalculation of @techlink{location}
|
||||
information@|details|, even if the editor currently has delayed
|
||||
refreshing (see @method[editor<%> refresh-delayed?]).})
|
||||
|
||||
(define FCA (FCAX "C" ""))
|
||||
(define FCAMW (FCAX "C" " if a maximum width is set for the editor"))
|
||||
|
|
@ -180,11 +182,14 @@ information@|details|, even if the editor currently has delayed refreshing (see
|
|||
@elem{The editor's style list must contain @style, otherwise
|
||||
the style is not changed. See also @xmethod[style-list% convert].})
|
||||
|
||||
(define (FontKWs font) @elem{The @|font| argument determines the font for the control.})
|
||||
(define (FontLabelKWs font label-font) @elem{The @|font| argument determines the font for the control content,
|
||||
(define (FontKWs font)
|
||||
@elem{The @|font| argument determines the font for the control.})
|
||||
(define (FontLabelKWs font label-font)
|
||||
@elem{The @|font| argument determines the font for the control content,
|
||||
and @|label-font| determines the font for the control label.})
|
||||
|
||||
(define (WindowKWs enabled) @elem{For information about the @|enabled| argument, see @racket[window<%>].})
|
||||
(define (WindowKWs enabled)
|
||||
@elem{For information about the @|enabled| argument, see @racket[window<%>].})
|
||||
(define-inline (SubareaKWs)
|
||||
@elem{For information about the @racket[horiz-margin] and @racket[vert-margin]
|
||||
arguments, see @racket[subarea<%>].})
|
||||
|
|
|
|||
|
|
@ -63,15 +63,12 @@
|
|||
@section[#:tag (string-append section-prefix " Pre-Defined Variables")]{Pre-Defined Variables}
|
||||
|
||||
@defthing[empty empty?]{
|
||||
|
||||
The empty list.}
|
||||
|
||||
@defthing[true boolean?]{
|
||||
|
||||
The true value.}
|
||||
|
||||
@defthing[false boolean?]{
|
||||
|
||||
The false value.}
|
||||
|
||||
@section[#:tag (string-append section-prefix " Template Variables")]{Template Variables}
|
||||
|
|
|
|||
|
|
@ -85,14 +85,16 @@
|
|||
(define/public (send/msg msg)
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (x)
|
||||
(eprintf "While sending message to parallel-do worker: ~a ~a\n" id (exn-message x))
|
||||
(eprintf "While sending message to parallel-do worker: ~a ~a\n"
|
||||
id (exn-message x))
|
||||
(exit 1))])
|
||||
(DEBUG_COMM (eprintf "CSENDING ~v ~v\n" id msg))
|
||||
(write msg in) (flush-output in)))
|
||||
(define/public (recv/msg)
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (x)
|
||||
(eprintf "While receiving message from parallel-do worker ~a ~a\n" id (exn-message x))
|
||||
(eprintf "While receiving message from parallel-do worker ~a ~a\n"
|
||||
id (exn-message x))
|
||||
(exit 1))])
|
||||
(define r (read out))
|
||||
(DEBUG_COMM (eprintf "CRECEIVNG ~v ~v\n" id r))
|
||||
|
|
|
|||
|
|
@ -34,9 +34,9 @@
|
|||
#:key
|
||||
[with-gl (lambda (f) (f))]
|
||||
[mask (send bm get-loaded-mask)])
|
||||
(let ([w (send bm get-width)]
|
||||
[h (send bm get-height)]
|
||||
[rgba (argb->rgba (bitmap->argb bm mask))])
|
||||
(define w (send bm get-width))
|
||||
(define h (send bm get-height))
|
||||
(define rgba (argb->rgba (bitmap->argb bm mask)))
|
||||
(with-gl
|
||||
(lambda ()
|
||||
(let ((tex (gl-vector-ref (glGenTextures 1) 0))
|
||||
|
|
@ -67,4 +67,4 @@
|
|||
(gl-disable 'texture-2d)
|
||||
(gl-end-list)
|
||||
|
||||
list-id))))))
|
||||
list-id)))))
|
||||
|
|
|
|||
|
|
@ -570,8 +570,11 @@
|
|||
attached))
|
||||
|
||||
(define (values-map fn . lsts)
|
||||
(apply values (apply map list
|
||||
(apply map (lambda args (call-with-values (lambda () (apply fn args)) list))
|
||||
(apply values
|
||||
(apply map list
|
||||
(apply map (lambda args
|
||||
(call-with-values (lambda () (apply fn args))
|
||||
list))
|
||||
lsts))))
|
||||
|
||||
; produces the list of numbers from a to b (inclusive)
|
||||
|
|
|
|||
|
|
@ -174,7 +174,8 @@ please adhere to these guidelines:
|
|||
(saved-unsubmitted-bug-reports "Saved, unsubmitted bug reports:")
|
||||
;; the above string constant is next to previous line in same dialog, followed by list of bug report subjects (as buttons)
|
||||
(error-sending-bug-report "Error Sending Bug Report")
|
||||
(error-sending-bug-report-expln "An error occurred when sending this bug report."
|
||||
(error-sending-bug-report-expln
|
||||
"An error occurred when sending this bug report."
|
||||
" If your internet connection is otherwise working fine, please visit:\n\n http://bugs.racket-lang.org/\n\nand"
|
||||
" submit the bug via our online web-form. Sorry for the difficulties.\n\nThe error message is:\n~a")
|
||||
(illegal-bug-report "Illegal Bug Report")
|
||||
|
|
|
|||
|
|
@ -27,19 +27,18 @@
|
|||
(hash-set! rx-keys rx (make-ephemeron rx bstr))
|
||||
rx))))
|
||||
|
||||
(define (scribble-inside-lexer orig-in offset mode)
|
||||
(let ([mode (or mode
|
||||
(define (scribble-inside-lexer orig-in offset orig-mode)
|
||||
(define mode (or orig-mode
|
||||
(list
|
||||
(make-text #rx"^@"
|
||||
#f
|
||||
#f
|
||||
#rx".*?(?:(?=[@\r\n])|$)"
|
||||
#f
|
||||
#f)))]
|
||||
[in (special-filter-input-port orig-in
|
||||
(lambda (v s)
|
||||
(bytes-set! s 0 (char->integer #\.))
|
||||
1))])
|
||||
#f))))
|
||||
(define in (special-filter-input-port
|
||||
orig-in
|
||||
(lambda (v s) (bytes-set! s 0 (char->integer #\.)) 1)))
|
||||
(let-values ([(line col pos) (port-next-location orig-in)])
|
||||
(when line
|
||||
(port-count-lines! in)))
|
||||
|
|
@ -362,7 +361,7 @@
|
|||
(enter-simple-opener (cdr mode))]
|
||||
[else
|
||||
(scribble-inside-lexer in offset (cdr mode))])]
|
||||
[else (error "bad mode")])))))
|
||||
[else (error "bad mode")]))))
|
||||
|
||||
(define (scribble-lexer in offset mode)
|
||||
(scribble-inside-lexer in offset (or mode (list (make-scheme 'many #f)))))
|
||||
|
|
|
|||
|
|
@ -57,4 +57,5 @@ begin integer p, q;
|
|||
begin y := abs(a[p, q]);
|
||||
i := p; k := q
|
||||
end
|
||||
end Absmax}))
|
||||
end Absmax
|
||||
}))
|
||||
|
|
|
|||
|
|
@ -55,7 +55,8 @@
|
|||
|
||||
(define (kill-safe-test proxy?)
|
||||
(unless (ANYFLAGS 'isora 'isdb2)
|
||||
(test-case (format "kill-safe test~a" (if proxy? " (proxy)" ""))
|
||||
(test-case
|
||||
(format "kill-safe test~a" (if proxy? " (proxy)" ""))
|
||||
(call-with-connection
|
||||
(lambda (c0)
|
||||
(let ([c (if proxy?
|
||||
|
|
|
|||
|
|
@ -233,7 +233,8 @@
|
|||
(define labels
|
||||
(let* ([all-info (call-with-input-file (build-path (collection-path "solutions")
|
||||
'up 'up "proj" "book" "solutions"
|
||||
"labels.scm") read)]
|
||||
"labels.scm")
|
||||
read)]
|
||||
[ex-labels (filter (lambda (x) (and (string=? (substring (car x) 0 3) "ex:")
|
||||
(> (string-length (car x)) 3)))
|
||||
all-info)])
|
||||
|
|
|
|||
|
|
@ -24,19 +24,13 @@
|
|||
(let ([vr (viewable-region 3 3 500 500)])
|
||||
(for ([i (in-range 4 503)])
|
||||
(check-true (in-viewable-region-horiz vr i)
|
||||
(format "~a should be in ~a"
|
||||
i
|
||||
vr)))
|
||||
(format "~a should be in ~a" i vr)))
|
||||
(for ([i (in-range 0 2)])
|
||||
(check-false (in-viewable-region-horiz vr i)
|
||||
(format "~a should not be in ~a"
|
||||
i
|
||||
vr))
|
||||
(format "~a should not be in ~a" i vr))
|
||||
(for ([i (in-range 504 1000)])
|
||||
(check-false (in-viewable-region-horiz vr i)
|
||||
(format "~a should not be in ~a"
|
||||
i
|
||||
vr)))))
|
||||
(format "~a should not be in ~a" i vr)))))
|
||||
|
||||
(let ([vr (viewable-region 0 0 732 685)])
|
||||
(check-true (in-viewable-region-horiz vr 10))
|
||||
|
|
|
|||
|
|
@ -30,16 +30,14 @@
|
|||
|
||||
; this is the same test for match-lambda
|
||||
|
||||
(mytest (letrec ((z
|
||||
(match-lambda ((a b c)
|
||||
(mytest (letrec ((z (match-lambda ((a b c)
|
||||
(if (= a 10)
|
||||
(list a b c)
|
||||
(cons a (z (list (add1 a) 2 3))))))))
|
||||
(z '(1 2 3)))
|
||||
'(1 2 3 4 5 6 7 8 9 10 2 3))
|
||||
|
||||
(mytest (letrec ((z
|
||||
(match-lambda* ((a b c)
|
||||
(mytest (letrec ((z (match-lambda* ((a b c)
|
||||
(if (= a 10)
|
||||
(list a b c)
|
||||
(cons a (z (add1 a) 2 3)))))))
|
||||
|
|
@ -145,8 +143,7 @@
|
|||
|
||||
; this is some thing that I missed before
|
||||
|
||||
(mytest (match '((1) (2) (3))
|
||||
(((_) ...) 'hey))
|
||||
(mytest (match '((1) (2) (3)) (((_) ...) 'hey))
|
||||
'hey)
|
||||
|
||||
; failure tests
|
||||
|
|
@ -167,7 +164,6 @@
|
|||
|
||||
|
||||
|
||||
|
||||
; set! tests
|
||||
|
||||
; set! for lists
|
||||
|
|
@ -231,34 +227,29 @@
|
|||
;; set! for vectors
|
||||
|
||||
(mytest (let ((x (vector 1 2)))
|
||||
(match x
|
||||
(#(_ (set! set-it)) (set-it 17)))
|
||||
(match x (#(_ (set! set-it)) (set-it 17)))
|
||||
x)
|
||||
#(1 17))
|
||||
|
||||
(mytest (let ((x (vector 1 2)))
|
||||
(match x
|
||||
(#((set! set-it) _) (set-it 17)))
|
||||
(match x (#((set! set-it) _) (set-it 17)))
|
||||
x)
|
||||
#(17 2))
|
||||
|
||||
;; set! for boxes
|
||||
|
||||
(mytest (let ((x (box 1)))
|
||||
(match x
|
||||
(#&(set! set-it) (set-it 17)))
|
||||
(match x (#&(set! set-it) (set-it 17)))
|
||||
x)
|
||||
#&17)
|
||||
#;
|
||||
(mytest (let ((x #&(1 2)))
|
||||
(match x
|
||||
(#&(_ (set! set-it)) (set-it 17)))
|
||||
(match x (#&(_ (set! set-it)) (set-it 17)))
|
||||
x)
|
||||
#&(1 17))
|
||||
|
||||
(mytest (let ((x (box (vector 1 2))))
|
||||
(match x
|
||||
(#&#(_ (set! set-it)) (set-it 17)))
|
||||
(match x (#&#(_ (set! set-it)) (set-it 17)))
|
||||
x)
|
||||
#&#(1 17))
|
||||
|
||||
|
|
@ -268,133 +259,98 @@
|
|||
; get! for lists
|
||||
#|
|
||||
(mytest (let* ((x '(1 2 (3 4)))
|
||||
(f
|
||||
(match x
|
||||
((_ _ ((get! get-it) _)) get-it))))
|
||||
(match x
|
||||
((_ _ ((set! set-it) _)) (set-it 17)))
|
||||
(f)) 17)
|
||||
(f (match x ((_ _ ((get! get-it) _)) get-it))))
|
||||
(match x ((_ _ ((set! set-it) _)) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x '(1 2 (3 4)))
|
||||
(f
|
||||
(match x
|
||||
((_ _ (_ (get! get-it))) get-it))))
|
||||
(match x
|
||||
((_ _ (_ (set! set-it))) (set-it 17)))
|
||||
(f)) 17)
|
||||
(f (match x ((_ _ (_ (get! get-it))) get-it))))
|
||||
(match x ((_ _ (_ (set! set-it))) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x '(1 2 (3 4)))
|
||||
(f
|
||||
(match x
|
||||
(((get! get-it) _ (_ _)) get-it))))
|
||||
(match x
|
||||
(((set! set-it) _ (_ _)) (set-it 17)))
|
||||
(f)) 17)
|
||||
|
||||
(f (match x (((get! get-it) _ (_ _)) get-it))))
|
||||
(match x (((set! set-it) _ (_ _)) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x '(1 2 (3 4)))
|
||||
(f
|
||||
(match x
|
||||
((_ (get! get-it) (_ _)) get-it))))
|
||||
(match x
|
||||
((_ (set! set-it) (_ _)) (set-it 17)))
|
||||
(f)) 17)
|
||||
(f (match x ((_ (get! get-it) (_ _)) get-it))))
|
||||
(match x ((_ (set! set-it) (_ _)) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
|
||||
;get! for improper lists
|
||||
|
||||
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
||||
(f
|
||||
(match x
|
||||
(((get! get-it) _ (_ . _) . _) get-it))))
|
||||
(match x
|
||||
(((set! set-it) _ (_ . _) . _) (set-it 17)))
|
||||
(f)) 17)
|
||||
|
||||
(f (match x (((get! get-it) _ (_ . _) . _) get-it))))
|
||||
(match x (((set! set-it) _ (_ . _) . _) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
||||
(f
|
||||
(match x
|
||||
((_ (get! get-it) (_ . _) . _) get-it))))
|
||||
(match x
|
||||
((_ (set! set-it) (_ . _) . _) (set-it 17)))
|
||||
(f)) 17)
|
||||
|
||||
(f (match x ((_ (get! get-it) (_ . _) . _) get-it))))
|
||||
(match x ((_ (set! set-it) (_ . _) . _) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
||||
(f
|
||||
(match x
|
||||
((_ _ ((get! get-it) . _) . _) get-it))))
|
||||
(match x
|
||||
((_ _ ((set! set-it) . _) . _) (set-it 17)))
|
||||
(f)) 17)
|
||||
|
||||
(f (match x ((_ _ ((get! get-it) . _) . _) get-it))))
|
||||
(match x ((_ _ ((set! set-it) . _) . _) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
||||
(f
|
||||
(match x
|
||||
((_ _ (_ . (get! get-it)) . _) get-it))))
|
||||
(match x
|
||||
((_ _ (_ . (set! set-it)) . _) (set-it 17)))
|
||||
(f)) 17)
|
||||
|
||||
(f (match x ((_ _ (_ . (get! get-it)) . _) get-it))))
|
||||
(match x ((_ _ (_ . (set! set-it)) . _) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
||||
(f
|
||||
(match x
|
||||
((_ _ (_ . _) . (get! get-it)) get-it))))
|
||||
(match x
|
||||
((_ _ (_ . _) . (set! set-it)) (set-it 17)))
|
||||
(f)) 17)
|
||||
(f (match x ((_ _ (_ . _) . (get! get-it)) get-it))))
|
||||
(match x ((_ _ (_ . _) . (set! set-it)) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
|#
|
||||
;; get! for vectors
|
||||
|
||||
(mytest (let* ((x (vector 1 2))
|
||||
(f
|
||||
(match x
|
||||
(#(_ (get! get-it)) get-it))))
|
||||
(match x
|
||||
(#(_ (set! set-it)) (set-it 17)))
|
||||
(f)) 17)
|
||||
|
||||
(f (match x (#(_ (get! get-it)) get-it))))
|
||||
(match x (#(_ (set! set-it)) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x (vector 1 2))
|
||||
(f
|
||||
(match x
|
||||
(#((get! get-it) _) get-it))))
|
||||
(match x
|
||||
(#((set! set-it) _) (set-it 17)))
|
||||
(f)) 17)
|
||||
(f (match x (#((get! get-it) _) get-it))))
|
||||
(match x (#((set! set-it) _) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
|
||||
;; get! for boxes
|
||||
|
||||
(mytest (let* ((x (box 1))
|
||||
(f
|
||||
(match x
|
||||
(#&(get! get-it) get-it))))
|
||||
(match x
|
||||
(#&(set! set-it) (set-it 17)))
|
||||
(f)) 17)
|
||||
(f (match x (#&(get! get-it) get-it))))
|
||||
(match x (#&(set! set-it) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
#;
|
||||
(mytest (let* ((x #&(1 2))
|
||||
(f
|
||||
(match x
|
||||
(#&(_ (get! get-it)) get-it))))
|
||||
(match x
|
||||
(#&(_ (set! set-it)) (set-it 17)))
|
||||
(f)) 17)
|
||||
|
||||
(f (match x (#&(_ (get! get-it)) get-it))))
|
||||
(match x (#&(_ (set! set-it)) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
(mytest (let* ((x (box (vector 1 2)))
|
||||
(f
|
||||
(match x
|
||||
(#&#(_ (get! get-it)) get-it))))
|
||||
(match x
|
||||
(#&#(_ (set! set-it)) (set-it 17)))
|
||||
(f)) 17)
|
||||
(f (match x (#&#(_ (get! get-it)) get-it))))
|
||||
(match x (#&#(_ (set! set-it)) (set-it 17)))
|
||||
(f))
|
||||
17)
|
||||
|
||||
|
||||
|#
|
||||
|
|
@ -441,166 +397,34 @@
|
|||
(`#&(c a b ,@(a b c) r f i) (list a b c)))
|
||||
'(1 2 3))
|
||||
|
||||
(mytest (match (list
|
||||
"hi"
|
||||
1
|
||||
'there
|
||||
#\c
|
||||
#t
|
||||
#f
|
||||
'(a b c)
|
||||
'(a b . c)
|
||||
'(a b c c c c)
|
||||
#(a b c)
|
||||
#(a b c c c c)
|
||||
#&(a b c)
|
||||
'(1 2 3)
|
||||
'(4 5 . 6)
|
||||
'(7 8 9)
|
||||
#(10 11 12)
|
||||
#&(13 14 15 16)
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
17
|
||||
)
|
||||
(`(
|
||||
"hi"
|
||||
1
|
||||
there
|
||||
#\c
|
||||
#t
|
||||
#f
|
||||
(a b c)
|
||||
(a b . c)
|
||||
(a b c ..2)
|
||||
#(a b c)
|
||||
#(a b c ..2)
|
||||
#&(a b c)
|
||||
,(a b c)
|
||||
,(c1 d . e)
|
||||
,(f g h ...)
|
||||
,#(i j k)
|
||||
,#&(l m n o)
|
||||
,@(1 2 3 4 p)
|
||||
)
|
||||
(list
|
||||
a b c
|
||||
c1 d e
|
||||
f g h
|
||||
i j k
|
||||
l m n o
|
||||
p
|
||||
)))
|
||||
(mytest (match (list "hi" 1 'there #\c #t #f '(a b c) '(a b . c)
|
||||
'(a b c c c c) #(a b c) #(a b c c c c) #&(a b c)
|
||||
'(1 2 3) '(4 5 . 6) '(7 8 9) #(10 11 12) #&(13 14 15 16)
|
||||
1 2 3 4 17)
|
||||
(`("hi" 1 there #\c #t #f (a b c) (a b . c) (a b c ..2) #(a b c)
|
||||
#(a b c ..2) #&(a b c) ,(a b c) ,(c1 d . e) ,(f g h ...)
|
||||
,#(i j k) ,#&(l m n o) ,@(1 2 3 4 p))
|
||||
(list a b c c1 d e f g h i j k l m n o p)))
|
||||
'(1 2 3 4 5 6 7 8 (9) 10 11 12 13 14 15 16 17))
|
||||
|
||||
(mytest (match (vector
|
||||
"hi"
|
||||
1
|
||||
'there
|
||||
#\c
|
||||
#t
|
||||
#f
|
||||
'(a b c)
|
||||
'(a b . c)
|
||||
'(a b c c c c)
|
||||
#(a b c)
|
||||
#(a b c c c c)
|
||||
#&(a b c)
|
||||
'(1 2 3)
|
||||
'(4 5 . 6)
|
||||
'(7 8 9)
|
||||
#(10 11 12)
|
||||
#&(13 14 15 16)
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
17
|
||||
)
|
||||
(`#(
|
||||
"hi"
|
||||
1
|
||||
there
|
||||
#\c
|
||||
#t
|
||||
#f
|
||||
(a b c)
|
||||
(a b . c)
|
||||
(a b c ..2)
|
||||
#(a b c)
|
||||
#(a b c ..2)
|
||||
#&(a b c)
|
||||
,(a b c)
|
||||
,(c1 d . e)
|
||||
,(f g h ...)
|
||||
,#(i j k)
|
||||
,#&(l m n o)
|
||||
,@(1 2 3 4 p)
|
||||
)
|
||||
(list
|
||||
a b c
|
||||
c1 d e
|
||||
f g h
|
||||
i j k
|
||||
l m n o
|
||||
p
|
||||
)))
|
||||
(mytest (match (vector "hi" 1 'there #\c #t #f '(a b c) '(a b . c)
|
||||
'(a b c c c c) #(a b c) #(a b c c c c) #&(a b c)
|
||||
'(1 2 3) '(4 5 . 6) '(7 8 9) #(10 11 12)
|
||||
#&(13 14 15 16) 1 2 3 4 17)
|
||||
(`#("hi" 1 there #\c #t #f (a b c) (a b . c) (a b c ..2) #(a b c)
|
||||
#(a b c ..2) #&(a b c) ,(a b c) ,(c1 d . e) ,(f g h ...)
|
||||
,#(i j k) ,#&(l m n o) ,@(1 2 3 4 p))
|
||||
(list a b c c1 d e f g h i j k l m n o p)))
|
||||
'(1 2 3 4 5 6 7 8 (9) 10 11 12 13 14 15 16 17))
|
||||
|
||||
(mytest (match (box (list
|
||||
"hi"
|
||||
1
|
||||
'there
|
||||
#\c
|
||||
#t
|
||||
#f
|
||||
'(a b c)
|
||||
'(a b . c)
|
||||
'(a b c c c c)
|
||||
#(a b c)
|
||||
#(a b c c c c)
|
||||
#&(a b c)
|
||||
'(1 2 3)
|
||||
'(4 5 . 6)
|
||||
'(7 8 9)
|
||||
#(10 11 12)
|
||||
#&(13 14 15 16)
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
17
|
||||
))
|
||||
(`#&(
|
||||
"hi"
|
||||
1
|
||||
there
|
||||
#\c
|
||||
#t
|
||||
#f
|
||||
(a b c)
|
||||
(a b . c)
|
||||
(a b c ..2)
|
||||
#(a b c)
|
||||
#(a b c ..2)
|
||||
#&(a b c)
|
||||
,(a b c)
|
||||
,(c1 d . e)
|
||||
,(f g h ...)
|
||||
,#(i j k)
|
||||
,#&(l m n o)
|
||||
,@(1 2 3 4 p)
|
||||
)
|
||||
(list
|
||||
a b c
|
||||
c1 d e
|
||||
f g h
|
||||
i j k
|
||||
l m n o
|
||||
p
|
||||
)))
|
||||
(mytest (match (box (list "hi" 1 'there #\c #t #f '(a b c) '(a b . c)
|
||||
'(a b c c c c) #(a b c) #(a b c c c c) #&(a b c)
|
||||
'(1 2 3) '(4 5 . 6) '(7 8 9) #(10 11 12)
|
||||
#&(13 14 15 16) 1 2 3 4 17))
|
||||
(`#&("hi" 1 there #\c #t #f (a b c) (a b . c) (a b c ..2) #(a b c)
|
||||
#(a b c ..2) #&(a b c) ,(a b c) ,(c1 d . e) ,(f g h ...)
|
||||
,#(i j k) ,#&(l m n o) ,@(1 2 3 4 p))
|
||||
(list a b c c1 d e f g h i j k l m n o p)))
|
||||
'(1 2 3 4 5 6 7 8 (9) 10 11 12 13 14 15 16 17))
|
||||
|
||||
(mytest (match '(1 2 3 4)
|
||||
|
|
@ -629,7 +453,6 @@
|
|||
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))))
|
||||
|
||||
|
||||
|
||||
(mytest (match #(#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
||||
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8)))))
|
||||
#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
||||
|
|
|
|||
|
|
@ -11,13 +11,15 @@
|
|||
(fprintf out "~a" txt))))
|
||||
|
||||
(define (print-out msg B/sE)
|
||||
(displayln (list msg
|
||||
(displayln
|
||||
(list msg
|
||||
(exact->inexact B/sE) 'bytes-per-second
|
||||
(exact->inexact (/ B/sE (* 1024 1024))) 'MB-per-second)))
|
||||
(exact->inexact (/ B/sE (* 1024 1024)))
|
||||
'MB-per-second)))
|
||||
|
||||
(define (processes-byte-message-test)
|
||||
(let ([pl
|
||||
(pp:place/base (bo ch)
|
||||
(let ([pl (pp:place/base
|
||||
(bo ch)
|
||||
(define message-size (* 4024 1024))
|
||||
(define count 10)
|
||||
(define fourk-b-message (make-bytes message-size 66))
|
||||
|
|
@ -29,7 +31,8 @@
|
|||
(define four-k-message (make-bytes message-size 65))
|
||||
(define count 10)
|
||||
(define-values (r t1 t2 t3)
|
||||
(time-apply (lambda ()
|
||||
(time-apply
|
||||
(lambda ()
|
||||
(for ([i (in-range count)])
|
||||
(pp:place-channel-put pl four-k-message)
|
||||
(pp:place-channel-get pl))) null))
|
||||
|
|
@ -62,7 +65,8 @@ END
|
|||
(define four-k-message (make-bytes message-size 65))
|
||||
(define count 150)
|
||||
(define-values (r t1 t2 t3)
|
||||
(time-apply (lambda ()
|
||||
(time-apply
|
||||
(lambda ()
|
||||
(for ([i (in-range count)])
|
||||
(place-channel-put pl four-k-message)
|
||||
(place-channel-get pl))) null))
|
||||
|
|
@ -87,13 +91,15 @@ END
|
|||
"pct1.rkt")
|
||||
|
||||
(let ([pl (dynamic-place "pct1.rkt" 'place-main)])
|
||||
(define tree (let loop ([depth 8])
|
||||
(define tree
|
||||
(let loop ([depth 8])
|
||||
(if (depth . <= . 0)
|
||||
1
|
||||
(cons (loop (sub1 depth)) (loop (sub1 depth))))))
|
||||
(define count 500)
|
||||
(define-values (r t1 t2 t3)
|
||||
(time-apply (lambda ()
|
||||
(time-apply
|
||||
(lambda ()
|
||||
(for ([i (in-range count)])
|
||||
(place-channel-put pl tree)
|
||||
(place-channel-get pl))) null))
|
||||
|
|
|
|||
|
|
@ -164,9 +164,12 @@
|
|||
(syntax-case stx ()
|
||||
[(_ lst (name listvar) body ...)
|
||||
#'(begin
|
||||
(define places (for/list ([i (in-range (processor-count))])
|
||||
(define places
|
||||
(for/list ([i (in-range (processor-count))])
|
||||
(place/lambda (name ch)
|
||||
(place-channel-put ch ((lambda (listvar) body ...) (place-channel-get ch))))))
|
||||
(place-channel-put ch
|
||||
((lambda (listvar) body ...)
|
||||
(place-channel-get ch))))))
|
||||
|
||||
(for ([p places]
|
||||
[item (split-n (processor-count) lst)])
|
||||
|
|
|
|||
|
|
@ -63,11 +63,8 @@
|
|||
(define-syntax (time-n stx)
|
||||
(syntax-case stx ()
|
||||
[(_ msg cnt body ...)
|
||||
#'(let-values ([(r ct rt gct) (time-apply
|
||||
(lambda ()
|
||||
body ...
|
||||
)
|
||||
null)])
|
||||
#'(let-values ([(r ct rt gct)
|
||||
(time-apply (lambda () body ...) null)])
|
||||
(displayln (list msg cnt ct rt gct))
|
||||
(if (pair? r) (car r) r))
|
||||
#|
|
||||
|
|
|
|||
|
|
@ -10,31 +10,28 @@
|
|||
(check-equal? (matches-arity-exactly? (λ (x y) x) 2 3 '() '()) #f)
|
||||
(check-equal? (matches-arity-exactly? (λ (x y) x) 3 #f '() '()) #f)
|
||||
|
||||
(check-equal? (matches-arity-exactly? (case-lambda
|
||||
[() 1]
|
||||
[(x) 2])
|
||||
0 1 '() '()) #t)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda
|
||||
[() 1]
|
||||
[(x) 2])
|
||||
0 2 '() '()) #f)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda
|
||||
[() 1]
|
||||
[(x y) 2])
|
||||
0 2 '() '()) #f)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda
|
||||
[() 1]
|
||||
[(x y) 2])
|
||||
0 1 '() '()) #f)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda
|
||||
[() 1]
|
||||
[(x y) 2])
|
||||
0 #f '() '()) #f)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda [() 1] [(x) 2])
|
||||
0 1 '() '())
|
||||
#t)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda [() 1] [(x) 2])
|
||||
0 2 '() '())
|
||||
#f)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda [() 1] [(x y) 2])
|
||||
0 2 '() '())
|
||||
#f)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda [() 1] [(x y) 2])
|
||||
0 1 '() '())
|
||||
#f)
|
||||
(check-equal? (matches-arity-exactly? (case-lambda [() 1] [(x y) 2])
|
||||
0 #f '() '())
|
||||
#f)
|
||||
|
||||
(check-equal? (matches-arity-exactly? (lambda (x . y) x)
|
||||
1 #f '() '()) #t)
|
||||
1 #f '() '())
|
||||
#t)
|
||||
(check-equal? (matches-arity-exactly? (lambda (x . y) x)
|
||||
0 #f '() '()) #f)
|
||||
0 #f '() '())
|
||||
#f)
|
||||
(check-equal? (matches-arity-exactly? (lambda (x #:y y) y)
|
||||
1 1 '(#:y) '())
|
||||
#t)
|
||||
|
|
@ -68,4 +65,3 @@
|
|||
(check-equal? (matches-arity-exactly? (lambda (x #:y y #:z [z 1]) y)
|
||||
1 1 '() '(#:y #:z))
|
||||
#f)
|
||||
|
||||
|
|
|
|||
|
|
@ -64,7 +64,8 @@
|
|||
|
||||
(write-string "Hello\n" o)
|
||||
(close-output-port o)
|
||||
(with-input-from-file "test1" (lambda ()
|
||||
(with-input-from-file "test1"
|
||||
(lambda ()
|
||||
(check-equal? (port->string) "Hello\nBye\nHello\n" "output file contents match")))
|
||||
|
||||
(define o2 (open-output-file "test1" #:exists 'replace))
|
||||
|
|
@ -76,7 +77,8 @@
|
|||
|
||||
(write-string "HELLO\n" o2)
|
||||
(close-output-port o2)
|
||||
(with-input-from-file "test1" (lambda ()
|
||||
(with-input-from-file "test1"
|
||||
(lambda ()
|
||||
(check-equal? (port->string) "HELLO\nBYE\nHELLO\n" "output file contents match")))
|
||||
|
||||
(define i2 (open-input-file "test2"))
|
||||
|
|
|
|||
|
|
@ -8,6 +8,6 @@
|
|||
(: make-empty-env (case-lambda [-> Environment]
|
||||
[Environment -> Environment]))
|
||||
(define make-empty-env
|
||||
(case-lambda: [() (make-Environment #f (make-hasheq))]
|
||||
[((parent : Environment)) (make-Environment parent
|
||||
(make-hasheq))]))
|
||||
(case-lambda:
|
||||
[() (make-Environment #f (make-hasheq))]
|
||||
[((parent : Environment)) (make-Environment parent (make-hasheq))]))
|
||||
|
|
|
|||
|
|
@ -473,9 +473,8 @@
|
|||
;thread-suspend-evt
|
||||
|
||||
;Section 10.1.4
|
||||
[thread-send (-poly (a)
|
||||
(cl->*
|
||||
(-> -Thread Univ -Void)
|
||||
[thread-send
|
||||
(-poly (a) (cl->* (-> -Thread Univ -Void)
|
||||
(-> -Thread Univ (-val #f) (-opt -Void))
|
||||
(-> -Thread Univ (-> a) (Un -Void a))))]
|
||||
[thread-receive (-> Univ)]
|
||||
|
|
@ -552,7 +551,8 @@
|
|||
[char-whitespace? (-> -Char B)]
|
||||
[char-blank? (-> -Char B)]
|
||||
[char-iso-control? (-> -Char B)]
|
||||
[char-general-category (-> -Char (apply Un (map -val
|
||||
[char-general-category
|
||||
(-> -Char (apply Un (map -val
|
||||
'(lu ll lt lm lo mn mc me nd nl no ps pe pi pf pd
|
||||
pc po sc sm sk so zs zp zl cc cf cs co cn))))]
|
||||
[make-known-char-range-list (-> (-lst (-Tuple (list -PosInt -PosInt B))))]
|
||||
|
|
@ -823,7 +823,8 @@
|
|||
|
||||
|
||||
|
||||
[build-path (cl->*
|
||||
[build-path
|
||||
(cl->*
|
||||
((list -Pathlike*) -Pathlike* . ->* . -Path)
|
||||
((list -SomeSystemPathlike*) -SomeSystemPathlike* . ->* . -SomeSystemPath))]
|
||||
[build-path/convention-type
|
||||
|
|
@ -1661,8 +1662,7 @@
|
|||
|
||||
[process (-> -String
|
||||
(-values (list -Input-Port -Output-Port -Nat -Input-Port
|
||||
(cl->*
|
||||
(-> (-val 'status) (one-of/c 'running 'done-ok 'done-error))
|
||||
(cl->* (-> (-val 'status) (one-of/c 'running 'done-ok 'done-error))
|
||||
(-> (-val 'exit-code) (-opt -Byte))
|
||||
(-> (-val 'wait) ManyUniv)
|
||||
(-> (-val 'interrupt) -Void)
|
||||
|
|
@ -1673,16 +1673,14 @@
|
|||
(cl->*
|
||||
(->* (list -Pathlike) (Un -Path -String -Bytes)
|
||||
(-values (list -Input-Port -Output-Port -Nat -Input-Port
|
||||
(cl->*
|
||||
(-> (-val 'status) (one-of/c 'running 'done-ok 'done-error))
|
||||
(cl->* (-> (-val 'status) (one-of/c 'running 'done-ok 'done-error))
|
||||
(-> (-val 'exit-code) (-opt -Byte))
|
||||
(-> (-val 'wait) ManyUniv)
|
||||
(-> (-val 'interrupt) -Void)
|
||||
(-> (-val 'kill) -Void)))))
|
||||
(-> -Pathlike (-val 'exact) -String
|
||||
(-values (list -Input-Port -Output-Port -Nat -Input-Port
|
||||
(cl->*
|
||||
(-> (-val 'status) (one-of/c 'running 'done-ok 'done-error))
|
||||
(cl->* (-> (-val 'status) (one-of/c 'running 'done-ok 'done-error))
|
||||
(-> (-val 'exit-code) (-opt -Byte))
|
||||
(-> (-val 'wait) ManyUniv)
|
||||
(-> (-val 'interrupt) -Void)
|
||||
|
|
|
|||
|
|
@ -49,7 +49,8 @@
|
|||
(syntax-parse stx
|
||||
[(require/contract nm:renameable hidden:id cnt lib)
|
||||
#`(begin (require (only-in lib [nm.orig-nm nm.orig-nm-r]))
|
||||
(define-syntax nm.nm (make-rename-transformer
|
||||
(define-syntax nm.nm
|
||||
(make-rename-transformer
|
||||
(syntax-property (syntax-property (quote-syntax hidden)
|
||||
'not-free-identifier=? #t)
|
||||
'not-provide-all-defined #t)))
|
||||
|
|
|
|||
|
|
@ -9,8 +9,7 @@
|
|||
(provide call ret with-monitor label
|
||||
re->monitor-predicate/concurrent
|
||||
re->monitor-predicate/serial
|
||||
(all-from-out
|
||||
"monitor.rkt"
|
||||
(all-from-out "monitor.rkt"
|
||||
unstable/automata/re
|
||||
unstable/automata/re-ext))
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,8 @@
|
|||
racket/contract)
|
||||
|
||||
(provide/contract
|
||||
[make-cookie ((cookie-name? cookie-value?) (#:comment (or/c false/c string?)
|
||||
[make-cookie ((cookie-name? cookie-value?)
|
||||
(#:comment (or/c false/c string?)
|
||||
#:domain (or/c false/c valid-domain?)
|
||||
#:max-age (or/c false/c exact-nonnegative-integer?)
|
||||
#:path (or/c false/c string?)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user