golche

object-applyでgorubyっぽいことをする試み。

(extend srfi-1 util.combinations)

(define (matching-symbols key)
  (define (pack-capture-sizes mat)
    (fold (lambda (i r) (+ (string-size (mat i)) (* r 32)))
          0 (iota (- (rxmatch-num-matches mat) 1) 1)))
  (let ([results '()]
        [matcher (string->regexp
                  (regexp-replace-all
                   #/./
                   (x->string key)
                   (lambda (m)
                     #`"(.*?),(regexp-quote (m))")))])
    (for-each
     (lambda (mod)
       (hash-table-for-each
        (module-table mod)
        (lambda (sym val)
          (let* ([s (symbol->string sym)]
                 [m (rxmatch matcher s)])
            (if m (push! results
                         (list (pack-capture-sizes m) s sym)))))))
     (all-modules))
    (map! caddr
          (sort! results
                 (lambda (x y)
                   (or (< (car x) (car y))
                       (and (= (car x) (car y))
                            (string<? (cadr x) (cadr y)))))))))

(define (shortest-abbreviation key)
  (set! key (x->string key))
  (let* ([lst (matching-symbols key)]
         [sym (string->symbol key)])
    (if (or (null? lst) (not (memq sym lst)))
        #f
        (call/cc
         (lambda (cnt)
           (for-each
            (lambda (n)
              (combinations-for-each
               (lambda (c)
                 (set! c (list->string c))
                 (if (eq? sym (car (matching-symbols c)))
                     (cnt c)))
               (string->list key) n))
            (iota (string-size key) 1)))))))

(define-method object-apply ((kwd <keyword>))
  (let ([sym (string->symbol (keyword->string kwd))]
        [mod (current-module)])
    (if (global-variable-bound? mod sym)
        (global-variable-ref mod sym)
      (let ([lst (matching-symbols sym)] [val #f])
        (if (null? lst) (error "golche: no match"))
        (set! val (global-variable-ref mod (car lst)))
        (eval `(define ,sym ,val) mod)
        (format (standard-error-port) "~s => ~s\n" val sym)
        val))))

(define-method object-apply ((kwd <keyword>) . arg)
  (apply (object-apply kwd) arg))

> gosh -I. -l golche.scm
gosh> (:mp(:nm)(:io 9))
#<subr number->string> => nm
#<closure iota> => io
#<subr map> => mp
("0" "1" "2" "3" "4" "5" "6" "7" "8")
gosh> (shortest-abbreviation 'shortest-abbreviation)
"sh"
gosh> (:sh 'regexp-replace-all*)
#<closure shortest-abbreviation> => sh
"r--*"

一応動いてるっぽい。
検索対象が多いのと関数名が長いせいでshortest-abbreviationはかなり遅い。