[racket-dev] [plt] Push #26737: master branch updated

From: Robby Findler (robby at eecs.northwestern.edu)
Date: Sun Apr 28 18:56:06 EDT 2013

"contarcts". I think DrRacket's spell checker would have caught that one
(but I really need to fix indentation for scribble files before I'd say
that DrRacket is useable).

Robby


On Sun, Apr 28, 2013 at 5:04 PM, <mflatt at racket-lang.org> wrote:

> mflatt has updated `master' from ad323e5081 to 60610b737d.
>   http://git.racket-lang.org/plt/ad323e5081..60610b737d
>
> =====[ 4 Commits ]======================================================
> Directory summary:
>   40.4% collects/drracket/private/
>   11.1% collects/pkg/gui/
>   45.5% collects/scribblings/reference/
>
> ~~~~~~~~~~
>
> e468d1f Matthew Flatt <mflatt at racket-lang.org> 2013-04-28 08:44
> :
> | minor code improvement
> :
>   M src/racket/src/eval.c | 2 +-
>
> ~~~~~~~~~~
>
> 05c0299 Matthew Flatt <mflatt at racket-lang.org> 2013-04-28 09:32
> :
> | switch DrRacket's "Install Package..." to the new package manager GUI
> :
>   M collects/drracket/private/frame.rkt | 278
> ++-------------------------------
>   M collects/pkg/gui/main.rkt           | 107 +++++++------
>
> ~~~~~~~~~~
>
> 0754f79 Matthew Flatt <mflatt at racket-lang.org> 2013-04-28 10:09
> :
> | adjust the new "notation" section of the reference
> :
>   M collects/scribblings/reference/contracts.scrbl  | 7 +++++--
>   M collects/scribblings/reference/eval-model.scrbl | 2 +-
>   R collects/scribblings/reference/{intro.scrbl => notation.scrbl} (71%)
>   M collects/scribblings/reference/reference.scrbl  | 2 +-
>
> ~~~~~~~~~~
>
> 60610b7 Matthew Flatt <mflatt at racket-lang.org> 2013-04-28 15:19
> :
> | add some comments to help explain the compiler's space-safety pass
> :
>   M src/racket/src/schpriv.h | 15 +++++++++------
>
> =====[ Overall Diff ]===================================================
>
> collects/drracket/private/frame.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/drracket/private/frame.rkt
> +++ NEW/collects/drracket/private/frame.rkt
> @@ -1,262 +1,16 @@
>  #lang racket/base
>
>  (module install-pkg racket/base
> -  (require racket/gui/base
> -           racket/class
> -           string-constants
> -           pkg/name
> -           pkg/lib
> -           racket/list
> -           framework)
> +  (require racket/class
> +           pkg/gui/main)
>    (provide install-pkg)
> -
> -  (define sc-install-pkg-dialog-title (string-constant
> install-pkg-dialog-title))
> -  (define sc-install-pkg-source-label (string-constant
> install-pkg-source-label))
> -  (define sc-install-pkg-type-label (string-constant
> install-pkg-type-label))
> -  (define sc-install-pkg-infer (string-constant install-pkg-infer))
> -  (define sc-install-pkg-file (string-constant install-pkg-file))
> -  (define sc-install-pkg-dir (string-constant install-pkg-dir))
> -  (define sc-install-pkg-dir-url (string-constant install-pkg-dir-url))
> -  (define sc-install-pkg-file-url (string-constant install-pkg-file-url))
> -  (define sc-install-pkg-github (string-constant install-pkg-github))
> -  (define sc-install-pkg-name (string-constant install-pkg-name))
> -  (define sc-install-pkg-inferred-as (string-constant
> install-pkg-inferred-as))
> -  (define sc-install-pkg-force? (string-constant install-pkg-force?))
> -  (define sc-install-pkg-command-line (string-constant
> install-pkg-command-line))
> -
> -  (define sc-install-pkg-action-label (string-constant
> install-pkg-action-label))
> -  (define sc-install-pkg-install (string-constant install-pkg-install))
> -  (define sc-install-pkg-update (string-constant install-pkg-update))
> -  (define sc-action-inferred-to-be-update (string-constant
> install-pkg-action-inferred-to-be-update))
> -  (define sc-action-inferred-to-be-install (string-constant
> install-pkg-action-inferred-to-be-install))
> -
> -  (preferences:set-default 'drracket:gui-installer-pkg-source "" string?)
> -
> -  (define (install-pkg parent)
> -    (define dlg (new dialog%
> -                     [parent parent]
> -                     [label sc-install-pkg-dialog-title]
> -                     [alignment '(right center)]))
> -    (define tf (new text-field%
> -                    [parent dlg]
> -                    [min-width 600]
> -                    [label sc-install-pkg-source-label]
> -                    [callback (λ (_1 _2)
> -                                (preferences:set
> 'drracket:gui-installer-pkg-source (send tf get-value))
> -                                (adjust-all))]))
> -    (send tf set-value (preferences:get
> 'drracket:gui-installer-pkg-source))
> -
> -    (define details-parent (new vertical-panel% [parent dlg]))
> -    (define details-panel (new group-box-panel%
> -                               [label (string-constant autosave-details)]
> -                               [parent details-parent]
> -                               [alignment '(left center)]))
> -    (define button-panel (new horizontal-panel%
> -                              [parent dlg]
> -                              [stretchable-height #f]
> -                              [alignment '(right center)]))
> -
>
> -    (define details-shown? #f)
> -    (define details-button (new button%
> -                                [label (string-constant
> show-details-button-label)]
> -                                [parent button-panel]
> -                                [callback
> -                                 (λ (a b)
> -                                   (set! details-shown? (not
> details-shown?))
> -                                   (adjust-all))]))
> -    (new horizontal-panel% [parent button-panel])
> -    (define-values (ok-button cancel-button)
> -      (gui-utils:ok/cancel-buttons button-panel
> -                                   (λ (_1 _2)
> -                                     (set! ok? #t)
> -                                     (send dlg show #f))
> -                                   (λ (_1 _2) (send dlg show #f))))
> -    (send details-parent change-children (λ (l) '()))
> -    (define choice (new choice%
> -                        [label sc-install-pkg-type-label]
> -                        [parent details-panel]
> -                        [stretchable-width #t]
> -                        [callback (λ (x y) (adjust-all))]
> -                        [choices (list sc-install-pkg-infer
> -                                       sc-install-pkg-file
> -                                       sc-install-pkg-dir
> -                                       sc-install-pkg-file-url
> -                                       sc-install-pkg-dir-url
> -                                       sc-install-pkg-github
> -                                       sc-install-pkg-name)]))
> -
> -    (define inferred-msg-parent (new horizontal-panel%
> -                                     [parent details-panel]
> -                                     [stretchable-height #f]
> -                                     [alignment '(right center)]))
> -    (define inferred-msg (new message% [label ""] [parent
> inferred-msg-parent] [auto-resize #t]))
> -
> -    (define action-choice (new choice%
> -                               [label sc-install-pkg-action-label]
> -                               [parent details-panel]
> -                               [stretchable-width #t]
> -                               [callback (λ (x y) (adjust-all))]
> -                               [choices (list sc-install-pkg-infer
> -                                              sc-install-pkg-install
> -                                              sc-install-pkg-update)]))
> -    (define inferred-action-msg-parent (new horizontal-panel%
> -                                            [parent details-panel]
> -                                            [stretchable-height #f]
> -                                            [alignment '(right center)]))
> -    (define inferred-action-msg (new message% [label ""] [parent
> inferred-action-msg-parent] [auto-resize #t]))
> -
> -    (define cb (new check-box%
> -                    [label sc-install-pkg-force?]
> -                    [parent details-panel]
> -                    [callback (λ (a b) (adjust-all))]))
> -
> -    (new message% [parent details-panel] [label
> sc-install-pkg-command-line])
> -    (define cmdline-panel (new horizontal-panel% [parent details-panel]
> [stretchable-height #f]))
> -    (new horizontal-panel% [parent cmdline-panel] [min-width 12]
> [stretchable-width #f])
> -    (define cmdline-msg (new message%
> -                             [parent cmdline-panel]
> -                             [stretchable-width #t]
> -                             [label ""]
> -                             [font (send (send
> (editor:get-standard-style-list)
> -                                               find-named-style
> -                                               "Standard")
> -                                         get-font)]))
> -
> -    (define (selected-type)
> -      (case (send choice get-selection)
> -        [(0) #f]
> -        [(1) 'file]
> -        [(2) 'dir]
> -        [(3) 'file-url]
> -        [(4) 'dir-url]
> -        [(5) 'github]
> -        [(6) 'name]))
> -
> -    (define (type->str type)
> -      (case type
> -        [(file) sc-install-pkg-file]
> -        [(name) sc-install-pkg-name]
> -        [(dir) sc-install-pkg-dir]
> -        [(github) sc-install-pkg-github]
> -        [(file-url) sc-install-pkg-file-url]
> -        [(dir-url) sc-install-pkg-dir-url]
> -        [else (error 'type->str "unknown type ~s\n" type)]))
> -
> -    (define currently-installed-pkgs (installed-pkg-names))
> -    (define (get-current-action)
> -      (case (send action-choice get-selection)
> -        [(0)
> -         (define current-name (package-source->name (send tf get-value)))
> -         (cond
> -           [(and current-name (member current-name
> currently-installed-pkgs))
> -            'update]
> -           [else
> -            'install])]
> -        [(1) 'install]
> -        [(2) 'update]))
> -
> -
> -    (define (adjust-all)
> -      (adjust-inferred)
> -      (adjust-inferred-action)
> -      (adjust-checkbox)
> -      (adjust-cmd-line)
> -      (adjust-details-shown)
> -      (adjust-ok/cancel))
> -
> -    (define (adjust-checkbox)
> -      (send cb enable (equal? 'install (get-current-action))))
> -
> -    (define (adjust-inferred-action)
> -      (define action (get-current-action))
> -      (define new-lab
> -        (cond
> -          [(equal? 0 (send action-choice get-selection))
> -           (case (get-current-action)
> -             [(install) sc-action-inferred-to-be-install]
> -             [(update) sc-action-inferred-to-be-update])]
> -          [else ""]))
> -      (send inferred-action-msg set-label new-lab))
> -
> -    (define (adjust-ok/cancel)
> -      (send ok-button enable (compute-cmd-line)))
> -
> -    (define (adjust-details-shown)
> -      (define current-details-shown-state?
> -        (and (member details-panel (send details-parent get-children))
> -             #t))
> -      (unless (equal? current-details-shown-state?
> -                      details-shown?)
> -        (cond
> -          [details-shown?
> -           (send details-button set-label (string-constant
> hide-details-button-label))
> -           (send details-parent change-children
> -                 (λ (l) (list details-panel)))]
> -          [else
> -           (send details-button set-label (string-constant
> show-details-button-label))
> -           (send details-parent change-children
> -                 (λ (l) '()))])))
> -
> -    (define (adjust-inferred)
> -      (define new-lab
> -        (and (equal? #f (selected-type))
> -             (let-values ([(_ actual-type)
> -                           (package-source->name+type (send tf get-value)
> #f)])
> -               (and actual-type
> -                    (format sc-install-pkg-inferred-as (type->str
> actual-type))))))
> -      (send inferred-msg set-label (or new-lab "")))
> -
> -    (define (adjust-cmd-line)
> -      (define (convert-to-string s)
> -        (cond
> -          [(string? s)
> -           (if (regexp-match #rx" " s)
> -               (string-append "\"" s "\"")
> -               s)]
> -          [(keyword? s) (regexp-replace #rx"^#:" (format "~a" s) "--")]
> -          [(symbol? s) (symbol->string s)]
> -          [(boolean? s) #f]
> -          [else (error 'convert-to-string "unk ~s" s)]))
> -      (define cmd-line (compute-cmd-line))
> -      (send cmdline-msg set-label
> -            (if cmd-line
> -                (string-append
> -                 (if (eq? (system-type) 'windows)
> -                     "raco.exe"
> -                     "raco")
> -                 " pkg "
> -                 (apply string-append
> -                        (add-between
> -                         (filter values (map convert-to-string cmd-line))
> -                         " ")))
> -                "")))
> -
> -    (define (compute-cmd-line)
> -      (define the-pkg
> -        (cond
> -          [(and (equal? 'update (get-current-action))
> -                (package-source->name (send tf get-value)))
> -           =>
> -           values]
> -          [else (send tf get-value)]))
> -      (and (not (equal? the-pkg ""))
> -           (cons (get-current-action)
> -                 (append
> -                  (if (send cb get-value)
> -                      '(#:force #t)
> -                      '())
> -                  (if (selected-type)
> -                      (list '#:type (selected-type))
> -                      '())
> -                  (list the-pkg)))))
> -
> -    (adjust-all)
> -
> -    (define ok? #f)
> -
> -    (send dlg show #t)
> -    (and ok? (compute-cmd-line))))
> +  (define pkg-gui #f)
> +
> +  (define (install-pkg parent wrap-terminal-action)
> +    (if pkg-gui
> +        (send pkg-gui show #t)
> +        (set! pkg-gui (make-pkg-gui #:wrap-terminal-action
> wrap-terminal-action)))))
>
>  (module main racket
>    (require (submod ".." install-pkg))
> @@ -450,17 +204,11 @@
>               [label (string-constant install-pkg-menu-item...)]
>               [parent file-menu]
>               [callback
> -              (λ (item evt)
> -                (define res (install-pkg this))
> -                (when res
> -                  (parameterize ([error-display-handler
> drracket:init:original-error-display-handler])
> -                    (in-terminal
> -                     #:title (string-constant install-pkg-dialog-title)
> -                     (λ (cust parent)
> -                       (define action (case (car res)
> -                                        [(install) install]
> -                                        [(update) update]))
> -                       (apply action (cdr res)))))))])
> +              (λ (item evt)
> +                 (install-pkg this
> +                              (lambda (thunk)
> +                                (parameterize ([error-display-handler
> drracket:init:original-error-display-handler])
> +                                  (thunk)))))])
>          (super file-menu:between-open-and-revert file-menu))
>
>        (define/override (file-menu:between-print-and-close menu)
>
> collects/pkg/gui/main.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/pkg/gui/main.rkt
> +++ NEW/collects/pkg/gui/main.rkt
> @@ -8,51 +8,62 @@
>           mrlib/terminal
>           string-constants)
>
> -(define frame
> -  (new frame:basic%
> -       [label "Package Manager"]
> -       [width 800]
> -       [height 600]))
> -
> -(define sel-tab
> -  (new tab-panel%
> -       [parent (send frame get-area-container)]
> -       [choices (list (string-constant install-pkg-install-by-source)
> -                      (string-constant install-pkg-install-from-list)
> -                      (string-constant install-pkg-install-installed))]
> -       [callback (lambda (t e)
> -                   (define old (send sel-panel active-child))
> -                   (define new (list-ref panels (send t get-selection)))
> -                   (unless (eq? new old)
> -                     (send sel-panel active-child new)))]))
> -
> -(define sel-panel
> -  (new panel:single%
> -       [parent sel-tab]))
> -
> -(define terminal #f)
> -(define (in-terminal-panel abort-label thunk)
> -  (when terminal
> -    (send terminal close))
> -  (define t (in-terminal
> -             #:abort-label abort-label
> -             #:container (send frame get-area-container)
> -             (λ (cust parent) (thunk))))
> -  (set! terminal t)
> -  (send sel-tab enable #f)
> -  (yield (send t can-close-evt))
> -  (send sel-tab enable #t))
> -
> -(define panels
> -  (list
> -   (new by-source-panel%
> -        [parent sel-panel]
> -        [in-terminal in-terminal-panel])
> -   (new by-list-panel%
> -        [parent sel-panel]
> -        [in-terminal in-terminal-panel])
> -   (new by-installed-panel%
> -        [parent sel-panel]
> -        [in-terminal in-terminal-panel])))
> -
> -(send frame show #t)
> +(provide make-pkg-gui)
> +
> +(define (make-pkg-gui #:wrap-terminal-action [wrap-terminal-action
> (lambda (thunk) (thunk))])
> +  (define frame
> +    (new (class frame:standard-menus%
> +           (super-new)
> +           ;; no menu separator:
> +           (define/override (edit-menu:between-select-all-and-find m)
> (void)))
> +         [label "Package Manager"]
> +         [width 800]
> +         [height 600]))
> +
> +  (define sel-tab
> +    (new tab-panel%
> +         [parent (send frame get-area-container)]
> +         [choices (list (string-constant install-pkg-install-by-source)
> +                        (string-constant install-pkg-install-from-list)
> +                        (string-constant install-pkg-install-installed))]
> +         [callback (lambda (t e)
> +                     (define old (send sel-panel active-child))
> +                     (define new (list-ref panels (send t get-selection)))
> +                     (unless (eq? new old)
> +                       (send sel-panel active-child new)))]))
> +
> +  (define sel-panel
> +    (new panel:single%
> +         [parent sel-tab]))
> +
> +  (define terminal #f)
> +  (define (in-terminal-panel abort-label thunk)
> +    (when terminal
> +      (send terminal close))
> +    (define t (in-terminal
> +               #:abort-label abort-label
> +               #:container (send frame get-area-container)
> +               (λ (cust parent) (wrap-terminal-action thunk))))
> +    (set! terminal t)
> +    (send sel-tab enable #f)
> +    (yield (send t can-close-evt))
> +    (send sel-tab enable #t))
> +
> +  (define panels
> +    (list
> +     (new by-source-panel%
> +          [parent sel-panel]
> +          [in-terminal in-terminal-panel])
> +     (new by-list-panel%
> +          [parent sel-panel]
> +          [in-terminal in-terminal-panel])
> +     (new by-installed-panel%
> +          [parent sel-panel]
> +          [in-terminal in-terminal-panel])))
> +
> +  (send frame show #t)
> +
> +  frame)
> +
> +(module+ main
> +  (void (make-pkg-gui)))
>
> collects/scribblings/reference/contracts.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribblings/reference/contracts.scrbl
> +++ NEW/collects/scribblings/reference/contracts.scrbl
> @@ -68,7 +68,11 @@ failed, and anything else to indicate it passed.}
>
>  ]
>
> + at deftech{Contract combinators} are functions such as @racket[->] and
> + at racket[listof] that take contarcts and produce other contracts.
> +
>  Contracts in Racket are subdivided into three different categories:
> +@;
>  @itemlist[@item{@deftech{Flat contract}s can be fully checked
> immediately for
>                   a given value. These kinds of contracts are essentially
>                   predicate functions. Using
> @racket[flat-contract-predicate],
> @@ -95,8 +99,7 @@ Contracts in Racket are subdivided into three different
> categories:
>
>  For more about this hierarchy, see @tech{chaperones} and
>  a research paper on chaperones, impersonators, and how they can be used to
> -implement contracts @cite{Strickland12}.
> -
> +implement contracts~@cite{Strickland12}.
>
>  @local-table-of-contents[]
>
>
> collects/scribblings/reference/eval-model.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribblings/reference/eval-model.scrbl
> +++ NEW/collects/scribblings/reference/eval-model.scrbl
> @@ -517,7 +517,7 @@ access the same @tech{location}.
>
>  @margin-note/ref{See @secref["module"] for the syntax of modules.}
>
> -Most definitions in Racket are in modules. In terms of evaluation,
> +Most definitions in Racket are in @deftech{modules}. In terms of
> evaluation,
>  a module is essentially a prefix on a defined name, so that different
>  modules can define the name. That is, a @deftech{module-level
>  variable} is like a @tech{top-level variable} from the perspective of
>
> collects/scribblings/reference/reference.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribblings/reference/reference.scrbl
> +++ NEW/collects/scribblings/reference/reference.scrbl
> @@ -57,7 +57,7 @@ The @racketmodname[racket] library combines
>
>  @table-of-contents[]
>
> - at include-section["intro.scrbl"]
> + at include-section["notation.scrbl"]
>  @include-section["model.scrbl"]
>  @include-section["syntax.scrbl"]
>  @include-section["data.scrbl"]
>
> src/racket/src/eval.c
> ~~~~~~~~~~~~~~~~~~~~~
> --- OLD/src/racket/src/eval.c
> +++ NEW/src/racket/src/eval.c
> @@ -3390,7 +3390,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands,
> Scheme_Object **rands,
>
>           arg = app->rand2;
>
> -         switch ((SCHEME_APPN_FLAGS(app) >> 6) & 0x7) {
> +         switch ((flags >> 6) & 0x7) {
>           case SCHEME_EVAL_CONSTANT:
>             break;
>           case SCHEME_EVAL_GLOBAL:
>
> src/racket/src/schpriv.h
> ~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/src/racket/src/schpriv.h
> +++ NEW/src/racket/src/schpriv.h
> @@ -2801,12 +2801,15 @@ int scheme_is_sub_env(Scheme_Comp_Env *stx_env,
> Scheme_Comp_Env *env);
>  typedef struct SFS_Info {
>    MZTAG_IF_REQUIRED
>    int for_mod, pass;
> -  int tail_pos;
> -  int depth, stackpos, tlpos;
> -  int selfpos, selfstart, selflen;
> -  int ip, seqn, max_nontail;
> -  int min_touch, max_touch;
> -  int *max_used, *max_calls;
> +  int tail_pos; /* in tail position? */
> +  int depth, stackpos, tlpos; /* stack shape */
> +  int selfpos, selfstart, selflen; /* tracks self calls */
> +  int ip; /* "instruction pointer" --- counts up during traversal of
> expressions */
> +  int seqn; /* tracks nesting */
> +  int max_nontail; /* ip of last non-tail call in the body */
> +  int min_touch, max_touch; /* tracks range of `macx_used' values changed
> */
> +  int *max_used; /* maps stack position (i.e., variable) to ip of the
> variable's last use */
> +  int *max_calls; /* maps stack position to ip of last non-tail call in
> variable's scope */
>    Scheme_Object *saved;
>  } SFS_Info;
>
>
> *** See above for renames and copies ***
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/dev/archive/attachments/20130428/33160939/attachment-0001.html>

Posted on the dev mailing list.