conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

made apropos symbols come out in order (as in symbol<? order)

This commit is contained in:
Abdulaziz Ghuloum 2008-12-27 13:48:49 -05:00
parent 264156f305
commit 2658e6395d
2 changed files with 25 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
scheme/ikarus.apropos.ss
View File

@ -28,28 +28,30 @@
[(symbol? name) (symbol->string name)]
[else
(die who "not a string or symbol" name)])])
(let ([libs (installed-libraries)]
[matcher
(compose (match-maker name)
(compose symbol->string car))])
(fold-right
(lambda (lib rest)
(let ([ls (filter matcher (library-subst lib))])
(if (null? ls)
rest
(cons (cons (library-name lib) (map car ls)) rest))))
'()
(list-sort
(lambda (lib1 lib2)
(let f ([ls1 (library-name lib1)] [ls2 (library-name lib2)])
(and (pair? ls2)
(or (null? ls1)
(let ([s1 (symbol->string (car ls1))]
[s2 (symbol->string (car ls2))])
(or (string<? s1 s2)
(and (string=? s1 s2)
(f (cdr ls1) (cdr ls2)))))))))
(installed-libraries))))))
(define matcher
(compose (match-maker name)
(compose symbol->string car)))
(fold-right
(lambda (lib rest)
(define (symbol<? s1 s2)
(string<? (symbol->string s1) (symbol->string s2)))
(let ([ls (filter matcher (library-subst lib))])
(if (null? ls)
rest
(let ([ls (list-sort symbol<? (map car ls))])
(cons (cons (library-name lib) ls) rest)))))
'()
(list-sort
(lambda (lib1 lib2)
(let f ([ls1 (library-name lib1)] [ls2 (library-name lib2)])
(and (pair? ls2)
(or (null? ls1)
(let ([s1 (symbol->string (car ls1))]
[s2 (symbol->string (car ls2))])
(or (string<? s1 s2)
(and (string=? s1 s2)
(f (cdr ls1) (cdr ls2)))))))))
(installed-libraries)))))
(define (apropos name)
(for-each

2
scheme/last-revision
View File

@ -1 +1 @@
1729
1730