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

minor improvement to class/c: generate a little bit less code

Browse Source
This commit is contained in:
Robby Findler 2013-05-26 15:49:15 -05:00
parent 429000fe3b
commit 5b09ea16fb
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/racket/private/class-internal.rkt
View File

@ -3496,13 +3496,10 @@ An example
[else #f])) [else #f]))
(syntax-local-name))]) (syntax-local-name))])
(syntax/loc stx (syntax/loc stx
(let* ([inits+contracts (sort (list (cons i i-c) ...) (let-values ([(inits init-ctcs) (sort-inits+contracts (list (cons i i-c) ...))])
(lambda (s1 s2)
(string<? (symbol->string s1) (symbol->string s2)))
#:key car)])
(make-class/c methods method-ctcs (make-class/c methods method-ctcs
fields field-ctcs fields field-ctcs
(map car inits+contracts) (map cdr inits+contracts) inits init-ctcs
inherits inherit-ctcs inherits inherit-ctcs
inherit-fields inherit-field-ctcs inherit-fields inherit-field-ctcs
supers super-ctcs supers super-ctcs
@ -3514,6 +3511,13 @@ An example
opaque? opaque?
'name))))))])) '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) (define (check-object-contract obj methods fields fail)
(unless (object? obj) (unless (object? obj)
(fail "not a object")) (fail "not a object"))