diff options
Diffstat (limited to 'scheme/guile')
| -rw-r--r-- | scheme/guile/geiser/doc.scm | 24 | ||||
| -rw-r--r-- | scheme/guile/geiser/modules.scm | 14 | ||||
| -rw-r--r-- | scheme/guile/geiser/utils.scm | 12 |
3 files changed, 28 insertions, 22 deletions
diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index 982af95..85bf4d4 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -38,11 +38,14 @@ (and args (signature name args)))) (define (signature id args-list) + (define (rem-gensyms args) + (map (lambda (s) (if (gensym? s) '_ + (if (list? s) (rem-gensyms s) s))) args)) (define (arglst args kind) (let ((args (assq-ref args kind))) - (cond ((or (not args) (null? args)) '()) - ((list? args) args) - (else (list args))))) + (rem-gensyms (cond ((or (not args) (null? args)) '()) + ((list? args) args) + (else (list args)))))) (define (mkargs as) `((required ,@(arglst as 'required)) (optional ,@(arglst as 'optional) @@ -80,24 +83,19 @@ (else #f)))) (define (arity->args art) + (define (gen-arg-names count) + (map (lambda (x) '_) (iota (max count 0)))) (let ((req (car art)) (opt (cadr art)) (rest (caddr art))) `(,@(if (> req 0) - (list (cons 'required (gen-arg-names 1 req))) + (list (cons 'required (gen-arg-names req))) '()) ,@(if (> opt 0) - (list (cons 'optional (gen-arg-names (+ 1 req) opt))) + (list (cons 'optional (gen-arg-names opt))) '()) ,@(if rest (list (cons 'rest 'rest)) '())))) -(define (gen-arg-names fst count) - (let* ((letts (list->vector '(#\x #\y #\z #\u #\v #\w #\t))) - (len (vector-length letts)) - (lett (lambda (n) (vector-ref letts (modulo n len))))) - (map (lambda (n) (string->symbol (format "~A" (lett (- n 1))))) - (iota (max count 1) fst)))) - (define (arglist->args arglist) `((required . ,(car arglist)) (optional . ,(cadr arglist)) @@ -173,7 +171,7 @@ (with-output-to-string (lambda () (let* ((type (cond ((macro? obj) "A macro") - ((procedure? obj) "A procedure") + ((procedure? obj) "A procedure") ((program? obj) "A compiled program") (else "An object"))) (modname (symbol-module sym)) diff --git a/scheme/guile/geiser/modules.scm b/scheme/guile/geiser/modules.scm index 6f499dd..7ca18c9 100644 --- a/scheme/guile/geiser/modules.scm +++ b/scheme/guile/geiser/modules.scm @@ -25,7 +25,7 @@ (define (module-name? module-name) (and (list? module-name) - (> (length module-name) 0) + (not (null? module-name)) (every symbol? module-name))) (define (symbol-module sym . all) @@ -67,13 +67,13 @@ (define (all-modules) (define (maybe-name m) - (let ((name (format "~A" (module-name m)))) - (and (not (string-match "^[(]#[{]" name)) name))) + (let ((name (module-name m))) + (and (not (gensym? (car name))) + (format "~A" name)))) (let* ((guile (resolve-module '(guile))) - (roots (remove (lambda (m) (eq? m guile)) (root-modules)))) - (cons "(guile)" - (filter-map maybe-name - (apply append (map all-child-modules roots)))))) + (roots (remove (lambda (m) (eq? m guile)) (root-modules))) + (children (append-map all-child-modules roots))) + (cons "(guile)" (filter-map maybe-name children)))) (define* (all-child-modules mod #:optional (seen '())) (let ((cs (filter (lambda (m) (not (member m seen))) (submodules mod)))) diff --git a/scheme/guile/geiser/utils.scm b/scheme/guile/geiser/utils.scm index b047e6c..01dfaa0 100644 --- a/scheme/guile/geiser/utils.scm +++ b/scheme/guile/geiser/utils.scm @@ -1,6 +1,6 @@ ;;; utils.scm -- utility functions -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -13,7 +13,9 @@ #:export (make-location symbol->object pair->list - sort-symbols!)) + sort-symbols! + gensym?) + #:use-module (ice-9 regex)) (define (symbol->object sym) (and (symbol? sym) @@ -35,4 +37,10 @@ (string<? (symbol->string l) (symbol->string r))))) (sort! syms cmp))) +(define (gensym? sym) + (and (symbol? sym) (gensym-name? (format "~A" sym)))) + +(define (gensym-name? name) + (and (string-match "^#[{]" name) #t)) + ;;; utils.scm ends here |