From a9f46ade9ea16eba75074f407e8275caf0c6cefc Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 17 Apr 2014 14:04:14 -0500 Subject: [PATCH 1/8] make the teaching languages cooperate with the new undefined semantics --- .../lang/private/rewrite-error-message.rkt | 2 + .../htdp-pkgs/htdp-lib/lang/private/teach.rkt | 40 ++++--------------- .../htdp-lib/lang/private/teachhelp.rkt | 16 +++----- 3 files changed, 14 insertions(+), 44 deletions(-) diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/rewrite-error-message.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/rewrite-error-message.rkt index 090469cb54..5ad87209eb 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/rewrite-error-message.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/rewrite-error-message.rkt @@ -135,6 +135,8 @@ (lambda (all) "list")) (list #rx"assignment disallowed;\n cannot set variable before its definition\n variable:" (lambda (all) "cannot set variable before its definition:")) + (list #rx"^(.*): undefined;\n cannot use before initialization" + (λ (all one) (format "local variable used before its definition: ~a" one))) ;; When do these show up? I see only `#' errors, currently. (list (regexp-quote "#(struct:object:image% ...)") (lambda (all) "an image")) diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt index 82ed4618e3..b4b9c8e5d0 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt @@ -87,16 +87,6 @@ (format "~a: question result is not true or false: ~e" where b) (current-continuation-marks))))) - ;; Wrapped around uses of local-bound variables: - (define (teach-check-not-undefined name val) - (if (eq? undefined val) - (raise - (make-exn:fail:contract:variable - (format "local variable used before its definition: ~a" name) - (current-continuation-marks) - name)) - val)) - (define (identifier-is-bound? id) (or (identifier-binding id) ;; identifier-binding returns #f for variable bound at the top-level, @@ -1144,18 +1134,6 @@ ;; a good error message, we need to wait, and that's what ;; beginner-app-delay does. - ;; For intermediate: - - ;; This application form disallows rator expressions that aren't - ;; top-level identifiers or of the form `(teach-check-not-undefined ...)'. - - ;; The latter is probably surprising. It turns out that every use of - ;; a `local'-bound identifier gets converted to an undefined check, - ;; and the call to `teach-check-not-undefined' can't be forged by the - ;; programmer. So the pattern-match effectively recognizes uses of - ;; `local'-bound identifiers, which are legal as rator - ;; expressions. (`let' and `letrec' get converted to `local'.) - (define-values (beginner-app/proc intermediate-app/proc) (let ([mk-app (lambda (lex-ok?) @@ -1163,10 +1141,6 @@ (syntax-case stx () [(_ rator rand ...) (let* ([fun (syntax rator)] - [undef-check? (syntax-case fun (teach-check-not-undefined) - [(teach-check-not-undefined id) - #t] - [_else #f])] [binding (and (identifier? fun) (identifier-binding fun))] [lex? (eq? 'lexical binding)] @@ -1177,7 +1151,7 @@ fun "expected a function after the open parenthesis, but found ~a" what))]) - (unless (and (identifier? fun) (or lex-ok? undef-check? (not lex?))) + (unless (and (identifier? fun) (or lex-ok? (not lex?))) (bad-app (if lex? "a variable" (something-else fun)))) @@ -1748,8 +1722,8 @@ (syntax ((define-syntaxes (def-id/prop ...) (values - (make-undefined-check - (quote-syntax teach-check-not-undefined) + (redirect-identifier-to + (quote-syntax set!) (quote-syntax tmp-id)) ...)) ...)))]) @@ -1817,8 +1791,8 @@ (syntax->list (syntax (rhs-expr ...))))]) (quasisyntax/loc stx (#%stratified-body - (define-syntaxes (name) (make-undefined-check - (quote-syntax teach-check-not-undefined) + (define-syntaxes (name) (redirect-identifier-to + (quote-syntax set!) (quote-syntax tmp-id))) ... (define-values (tmp-id) rhs-expr) @@ -1852,8 +1826,8 @@ (quasisyntax/loc stx (let-values ([(tmp-id) rhs-expr] ...) #,(stepper-syntax-property - #`(let-syntaxes ([(name) (make-undefined-check - (quote-syntax teach-check-not-undefined) + #`(let-syntaxes ([(name) (redirect-identifier-to + (quote-syntax set!t) (quote-syntax tmp-id))] ...) expr) diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/teachhelp.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/teachhelp.rkt index 3d66862474..ede0d44680 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/teachhelp.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/teachhelp.rkt @@ -4,11 +4,10 @@ stepper/private/syntax-property (for-template (prefix r: racket/base))) - (provide make-undefined-check - make-first-order-function) + (provide make-first-order-function + redirect-identifier-to) - (define (make-undefined-check check-proc tmp-id) - (let ([set!-stx (datum->syntax-object check-proc 'set!)]) + (define (redirect-identifier-to set!-stx tmp-id) (make-set!-transformer (lambda (stx) (syntax-case stx () @@ -24,15 +23,10 @@ stx)] [id (stepper-syntax-property - (datum->syntax-object - check-proc - (list check-proc - (list 'quote (syntax id)) - tmp-id) - stx) + tmp-id 'stepper-skipto (append skipto/cdr - skipto/third))]))))) + skipto/third))])))) #; (define (appropriate-use what) (case what From ccefa53af3559a7e7492752f1e5255172293d1cb Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 17 Apr 2014 22:38:42 -0500 Subject: [PATCH 2/8] add missing release notes Please include in 6.0.1 --- pkgs/drracket-pkgs/drracket/drracket/HISTORY.txt | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/pkgs/drracket-pkgs/drracket/drracket/HISTORY.txt b/pkgs/drracket-pkgs/drracket/drracket/HISTORY.txt index 0281658a9f..1f03788db0 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/HISTORY.txt +++ b/pkgs/drracket-pkgs/drracket/drracket/HISTORY.txt @@ -9,6 +9,15 @@ visible in released versions of DrRacket (previously they were visible only in git-based versions and nightly builds) + . improved DrRacket .plt installation functionality so that it + prints out the start of the contents of the file it tried to + unpack when it fails + + . Mac OS X: added full screen support + + . added a re-indent paragraph key binding (esc;q) for Scribble + mode. Thanks to Lei Wang for implementing this. + ------------------------------ Version 6.0 ------------------------------ From cfb45e91e35520f0597319d514cef3d0d963f447 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Fri, 18 Apr 2014 09:47:02 +0200 Subject: [PATCH 3/8] Sync German string constants with latest. --- .../string-constants/private/german-string-constants.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/german-string-constants.rkt b/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/german-string-constants.rkt index fd208801ae..cd02afe963 100644 --- a/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/german-string-constants.rkt +++ b/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/german-string-constants.rkt @@ -1274,7 +1274,7 @@ (module-browser-filename-format "Vollständiger Dateiname: ~a (~a Zeilen)") (module-browser-root-filename "Basis-Dateiname: ~a") (module-browser-font-size-gauge-label "Schriftgröße") - (module-browser-progress-label "Fortschritt Modul-Übersicht") + (module-browser-progress-label "Fortschritt Modul-Browser") (module-browser-adding-file "Datei ~a hinzufügen...") (module-browser-laying-out-graph-label "Graph-Layout") (module-browser-open-file-format "~a öffnen") From 9d9a1cd054981bb2dedc63e4c4585760ff1748f8 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 18 Apr 2014 06:36:58 -0500 Subject: [PATCH 4/8] add some debugging information into the module language test suite specifically, when tests fail and there is an error icon in the REPL, then go find the stack associated with it and print it out --- .../private/module-lang-test-utils.rkt | 23 ++++++++++++++++++- .../drracket/drracket/private/debug.rkt | 6 +++++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/pkgs/drracket-pkgs/drracket-test/tests/drracket/private/module-lang-test-utils.rkt b/pkgs/drracket-pkgs/drracket-test/tests/drracket/private/module-lang-test-utils.rkt index 13814eb476..1ba6d5f786 100644 --- a/pkgs/drracket-pkgs/drracket-test/tests/drracket/private/module-lang-test-utils.rkt +++ b/pkgs/drracket-pkgs/drracket-test/tests/drracket/private/module-lang-test-utils.rkt @@ -115,6 +115,19 @@ get-text (send interactions-text paragraph-start-position output-start-paragraph) (send interactions-text paragraph-end-position para-before-prompt)))))) + (define stacks + (queue-callback/res + (λ () + (let loop ([snip (send interactions-text find-first-snip)]) + (cond + [(not snip) '()] + [else + (cond + [(method-in-interface? 'get-stacks (object-interface snip)) + (define-values (s1 s2) (send snip get-stacks)) + (list* s1 s2 (loop (send snip next)))] + [else + (loop (send snip next))])]))))) (define output-passed? (let ([r (test-result test)]) ((cond [(string? r) string=?] @@ -127,7 +140,15 @@ (test-definitions test) (or (test-interactions test) 'no-interactions) (test-result test) - text)) + text) + (unless (null? stacks) + (eprintf "stacks from error message:") + (for ([stack (in-list stacks)]) + (when stack + (eprintf "\n----\n") + (for ([frame (in-list stack)]) + (eprintf " ~s\n" frame)) + (eprintf "---\n"))))) (cond [(eq? (test-error-ranges test) 'dont-test) (void)] diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt index 41455c7474..d1da582943 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt @@ -208,9 +208,14 @@ profile todo: (class clickable-image-snip% (inherit get-callback) (define/public (get-image-name) filename) + (define stack1 #f) + (define stack2 #f) + (define/public (set-stacks s1 s2) (set! stack1 s1) (set! stack2 s2)) + (define/public (get-stacks) (values stack1 stack2)) (define/override (copy) (let ([n (new note%)]) (send n set-callback (get-callback)) + (send n set-stacks stack1 stack2) n)) (super-make-object bitmap))]) note%))) @@ -492,6 +497,7 @@ profile todo: (let ([note% (if (mf-bday?) mf-note% bug-note%)]) (when note% (let ([note (new note%)]) + (send note set-stacks cms1 cms2) (send note set-callback (λ (snp) (show-backtrace-window/edition-pairs/two msg cms1 editions1 cms2 editions2 defs ints))) (write-special note (current-error-port)) (display #\space (current-error-port))))))) From 34abe306e34e038bb3e6504f6203db3f85a913a2 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 18 Apr 2014 06:54:19 -0500 Subject: [PATCH 5/8] fix a non-buggy set!-before-initialization in syntax-browser What appears to be happening is that the fields path and next-push are state variables on this class that are initialized and then used only during the dynamic-extent of syntax-object->datum/record-paths and of the pretty-printing code. So, before the check was in place, they were initialized and used before the 'path' field was initialized, but by the time the path field was initialized, the value was junk (not going to be used again) but it still raised an error --- pkgs/gui-pkgs/gui-lib/mrlib/syntax-browser.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pkgs/gui-pkgs/gui-lib/mrlib/syntax-browser.rkt b/pkgs/gui-pkgs/gui-lib/mrlib/syntax-browser.rkt index 4e9681ca70..b40177101d 100644 --- a/pkgs/gui-pkgs/gui-lib/mrlib/syntax-browser.rkt +++ b/pkgs/gui-pkgs/gui-lib/mrlib/syntax-browser.rkt @@ -69,6 +69,8 @@ needed to really make this work: (define/override (write stream) (send stream put (string->bytes/utf-8 (format "~s" (marshall-syntax main-stx))))) + (define path '()) + (define next-push 0) (define-values (datum paths-ht) (syntax-object->datum/record-paths main-stx)) (define output-text (new text:hide-caret/selection%)) @@ -88,8 +90,6 @@ needed to really make this work: 0 (send text last-position))) - (define path '()) - (define next-push 0) (define/private (push!) (set! path (cons next-push path)) (set! next-push 0)) From 9e7b013a7d61dabe48785377f2e5f39f04def90b Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 18 Apr 2014 11:14:30 -0400 Subject: [PATCH 6/8] Fix `typecheck-fail` in TR Closes PR 14449 --- .../typed-racket/typecheck/internal-forms.rkt | 11 ++++++++--- .../tests/typed-racket/unit-tests/typecheck-tests.rkt | 6 ++++++ 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/internal-forms.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/internal-forms.rkt index 80461e4e7a..a11abf7d33 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/internal-forms.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/internal-forms.rkt @@ -113,9 +113,14 @@ [predicate-assertion (assert-predicate-internal type predicate)] [type-declaration - (:-internal id:identifier type)] - [typecheck-failure - (typecheck-fail-internal stx message:str var:id)]) + (:-internal id:identifier type)]) + +;; Define separately outside of `define-internal-classes` since this form +;; is meant to appear in expression positions, so it doesn't make sense to use +;; the `define-values` protocol used for other internal forms. +(define-syntax-class typecheck-failure + #:literal-sets (kernel-literals internal-literals) + (pattern (quote-syntax (typecheck-fail-internal stx message:str var)))) ;;; Internal form creation (begin-for-syntax diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt index 1f81f11cb8..9e7427b5d0 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -2747,6 +2747,12 @@ (f 1 2 3)) #:ret (ret Univ -true-filter)] + ;; typecheck-fail should fail + [tc-err (typecheck-fail #'stx "typecheck-fail") + #:msg #rx"typecheck-fail"] + [tc-err (string-append (typecheck-fail #'stx "typecheck-fail") "bar") + #:ret (ret -String) + #:msg #rx"typecheck-fail"] ) (test-suite "tc-literal tests" From 2846764a93d3317b0934c61d078f54baf3a18599 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 18 Apr 2014 10:09:15 -0600 Subject: [PATCH 7/8] Clarify Datalog/Racket interaction re Matthias --- pkgs/datalog/scribblings/racket.scrbl | 10 +++++++++- pkgs/datalog/tests/racket.rkt | 5 +++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/pkgs/datalog/scribblings/racket.scrbl b/pkgs/datalog/scribblings/racket.scrbl index 3b298fa674..c66517cdbb 100644 --- a/pkgs/datalog/scribblings/racket.scrbl +++ b/pkgs/datalog/scribblings/racket.scrbl @@ -61,6 +61,8 @@ The Datalog database can be directly used by Racket programs through this API. (datalog family (? (add1 1 :- X))) + (datalog family + (? (add1 X :- 2))) (datalog family (? (#,(λ (x) (+ x 1)) 1 :- X)))] @@ -107,7 +109,13 @@ for a variable symbol, or @RACKET[#,expr] where @racket[expr] evaluates to a constant datum. Bound identifiers in terms are treated as the datum they are bound to. -External queries invalidate Datalog's guaranteed termination. For example, this program does not terminate: +External queries fail if any logic variable is not fully resolved to a +datum on the Datalog side. In other words, unbound logic variables +never flow to Racket. + +External queries invalidate Datalog's guaranteed termination. For +example, this program does not terminate: + @racketblock[ (datalog (make-theory) (! (:- (loop X) diff --git a/pkgs/datalog/tests/racket.rkt b/pkgs/datalog/tests/racket.rkt index 9f578d5dea..8d1ab3ac38 100644 --- a/pkgs/datalog/tests/racket.rkt +++ b/pkgs/datalog/tests/racket.rkt @@ -76,6 +76,11 @@ => (list (hasheq 'X 2)) + (datalog parent + (? (add1 X :- 2))) + => + (list) + (datalog parent (? (#,(λ (x) (+ x 1)) 1 :- X))) => From 870057ab196489ec0019e9bef3b3450a8fe37c9c Mon Sep 17 00:00:00 2001 From: John Clements Date: Fri, 18 Apr 2014 10:25:19 -0700 Subject: [PATCH 8/8] Update HISTORY.txt for stepper Please merge to 6.0.1 release --- pkgs/htdp-pkgs/htdp-lib/stepper/HISTORY.txt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/pkgs/htdp-pkgs/htdp-lib/stepper/HISTORY.txt b/pkgs/htdp-pkgs/htdp-lib/stepper/HISTORY.txt index 31ea30a70a..42cc48d923 100644 --- a/pkgs/htdp-pkgs/htdp-lib/stepper/HISTORY.txt +++ b/pkgs/htdp-pkgs/htdp-lib/stepper/HISTORY.txt @@ -1,5 +1,9 @@ Stepper ------- +Changes for 6.0.1: + +None. + Changes for 6.0: Minor bug fixes.