suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix inverted argument default for editor<%> read-from-file method; better Check Sytax results on packages; added syntax/flatten-begin library

Browse Source 
svn: r14548
This commit is contained in:
Matthew Flatt 2009-04-17 22:50:19 +00:00
parent c6a2904928
commit 4b3626c156
10 changed files with 50 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mred/private/wxme/pasteboard.ss
View File

@ -1913,7 +1913,7 @@
(do-write-headers-footers f #f)))
(def/override (read-from-file [editor-stream-in% f]
[bool? [overwritestyle? #t]])
[bool? [overwritestyle? #f]])
(if (or s-user-locked?
(not (zero? write-locked)))
#f

4
collects/mred/private/wxme/text.ss
View File

@ -2581,9 +2581,9 @@
(define/override (read-from-file . args)
(case-args
args
[([editor-stream-in% f] [exact-nonnegative-integer? start] [any? [overwritestyle? #t]])
[([editor-stream-in% f] [exact-nonnegative-integer? start] [any? [overwritestyle? #f]])
(do-read-from-file f start overwritestyle?)]
[([editor-stream-in% f] [any? [overwritestyle? #t]])
[([editor-stream-in% f] [any? [overwritestyle? #f]])
(do-read-from-file f 'start overwritestyle?)]
(method-name 'text% 'read-from-file)))

15
collects/scheme/package.ss
View File

@ -2,7 +2,8 @@
(require (for-syntax scheme/base
syntax/kerncase
syntax/boundmap
syntax/define))
syntax/define
syntax/flatten-begin))
(provide define-package
package-begin
@ -93,6 +94,12 @@
hidden)
id)))
(define-for-syntax (move-props orig new)
(datum->syntax new
(syntax-e new)
orig
orig))
(define-for-syntax (do-define-package stx exp-stx)
(syntax-case exp-stx ()
[(_ pack-id mode exports form ...)
@ -293,7 +300,7 @@
(car def-ctxes)))])
(syntax-case expr (begin)
[(begin . rest)
(loop (append (syntax->list #'rest) (cdr exprs))
(loop (append (flatten-begin expr) (cdr exprs))
rev-forms
def-ctxes)]
[(def (id ...) rhs)
@ -315,7 +322,7 @@
(syntax-local-bind-syntaxes ids #'rhs def-ctx)
(register-bindings! ids)
(loop (cdr exprs)
(cons #`(define-syntaxes #,ids rhs)
(cons (move-props expr #`(define-syntaxes #,ids rhs))
rev-forms)
(if star? (cons def-ctx def-ctxes) def-ctxes)))))]
[(def (id ...) rhs)
@ -333,7 +340,7 @@
(syntax-local-bind-syntaxes ids #f def-ctx)
(register-bindings! ids)
(loop (cdr exprs)
(cons #`(define-values #,ids rhs) rev-forms)
(cons (move-props expr #`(define-values #,ids rhs)) rev-forms)
(if star? (cons def-ctx def-ctxes) def-ctxes))))]
[else
(loop (cdr exprs)

5
collects/scheme/private/class-internal.ss
View File

@ -11,6 +11,7 @@
syntax/name
syntax/context
syntax/define
syntax/flatten-begin
syntax/private/boundmap
mzlib/stxparam
"classidmap.ss"))
@ -245,9 +246,9 @@
null
(let ([e (expand (car l))])
(syntax-case e (begin define-syntaxes define-values)
[(begin expr ...)
[(begin . _)
(loop (append
(syntax->list (syntax (expr ...)))
(flatten-begin e)
(cdr l)))]
[(define-syntaxes (id ...) rhs)
(andmap identifier? (syntax->list #'(id ...)))

2
collects/scribblings/gui/editor-intf.scrbl
View File

@ -1826,7 +1826,7 @@ See @method[editor<%> read-header-from-file].
@defmethod[(read-from-file [stream (is-a?/c editor-stream-in%)]
[overwrite-styles? any/c #t])
[overwrite-styles? any/c #f])
boolean?]{
Reads new contents for the editor from a stream. The return value is

2
collects/scribblings/gui/text-class.scrbl
View File

@ -1698,7 +1698,7 @@ Returns the paragraph number of the paragraph containing a given @techlink{posit
@defmethod[#:mode extend
(read-from-file [stream (is-a?/c editor-stream-in%)]
[start (or/c exact-nonnegative-integer? (one/of 'start))]
[overwrite-styles? any/c #t])
[overwrite-styles? any/c #f])
boolean?]{
New data is inserted at the @techlink{position} indicated by @scheme[start], or at

6
collects/scribblings/reference/stx-props.scrbl
View File

@ -54,17 +54,17 @@ MzScheme adds properties to expanded syntax (often using
@item{When an internal @scheme[define-values] or
@scheme[define-syntaxes] form is converted into a
@scheme[letrec-values+syntaxes] form (see @secref["intdef-body"]),
@scheme[letrec-syntaxes+values] form (see @secref["intdef-body"]),
@scheme[syntax-track-origin] is applied to each generated binding
clause. The second argument to @scheme[syntax-track-origin] is the
converted form, and the third argument is the @scheme[define-values]
or @scheme[define-syntaxes] keyword form the converted form.}
@item{When a @scheme[letrec-values+syntaxes] expression is fully
@item{When a @scheme[letrec-syntaxes+values] expression is fully
expanded, syntax bindings disappear, and the result is either a
@scheme[letrec-values] form (if the unexpanded form contained
non-syntax bindings), or only the body of the
@scheme[letrec-values+syntaxes] form (wrapped with @scheme[begin] if
@scheme[letrec-syntaxes+values] form (wrapped with @scheme[begin] if
the body contained multiple expressions). To record the disappeared
syntax bindings, a property is added to the expansion result: an
immutable list of identifiers from the disappeared bindings, as a

13
collects/syntax/flatten-begin.ss Normal file
View File

@ -0,0 +1,13 @@
#lang scheme/base
(provide flatten-begin)
(define (flatten-begin stx)
(let ([l (syntax->list stx)])
(if l
(map (lambda (e)
(syntax-track-origin e stx (car l)))
(cdr l))
(raise-syntax-error
#f
"bad syntax"
stx))))

14
collects/syntax/scribblings/flatten-begin.scrbl Normal file
View File

@ -0,0 +1,14 @@
#lang scribble/doc
@(require "common.ss"
(for-label syntax/flatten-begin))
@title[#:tag "flatten-begin"]{Flattening @scheme[begin] Forms}
@defmodule[syntax/flatten-begin]
@defproc[(flatten-begin [stx syntax?]) (listof syntax?)]{
Extracts the sub-expressions from a @scheme[begin]-like form,
reporting an error if @scheme[stx] does not have the right shape
(i.e., a syntax list). The resulting syntax objects have annotations
transferred from @scheme[stx] using @scheme[syntax-track-origin].}

2
collects/syntax/scribblings/transformer-helpers.scrbl
View File

@ -6,6 +6,6 @@
@include-section["name.scrbl"]
@include-section["context.scrbl"]
@include-section["define.scrbl"]
@include-section["flatten-begin.scrbl"]
@include-section["struct.scrbl"]
@include-section["path-spec.scrbl"]