8799cd2137
code that skips over them when building the search indices.
Overall, this means that the only change most people would see
is that multiple constructors in the same class will get a warning
(and there was one of those, so fixed that too).
Also, Rackety. Specifically, transformed this surprising combination
of constructs (where all caps are placeholders for something specific):
((if PRED
(λ (c mk) BODY2)
(λ (c mk) BODY1))
content
(lambda (tag) BODY3))
into this one:
(define (mk tag) BODY3)
(if PRED
BODY1{c:=content}
BODY2{c:=content})
original commit: 8ee76c9547899f62e6f28eba1cdbba1f4d54c399
59 lines
1.5 KiB
Racket
59 lines
1.5 KiB
Racket
#lang scheme/base
|
|
(require "../struct.rkt"
|
|
"../search.rkt"
|
|
"../scheme.rkt"
|
|
"../basic.rkt"
|
|
"manual-scheme.rkt"
|
|
(for-syntax scheme/base))
|
|
|
|
(provide ;; public:
|
|
method xmethod)
|
|
; XXX unknown contracts
|
|
(provide *method **method
|
|
method-tag
|
|
constructor-tag
|
|
name-this-object)
|
|
|
|
(define-syntax-rule (method a b)
|
|
(*method 'b (quote-syntax a)))
|
|
|
|
(define-syntax-rule (xmethod a b)
|
|
(elem (method a b) " in " (racket a)))
|
|
|
|
(define (*method sym id)
|
|
(**method sym id))
|
|
|
|
(define (**method sym id/tag)
|
|
(define content (list (symbol->string sym)))
|
|
(define (mk tag)
|
|
(make-element symbol-color
|
|
(list (make-link-element value-link-color content
|
|
(method-tag tag sym)))))
|
|
(if (identifier? id/tag)
|
|
(make-delayed-element
|
|
(λ (ren p ri)
|
|
(let ([tag (find-scheme-tag p ri id/tag #f)])
|
|
(if tag (list (mk tag)) content)))
|
|
(λ () (car content))
|
|
(λ () (car content)))
|
|
(mk id/tag)))
|
|
|
|
(define (method-tag vtag sym)
|
|
(list 'meth (list (cadr vtag) sym)))
|
|
|
|
(define (constructor-tag vtag)
|
|
(list 'construtor (cadr vtag)))
|
|
|
|
(define (name-this-object type-sym)
|
|
(to-element
|
|
(string->symbol
|
|
(regexp-replace
|
|
#rx"(%|<%>|-mixin)$"
|
|
(format "_a~a-~s"
|
|
(if (member (string-ref (symbol->string type-sym) 0)
|
|
'(#\a #\e #\i #\o #\u))
|
|
"n"
|
|
"")
|
|
type-sym)
|
|
""))))
|