[racket-dev] [plt] Push #26737: master branch updated
"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>
![[logo]](/logo.png){kind=logo}