scheme/racket/geiser/locations.rkt

   1 ;;; locations.rkt -- locating symbols
   2
   3 ;; Copyright (C) 2009, 2010 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: Sun Apr 26, 2009 19:43
  11
  12 #lang racket
  13
  14 (provide symbol-location
  15          symbol-location*
  16          module-location
  17          symbol-module
  18          symbol-module-name)
  19
  20 (require geiser/utils geiser/modules)
  21
  22 (define (symbol-location* sym)
  23   (let* ([id (namespace-symbol->identifier sym)]
  24          [binding (and id (identifier-binding id))])
  25     (if (list? binding)
  26         (cons
  27          (cadr binding)
  28          (resolved-module-path-name
  29           (module-path-index-resolve (car binding))))
  30         (cons sym #f))))
  31
  32 (define (make-location name path line)
  33   (list (cons "name" name)
  34         (cons "file" (if (path? path) (path->string path) '()))
  35         (cons "line" (or line '()))))
  36
  37 (define (symbol-location sym)
  38   (let* ([loc (symbol-location* sym)]
  39          [name (car loc)]
  40          [path (cdr loc)])
  41     (if path
  42         (make-location name path #f)
  43         (module-location sym))))
  44
  45 (define symbol-module (compose cdr symbol-location*))
  46
  47 (define symbol-module-name
  48   (compose module-path-name->name symbol-module))
  49
  50 (define (module-location sym)
  51   (make-location sym (module-spec->path-name sym) 1))