<div dir="ltr">"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). <div> </div><div>Robby</div></div><div class="gmail_extra"> <div class="gmail_quote">On Sun, Apr 28, 2013 at 5:04 PM, <<a href="mailto:mflatt@racket-lang.org" target="_blank">mflatt@racket-lang.org</a>> wrote: <blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">mflatt has updated `master' from ad323e5081 to 60610b737d. <a href="http://git.racket-lang.org/plt/ad323e5081..60610b737d" target="_blank">http://git.racket-lang.org/plt/ad323e5081..60610b737d</a> =====[ 4 Commits ]====================================================== Directory summary: 40.4% collects/drracket/private/ 11.1% collects/pkg/gui/ 45.5% collects/scribblings/reference/ ~~~~~~~~~~ e468d1f Matthew Flatt <<a href="mailto:mflatt@racket-lang.org">mflatt@racket-lang.org</a>> 2013-04-28 08:44 : | minor code improvement : M src/racket/src/eval.c | 2 +- ~~~~~~~~~~ 05c0299 Matthew Flatt <<a href="mailto:mflatt@racket-lang.org">mflatt@racket-lang.org</a>> 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 <<a href="mailto:mflatt@racket-lang.org">mflatt@racket-lang.org</a>> 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 <<a href="mailto:mflatt@racket-lang.org">mflatt@racket-lang.org</a>> 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.} ] +@deftech{Contract combinators} are functions such as @racket[->] and +@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[] -@include-section["intro.scrbl"] +@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 *** </blockquote></div> </div>