unit bug fixes related to new scoping of signature elements; change scribble/manual to compute ids typeset as variables at compile time, in preparation for moving from a parameter to syntax bindings; fix docs typos; extend decompiler's support for unmarshaling syntax objects
svn: r12046 original commit: 7a55275a26f4052af6ec87f2737f367721abc4ec
This commit is contained in:
Matthew Flatt
parent
88e4b31afe
commit
1096283709
|
|
@ -12,7 +12,9 @@
|
|||
scheme/stxparam
|
||||
scheme/serialize
|
||||
setup/main-collects
|
||||
(for-syntax scheme/base)
|
||||
(for-syntax scheme/base
|
||||
syntax/boundmap
|
||||
syntax/kerncase)
|
||||
(for-label scheme/base
|
||||
scheme/class))
|
||||
|
||||
|
|
@ -739,13 +741,16 @@
|
|||
[(_ [[proto result] ...] desc ...)
|
||||
(defproc* #:mode procedure #:within #f [[proto result] ...] desc ...)]
|
||||
[(_ #:mode m #:within cl [[proto result] ...] desc ...)
|
||||
(*defproc 'm (quote-syntax/loc cl)
|
||||
(list (extract-proc-id proto) ...)
|
||||
'[proto ...]
|
||||
(list (arg-contracts proto) ...)
|
||||
(list (arg-defaults proto) ...)
|
||||
(list (lambda () (result-contract result)) ...)
|
||||
(lambda () (list desc ...)))]))
|
||||
(with-togetherable-scheme-variables
|
||||
()
|
||||
([proc proto] ...)
|
||||
(*defproc 'm (quote-syntax/loc cl)
|
||||
(list (extract-proc-id proto) ...)
|
||||
'[proto ...]
|
||||
(list (arg-contracts proto) ...)
|
||||
(list (arg-defaults proto) ...)
|
||||
(list (lambda () (result-contract result)) ...)
|
||||
(lambda () (list desc ...))))]))
|
||||
(define-syntax defstruct
|
||||
(syntax-rules ()
|
||||
[(_ name fields #:mutable #:inspector #f desc ...)
|
||||
|
|
@ -762,10 +767,13 @@
|
|||
(**defstruct name fields #t #f desc ...)]))
|
||||
(define-syntax-rule (**defstruct name ([field field-contract] ...) immutable?
|
||||
transparent? desc ...)
|
||||
(*defstruct (quote-syntax/loc name) 'name
|
||||
'([field field-contract] ...)
|
||||
(list (lambda () (schemeblock0 field-contract)) ...)
|
||||
immutable? transparent? (lambda () (list desc ...))))
|
||||
(with-togetherable-scheme-variables
|
||||
()
|
||||
()
|
||||
(*defstruct (quote-syntax/loc name) 'name
|
||||
'([field field-contract] ...)
|
||||
(list (lambda () (schemeblock0 field-contract)) ...)
|
||||
immutable? transparent? (lambda () (list desc ...)))))
|
||||
(define-syntax (defform*/subs stx)
|
||||
(syntax-case stx ()
|
||||
[(_ #:id defined-id #:literals (lit ...) [spec spec1 ...]
|
||||
|
|
@ -783,16 +791,20 @@
|
|||
spec
|
||||
spec)]
|
||||
[_ spec])))])
|
||||
#'(*defforms (quote-syntax/loc defined-id) '(lit ...)
|
||||
'(spec spec1 ...)
|
||||
(list (lambda (x) (schemeblock0/form new-spec))
|
||||
(lambda (ignored) (schemeblock0/form spec1)) ...)
|
||||
'((non-term-id non-term-form ...) ...)
|
||||
(list (list (lambda () (scheme non-term-id))
|
||||
(lambda () (schemeblock0/form non-term-form))
|
||||
...)
|
||||
...)
|
||||
(lambda () (list desc ...))))]
|
||||
#'(with-togetherable-scheme-variables
|
||||
(lit ...)
|
||||
([form spec] [form spec1] ...
|
||||
[non-term (non-term-id non-term-form ...)] ...)
|
||||
(*defforms (quote-syntax/loc defined-id)
|
||||
'(spec spec1 ...)
|
||||
(list (lambda (x) (schemeblock0/form new-spec))
|
||||
(lambda (ignored) (schemeblock0/form spec1)) ...)
|
||||
'((non-term-id non-term-form ...) ...)
|
||||
(list (list (lambda () (scheme non-term-id))
|
||||
(lambda () (schemeblock0/form non-term-form))
|
||||
...)
|
||||
...)
|
||||
(lambda () (list desc ...)))))]
|
||||
[(fm #:id id [spec spec1 ...] ([non-term-id non-term-form ...] ...)
|
||||
desc ...)
|
||||
#'(fm #:id id #:literals () [spec spec1 ...]
|
||||
|
|
@ -839,46 +851,60 @@
|
|||
(define-syntax (defform/none stx)
|
||||
(syntax-case stx ()
|
||||
[(_ #:literals (lit ...) spec desc ...)
|
||||
#'(*defforms #f '(lit ...)
|
||||
'(spec) (list (lambda (ignored) (schemeblock0/form spec)))
|
||||
null null
|
||||
(lambda () (list desc ...)))]
|
||||
#'(with-togetherable-scheme-variables
|
||||
(lit ...)
|
||||
([form spec])
|
||||
(*defforms #f
|
||||
'(spec) (list (lambda (ignored) (schemeblock0/form spec)))
|
||||
null null
|
||||
(lambda () (list desc ...))))]
|
||||
[(_ spec desc ...)
|
||||
#'(defform/none #:literals () spec desc ...)]))
|
||||
(define-syntax (defidform stx)
|
||||
(syntax-case stx ()
|
||||
[(_ spec-id desc ...)
|
||||
#'(*defforms (quote-syntax/loc spec-id) null
|
||||
'(spec-id)
|
||||
(list (lambda (x) (make-omitable-paragraph (list x))))
|
||||
null
|
||||
null
|
||||
(lambda () (list desc ...)))]))
|
||||
#'(with-togetherable-scheme-variables
|
||||
()
|
||||
()
|
||||
(*defforms (quote-syntax/loc spec-id)
|
||||
'(spec-id)
|
||||
(list (lambda (x) (make-omitable-paragraph (list x))))
|
||||
null
|
||||
null
|
||||
(lambda () (list desc ...))))]))
|
||||
(define-syntax (defsubform stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . rest) #'(into-blockquote (defform . rest))]))
|
||||
(define-syntax (defsubform* stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . rest) #'(into-blockquote (defform* . rest))]))
|
||||
(define-syntax spec?form/subs
|
||||
(syntax-rules ()
|
||||
[(_ has-kw? #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
|
||||
desc ...)
|
||||
(with-scheme-variables
|
||||
(lit ...)
|
||||
([form/maybe (has-kw? spec)]
|
||||
[non-term (non-term-id non-term-form ...)] ...)
|
||||
(*specsubform 'spec '(lit ...) (lambda () (schemeblock0/form spec))
|
||||
'((non-term-id non-term-form ...) ...)
|
||||
(list (list (lambda () (scheme non-term-id))
|
||||
(lambda () (schemeblock0/form non-term-form))
|
||||
...)
|
||||
...)
|
||||
(lambda () (list desc ...))))]))
|
||||
(define-syntax specsubform
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) spec desc ...)
|
||||
(*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0/form spec))
|
||||
null null (lambda () (list desc ...)))]
|
||||
(spec?form/subs #f #:literals (lit ...) spec () desc ...)]
|
||||
[(_ spec desc ...)
|
||||
(*specsubform 'spec #f null (lambda () (schemeblock0/form spec))
|
||||
null null (lambda () (list desc ...)))]))
|
||||
(specsubform #:literals () spec desc ...)]))
|
||||
(define-syntax specsubform/subs
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
|
||||
desc ...)
|
||||
(*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0/form spec))
|
||||
'((non-term-id non-term-form ...) ...)
|
||||
(list (list (lambda () (scheme non-term-id))
|
||||
(lambda () (schemeblock0/form non-term-form))
|
||||
...)
|
||||
...)
|
||||
(lambda () (list desc ...)))]
|
||||
(spec?form/subs #f #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
|
||||
desc ...)]
|
||||
[(_ spec subs desc ...)
|
||||
(specsubform/subs #:literals () spec subs desc ...)]))
|
||||
(define-syntax-rule (specspecsubform spec desc ...)
|
||||
|
|
@ -888,37 +914,37 @@
|
|||
(define-syntax specform
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) spec desc ...)
|
||||
(*specsubform 'spec #t '(lit ...) (lambda () (schemeblock0/form spec))
|
||||
null null (lambda () (list desc ...)))]
|
||||
(spec?form/subs #t #:literals (lit ...) spec () desc ...)]
|
||||
[(_ spec desc ...)
|
||||
(*specsubform 'spec #t null (lambda () (schemeblock0/form spec))
|
||||
null null (lambda () (list desc ...)))]))
|
||||
(specform #:literals () spec desc ...)]))
|
||||
(define-syntax specform/subs
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
|
||||
desc ...)
|
||||
(*specsubform 'spec #t
|
||||
'(lit ...)
|
||||
(lambda () (schemeblock0/form spec))
|
||||
'((non-term-id non-term-form ...) ...)
|
||||
(list (list (lambda () (scheme non-term-id))
|
||||
(lambda () (schemeblock0/form non-term-form))
|
||||
...)
|
||||
...)
|
||||
(lambda () (list desc ...)))]
|
||||
(spec?form/subs #t #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
|
||||
desc ...)]
|
||||
[(_ spec ([non-term-id non-term-form ...] ...) desc ...)
|
||||
(specform/subs #:literals () spec ([non-term-id non-term-form ...] ...)
|
||||
desc ...)]))
|
||||
(define-syntax-rule (specsubform/inline spec desc ...)
|
||||
(*specsubform 'spec #f null #f null null (lambda () (list desc ...))))
|
||||
(with-scheme-variables
|
||||
()
|
||||
([form/maybe (#f spec)])
|
||||
(*specsubform 'spec null #f null null (lambda () (list desc ...)))))
|
||||
(define-syntax-rule (defthing id result desc ...)
|
||||
(*defthing (list (quote-syntax/loc id)) (list 'id) #f
|
||||
(list (schemeblock0 result))
|
||||
(lambda () (list desc ...))))
|
||||
(with-togetherable-scheme-variables
|
||||
()
|
||||
()
|
||||
(*defthing (list (quote-syntax/loc id)) (list 'id) #f
|
||||
(list (schemeblock0 result))
|
||||
(lambda () (list desc ...)))))
|
||||
(define-syntax-rule (defthing* ([id result] ...) desc ...)
|
||||
(*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f
|
||||
(list (schemeblock0 result) ...)
|
||||
(lambda () (list desc ...))))
|
||||
(with-togetherable-scheme-variables
|
||||
()
|
||||
()
|
||||
(*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f
|
||||
(list (schemeblock0 result) ...)
|
||||
(lambda () (list desc ...)))))
|
||||
(define-syntax-rule (defparam id arg contract desc ...)
|
||||
(defproc* ([(id) contract] [(id [arg contract]) void?]) desc ...))
|
||||
(define-syntax-rule (defparam* id arg in-contract out-contract desc ...)
|
||||
|
|
@ -928,20 +954,26 @@
|
|||
(define-syntax schemegrammar
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) id clause ...)
|
||||
(*schemegrammar '(lit ...)
|
||||
'(id clause ...)
|
||||
(lambda ()
|
||||
(list (list (scheme id)
|
||||
(schemeblock0/form clause) ...))))]
|
||||
(with-scheme-variables
|
||||
(lit ...)
|
||||
([non-term (id clause ...)])
|
||||
(*schemegrammar '(lit ...)
|
||||
'(id clause ...)
|
||||
(lambda ()
|
||||
(list (list (scheme id)
|
||||
(schemeblock0/form clause) ...)))))]
|
||||
[(_ id clause ...) (schemegrammar #:literals () id clause ...)]))
|
||||
(define-syntax schemegrammar*
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) [id clause ...] ...)
|
||||
(*schemegrammar '(lit ...)
|
||||
'(id ... clause ... ...)
|
||||
(lambda ()
|
||||
(list (list (scheme id) (schemeblock0/form clause) ...)
|
||||
...)))]
|
||||
(with-scheme-variables
|
||||
(lit ...)
|
||||
([non-term (id clause ...)] ...)
|
||||
(*schemegrammar '(lit ...)
|
||||
'(id ... clause ... ...)
|
||||
(lambda ()
|
||||
(list (list (scheme id) (schemeblock0/form clause) ...)
|
||||
...))))]
|
||||
[(_ [id clause ...] ...)
|
||||
(schemegrammar* #:literals () [id clause ...] ...)]))
|
||||
(define-syntax-rule (var id)
|
||||
|
|
@ -949,6 +981,75 @@
|
|||
(define-syntax-rule (svar id)
|
||||
(*var 'id))
|
||||
|
||||
(define-syntax (with-togetherable-scheme-variables stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . rest)
|
||||
;; Make it transparent, so deftogether is allowed to pull it apart
|
||||
(syntax-property
|
||||
(syntax/loc stx
|
||||
(with-togetherable-scheme-variables* . rest))
|
||||
'certify-mode
|
||||
'transparent)]))
|
||||
|
||||
(define-syntax-rule (with-togetherable-scheme-variables* . rest)
|
||||
(with-scheme-variables . rest))
|
||||
|
||||
(define-syntax (with-scheme-variables stx)
|
||||
(syntax-case stx ()
|
||||
[(_ lits ([kind s-exp] ...) body)
|
||||
(let ([ht (make-bound-identifier-mapping)]
|
||||
[lits (syntax->datum #'lits)])
|
||||
(for-each (lambda (kind s-exp)
|
||||
(case (syntax-e kind)
|
||||
[(proc)
|
||||
(for-each
|
||||
(lambda (arg)
|
||||
(if (identifier? arg)
|
||||
(unless (or (eq? (syntax-e arg) '...)
|
||||
(eq? (syntax-e arg) '...+)
|
||||
(memq (syntax-e arg) lits))
|
||||
(bound-identifier-mapping-put! ht arg #t))
|
||||
(syntax-case arg ()
|
||||
[(kw arg . rest)
|
||||
(keyword? (syntax-e #'kw))
|
||||
(bound-identifier-mapping-put! ht #'arg #t)]
|
||||
[(arg . rest)
|
||||
(identifier? #'arg)
|
||||
(bound-identifier-mapping-put! ht #'arg #t)])))
|
||||
(cdr (syntax->list s-exp)))]
|
||||
[(form form/maybe non-term)
|
||||
(let loop ([form (case (syntax-e kind)
|
||||
[(form) (if (identifier? s-exp)
|
||||
null
|
||||
(cdr (syntax-e s-exp)))]
|
||||
[(form/maybe)
|
||||
(syntax-case s-exp ()
|
||||
[(#f form) #'form]
|
||||
[(#t (id . form)) #'form])]
|
||||
[(non-term) s-exp])])
|
||||
(if (identifier? form)
|
||||
(unless (or (eq? (syntax-e form) '...)
|
||||
(eq? (syntax-e form) '...+)
|
||||
(eq? (syntax-e form) '?)
|
||||
(memq (syntax-e form) lits))
|
||||
(bound-identifier-mapping-put! ht form #t))
|
||||
(syntax-case form (unsyntax)
|
||||
[(unsyntax _) (void)]
|
||||
[(a . b) (loop #'a) (loop #'b)]
|
||||
[#(a ...) (loop #'(a ...))]
|
||||
[_ (void)])))]
|
||||
[else
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"unknown variable mode"
|
||||
stx
|
||||
kind)]))
|
||||
(syntax->list #'(kind ...))
|
||||
(syntax->list #'(s-exp ...)))
|
||||
(with-syntax ([(id ...) (bound-identifier-mapping-map ht (lambda (k v) k))])
|
||||
#'(parameterize ([current-variable-list '(id ...)])
|
||||
body)))]))
|
||||
|
||||
(define (defthing/proc id contract descs)
|
||||
(*defthing (list id) (list (syntax-e id)) #f (list contract)
|
||||
(lambda () descs)))
|
||||
|
|
@ -1009,7 +1110,7 @@
|
|||
(lambda (render part ri)
|
||||
(proc (or (get-exporting-libraries render part ri) null)))))
|
||||
|
||||
(define-struct (box-splice splice) (var-list))
|
||||
(define-struct (box-splice splice) ())
|
||||
|
||||
(define (*deftogether boxes body-thunk)
|
||||
(make-splice
|
||||
|
|
@ -1029,12 +1130,33 @@
|
|||
"together"
|
||||
(table-flowss (car (splice-run box))))))))
|
||||
boxes))
|
||||
(parameterize ([current-variable-list
|
||||
(append-map box-splice-var-list boxes)])
|
||||
(body-thunk)))))
|
||||
(body-thunk))))
|
||||
|
||||
(define-syntax-rule (deftogether (box ...) . body)
|
||||
(*deftogether (list box ...) (lambda () (list . body))))
|
||||
(define-syntax (deftogether stx)
|
||||
(syntax-case stx ()
|
||||
[(_ (def ...) . body)
|
||||
(with-syntax ([((_ (lit ...) (var ...) decl) ...)
|
||||
(map (lambda (def)
|
||||
(let ([exp-def (local-expand
|
||||
def
|
||||
'expression
|
||||
(cons
|
||||
#'with-togetherable-scheme-variables*
|
||||
(kernel-form-identifier-list)))])
|
||||
(syntax-case exp-def (with-togetherable-scheme-variables*)
|
||||
[(with-togetherable-scheme-variables* lits vars decl)
|
||||
exp-def]
|
||||
[_
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"sub-form is not a documentation form that can be combined"
|
||||
stx
|
||||
def)])))
|
||||
(syntax->list #'(def ...)))])
|
||||
#'(with-togetherable-scheme-variables
|
||||
(lit ... ...)
|
||||
(var ... ...)
|
||||
(*deftogether (list decl ...) (lambda () (list . body)))))]))
|
||||
|
||||
(define-struct arg
|
||||
(special? kw id optional? starts-optional? ends-optional? num-closers))
|
||||
|
|
@ -1365,22 +1487,20 @@
|
|||
(define var-list
|
||||
(filter-map (lambda (a) (and (not (arg-special? a)) (arg-id a)))
|
||||
(append* all-args)))
|
||||
(parameterize ([current-variable-list var-list])
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(append-map
|
||||
do-one
|
||||
stx-ids prototypes all-args arg-contractss arg-valss result-contracts
|
||||
(let loop ([ps prototypes] [accum null])
|
||||
(cond [(null? ps) null]
|
||||
[(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
|
||||
(cons #f (loop (cdr ps) accum))]
|
||||
[else (cons #t (loop (cdr ps)
|
||||
(cons (extract-id (car ps)) accum)))]))))
|
||||
(content-thunk))
|
||||
var-list)))
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(append-map
|
||||
do-one
|
||||
stx-ids prototypes all-args arg-contractss arg-valss result-contracts
|
||||
(let loop ([ps prototypes] [accum null])
|
||||
(cond [(null? ps) null]
|
||||
[(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
|
||||
(cons #f (loop (cdr ps) accum))]
|
||||
[else (cons #t (loop (cdr ps)
|
||||
(cons (extract-id (car ps)) accum)))]))))
|
||||
(content-thunk))))
|
||||
|
||||
(define (make-target-element* inner-make-target-element stx-id content wrappers)
|
||||
(if (null? wrappers)
|
||||
|
|
@ -1577,8 +1697,7 @@
|
|||
(make-flow (list (field-contract))))))))]
|
||||
[else null]))
|
||||
fields field-contracts)))
|
||||
(content-thunk))
|
||||
null))
|
||||
(content-thunk))))
|
||||
|
||||
(define (*defthing stx-ids names form? result-contracts content-thunk)
|
||||
(make-box-splice
|
||||
|
|
@ -1623,24 +1742,12 @@
|
|||
result-contract
|
||||
(make-omitable-paragraph (list result-contract)))))))))))
|
||||
stx-ids names result-contracts))
|
||||
(content-thunk))
|
||||
null))
|
||||
(content-thunk))))
|
||||
|
||||
(define (meta-symbol? s) (memq s '(... ...+ ?)))
|
||||
|
||||
(define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk)
|
||||
(define var-list
|
||||
(let loop ([form (cons forms subs)])
|
||||
(cond [(symbol? form)
|
||||
(if (or (meta-symbol? form)
|
||||
(and kw-id (eq? form (syntax-e kw-id)))
|
||||
(memq form lits))
|
||||
null
|
||||
(list form))]
|
||||
[(pair? form) (append (loop (car form)) (loop (cdr form)))]
|
||||
[else null])))
|
||||
(parameterize ([current-variable-list var-list]
|
||||
[current-meta-list '(... ...+)])
|
||||
(define (*defforms kw-id forms form-procs subs sub-procs content-thunk)
|
||||
(parameterize ([current-meta-list '(... ...+)])
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
|
|
@ -1689,23 +1796,10 @@
|
|||
(*schemerawgrammars "specgrammar"
|
||||
(map car l)
|
||||
(map cdr l))))))))))
|
||||
(content-thunk))
|
||||
var-list)))
|
||||
(content-thunk)))))
|
||||
|
||||
(define (*specsubform form has-kw? lits form-thunk subs sub-procs content-thunk)
|
||||
(parameterize ([current-variable-list
|
||||
(append (let loop ([form (cons (if has-kw? (cdr form) form)
|
||||
subs)])
|
||||
(cond
|
||||
[(symbol? form) (if (or (meta-symbol? form)
|
||||
(memq form lits))
|
||||
null
|
||||
(list form))]
|
||||
[(pair? form) (append (loop (car form))
|
||||
(loop (cdr form)))]
|
||||
[else null]))
|
||||
(current-variable-list))]
|
||||
[current-meta-list '(... ...+)])
|
||||
(define (*specsubform form lits form-thunk subs sub-procs content-thunk)
|
||||
(parameterize ([current-meta-list '(... ...+)])
|
||||
(make-blockquote
|
||||
"leftindent"
|
||||
(cons
|
||||
|
|
@ -1754,23 +1848,14 @@
|
|||
(*schemerawgrammars style (list nonterm) (list (cons clause1 clauses))))
|
||||
|
||||
(define (*schemegrammar lits s-expr clauseses-thunk)
|
||||
(parameterize ([current-variable-list
|
||||
(let loop ([form s-expr])
|
||||
(cond
|
||||
[(symbol? form) (if (memq form lits)
|
||||
null
|
||||
(list form))]
|
||||
[(pair? form) (append (loop (car form))
|
||||
(loop (cdr form)))]
|
||||
[else null]))])
|
||||
(let ([l (clauseses-thunk)])
|
||||
(*schemerawgrammars #f
|
||||
(map (lambda (x)
|
||||
(make-element #f
|
||||
(list (hspace 2)
|
||||
(car x))))
|
||||
l)
|
||||
(map cdr l)))))
|
||||
(let ([l (clauseses-thunk)])
|
||||
(*schemerawgrammars #f
|
||||
(map (lambda (x)
|
||||
(make-element #f
|
||||
(list (hspace 2)
|
||||
(car x))))
|
||||
l)
|
||||
(map cdr l))))
|
||||
|
||||
(define (*var id)
|
||||
(to-element (*var-sym id)))
|
||||
|
|
@ -2425,16 +2510,22 @@
|
|||
signature-desc)
|
||||
|
||||
(define-syntax-rule (defsignature name (super ...) body ...)
|
||||
(*defsignature (quote-syntax name)
|
||||
(list (quote-syntax super) ...)
|
||||
(lambda () (list body ...))
|
||||
#t))
|
||||
(with-togetherable-scheme-variables
|
||||
()
|
||||
()
|
||||
(*defsignature (quote-syntax name)
|
||||
(list (quote-syntax super) ...)
|
||||
(lambda () (list body ...))
|
||||
#t)))
|
||||
|
||||
(define-syntax-rule (defsignature/splice name (super ...) body ...)
|
||||
(*defsignature (quote-syntax name)
|
||||
(list (quote-syntax super) ...)
|
||||
(lambda () (list body ...))
|
||||
#f))
|
||||
(with-togetherable-scheme-variables
|
||||
()
|
||||
()
|
||||
(*defsignature (quote-syntax name)
|
||||
(list (quote-syntax super) ...)
|
||||
(lambda () (list body ...))
|
||||
#f)))
|
||||
|
||||
(define-struct sig-desc (in))
|
||||
(define (signature-desc . l)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user