commit 885b7d6616168663dd2370dd5934cdcb89f152dc parent 8352e11979282b36702f67aa7915d79bd83960a3 Author: Jay McCarthy <jay@racket-lang.org> Date: Wed, 28 Apr 2010 13:21:30 -0600 Changing unstable, xml, html, and web-server to be rackety original commit: 7d1c7d874b6693e9d74722149a40ae43ac56e90f Diffstat:
70 files changed, 162 insertions(+), 162 deletions(-)
diff --git a/collects/macro-debugger/expand.ss b/collects/macro-debugger/expand.rkt diff --git a/collects/macro-debugger/info.ss b/collects/macro-debugger/info.rkt diff --git a/collects/macro-debugger/model/context.ss b/collects/macro-debugger/model/context.rkt diff --git a/collects/macro-debugger/model/debug.ss b/collects/macro-debugger/model/debug.rkt diff --git a/collects/macro-debugger/model/deriv-c.ss b/collects/macro-debugger/model/deriv-c.rkt diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.rkt diff --git a/collects/macro-debugger/model/deriv-tokens.ss b/collects/macro-debugger/model/deriv-tokens.rkt diff --git a/collects/macro-debugger/model/deriv-util.rkt b/collects/macro-debugger/model/deriv-util.rkt @@ -0,0 +1,71 @@ + +#lang scheme/base +(require (for-syntax scheme/base) + (for-syntax racket/private/struct-info) + scheme/list + scheme/match + unstable/struct + "deriv.ss") + +(provide make + + Wrap + + ok-node? + interrupted-node? + + wderiv-e1 + wderiv-e2 + wlderiv-es1 + wlderiv-es2 + wbderiv-es1 + wbderiv-es2 + + wderivlist-es2) + +;; Wrap matcher +;; Matches unwrapped, interrupted wrapped, or error wrapped +(define-match-expander Wrap + (lambda (stx) + (syntax-case stx () + [(Wrap S (var ...)) + (syntax/loc stx (struct S (var ...)))]))) + +;; ---- + +(define (check sym pred type x) + (unless (pred x) + (raise-type-error sym type x))) + +(define (ok-node? x) + (check 'ok-node? node? "node" x) + (and (node-z1 x) #t)) +(define (interrupted-node? x) + (check 'interrupted-node? node? "node" x) + (not (node-z2 x))) + + +(define (wderiv-e1 x) + (check 'wderiv-e1 deriv? "deriv" x) + (node-z1 x)) +(define (wderiv-e2 x) + (check 'wderiv-e2 deriv? "deriv" x) + (node-z2 x)) + +(define (wlderiv-es1 x) + (check 'wlderiv-es1 lderiv? "lderiv" x) + (node-z1 x)) +(define (wlderiv-es2 x) + (check 'wlderiv-es2 lderiv? "lderiv" x) + (node-z2 x)) + +(define (wbderiv-es1 x) + (check 'wbderiv-es1 bderiv? "bderiv" x) + (node-z1 x)) +(define (wbderiv-es2 x) + (check 'wbderiv-es2 bderiv? "bderiv" x)) + +;; wderivlist-es2 : (list-of WDeriv) -> (list-of Stx)/#f +(define (wderivlist-es2 xs) + (let ([es2 (map wderiv-e2 xs)]) + (and (andmap syntax? es2) es2))) diff --git a/collects/macro-debugger/model/deriv-util.ss b/collects/macro-debugger/model/deriv-util.ss @@ -1,71 +0,0 @@ - -#lang scheme/base -(require (for-syntax scheme/base) - (for-syntax scheme/private/struct-info) - scheme/list - scheme/match - unstable/struct - "deriv.ss") - -(provide make - - Wrap - - ok-node? - interrupted-node? - - wderiv-e1 - wderiv-e2 - wlderiv-es1 - wlderiv-es2 - wbderiv-es1 - wbderiv-es2 - - wderivlist-es2) - -;; Wrap matcher -;; Matches unwrapped, interrupted wrapped, or error wrapped -(define-match-expander Wrap - (lambda (stx) - (syntax-case stx () - [(Wrap S (var ...)) - (syntax/loc stx (struct S (var ...)))]))) - -;; ---- - -(define (check sym pred type x) - (unless (pred x) - (raise-type-error sym type x))) - -(define (ok-node? x) - (check 'ok-node? node? "node" x) - (and (node-z1 x) #t)) -(define (interrupted-node? x) - (check 'interrupted-node? node? "node" x) - (not (node-z2 x))) - - -(define (wderiv-e1 x) - (check 'wderiv-e1 deriv? "deriv" x) - (node-z1 x)) -(define (wderiv-e2 x) - (check 'wderiv-e2 deriv? "deriv" x) - (node-z2 x)) - -(define (wlderiv-es1 x) - (check 'wlderiv-es1 lderiv? "lderiv" x) - (node-z1 x)) -(define (wlderiv-es2 x) - (check 'wlderiv-es2 lderiv? "lderiv" x) - (node-z2 x)) - -(define (wbderiv-es1 x) - (check 'wbderiv-es1 bderiv? "bderiv" x) - (node-z1 x)) -(define (wbderiv-es2 x) - (check 'wbderiv-es2 bderiv? "bderiv" x)) - -;; wderivlist-es2 : (list-of WDeriv) -> (list-of Stx)/#f -(define (wderivlist-es2 xs) - (let ([es2 (map wderiv-e2 xs)]) - (and (andmap syntax? es2) es2))) diff --git a/collects/macro-debugger/model/deriv.ss b/collects/macro-debugger/model/deriv.rkt diff --git a/collects/macro-debugger/model/hiding-policies.ss b/collects/macro-debugger/model/hiding-policies.rkt diff --git a/collects/macro-debugger/model/reductions-config.ss b/collects/macro-debugger/model/reductions-config.rkt diff --git a/collects/macro-debugger/model/reductions-engine.ss b/collects/macro-debugger/model/reductions-engine.rkt diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.rkt diff --git a/collects/macro-debugger/model/steps.ss b/collects/macro-debugger/model/steps.rkt diff --git a/collects/macro-debugger/model/stx-util.ss b/collects/macro-debugger/model/stx-util.rkt diff --git a/collects/macro-debugger/model/trace-raw.ss b/collects/macro-debugger/model/trace-raw.rkt diff --git a/collects/macro-debugger/model/trace.ss b/collects/macro-debugger/model/trace.rkt diff --git a/collects/macro-debugger/model/yacc-ext.ss b/collects/macro-debugger/model/yacc-ext.rkt diff --git a/collects/macro-debugger/model/yacc-interrupted.ss b/collects/macro-debugger/model/yacc-interrupted.rkt diff --git a/collects/macro-debugger/stepper-text.ss b/collects/macro-debugger/stepper-text.rkt diff --git a/collects/macro-debugger/stepper.ss b/collects/macro-debugger/stepper.rkt diff --git a/collects/macro-debugger/syntax-browser.ss b/collects/macro-debugger/syntax-browser.rkt diff --git a/collects/macro-debugger/syntax-browser/controller.ss b/collects/macro-debugger/syntax-browser/controller.rkt diff --git a/collects/macro-debugger/syntax-browser/display.ss b/collects/macro-debugger/syntax-browser/display.rkt diff --git a/collects/macro-debugger/syntax-browser/embed.ss b/collects/macro-debugger/syntax-browser/embed.rkt diff --git a/collects/macro-debugger/syntax-browser/frame.ss b/collects/macro-debugger/syntax-browser/frame.rkt diff --git a/collects/macro-debugger/syntax-browser/hrule-snip.ss b/collects/macro-debugger/syntax-browser/hrule-snip.rkt diff --git a/collects/macro-debugger/syntax-browser/image.ss b/collects/macro-debugger/syntax-browser/image.rkt diff --git a/collects/macro-debugger/syntax-browser/interfaces.ss b/collects/macro-debugger/syntax-browser/interfaces.rkt diff --git a/collects/macro-debugger/syntax-browser/keymap.ss b/collects/macro-debugger/syntax-browser/keymap.rkt diff --git a/collects/macro-debugger/syntax-browser/partition.ss b/collects/macro-debugger/syntax-browser/partition.rkt diff --git a/collects/macro-debugger/syntax-browser/prefs.ss b/collects/macro-debugger/syntax-browser/prefs.rkt diff --git a/collects/macro-debugger/syntax-browser/pretty-helper.ss b/collects/macro-debugger/syntax-browser/pretty-helper.rkt diff --git a/collects/macro-debugger/syntax-browser/pretty-printer.ss b/collects/macro-debugger/syntax-browser/pretty-printer.rkt diff --git a/collects/macro-debugger/syntax-browser/properties.ss b/collects/macro-debugger/syntax-browser/properties.rkt diff --git a/collects/macro-debugger/syntax-browser/snip-decorated.ss b/collects/macro-debugger/syntax-browser/snip-decorated.rkt diff --git a/collects/macro-debugger/syntax-browser/snip.ss b/collects/macro-debugger/syntax-browser/snip.rkt diff --git a/collects/macro-debugger/syntax-browser/text.ss b/collects/macro-debugger/syntax-browser/text.rkt diff --git a/collects/macro-debugger/syntax-browser/util.ss b/collects/macro-debugger/syntax-browser/util.rkt diff --git a/collects/macro-debugger/syntax-browser/widget.ss b/collects/macro-debugger/syntax-browser/widget.rkt diff --git a/collects/macro-debugger/util/mpi.ss b/collects/macro-debugger/util/mpi.rkt diff --git a/collects/macro-debugger/view/cursor.ss b/collects/macro-debugger/view/cursor.rkt diff --git a/collects/macro-debugger/view/debug-format.ss b/collects/macro-debugger/view/debug-format.rkt diff --git a/collects/macro-debugger/view/debug.ss b/collects/macro-debugger/view/debug.rkt diff --git a/collects/macro-debugger/view/extensions.ss b/collects/macro-debugger/view/extensions.rkt diff --git a/collects/macro-debugger/view/frame.ss b/collects/macro-debugger/view/frame.rkt diff --git a/collects/macro-debugger/view/hiding-panel.ss b/collects/macro-debugger/view/hiding-panel.rkt diff --git a/collects/macro-debugger/view/interfaces.ss b/collects/macro-debugger/view/interfaces.rkt diff --git a/collects/macro-debugger/view/prefs.ss b/collects/macro-debugger/view/prefs.rkt diff --git a/collects/macro-debugger/view/step-display.ss b/collects/macro-debugger/view/step-display.rkt diff --git a/collects/macro-debugger/view/stepper.ss b/collects/macro-debugger/view/stepper.rkt diff --git a/collects/macro-debugger/view/term-record.ss b/collects/macro-debugger/view/term-record.rkt diff --git a/collects/macro-debugger/view/view.ss b/collects/macro-debugger/view/view.rkt diff --git a/collects/tests/macro-debugger/all-tests.ss b/collects/tests/macro-debugger/all-tests.rkt diff --git a/collects/tests/macro-debugger/gentest-framework.ss b/collects/tests/macro-debugger/gentest-framework.rkt diff --git a/collects/tests/macro-debugger/gentests.ss b/collects/tests/macro-debugger/gentests.rkt diff --git a/collects/tests/macro-debugger/gui-tests.ss b/collects/tests/macro-debugger/gui-tests.rkt diff --git a/collects/tests/macro-debugger/test-setup.ss b/collects/tests/macro-debugger/test-setup.rkt diff --git a/collects/tests/macro-debugger/tests/collects.ss b/collects/tests/macro-debugger/tests/collects.rkt diff --git a/collects/tests/macro-debugger/tests/hiding.ss b/collects/tests/macro-debugger/tests/hiding.rkt diff --git a/collects/tests/macro-debugger/tests/policy.ss b/collects/tests/macro-debugger/tests/policy.rkt diff --git a/collects/tests/macro-debugger/tests/regression.ss b/collects/tests/macro-debugger/tests/regression.rkt diff --git a/collects/tests/macro-debugger/tests/syntax-basic.ss b/collects/tests/macro-debugger/tests/syntax-basic.rkt diff --git a/collects/tests/macro-debugger/tests/syntax-errors.ss b/collects/tests/macro-debugger/tests/syntax-errors.rkt diff --git a/collects/tests/macro-debugger/tests/syntax-macros.ss b/collects/tests/macro-debugger/tests/syntax-macros.rkt diff --git a/collects/tests/macro-debugger/tests/syntax-modules.ss b/collects/tests/macro-debugger/tests/syntax-modules.rkt diff --git a/collects/unstable/find.rkt b/collects/unstable/find.rkt @@ -0,0 +1,73 @@ +#lang racket/base +(require racket/contract + unstable/struct) + +(provide/contract + [find + (->* ((-> any/c any/c) + any/c) + (#:stop-on-found? any/c + #:stop (or/c #f (-> any/c any/c)) + #:get-children (or/c #f (-> any/c (or/c #f list?)))) + list?)] + [find-first + (->* ((-> any/c any/c) + any/c) + (#:stop (or/c #f (-> any/c any/c)) + #:get-children (or/c #f (-> any/c (or/c #f list?))) + #:default any/c) + any/c)]) + +(define (find pred x + #:stop-on-found? [stop-on-found? #f] + #:stop [stop #f] + #:get-children [get-children #f]) + (define (loop x acc) + (cond [(pred x) + (let ([acc (cons x acc)]) + (if stop-on-found? + acc + (loop/nf x acc)))] + [else + (loop/nf x acc)])) + ;; loop/nt: x is "not found"; look in its children + (define (loop/nf x acc) + (cond [(and stop (stop x)) + acc] + [(and get-children (get-children x)) + => (lambda (children) (loop* children acc))] + [(pair? x) + (let ([acc (loop (car x) acc)]) + (loop (cdr x) acc))] + [(vector? x) + (for/fold ([acc acc]) ([elem (in-vector x)]) + (loop elem acc))] + [(box? x) + (loop (unbox x) acc)] + [(struct->list x #:on-opaque 'skip) + => (lambda (elems) + (loop* elems acc))] + ;; unreachable, since + ;; (struct->list X #:on-opaque 'skip) always returns a list + [else acc])) + (define (loop* xs acc) + (for/fold ([acc acc]) ([elem (in-list xs)]) + (loop elem acc))) + (reverse (loop x null))) +;; Eli: This looks borderline too generic to be useful, also in the fact that +;; the documentation tends to explain things in terms of the implementation +;; (eg, the description of #:stop). In any case, you should definitely +;; rename it -- `find' is too common in different ways (see srfi-1 or cltl). + +(define (find-first pred x + #:stop [stop #f] + #:get-children [get-children #f] + #:default [default #f]) + (let/ec return + (define (pred* x) + (and (pred x) (return x))) + (find pred* x #:stop stop #:get-children get-children) + (if (procedure? default) + (default) + default))) +;; Eli: Note that this is documented "Like `find-first'". diff --git a/collects/unstable/find.ss b/collects/unstable/find.ss @@ -1,73 +0,0 @@ -#lang scheme/base -(require scheme/contract - unstable/struct) - -(provide/contract - [find - (->* ((-> any/c any/c) - any/c) - (#:stop-on-found? any/c - #:stop (or/c #f (-> any/c any/c)) - #:get-children (or/c #f (-> any/c (or/c #f list?)))) - list?)] - [find-first - (->* ((-> any/c any/c) - any/c) - (#:stop (or/c #f (-> any/c any/c)) - #:get-children (or/c #f (-> any/c (or/c #f list?))) - #:default any/c) - any/c)]) - -(define (find pred x - #:stop-on-found? [stop-on-found? #f] - #:stop [stop #f] - #:get-children [get-children #f]) - (define (loop x acc) - (cond [(pred x) - (let ([acc (cons x acc)]) - (if stop-on-found? - acc - (loop/nf x acc)))] - [else - (loop/nf x acc)])) - ;; loop/nt: x is "not found"; look in its children - (define (loop/nf x acc) - (cond [(and stop (stop x)) - acc] - [(and get-children (get-children x)) - => (lambda (children) (loop* children acc))] - [(pair? x) - (let ([acc (loop (car x) acc)]) - (loop (cdr x) acc))] - [(vector? x) - (for/fold ([acc acc]) ([elem (in-vector x)]) - (loop elem acc))] - [(box? x) - (loop (unbox x) acc)] - [(struct->list x #:on-opaque 'skip) - => (lambda (elems) - (loop* elems acc))] - ;; unreachable, since - ;; (struct->list X #:on-opaque 'skip) always returns a list - [else acc])) - (define (loop* xs acc) - (for/fold ([acc acc]) ([elem (in-list xs)]) - (loop elem acc))) - (reverse (loop x null))) -;; Eli: This looks borderline too generic to be useful, also in the fact that -;; the documentation tends to explain things in terms of the implementation -;; (eg, the description of #:stop). In any case, you should definitely -;; rename it -- `find' is too common in different ways (see srfi-1 or cltl). - -(define (find-first pred x - #:stop [stop #f] - #:get-children [get-children #f] - #:default [default #f]) - (let/ec return - (define (pred* x) - (and (pred x) (return x))) - (find pred* x #:stop stop #:get-children get-children) - (if (procedure? default) - (default) - default))) -;; Eli: Note that this is documented "Like `find-first'". diff --git a/collects/unstable/scribblings/find.scrbl b/collects/unstable/scribblings/find.scrbl @@ -1,20 +1,20 @@ #lang scribble/manual @(require scribble/eval - "utils.ss" + "utils.rkt" (for-label unstable/find - scheme/contract - scheme/shared - scheme/base)) + racket/contract + racket/shared + racket/base)) @title[#:tag "find"]{Find} @(define the-eval (make-base-eval)) @(the-eval '(require unstable/find)) -@(the-eval '(require scheme/shared)) +@(the-eval '(require racket/shared)) @defmodule[unstable/find] -@unstable[@author+email["Ryan Culpepper" "ryanc@plt-scheme.org"]] +@unstable[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]] @defproc[(find [pred (-> any/c any/c)] [x any/c] @@ -23,23 +23,23 @@ [#:get-children get-children (or/c #f (-> any/c (or/c #f list?))) #f]) list?]{ -Returns a list of all values satisfying @scheme[pred] contained in -@scheme[x] (possibly including @scheme[x] itself). +Returns a list of all values satisfying @racket[pred] contained in +@racket[x] (possibly including @racket[x] itself). -If @scheme[stop-on-found?] is true, the children of values satisfying -@scheme[pred] are not examined. If @scheme[stop] is a procedure, then -the children of values for which @scheme[stop] returns true are not -examined (but the values themselves are; @scheme[stop] is applied -after @scheme[pred]). Only the current branch of the search is +If @racket[stop-on-found?] is true, the children of values satisfying +@racket[pred] are not examined. If @racket[stop] is a procedure, then +the children of values for which @racket[stop] returns true are not +examined (but the values themselves are; @racket[stop] is applied +after @racket[pred]). Only the current branch of the search is stopped, not the whole search. The search recurs through pairs, vectors, boxes, and the accessible -fields of structures. If @scheme[get-children] is a procedure, it can +fields of structures. If @racket[get-children] is a procedure, it can override the default notion of a value's children by returning a list (if it returns false, the default notion of children is used). -No cycle detection is done, so @scheme[find] on a cyclic graph may -diverge. To do cycle checking yourself, use @scheme[stop] and a +No cycle detection is done, so @racket[find] on a cyclic graph may +diverge. To do cycle checking yourself, use @racket[stop] and a mutable table. @examples[#:eval the-eval @@ -63,8 +63,8 @@ mutable table. [#:default default any/c (lambda () (error ....))]) any/c]{ -Like @scheme[find], but only returns the first match. If no -matches are found, @scheme[default] is applied as a thunk if it is a +Like @racket[find], but only returns the first match. If no +matches are found, @racket[default] is applied as a thunk if it is a procedure or returned otherwise. @examples[#:eval the-eval