utils.scm (1593B)
1 ;;; utils.scm -- utility functions 2 3 ;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz 4 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>. 9 10 ;; Start date: Mon Mar 02, 2009 01:48 11 12 (define-module (geiser utils) 13 #:export (make-location 14 symbol->object 15 pair->list 16 sort-symbols! 17 make-symbol-sort 18 gensym?) 19 #:use-module (ice-9 regex)) 20 21 (define (symbol->object sym) 22 (and (symbol? sym) 23 (module-defined? (current-module) sym) 24 (module-ref (current-module) sym))) 25 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)))))) 31 32 (define (make-location file line) 33 (list (cons "file" (if (string? file) file '())) 34 (cons "line" (if (number? line) (+ 1 line) '())))) 35 36 (define (sort-symbols! syms) 37 (let ((cmp (lambda (l r) 38 (string<? (symbol->string l) (symbol->string r))))) 39 (sort! syms cmp))) 40 41 (define (make-symbol-sort sel) 42 (let ((cmp (lambda (a b) 43 (string<? (symbol->string (sel a)) 44 (symbol->string (sel b)))))) 45 (lambda (syms) 46 (sort! syms cmp)))) 47 48 (define (gensym? sym) 49 (and (symbol? sym) (gensym-name? (format #f "~A" sym)))) 50 51 (define (gensym-name? name) 52 (and (string-match "^#[{]" name) #t))