From 1f80c5048e78d0251c18634b8bf7d3f8ea4733b0 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 2 Mar 2009 03:13:59 +0100 Subject: Breakdown of schemeland into neat submodules. --- scheme/guile/geiser/utils.scm | 53 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 scheme/guile/geiser/utils.scm (limited to 'scheme/guile/geiser/utils.scm') diff --git a/scheme/guile/geiser/utils.scm b/scheme/guile/geiser/utils.scm new file mode 100644 index 0000000..1aa919a --- /dev/null +++ b/scheme/guile/geiser/utils.scm @@ -0,0 +1,53 @@ +;; utils.scm -- utility functions + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Start date: Mon Mar 02, 2009 01:48 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Comentary: + +;; Some utilities used by other modules. + +;;; Code: + +(define-module (geiser utils) + #:export (make-location + symbol->object + pair->list + sort-symbols!)) + +(define (symbol->object sym) + (and (symbol? sym) + (module-defined? (current-module) sym) + (module-ref (current-module) sym))) + +(define (pair->list pair) + (let loop ((d pair) (s '())) + (cond ((null? d) (reverse! s)) + ((symbol? d) (reverse! (cons d s))) + (else (loop (cdr d) (cons (car d) s)))))) + +(define (make-location file line) + (list (cons 'file (if (string? file) file '())) + (cons 'line (if (number? line) (+ 1 line) '())))) + +(define (sort-symbols! syms) + (let ((cmp (lambda (l r) + (stringstring l) (symbol->string r))))) + (sort! syms cmp))) + +;;; utils.scm ends here -- cgit v1.2.3