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

change 'read-language' protocol so that the result from 'get-info' accepts a key plus default value (instead of just a key)

Browse Source 
svn: r16459
This commit is contained in:
Matthew Flatt 2009-10-29 23:05:56 +00:00
parent c3857c32e3
commit 973d51c20f
10 changed files with 42 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/at-exp/lang/reader.ss
View File

@ -24,8 +24,8 @@
wrap-reader
wrap-reader
(lambda (proc)
(lambda (key)
(lambda (key defval)
(case key
[(color-lexer)
(dynamic-require 'syntax-color/scribble-lexer 'scribble-lexer)]
[else (and proc (proc key))]))))))
[else (if proc (proc key defval) defval)]))))))

2
collects/drscheme/private/module-language-tools.ss
View File

@ -102,7 +102,7 @@
(contract (or/c #f (listof (list/c string?
(is-a?/c bitmap%)
(-> (is-a?/c drscheme:unit:frame<%>) any))))
(info-result 'drscheme:toolbar-buttons)
(info-result 'drscheme:toolbar-buttons #f)
(get-lang-name pos)
'drscheme/private/module-language-tools)))))))

4
collects/scribble/base/lang/reader.ss
View File

@ -6,13 +6,13 @@ scribble/base/lang
#:read-syntax scribble:read-syntax-inside
#:whole-body-readers? #t
#:wrapper1 (lambda (t) (list* 'doc 'values '() (t)))
#:info (lambda (key default)
#:info (lambda (key defval default)
(case key
[(color-lexer)
(dynamic-require 'syntax-color/scribble-lexer 'scribble-inside-lexer)]
[(drscheme:toolbar-buttons)
(dynamic-require 'scribble/drscheme-buttons 'drscheme-buttons)]
[else (default key)]))
[else (default key defval)]))
(require (prefix-in scribble: "../../reader.ss"))

4
collects/scribble/manual/lang/reader.ss
View File

@ -6,10 +6,10 @@ scribble/manual/lang
#:read-syntax scribble:read-syntax-inside
#:whole-body-readers? #t
#:wrapper1 (lambda (t) (cons 'doc (t)))
#:info (lambda (key default)
#:info (lambda (key defval default)
(case key
[(color-lexer)
(dynamic-require 'syntax-color/scribble-lexer 'scribble-inside-lexer)]
[else (default key)]))
[else (default defval key)]))
(require (prefix-in scribble: "../../reader.ss"))

4
collects/scribble/sigplan/lang/reader.ss
View File

@ -6,10 +6,10 @@ scribble/sigplan/lang
#:read-syntax scribble:read-syntax-inside
#:whole-body-readers? #t
#:wrapper1 (lambda (t) (cons 'doc (t)))
#:info (lambda (key default)
#:info (lambda (key defval default)
(case key
[(color-lexer)
(dynamic-require 'syntax-color/scribble-lexer 'scribble-inside-lexer)]
[else (default key)]))
[else (default defval key)]))
(require (prefix-in scribble: "../../reader.ss"))

22
collects/scribblings/reference/read.scrbl
View File

@ -107,7 +107,7 @@ See @secref["readtables"] for an extended example that uses
@defproc[(read-language [in input-port? (current-input-port)]
[fail-thunk (-> any) (lambda () (error ...))])
(any/c . -> . any)]{
(any/c any/c . -> . any)]{
Reads @scheme[in] in the same way as @scheme[read], but stopping as
soon as a @tech{reader language} (or its absence) is determined.
@ -119,16 +119,16 @@ a @schemeidfont{read} or @schemeidfont{read-syntax} form as
@scheme[read] and @scheme[read-syntax] do, @scheme[read-language]
dispatches to a @schemeidfont{get-info} function (if any) exported by
the same module. The result of the @schemeidfont{get-info} function is
the result of @scheme[read-language] if it is a function of one
argument; if @schemeidfont{get-info} produces any other kind of
the result of @scheme[read-language] if it is a function of two
arguments; if @schemeidfont{get-info} produces any other kind of
result, the @exnraise[exn:fail:contract].
The function produced by @schemeidfont{get-info} reflects information
about the expected syntax of the input stream. The argument to the
about the expected syntax of the input stream. The first argument to the
function serves as a key on such information; acceptable keys and the
interpretation of results is up to external tools, such as DrScheme.
If no information is available for a given key, the result should be
@scheme[#f].
the second argument.
The @schemeidfont{get-info} function itself is applied to five
arguments: the input port being read, the module path from which the
@ -138,7 +138,8 @@ integer or @scheme[#f]), and position (positive exact integer or
@scheme[#f]) of the start of the @litchar{#lang} or @litchar{#!}
form. The @schemeidfont{get-info} function may further read from the
given input port to determine its result, but it should read no
further than necessary.
further than necessary. The @schemeidfont{get-info} function should
not read from the port after returning a function.
If @scheme[in] starts with a @tech{reader language} specification but
the relevant module does not export @schemeidfont{get-info} (but
@ -146,8 +147,13 @@ perhaps does export @schemeidfont{read} and
@schemeidfont{read-syntax}), then the result of @scheme[read-language]
is @scheme[#f].
If @scheme[in] does not specify a @tech{reader language}, then
@scheme[fail-thunk] is called. The default @scheme[fail-thunk] raises
If @scheme[in] has a @litchar{#lang} or @litchar{#!} specification,
but parsing and resolving the specification raises an exception, the
exception is propagated by @scheme[read-language].
If @scheme[in] does not specify a @tech{reader language} with
@litchar{#lang} or @litchar{#!}, then @scheme[fail-thunk] is
called. The default @scheme[fail-thunk] raises
@scheme[exn:fail:contract].}

2
collects/syntax-color/module-lexer.ss
View File

@ -36,7 +36,7 @@
start-pos
end-pos
0
(or (let ([v (get-info 'color-lexer)])
(or (let ([v (get-info 'color-lexer #f)])
(and v
(if (procedure-arity-includes? v 3)
(cons v #f)

20
collects/syntax/module-reader.ss
View File

@ -50,6 +50,8 @@
(err "must specify either both #:read and #:read-syntax, or none"))
(when (and ~whole-body-readers? (not (and ~read ~read-syntax)))
(err "got a #:whole-body-readers? without #:read and #:read-syntax"))])
;; FIXME: a lot of the generated code is constant and should be lifted
;; out of the template:
(quasisyntax/loc stx
(#%module-begin
#,@body
@ -112,24 +114,24 @@
(define (get-info-getter props)
(define lang (car props))
(define data (cadr props))
(define (default-info what)
(define (default-info what defval)
(case what
[(module-language) (car props)]
;; ... more?
[else #f]))
[else defval]))
(define info
(let* ([#,<lang-id> lang] ;\ visible in
[#,<data-id> data] ;/ user-code
[info #,~info])
(if (or (not info) (and (procedure? info) (ar? info 2)))
(if (or (not info) (and (procedure? info) (ar? info 3)))
info
(raise-type-error 'syntax/module-reader
"info procedure of 1 or 0 arguments" info))))
(define (language-info what)
"info procedure of 3 arguments" info))))
(define (language-info what defval)
(if info
(let ([r (info what default-info)])
(if (eq? r default-info) (default-info what) r))
(default-info what)))
(let ([r (info what defval default-info)])
(if (eq? r default-info) (default-info what defval) r))
(default-info what defval)))
language-info))))
(syntax-case stx ()
[(_ lang body ...)
@ -206,7 +208,7 @@
(define (-get-info inp mod line col pos)
(let ([r (get inp 'get-info (object-name inp) line col pos
(lambda (spec) (lambda () (lambda (inp mod line col pos)
(lambda (tag) #f)))))])
(lambda (tag defval) defval)))))])
(convert-get-info (r inp mod line col pos))))
(define (read-fn in read-sym args src mod line col pos convert)

9
collects/syntax/scribblings/module-reader.scrbl
View File

@ -76,10 +76,11 @@ using:
Similarly, the @scheme[#:info] keyword supplies a procedure to be used
by a @scheme[get-info] export (see @scheme[read-language]). The
procedure produced by @scheme[info-expr] should consume two arguments:
a key symbol and a default info-getting procedure (to be called with
the key for default handling). If @scheme[#:info] is not supplied, the
default info-getting procedure is used.
procedure produced by @scheme[info-expr] should consume three
arguments: a key value, a default result, and a default info-getting
procedure (to be called with the key and default result for default
handling). If @scheme[#:info] is not supplied, the default
info-getting procedure is used.
You can also use the (optional) module @scheme[body] forms to provide more
definitions that might be needed to implement your reader functions.

4
src/mzscheme/src/read.c
View File

@ -5657,8 +5657,8 @@ static Scheme_Object *readtable_call(int w_char, int ch, Scheme_Object *proc, Re
if (get_info) {
a[0] = v;
if (!scheme_check_proc_arity(NULL, 1, 0, 1, a)) {
scheme_wrong_type("read-language", "procedure (arity 1)", -1, -1, a);
if (!scheme_check_proc_arity(NULL, 2, 0, 1, a)) {
scheme_wrong_type("read-language", "procedure (arity 2)", -1, -1, a);
}
}