From 2d30daecad657d692a7f3cb66deb496630362600 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 24 May 2010 00:03:30 +0200 Subject: Racket: PLT implementation renamed to Racket. --- scheme/racket/geiser/locations.rkt | 54 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 scheme/racket/geiser/locations.rkt (limited to 'scheme/racket/geiser/locations.rkt') diff --git a/scheme/racket/geiser/locations.rkt b/scheme/racket/geiser/locations.rkt new file mode 100644 index 0000000..b4c0f37 --- /dev/null +++ b/scheme/racket/geiser/locations.rkt @@ -0,0 +1,54 @@ +;;; locations.rkt -- locating symbols + +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the Modified BSD License. You should +;; have received a copy of the license along with this program. If +;; not, see . + +;; Start date: Sun Apr 26, 2009 19:43 + +#lang racket + +(provide symbol-location + symbol-location* + module-location + symbol-module-name + symbol-module-path-name) + +(require geiser/utils geiser/modules) + +(define (symbol-location* sym) + (let* ((id (namespace-symbol->identifier sym)) + (binding (and id (identifier-binding id)))) + (if (list? binding) + (cons + (cadr binding) + (resolved-module-path-name + (module-path-index-resolve (car binding)))) + (cons sym #f)))) + +(define (make-location name path line) + (list (cons 'name name) + (cons 'file (if (path? path) (path->string path) '())) + (cons 'line (or line '())))) + +(define (symbol-location sym) + (let* ((loc (symbol-location* sym)) + (name (car loc)) + (path (cdr loc))) + (if path + (make-location name path #f) + (module-location sym)))) + +(define symbol-module-path-name (compose cdr symbol-location*)) + +(define symbol-module-name + (compose module-path-name->name symbol-module-path-name)) + +(define (module-location sym) + (make-location sym (module-spec->path-name sym) 1)) + + +;;; locations.rkt ends here -- cgit v1.2.3