Merge branch 'master' of pltgit:plt

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)

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)))
  =>

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)]

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
 ------------------------------

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)))))))

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))

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 `#<image>' errors, currently.
           (list (regexp-quote "#(struct:object:image% ...)")
                 (lambda (all) "an image"))

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
+						  (redirect-identifier-to
-						   (quote-syntax teach-check-not-undefined)
+						   (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
+                  (define-syntaxes (name) (redirect-identifier-to
-                                           (quote-syntax teach-check-not-undefined)
+                                           (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
+                     #`(let-syntaxes ([(name) (redirect-identifier-to
-                                               (quote-syntax teach-check-not-undefined)
+                                               (quote-syntax set!t)
                                                (quote-syntax tmp-id))]
                                       ...)
                                      expr)

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
+  (provide make-first-order-function
-           make-first-order-function)
+           redirect-identifier-to)
 
-  (define (make-undefined-check check-proc tmp-id)
+  (define (redirect-identifier-to set!-stx tmp-id)
-    (let ([set!-stx (datum->syntax-object check-proc 'set!)])
       (make-set!-transformer
        (lambda (stx)
 	 (syntax-case stx ()
@@ -24,15 +23,10 @@
              stx)]
 	   [id
             (stepper-syntax-property
-             (datum->syntax-object
+             tmp-id
-              check-proc
-              (list check-proc 
-                    (list 'quote (syntax id))
-                    tmp-id)
-              stx)
              'stepper-skipto
              (append skipto/cdr
-                     skipto/third))])))))
+                     skipto/third))]))))
 #;    
   (define (appropriate-use what)
     (case what

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.

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")

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)]
+    (:-internal id:identifier type)])
-  [typecheck-failure
+
-    (typecheck-fail-internal stx message:str var:id)])
+;; 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

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"