1 ;;; utils.scm -- utility functions
3 ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
10 ;; Start date: Mon Mar 02, 2009 01:48
12 (define-module (geiser utils)
13 #:export (make-location
19 #:use-module (ice-9 regex))
21 (define (symbol->object sym)
23 (module-defined? (current-module) sym)
24 (module-ref (current-module) sym)))
26 (define (pair->list pair)
27 (let loop ((d pair) (s '()))
28 (cond ((null? d) (reverse! s))
29 ((symbol? d) (reverse! (cons d s)))
30 (else (loop (cdr d) (cons (car d) s))))))
32 (define (make-location file line)
33 (list (cons "file" (if (string? file) file '()))
34 (cons "line" (if (number? line) (+ 1 line) '()))))
36 (define (sort-symbols! syms)
37 (let ((cmp (lambda (l r)
38 (string<? (symbol->string l) (symbol->string r)))))
41 (define (make-symbol-sort sel)
42 (let ((cmp (lambda (a b)
43 (string<? (symbol->string (sel a))
44 (symbol->string (sel b))))))
49 (and (symbol? sym) (gensym-name? (format "~A" sym))))
51 (define (gensym-name? name)
52 (and (string-match "^#[{]" name) #t))
54 ;;; utils.scm ends here