minor improvement to class/c: generate a little bit less code
This commit is contained in:
parent
429000fe3b
commit
5b09ea16fb
|
@ -3496,13 +3496,10 @@ An example
|
|||
[else #f]))
|
||||
(syntax-local-name))])
|
||||
(syntax/loc stx
|
||||
(let* ([inits+contracts (sort (list (cons i i-c) ...)
|
||||
(lambda (s1 s2)
|
||||
(string<? (symbol->string s1) (symbol->string s2)))
|
||||
#:key car)])
|
||||
(let-values ([(inits init-ctcs) (sort-inits+contracts (list (cons i i-c) ...))])
|
||||
(make-class/c methods method-ctcs
|
||||
fields field-ctcs
|
||||
(map car inits+contracts) (map cdr inits+contracts)
|
||||
inits init-ctcs
|
||||
inherits inherit-ctcs
|
||||
inherit-fields inherit-field-ctcs
|
||||
supers super-ctcs
|
||||
|
@ -3514,6 +3511,13 @@ An example
|
|||
opaque?
|
||||
'name))))))]))
|
||||
|
||||
(define (sort-inits+contracts lst)
|
||||
(define sorted
|
||||
(sort lst
|
||||
string<?
|
||||
#:key (compose symbol->string car)))
|
||||
(values (map car sorted) (map cdr sorted)))
|
||||
|
||||
(define (check-object-contract obj methods fields fail)
|
||||
(unless (object? obj)
|
||||
(fail "not a object"))
|
||||
|
|
Loading…
Reference in New Issue
Block a user