Merged changes from trunk.
svn: r18007
This commit is contained in:
Carl Eastlund
commit
fe40d3e888
|
|
@ -1,20 +0,0 @@
|
|||
#lang scheme/gui
|
||||
|
||||
(require 2htdp/universe)
|
||||
(require 2htdp/image)
|
||||
|
||||
(define s "")
|
||||
(define x 1)
|
||||
|
||||
(big-bang 1
|
||||
(on-tick (lambda (w)
|
||||
(begin
|
||||
(set! x (+ x 1))
|
||||
(if (= x 3) 0 1))))
|
||||
(stop-when zero?)
|
||||
(on-draw (lambda (w)
|
||||
(begin
|
||||
(set! s (string-append "-" s))
|
||||
(rectangle 1 1 'solid 'green)))))
|
||||
|
||||
(unless (string=? s "---") (error 'world-update-test "failed! ~s" s))
|
||||
|
|
@ -153,7 +153,7 @@
|
|||
(choice-res-errors result))
|
||||
(fail-type->message (choice-res-errors result))
|
||||
(make-err
|
||||
(format "Found additional content after ~a, begining with '~a'."
|
||||
(format "Found additional content after ~a, beginning with '~a'."
|
||||
(res-msg (car used-sort))
|
||||
(input->output-name (car (res-rest (car used-sort)))))
|
||||
(and src?
|
||||
|
|
@ -166,7 +166,7 @@
|
|||
[(and (repeat-res? result) (fail-type? (repeat-res-stop result)))
|
||||
;(printf "repeat-fail~n")
|
||||
(fail-type->message (repeat-res-stop result))]
|
||||
[else (error 'parser (format "Internal error: recieved unexpected input ~a"
|
||||
[else (error 'parser (format "Internal error: received unexpected input ~a"
|
||||
result))])])
|
||||
(cond
|
||||
[(err? out)
|
||||
|
|
|
|||
|
|
@ -288,7 +288,7 @@
|
|||
[(null? (cdr l)) (string-append "or " (car l))]
|
||||
[else (string-append (car l) ", " (formatter (cdr l)))]))])
|
||||
(cond
|
||||
[(null? l) (error 'internal-error "nice-list in combinator-parser/errors.scm recieved null list")]
|
||||
[(null? l) (error 'internal-error "nice-list in combinator-parser/errors.scm received null list")]
|
||||
[(null? (cdr l)) (car l)]
|
||||
[(null? (cddr l)) (string-append (car l) " or " (cadr l))]
|
||||
[else (formatter l)])))
|
||||
|
|
|
|||
|
|
@ -3272,7 +3272,7 @@
|
|||
(define (convert-function-calls e vars &-vars c++-class live-vars complain-not-in memcpy? braces-are-aggregates?)
|
||||
;; e is a single statement
|
||||
;; Reverse to calculate live vars as we go.
|
||||
;; Also, it's easier to look for parens and then inspect preceeding
|
||||
;; Also, it's easier to look for parens and then inspect preceding
|
||||
;; to find function calls.
|
||||
;; complain-not-in is ither #f [function calls are ok], a string [not ok, string describes way],
|
||||
;; or (list ok-exprs ...)) [in a rator position, only ok-expr calls are allowed,
|
||||
|
|
@ -3608,7 +3608,7 @@
|
|||
(not (null? (cdr assignee)))
|
||||
;; ok if name starts with "_stk_"
|
||||
(not (regexp-match re:_stk_ (symbol->string (tok-n (car assignee)))))
|
||||
;; ok if preceeding is else or label terminator
|
||||
;; ok if preceding is else or label terminator
|
||||
(not (memq (tok-n (cadr assignee)) '(else |:|)))
|
||||
;; assignment to field in record is ok
|
||||
(not (and (eq? (tok-n (cadr assignee)) '|.|)
|
||||
|
|
@ -3617,7 +3617,7 @@
|
|||
(null? (cdddr assignee))))
|
||||
;; ok if preceded by XFORM_OK_ASSIGN
|
||||
(not (eq? (tok-n (cadr assignee)) 'XFORM_OK_ASSIGN))
|
||||
;; ok if preceeding is `if', `until', etc.
|
||||
;; ok if preceding is `if', `until', etc.
|
||||
(not (and (parens? (cadr assignee))
|
||||
(pair? (cddr assignee))
|
||||
(memq (tok-n (caddr assignee)) '(if while for until))))))
|
||||
|
|
|
|||
|
|
@ -236,7 +236,7 @@ Returns the class of an object (or the meta-class of a class).}
|
|||
boolean?]{
|
||||
|
||||
Adds a method to a class. The @scheme[type] argument must be a FFI C
|
||||
type (@seeCtype) that matches both @scheme[imp] and and the not
|
||||
type (@seeCtype) that matches both @scheme[imp] and the not
|
||||
Objective-C type string @scheme[type-encoding].}
|
||||
|
||||
@defproc[(class_addIvar [cls _Class] [name string?] [size exact-nonnegative-integer?]
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
(error '_sndfile "got a NULL pointer (bad info?)")))))
|
||||
|
||||
;; sf_count_t is a count type that depends on the operating system however it
|
||||
;; seems to be a long int for all teh supported ones so in this scase we just
|
||||
;; seems to be a long int for all the supported ones so in this scase we just
|
||||
;; define it as two ints.
|
||||
(define _sf-count-t _int64)
|
||||
|
||||
|
|
|
|||
|
|
@ -543,7 +543,7 @@
|
|||
;; this flag is specific to this frame
|
||||
;; the true state of the info panel is
|
||||
;; the combination of this flag and the
|
||||
;; the 'framework:show-status-line preference
|
||||
;; 'framework:show-status-line preference
|
||||
;; as shown in update-info-visibility
|
||||
(define info-hidden? #f)
|
||||
(define/public (hide-info)
|
||||
|
|
|
|||
|
|
@ -316,7 +316,7 @@ careful charlie
|
|||
[(eq? their-loc 'start)
|
||||
(let ([their-enter-spot (get-enter-pos (pawn-color pawn))])
|
||||
;; this code assumes that the enter-pos's are not within 6 of
|
||||
;; where the board indicies wrap around.
|
||||
;; where the board indices wrap around.
|
||||
(cond
|
||||
[(= my-loc their-enter-spot)
|
||||
(add-single-roll-chances 5)
|
||||
|
|
|
|||
|
|
@ -252,10 +252,10 @@
|
|||
(define/private (draw-cell draw-i draw-j)
|
||||
(let-values ([(xd yd wd hd) (ij->xywh draw-i draw-j)])
|
||||
(let* ([dc (get-dc)]
|
||||
[indicies (board-ref board draw-i draw-j)])
|
||||
(if indicies
|
||||
(let ([bm-i (loc-x indicies)]
|
||||
[bm-j (loc-y indicies)])
|
||||
[indices (board-ref board draw-i draw-j)])
|
||||
(if indices
|
||||
(let ([bm-i (loc-x indices)]
|
||||
[bm-j (loc-y indices)])
|
||||
(let-values ([(xs ys ws hs) (ij->xywh bm-i bm-j)])
|
||||
(send dc set-pen pict-pen)
|
||||
(send dc set-brush pict-brush)
|
||||
|
|
|
|||
|
|
@ -152,7 +152,7 @@ Keywords for configuring @scheme[check:]:
|
|||
@item{@indexed-scheme[:student-line]---when a submission is converted
|
||||
to text, it begins with lines describing the students that have
|
||||
submitted it; this is used to specify the format of these lines. It
|
||||
is a string with holes that that @scheme[user-substs] fills out.
|
||||
is a string with holes that @scheme[user-substs] fills out.
|
||||
The default is @scheme["Student: {username} ({Full Name} <{Email}>)"],
|
||||
which requires @scheme["Full Name"] and @scheme["Email"] entries in
|
||||
the server's extra-fields configuration. These lines are prefixed
|
||||
|
|
|
|||
|
|
@ -190,7 +190,7 @@
|
|||
|
||||
(provide tree-filter)
|
||||
;; (string -> any) tree -> tree
|
||||
;; If the filter returns '+ or '- this qualifies or disqualifies the the
|
||||
;; If the filter returns '+ or '- this qualifies or disqualifies the
|
||||
;; current tree immediately, otherwise recurse down directories. If any other
|
||||
;; result is returned for directories scanning continues, and for files they
|
||||
;; are included if the result is not #f.
|
||||
|
|
|
|||
|
|
@ -1519,7 +1519,7 @@
|
|||
(if (and gsnip
|
||||
(has-flag? (snip->flags gsnip) HARD-NEWLINE)
|
||||
(eq? (snip->next gsnip) snip))
|
||||
;; preceeding snip was a newline, so the new slip belongs on the next line:
|
||||
;; preceding snip was a newline, so the new slip belongs on the next line:
|
||||
(let* ([oldline (snip->line gsnip)]
|
||||
[inserted-new-line?
|
||||
(if (mline-next oldline)
|
||||
|
|
@ -4188,7 +4188,7 @@
|
|||
(has-flag? (snip->flags gsnip) NEWLINE)
|
||||
(not (has-flag? (snip->flags gsnip) HARD-NEWLINE)))
|
||||
(begin
|
||||
;; we want the snip on the same line as the preceeding snip:
|
||||
;; we want the snip on the same line as the preceding snip:
|
||||
(if (snip->next gsnip)
|
||||
(insert-snip (snip->next gsnip) snip)
|
||||
(append-snip snip))
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ work right.
|
|||
Most of the exports are just for use in 2htdp/image
|
||||
(technically, 2htdp/private/image-more). The main
|
||||
use of this library is the snip class addition it
|
||||
does (and any code that that does not depend on
|
||||
does (and any code that does not depend on
|
||||
has been moved out).
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@
|
|||
(super-new)
|
||||
(set-snipclass matrix-snip-class)))
|
||||
|
||||
;; the snip class for matricies
|
||||
;; the snip class for matrices
|
||||
(define matrix-snip-class%
|
||||
(class cache-image-snip-class%
|
||||
(super-new)
|
||||
|
|
|
|||
|
|
@ -348,7 +348,7 @@
|
|||
(with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))]
|
||||
[(dom-length dom-index ...) (generate-indices (syntax (dom ...)))]
|
||||
[(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(arg-x ...) (generate-temporaries (syntax (dom ...)))])
|
||||
(with-syntax ([(name-dom-contract-x ...)
|
||||
|
|
@ -391,7 +391,7 @@
|
|||
(with-syntax ([(rng-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[(rng-contract-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[(rng-projection-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[(rng-length rng-index ...) (generate-indicies (syntax (rng ...)))]
|
||||
[(rng-length rng-index ...) (generate-indices (syntax (rng ...)))]
|
||||
[(rng-ant-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[(res-x ...) (generate-temporaries (syntax (rng ...)))])
|
||||
(values
|
||||
|
|
@ -491,7 +491,7 @@
|
|||
[(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(arg-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))]
|
||||
[(dom-length dom-index ...) (generate-indices (syntax (dom ...)))]
|
||||
[(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[dom-rest-x (car (generate-temporaries (list (syntax rest))))]
|
||||
[dom-rest-contract-x (car (generate-temporaries (list (syntax rest))))]
|
||||
|
|
@ -501,7 +501,7 @@
|
|||
[(rng-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[(rng-contract-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[(rng-projection-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[(rng-length rng-index ...) (generate-indicies (syntax (rng ...)))]
|
||||
[(rng-length rng-index ...) (generate-indices (syntax (rng ...)))]
|
||||
[(rng-ant-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[(res-x ...) (generate-temporaries (syntax (rng ...)))]
|
||||
[arity (length (syntax->list (syntax (dom ...))))])
|
||||
|
|
@ -564,7 +564,7 @@
|
|||
[(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(arg-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))]
|
||||
[(dom-length dom-index ...) (generate-indices (syntax (dom ...)))]
|
||||
[(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[dom-rest-x (car (generate-temporaries (list (syntax rest))))]
|
||||
[dom-rest-contract-x (car (generate-temporaries (list (syntax rest))))]
|
||||
|
|
@ -682,7 +682,7 @@
|
|||
(with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))]
|
||||
[(dom-length dom-index ...) (generate-indices (syntax (dom ...)))]
|
||||
[(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))]
|
||||
[(arg-x ...) (generate-temporaries (syntax (dom ...)))])
|
||||
(values
|
||||
|
|
@ -1099,10 +1099,10 @@
|
|||
(syntax (let ([name rhs]) name)))]
|
||||
[else to-be-named])))
|
||||
|
||||
;; generate-indicies : syntax[list] -> (cons number (listof number))
|
||||
;; generate-indices : syntax[list] -> (cons number (listof number))
|
||||
;; given a syntax list of length `n', returns a list containing
|
||||
;; the number n followed by th numbers from 0 to n-1
|
||||
(define (generate-indicies stx)
|
||||
(define (generate-indices stx)
|
||||
(let ([n (length (syntax->list stx))])
|
||||
(cons n
|
||||
(let loop ([i n])
|
||||
|
|
|
|||
|
|
@ -469,7 +469,7 @@ c_plcont(PLFLT **f, PLINT nx, PLINT ny, PLINT kx, PLINT lx,
|
|||
* The subrange of indices used for contouring is kx to lx in the x
|
||||
* direction and from ky to ly in the y direction. The array of contour
|
||||
* levels is clevel(nlevel), and "pltr" is the name of a function which
|
||||
* transforms array indicies into world coordinates.
|
||||
* transforms array indices into world coordinates.
|
||||
*
|
||||
* Note that the fortran-like minimum and maximum indices (kx, lx, ky, ly)
|
||||
* are translated into more C-like ones. I've only kept them as they are
|
||||
|
|
|
|||
|
|
@ -216,7 +216,7 @@ a version as a sequence of exact, non-negative integers. Roughly, such
|
|||
a name is converted to a PLT Scheme module pathname (see @secref[#:doc
|
||||
guide-src "module-paths"]) by concatenating the symbols with a
|
||||
@litchar{/} separator, and then appending the version integers each
|
||||
with a preceeding @litchar{-}. As a special case, when an @|r6rs| path
|
||||
with a preceding @litchar{-}. As a special case, when an @|r6rs| path
|
||||
contains a single symbol (optionally followed by a version), a
|
||||
@schemeidfont{main} symbol is effectively inserted after the initial
|
||||
symbol. See below for further encoding considerations.
|
||||
|
|
|
|||
|
|
@ -191,7 +191,7 @@
|
|||
(bytes-set! tgt left LF)
|
||||
(set! buffer #f)
|
||||
(add1 left)]))])))
|
||||
(make-input-port 'readline reader #f close!)))
|
||||
(make-input-port 'readline-input reader #f close!)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Reading functions
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@
|
|||
;; and a 'where' in the second clause
|
||||
(test (render-metafunction T) "metafunction-T.png")
|
||||
|
||||
;; in this test, teh `x' is italic and the 'z' is sf, since 'x' is in the grammar, and 'z' is not.
|
||||
;; in this test, the `x' is italic and the 'z' is sf, since 'x' is in the grammar, and 'z' is not.
|
||||
(test (render-lw
|
||||
lang
|
||||
(to-lw ((λ (x) (x x))
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
#lang scheme/base (provide stamp) (define stamp "4feb2010")
|
||||
#lang scheme/base (provide stamp) (define stamp "6feb2010")
|
||||
|
|
|
|||
|
|
@ -76,8 +76,8 @@ it around flattened out.
|
|||
[struct-maker struct-maker/val]
|
||||
[predicate predicate/val]
|
||||
[the-contract (add-suffix "-contract")]
|
||||
[(selector-indicies ...) (nums-up-to field-count/val)]
|
||||
[(selector-indicies+1 ...) (map add1 (nums-up-to field-count/val))]
|
||||
[(selector-indices ...) (nums-up-to field-count/val)]
|
||||
[(selector-indices+1 ...) (map add1 (nums-up-to field-count/val))]
|
||||
[(ctc-x ...) (generate-temporaries (syntax (fields ...)))]
|
||||
[(f-x ...) f-x/vals]
|
||||
[((f-xs ...) ...) f-xs/vals]
|
||||
|
|
@ -113,7 +113,7 @@ it around flattened out.
|
|||
(lambda (k v)
|
||||
(when (unknown? v)
|
||||
(let ([proc (unknown-proc v)])
|
||||
(let ([new (proc (wrap-get stct selector-indicies+1) ...)])
|
||||
(let ([new (proc (wrap-get stct selector-indices+1) ...)])
|
||||
(cond
|
||||
[(unknown? new)
|
||||
(set! any-unknown? #t)]
|
||||
|
|
@ -177,7 +177,7 @@ it around flattened out.
|
|||
(cond
|
||||
[(raw-predicate stct)
|
||||
;; found the original value
|
||||
(values #f (get stct selector-indicies) ...)]
|
||||
(values #f (get stct selector-indices) ...)]
|
||||
|
||||
[(opt-wrap-predicate stct)
|
||||
(let ((inner (opt-wrap-get stct 0)))
|
||||
|
|
@ -187,11 +187,11 @@ it around flattened out.
|
|||
(let-values ([(inner-stct fields ...) (loop inner)])
|
||||
(let-values ([(fields ...) (enforcer stct fields ...)])
|
||||
(opt-wrap-set stct 0 #f)
|
||||
(opt-wrap-set stct selector-indicies+1 fields) ...
|
||||
(opt-wrap-set stct selector-indices+1 fields) ...
|
||||
(values stct fields ...))))
|
||||
|
||||
;; found a cached version
|
||||
(values #f (opt-wrap-get stct selector-indicies+1) ...)))]
|
||||
(values #f (opt-wrap-get stct selector-indices+1) ...)))]
|
||||
[(wrap-predicate stct)
|
||||
(let ([inner (wrap-get stct 0)])
|
||||
(if inner
|
||||
|
|
@ -201,19 +201,19 @@ it around flattened out.
|
|||
(let-values ([(fields ...)
|
||||
(rewrite-fields stct contract/info fields ...)])
|
||||
(wrap-set stct 0 #f)
|
||||
(wrap-set stct selector-indicies+1 fields) ...
|
||||
(wrap-set stct selector-indices+1 fields) ...
|
||||
(evaluate-attrs stct contract/info)
|
||||
(values stct fields ...))))
|
||||
|
||||
;; found a cached version of the value
|
||||
(values #f (wrap-get stct selector-indicies+1) ...)))]))])
|
||||
(values #f (wrap-get stct selector-indices+1) ...)))]))])
|
||||
(cond
|
||||
[(opt-wrap-predicate stct) (opt-wrap-get stct i+1)]
|
||||
[(wrap-predicate stct) (wrap-get stct i+1)])))
|
||||
|
||||
(define (rewrite-fields parent contract/info ctc-x ...)
|
||||
(let* ([f-x (let* ([ctc-field (contract-get (contract/info-contract contract/info)
|
||||
selector-indicies)]
|
||||
selector-indices)]
|
||||
[ctc (if (contract-struct? ctc-field)
|
||||
ctc-field
|
||||
(ctc-field f-xs ...))]
|
||||
|
|
@ -229,8 +229,8 @@ it around flattened out.
|
|||
(define (stronger-lazy-contract? a b)
|
||||
(and (contract-predicate b)
|
||||
(contract-stronger?
|
||||
(contract-get a selector-indicies)
|
||||
(contract-get b selector-indicies)) ...))
|
||||
(contract-get a selector-indices)
|
||||
(contract-get b selector-indices)) ...))
|
||||
|
||||
(define (lazy-contract-proj ctc)
|
||||
(λ (blame)
|
||||
|
|
@ -279,7 +279,7 @@ it around flattened out.
|
|||
(contract-maker ctc-x ... #f)))
|
||||
|
||||
(define (selectors x)
|
||||
(burrow-in x 'selectors selector-indicies))
|
||||
(burrow-in x 'selectors selector-indices))
|
||||
...
|
||||
|
||||
(define (burrow-in struct selector-name i)
|
||||
|
|
@ -300,7 +300,7 @@ it around flattened out.
|
|||
(define (lazy-contract-name ctc)
|
||||
(do-contract-name 'struct/c
|
||||
'struct/dc
|
||||
(list (contract-get ctc selector-indicies) ...)
|
||||
(list (contract-get ctc selector-indices) ...)
|
||||
'(fields ...)
|
||||
(contract-get ctc field-count)))
|
||||
|
||||
|
|
@ -316,7 +316,7 @@ it around flattened out.
|
|||
#f
|
||||
(+ field-count 1) ;; extra field is for synthesized attribute ctcs
|
||||
;; it is a list whose first element is
|
||||
;; a procedure (called once teh attrs are known) that
|
||||
;; a procedure (called once the attrs are known) that
|
||||
;; indicates if the test passes. the rest of the elements are
|
||||
;; procedures that build the attrs
|
||||
;; this field is #f when there is no synthesized attrs
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
scheme/control
|
||||
scheme/stxparam scheme/splicing)
|
||||
|
||||
(provide yield generator in-generator infinite-generator
|
||||
(provide yield generator generator-state in-generator infinite-generator
|
||||
sequence->generator sequence->repeated-generator)
|
||||
|
||||
;; (define-syntax-parameter yield
|
||||
|
|
@ -44,25 +44,56 @@
|
|||
(lambda (v)
|
||||
(error 'yield "must be called in the context of a generator"))))
|
||||
|
||||
(define (yield value)
|
||||
((current-yielder) value))
|
||||
(define yield
|
||||
(case-lambda [() ((current-yielder))]
|
||||
[(v) ((current-yielder) v)]
|
||||
[vs (apply (current-yielder) vs)]))
|
||||
|
||||
(define yield-tag (make-continuation-prompt-tag))
|
||||
|
||||
(define-syntax-rule (generator body0 body ...)
|
||||
(let ()
|
||||
(let ([state 'fresh])
|
||||
(define (cont)
|
||||
(define (yielder value)
|
||||
(shift-at yield-tag k (set! cont k) value))
|
||||
(define (yielder . vs)
|
||||
(set! state 'suspended)
|
||||
(shift-at yield-tag k (set! cont k) (apply values vs)))
|
||||
(set! state 'running)
|
||||
(reset-at yield-tag
|
||||
(parameterize ([current-yielder yielder])
|
||||
(let ([retval (begin body0 body ...)])
|
||||
;; normal return:
|
||||
(set! cont (lambda () retval))
|
||||
retval))))
|
||||
(define (generator) (cont))
|
||||
(call-with-values
|
||||
(lambda () (begin body0 body ...))
|
||||
;; get here only on at the end of the generator
|
||||
(lambda rs
|
||||
(set! cont (lambda () (set! state 'done) (apply values rs)))
|
||||
(cont))))))
|
||||
(define (err [what "send a value to"])
|
||||
(error 'generator "cannot ~a a ~a generator" what state))
|
||||
(define generator
|
||||
(case-lambda
|
||||
[() (if (eq? state 'running)
|
||||
(err "call")
|
||||
(begin (set! state 'running) (cont)))]
|
||||
;; yield-tag means return the state (see `generator-state' below)
|
||||
[(x) (cond [(eq? x yield-tag) state]
|
||||
[(memq state '(suspended running))
|
||||
(set! state 'running)
|
||||
(cont x)]
|
||||
[else (err)])]
|
||||
[xs (if (memq state '(suspended running))
|
||||
(begin (set! state 'running) (apply cont xs))
|
||||
(err))]))
|
||||
generator))
|
||||
|
||||
;; Get the state -- this is a hack: uses yield-tag as a hidden value that makes
|
||||
;; the generator return its state. Protect against grabbing this tag (eg, with
|
||||
;; (generator-state values)) by inspecting the result (so it can still be
|
||||
;; deceived, but that will be harmless).
|
||||
(define (generator-state g)
|
||||
(let ([s (and (procedure? g) (procedure-arity-includes? g 1) (g yield-tag))])
|
||||
(if (memq s '(fresh running suspended done))
|
||||
s
|
||||
(raise-type-error 'generator-state "generator" g))))
|
||||
|
||||
(define-syntax-rule (infinite-generator body0 body ...)
|
||||
(generator (let loop () body0 body ... (loop))))
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
(provide split-rows)
|
||||
|
||||
;; split-rows : Listof[Row] -> Listof[Listof[Row]]
|
||||
;; takes a matrix, and returns a list of matricies
|
||||
;; takes a matrix, and returns a list of matrices
|
||||
;; each returned matrix does not require the mixture rule to do compilation of
|
||||
;; the first column.
|
||||
(define (split-rows rows [acc null])
|
||||
|
|
|
|||
|
|
@ -24,16 +24,16 @@ doing these checks.
|
|||
|
||||
|#
|
||||
|
||||
;; This code works with unsafe operations, but don't use it for a while to
|
||||
;; catch potential problems.
|
||||
;; (#%require (rename '#%unsafe i+ unsafe-fx+)
|
||||
;; (rename '#%unsafe i- unsafe-fx-)
|
||||
;; (rename '#%unsafe i= unsafe-fx=)
|
||||
;; (rename '#%unsafe i< unsafe-fx<)
|
||||
;; (rename '#%unsafe i<= unsafe-fx<=)
|
||||
;; (rename '#%unsafe i>> unsafe-fxrshift)
|
||||
;; (rename '#%unsafe vref unsafe-vector-ref)
|
||||
;; (rename '#%unsafe vset! unsafe-vector-set!))
|
||||
;; This code works with unsafe operations, if there are problems, the commented
|
||||
;; chunk of code below can be used to run it in safe mode.
|
||||
(#%require (rename '#%unsafe i+ unsafe-fx+)
|
||||
(rename '#%unsafe i- unsafe-fx-)
|
||||
(rename '#%unsafe i= unsafe-fx=)
|
||||
(rename '#%unsafe i< unsafe-fx<)
|
||||
(rename '#%unsafe i<= unsafe-fx<=)
|
||||
(rename '#%unsafe i>> unsafe-fxrshift)
|
||||
(rename '#%unsafe vref unsafe-vector-ref)
|
||||
(rename '#%unsafe vset! unsafe-vector-set!))
|
||||
|
||||
(define sort (let ()
|
||||
|
||||
|
|
@ -42,14 +42,15 @@ doing these checks.
|
|||
[(dr (foo . pattern) template)
|
||||
(define-syntax foo (syntax-rules () [(_ . pattern) template]))]))
|
||||
|
||||
(define-syntax-rule (i+ x y) (+ x y))
|
||||
(define-syntax-rule (i- x y) (- x y))
|
||||
(define-syntax-rule (i= x y) (= x y))
|
||||
(define-syntax-rule (i< x y) (< x y))
|
||||
(define-syntax-rule (i<= x y) (<= x y))
|
||||
(define-syntax-rule (i>> x y) (arithmetic-shift x (- y)))
|
||||
(define-syntax-rule (vref v i) (vector-ref v i))
|
||||
(define-syntax-rule (vset! v i x) (vector-set! v i x))
|
||||
;; Use this to make it safe:
|
||||
;; (define-syntax-rule (i+ x y) (+ x y))
|
||||
;; (define-syntax-rule (i- x y) (- x y))
|
||||
;; (define-syntax-rule (i= x y) (= x y))
|
||||
;; (define-syntax-rule (i< x y) (< x y))
|
||||
;; (define-syntax-rule (i<= x y) (<= x y))
|
||||
;; (define-syntax-rule (i>> x y) (arithmetic-shift x (- y)))
|
||||
;; (define-syntax-rule (vref v i) (vector-ref v i))
|
||||
;; (define-syntax-rule (vset! v i x) (vector-set! v i x))
|
||||
|
||||
(define-syntax-rule (sort-internal-body v *<? n has-getkey? getkey)
|
||||
(let* ([n/2- (i>> n 1)] [n/2+ (i- n n/2-)])
|
||||
|
|
|
|||
|
|
@ -98,7 +98,7 @@
|
|||
(let ([s (read-bytes drop input-port)])
|
||||
(when out
|
||||
(display s out)))
|
||||
;; Get the matching part, and shift matching indicies
|
||||
;; Get the matching part, and shift matching indices
|
||||
(let ([s (read-bytes (- (cdar m) drop) input-port)])
|
||||
(cons s
|
||||
(map (lambda (p)
|
||||
|
|
|
|||
|
|
@ -430,8 +430,8 @@
|
|||
(define (input->port inp)
|
||||
;; returns #f when it can't create a port
|
||||
(cond [(input-port? inp) inp]
|
||||
[(string? inp) (open-input-string inp)]
|
||||
[(bytes? inp) (open-input-bytes inp)]
|
||||
[(string? inp) (open-input-string inp #f)]
|
||||
[(bytes? inp) (open-input-bytes inp #f)]
|
||||
[(path? inp) (open-input-file inp)]
|
||||
[else #f]))
|
||||
|
||||
|
|
@ -761,28 +761,22 @@
|
|||
(cond [(eof-object? r) (terminate+kill! #t #t)]
|
||||
[(eq? (car r) 'exn) (raise (cdr r))]
|
||||
[else (apply values (cdr r))]))]))
|
||||
(define get-uncovered
|
||||
(case-lambda
|
||||
[() (get-uncovered #t)]
|
||||
[(prog?) (get-uncovered prog? 'program)]
|
||||
[(prog? src)
|
||||
(unless uncovered
|
||||
(error 'get-uncovered-expressions "no coverage information"))
|
||||
(let ([uncovered (if prog? (car uncovered) ((cadr uncovered)))])
|
||||
(if src
|
||||
(filter (lambda (x) (equal? src (syntax-source x))) uncovered)
|
||||
uncovered))]))
|
||||
(define (get-uncovered [prog? #t] [src 'program])
|
||||
(unless uncovered
|
||||
(error 'get-uncovered-expressions "no coverage information"))
|
||||
(let ([uncovered (if prog? (car uncovered) ((cadr uncovered)))])
|
||||
(if src
|
||||
(filter (lambda (x) (equal? src (syntax-source x))) uncovered)
|
||||
uncovered)))
|
||||
(define (output-getter p)
|
||||
(if (procedure? p) (user-eval (make-evaluator-message 'thunk (list p))) p))
|
||||
(define input-putter
|
||||
(case-lambda
|
||||
[() (input-putter input)]
|
||||
[(arg) (cond [(not input)
|
||||
(error 'put-input "evaluator input is not 'pipe")]
|
||||
[(or (string? arg) (bytes? arg))
|
||||
(display arg input) (flush-output input)]
|
||||
[(eof-object? arg) (close-output-port input)]
|
||||
[else (error 'put-input "bad argument: ~e" arg)])]))
|
||||
(define (input-putter [arg input])
|
||||
(cond [(not input)
|
||||
(error 'put-input "evaluator input is not 'pipe")]
|
||||
[(or (string? arg) (bytes? arg))
|
||||
(display arg input) (flush-output input)]
|
||||
[(eof-object? arg) (close-output-port input)]
|
||||
[else (error 'put-input "bad argument: ~e" arg)]))
|
||||
(define (evaluator expr)
|
||||
(if (evaluator-message? expr)
|
||||
(let ([msg (evaluator-message-msg expr)])
|
||||
|
|
@ -832,13 +826,12 @@
|
|||
;; set up the IO context
|
||||
[current-input-port
|
||||
(let ([inp (sandbox-input)])
|
||||
(cond
|
||||
[(not inp) null-input]
|
||||
[(input->port inp) => values]
|
||||
[(and (procedure? inp) (procedure-arity-includes? inp 0)) (inp)]
|
||||
[(eq? 'pipe inp)
|
||||
(let-values ([(i o) (make-pipe)]) (set! input o) i)]
|
||||
[else (error 'make-evaluator "bad sandbox-input: ~e" inp)]))]
|
||||
(cond [(not inp) null-input]
|
||||
[(input->port inp) => values]
|
||||
[(and (procedure? inp) (procedure-arity-includes? inp 0)) (inp)]
|
||||
[(eq? 'pipe inp)
|
||||
(let-values ([(i o) (make-pipe)]) (set! input o) i)]
|
||||
[else (error 'make-evaluator "bad sandbox-input: ~e" inp)]))]
|
||||
[current-output-port (make-output 'output (sandbox-output)
|
||||
(lambda (o) (set! output o)))]
|
||||
[current-error-port (make-output 'error-output (sandbox-error-output)
|
||||
|
|
|
|||
|
|
@ -285,7 +285,7 @@ and thus used as a contract.
|
|||
|
||||
But many other values also play double duty as contracts.
|
||||
For example, if your function accepts a number or @scheme[#f],
|
||||
@scheme[(or/c number? #f)] sufficies. Similarly, the @scheme[result/c] contract
|
||||
@scheme[(or/c number? #f)] suffices. Similarly, the @scheme[result/c] contract
|
||||
could have been written with a @scheme[0] in place of @scheme[zero?].
|
||||
|
||||
Even better, if you use a regular expression as a contract, the contract
|
||||
|
|
|
|||
|
|
@ -470,7 +470,7 @@ form is evaluated:
|
|||
3]
|
||||
]
|
||||
|
||||
The substition and @tech{location}-generation step of procedure
|
||||
The substitution and @tech{location}-generation step of procedure
|
||||
application requires that the argument is a @tech{value}. Therefore,
|
||||
in @scheme[((lambda (x) (+ x 10)) (+ 1 2))], the @scheme[(+ 1 2)]
|
||||
sub-expression must be simplified to the @tech{value} @scheme[3], and
|
||||
|
|
|
|||
|
|
@ -111,7 +111,7 @@ types can generate events (see @scheme[prop:evt]).
|
|||
|
||||
@item{@scheme[_choice] --- an event returned by @scheme[choice-evt] is
|
||||
ready when one or more of the @scheme[_evt]s supplied to
|
||||
@scheme[chocie-evt] are ready. If the choice event is chosen, one of
|
||||
@scheme[choice-evt] are ready. If the choice event is chosen, one of
|
||||
its ready @scheme[_evt]s is chosen pseudo-randomly, and the result is
|
||||
the chosen @scheme[_evt]'s result.}
|
||||
|
||||
|
|
|
|||
|
|
@ -59,8 +59,8 @@ Lrange ::= ^ Lrange contains _^_
|
|||
| Srange Lrange contains everything in Srange #co
|
||||
Look ::= (?=Regexp) Match if Regexp matches #mode
|
||||
| (?!Regexp) Match if Regexp doesn't match #mode
|
||||
| (?<=Regexp) Match if Regexp matches preceeding #mode
|
||||
| (?<!Regexp) Match if Regexp doesn't match preceeding #mode
|
||||
| (?<=Regexp) Match if Regexp matches preceding #mode
|
||||
| (?<!Regexp) Match if Regexp doesn't match preceding #mode
|
||||
Pred ::= (N) True if Nth _(_ has a match #mode
|
||||
| Look True if Look matches #mode
|
||||
Srange ::= ... ... #px
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@ less or equal to @scheme[end] if @scheme[step] is negative.
|
|||
|
||||
@defproc[(in-naturals [start exact-nonnegative-integer? 0]) sequence?]{
|
||||
Returns an infinite sequence of exact integers starting with
|
||||
@scheme[start], where each element is one more than the preceeding
|
||||
@scheme[start], where each element is one more than the preceding
|
||||
element. @speed[in-naturals "integer"]}
|
||||
|
||||
@defproc[(in-list [lst list?]) sequence?]{
|
||||
|
|
|
|||
|
|
@ -145,13 +145,13 @@ needed to strip lexical and source-location information recursively.}
|
|||
(list/c any/c
|
||||
(or/c exact-positive-integer? #f)
|
||||
(or/c exact-nonnegative-integer? #f)
|
||||
(or/c exact-nonnegative-integer? #f)
|
||||
(or/c exact-positive-integer? #f))
|
||||
(or/c exact-positive-integer? #f)
|
||||
(or/c exact-nonnegative-integer? #f))
|
||||
(vector/c any/c
|
||||
(or/c exact-positive-integer? #f)
|
||||
(or/c exact-nonnegative-integer? #f)
|
||||
(or/c exact-nonnegative-integer? #f)
|
||||
(or/c exact-positive-integer? #f)))
|
||||
(or/c exact-positive-integer? #f)
|
||||
(or/c exact-nonnegative-integer? #f)))
|
||||
#f]
|
||||
[prop (or/c syntax? #f) #f]
|
||||
[cert (or/c syntax? #f) #f])
|
||||
|
|
|
|||
|
|
@ -142,7 +142,7 @@ A syntax object matches a @scheme[pattern] as follows:
|
|||
@specsubform[const]{
|
||||
|
||||
A @scheme[const] is any datum that does not match one of the
|
||||
preceeding forms; a syntax object matches a @scheme[const] pattern
|
||||
preceding forms; a syntax object matches a @scheme[const] pattern
|
||||
when its datum is @scheme[equal?] to the @scheme[quote]d
|
||||
@scheme[const].}
|
||||
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@
|
|||
;; and tm:julian-day-at-zero-seconds, which refer to the '0' of CURRENT-SECONDS.
|
||||
;;
|
||||
;; SRFI-6, String Ports, and SRFI-8, RECEIVE: Binding Multiple Values,
|
||||
;; are also used. MzScheme has String Ports built-in. The RECIEVE form
|
||||
;; are also used. MzScheme has String Ports built-in. The RECEIVE form
|
||||
;; is copied below.
|
||||
;;
|
||||
; srfi-8: receive
|
||||
|
|
|
|||
|
|
@ -285,7 +285,7 @@ please adhere to these guidelines:
|
|||
(plt:hd:manual-installed-date "(~a installeret)")
|
||||
; Help Desk configuration
|
||||
;; refreshing manuals
|
||||
(plt:hd:refresh-clearing-indicies "Renser forgemte indekser")
|
||||
(plt:hd:refresh-clearing-indices "Renser forgemte indekser")
|
||||
;; should not mention `SVN' (plt:hd:refresh-done "Færdig med at opdatere SVN-manualer")
|
||||
(plt:hd:refreshing-manuals "Genhenter manualer")
|
||||
(plt:hd:refresh-downloading... "Henter ~a...")
|
||||
|
|
|
|||
|
|
@ -312,7 +312,7 @@ please adhere to these guidelines:
|
|||
(plt:hd:refresh-downloading... "Downloading ~a...")
|
||||
(plt:hd:refresh-deleting... "Deleting old version of ~a...")
|
||||
(plt:hd:refresh-installing... "Installing new version of ~a...")
|
||||
(plt:hd:refresh-clearing-indicies "Clearing cached indices")
|
||||
(plt:hd:refresh-clearing-indices "Clearing cached indices")
|
||||
(plt:hd:refreshing-manuals-finished "Finished.")
|
||||
(plt:hd:about-help-desk "About Help Desk")
|
||||
(plt:hd:help-desk-about-string
|
||||
|
|
@ -450,7 +450,7 @@ please adhere to these guidelines:
|
|||
(revert-to-defaults "Revert to Defaults")
|
||||
|
||||
(black-on-white-color-scheme "Black on White") ;; these two appear in the color preferences dialog on butttons
|
||||
(white-on-black-color-scheme "White on Black") ;; clicking the buttons changes teh color schemes to some defaults that've been set up.
|
||||
(white-on-black-color-scheme "White on Black") ;; clicking the buttons changes the color schemes to some defaults that've been set up.
|
||||
|
||||
; title of the color choosing dialog
|
||||
|
||||
|
|
|
|||
|
|
@ -312,7 +312,7 @@
|
|||
(plt:hd:refresh-downloading... "Téléchargement de ~a...")
|
||||
(plt:hd:refresh-deleting... "Effacement de l'ancienne version de ~a...")
|
||||
(plt:hd:refresh-installing... "Installation de la nouvelle version de ~a...")
|
||||
(plt:hd:refresh-clearing-indicies "Effacement des indices cachés")
|
||||
(plt:hd:refresh-clearing-indices "Effacement des indices cachés")
|
||||
(plt:hd:refreshing-manuals-finished "Terminé.")
|
||||
(plt:hd:about-help-desk "A propos de l'Aide")
|
||||
(plt:hd:help-desk-about-string
|
||||
|
|
@ -450,7 +450,7 @@
|
|||
(revert-to-defaults "Retour aux valeurs par défaut")
|
||||
|
||||
(black-on-white-color-scheme "Noir sur blanc") ;; these two appear in the color preferences dialog on butttons
|
||||
(white-on-black-color-scheme "Blanc sur noir") ;; clicking the buttons changes teh color schemes to some defaults that've been set up.
|
||||
(white-on-black-color-scheme "Blanc sur noir") ;; clicking the buttons changes the color schemes to some defaults that've been set up.
|
||||
|
||||
; title of the color choosing dialog
|
||||
|
||||
|
|
|
|||
|
|
@ -212,7 +212,7 @@
|
|||
(plt:hd:refresh-downloading... "~a herunterladen...")
|
||||
(plt:hd:refresh-deleting... "Alte Version von ~a löschen...")
|
||||
(plt:hd:refresh-installing... "Neue Version von ~a installieren...")
|
||||
(plt:hd:refresh-clearing-indicies "Gecachte Indizes löschen")
|
||||
(plt:hd:refresh-clearing-indices "Gecachte Indizes löschen")
|
||||
(plt:hd:refreshing-manuals-finished "Fertig.")
|
||||
(plt:hd:about-help-desk "Über das Hilfezentrum")
|
||||
(plt:hd:help-desk-about-string
|
||||
|
|
@ -348,7 +348,7 @@
|
|||
(revert-to-defaults "Standardeinstellung wiederherstellen")
|
||||
|
||||
(black-on-white-color-scheme "Schwarz auf Weiß") ;; these two appear in the color preferences dialog on butttons
|
||||
(white-on-black-color-scheme "Weiß auf Schwarz") ;; clicking the buttons changes teh color schemes to some defaults that've been set up.
|
||||
(white-on-black-color-scheme "Weiß auf Schwarz") ;; clicking the buttons changes the color schemes to some defaults that've been set up.
|
||||
|
||||
; title of the color choosing dialog
|
||||
|
||||
|
|
@ -951,6 +951,7 @@
|
|||
(initial-language-category "Sprache am Anfang")
|
||||
(no-language-chosen "Keine Sprache ausgewählt")
|
||||
|
||||
(module-language-name "Sprache aus Quelltext ermitteln")
|
||||
(module-language-one-line-summary "List die #lang-Zeile, um die tatsächliche Sprache zu ermitteln.")
|
||||
|
||||
(module-language-auto-text "Automatisch Zeile mit #lang") ;; shows up in the details section of the module language
|
||||
|
|
|
|||
|
|
@ -307,7 +307,7 @@ please adhere to these guidelines:
|
|||
(plt:hd:refresh-downloading... "~a をダウンロードしています...")
|
||||
(plt:hd:refresh-deleting... "古いバージョンの ~a を削除しています...")
|
||||
(plt:hd:refresh-installing... "新しいバージョンの ~a をインストールしています...")
|
||||
(plt:hd:refresh-clearing-indicies "キャッシュ内の索引を消去しています")
|
||||
(plt:hd:refresh-clearing-indices "キャッシュ内の索引を消去しています")
|
||||
(plt:hd:refreshing-manuals-finished "完了しました。")
|
||||
(plt:hd:about-help-desk "ヘルプデスクについて")
|
||||
(plt:hd:help-desk-about-string
|
||||
|
|
@ -445,7 +445,7 @@ please adhere to these guidelines:
|
|||
(revert-to-defaults "デフォルトに戻す")
|
||||
|
||||
(black-on-white-color-scheme "白地に黒") ;; these two appear in the color preferences dialog on butttons
|
||||
(white-on-black-color-scheme "黒地に白") ;; clicking the buttons changes teh color schemes to some defaults that've been set up.
|
||||
(white-on-black-color-scheme "黒地に白") ;; clicking the buttons changes the color schemes to some defaults that've been set up.
|
||||
|
||||
; title of the color choosing dialog
|
||||
|
||||
|
|
|
|||
|
|
@ -289,7 +289,7 @@ please adhere to these guidelines:
|
|||
(plt:hd:refresh-downloading... "A tirar ~a...")
|
||||
(plt:hd:refresh-deleting... "A remover a versão antiga de ~a...")
|
||||
(plt:hd:refresh-installing... "A instalar nova versão de ~a...")
|
||||
(plt:hd:refresh-clearing-indicies "A apagar os índices em cache")
|
||||
(plt:hd:refresh-clearing-indices "A apagar os índices em cache")
|
||||
(plt:hd:refreshing-manuals-finished "Concluído.")
|
||||
(plt:hd:about-help-desk "Sobre o Directorio de Ajuda")
|
||||
(plt:hd:help-desk-about-string
|
||||
|
|
|
|||
|
|
@ -229,7 +229,7 @@
|
|||
(plt:hd:refresh-downloading... "下载~a...")
|
||||
(plt:hd:refresh-deleting... "删除旧版本的~a...")
|
||||
(plt:hd:refresh-installing... "安装新版本的~a...")
|
||||
(plt:hd:refresh-clearing-indicies "清除缓存中的索引")
|
||||
(plt:hd:refresh-clearing-indices "清除缓存中的索引")
|
||||
(plt:hd:refreshing-manuals-finished "完成。")
|
||||
(plt:hd:about-help-desk "关于Help Desk")
|
||||
(plt:hd:help-desk-about-string
|
||||
|
|
@ -367,7 +367,7 @@
|
|||
(revert-to-defaults "恢复默认")
|
||||
|
||||
(black-on-white-color-scheme "白底黑字") ;; these two appear in the color preferences dialog on butttons
|
||||
(white-on-black-color-scheme "黑底白字") ;; clicking the buttons changes teh color schemes to some defaults that've been set up.
|
||||
(white-on-black-color-scheme "黑底白字") ;; clicking the buttons changes the color schemes to some defaults that've been set up.
|
||||
|
||||
; title of the color choosing dialog
|
||||
|
||||
|
|
|
|||
|
|
@ -195,11 +195,11 @@
|
|||
;; Help Desk configuration
|
||||
;; refreshing manuals
|
||||
;; should not mention `SVN' (plt:hd:refresh-done "Refresco de los manuales via SVN terminado")
|
||||
(plt:hd:refresh-clearing-indicies "Eliminando índices guardados")
|
||||
(plt:hd:refresh-clearing-indices "Eliminando índices guardados")
|
||||
(plt:hd:refresh-deleting... "Borrando la versión vieja de ~a...")
|
||||
(plt:hd:refresh-downloading... "Bajando ~a...")
|
||||
(plt:hd:refresh-installing... "Instalando nueva versión de ~a...")
|
||||
(plt:hd:refresh-clearing-indicies "Eliminando indices almacenados")
|
||||
(plt:hd:refresh-clearing-indices "Eliminando indices almacenados")
|
||||
(plt:hd:refreshing-manuals "Bajando (nuevamente) los Manuales")
|
||||
(plt:hd:refreshing-manuals-finished "Terminado.")
|
||||
(plt:hd:about-help-desk "Acerca del Módulo de Ayuda")
|
||||
|
|
|
|||
|
|
@ -228,7 +228,7 @@
|
|||
(plt:hd:refresh-downloading... "下载~a...")
|
||||
(plt:hd:refresh-deleting... "删除旧版本的~a...")
|
||||
(plt:hd:refresh-installing... "安装新版本的~a...")
|
||||
(plt:hd:refresh-clearing-indicies "清除缓存中的索引")
|
||||
(plt:hd:refresh-clearing-indices "清除缓存中的索引")
|
||||
(plt:hd:refreshing-manuals-finished "完成。")
|
||||
(plt:hd:about-help-desk "关于Help Desk")
|
||||
(plt:hd:help-desk-about-string
|
||||
|
|
@ -366,7 +366,7 @@
|
|||
(revert-to-defaults "恢复默认")
|
||||
|
||||
(black-on-white-color-scheme "白底黑字") ;; these two appear in the color preferences dialog on butttons
|
||||
(white-on-black-color-scheme "黑底白字") ;; clicking the buttons changes teh color schemes to some defaults that've been set up.
|
||||
(white-on-black-color-scheme "黑底白字") ;; clicking the buttons changes the color schemes to some defaults that've been set up.
|
||||
|
||||
; title of the color choosing dialog
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@
|
|||
;; or the other
|
||||
;; - (vector map) => template portion is a vector,
|
||||
;; contents like the list in map
|
||||
;; - (box map) => template portion is a box with substition
|
||||
;; - (box map) => template portion is a box with substitution
|
||||
;; - #s(ellipses elem count map) => template portion is an ellipses-generated list
|
||||
;; - #s(ellipses-quote map) => template has a quoting ellipses
|
||||
;; - #s(prefab v map) => template portion is a prefab
|
||||
|
|
|
|||
|
|
@ -237,7 +237,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
Constructs an arbitrary regular star polygon (a generalization of the regular polygons).
|
||||
The polygon is enclosed by a regular polygon with @scheme[side-count] sides each
|
||||
@scheme[side-length] long. The polygon is actually constructed by going from vertex to
|
||||
vertex around the regular polgon, but skipping over every @scheme[step-count] verticies.
|
||||
vertex around the regular polgon, but skipping over every @scheme[step-count] vertices.
|
||||
|
||||
For examples, if @scheme[side-count] is @scheme[5] and @scheme[step-count] is @scheme[2],
|
||||
then this function produces a shape just like @scheme[star].
|
||||
|
|
@ -250,15 +250,15 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
|
||||
}
|
||||
|
||||
@defproc*[([(polygon [verticies (listof posn?)]
|
||||
@defproc*[([(polygon [vertices (listof posn?)]
|
||||
[mode mode?]
|
||||
[color image-color?])
|
||||
image?]
|
||||
[(polygon [verticies (listof posn?)]
|
||||
[(polygon [vertices (listof posn?)]
|
||||
[outline-mode (or/c 'outline "outline")]
|
||||
[pen-or-color (or/c pen? image-color?)])
|
||||
image?])]{
|
||||
Constructs a polygon connecting the given verticies.
|
||||
Constructs a polygon connecting the given vertices.
|
||||
|
||||
@mode/color-text
|
||||
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
[use-get/put-dialog (-> (-> any) path? void?)]
|
||||
[set-module-language! (->* () (boolean?) void?)])
|
||||
|
||||
(provide fire-up-drscheme
|
||||
(provide fire-up-drscheme-and-run-tests
|
||||
save-drscheme-window-as
|
||||
do-execute
|
||||
test-util-error
|
||||
|
|
@ -622,13 +622,35 @@
|
|||
;; but just to print and return.
|
||||
(define orig-display-handler (error-display-handler))
|
||||
|
||||
(define (fire-up-drscheme)
|
||||
(dynamic-require 'drscheme #f)
|
||||
|
||||
;; reset the uncaught exception handler to be sure we kill everything (drscheme sets it)
|
||||
(uncaught-exception-handler
|
||||
(λ (x)
|
||||
(if (exn? x)
|
||||
(orig-display-handler (exn-message x) x)
|
||||
(fprintf (current-error-port) "uncaught exception ~s\n" x))
|
||||
(exit 1))))
|
||||
(define (fire-up-drscheme-and-run-tests run-test)
|
||||
(let ()
|
||||
;; change the preferences system so that it doesn't write to
|
||||
;; a file; partly to avoid problems of concurrency in drdr
|
||||
;; but also to make the test suite easier for everyone to run.
|
||||
(let ([prefs-table (make-hash)])
|
||||
(fw:preferences:low-level-put-preferences
|
||||
(lambda (names vals)
|
||||
(for-each (lambda (name val) (hash-set! prefs-table name val))
|
||||
names vals)))
|
||||
(fw:preferences:low-level-get-preference
|
||||
(lambda (name [fail (lambda () #f)])
|
||||
(hash-ref prefs-table name fail))))
|
||||
|
||||
(dynamic-require 'drscheme #f)
|
||||
|
||||
;; set all preferences to their defaults (some pref values may have
|
||||
;; been read by this point, but hopefully that won't affect much
|
||||
;; of the startup of drscheme)
|
||||
(fw:preferences:restore-defaults)
|
||||
|
||||
(thread (λ ()
|
||||
(let ([orig-display-handler (error-display-handler)])
|
||||
(uncaught-exception-handler
|
||||
(λ (x)
|
||||
(if (exn? x)
|
||||
(orig-display-handler (exn-message x) x)
|
||||
(fprintf (current-error-port) "uncaught exception ~s\n" x))
|
||||
(exit 1))))
|
||||
(run-test)
|
||||
(exit)))
|
||||
(yield (make-semaphore 0))))
|
||||
|
|
@ -183,20 +183,15 @@ add this test:
|
|||
(define drs-frame #f)
|
||||
(define interactions-text #f)
|
||||
|
||||
(let ([s (make-semaphore)])
|
||||
(fire-up-drscheme)
|
||||
(thread
|
||||
(λ ()
|
||||
(set! drs-frame (wait-for-drscheme-frame))
|
||||
(set! interactions-text (send drs-frame get-interactions-text))
|
||||
(set-language-level! (list #rx"Pretty Big"))
|
||||
(clear-definitions drs-frame)
|
||||
(do-execute drs-frame)
|
||||
|
||||
(output-err-port-checking) ;; must come first
|
||||
;(long-io/execute-test)
|
||||
(reading-test)
|
||||
(semaphore-post s)))
|
||||
(yield s)
|
||||
(exit))
|
||||
(fire-up-drscheme-and-run-tests
|
||||
(λ ()
|
||||
(set! drs-frame (wait-for-drscheme-frame))
|
||||
(set! interactions-text (send drs-frame get-interactions-text))
|
||||
(set-language-level! (list #rx"Pretty Big"))
|
||||
(clear-definitions drs-frame)
|
||||
(do-execute drs-frame)
|
||||
|
||||
(output-err-port-checking) ;; must come first
|
||||
;;(long-io/execute-test)
|
||||
(reading-test)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1352,7 +1352,4 @@ the settings above should match r5rs
|
|||
(go pretty-big)
|
||||
(go r5rs))
|
||||
|
||||
(let ()
|
||||
(fire-up-drscheme)
|
||||
(thread (λ () (run-test) (exit)))
|
||||
(yield (make-semaphore)))
|
||||
(fire-up-drscheme-and-run-tests run-test)
|
||||
|
|
|
|||
|
|
@ -129,7 +129,6 @@
|
|||
error-ranges-expected
|
||||
(send interactions-text get-error-ranges))))])))))
|
||||
|
||||
|
||||
(define drs 'not-yet-drs-frame)
|
||||
(define interactions-text 'not-yet-interactions-text)
|
||||
(define definitions-text 'not-yet-definitions-text)
|
||||
|
|
|
|||
|
|
@ -141,7 +141,7 @@
|
|||
(provide s)
|
||||
(define-syntax (s stx) e))}
|
||||
@t{(require m) s}
|
||||
@rx{module-lang-test-tmp2.ss:1:[67][90]: compile: bad syntax;
|
||||
@rx{compile: bad syntax;
|
||||
literal data is not allowed, because no #%datum syntax transformer
|
||||
is bound in: 1$})
|
||||
(test @t{(module tmp mzscheme
|
||||
|
|
@ -247,11 +247,7 @@
|
|||
f
|
||||
(f)
|
||||
--
|
||||
#t
|
||||
#:error-ranges
|
||||
(λ (defs ints)
|
||||
(list (make-srcloc ints 3 3 107 1)
|
||||
(make-srcloc ints 3 2 106 3))))
|
||||
#t)
|
||||
|
||||
;; test protection against user-code changing the namespace
|
||||
(test @t{#lang scheme/base
|
||||
|
|
@ -265,7 +261,4 @@
|
|||
|
||||
|
||||
(require "drscheme-test-util.ss")
|
||||
(let ()
|
||||
(fire-up-drscheme)
|
||||
(thread (λ () (run-test) (exit)))
|
||||
(yield (make-semaphore 0)))
|
||||
(fire-up-drscheme-and-run-tests run-test)
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@ This produces an ACK message
|
|||
backtrace-image-string
|
||||
" "
|
||||
file-image-string
|
||||
" ../../mred/private/snipfile.ss:"))
|
||||
" .*mred/private/snipfile.ss:"))
|
||||
"[0-9]+:[0-9]+: "
|
||||
(regexp-quote str))))
|
||||
|
||||
|
|
@ -190,8 +190,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: reference to undefined identifier: xx"
|
||||
"reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -266,8 +266,8 @@ This produces an ACK message
|
|||
"define-values: cannot change constant identifier: +"
|
||||
"define-values: cannot change constant identifier: +"
|
||||
"define-values: cannot change constant identifier: +"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
|
|
@ -305,8 +305,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:7: reference to undefined identifier: xx"
|
||||
"reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -350,8 +350,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:2:0: reference to undefined identifier: xx"
|
||||
"reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -417,8 +417,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: reference to undefined identifier: x"
|
||||
"reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -457,8 +457,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #<void>"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: expt: expected argument of type <number>; given #<void>"
|
||||
"expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -507,8 +507,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: reference to undefined identifier: x"
|
||||
"1\n2\nreference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -620,8 +620,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f\n15"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:5:19: expt: expected argument of type <number>; given #f\n15"
|
||||
"expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -644,12 +644,12 @@ This produces an ACK message
|
|||
|
||||
;; should produce a syntax object with a turn-down triangle.
|
||||
(mktest "(write (list (syntax x)))"
|
||||
(#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:21.*>\"})")
|
||||
(#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp3.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp3.ss:1:21.*>\"})")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
|
|
@ -685,12 +685,12 @@ This produces an ACK message
|
|||
|
||||
(mktest "(parameterize ([current-output-port (open-output-string)]) (fprintf (current-error-port) \"~e\" #'foot))"
|
||||
|
||||
(#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:96.*>")
|
||||
(#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp3.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp3.ss:1:96.*>")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
|
|
@ -719,8 +719,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:6:15: expt: expected argument of type <number>; given #f"
|
||||
"expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -796,8 +796,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:3:13: procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
"procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -898,8 +898,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: reference to undefined identifier: xx"
|
||||
"reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -1069,7 +1069,8 @@ This produces an ACK message
|
|||
(define backtrace-image-string "{stop-multi.png}")
|
||||
(define file-image-string "{stop-22x22.png}")
|
||||
|
||||
(define tmp-load-directory
|
||||
(define tmp-load-directory (find-system-path 'temp-dir)
|
||||
#;
|
||||
(normal-case-path
|
||||
(normalize-path
|
||||
(collection-path "tests" "drscheme"))))
|
||||
|
|
@ -1080,8 +1081,6 @@ This produces an ACK message
|
|||
(define tmp-load3-short-filename "repl-test-tmp3.ss")
|
||||
(define tmp-load3-filename (build-path tmp-load-directory tmp-load3-short-filename))
|
||||
|
||||
tmp-load-filename
|
||||
|
||||
(define (cleanup-tmp-files)
|
||||
(when (file-exists? tmp-load-filename) (delete-file tmp-load-filename))
|
||||
(when (file-exists? tmp-load3-filename) (delete-file tmp-load3-filename)))
|
||||
|
|
@ -1133,7 +1132,7 @@ tmp-load-filename
|
|||
; given a filename "foo", we perform two operations on the contents
|
||||
; of the file "foo.ss". First, we insert its contents into the REPL
|
||||
; directly, and second, we use the load command. We compare the
|
||||
; the results of these operations against expected results.
|
||||
; results of these operations against expected results.
|
||||
(define ((run-single-test execute-text-start escape language-cust) in-vector)
|
||||
;(printf "\n>> testing ~s\n" (test-program in-vector))
|
||||
(let* ([program (test-program in-vector)]
|
||||
|
|
@ -1515,13 +1514,10 @@ tmp-load-filename
|
|||
(string-append a b)))
|
||||
|
||||
|
||||
(let ()
|
||||
(fire-up-drscheme)
|
||||
(wait-for-drscheme-frame) ;; after this point, it is safe to set the exit handler
|
||||
(exit-handler
|
||||
(let ([eh (exit-handler)])
|
||||
(λ (val)
|
||||
(cleanup-tmp-files)
|
||||
(eh val))))
|
||||
(thread (λ () (run-test) (exit)))
|
||||
(yield (make-semaphore 0)))
|
||||
(exit-handler
|
||||
(let ([eh (exit-handler)])
|
||||
(λ (val)
|
||||
(cleanup-tmp-files)
|
||||
(eh val))))
|
||||
|
||||
(fire-up-drscheme-and-run-tests run-test)
|
||||
|
|
|
|||
7
collects/tests/drscheme/run.sh
Normal file
7
collects/tests/drscheme/run.sh
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#!/bin/sh -x
|
||||
mred module-lang-test.ss &&
|
||||
mred repl-test.ss &&
|
||||
mred io.ss &&
|
||||
mred language-test.ss &&
|
||||
mred syncheck-test.ss &&
|
||||
mred teachpack.ss
|
||||
|
|
@ -849,28 +849,21 @@ trigger runtime errors in check syntax.
|
|||
(list '((27 33) (19 26) (36 49) (53 59) (64 66))))))
|
||||
|
||||
(define (main)
|
||||
(let ([s (make-semaphore 0)])
|
||||
(thread
|
||||
(λ ()
|
||||
(let ([drs (wait-for-drscheme-frame)])
|
||||
(set-language-level! (list "Pretty Big"))
|
||||
(do-execute drs)
|
||||
(let* ([defs (send drs get-definitions-text)]
|
||||
[filename (make-temporary-file "syncheck-test~a")])
|
||||
(let-values ([(dir _1 _2) (split-path filename)])
|
||||
(send defs save-file filename)
|
||||
(preferences:set 'framework:coloring-active #f)
|
||||
(for-each (run-one-test (normalize-path dir)) tests)
|
||||
(preferences:set 'framework:coloring-active #t)
|
||||
(send defs save-file) ;; clear out autosave
|
||||
(send defs set-filename #f)
|
||||
(delete-file filename)
|
||||
;; let the app die.
|
||||
(semaphore-post s))))))
|
||||
(fire-up-drscheme)
|
||||
(yield s)
|
||||
(printf "Tests complete.\n")
|
||||
(exit)))
|
||||
(fire-up-drscheme-and-run-tests
|
||||
(λ ()
|
||||
(let ([drs (wait-for-drscheme-frame)])
|
||||
(set-language-level! (list "Pretty Big"))
|
||||
(do-execute drs)
|
||||
(let* ([defs (send drs get-definitions-text)]
|
||||
[filename (make-temporary-file "syncheck-test~a")])
|
||||
(let-values ([(dir _1 _2) (split-path filename)])
|
||||
(send defs save-file filename)
|
||||
(preferences:set 'framework:coloring-active #f)
|
||||
(for-each (run-one-test (normalize-path dir)) tests)
|
||||
(preferences:set 'framework:coloring-active #t)
|
||||
(send defs save-file) ;; clear out autosave
|
||||
(send defs set-filename #f)
|
||||
(delete-file filename)))))))
|
||||
|
||||
(define ((run-one-test save-dir) test)
|
||||
(let* ([drs (wait-for-drscheme-frame)]
|
||||
|
|
|
|||
|
|
@ -238,7 +238,4 @@
|
|||
;(bad-tests)
|
||||
(test-built-in-teachpacks))
|
||||
|
||||
(let ()
|
||||
(fire-up-drscheme)
|
||||
(thread (λ () (run-test) (exit)))
|
||||
(yield (make-semaphore)))
|
||||
(fire-up-drscheme-and-run-tests run-test)
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@
|
|||
state))))
|
||||
|
||||
; Given the size of a vector and a procedure which
|
||||
; sends indicies to desired vector elements, create
|
||||
; sends indices to desired vector elements, create
|
||||
; and return the vector.
|
||||
(define proc->vector
|
||||
(lambda (size f)
|
||||
|
|
@ -278,7 +278,7 @@
|
|||
; vertex. Each entry is a bool indicating if the edge exists.
|
||||
; The diagonal of the matrix is never examined.
|
||||
; Make-minimal? returns a procedure which tests if a labelling
|
||||
; of the verticies is such that the matrix is minimal.
|
||||
; of the vertices is such that the matrix is minimal.
|
||||
; If it is, then the procedure returns the result of folding over
|
||||
; the elements of the automoriphism group. If not, it returns #f.
|
||||
; The folding is done by calling folder via
|
||||
|
|
@ -382,11 +382,11 @@
|
|||
|
||||
|
||||
; Fold over rooted directed graphs with bounded out-degree.
|
||||
; Size is the number of verticies (including the root). Max-out is the
|
||||
; Size is the number of vertices (including the root). Max-out is the
|
||||
; maximum out-degree for any vertex. Folder is called via
|
||||
; (folder edges state)
|
||||
; where edges is a list of length size. The ith element of the list is
|
||||
; a list of the verticies j for which there is an edge from i to j.
|
||||
; a list of the vertices j for which there is an edge from i to j.
|
||||
; The last vertex is the root.
|
||||
(define fold-over-rdg
|
||||
(lambda (size max-out folder state)
|
||||
|
|
@ -622,7 +622,7 @@
|
|||
|
||||
;;; ==== test input ====
|
||||
|
||||
; Produces all directed graphs with N verticies, distinguished root,
|
||||
; Produces all directed graphs with N vertices, distinguished root,
|
||||
; and out-degree bounded by 2, upto isomorphism (there are 44).
|
||||
|
||||
;(define go
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
(module regexmatch mzscheme
|
||||
(define rx
|
||||
(string-append
|
||||
"(?:^|[^0-9\\(])" ; (1) preceeding non-digit or bol
|
||||
"(?:^|[^0-9\\(])" ; (1) preceding non-digit or bol
|
||||
"(" ; (2) area code
|
||||
"\\(([0-9][0-9][0-9])\\)" ; (3) is either 3 digits in parens
|
||||
"|" ; or
|
||||
|
|
@ -22,7 +22,7 @@
|
|||
"([0-9][0-9][0-9])" ; (5) exchange is 3 digits
|
||||
"[ -]" ; separator is either space or dash
|
||||
"([0-9][0-9][0-9][0-9])" ; (6) last 4 digits
|
||||
"(?:[^0-9]|$)" ; must be followed by a non-digit
|
||||
"(?:[^0-9]|$)" ; must be followed by a non-digit
|
||||
))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -235,15 +235,30 @@
|
|||
(for/list ([x (in-generator (helper 0) (helper 1) (helper 2))])
|
||||
x)))
|
||||
|
||||
(let ([g (lambda () (generator (yield 1) (yield 2) (yield 3)))])
|
||||
(let ([g (g)]) (test '(1 2 3) list (g) (g) (g)))
|
||||
(let ([g (g)]) (test '(1 2 3 10 10) list (g) (g) (g) (g 10) (g)))
|
||||
(let ([g (generator (yield (yield (yield 1))))])
|
||||
(test '(1 2 3 4 4 4) list (g) (g 2) (g 3) (g 4) (g) (g)))
|
||||
(let ([g (g)])
|
||||
(test '(fresh 1 suspended 2 suspended 3 suspended last done)
|
||||
list (generator-state g) (g)
|
||||
(generator-state g) (g)
|
||||
(generator-state g) (g)
|
||||
(generator-state g) (g 'last)
|
||||
(generator-state g)))
|
||||
(letrec ([g (generator (yield (generator-state g))
|
||||
(yield (generator-state g)))])
|
||||
(test '(fresh running suspended running suspended last done)
|
||||
list (generator-state g) (g)
|
||||
(generator-state g) (g)
|
||||
(generator-state g) (g 'last)
|
||||
(generator-state g))))
|
||||
|
||||
(let* ([helper (lambda (pred num)
|
||||
(for ([i (in-range 0 3)])
|
||||
(yield (pred (+ i num)))))]
|
||||
[g1 (generator
|
||||
(helper odd? 1)
|
||||
(yield 'odd))]
|
||||
[g2 (generator
|
||||
(helper even? 1)
|
||||
(yield 'even))])
|
||||
(for ([i (in-range 0 3)]) (yield (pred (+ i num)))))]
|
||||
[g1 (generator (helper odd? 1) (yield 'odd))]
|
||||
[g2 (generator (helper even? 1) (yield 'even))])
|
||||
(test '(#t #f #f #t #t #f odd even) 'yield-helper
|
||||
(list (g1) (g2) (g1) (g2) (g1) (g2) (g1) (g2))))
|
||||
|
||||
|
|
|
|||
|
|
@ -14,6 +14,13 @@
|
|||
#:with ty (syntax-property #'name 'type-label)
|
||||
#:with ann-name #'name))
|
||||
|
||||
(define-splicing-syntax-class (param-annotated-name trans)
|
||||
#:attributes (name ty ann-name)
|
||||
#:description "type-annotated identifier"
|
||||
#:literals (:)
|
||||
(pattern [~seq name:id : ty]
|
||||
#:with ann-name (syntax-property #'name 'type-label (trans #'ty))))
|
||||
|
||||
(define-syntax-class annotated-binding
|
||||
#:attributes (name ty ann-name binding rhs)
|
||||
(pattern (~and whole [:annotated-name rhs:expr])
|
||||
|
|
|
|||
|
|
@ -209,6 +209,8 @@
|
|||
[char-downcase (-> -Char -Char)]
|
||||
[char-titlecase (-> -Char -Char)]
|
||||
[char-foldcase (-> -Char -Char)]
|
||||
[char->integer (-> -Char -Nat)]
|
||||
[integer->char (-> -Nat -Char)]
|
||||
|
||||
[string-normalize-nfd (-> -String -String)]
|
||||
[string-normalize-nfkd (-> -String -String)]
|
||||
|
|
@ -365,11 +367,20 @@
|
|||
[(-Path) (-lst -Path)])]
|
||||
|
||||
[hash? (make-pred-ty (make-HashtableTop))]
|
||||
[hash-eq? (-> (make-HashtableTop) B)]
|
||||
[hash-eqv? (-> (make-HashtableTop) B)]
|
||||
[hash-weak? (-> (make-HashtableTop) B)]
|
||||
[make-hash (-poly (a b) (-> (-HT a b)))]
|
||||
[make-hasheq (-poly (a b) (-> (-HT a b)))]
|
||||
[make-hasheqv (-poly (a b) (-> (-HT a b)))]
|
||||
[make-weak-hash (-poly (a b) (-> (-HT a b)))]
|
||||
[make-weak-hasheq (-poly (a b) (-> (-HT a b)))]
|
||||
[make-weak-hasheqv (-poly (a b) (-> (-HT a b)))]
|
||||
[make-immutable-hash (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))]
|
||||
[make-immutable-hasheq (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))]
|
||||
[make-immutable-hasheqv (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))]
|
||||
|
||||
[hash-set (-poly (a b) ((-HT a b) a b . -> . (-HT a b)))]
|
||||
[hash-set! (-poly (a b) ((-HT a b) a b . -> . -Void))]
|
||||
[hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]
|
||||
[hash-ref (-poly (a b c)
|
||||
|
|
@ -379,6 +390,25 @@
|
|||
[hash-ref! (-poly (a b)
|
||||
(cl-> [((-HT a b) a (-> b)) b]
|
||||
[((-HT a b) a b) b]))]
|
||||
[hash-has-key? (-poly (a b) (-> (-HT a b) a B))]
|
||||
[hash-update! (-poly (a b)
|
||||
(cl-> [((-HT a b) a (-> b b)) -Void]
|
||||
[((-HT a b) a (-> b b) (-> a)) -Void]
|
||||
[((-HT a b) a (-> b b) a) -Void]))]
|
||||
[hash-update (-poly (a b)
|
||||
(cl-> [((-HT a b) a (-> b b)) (-HT a b)]
|
||||
[((-HT a b) a (-> b b) (-> a)) (-HT a b)]
|
||||
[((-HT a b) a (-> b b) a) (-HT a b)]))]
|
||||
[hash-remove (-poly (a b) ((-HT a b) a . -> . (-HT a b)))]
|
||||
[hash-remove! (-poly (a b) ((-HT a b) a . -> . -Void))]
|
||||
[hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]
|
||||
[hash-for-each (-poly (a b c) (-> (-HT a b) (-> a b c) -Void))]
|
||||
[hash-count (-poly (a b) (-> (-HT a b) -Nat))]
|
||||
[hash-copy (-poly (a b) (-> (-HT a b) (-HT a b)))]
|
||||
[eq-hash-code (-poly (a) (-> a -Integer))]
|
||||
[eqv-hash-code (-poly (a) (-> a -Integer))]
|
||||
[equal-hash-code (-poly (a) (-> a -Integer))]
|
||||
[equal-secondary-hash-code (-poly (a) (-> a -Integer))]
|
||||
[hash-iterate-first (-poly (a b)
|
||||
((-HT a b) . -> . (Un (-val #f) -Integer)))]
|
||||
[hash-iterate-next (-poly (a b)
|
||||
|
|
@ -428,9 +458,6 @@
|
|||
|
||||
[make-directory (-> -Path -Void)]
|
||||
|
||||
[hash-for-each (-poly (a b c)
|
||||
(-> (-HT a b) (-> a b c) -Void))]
|
||||
|
||||
[delete-file (-> -Pathlike -Void)]
|
||||
[make-namespace (->opt [(Un (-val 'empty) (-val 'initial))] -Namespace)]
|
||||
[make-base-namespace (-> -Namespace)]
|
||||
|
|
|
|||
|
|
@ -340,6 +340,6 @@ This file defines two sorts of primitives. All of them are provided into any mod
|
|||
(let ()
|
||||
(define ((mk l/c) stx)
|
||||
(syntax-parse stx
|
||||
[(_ k:annotated-name . body)
|
||||
(quasisyntax/loc stx (#,l/c k.name . body))]))
|
||||
[(_ (~var k (param-annotated-name (lambda (s) #`(#,s -> (U))))) . body)
|
||||
(quasisyntax/loc stx (#,l/c k.ann-name . body))]))
|
||||
(values (mk #'let/cc) (mk #'let/ec))))
|
||||
|
|
|
|||
|
|
@ -132,7 +132,7 @@ result of @scheme[_loop] (and thus the result of the entire
|
|||
@deftogether[[
|
||||
@defform[(let/cc: v : t . body)]
|
||||
@defform[(let/ec: v : t . body)]]]{Type-annotated versions of
|
||||
@scheme[let/cc] and @scheme[let/ec].}
|
||||
@scheme[let/cc] and @scheme[let/ec]. @scheme[t] is the type that will be provided to the continuation @scheme[v].}
|
||||
|
||||
@subsection{Anonymous Functions}
|
||||
|
||||
|
|
|
|||
|
|
@ -125,7 +125,7 @@
|
|||
|
||||
;; substitute many variables
|
||||
;; substitution = Listof[U List[Name,Type] List[Name,Listof[Type]]]
|
||||
;; subst-all : substition Type -> Type
|
||||
;; subst-all : substitution Type -> Type
|
||||
(define (subst-all s t)
|
||||
(for/fold ([t t]) ([e s])
|
||||
(match e
|
||||
|
|
@ -309,4 +309,4 @@
|
|||
|
||||
;; a parameter for the current polymorphic structure being defined
|
||||
;; to allow us to prevent non-regular datatypes
|
||||
(define current-poly-struct (make-parameter #f))
|
||||
(define current-poly-struct (make-parameter #f))
|
||||
|
|
|
|||
|
|
@ -1188,7 +1188,7 @@ General
|
|||
- The teaching libraries are now called teachpacks. See the teachpack
|
||||
release notes for more information.
|
||||
|
||||
- DrScheme's languages have changed (again). The langauges are now:
|
||||
- DrScheme's languages have changed (again). The languages are now:
|
||||
|
||||
- Beginning Student
|
||||
- Intermediate Student
|
||||
|
|
|
|||
|
|
@ -1360,7 +1360,7 @@ System:
|
|||
is just the right height to display one line of text.
|
||||
inherits from mred:wrapping-canvas%
|
||||
mred:frame-title-canvas%
|
||||
updates the title of the frame when it recieves focus
|
||||
updates the title of the frame when it receives focus
|
||||
events. inherits from mred:wrapping-canvas%
|
||||
- all of the "connection maintenence" ie edits that know which canvses
|
||||
they are in, frames that know which canvas is the most recently
|
||||
|
|
|
|||
|
|
@ -178,7 +178,7 @@ v4.1 (this is the first version that was included in the PLT
|
|||
|
||||
- handling of non-terminals uses that have underscores in
|
||||
them now works properly (only showed up when using them
|
||||
in the definition of a langauge)
|
||||
in the definition of a language)
|
||||
|
||||
- an extended language can now define multiple non-terminals
|
||||
together
|
||||
|
|
|
|||
|
|
@ -299,7 +299,7 @@ size_t CORD_rchr(CORD x, size_t i, int c);
|
|||
/* the correct buffer size. */
|
||||
/* 4. Most of the conversions are implement through the native */
|
||||
/* vsprintf. Hence they are usually no faster, and */
|
||||
/* idiosyncracies of the native printf are preserved. However, */
|
||||
/* idiosyncrasies of the native printf are preserved. However, */
|
||||
/* CORD arguments to CORD_sprintf and CORD_vsprintf are NOT copied; */
|
||||
/* the result shares the original structure. This may make them */
|
||||
/* very efficient in some unusual applications. */
|
||||
|
|
|
|||
|
|
@ -1866,6 +1866,7 @@ static void Master_collect() {
|
|||
}
|
||||
else {
|
||||
printf("%i SIGNALED BUT NOT COLLECTED\n", i);
|
||||
children_ready = 0;
|
||||
}
|
||||
}
|
||||
if (children_ready) {
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ SenoraGC is a relatively portable conservative GC for a slightly
|
|||
cooperative environment.
|
||||
|
||||
The collector is intended mainly for debugging and memory tracing, but
|
||||
it can also act as a reasonbaly effecient, general-purpose,
|
||||
it can also act as a reasonbaly efficient, general-purpose,
|
||||
conservative collector. The standard MzScheme build uses SGC for
|
||||
certain platforms where Boehm's GC hasn't been ported, yet (notably,
|
||||
OSKit and BeOS).
|
||||
|
|
|
|||
|
|
@ -3335,7 +3335,7 @@ static void register_transitive_use(Optimize_Info *info, int pos, int j)
|
|||
void scheme_env_make_closure_map(Optimize_Info *info, mzshort *_size, mzshort **_map)
|
||||
{
|
||||
/* A closure map lists the captured variables for a closure; the
|
||||
indices are resolved two new indicies in the second phase of
|
||||
indices are resolved two new indices in the second phase of
|
||||
compilation. */
|
||||
Optimize_Info *frame;
|
||||
int i, j, pos = 0, lpos = 0, tu;
|
||||
|
|
|
|||
|
|
@ -2643,7 +2643,7 @@ static Scheme_Object *do_build_path(int argc, Scheme_Object **argv, int idelta,
|
|||
/* Originally, it made sense to just perform build operations
|
||||
directly on string representations, because it was simple enough.
|
||||
Over the years, though, as we refined the path syntax for Windows
|
||||
to deal with all of its idiosyncracies, this has gotten completely
|
||||
to deal with all of its idiosyncrasies, this has gotten completely
|
||||
out of hand. */
|
||||
{
|
||||
#define PN_BUF_LEN 256
|
||||
|
|
|
|||
|
|
@ -548,9 +548,11 @@ scheme_init_fun (Scheme_Env *env)
|
|||
REGISTER_SO(is_method_symbol);
|
||||
REGISTER_SO(scheme_inferred_name_symbol);
|
||||
REGISTER_SO(cont_key);
|
||||
REGISTER_SO(barrier_prompt_key);
|
||||
is_method_symbol = scheme_intern_symbol("method-arity-error");
|
||||
scheme_inferred_name_symbol = scheme_intern_symbol("inferred-name");
|
||||
cont_key = scheme_make_symbol("k"); /* uninterned */
|
||||
barrier_prompt_key = scheme_make_symbol("bar"); /* uninterned */
|
||||
|
||||
REGISTER_SO(scheme_default_prompt_tag);
|
||||
{
|
||||
|
|
@ -2150,11 +2152,6 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem
|
|||
if (!new_thread) {
|
||||
prompt->is_barrier = 1;
|
||||
}
|
||||
|
||||
if (!barrier_prompt_key) {
|
||||
REGISTER_SO(barrier_prompt_key);
|
||||
barrier_prompt_key = scheme_make_symbol("bar"); /* uninterned */
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef MZ_PRECISE_GC
|
||||
|
|
@ -5061,9 +5058,9 @@ call_cc (int argc, Scheme_Object *argv[])
|
|||
static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int composable,
|
||||
Scheme_Object *prompt_tag,
|
||||
Scheme_Cont *sub_cont, Scheme_Prompt *prompt,
|
||||
Scheme_Meta_Continuation *prompt_cont, MZ_MARK_POS_TYPE prompt_pos,
|
||||
Scheme_Prompt *barrier_prompt, Scheme_Prompt *effective_barrier_prompt,
|
||||
Scheme_Meta_Continuation *barrier_cont, MZ_MARK_POS_TYPE barrier_pos)
|
||||
Scheme_Meta_Continuation *prompt_cont,
|
||||
Scheme_Prompt *effective_barrier_prompt
|
||||
)
|
||||
{
|
||||
Scheme_Cont *cont;
|
||||
|
||||
|
|
@ -5700,8 +5697,7 @@ internal_call_cc (int argc, Scheme_Object *argv[])
|
|||
}
|
||||
|
||||
cont = grab_continuation(p, 0, composable, prompt_tag, sub_cont,
|
||||
prompt, prompt_cont, prompt_pos,
|
||||
barrier_prompt, effective_barrier_prompt, barrier_cont, barrier_pos);
|
||||
prompt, prompt_cont, effective_barrier_prompt);
|
||||
|
||||
scheme_zero_unneeded_rands(p);
|
||||
|
||||
|
|
@ -6107,7 +6103,7 @@ static Scheme_Object *compose_continuation(Scheme_Cont *cont, int exec_chain,
|
|||
|
||||
/* Grab a continuation so that we capture the current Scheme stack,
|
||||
etc.: */
|
||||
saved = grab_continuation(p, 1, 0, NULL, NULL, NULL, NULL, 0, NULL, NULL, NULL, 0);
|
||||
saved = grab_continuation(p, 1, 0, NULL, NULL, NULL, NULL, NULL);
|
||||
|
||||
if (p->meta_prompt)
|
||||
saved->prompt_stack_start = p->meta_prompt->stack_boundary;
|
||||
|
|
|
|||
|
|
@ -2832,7 +2832,7 @@ typedef struct Scheme_Module_Phase_Exports
|
|||
Scheme_Object *kernel_exclusion; /* we allow up to two exns, but they must be shadowed */
|
||||
Scheme_Object *kernel_exclusion2;
|
||||
|
||||
Scheme_Hash_Table *ht; /* maps external names to array indicies; created lazily */
|
||||
Scheme_Hash_Table *ht; /* maps external names to array indices; created lazily */
|
||||
} Scheme_Module_Phase_Exports;
|
||||
|
||||
typedef struct Scheme_Module_Exports
|
||||
|
|
|
|||
|
|
@ -606,7 +606,7 @@ wxCursor::wxCursor(wxBitmap *mask, wxBitmap *bm, int hotSpotX, int hotSpotY)
|
|||
}
|
||||
}
|
||||
|
||||
c = new WXGC_PTRS wxColour(); /* to recieve bit values */
|
||||
c = new WXGC_PTRS wxColour(); /* to receive bit values */
|
||||
|
||||
cMacCustomCursor = new WXGC_ATOMIC Cursor;
|
||||
|
||||
|
|
|
|||
|
|
@ -401,7 +401,7 @@ typedef struct { byte *pic; /* image data */
|
|||
#endif
|
||||
#endif
|
||||
|
||||
/* indicies into conv24MB */
|
||||
/* indices into conv24MB */
|
||||
#define CONV24_8BIT 0
|
||||
#define CONV24_24BIT 1
|
||||
#define CONV24_SEP1 2
|
||||
|
|
|
|||
|
|
@ -1377,7 +1377,7 @@ wxCursor::wxCursor(wxBitmap *bm, wxBitmap *mask, int hotSpotX, int hotSpotY)
|
|||
mask_dc = temp_mask_mdc;
|
||||
}
|
||||
|
||||
c = new wxColour(); /* to recieve bit values */
|
||||
c = new wxColour(); /* to receive bit values */
|
||||
|
||||
/* Windows wants cursor data in terms of an "and" bit array and
|
||||
"xor" bit array. */
|
||||
|
|
|
|||
|
|
@ -222,7 +222,7 @@ to define them here. They will end up in the private(!) header file.
|
|||
|
||||
@ A private variable is used to track the keyboard focus, but only
|
||||
while traversal is on. If |traversal_focus| is |True|, it means that
|
||||
the widget has keyboard focus and that that focus is a result of
|
||||
the widget has keyboard focus and that focus is a result of
|
||||
keyboard traversal. It also means that the widget's border is
|
||||
highlighted, although that is only visible if the |highlightThickness|
|
||||
is positive.
|
||||
|
|
|
|||
|
|
@ -886,7 +886,7 @@ int wxImage::QuickCheck(byte *pic24, int w, int h, int maxcol)
|
|||
finds more than 'maxcol' colors, it returns '0'. If it DOESN'T, it does
|
||||
the 24-to-8 conversion by simply sticking the colors it found into
|
||||
a colormap, and changing instances of a color in pic24 into colormap
|
||||
indicies (in pic) */
|
||||
indices (in pic) */
|
||||
|
||||
unsigned long colors[256],col;
|
||||
int i, nc, low, high, mid;
|
||||
|
|
|
|||
|
|
@ -382,7 +382,7 @@ typedef struct { byte *pic; /* image data */
|
|||
#endif
|
||||
#endif
|
||||
|
||||
/* indicies into conv24MB */
|
||||
/* indices into conv24MB */
|
||||
#define CONV24_8BIT 0
|
||||
#define CONV24_24BIT 1
|
||||
#define CONV24_SEP1 2
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user