More "~n" -> "\n" changes
This commit is contained in:
parent
2853020369
commit
8e0f8dd39c
|
@ -614,7 +614,7 @@
|
||||||
(loop)]
|
(loop)]
|
||||||
[msg
|
[msg
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"frtime engine: msg not understood: ~a~n"
|
"frtime engine: msg not understood: ~a\n"
|
||||||
msg)
|
msg)
|
||||||
(loop)]))
|
(loop)]))
|
||||||
|
|
||||||
|
|
|
@ -287,7 +287,7 @@
|
||||||
(if (<= input test)
|
(if (<= input test)
|
||||||
'input-smaller
|
'input-smaller
|
||||||
'test-smaller)))]))])
|
'test-smaller)))]))])
|
||||||
; (printf "~a ~a ~a~n" compare secs (date->string date))
|
; (printf "~a ~a ~a\n" compare secs (date->string date))
|
||||||
(cond
|
(cond
|
||||||
[(eq? compare 'equal) secs]
|
[(eq? compare 'equal) secs]
|
||||||
[(or (= secs below-secs) (= secs above-secs))
|
[(or (= secs below-secs) (= secs above-secs))
|
||||||
|
|
|
@ -95,7 +95,7 @@
|
||||||
(label "Check3")))
|
(label "Check3")))
|
||||||
|
|
||||||
; get the streams from the check boxes
|
; get the streams from the check boxes
|
||||||
(printf "callbacks->args-evts:~n")
|
(printf "callbacks->args-evts:\n")
|
||||||
(send my-cb1 get-focus-events)
|
(send my-cb1 get-focus-events)
|
||||||
(send my-cb2 get-focus-events)
|
(send my-cb2 get-focus-events)
|
||||||
(send my-cb3 get-focus-events)
|
(send my-cb3 get-focus-events)
|
||||||
|
@ -143,7 +143,7 @@
|
||||||
(map-e car es)))
|
(map-e car es)))
|
||||||
(label "Check4")))
|
(label "Check4")))
|
||||||
|
|
||||||
(printf "mixin-merge-e:~n")
|
(printf "mixin-merge-e:\n")
|
||||||
|
|
||||||
(send my-cb4 get-focus-events) ; focus-events
|
(send my-cb4 get-focus-events) ; focus-events
|
||||||
(send my-cb4 get-key-events) ; key-events
|
(send my-cb4 get-key-events) ; key-events
|
||||||
|
|
|
@ -93,7 +93,7 @@
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(fprintf
|
(fprintf
|
||||||
(current-error-port)
|
(current-error-port)
|
||||||
"you've encountered a bug in frtime. please send a report to the Racket mailing list.~nexn: ~a~n"
|
"you've encountered a bug in frtime. please send a report to the Racket mailing list.\nexn: ~a\n"
|
||||||
e) #f)))
|
e) #f)))
|
||||||
(cond
|
(cond
|
||||||
[(memq obj mem) #f]
|
[(memq obj mem) #f]
|
||||||
|
|
|
@ -555,7 +555,7 @@
|
||||||
[proc-k (lambda (evt) (proc emit suspend evt) (set! proc-k #f))])
|
[proc-k (lambda (evt) (proc emit suspend evt) (set! proc-k #f))])
|
||||||
(let ([thunk (lambda ()
|
(let ([thunk (lambda ()
|
||||||
(when (ormap undefined? streams)
|
(when (ormap undefined? streams)
|
||||||
;(fprintf (current-error-port) "had an undefined stream~n")
|
;(fprintf (current-error-port) "had an undefined stream\n")
|
||||||
(set! streams (fix-streams streams args)))
|
(set! streams (fix-streams streams args)))
|
||||||
(let loop ([streams streams])
|
(let loop ([streams streams])
|
||||||
(extract (lambda (the-event strs)
|
(extract (lambda (the-event strs)
|
||||||
|
@ -658,7 +658,7 @@
|
||||||
rtn))))
|
rtn))))
|
||||||
|
|
||||||
(define (make-mutable lst)
|
(define (make-mutable lst)
|
||||||
(printf "make-mutable called on ~a~n" lst)
|
(printf "make-mutable called on ~a\n" lst)
|
||||||
lst
|
lst
|
||||||
#;(if (pair? lst)
|
#;(if (pair? lst)
|
||||||
(mcons (first lst) (make-mutable (rest lst)))
|
(mcons (first lst) (make-mutable (rest lst)))
|
||||||
|
@ -774,7 +774,7 @@
|
||||||
(syntax->list #'(exp ...)))])
|
(syntax->list #'(exp ...)))])
|
||||||
#'(tag new-exp ...))]
|
#'(tag new-exp ...))]
|
||||||
[x (begin
|
[x (begin
|
||||||
(fprintf (current-error-port) "snapshot-unbound: fell through on ~a~n" #'x)
|
(fprintf (current-error-port) "snapshot-unbound: fell through on ~a\n" #'x)
|
||||||
'())])
|
'())])
|
||||||
expr insp #f))))
|
expr insp #f))))
|
||||||
|
|
||||||
|
@ -793,7 +793,7 @@
|
||||||
[(free-var ...) (hash-map unbound-ids
|
[(free-var ...) (hash-map unbound-ids
|
||||||
(lambda (k v) k))])
|
(lambda (k v) k))])
|
||||||
(begin
|
(begin
|
||||||
;(printf "~a~n" unbound-ids)
|
;(printf "~a\n" unbound-ids)
|
||||||
#'(if (ormap behavior? (list free-var ...))
|
#'(if (ormap behavior? (list free-var ...))
|
||||||
(procs->signal:compound (lambda _
|
(procs->signal:compound (lambda _
|
||||||
(lambda (id ...)
|
(lambda (id ...)
|
||||||
|
|
|
@ -47,7 +47,7 @@
|
||||||
;; from getting too big.
|
;; from getting too big.
|
||||||
(set! cnt 0)
|
(set! cnt 0)
|
||||||
(set! search (mk-search)))
|
(set! search (mk-search)))
|
||||||
(printf "------------~n~a~n" (board->string depth board))
|
(printf "------------\n~a\n" (board->string depth board))
|
||||||
(cond
|
(cond
|
||||||
[(winner? board 'red) 0]
|
[(winner? board 'red) 0]
|
||||||
[(winner? board 'yellow)
|
[(winner? board 'yellow)
|
||||||
|
@ -112,6 +112,6 @@
|
||||||
(hash-table-for-each move-map
|
(hash-table-for-each move-map
|
||||||
(lambda (k v)
|
(lambda (k v)
|
||||||
(when (> (list-ref v 3) 1)
|
(when (> (list-ref v 3) 1)
|
||||||
(printf "~s~n" (cons k v)))))))
|
(printf "~s\n" (cons k v)))))))
|
||||||
CONFIG EXPLORE MODEL HEURISTICS)])
|
CONFIG EXPLORE MODEL HEURISTICS)])
|
||||||
(export))))
|
(export))))
|
||||||
|
|
|
@ -92,7 +92,7 @@
|
||||||
0 ; indent
|
0 ; indent
|
||||||
init-memory
|
init-memory
|
||||||
me board)])
|
me board)])
|
||||||
(log-printf 1 0 "> ~a/~a Result: ~a~n"
|
(log-printf 1 0 "> ~a/~a Result: ~a\n"
|
||||||
steps (min max-depth one-step-depth)
|
steps (min max-depth one-step-depth)
|
||||||
(play->string v))
|
(play->string v))
|
||||||
v))
|
v))
|
||||||
|
@ -471,7 +471,7 @@
|
||||||
(set! explore-count 0)
|
(set! explore-count 0)
|
||||||
(set! enter-count 0)
|
(set! enter-count 0)
|
||||||
(set! move-count 0)
|
(set! move-count 0)
|
||||||
(log-printf 1 indent "~a> ~a Exploring for ~a~n" (make-string indent #\space) steps me)
|
(log-printf 1 indent "~a> ~a Exploring for ~a\n" (make-string indent #\space) steps me)
|
||||||
(let-values ([(vs xform)
|
(let-values ([(vs xform)
|
||||||
(minmax 0
|
(minmax 0
|
||||||
(if (or (steps . <= . 1) first-move?)
|
(if (or (steps . <= . 1) first-move?)
|
||||||
|
@ -480,7 +480,7 @@
|
||||||
config
|
config
|
||||||
me
|
me
|
||||||
board #f #f)])
|
board #f #f)])
|
||||||
(log-printf 2 indent "~a>> Done ~a ~a ~a ~a+~a [~a secs]~n"
|
(log-printf 2 indent "~a>> Done ~a ~a ~a ~a+~a [~a secs]\n"
|
||||||
(make-string indent #\space)
|
(make-string indent #\space)
|
||||||
hit-count depth-count explore-count enter-count move-count
|
hit-count depth-count explore-count enter-count move-count
|
||||||
(float->string (/ (- (current-inexact-milliseconds) now) 1000)))
|
(float->string (/ (- (current-inexact-milliseconds) now) 1000)))
|
||||||
|
@ -559,7 +559,7 @@
|
||||||
(with-output-to-file MEMORY-FILE
|
(with-output-to-file MEMORY-FILE
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ([m (cdar plays)])
|
(let ([m (cdar plays)])
|
||||||
(printf "(~a ~a ~a)~n#|~n~a|#~n"
|
(printf "(~a ~a ~a)\n#|\n~a|#\n"
|
||||||
(if (found-win? plays) 'win 'lose)
|
(if (found-win? plays) 'win 'lose)
|
||||||
(car board-key+xform)
|
(car board-key+xform)
|
||||||
(list
|
(list
|
||||||
|
@ -620,10 +620,10 @@
|
||||||
|
|
||||||
(define (show-recur sz from-i from-j to-i to-j sv)
|
(define (show-recur sz from-i from-j to-i to-j sv)
|
||||||
(if (not (plan? (cdar sv)))
|
(if (not (plan? (cdar sv)))
|
||||||
(printf " Recur ~a (~a,~a)->(~a,~a) ; ??? = ~a/~a~n"
|
(printf " Recur ~a (~a,~a)->(~a,~a) ; ??? = ~a/~a\n"
|
||||||
sz from-i from-j to-i to-j
|
sz from-i from-j to-i to-j
|
||||||
(caar sv) (get-depth (car sv)))
|
(caar sv) (get-depth (car sv)))
|
||||||
(printf " Recur ~a (~a,~a)->(~a,~a) ; (~a,~a)->(~a,~a) = ~a/~a~n"
|
(printf " Recur ~a (~a,~a)->(~a,~a) ; (~a,~a)->(~a,~a) = ~a/~a\n"
|
||||||
sz from-i from-j to-i to-j
|
sz from-i from-j to-i to-j
|
||||||
(plan-from-i (cdar sv)) (plan-from-j (cdar sv))
|
(plan-from-i (cdar sv)) (plan-from-j (cdar sv))
|
||||||
(plan-to-i (cdar sv)) (plan-to-j (cdar sv))
|
(plan-to-i (cdar sv)) (plan-to-j (cdar sv))
|
||||||
|
|
|
@ -202,7 +202,7 @@
|
||||||
[three-red-board (move two-red-board (cadr red-pieces) #f #f 1 1 values void)])
|
[three-red-board (move two-red-board (cadr red-pieces) #f #f 1 1 values void)])
|
||||||
(define (test x y)
|
(define (test x y)
|
||||||
(unless (equal? x y)
|
(unless (equal? x y)
|
||||||
(error 'test "failure!: ~s ~s~n" x y)))
|
(error 'test "failure!: ~s ~s\n" x y)))
|
||||||
(test #f (n-in-a-row/col? 1 empty-board 0 0 'red))
|
(test #f (n-in-a-row/col? 1 empty-board 0 0 'red))
|
||||||
(test #t (n-in-a-row/col? 1 one-red-board 0 0 'red))
|
(test #t (n-in-a-row/col? 1 one-red-board 0 0 'red))
|
||||||
(test #t (n-in-a-row/col? 2 two-red-board 0 0 'red))
|
(test #t (n-in-a-row/col? 2 two-red-board 0 0 'red))
|
||||||
|
|
|
@ -57,13 +57,13 @@
|
||||||
[history null])
|
[history null])
|
||||||
(cond
|
(cond
|
||||||
[(winner? board who)
|
[(winner? board who)
|
||||||
(printf "----------- ~a wins!-------------~n~a~n" who (board->string 1 board))
|
(printf "----------- ~a wins!-------------\n~a\n" who (board->string 1 board))
|
||||||
(go)]
|
(go)]
|
||||||
[(winner? board (other who))
|
[(winner? board (other who))
|
||||||
(printf "----------- ~a wins!-------------~n~a~n" (other who) (board->string 1 board))
|
(printf "----------- ~a wins!-------------\n~a\n" (other who) (board->string 1 board))
|
||||||
(go)]
|
(go)]
|
||||||
[else
|
[else
|
||||||
(printf "~n~a moved; ~a's turn~n~a~n" who-moved who (board->string 1 board))
|
(printf "\n~a moved; ~a's turn\n~a\n" who-moved who (board->string 1 board))
|
||||||
(let ([start (current-inexact-milliseconds)]
|
(let ([start (current-inexact-milliseconds)]
|
||||||
[m ((make-search (if (= BOARD-SIZE 3)
|
[m ((make-search (if (= BOARD-SIZE 3)
|
||||||
make-3x3-rate-board
|
make-3x3-rate-board
|
||||||
|
@ -73,7 +73,7 @@
|
||||||
make-4x4-canned-moves))
|
make-4x4-canned-moves))
|
||||||
timeout steps depth
|
timeout steps depth
|
||||||
who board history)])
|
who board history)])
|
||||||
(printf "[~a secs]~n" (/ (- (current-inexact-milliseconds) start)
|
(printf "[~a secs]\n" (/ (- (current-inexact-milliseconds) start)
|
||||||
1000.0))
|
1000.0))
|
||||||
(loop (apply-play board m) (other who) who (cons board history)))])))))
|
(loop (apply-play board m) (other who) who (cons board history)))])))))
|
||||||
CONFIG EXPLORE MODEL HEURISTICS)])
|
CONFIG EXPLORE MODEL HEURISTICS)])
|
||||||
|
|
|
@ -70,7 +70,7 @@
|
||||||
;; Time test
|
;; Time test
|
||||||
(let ([start (current-inexact-milliseconds)]
|
(let ([start (current-inexact-milliseconds)]
|
||||||
[m (test-search 5 empty-board 'red null)])
|
[m (test-search 5 empty-board 'red null)])
|
||||||
(printf "[~a secs]~n" (/ (- (current-inexact-milliseconds) start)
|
(printf "[~a secs]\n" (/ (- (current-inexact-milliseconds) start)
|
||||||
1000.0))
|
1000.0))
|
||||||
))
|
))
|
||||||
CONFIG EXPLORE MODEL HEURISTICS)])
|
CONFIG EXPLORE MODEL HEURISTICS)])
|
||||||
|
|
|
@ -18,10 +18,10 @@
|
||||||
(set-failed!)
|
(set-failed!)
|
||||||
(printf " EXPECTED ~s" ex)
|
(printf " EXPECTED ~s" ex)
|
||||||
(exit))
|
(exit))
|
||||||
(printf "~n")))]))
|
(printf "\n")))]))
|
||||||
|
|
||||||
(define (report-test-results)
|
(define (report-test-results)
|
||||||
(printf (if failed?
|
(printf (if failed?
|
||||||
"~nTESTS FAILED~n"
|
"\nTESTS FAILED\n"
|
||||||
"~nAll tests passed.~n"))))
|
"\nAll tests passed.\n"))))
|
||||||
|
|
||||||
|
|
|
@ -134,7 +134,7 @@
|
||||||
[n choice])
|
[n choice])
|
||||||
(cond
|
(cond
|
||||||
[(zero? n)
|
[(zero? n)
|
||||||
;(printf "choose: ~a~n" (car choices))
|
;(printf "choose: ~a\n" (car choices))
|
||||||
(set! choice-coordinates (car choices))
|
(set! choice-coordinates (car choices))
|
||||||
(cdr choices)]
|
(cdr choices)]
|
||||||
[else (cons (car choices) (loop (cdr choices) (- n 1)))])))
|
[else (cons (car choices) (loop (cdr choices) (- n 1)))])))
|
||||||
|
|
|
@ -426,7 +426,7 @@ paint by numbers.
|
||||||
[(eq? prev WRONG-BRUSH) UNKNOWN-BRUSH]
|
[(eq? prev WRONG-BRUSH) UNKNOWN-BRUSH]
|
||||||
[else
|
[else
|
||||||
(error 'internal-error
|
(error 'internal-error
|
||||||
"unkown brush in board ~s~n" prev)]))]
|
"unkown brush in board ~s\n" prev)]))]
|
||||||
|
|
||||||
[define/private check-modifier
|
[define/private check-modifier
|
||||||
(lambda (evt)
|
(lambda (evt)
|
||||||
|
@ -741,7 +741,7 @@ paint by numbers.
|
||||||
(loop (- i 1) 0 ans)
|
(loop (- i 1) 0 ans)
|
||||||
(loop (- i 1) 0 (cons block-count ans)))]
|
(loop (- i 1) 0 (cons block-count ans)))]
|
||||||
[(on) (loop (- i 1) (+ block-count 1) ans)]
|
[(on) (loop (- i 1) (+ block-count 1) ans)]
|
||||||
[else (error 'calculate-col "unknown response from get-rect: ~a~n" this)]))])))]
|
[else (error 'calculate-col "unknown response from get-rect: ~a\n" this)]))])))]
|
||||||
|
|
||||||
[define/private calculate-col
|
[define/private calculate-col
|
||||||
(lambda (col)
|
(lambda (col)
|
||||||
|
@ -762,7 +762,7 @@ paint by numbers.
|
||||||
(let loop ([l col/row-numbers]
|
(let loop ([l col/row-numbers]
|
||||||
[n col/row])
|
[n col/row])
|
||||||
(cond
|
(cond
|
||||||
[(null? l) (error 'update-col/row "col/row too big: ~a~n" col/row)]
|
[(null? l) (error 'update-col/row "col/row too big: ~a\n" col/row)]
|
||||||
[(zero? n)
|
[(zero? n)
|
||||||
(cons (calculate-col/row col/row)
|
(cons (calculate-col/row col/row)
|
||||||
(cdr l))]
|
(cdr l))]
|
||||||
|
|
|
@ -265,8 +265,8 @@
|
||||||
(fw:gui-utils:get-choice
|
(fw:gui-utils:get-choice
|
||||||
(format "~
|
(format "~
|
||||||
Solving can be a very computationally intense task;~
|
Solving can be a very computationally intense task;~
|
||||||
~nyou may run out of memory and crash. ~
|
\nyou may run out of memory and crash. ~
|
||||||
~nReally continue? (Be sure to save your work!)")
|
\nReally continue? (Be sure to save your work!)")
|
||||||
"Yes"
|
"Yes"
|
||||||
"No"
|
"No"
|
||||||
"Really Solve?"
|
"Really Solve?"
|
||||||
|
|
|
@ -278,8 +278,8 @@
|
||||||
(gui-utils:get-choice
|
(gui-utils:get-choice
|
||||||
(format "~
|
(format "~
|
||||||
Solving can be a very computationally intense task;~
|
Solving can be a very computationally intense task;~
|
||||||
~nyou may run out of memory and crash. ~
|
\nyou may run out of memory and crash. ~
|
||||||
~nReally continue? (Be sure to save your work!)")
|
\nReally continue? (Be sure to save your work!)")
|
||||||
"Yes"
|
"Yes"
|
||||||
"No"
|
"No"
|
||||||
"Really Solve?"
|
"Really Solve?"
|
||||||
|
|
|
@ -17,7 +17,7 @@
|
||||||
(newline (current-error-port))))
|
(newline (current-error-port))))
|
||||||
|
|
||||||
(define (calculate-grid filename)
|
(define (calculate-grid filename)
|
||||||
(fprintf (current-error-port) "reading ~a~n" filename)
|
(fprintf (current-error-port) "reading ~a\n" filename)
|
||||||
(let* ([bitmap (make-object bitmap% filename)]
|
(let* ([bitmap (make-object bitmap% filename)]
|
||||||
[_ (unless (send bitmap ok?)
|
[_ (unless (send bitmap ok?)
|
||||||
(error 'bad-bitmap "name: ~a" filename))]
|
(error 'bad-bitmap "name: ~a" filename))]
|
||||||
|
@ -34,10 +34,10 @@
|
||||||
[new-bitmap-height (floor (/ (- puzzle-height 1) pixel-size))])
|
[new-bitmap-height (floor (/ (- puzzle-height 1) pixel-size))])
|
||||||
|
|
||||||
(begin
|
(begin
|
||||||
(fprintf (current-error-port) "size of picture: ~a x ~a~n" raw-width raw-height)
|
(fprintf (current-error-port) "size of picture: ~a x ~a\n" raw-width raw-height)
|
||||||
(fprintf (current-error-port) " size of image: ~a x ~a~n" image-width image-height)
|
(fprintf (current-error-port) " size of image: ~a x ~a\n" image-width image-height)
|
||||||
(fprintf (current-error-port) "grid-start (~a, ~a)~n" grid-x-start grid-y-start)
|
(fprintf (current-error-port) "grid-start (~a, ~a)\n" grid-x-start grid-y-start)
|
||||||
(fprintf (current-error-port) "size of puzzle: ~a x ~a~n"
|
(fprintf (current-error-port) "size of puzzle: ~a x ~a\n"
|
||||||
puzzle-width
|
puzzle-width
|
||||||
puzzle-height))
|
puzzle-height))
|
||||||
(reverse
|
(reverse
|
||||||
|
@ -62,7 +62,7 @@
|
||||||
(* pixel-size (+ j -1 1/2)))))
|
(* pixel-size (+ j -1 1/2)))))
|
||||||
'x
|
'x
|
||||||
'o)])
|
'o)])
|
||||||
;(fprintf (current-error-port) "(~a, ~a) is ~a~n" i j pixel-value)
|
;(fprintf (current-error-port) "(~a, ~a) is ~a\n" i j pixel-value)
|
||||||
(cons pixel-value
|
(cons pixel-value
|
||||||
(loop (- i 1))))])))
|
(loop (- i 1))))])))
|
||||||
(loop (- j 1)))])))))
|
(loop (- j 1)))])))))
|
||||||
|
@ -162,7 +162,7 @@
|
||||||
(call-with-output-file "raw-hattori.ss"
|
(call-with-output-file "raw-hattori.ss"
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(parameterize ([current-output-port port])
|
(parameterize ([current-output-port port])
|
||||||
(printf "`(~n")
|
(printf "`(\n")
|
||||||
(let loop ([n 1])
|
(let loop ([n 1])
|
||||||
(when (<= n 139)
|
(when (<= n 139)
|
||||||
(main-n n)
|
(main-n n)
|
||||||
|
|
|
@ -8,12 +8,12 @@
|
||||||
"expected an image file on the command-line"))
|
"expected an image file on the command-line"))
|
||||||
|
|
||||||
(define image (vector-ref argv 0))
|
(define image (vector-ref argv 0))
|
||||||
(fprintf (current-error-port) "processing ~a~n" image)
|
(fprintf (current-error-port) "processing ~a\n" image)
|
||||||
|
|
||||||
(define bitmap (make-object bitmap% image))
|
(define bitmap (make-object bitmap% image))
|
||||||
(when (send bitmap is-color?)
|
(when (send bitmap is-color?)
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"expected a monochrome bitmap -- all non-black spaces will be considered white~n"))
|
"expected a monochrome bitmap -- all non-black spaces will be considered white\n"))
|
||||||
|
|
||||||
(newline (current-error-port))
|
(newline (current-error-port))
|
||||||
|
|
||||||
|
|
|
@ -28,8 +28,8 @@ The col and row type specs are in sig.ss and the solution type is:
|
||||||
(prefix solve: "../solve.ss"))
|
(prefix solve: "../solve.ss"))
|
||||||
|
|
||||||
(if (equal? (vector) argv)
|
(if (equal? (vector) argv)
|
||||||
(printf "pass any command line argument to skip the solver~n~n")
|
(printf "pass any command line argument to skip the solver\n\n")
|
||||||
(printf "skipping the solver~n"))
|
(printf "skipping the solver\n"))
|
||||||
|
|
||||||
(define memory-limit (* 1024 1024 400)) ;; in bytes (500 megs)
|
(define memory-limit (* 1024 1024 400)) ;; in bytes (500 megs)
|
||||||
|
|
||||||
|
@ -161,7 +161,7 @@ The col and row type specs are in sig.ss and the solution type is:
|
||||||
(newline)]
|
(newline)]
|
||||||
[else
|
[else
|
||||||
(let ([dots-to-print (floor (- (* progress-bar-max (/ counter (- max 1))) dots-printed))])
|
(let ([dots-to-print (floor (- (* progress-bar-max (/ counter (- max 1))) dots-printed))])
|
||||||
'(printf "~spercentage: ~a ~a ~a ~a~n"
|
'(printf "~spercentage: ~a ~a ~a ~a\n"
|
||||||
cleanup
|
cleanup
|
||||||
dots-to-print
|
dots-to-print
|
||||||
counter
|
counter
|
||||||
|
@ -184,7 +184,7 @@ The col and row type specs are in sig.ss and the solution type is:
|
||||||
(define (solve name rows cols)
|
(define (solve name rows cols)
|
||||||
(cond
|
(cond
|
||||||
[(equal? argv (vector))
|
[(equal? argv (vector))
|
||||||
(printf "Solving ~s; memory limit ~a~n"
|
(printf "Solving ~s; memory limit ~a\n"
|
||||||
name (format-memory-txt memory-limit))
|
name (format-memory-txt memory-limit))
|
||||||
(let ([row-count (length rows)]
|
(let ([row-count (length rows)]
|
||||||
[col-count (length cols)])
|
[col-count (length cols)])
|
||||||
|
@ -205,7 +205,7 @@ The col and row type specs are in sig.ss and the solution type is:
|
||||||
(semaphore-wait kill)
|
(semaphore-wait kill)
|
||||||
(set! sucessful? #f)
|
(set! sucessful? #f)
|
||||||
(kill-thread k)
|
(kill-thread k)
|
||||||
(fprintf (current-error-port) "~nsolver raised an exception~n~a~n"
|
(fprintf (current-error-port) "\nsolver raised an exception\n~a\n"
|
||||||
(if (exn? x)
|
(if (exn? x)
|
||||||
(exn-message x)
|
(exn-message x)
|
||||||
x))
|
x))
|
||||||
|
@ -235,7 +235,7 @@ The col and row type specs are in sig.ss and the solution type is:
|
||||||
(void))))))
|
(void))))))
|
||||||
(semaphore-wait kill)
|
(semaphore-wait kill)
|
||||||
(kill-thread t)
|
(kill-thread t)
|
||||||
(fprintf (current-error-port) "~n memory limit expired.~n")
|
(fprintf (current-error-port) "\n memory limit expired.\n")
|
||||||
(collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)
|
(collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)
|
||||||
(update-memory-display)
|
(update-memory-display)
|
||||||
(semaphore-post done)))])
|
(semaphore-post done)))])
|
||||||
|
@ -271,10 +271,10 @@ The col and row type specs are in sig.ss and the solution type is:
|
||||||
[problems (caddr set)])
|
[problems (caddr set)])
|
||||||
(for-each sanity-check problems)
|
(for-each sanity-check problems)
|
||||||
(if (file-exists? output-file)
|
(if (file-exists? output-file)
|
||||||
(printf "skipping ~s (~a)~n" set-name (normalize-path output-file))
|
(printf "skipping ~s (~a)\n" set-name (normalize-path output-file))
|
||||||
(call-with-output-file output-file
|
(call-with-output-file output-file
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(printf "Building ~s~n" set-name)
|
(printf "Building ~s\n" set-name)
|
||||||
(parameterize ([current-output-port port])
|
(parameterize ([current-output-port port])
|
||||||
(write
|
(write
|
||||||
`(unit/sig paint-by-numbers:problem-set^
|
`(unit/sig paint-by-numbers:problem-set^
|
||||||
|
|
|
@ -559,7 +559,7 @@
|
||||||
((unknown) ".")
|
((unknown) ".")
|
||||||
((on) "#"))))
|
((on) "#"))))
|
||||||
row)
|
row)
|
||||||
(printf "~n"))
|
(printf "\n"))
|
||||||
(extract-rows board)))
|
(extract-rows board)))
|
||||||
|
|
||||||
; animate-changes takes a board and draws it on the main screen
|
; animate-changes takes a board and draws it on the main screen
|
||||||
|
|
|
@ -70,7 +70,7 @@
|
||||||
|
|
||||||
'(when (= depth 2)
|
'(when (= depth 2)
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"us: ~a them: ~a u-m:~a t-m: ~a u-l: ~a t-l: ~a u-c: ~a t-c: ~a~n"
|
"us: ~a them: ~a u-m:~a t-m: ~a u-l: ~a t-l: ~a u-c: ~a t-c: ~a\n"
|
||||||
usses thems
|
usses thems
|
||||||
middle-usses middle-thems
|
middle-usses middle-thems
|
||||||
us-in-line them-in-line
|
us-in-line them-in-line
|
||||||
|
|
|
@ -290,9 +290,9 @@
|
||||||
(format
|
(format
|
||||||
(string-append
|
(string-append
|
||||||
"There was an error running the "
|
"There was an error running the "
|
||||||
"program player for ~a.~n"
|
"program player for ~a.\n"
|
||||||
"We'll assume a default move, T1.~n"
|
"We'll assume a default move, T1.\n"
|
||||||
"Here is the error message:~n~a")
|
"Here is the error message:\n~a")
|
||||||
who
|
who
|
||||||
(if (exn? exn)
|
(if (exn? exn)
|
||||||
(exn-message exn)
|
(exn-message exn)
|
||||||
|
@ -685,7 +685,7 @@
|
||||||
(with-handlers ([void
|
(with-handlers ([void
|
||||||
(lambda (exn)
|
(lambda (exn)
|
||||||
(message-box "Error"
|
(message-box "Error"
|
||||||
(format "There was an error:~n~a"
|
(format "There was an error:\n~a"
|
||||||
(if (exn? exn)
|
(if (exn? exn)
|
||||||
(exn-message exn)
|
(exn-message exn)
|
||||||
exn))))])
|
exn))))])
|
||||||
|
|
|
@ -125,7 +125,7 @@
|
||||||
(- (car gf) good-so-far))])
|
(- (car gf) good-so-far))])
|
||||||
|
|
||||||
'(when (and (= depth RECURSION-DEPTH))
|
'(when (and (= depth RECURSION-DEPTH))
|
||||||
(fprintf (current-error-port) "Returned goodness: ~a~n" (car move))
|
(fprintf (current-error-port) "Returned goodness: ~a\n" (car move))
|
||||||
(print-board (cadr gf) (current-error-port)))
|
(print-board (cadr gf) (current-error-port)))
|
||||||
|
|
||||||
(let ([g (car move)])
|
(let ([g (car move)])
|
||||||
|
@ -153,7 +153,7 @@
|
||||||
|
|
||||||
'(when (and (= depth RECURSION-DEPTH))
|
'(when (and (= depth RECURSION-DEPTH))
|
||||||
(for-each (lambda (gf)
|
(for-each (lambda (gf)
|
||||||
(fprintf (current-error-port) "Goodness: ~a~n" (car gf))
|
(fprintf (current-error-port) "Goodness: ~a\n" (car gf))
|
||||||
(print-board (cadr gf) (current-error-port)))
|
(print-board (cadr gf) (current-error-port)))
|
||||||
good-futures))
|
good-futures))
|
||||||
|
|
||||||
|
@ -263,9 +263,9 @@
|
||||||
(thread
|
(thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let loop ([iteration 0])
|
(let loop ([iteration 0])
|
||||||
; (fprintf (current-error-port) "Starting iteration ~a~n" iteration)
|
; (fprintf (current-error-port) "Starting iteration ~a\n" iteration)
|
||||||
(set! result (f iteration))
|
(set! result (f iteration))
|
||||||
'(fprintf (current-error-port) " [finished iteration depth ~a: ~a~a]~n"
|
'(fprintf (current-error-port) " [finished iteration depth ~a: ~a~a]\n"
|
||||||
iteration (cadr result) (add1 (cddr result)))
|
iteration (cadr result) (add1 (cddr result)))
|
||||||
(unless (or (pair? (car result)))
|
(unless (or (pair? (car result)))
|
||||||
(loop (add1 iteration)))))))
|
(loop (add1 iteration)))))))
|
||||||
|
@ -282,7 +282,7 @@
|
||||||
|
|
||||||
(define (go)
|
(define (go)
|
||||||
'(begin
|
'(begin
|
||||||
(fprintf (current-error-port) "Start:~n")
|
(fprintf (current-error-port) "Start:\n")
|
||||||
(print-board board (current-error-port)))
|
(print-board board (current-error-port)))
|
||||||
(let* ([go (lambda (i)
|
(let* ([go (lambda (i)
|
||||||
(set! RECURSION-DEPTH i)
|
(set! RECURSION-DEPTH i)
|
||||||
|
@ -292,7 +292,7 @@
|
||||||
(go depth)
|
(go depth)
|
||||||
(use-up-time go))])
|
(use-up-time go))])
|
||||||
'(when (pair? (car result))
|
'(when (pair? (car result))
|
||||||
(fprintf (current-error-port) "we ~a~n"
|
(fprintf (current-error-port) "we ~a\n"
|
||||||
(if (= (caar result) LOSER-GOODNESS)
|
(if (= (caar result) LOSER-GOODNESS)
|
||||||
"lose"
|
"lose"
|
||||||
"win")))
|
"win")))
|
||||||
|
|
|
@ -318,7 +318,7 @@
|
||||||
(loop (- i 1))]))
|
(loop (- i 1))]))
|
||||||
(set! biggest-so-far (max biggest-so-far (calc-score answer)))
|
(set! biggest-so-far (max biggest-so-far (calc-score answer)))
|
||||||
(set! tests (+ tests 1))
|
(set! tests (+ tests 1))
|
||||||
(printf "tests: ~a sofar: ~a largest connected region: ~a score ~a~n"
|
(printf "tests: ~a sofar: ~a largest connected region: ~a score ~a\n"
|
||||||
tests
|
tests
|
||||||
biggest-so-far
|
biggest-so-far
|
||||||
answer
|
answer
|
||||||
|
|
|
@ -44,7 +44,7 @@
|
||||||
[(struct:line) make-line]
|
[(struct:line) make-line]
|
||||||
[(struct:merge) make-tmerge]
|
[(struct:merge) make-tmerge]
|
||||||
[(struct:turtles/offset) make-turtles/offset]
|
[(struct:turtles/offset) make-turtles/offset]
|
||||||
[else (error 'vec->struc "unknown structure: ~s~n" sexp)])
|
[else (error 'vec->struc "unknown structure: ~s\n" sexp)])
|
||||||
(map vec->struc (vector-ref sexp 1)))]
|
(map vec->struc (vector-ref sexp 1)))]
|
||||||
[else sexp]))
|
[else sexp]))
|
||||||
|
|
||||||
|
|
|
@ -866,7 +866,7 @@
|
||||||
(define/public (print-to-console v)
|
(define/public (print-to-console v)
|
||||||
;; ==drscheme eventspace thread==
|
;; ==drscheme eventspace thread==
|
||||||
;; only when a user thread is suspended
|
;; only when a user thread is suspended
|
||||||
(do-in-user-thread (lambda () (fprintf (current-error-port) " ### DEBUGGER: ~s~n" v))))
|
(do-in-user-thread (lambda () (fprintf (current-error-port) " ### DEBUGGER: ~s\n" v))))
|
||||||
|
|
||||||
(define (frame->end-breakpoint-status frame)
|
(define (frame->end-breakpoint-status frame)
|
||||||
(let/ec k
|
(let/ec k
|
||||||
|
@ -1098,7 +1098,7 @@
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (name/value)
|
(lambda (name/value)
|
||||||
(let ([name (format "~a" (syntax-e (first name/value)))]
|
(let ([name (format "~a" (syntax-e (first name/value)))]
|
||||||
[value (format " => ~s~n" (second name/value))])
|
[value (format " => ~s\n" (second name/value))])
|
||||||
(send variables-text insert name)
|
(send variables-text insert name)
|
||||||
(send variables-text change-style bold-sd
|
(send variables-text change-style bold-sd
|
||||||
(- (send variables-text last-position) (string-length name))
|
(- (send variables-text last-position) (string-length name))
|
||||||
|
@ -1135,7 +1135,7 @@
|
||||||
(unless already-stopped?
|
(unless already-stopped?
|
||||||
(send stack-frames delete 0 (send stack-frames last-position))
|
(send stack-frames delete 0 (send stack-frames last-position))
|
||||||
(for-each (lambda (trimmed-expr)
|
(for-each (lambda (trimmed-expr)
|
||||||
(send stack-frames insert (format "~a~n" trimmed-expr)))
|
(send stack-frames insert (format "~a\n" trimmed-expr)))
|
||||||
trimmed-exprs))
|
trimmed-exprs))
|
||||||
(send stack-frames change-style normal-sd 0 (send stack-frames last-position))
|
(send stack-frames change-style normal-sd 0 (send stack-frames last-position))
|
||||||
(send stack-frames change-style bold-sd
|
(send stack-frames change-style bold-sd
|
||||||
|
|
|
@ -123,11 +123,11 @@
|
||||||
(define (display-mark mark)
|
(define (display-mark mark)
|
||||||
(apply
|
(apply
|
||||||
string-append
|
string-append
|
||||||
(format "source: ~a~n" (mz:syntax-object->datum (mark-source mark)))
|
(format "source: ~a\n" (mz:syntax-object->datum (mark-source mark)))
|
||||||
(format "label: ~a~n" (mark-label mark))
|
(format "label: ~a\n" (mark-label mark))
|
||||||
(format "bindings:~n")
|
(format "bindings:\n")
|
||||||
(map (lambda (binding)
|
(map (lambda (binding)
|
||||||
(format " ~a : ~a~n" (syntax-e (mark-binding-binding binding))
|
(format " ~a : ~a\n" (syntax-e (mark-binding-binding binding))
|
||||||
(mark-binding-value binding)))
|
(mark-binding-value binding)))
|
||||||
(mark-bindings mark))))
|
(mark-bindings mark))))
|
||||||
|
|
||||||
|
@ -152,7 +152,7 @@
|
||||||
(lookup-first-binding (lambda (id2) (mz:module-identifier=? id id2))
|
(lookup-first-binding (lambda (id2) (mz:module-identifier=? id id2))
|
||||||
mark-list
|
mark-list
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(error 'lookup-binding "variable not found in environment: ~a~n" (if (syntax? id)
|
(error 'lookup-binding "variable not found in environment: ~a\n" (if (syntax? id)
|
||||||
(mz:syntax-object->datum id)
|
(mz:syntax-object->datum id)
|
||||||
id))))))
|
id))))))
|
||||||
|
|
||||||
|
|
|
@ -213,11 +213,11 @@
|
||||||
(cond
|
(cond
|
||||||
[(or (eof-object? ans) (eq? ans 'x)) (void)]
|
[(or (eof-object? ans) (eq? ans 'x)) (void)]
|
||||||
[(not (number? ans))
|
[(not (number? ans))
|
||||||
(printf "The input must be a number. Given: ~s~n" ans) (repl)]
|
(printf "The input must be a number. Given: ~s\n" ans) (repl)]
|
||||||
[(number? ans)
|
[(number? ans)
|
||||||
(let ([res (f ans)])
|
(let ([res (f ans)])
|
||||||
(if (number? res)
|
(if (number? res)
|
||||||
(printf "~sF corresponds to ~sC~n" ans res)
|
(printf "~sF corresponds to ~sC\n" ans res)
|
||||||
(error 'convert OUT-ERROR res))
|
(error 'convert OUT-ERROR res))
|
||||||
(repl))]
|
(repl))]
|
||||||
[else (error 'convert "can't happen")])))))
|
[else (error 'convert "can't happen")])))))
|
||||||
|
@ -236,10 +236,10 @@
|
||||||
(cond
|
(cond
|
||||||
[(eof-object? in) (void)]
|
[(eof-object? in) (void)]
|
||||||
[(number? in) (begin (check-and-print (f in)) (read-until-eof))]
|
[(number? in) (begin (check-and-print (f in)) (read-until-eof))]
|
||||||
[else (error 'convert "The input must be a number. Given: ~e~n" in)])))
|
[else (error 'convert "The input must be a number. Given: ~e\n" in)])))
|
||||||
(define (check-and-print out)
|
(define (check-and-print out)
|
||||||
(cond
|
(cond
|
||||||
[(number? out) (printf "~s~n" out)]
|
[(number? out) (printf "~s\n" out)]
|
||||||
[else (error 'convert OUT-ERROR out)])))
|
[else (error 'convert OUT-ERROR out)])))
|
||||||
read-until-eof))
|
read-until-eof))
|
||||||
|
|
||||||
|
|
|
@ -73,7 +73,7 @@
|
||||||
;; Symbol (union true String) String X -> void
|
;; Symbol (union true String) String X -> void
|
||||||
(define (check-list-list pname condition pred given)
|
(define (check-list-list pname condition pred given)
|
||||||
(when (string? condition)
|
(when (string? condition)
|
||||||
(tp-error pname (string-append condition (format "~nin ~e" given)))))
|
(tp-error pname (string-append condition (format "\nin ~e" given)))))
|
||||||
|
|
||||||
;; Symbol (_ -> Boolean) String X X *-> X
|
;; Symbol (_ -> Boolean) String X X *-> X
|
||||||
(define (check-result pname pred? expected given . other-given)
|
(define (check-result pname pred? expected given . other-given)
|
||||||
|
|
|
@ -52,7 +52,7 @@
|
||||||
(format "number in 0 ...~s" GUESS) "first" i)
|
(format "number in 0 ...~s" GUESS) "first" i)
|
||||||
'(if (and (number? i) (integer? i) (exact? i) (<= 0 i (sub1 GUESS)))
|
'(if (and (number? i) (integer? i) (exact? i) (<= 0 i (sub1 GUESS)))
|
||||||
...
|
...
|
||||||
(printf "control: improper index, expected 0 ... ~s~n" GUESS))
|
(printf "control: improper index, expected 0 ... ~s\n" GUESS))
|
||||||
(send (list-ref guess-choices (- GUESS i 1)) get-selection))
|
(send (list-ref guess-choices (- GUESS i 1)) get-selection))
|
||||||
|
|
||||||
;; connect : (button% control-event% -> true) -> true
|
;; connect : (button% control-event% -> true) -> true
|
||||||
|
@ -61,7 +61,7 @@
|
||||||
(define (connect/proc call-back)
|
(define (connect/proc call-back)
|
||||||
(check-proc 'connect call-back 2 '1st "2 arguments")
|
(check-proc 'connect call-back 2 '1st "2 arguments")
|
||||||
(if check-button
|
(if check-button
|
||||||
(printf "connect: called a second time~n")
|
(printf "connect: called a second time\n")
|
||||||
(begin
|
(begin
|
||||||
(set! check-button
|
(set! check-button
|
||||||
(make-object button% "Check" guess-panel call-back '(border)))
|
(make-object button% "Check" guess-panel call-back '(border)))
|
||||||
|
|
|
@ -44,7 +44,7 @@
|
||||||
(define (connect/proc call-back)
|
(define (connect/proc call-back)
|
||||||
(check-proc 'connect call-back 2 '1st "2 arguments")
|
(check-proc 'connect call-back 2 '1st "2 arguments")
|
||||||
(if button
|
(if button
|
||||||
(printf "connect: called a second time~n")
|
(printf "connect: called a second time\n")
|
||||||
(begin
|
(begin
|
||||||
(set! button (make-object button% "LookUp" panel call-back '(border)))
|
(set! button (make-object button% "LookUp" panel call-back '(border)))
|
||||||
(send query-tf focus)
|
(send query-tf focus)
|
||||||
|
|
|
@ -18,5 +18,5 @@
|
||||||
'sorry_all_wrong]))
|
'sorry_all_wrong]))
|
||||||
|
|
||||||
(define (go/proc s)
|
(define (go/proc s)
|
||||||
(printf "Have fun playing, ~a~n" s)
|
(printf "Have fun playing, ~a\n" s)
|
||||||
(master compare)))
|
(master compare)))
|
||||||
|
|
|
@ -480,7 +480,7 @@
|
||||||
(loop (add1 port-no) (add1 attempts))]
|
(loop (add1 port-no) (add1 attempts))]
|
||||||
[else
|
[else
|
||||||
(error 'get-next-port
|
(error 'get-next-port
|
||||||
"Couldn't find an available port between ~a and ~a~n"
|
"Couldn't find an available port between ~a and ~a\n"
|
||||||
starting-at (+ starting-at max-attempts))]))))
|
starting-at (+ starting-at max-attempts))]))))
|
||||||
|
|
||||||
;; the current-server is a (make-parameter (or/c #f a-server))
|
;; the current-server is a (make-parameter (or/c #f a-server))
|
||||||
|
|
|
@ -22,7 +22,7 @@
|
||||||
(define OUT "convert-out.dat")
|
(define OUT "convert-out.dat")
|
||||||
|
|
||||||
(define (create-convert-in)
|
(define (create-convert-in)
|
||||||
(printf "212 32~n-40~n"))
|
(printf "212 32\n-40\n"))
|
||||||
|
|
||||||
(define (check-convert-out)
|
(define (check-convert-out)
|
||||||
(and (= (read) 100)
|
(and (= (read) 100)
|
||||||
|
|
|
@ -14,7 +14,7 @@
|
||||||
(define call-back
|
(define call-back
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(begin
|
(begin
|
||||||
(draw-message msg (format "~s ~s~n" (choice-index chc) (text-contents txt)))
|
(draw-message msg (format "~s ~s\n" (choice-index chc) (text-contents txt)))
|
||||||
(draw-message msg "Bye World"))))
|
(draw-message msg "Bye World"))))
|
||||||
|
|
||||||
(define (destroy x) (hide-window x))
|
(define (destroy x) (hide-window x))
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
[(_ form ...)
|
[(_ form ...)
|
||||||
(syntax
|
(syntax
|
||||||
(with-handlers ([exn? (lambda (e)
|
(with-handlers ([exn? (lambda (e)
|
||||||
(printf "~a~n" (exn-message e))
|
(printf "~a\n" (exn-message e))
|
||||||
#t)])
|
#t)])
|
||||||
form ...
|
form ...
|
||||||
#f))])))
|
#f))])))
|
||||||
|
|
|
@ -84,7 +84,7 @@ Reads HTML from a port, producing an @xexpr compatible with the
|
||||||
[(struct h:html-element (attributes))
|
[(struct h:html-element (attributes))
|
||||||
'()]))
|
'()]))
|
||||||
|
|
||||||
(printf "~s~n" (extract-pcdata an-html)))
|
(printf "~s\n" (extract-pcdata an-html)))
|
||||||
(require 'html-example)
|
(require 'html-example)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
|
@ -30,7 +30,7 @@
|
||||||
;; Symbol (union true String) String X -> void
|
;; Symbol (union true String) String X -> void
|
||||||
(define (check-list-list pname condition pred given)
|
(define (check-list-list pname condition pred given)
|
||||||
(when (string? condition)
|
(when (string? condition)
|
||||||
(error pname (string-append condition (format "~nin ~e" given)))))
|
(error pname (string-append condition (format "\nin ~e" given)))))
|
||||||
|
|
||||||
;; Symbol (_ -> Boolean) String X -> X
|
;; Symbol (_ -> Boolean) String X -> X
|
||||||
(define (check-result pname pred? expected given)
|
(define (check-result pname pred? expected given)
|
||||||
|
|
|
@ -249,9 +249,9 @@
|
||||||
(lambda (stx #:allow-nonstx? [allow-nonstx? #f] #:default [default #f])
|
(lambda (stx #:allow-nonstx? [allow-nonstx? #f] #:default [default #f])
|
||||||
(let ([replacement (hash-ref table stx #f)])
|
(let ([replacement (hash-ref table stx #f)])
|
||||||
(if replacement
|
(if replacement
|
||||||
(begin #;(printf " replacing ~s with ~s~n" stx replacement)
|
(begin #;(printf " replacing ~s with ~s\n" stx replacement)
|
||||||
replacement)
|
replacement)
|
||||||
(begin #;(printf " not replacing ~s~n" stx)
|
(begin #;(printf " not replacing ~s\n" stx)
|
||||||
default)))))
|
default)))))
|
||||||
|
|
||||||
(define (make-renames-table from0 to0)
|
(define (make-renames-table from0 to0)
|
||||||
|
|
|
@ -36,10 +36,10 @@
|
||||||
[old-parts (stx->list old-expr)])
|
[old-parts (stx->list old-expr)])
|
||||||
;; FIXME
|
;; FIXME
|
||||||
(unless (= (length new-parts) (length old-parts))
|
(unless (= (length new-parts) (length old-parts))
|
||||||
(printf "** syntax/restamp~n~s~n" (quote-syntax #,stx))
|
(printf "** syntax/restamp\n~s\n" (quote-syntax #,stx))
|
||||||
(printf "pattern : ~s~n" (syntax->datum #'(pa (... ...))))
|
(printf "pattern : ~s\n" (syntax->datum #'(pa (... ...))))
|
||||||
(printf "old parts: ~s~n" (map syntax->datum old-parts))
|
(printf "old parts: ~s\n" (map syntax->datum old-parts))
|
||||||
(printf "new parts: ~s~n" (map syntax->datum new-parts)))
|
(printf "new parts: ~s\n" (map syntax->datum new-parts)))
|
||||||
(d->so
|
(d->so
|
||||||
old-expr
|
old-expr
|
||||||
(map (lambda (new old) (syntax/restamp pa new old))
|
(map (lambda (new old) (syntax/restamp pa new old))
|
||||||
|
@ -49,10 +49,10 @@
|
||||||
;; FIXME
|
;; FIXME
|
||||||
#'(begin
|
#'(begin
|
||||||
(unless (and (stx-pair? new-expr) (stx-pair? old-expr))
|
(unless (and (stx-pair? new-expr) (stx-pair? old-expr))
|
||||||
(printf "** syntax/restamp~n~s~n" (quote-syntax #,stx))
|
(printf "** syntax/restamp\n~s\n" (quote-syntax #,stx))
|
||||||
(printf "pattern : ~s~n" (syntax->datum (quote-syntax (pa . pb))))
|
(printf "pattern : ~s\n" (syntax->datum (quote-syntax (pa . pb))))
|
||||||
(printf "old parts: ~s~n" old-expr)
|
(printf "old parts: ~s\n" old-expr)
|
||||||
(printf "new parts: ~s~n" new-expr))
|
(printf "new parts: ~s\n" new-expr))
|
||||||
(let ([na (stx-car new-expr)]
|
(let ([na (stx-car new-expr)]
|
||||||
[nb (stx-cdr new-expr)]
|
[nb (stx-cdr new-expr)]
|
||||||
[oa (stx-car old-expr)]
|
[oa (stx-car old-expr)]
|
||||||
|
|
|
@ -18,7 +18,7 @@
|
||||||
(define val (cdr sig+val))
|
(define val (cdr sig+val))
|
||||||
(define t (tokenize sig val pos))
|
(define t (tokenize sig val pos))
|
||||||
(send browser add-text
|
(send browser add-text
|
||||||
(format "Signal: ~s: ~s~n"
|
(format "Signal: ~s: ~s\n"
|
||||||
pos
|
pos
|
||||||
(token-name (position-token-token t))))
|
(token-name (position-token-token t))))
|
||||||
(when val
|
(when val
|
||||||
|
|
|
@ -50,7 +50,7 @@
|
||||||
[val (cdr sig+val)]
|
[val (cdr sig+val)]
|
||||||
[t (tokenize sig val pos)])
|
[t (tokenize sig val pos)])
|
||||||
(when (trace-verbose?)
|
(when (trace-verbose?)
|
||||||
(printf "~s: ~s~n" pos
|
(printf "~s: ~s\n" pos
|
||||||
(token-name (position-token-token t))))
|
(token-name (position-token-token t))))
|
||||||
(set! pos (add1 pos))
|
(set! pos (add1 pos))
|
||||||
t))))
|
t))))
|
||||||
|
|
|
@ -255,19 +255,19 @@
|
||||||
|
|
||||||
;; display-kv : any any -> void
|
;; display-kv : any any -> void
|
||||||
(define/private (display-kv key value)
|
(define/private (display-kv key value)
|
||||||
(display (format "~a~n" key) key-sd)
|
(display (format "~a\n" key) key-sd)
|
||||||
(display (format "~s~n~n" value) #f))
|
(display (format "~s\n\n" value) #f))
|
||||||
|
|
||||||
;; display-subkv : any any -> void
|
;; display-subkv : any any -> void
|
||||||
(define/public (display-subkv k v)
|
(define/public (display-subkv k v)
|
||||||
(display (format "~a: " k) sub-key-sd)
|
(display (format "~a: " k) sub-key-sd)
|
||||||
(display (format "~a~n" v) #f))
|
(display (format "~a\n" v) #f))
|
||||||
|
|
||||||
(define/public (display-subkv/value k v)
|
(define/public (display-subkv/value k v)
|
||||||
(display-subkv k v)
|
(display-subkv k v)
|
||||||
#;
|
#;
|
||||||
(begin
|
(begin
|
||||||
(display (format "~a:~n" k) sub-key-sd)
|
(display (format "~a:\n" k) sub-key-sd)
|
||||||
(let* ([value-text (new text:standard-style-list% (auto-wrap #t))]
|
(let* ([value-text (new text:standard-style-list% (auto-wrap #t))]
|
||||||
[value-snip (new editor-snip% (editor value-text))]
|
[value-snip (new editor-snip% (editor value-text))]
|
||||||
[value-port (make-text-port value-text)])
|
[value-port (make-text-port value-text)])
|
||||||
|
|
|
@ -17,7 +17,7 @@
|
||||||
(export make:collection^)
|
(export make:collection^)
|
||||||
|
|
||||||
(define (make-collection collection-name collection-files argv)
|
(define (make-collection collection-name collection-files argv)
|
||||||
(printf "building collection ~a: ~a~n" collection-name collection-files)
|
(printf "building collection ~a: ~a\n" collection-name collection-files)
|
||||||
(let* ([zo-compiler #f]
|
(let* ([zo-compiler #f]
|
||||||
[src-dir (current-directory)]
|
[src-dir (current-directory)]
|
||||||
[sses (sort collection-files
|
[sses (sort collection-files
|
||||||
|
|
|
@ -91,7 +91,7 @@
|
||||||
variant-dir)]
|
variant-dir)]
|
||||||
[dest-file.so (build-path dest-dir (append-extension-suffix base-file))])
|
[dest-file.so (build-path dest-dir (append-extension-suffix base-file))])
|
||||||
(make-directory* dest-dir)
|
(make-directory* dest-dir)
|
||||||
(printf " Copying ~a~n to ~a~n" file.so dest-file.so)
|
(printf " Copying ~a\n to ~a\n" file.so dest-file.so)
|
||||||
(when (file-exists? dest-file.so)
|
(when (file-exists? dest-file.so)
|
||||||
(delete-file dest-file.so))
|
(delete-file dest-file.so))
|
||||||
(copy-file file.so dest-file.so))
|
(copy-file file.so dest-file.so))
|
||||||
|
|
|
@ -18,7 +18,7 @@
|
||||||
(case mode
|
(case mode
|
||||||
[(no-cache) (error 'cache/file "No cache available: ~a" pth)]
|
[(no-cache) (error 'cache/file "No cache available: ~a" pth)]
|
||||||
[(cache always)
|
[(cache always)
|
||||||
#;(printf "cache/file: running ~S for ~a~n" thnk pth)
|
#;(printf "cache/file: running ~S for ~a\n" thnk pth)
|
||||||
(recompute!)]))])
|
(recompute!)]))])
|
||||||
(read-cache pth))]))
|
(read-cache pth))]))
|
||||||
|
|
||||||
|
|
|
@ -17,9 +17,9 @@
|
||||||
(define (make-archive rev)
|
(define (make-archive rev)
|
||||||
(define archive-path (revision-archive rev))
|
(define archive-path (revision-archive rev))
|
||||||
(if (file-exists? archive-path)
|
(if (file-exists? archive-path)
|
||||||
(printf "r~a is already archived~n" rev)
|
(printf "r~a is already archived\n" rev)
|
||||||
(local [(define tmp-path (make-temporary-file))]
|
(local [(define tmp-path (make-temporary-file))]
|
||||||
(printf "Archiving r~a~n" rev)
|
(printf "Archiving r~a\n" rev)
|
||||||
(create-archive tmp-path (revision-dir rev))
|
(create-archive tmp-path (revision-dir rev))
|
||||||
(rename-file-or-directory tmp-path archive-path)
|
(rename-file-or-directory tmp-path archive-path)
|
||||||
(archive-directory (revision-log-dir rev))
|
(archive-directory (revision-log-dir rev))
|
||||||
|
|
|
@ -115,7 +115,7 @@
|
||||||
(thread
|
(thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(subprocess-wait the-process)
|
(subprocess-wait the-process)
|
||||||
(printf "Killing parent because wrapper is dead...~n")
|
(printf "Killing parent because wrapper is dead...\n")
|
||||||
(kill-thread parent))))]
|
(kill-thread parent))))]
|
||||||
|
|
||||||
; Run without stdin
|
; Run without stdin
|
||||||
|
|
|
@ -6,17 +6,17 @@
|
||||||
(define replay-event
|
(define replay-event
|
||||||
(match-lambda
|
(match-lambda
|
||||||
[(struct stdout (bs))
|
[(struct stdout (bs))
|
||||||
(fprintf (current-output-port) "~a~n" bs)]
|
(fprintf (current-output-port) "~a\n" bs)]
|
||||||
[(struct stderr (bs))
|
[(struct stderr (bs))
|
||||||
(fprintf (current-error-port) "~a~n" bs)]))
|
(fprintf (current-error-port) "~a\n" bs)]))
|
||||||
|
|
||||||
(define (replay-status s)
|
(define (replay-status s)
|
||||||
(for-each replay-event (status-output-log s))
|
(for-each replay-event (status-output-log s))
|
||||||
#;(when (timeout? s)
|
#;(when (timeout? s)
|
||||||
(fprintf (current-error-port) "[replay-log] TIMEOUT!~n"))
|
(fprintf (current-error-port) "[replay-log] TIMEOUT!\n"))
|
||||||
#;(when (exit? s)
|
#;(when (exit? s)
|
||||||
(fprintf (current-error-port) "[replay-log] Exit code: ~a~n" (exit-code s)))
|
(fprintf (current-error-port) "[replay-log] Exit code: ~a\n" (exit-code s)))
|
||||||
#;(printf "[replay-log] Took ~a~n"
|
#;(printf "[replay-log] Took ~a\n"
|
||||||
(format-duration-ms (status-duration s)))
|
(format-duration-ms (status-duration s)))
|
||||||
(replay-exit-code s))
|
(replay-exit-code s))
|
||||||
|
|
||||||
|
|
|
@ -113,7 +113,7 @@
|
||||||
empty]
|
empty]
|
||||||
[(read-commit in-p)
|
[(read-commit in-p)
|
||||||
=> (lambda (c)
|
=> (lambda (c)
|
||||||
(printf "~S~n" c)
|
(printf "~S\n" c)
|
||||||
(list* c (read-commits in-p)))]
|
(list* c (read-commits in-p)))]
|
||||||
[else
|
[else
|
||||||
empty]))
|
empty]))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
|
|
||||||
(printf "Setting the default browser to something safe...~n")
|
(printf "Setting the default browser to something safe...\n")
|
||||||
|
|
||||||
; XXX maybe have it call /quit
|
; XXX maybe have it call /quit
|
||||||
(put-preferences
|
(put-preferences
|
||||||
|
|
|
@ -6,6 +6,6 @@
|
||||||
(fprintf (if (even? i)
|
(fprintf (if (even? i)
|
||||||
(current-error-port)
|
(current-error-port)
|
||||||
(current-output-port))
|
(current-output-port))
|
||||||
"~a~n"
|
"~a\n"
|
||||||
i))
|
i))
|
||||||
|
|
||||||
|
|
|
@ -20,7 +20,7 @@
|
||||||
(define log
|
(define log
|
||||||
(read-cache* (build-path (revision-log-dir rev) filename)))
|
(read-cache* (build-path (revision-log-dir rev) filename)))
|
||||||
(when log
|
(when log
|
||||||
(printf "~S~n"
|
(printf "~S\n"
|
||||||
(list rev
|
(list rev
|
||||||
(status-duration log)
|
(status-duration log)
|
||||||
(filter-map
|
(filter-map
|
||||||
|
@ -39,7 +39,7 @@
|
||||||
(define data-file (path-timing-log filename))
|
(define data-file (path-timing-log filename))
|
||||||
(with-handlers ([exn:fail? void])
|
(with-handlers ([exn:fail? void])
|
||||||
(make-parent-directory data-file))
|
(make-parent-directory data-file))
|
||||||
(printf "Making log for ~a~n" filename)
|
(printf "Making log for ~a\n" filename)
|
||||||
|
|
||||||
(if revision
|
(if revision
|
||||||
(with-output-to-file
|
(with-output-to-file
|
||||||
|
|
|
@ -12,7 +12,7 @@
|
||||||
current-ps-cmap-file-paths)
|
current-ps-cmap-file-paths)
|
||||||
|
|
||||||
(define (report-exn exn)
|
(define (report-exn exn)
|
||||||
(log-error (format "PostScript/AFM error: ~a~n"
|
(log-error (format "PostScript/AFM error: ~a\n"
|
||||||
(if (exn? exn)
|
(if (exn? exn)
|
||||||
(exn-message exn)
|
(exn-message exn)
|
||||||
exn))))
|
exn))))
|
||||||
|
@ -508,7 +508,7 @@
|
||||||
(when special-font
|
(when special-font
|
||||||
(let ([name (afm-expand-name special-font-name)])
|
(let ([name (afm-expand-name special-font-name)])
|
||||||
(hash-set! used-fonts name #t)
|
(hash-set! used-fonts name #t)
|
||||||
(fprintf out "currentfont~n/~a findfont~n~a scalefont setfont~n"
|
(fprintf out "currentfont\n/~a findfont\n~a scalefont setfont\n"
|
||||||
name
|
name
|
||||||
size)))
|
size)))
|
||||||
(if (font-is-cid? (or special-font font))
|
(if (font-is-cid? (or special-font font))
|
||||||
|
@ -545,7 +545,7 @@
|
||||||
(fprintf out "(~a) show\n" bytes)))))))
|
(fprintf out "(~a) show\n" bytes)))))))
|
||||||
(when special-font
|
(when special-font
|
||||||
;; Uses result of currentfont above:
|
;; Uses result of currentfont above:
|
||||||
(fprintf out "setfont~n"))))])
|
(fprintf out "setfont\n"))))])
|
||||||
(fprintf out "0 -~a rmoveto\n" (/ (* size (- (font-height font) (font-descent font))) 1000.0))
|
(fprintf out "0 -~a rmoveto\n" (/ (* size (- (font-height font) (font-descent font))) 1000.0))
|
||||||
(let loop ([l l][simples null][special-font-name #f][special-font #f])
|
(let loop ([l l][simples null][special-font-name #f][special-font #f])
|
||||||
(cond
|
(cond
|
||||||
|
@ -617,11 +617,11 @@
|
||||||
this-font)
|
this-font)
|
||||||
(begin
|
(begin
|
||||||
;; Not simple... use glyphshow
|
;; Not simple... use glyphshow
|
||||||
(fprintf out "gsave~n/~a findfont~n~a scalefont setfont~n"
|
(fprintf out "gsave\n/~a findfont\n~a scalefont setfont\n"
|
||||||
(afm-expand-name this-font-name)
|
(afm-expand-name this-font-name)
|
||||||
size)
|
size)
|
||||||
(fprintf out "/~a glyphshow\n" (achar-enc achar))
|
(fprintf out "/~a glyphshow\n" (achar-enc achar))
|
||||||
(fprintf out "grestore~n")
|
(fprintf out "grestore\n")
|
||||||
(loop (cdr l) null #f #f))))))
|
(loop (cdr l) null #f #f))))))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
;; No mapping for the character anywhere.
|
;; No mapping for the character anywhere.
|
||||||
|
|
|
@ -30,7 +30,7 @@
|
||||||
(let loop ()
|
(let loop ()
|
||||||
(let ([l (read-line p)])
|
(let ([l (read-line p)])
|
||||||
(unless (eof-object? l)
|
(unless (eof-object? l)
|
||||||
(fprintf orig-err "~a~n" l)
|
(fprintf orig-err "~a\n" l)
|
||||||
(loop)))))
|
(loop)))))
|
||||||
(lambda () (close-input-port p))))))])
|
(lambda () (close-input-port p))))))])
|
||||||
(echo in)
|
(echo in)
|
||||||
|
|
|
@ -22,13 +22,13 @@
|
||||||
(when f (f i))))]
|
(when f (f i))))]
|
||||||
[on-select
|
[on-select
|
||||||
(lambda (i)
|
(lambda (i)
|
||||||
(printf "Selected: ~a~n"
|
(printf "Selected: ~a\n"
|
||||||
(if i
|
(if i
|
||||||
(send (send i get-editor) get-flattened-text)
|
(send (send i get-editor) get-flattened-text)
|
||||||
i)))]
|
i)))]
|
||||||
[on-double-select
|
[on-double-select
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
(printf "Double-click: ~a~n"
|
(printf "Double-click: ~a\n"
|
||||||
(send (send s get-editor) get-flattened-text)))])
|
(send (send s get-editor) get-flattened-text)))])
|
||||||
(sequence (apply super-init args)))
|
(sequence (apply super-init args)))
|
||||||
p))
|
p))
|
||||||
|
|
|
@ -157,7 +157,7 @@ neck and it is the most readable solution.
|
||||||
($ dim x width stretchable-width?)
|
($ dim x width stretchable-width?)
|
||||||
($ dim y height stretchable-height?))
|
($ dim y height stretchable-height?))
|
||||||
others ...)
|
others ...)
|
||||||
(printf "(make-rect (make-dim ~s ~s ~s) (make-dim ~s ~s ~s))~n"
|
(printf "(make-rect (make-dim ~s ~s ~s) (make-dim ~s ~s ~s))\n"
|
||||||
x width stretchable-width?
|
x width stretchable-width?
|
||||||
y height stretchable-height?)
|
y height stretchable-height?)
|
||||||
(rect-print others)]))
|
(rect-print others)]))
|
||||||
|
|
|
@ -26,12 +26,12 @@
|
||||||
(send snip get-margin l t r b)
|
(send snip get-margin l t r b)
|
||||||
(printf "get-margin: ~sX~s ~sX~s\n" (unbox l) (unbox r) (unbox t) (unbox b)))
|
(printf "get-margin: ~sX~s ~sX~s\n" (unbox l) (unbox r) (unbox t) (unbox b)))
|
||||||
|
|
||||||
(printf "get-max-height: ~s~n" (send snip get-max-height))
|
(printf "get-max-height: ~s\n" (send snip get-max-height))
|
||||||
(printf "get-max-width: ~s~n" (send snip get-max-width))
|
(printf "get-max-width: ~s\n" (send snip get-max-width))
|
||||||
(printf "get-min-height: ~s~n" (send snip get-min-height))
|
(printf "get-min-height: ~s\n" (send snip get-min-height))
|
||||||
(printf "get-min-width: ~s~n" (send snip get-min-width))
|
(printf "get-min-width: ~s\n" (send snip get-min-width))
|
||||||
;(printf "snip-width: ~s~n" (send pasteboard snip-width snip))
|
;(printf "snip-width: ~s\n" (send pasteboard snip-width snip))
|
||||||
;(printf "snip-height: ~s~n" (send pasteboard snip-height snip))
|
;(printf "snip-height: ~s\n" (send pasteboard snip-height snip))
|
||||||
))
|
))
|
||||||
|
|
||||||
;;debug-pasteboard: -> (void)
|
;;debug-pasteboard: -> (void)
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
"../aligned-pasteboard.ss"
|
"../aligned-pasteboard.ss"
|
||||||
"../aligned-editor-container.ss")
|
"../aligned-editor-container.ss")
|
||||||
|
|
||||||
;; (printf "running tests for pasteboard-lib.ss~n")
|
;; (printf "running tests for pasteboard-lib.ss\n")
|
||||||
|
|
||||||
;;pasteboard-root: ((is-a?/c aligned-pasteboard<%>) -> (is-a?/c aligned-pasteboard<%>))
|
;;pasteboard-root: ((is-a?/c aligned-pasteboard<%>) -> (is-a?/c aligned-pasteboard<%>))
|
||||||
;;gets the top most aligned pasteboard in the tree of pasteboards and containers
|
;;gets the top most aligned pasteboard in the tree of pasteboards and containers
|
||||||
|
@ -203,5 +203,5 @@
|
||||||
(send frame show false)
|
(send frame show false)
|
||||||
)
|
)
|
||||||
|
|
||||||
(printf "tests done~n")
|
(printf "tests done\n")
|
||||||
|#
|
|#
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
"../aligned-editor-container.ss"
|
"../aligned-editor-container.ss"
|
||||||
"test-macro.ss")
|
"test-macro.ss")
|
||||||
|
|
||||||
;;(printf "running tests for snip-lib.ss~n")
|
;;(printf "running tests for snip-lib.ss\n")
|
||||||
|
|
||||||
;;snip-width: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?)
|
;;snip-width: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?)
|
||||||
;;the width of a snip in the given pasteboard
|
;;the width of a snip in the given pasteboard
|
||||||
|
@ -205,4 +205,4 @@
|
||||||
|
|
||||||
(send frame show false)
|
(send frame show false)
|
||||||
)
|
)
|
||||||
;;(printf "tests done~n")
|
;;(printf "tests done\n")
|
||||||
|
|
|
@ -21,7 +21,7 @@
|
||||||
; ;
|
; ;
|
||||||
; ;;;
|
; ;;;
|
||||||
|
|
||||||
(printf "running test1.ss~n")
|
(printf "running test1.ss\n")
|
||||||
|
|
||||||
(define frame
|
(define frame
|
||||||
(instantiate frame% ()
|
(instantiate frame% ()
|
||||||
|
@ -228,4 +228,4 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(send frame show false)
|
(send frame show false)
|
||||||
(printf "done~n")
|
(printf "done\n")
|
||||||
|
|
|
@ -22,7 +22,7 @@
|
||||||
; ;;;
|
; ;;;
|
||||||
;
|
;
|
||||||
|
|
||||||
(printf "running test2.ss~n")
|
(printf "running test2.ss\n")
|
||||||
|
|
||||||
(define frame
|
(define frame
|
||||||
(instantiate frame% ()
|
(instantiate frame% ()
|
||||||
|
@ -186,4 +186,4 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(send frame show false)
|
(send frame show false)
|
||||||
(printf "done~n")
|
(printf "done\n")
|
||||||
|
|
|
@ -46,7 +46,7 @@
|
||||||
[(left top) 0]
|
[(left top) 0]
|
||||||
[(right bottom) (- total-size item-size)]
|
[(right bottom) (- total-size item-size)]
|
||||||
[else (error 'place-children
|
[else (error 'place-children
|
||||||
"alignment spec is unknown ~a~n" spec)])))])
|
"alignment spec is unknown ~a\n" spec)])))])
|
||||||
(map (lambda (l)
|
(map (lambda (l)
|
||||||
(let*-values ([(min-width min-height v-stretch? h-stretch?)
|
(let*-values ([(min-width min-height v-stretch? h-stretch?)
|
||||||
(apply values l)]
|
(apply values l)]
|
||||||
|
|
|
@ -149,7 +149,7 @@
|
||||||
(let ([count 0])
|
(let ([count 0])
|
||||||
(lambda (ev)
|
(lambda (ev)
|
||||||
(when (send ev mousemove?)
|
(when (send ev mousemove?)
|
||||||
(printf "mousemove #~a, but who's counting?~n" count)
|
(printf "mousemove #~a, but who's counting?\n" count)
|
||||||
(set! count (add1 count))))))
|
(set! count (add1 count))))))
|
||||||
|
|
||||||
(define (today-handler ev)
|
(define (today-handler ev)
|
||||||
|
@ -198,7 +198,7 @@
|
||||||
(send ctrldoc find-element "CAPTION" "Caption")
|
(send ctrldoc find-element "CAPTION" "Caption")
|
||||||
(lambda (ev)
|
(lambda (ev)
|
||||||
(when (send ev keypress?)
|
(when (send ev keypress?)
|
||||||
(printf "ooh that tickles~n"))))
|
(printf "ooh that tickles\n"))))
|
||||||
|
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (sym-handler)
|
(lambda (sym-handler)
|
||||||
|
|
|
@ -2450,7 +2450,7 @@
|
||||||
(with-handlers
|
(with-handlers
|
||||||
([void
|
([void
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(printf "~a~n" (exn-message e))
|
(printf "~a\n" (exn-message e))
|
||||||
(loop))])
|
(loop))])
|
||||||
(mxprims:get-event browser))]
|
(mxprims:get-event browser))]
|
||||||
[event (make-object mx-event% prim-event)]
|
[event (make-object mx-event% prim-event)]
|
||||||
|
|
|
@ -289,7 +289,7 @@
|
||||||
(if (<= input test)
|
(if (<= input test)
|
||||||
'input-smaller
|
'input-smaller
|
||||||
'test-smaller)))]))])
|
'test-smaller)))]))])
|
||||||
; (printf "~a ~a ~a~n" compare secs (date->string date))
|
; (printf "~a ~a ~a\n" compare secs (date->string date))
|
||||||
(cond
|
(cond
|
||||||
[(eq? compare 'equal) secs]
|
[(eq? compare 'equal) secs]
|
||||||
[(or (= secs below-secs) (= secs above-secs))
|
[(or (= secs below-secs) (= secs above-secs))
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
(let* defs
|
(let* defs
|
||||||
(let ((real-ans code))
|
(let ((real-ans code))
|
||||||
(unless (equal? real-ans right-ans)
|
(unless (equal? real-ans right-ans)
|
||||||
(printf "Test failed: ~e gave ~e. Expected ~e~n"
|
(printf "Test failed: ~e gave ~e. Expected ~e\n"
|
||||||
'code real-ans 'right-ans))) ...))))
|
'code real-ans 'right-ans))) ...))))
|
||||||
|
|
||||||
(define-syntax test-block
|
(define-syntax test-block
|
||||||
|
|
|
@ -17,8 +17,8 @@
|
||||||
[print-error
|
[print-error
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(if (exn? e)
|
(if (exn? e)
|
||||||
(fprintf (current-error-port) "~a~n" (exn-message e))
|
(fprintf (current-error-port) "~a\n" (exn-message e))
|
||||||
(fprintf (current-error-port) "Exception in init file: ~e~n" e)))]
|
(fprintf (current-error-port) "Exception in init file: ~e\n" e)))]
|
||||||
[beginize (lambda (l)
|
[beginize (lambda (l)
|
||||||
(string-append
|
(string-append
|
||||||
"(begin "
|
"(begin "
|
||||||
|
|
|
@ -115,7 +115,7 @@
|
||||||
|
|
||||||
;; coroutine : ((bool ->) -> X) -> X-coroutine-object
|
;; coroutine : ((bool ->) -> X) -> X-coroutine-object
|
||||||
(define (coroutine f)
|
(define (coroutine f)
|
||||||
;;(printf "2. new coroutine~n")
|
;;(printf "2. new coroutine\n")
|
||||||
(let* ([can-stop-lock (make-semaphore 1)]
|
(let* ([can-stop-lock (make-semaphore 1)]
|
||||||
[done-ch (make-channel)]
|
[done-ch (make-channel)]
|
||||||
[ex-ch (make-channel)]
|
[ex-ch (make-channel)]
|
||||||
|
@ -123,7 +123,7 @@
|
||||||
[stop-enabled? #t]
|
[stop-enabled? #t]
|
||||||
[enable-stop
|
[enable-stop
|
||||||
(lambda (enable?)
|
(lambda (enable?)
|
||||||
;;(printf "3. enabling ~a~n" enable?)
|
;;(printf "3. enabling ~a\n" enable?)
|
||||||
(cond
|
(cond
|
||||||
[(and enable? (not stop-enabled?))
|
[(and enable? (not stop-enabled?))
|
||||||
(semaphore-post can-stop-lock)
|
(semaphore-post can-stop-lock)
|
||||||
|
@ -131,11 +131,11 @@
|
||||||
[(and (not enable?) stop-enabled?)
|
[(and (not enable?) stop-enabled?)
|
||||||
(semaphore-wait can-stop-lock)
|
(semaphore-wait can-stop-lock)
|
||||||
(set! stop-enabled? #f)])
|
(set! stop-enabled? #f)])
|
||||||
;;(printf "3. finished enabling~n")
|
;;(printf "3. finished enabling\n")
|
||||||
)]
|
)]
|
||||||
[tid (thread (lambda ()
|
[tid (thread (lambda ()
|
||||||
(semaphore-wait proceed-sema)
|
(semaphore-wait proceed-sema)
|
||||||
;;(printf "3. creating coroutine thread~n")
|
;;(printf "3. creating coroutine thread\n")
|
||||||
(with-handlers ([(lambda (exn) #t)
|
(with-handlers ([(lambda (exn) #t)
|
||||||
(lambda (exn)
|
(lambda (exn)
|
||||||
(enable-stop #t)
|
(enable-stop #t)
|
||||||
|
@ -152,7 +152,7 @@
|
||||||
(if (coroutine-object-worker w)
|
(if (coroutine-object-worker w)
|
||||||
(let ([can-stop-lock (coroutine-object-can-stop-lock w)]
|
(let ([can-stop-lock (coroutine-object-can-stop-lock w)]
|
||||||
[worker (coroutine-object-worker w)])
|
[worker (coroutine-object-worker w)])
|
||||||
#;(printf "2. starting coroutine~n")
|
#;(printf "2. starting coroutine\n")
|
||||||
(thread-resume worker)
|
(thread-resume worker)
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
void
|
void
|
||||||
|
@ -162,20 +162,20 @@
|
||||||
timeout
|
timeout
|
||||||
(alarm-evt (+ timeout (current-inexact-milliseconds))))
|
(alarm-evt (+ timeout (current-inexact-milliseconds))))
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
#;(printf "2. alarm-evt~n")
|
#;(printf "2. alarm-evt\n")
|
||||||
(semaphore-wait can-stop-lock)
|
(semaphore-wait can-stop-lock)
|
||||||
(thread-suspend worker)
|
(thread-suspend worker)
|
||||||
(semaphore-post can-stop-lock)
|
(semaphore-post can-stop-lock)
|
||||||
#f))
|
#f))
|
||||||
(wrap-evt (coroutine-object-done-ch w)
|
(wrap-evt (coroutine-object-done-ch w)
|
||||||
(lambda (res)
|
(lambda (res)
|
||||||
#;(printf "2. coroutine-done-evt~n")
|
#;(printf "2. coroutine-done-evt\n")
|
||||||
(set-coroutine-object-result! w res)
|
(set-coroutine-object-result! w res)
|
||||||
(coroutine-kill w)
|
(coroutine-kill w)
|
||||||
#t))
|
#t))
|
||||||
(wrap-evt (coroutine-object-ex-ch w)
|
(wrap-evt (coroutine-object-ex-ch w)
|
||||||
(lambda (exn)
|
(lambda (exn)
|
||||||
#;(printf "2. ex-evt~n")
|
#;(printf "2. ex-evt\n")
|
||||||
(coroutine-kill w)
|
(coroutine-kill w)
|
||||||
(raise exn))))))
|
(raise exn))))))
|
||||||
;; In case we escape through a break:
|
;; In case we escape through a break:
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
(lambda (load)
|
(lambda (load)
|
||||||
(lambda (filename expected-module)
|
(lambda (filename expected-module)
|
||||||
(fprintf ep
|
(fprintf ep
|
||||||
"~aloading ~a at ~a~n"
|
"~aloading ~a at ~a\n"
|
||||||
tab filename (current-process-milliseconds))
|
tab filename (current-process-milliseconds))
|
||||||
(begin0
|
(begin0
|
||||||
(let ([s tab])
|
(let ([s tab])
|
||||||
|
@ -18,7 +18,7 @@
|
||||||
(load filename expected-module))
|
(load filename expected-module))
|
||||||
(lambda () (set! tab s))))
|
(lambda () (set! tab s))))
|
||||||
(fprintf ep
|
(fprintf ep
|
||||||
"~adone ~a at ~a~n"
|
"~adone ~a at ~a\n"
|
||||||
tab filename (current-process-milliseconds)))))])
|
tab filename (current-process-milliseconds)))))])
|
||||||
(current-load (mk-chain load))
|
(current-load (mk-chain load))
|
||||||
(current-load-extension (mk-chain load-extension))))
|
(current-load-extension (mk-chain load-extension))))
|
||||||
|
|
|
@ -82,7 +82,7 @@
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ((result (calcp (lambda () (calcl ip)))))
|
(let ((result (calcp (lambda () (calcl ip)))))
|
||||||
(when result
|
(when result
|
||||||
(printf "~a~n" result)
|
(printf "~a\n" result)
|
||||||
(one-line))))))
|
(one-line))))))
|
||||||
(one-line)))
|
(one-line)))
|
||||||
|
|
||||||
|
|
|
@ -113,7 +113,7 @@
|
||||||
(let ((next-check (vector-ref next 1)))
|
(let ((next-check (vector-ref next 1)))
|
||||||
(or (>= next-check max-char-num)
|
(or (>= next-check max-char-num)
|
||||||
(loop (add1 next-check) (cdr nexts))))))))))
|
(loop (add1 next-check) (cdr nexts))))))))))
|
||||||
(printf "Warning: lexer at ~a can accept the empty string.~n" stx)))
|
(printf "Warning: lexer at ~a can accept the empty string.\n" stx)))
|
||||||
(with-syntax ((start-state-stx start)
|
(with-syntax ((start-state-stx start)
|
||||||
(trans-table-stx trans)
|
(trans-table-stx trans)
|
||||||
(no-lookahead-stx no-look)
|
(no-lookahead-stx no-look)
|
||||||
|
@ -230,7 +230,7 @@
|
||||||
(lambda (ip)
|
(lambda (ip)
|
||||||
(let ((first-pos (get-position ip))
|
(let ((first-pos (get-position ip))
|
||||||
(first-char (peek-char-or-special ip 0)))
|
(first-char (peek-char-or-special ip 0)))
|
||||||
;(printf "(peek-char-or-special port 0) = ~e~n" first-char)
|
;(printf "(peek-char-or-special port 0) = ~e\n" first-char)
|
||||||
(cond
|
(cond
|
||||||
((eof-object? first-char)
|
((eof-object? first-char)
|
||||||
(do-match ip first-pos eof-action (read-char-or-special ip)))
|
(do-match ip first-pos eof-action (read-char-or-special ip)))
|
||||||
|
@ -279,7 +279,7 @@
|
||||||
(let* ((act (vector-ref actions next-state))
|
(let* ((act (vector-ref actions next-state))
|
||||||
(next-length-bytes (+ (char-utf-8-length char) length-bytes))
|
(next-length-bytes (+ (char-utf-8-length char) length-bytes))
|
||||||
(next-char (peek-char-or-special ip next-length-bytes)))
|
(next-char (peek-char-or-special ip next-length-bytes)))
|
||||||
#;(printf "(peek-char-or-special port ~e) = ~e~n"
|
#;(printf "(peek-char-or-special port ~e) = ~e\n"
|
||||||
next-length-bytes next-char)
|
next-length-bytes next-char)
|
||||||
(lexer-loop next-state
|
(lexer-loop next-state
|
||||||
next-char
|
next-char
|
||||||
|
@ -312,13 +312,13 @@
|
||||||
(position-offset first-pos)
|
(position-offset first-pos)
|
||||||
(- (position-offset end-pos) (position-offset first-pos)))))
|
(- (position-offset end-pos) (position-offset first-pos)))))
|
||||||
(let ((match (read-string longest-match-length lb)))
|
(let ((match (read-string longest-match-length lb)))
|
||||||
;(printf "(read-string ~e port) = ~e~n" longest-match-length match)
|
;(printf "(read-string ~e port) = ~e\n" longest-match-length match)
|
||||||
(do-match lb first-pos longest-match-action match)))
|
(do-match lb first-pos longest-match-action match)))
|
||||||
|
|
||||||
(define file-path (make-parameter #f))
|
(define file-path (make-parameter #f))
|
||||||
|
|
||||||
(define (do-match ip first-pos action value)
|
(define (do-match ip first-pos action value)
|
||||||
#;(printf "(action ~a ~a ~a ~a)~n"
|
#;(printf "(action ~a ~a ~a ~a)\n"
|
||||||
(position-offset first-pos) (position-offset (get-position ip)) value ip)
|
(position-offset first-pos) (position-offset (get-position ip)) value ip)
|
||||||
(action first-pos (get-position ip) value ip))
|
(action first-pos (get-position ip) value ip))
|
||||||
|
|
||||||
|
|
|
@ -281,13 +281,13 @@
|
||||||
(else (loop old-states new-states all-states (cdr cs))))))))))
|
(else (loop old-states new-states all-states (cdr cs))))))))))
|
||||||
|
|
||||||
(define (print-dfa x)
|
(define (print-dfa x)
|
||||||
(printf "number of states: ~a~n" (dfa-num-states x))
|
(printf "number of states: ~a\n" (dfa-num-states x))
|
||||||
(printf "start state: ~a~n" (dfa-start-state x))
|
(printf "start state: ~a\n" (dfa-start-state x))
|
||||||
(printf "final states: ~a~n" (map car (dfa-final-states/actions x)))
|
(printf "final states: ~a\n" (map car (dfa-final-states/actions x)))
|
||||||
(for-each (lambda (trans)
|
(for-each (lambda (trans)
|
||||||
(printf "state: ~a~n" (car trans))
|
(printf "state: ~a\n" (car trans))
|
||||||
(for-each (lambda (rule)
|
(for-each (lambda (rule)
|
||||||
(printf " -~a-> ~a~n"
|
(printf " -~a-> ~a\n"
|
||||||
(is:integer-set-contents (car rule))
|
(is:integer-set-contents (car rule))
|
||||||
(cdr rule)))
|
(cdr rule)))
|
||||||
(cdr trans)))
|
(cdr trans)))
|
||||||
|
|
|
@ -170,7 +170,7 @@
|
||||||
(vector->list x))))
|
(vector->list x))))
|
||||||
(vector->list table))
|
(vector->list table))
|
||||||
(length (hash-table-map ht cons)))))
|
(length (hash-table-map ht cons)))))
|
||||||
(printf "~a states, ~aKB~n"
|
(printf "~a states, ~aKB\n"
|
||||||
num-states
|
num-states
|
||||||
(/ (* 4.0 (+ 2 num-states (* 2 num-vectors) num-entries
|
(/ (* 4.0 (+ 2 num-states (* 2 num-vectors) num-entries
|
||||||
(* 5 num-different-entries))) 1024)))
|
(* 5 num-different-entries))) 1024)))
|
||||||
|
|
|
@ -14,7 +14,7 @@
|
||||||
(let* defs
|
(let* defs
|
||||||
(let ((real-ans code))
|
(let ((real-ans code))
|
||||||
(unless (equal? real-ans right-ans)
|
(unless (equal? real-ans right-ans)
|
||||||
(printf "Test failed: ~e gave ~e. Expected ~e~n"
|
(printf "Test failed: ~e gave ~e. Expected ~e\n"
|
||||||
'code real-ans 'right-ans))) ...))))
|
'code real-ans 'right-ans))) ...))))
|
||||||
|
|
||||||
(define-syntax test-block
|
(define-syntax test-block
|
||||||
|
|
|
@ -149,14 +149,14 @@
|
||||||
(print-input-st-prod l "LA" a g print-output-terms))
|
(print-input-st-prod l "LA" a g print-output-terms))
|
||||||
|
|
||||||
(define (print-input-st-sym f name a g print-output)
|
(define (print-input-st-sym f name a g print-output)
|
||||||
(printf "~a:~n" name)
|
(printf "~a:\n" name)
|
||||||
(send a for-each-state
|
(send a for-each-state
|
||||||
(lambda (state)
|
(lambda (state)
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (non-term)
|
(lambda (non-term)
|
||||||
(let ((res (f (make-trans-key state non-term))))
|
(let ((res (f (make-trans-key state non-term))))
|
||||||
(if (not (null? res))
|
(if (not (null? res))
|
||||||
(printf "~a(~a, ~a) = ~a~n"
|
(printf "~a(~a, ~a) = ~a\n"
|
||||||
name
|
name
|
||||||
state
|
state
|
||||||
(gram-sym-symbol non-term)
|
(gram-sym-symbol non-term)
|
||||||
|
@ -165,7 +165,7 @@
|
||||||
(newline))
|
(newline))
|
||||||
|
|
||||||
(define (print-input-st-prod f name a g print-output)
|
(define (print-input-st-prod f name a g print-output)
|
||||||
(printf "~a:~n" name)
|
(printf "~a:\n" name)
|
||||||
(send a for-each-state
|
(send a for-each-state
|
||||||
(lambda (state)
|
(lambda (state)
|
||||||
(for-each
|
(for-each
|
||||||
|
@ -174,7 +174,7 @@
|
||||||
(lambda (prod)
|
(lambda (prod)
|
||||||
(let ((res (f state prod)))
|
(let ((res (f state prod)))
|
||||||
(if (not (null? res))
|
(if (not (null? res))
|
||||||
(printf "~a(~a, ~a) = ~a~n"
|
(printf "~a(~a, ~a) = ~a\n"
|
||||||
name
|
name
|
||||||
(kernel-index state)
|
(kernel-index state)
|
||||||
(prod-index prod)
|
(prod-index prod)
|
||||||
|
|
|
@ -167,7 +167,7 @@
|
||||||
;; build-LR0-automaton: grammar -> LR0-automaton
|
;; build-LR0-automaton: grammar -> LR0-automaton
|
||||||
;; Constructs the kernels of the sets of LR(0) items of g
|
;; Constructs the kernels of the sets of LR(0) items of g
|
||||||
(define (build-lr0-automaton grammar)
|
(define (build-lr0-automaton grammar)
|
||||||
; (printf "LR(0) automaton:~n")
|
; (printf "LR(0) automaton:\n")
|
||||||
(letrec (
|
(letrec (
|
||||||
(epsilons (make-hash-table 'equal))
|
(epsilons (make-hash-table 'equal))
|
||||||
(grammar-symbols (append (send grammar get-non-terms)
|
(grammar-symbols (append (send grammar get-non-terms)
|
||||||
|
@ -304,7 +304,7 @@
|
||||||
(set! automaton-non-term (cons (cons (make-trans-key kernel gs)
|
(set! automaton-non-term (cons (cons (make-trans-key kernel gs)
|
||||||
unique-kernel)
|
unique-kernel)
|
||||||
automaton-non-term))))
|
automaton-non-term))))
|
||||||
#;(printf "~a -> ~a on ~a~n"
|
#;(printf "~a -> ~a on ~a\n"
|
||||||
(kernel->string kernel)
|
(kernel->string kernel)
|
||||||
(kernel->string unique-kernel)
|
(kernel->string unique-kernel)
|
||||||
(gram-sym-symbol gs))
|
(gram-sym-symbol gs))
|
||||||
|
|
|
@ -91,9 +91,9 @@
|
||||||
(hash-table-put! ht x #t)))
|
(hash-table-put! ht x #t)))
|
||||||
(map cdr (apply append (vector->list table))))
|
(map cdr (apply append (vector->list table))))
|
||||||
(length (hash-table-map ht void)))))
|
(length (hash-table-map ht void)))))
|
||||||
(printf "~a states, ~a grammar symbols, ~a hash-table entries, ~a reduces~n"
|
(printf "~a states, ~a grammar symbols, ~a hash-table entries, ~a reduces\n"
|
||||||
num-states num-gram-syms num-ht-entries num-reduces)
|
num-states num-gram-syms num-ht-entries num-reduces)
|
||||||
(printf "~a -- ~aKB, previously ~aKB~n"
|
(printf "~a -- ~aKB, previously ~aKB\n"
|
||||||
(/ (+ 2 num-states
|
(/ (+ 2 num-states
|
||||||
(* 4 num-states) (* 2 1.5 num-ht-entries)
|
(* 4 num-states) (* 2 1.5 num-ht-entries)
|
||||||
(* 5 num-reduces)) 256.0)
|
(* 5 num-reduces)) 256.0)
|
||||||
|
|
|
@ -97,16 +97,16 @@
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (prod)
|
(lambda (prod)
|
||||||
(fprintf port
|
(fprintf port
|
||||||
"~a\t~a\t=\t~a~n"
|
"~a\t~a\t=\t~a\n"
|
||||||
(prod-index prod)
|
(prod-index prod)
|
||||||
(gram-sym-symbol (prod-lhs prod))
|
(gram-sym-symbol (prod-lhs prod))
|
||||||
(map gram-sym-symbol (vector->list (prod-rhs prod)))))
|
(map gram-sym-symbol (vector->list (prod-rhs prod)))))
|
||||||
prods)
|
prods)
|
||||||
(send a for-each-state
|
(send a for-each-state
|
||||||
(lambda (state)
|
(lambda (state)
|
||||||
(fprintf port "State ~a~n" (kernel-index state))
|
(fprintf port "State ~a\n" (kernel-index state))
|
||||||
(for-each (lambda (item)
|
(for-each (lambda (item)
|
||||||
(fprintf port "\t~a~n" (item->string item)))
|
(fprintf port "\t~a\n" (item->string item)))
|
||||||
(kernel-items state))
|
(kernel-items state))
|
||||||
(newline port)
|
(newline port)
|
||||||
(for-each
|
(for-each
|
||||||
|
@ -118,22 +118,22 @@
|
||||||
((null? (cdr act))
|
((null? (cdr act))
|
||||||
(print-entry sym (car act) port))
|
(print-entry sym (car act) port))
|
||||||
(else
|
(else
|
||||||
(fprintf port "begin conflict:~n")
|
(fprintf port "begin conflict:\n")
|
||||||
(when (> (count reduce? act) 1)
|
(when (> (count reduce? act) 1)
|
||||||
(set! RR-conflicts (add1 RR-conflicts)))
|
(set! RR-conflicts (add1 RR-conflicts)))
|
||||||
(when (> (count shift? act) 0)
|
(when (> (count shift? act) 0)
|
||||||
(set! SR-conflicts (add1 SR-conflicts)))
|
(set! SR-conflicts (add1 SR-conflicts)))
|
||||||
(map (lambda (x) (print-entry sym x port)) act)
|
(map (lambda (x) (print-entry sym x port)) act)
|
||||||
(fprintf port "end conflict~n")))))
|
(fprintf port "end conflict\n")))))
|
||||||
(vector-ref grouped-table (kernel-index state)))
|
(vector-ref grouped-table (kernel-index state)))
|
||||||
(newline port)))
|
(newline port)))
|
||||||
|
|
||||||
(when (> SR-conflicts 0)
|
(when (> SR-conflicts 0)
|
||||||
(fprintf port "~a shift/reduce conflict~a~n"
|
(fprintf port "~a shift/reduce conflict~a\n"
|
||||||
SR-conflicts
|
SR-conflicts
|
||||||
(if (= SR-conflicts 1) "" "s")))
|
(if (= SR-conflicts 1) "" "s")))
|
||||||
(when (> RR-conflicts 0)
|
(when (> RR-conflicts 0)
|
||||||
(fprintf port "~a reduce/reduce conflict~a~n"
|
(fprintf port "~a reduce/reduce conflict~a\n"
|
||||||
RR-conflicts
|
RR-conflicts
|
||||||
(if (= RR-conflicts 1) "" "s")))))
|
(if (= RR-conflicts 1) "" "s")))))
|
||||||
|
|
||||||
|
@ -159,7 +159,7 @@
|
||||||
(loop (car rest) (cdr rest)))
|
(loop (car rest) (cdr rest)))
|
||||||
((accept? (car rest))
|
((accept? (car rest))
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"accept/reduce or accept/shift conflicts. Check the grammar for useless cycles of productions~n")
|
"accept/reduce or accept/shift conflicts. Check the grammar for useless cycles of productions\n")
|
||||||
(loop current-guess (cdr rest)))
|
(loop current-guess (cdr rest)))
|
||||||
(else (loop current-guess (cdr rest)))))))))
|
(else (loop current-guess (cdr rest)))))))))
|
||||||
|
|
||||||
|
@ -180,12 +180,12 @@
|
||||||
(unless suppress
|
(unless suppress
|
||||||
(when (> SR-conflicts 0)
|
(when (> SR-conflicts 0)
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"~a shift/reduce conflict~a~n"
|
"~a shift/reduce conflict~a\n"
|
||||||
SR-conflicts
|
SR-conflicts
|
||||||
(if (= SR-conflicts 1) "" "s")))
|
(if (= SR-conflicts 1) "" "s")))
|
||||||
(when (> RR-conflicts 0)
|
(when (> RR-conflicts 0)
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"~a reduce/reduce conflict~a~n"
|
"~a reduce/reduce conflict~a\n"
|
||||||
RR-conflicts
|
RR-conflicts
|
||||||
(if (= RR-conflicts 1) "" "s"))))
|
(if (= RR-conflicts 1) "" "s"))))
|
||||||
table))
|
table))
|
||||||
|
|
|
@ -74,7 +74,7 @@
|
||||||
(car rhs))
|
(car rhs))
|
||||||
(if (= 3 (length rhs))
|
(if (= 3 (length rhs))
|
||||||
(p "%prec ~a" (cadadr rhs)))
|
(p "%prec ~a" (cadadr rhs)))
|
||||||
(p "~n"))))
|
(p "\n"))))
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (t)
|
(lambda (t)
|
||||||
(for-each
|
(for-each
|
||||||
|
@ -86,7 +86,7 @@
|
||||||
(lambda (t)
|
(lambda (t)
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (t)
|
(lambda (t)
|
||||||
(p "%token ~a~n" t)
|
(p "%token ~a\n" t)
|
||||||
(hash-table-put! term-table t (format "~a" t)))
|
(hash-table-put! term-table t (format "~a" t)))
|
||||||
(syntax-object->datum (terminals-def-t t))))
|
(syntax-object->datum (terminals-def-t t))))
|
||||||
terms)
|
terms)
|
||||||
|
@ -96,10 +96,10 @@
|
||||||
(for-each (lambda (tok)
|
(for-each (lambda (tok)
|
||||||
(p " ~a" (hash-table-get term-table tok)))
|
(p " ~a" (hash-table-get term-table tok)))
|
||||||
(cdr prec))
|
(cdr prec))
|
||||||
(p "~n"))
|
(p "\n"))
|
||||||
precs))
|
precs))
|
||||||
(p "%start ~a~n" start)
|
(p "%start ~a\n" start)
|
||||||
(p "%%~n")
|
(p "%%\n")
|
||||||
|
|
||||||
(for-each (lambda (prod)
|
(for-each (lambda (prod)
|
||||||
(let ((nt (car prod)))
|
(let ((nt (car prod)))
|
||||||
|
@ -109,9 +109,9 @@
|
||||||
(p "| ")
|
(p "| ")
|
||||||
(display-rhs rhs))
|
(display-rhs rhs))
|
||||||
(cddr prod))
|
(cddr prod))
|
||||||
(p ";~n")))
|
(p ";\n")))
|
||||||
grammar)
|
grammar)
|
||||||
(p "%%~n"))))
|
(p "%%\n"))))
|
||||||
|
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -174,7 +174,7 @@
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(fprintf
|
(fprintf
|
||||||
(current-error-port)
|
(current-error-port)
|
||||||
"Cannot write yacc-output to file \"~a\"~n"
|
"Cannot write yacc-output to file \"~a\"\n"
|
||||||
yacc-output)))]
|
yacc-output)))]
|
||||||
(call-with-output-file yacc-output
|
(call-with-output-file yacc-output
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
|
@ -271,14 +271,14 @@
|
||||||
(let ((a (find-action stack tok val start-pos end-pos)))
|
(let ((a (find-action stack tok val start-pos end-pos)))
|
||||||
(cond
|
(cond
|
||||||
((runtime-shift? a)
|
((runtime-shift? a)
|
||||||
;; (printf "shift:~a~n" (runtime-shift-state a))
|
;; (printf "shift:~a\n" (runtime-shift-state a))
|
||||||
(cons (make-stack-frame (runtime-shift-state a)
|
(cons (make-stack-frame (runtime-shift-state a)
|
||||||
val
|
val
|
||||||
start-pos
|
start-pos
|
||||||
end-pos)
|
end-pos)
|
||||||
stack))
|
stack))
|
||||||
(else
|
(else
|
||||||
;; (printf "discard input:~a~n" tok)
|
;; (printf "discard input:~a\n" tok)
|
||||||
(let-values (((tok val start-pos end-pos)
|
(let-values (((tok val start-pos end-pos)
|
||||||
(extract (get-token))))
|
(extract (get-token))))
|
||||||
(remove-input tok val start-pos end-pos))))))))
|
(remove-input tok val start-pos end-pos))))))))
|
||||||
|
@ -286,7 +286,7 @@
|
||||||
(let ((a (find-action stack 'error #f start-pos end-pos)))
|
(let ((a (find-action stack 'error #f start-pos end-pos)))
|
||||||
(cond
|
(cond
|
||||||
((runtime-shift? a)
|
((runtime-shift? a)
|
||||||
;; (printf "shift:~a~n" (runtime-shift-state a))
|
;; (printf "shift:~a\n" (runtime-shift-state a))
|
||||||
(set! stack
|
(set! stack
|
||||||
(cons
|
(cons
|
||||||
(make-stack-frame (runtime-shift-state a)
|
(make-stack-frame (runtime-shift-state a)
|
||||||
|
@ -296,7 +296,7 @@
|
||||||
stack))
|
stack))
|
||||||
(remove-input tok val start-pos end-pos))
|
(remove-input tok val start-pos end-pos))
|
||||||
(else
|
(else
|
||||||
;; (printf "discard state:~a~n" (car stack))
|
;; (printf "discard state:~a\n" (car stack))
|
||||||
(cond
|
(cond
|
||||||
((< (length stack) 2)
|
((< (length stack) 2)
|
||||||
(raise-read-error "parser: Cannot continue after error"
|
(raise-read-error "parser: Cannot continue after error"
|
||||||
|
@ -330,7 +330,7 @@
|
||||||
(let ((action (find-action stack tok val start-pos end-pos)))
|
(let ((action (find-action stack tok val start-pos end-pos)))
|
||||||
(cond
|
(cond
|
||||||
((runtime-shift? action)
|
((runtime-shift? action)
|
||||||
;; (printf "shift:~a~n" (runtime-shift-state action))
|
;; (printf "shift:~a\n" (runtime-shift-state action))
|
||||||
(parsing-loop (cons (make-stack-frame (runtime-shift-state action)
|
(parsing-loop (cons (make-stack-frame (runtime-shift-state action)
|
||||||
val
|
val
|
||||||
start-pos
|
start-pos
|
||||||
|
@ -338,7 +338,7 @@
|
||||||
stack)
|
stack)
|
||||||
(get-token)))
|
(get-token)))
|
||||||
((runtime-reduce? action)
|
((runtime-reduce? action)
|
||||||
;; (printf "reduce:~a~n" (runtime-reduce-prod-num action))
|
;; (printf "reduce:~a\n" (runtime-reduce-prod-num action))
|
||||||
(let-values (((new-stack args)
|
(let-values (((new-stack args)
|
||||||
(reduce-stack stack
|
(reduce-stack stack
|
||||||
(runtime-reduce-rhs-length action)
|
(runtime-reduce-rhs-length action)
|
||||||
|
@ -367,7 +367,7 @@
|
||||||
new-stack)
|
new-stack)
|
||||||
ip))))
|
ip))))
|
||||||
((runtime-accept? action)
|
((runtime-accept? action)
|
||||||
;; (printf "accept~n")
|
;; (printf "accept\n")
|
||||||
(stack-frame-value (car stack)))
|
(stack-frame-value (car stack)))
|
||||||
(else
|
(else
|
||||||
(if src-pos
|
(if src-pos
|
||||||
|
|
|
@ -265,10 +265,10 @@
|
||||||
[(result-addr)
|
[(result-addr)
|
||||||
(cond
|
(cond
|
||||||
[(procedure? result-addr)
|
[(procedure? result-addr)
|
||||||
(printf "Imported procedure~n")
|
(printf "Imported procedure\n")
|
||||||
result-addr]
|
result-addr]
|
||||||
[(location? result-addr)
|
[(location? result-addr)
|
||||||
(printf "Value at location ~a:~n" result-addr)
|
(printf "Value at location ~a:\n" result-addr)
|
||||||
(gc->scheme result-addr)])])))]))
|
(gc->scheme result-addr)])])))]))
|
||||||
|
|
||||||
; Module Begin
|
; Module Begin
|
||||||
|
@ -304,7 +304,7 @@
|
||||||
(when (gui-available?)
|
(when (gui-available?)
|
||||||
(if (<= (#%datum . heap-size) 500)
|
(if (<= (#%datum . heap-size) 500)
|
||||||
(set-ui! (dynamic-require `plai/private/gc-gui 'heap-viz%))
|
(set-ui! (dynamic-require `plai/private/gc-gui 'heap-viz%))
|
||||||
(printf "Large heap; the heap visualizer will not be displayed.~n")))
|
(printf "Large heap; the heap visualizer will not be displayed.\n")))
|
||||||
(init-allocator))))]
|
(init-allocator))))]
|
||||||
[_ (raise-syntax-error 'mutator
|
[_ (raise-syntax-error 'mutator
|
||||||
"Mutator must start with an 'allocator-setup' expression, such as: (allocator-setup <module-path> <literal-number>)"
|
"Mutator must start with an 'allocator-setup' expression, such as: (allocator-setup <module-path> <literal-number>)"
|
||||||
|
|
|
@ -56,4 +56,4 @@
|
||||||
print?))
|
print?))
|
||||||
|
|
||||||
(when print-name?
|
(when print-name?
|
||||||
(printf "Traces are in ~a~n" traces-file))
|
(printf "Traces are in ~a\n" traces-file))
|
||||||
|
|
|
@ -44,7 +44,7 @@
|
||||||
(set! failed-tests (+ failed-tests 1))
|
(set! failed-tests (+ failed-tests 1))
|
||||||
(unless verbose?
|
(unless verbose?
|
||||||
(printf "\ntesting ~s ... " t))
|
(printf "\ntesting ~s ... " t))
|
||||||
(printf "TEST FAILED!~nexpected:~a\nrewritten-received:~a\nreceived:~a\n\n"
|
(printf "TEST FAILED!\nexpected:~a\nrewritten-received:~a\nreceived:~a\n\n"
|
||||||
(combine-in-lines expected)
|
(combine-in-lines expected)
|
||||||
(combine-in-lines rewritten-results)
|
(combine-in-lines rewritten-results)
|
||||||
(combine-in-lines results))))))))
|
(combine-in-lines results))))))))
|
||||||
|
|
|
@ -1046,7 +1046,7 @@
|
||||||
(begin
|
(begin
|
||||||
(when #f
|
(when #f
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"Undefined link: ~s~n"
|
"Undefined link: ~s\n"
|
||||||
(tag-key (link-element-tag e) ri)))
|
(tag-key (link-element-tag e) ri)))
|
||||||
`((font ([class "badlink"])
|
`((font ([class "badlink"])
|
||||||
,@(if (empty-content? (element-content e))
|
,@(if (empty-content? (element-content e))
|
||||||
|
|
|
@ -143,9 +143,9 @@ Of course, this breaks assignment to the provided variable.
|
||||||
(module b racket
|
(module b racket
|
||||||
(require a)
|
(require a)
|
||||||
|
|
||||||
(printf "~s~n" amount)
|
(printf "~s\n" amount)
|
||||||
<font color="red">(do-it)</font>
|
<font color="red">(do-it)</font>
|
||||||
(printf "~s~n" amount))
|
(printf "~s\n" amount))
|
||||||
|
|
||||||
(require b)
|
(require b)
|
||||||
</racket>
|
</racket>
|
||||||
|
|
|
@ -74,7 +74,7 @@ This code launches two places, echos a message to them and then waits for the pl
|
||||||
(for ([i (in-range 2)]
|
(for ([i (in-range 2)]
|
||||||
[p pls])
|
[p pls])
|
||||||
(place-channel-send p i)
|
(place-channel-send p i)
|
||||||
(printf "~a~n" (place-channel-recv p)))
|
(printf "~a\n" (place-channel-recv p)))
|
||||||
(map place-wait pls))
|
(map place-wait pls))
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
|
@ -142,7 +142,7 @@ supplied than are used by the format string, the
|
||||||
|
|
||||||
@examples[
|
@examples[
|
||||||
(fprintf (current-output-port)
|
(fprintf (current-output-port)
|
||||||
"~a as a string is ~s.~n"
|
"~a as a string is ~s.\n"
|
||||||
'(3 4)
|
'(3 4)
|
||||||
"(3 4)")
|
"(3 4)")
|
||||||
]}
|
]}
|
||||||
|
@ -163,7 +163,7 @@ Formats to a string. The result is the same as
|
||||||
]
|
]
|
||||||
|
|
||||||
@examples[
|
@examples[
|
||||||
(format "~a as a string is ~s.~n" '(3 4) "(3 4)")
|
(format "~a as a string is ~s.\n" '(3 4) "(3 4)")
|
||||||
]}
|
]}
|
||||||
|
|
||||||
@defboolparam[print-pair-curly-braces on?]{
|
@defboolparam[print-pair-curly-braces on?]{
|
||||||
|
|
|
@ -30,7 +30,7 @@
|
||||||
(define-foreign-lib lib name type ... -> _void)]
|
(define-foreign-lib lib name type ... -> _void)]
|
||||||
[(_ lib name type ...)
|
[(_ lib name type ...)
|
||||||
(begin
|
(begin
|
||||||
;; (printf "~a~n" 'name)
|
;; (printf "~a\n" 'name)
|
||||||
(provide name)
|
(provide name)
|
||||||
(define name
|
(define name
|
||||||
(get-ffi-obj 'name lib (_fun* type ...) (unavailable 'name))))]))
|
(get-ffi-obj 'name lib (_fun* type ...) (unavailable 'name))))]))
|
||||||
|
|
|
@ -7,7 +7,7 @@
|
||||||
mrlib/private/aligned-pasteboard/aligned-pasteboard
|
mrlib/private/aligned-pasteboard/aligned-pasteboard
|
||||||
mrlib/private/aligned-pasteboard/aligned-editor-container)
|
mrlib/private/aligned-pasteboard/aligned-editor-container)
|
||||||
|
|
||||||
(printf "running tests for snip-lib.ss~n")
|
(printf "running tests for snip-lib.ss\n")
|
||||||
|
|
||||||
;;snip-min-width: ((is-a?/c snip%) . -> . number?)
|
;;snip-min-width: ((is-a?/c snip%) . -> . number?)
|
||||||
;;the width of a snip in the given pasteboard
|
;;the width of a snip in the given pasteboard
|
||||||
|
|
|
@ -105,7 +105,7 @@
|
||||||
(or (wait-for-drscheme-frame-pred)
|
(or (wait-for-drscheme-frame-pred)
|
||||||
(begin
|
(begin
|
||||||
(when print-message?
|
(when print-message?
|
||||||
(printf "Select DrRacket frame~n"))
|
(printf "Select DrRacket frame\n"))
|
||||||
(poll-until wait-for-drscheme-frame-pred)))))
|
(poll-until wait-for-drscheme-frame-pred)))))
|
||||||
|
|
||||||
;; wait-for-new-frame : frame [(listof eventspace) = null] -> frame
|
;; wait-for-new-frame : frame [(listof eventspace) = null] -> frame
|
||||||
|
@ -529,7 +529,7 @@
|
||||||
|
|
||||||
[else
|
[else
|
||||||
(loop (send snip previous)
|
(loop (send snip previous)
|
||||||
(cons (format "{unknown snip: ~e}~n" snip)
|
(cons (format "{unknown snip: ~e}\n" snip)
|
||||||
strings))])]))))))]))
|
strings))])]))))))]))
|
||||||
|
|
||||||
;; run-one/sync : (-> A) -> A
|
;; run-one/sync : (-> A) -> A
|
||||||
|
|
|
@ -138,7 +138,7 @@ add this test:
|
||||||
(- (send interactions-text last-paragraph) 1)))])
|
(- (send interactions-text last-paragraph) 1)))])
|
||||||
(unless (equal? got-value expected-transcript)
|
(unless (equal? got-value expected-transcript)
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
"FAILED: expected: ~s~n got: ~s~n program: ~s~n input: ~s~n"
|
"FAILED: expected: ~s\n got: ~s\n program: ~s\n input: ~s\n"
|
||||||
expected-transcript got-value program input)))))
|
expected-transcript got-value program input)))))
|
||||||
|
|
||||||
(clear-definitions drs-frame)
|
(clear-definitions drs-frame)
|
||||||
|
@ -159,7 +159,7 @@ add this test:
|
||||||
(do-input-test "(read-line)" "\n" "\n\"\"")
|
(do-input-test "(read-line)" "\n" "\n\"\"")
|
||||||
(do-input-test "(read-char)" "\n" "\n#\\newline")
|
(do-input-test "(read-char)" "\n" "\n#\\newline")
|
||||||
|
|
||||||
(do-input-test "(list (read) (printf \"1~n\") (read) (printf \"3~n\"))"
|
(do-input-test "(list (read) (printf \"1\n\") (read) (printf \"3\n\"))"
|
||||||
"0 2\n"
|
"0 2\n"
|
||||||
"0 2\n1\n3\n(0 #<void> 2 #<void>)")
|
"0 2\n1\n3\n(0 #<void> 2 #<void>)")
|
||||||
|
|
||||||
|
|
|
@ -48,7 +48,7 @@
|
||||||
|
|
||||||
(for-each (lambda (f)
|
(for-each (lambda (f)
|
||||||
(when (file-exists? f)
|
(when (file-exists? f)
|
||||||
(printf "trying ~a~n" f)
|
(printf "trying ~a\n" f)
|
||||||
(let ([str
|
(let ([str
|
||||||
(call-with-input-file f
|
(call-with-input-file f
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
|
@ -113,7 +113,7 @@
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (f)
|
(lambda (f)
|
||||||
(when (file-exists? f)
|
(when (file-exists? f)
|
||||||
(printf "trying ~a~n" f)
|
(printf "trying ~a\n" f)
|
||||||
(let-values ([(zo zi zn ze zf)
|
(let-values ([(zo zi zn ze zf)
|
||||||
(apply values (process* gzip "-c" f))]
|
(apply values (process* gzip "-c" f))]
|
||||||
[(mi mo) (make-pipe 4096)])
|
[(mi mo) (make-pipe 4096)])
|
||||||
|
|
|
@ -7,7 +7,7 @@
|
||||||
(error 'wait-for-mred-frame
|
(error 'wait-for-mred-frame
|
||||||
,(format "after ~a seconds, frame labelled ~s didn't appear" timeout name))
|
,(format "after ~a seconds, frame labelled ~s didn't appear" timeout name))
|
||||||
(let ([win (get-top-level-focus-window)])
|
(let ([win (get-top-level-focus-window)])
|
||||||
(printf "win: ~a label ~a~n" win (and win (string=? (send win get-label) ,name)))
|
(printf "win: ~a label ~a\n" win (and win (string=? (send win get-label) ,name)))
|
||||||
(unless (and win (string=? (send win get-label) ,name))
|
(unless (and win (string=? (send win get-label) ,name))
|
||||||
(sleep ,pause-time)
|
(sleep ,pause-time)
|
||||||
(loop (- n 1)))))))))
|
(loop (- n 1)))))))))
|
||||||
|
|
|
@ -35,7 +35,7 @@
|
||||||
((mailbox-receive mb 10 error-timeout (want-thnk 24))) => 24
|
((mailbox-receive mb 10 error-timeout (want-thnk 24))) => 24
|
||||||
))
|
))
|
||||||
|
|
||||||
(printf "Channel~n")
|
(printf "Channel\n")
|
||||||
(test-it! ch:new-mailbox ch:mailbox? ch:mailbox-send! ch:mailbox-receive)
|
(test-it! ch:new-mailbox ch:mailbox? ch:mailbox-send! ch:mailbox-receive)
|
||||||
(printf "Semaphore~n")
|
(printf "Semaphore\n")
|
||||||
(test-it! sema:new-mailbox sema:mailbox? sema:mailbox-send! sema:mailbox-receive)
|
(test-it! sema:new-mailbox sema:mailbox? sema:mailbox-send! sema:mailbox-receive)
|
||||||
|
|
|
@ -3,4 +3,4 @@
|
||||||
|
|
||||||
(==> (filter-e zero? (changes (modulo seconds 10)))
|
(==> (filter-e zero? (changes (modulo seconds 10)))
|
||||||
(lambda (v)
|
(lambda (v)
|
||||||
(printf "~S~n" (value-now x))))
|
(printf "~s\n" (value-now x))))
|
||||||
|
|
|
@ -716,7 +716,7 @@
|
||||||
0 0 w h
|
0 0 w h
|
||||||
mode color)
|
mode color)
|
||||||
(set! x (+ x w 10))))
|
(set! x (+ x w 10))))
|
||||||
(printf "bad bitmap~n")))])
|
(printf "bad bitmap\n")))])
|
||||||
;; BB icon
|
;; BB icon
|
||||||
(do-one bb 'solid black)
|
(do-one bb 'solid black)
|
||||||
(let ([start x])
|
(let ([start x])
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
f
|
f
|
||||||
(begin
|
(begin
|
||||||
(unless printout?
|
(unless printout?
|
||||||
(printf "please select the console~n"))
|
(printf "please select the console\n"))
|
||||||
(sleep 1/2)
|
(sleep 1/2)
|
||||||
(loop #t)))))]
|
(loop #t)))))]
|
||||||
[wait
|
[wait
|
||||||
|
@ -67,9 +67,9 @@
|
||||||
[frame (mred:test:get-active-frame)]
|
[frame (mred:test:get-active-frame)]
|
||||||
[_ (mred:test:keystroke #\3)]
|
[_ (mred:test:keystroke #\3)]
|
||||||
[autosave-time (+ 10 (mred:get-preference 'mred:autosave-delay))]
|
[autosave-time (+ 10 (mred:get-preference 'mred:autosave-delay))]
|
||||||
[_ (printf "waiting for autosave timeout (~a secs)~n" autosave-time)]
|
[_ (printf "waiting for autosave timeout (~a secs)\n" autosave-time)]
|
||||||
[_ (sleep autosave-time)]
|
[_ (sleep autosave-time)]
|
||||||
[_ (printf "finished waiting for autosave timeout~n")]
|
[_ (printf "finished waiting for autosave timeout\n")]
|
||||||
[_ (unless (file-exists? backup-file)
|
[_ (unless (file-exists? backup-file)
|
||||||
(error 'autosave "autosave file (~a) not created" backup-file))]
|
(error 'autosave "autosave file (~a) not created" backup-file))]
|
||||||
[_ (mred:test:menu-select "File" save-name)]
|
[_ (mred:test:menu-select "File" save-name)]
|
||||||
|
@ -80,7 +80,7 @@
|
||||||
[_ (wait-pending)]
|
[_ (wait-pending)]
|
||||||
[_ (wait (lambda () (eq? (mred:test:get-active-frame) console))
|
[_ (wait (lambda () (eq? (mred:test:get-active-frame) console))
|
||||||
"focus didn't return to the console after closing autosave test frame")])
|
"focus didn't return to the console after closing autosave test frame")])
|
||||||
(printf "test finished~n")))
|
(printf "test finished\n")))
|
||||||
|
|
||||||
;
|
;
|
||||||
; when rewriting, apply this function to:
|
; when rewriting, apply this function to:
|
||||||
|
|
|
@ -68,7 +68,7 @@
|
||||||
(sleep)
|
(sleep)
|
||||||
(collect-garbage)
|
(collect-garbage)
|
||||||
(collect-garbage)
|
(collect-garbage)
|
||||||
(printf "Thread: ~s Cycle: ~s~n" id n)
|
(printf "Thread: ~s Cycle: ~s\n" id n)
|
||||||
; (dump-object-stats)
|
; (dump-object-stats)
|
||||||
; (if (and dump-stats? (= id 1))
|
; (if (and dump-stats? (= id 1))
|
||||||
; (dump-memory-stats))
|
; (dump-memory-stats))
|
||||||
|
@ -229,7 +229,7 @@
|
||||||
(map (lambda (x)
|
(map (lambda (x)
|
||||||
(let ([v (weak-box-value (cdr x))])
|
(let ([v (weak-box-value (cdr x))])
|
||||||
(when v
|
(when v
|
||||||
(printf "~s ~s~n" (car x) v))))
|
(printf "~s ~s\n" (car x) v))))
|
||||||
allocated)
|
allocated)
|
||||||
(void))
|
(void))
|
||||||
|
|
||||||
|
@ -243,10 +243,10 @@
|
||||||
(if #f
|
(if #f
|
||||||
(thread (lambda ()
|
(thread (lambda ()
|
||||||
(read)
|
(read)
|
||||||
(printf "breaking~n")
|
(printf "breaking\n")
|
||||||
(break-thread t)
|
(break-thread t)
|
||||||
(thread-wait t)
|
(thread-wait t)
|
||||||
(printf "done~n")))
|
(printf "done\n")))
|
||||||
(void)))
|
(void)))
|
||||||
|
|
||||||
(define (do-test)
|
(define (do-test)
|
||||||
|
|
|
@ -93,7 +93,7 @@
|
||||||
(and (exn:fail? x)
|
(and (exn:fail? x)
|
||||||
(regexp-match "shutdown" (exn-message x))))
|
(regexp-match "shutdown" (exn-message x))))
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(printf "got expected error: ~a~n" (exn-message x))
|
(printf "got expected error: ~a\n" (exn-message x))
|
||||||
'error)])
|
'error)])
|
||||||
(parameterize ([current-eventspace e])
|
(parameterize ([current-eventspace e])
|
||||||
(t)))))
|
(t)))))
|
||||||
|
|
|
@ -9,7 +9,7 @@
|
||||||
(override
|
(override
|
||||||
[on-event
|
[on-event
|
||||||
(lambda (ev)
|
(lambda (ev)
|
||||||
(printf "~a~a MOUSE ~a (~a,~a)\n mods:~a~a~a~a~a\n buttons:~a~a~a~a~a~a~a~n"
|
(printf "~a~a MOUSE ~a (~a,~a)\n mods:~a~a~a~a~a\n buttons:~a~a~a~a~a~a~a\n"
|
||||||
(es-check)
|
(es-check)
|
||||||
iter
|
iter
|
||||||
(send ev get-event-type)
|
(send ev get-event-type)
|
||||||
|
@ -38,7 +38,7 @@
|
||||||
[on-char
|
[on-char
|
||||||
(lambda (ev)
|
(lambda (ev)
|
||||||
(set! iter (add1 iter))
|
(set! iter (add1 iter))
|
||||||
(printf "~a~a KEY: ~a\n rel-code: ~a\n other-codes: ~a\n mods:~a~a~a~a~a~n"
|
(printf "~a~a KEY: ~a\n rel-code: ~a\n other-codes: ~a\n mods:~a~a~a~a~a\n"
|
||||||
(es-check)
|
(es-check)
|
||||||
iter
|
iter
|
||||||
(let ([v (send ev get-key-code)])
|
(let ([v (send ev get-key-code)])
|
||||||
|
@ -68,7 +68,7 @@
|
||||||
(inherit accept-drop-files)
|
(inherit accept-drop-files)
|
||||||
(override
|
(override
|
||||||
[on-drop-file (lambda (file)
|
[on-drop-file (lambda (file)
|
||||||
(printf "Dropped: ~a~n" file))])
|
(printf "Dropped: ~a\n" file))])
|
||||||
(sequence
|
(sequence
|
||||||
(super-init "tests" #f 100 100)
|
(super-init "tests" #f 100 100)
|
||||||
(accept-drop-files #t)))))
|
(accept-drop-files #t)))))
|
||||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user