Merge branch 'master' of pltgit:plt
This commit is contained in:
Stephen Bloch
commit
dbf0206fb2
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -76,6 +76,11 @@
|
|||
=>
|
||||
(list (hasheq 'X 2))
|
||||
|
||||
(datalog parent
|
||||
(? (add1 X :- 2)))
|
||||
=>
|
||||
(list)
|
||||
|
||||
(datalog parent
|
||||
(? (#,(λ (x) (+ x 1)) 1 :- X)))
|
||||
=>
|
||||
|
|
|
|||
|
|
@ -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)]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
------------------------------
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,9 @@
|
|||
Stepper
|
||||
-------
|
||||
Changes for 6.0.1:
|
||||
|
||||
None.
|
||||
|
||||
Changes for 6.0:
|
||||
|
||||
Minor bug fixes.
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user