From f346bc7f1aa229b2720dbf6cbd42afe9cc95de1c Mon Sep 17 00:00:00 2001
From: Carl Eastlund <cce@racket-lang.org>
Date: Mon, 18 Jan 2010 23:10:10 +0000
Subject: [PATCH] Added a module for statically computing source locations and
 module paths.

svn: r17722
---
 collects/unstable/location.ss | 66 +++++++++++++++++++++++++++++++++++
 1 file changed, 66 insertions(+)
 create mode 100644 collects/unstable/location.ss

diff --git a/collects/unstable/location.ss b/collects/unstable/location.ss
new file mode 100644
index 0000000000..75a46e39fc
--- /dev/null
+++ b/collects/unstable/location.ss
@@ -0,0 +1,66 @@
+#lang scheme/base
+
+(require (for-syntax scheme/base unstable/srcloc))
+
+(provide quote-srcloc
+         quote-source-file
+         quote-line-number
+         quote-column-number
+         quote-character-position
+         quote-character-span
+         quote-module-path
+         quote-module-name)
+
+(define-syntax (quote-srcloc stx)
+  (syntax-case stx ()
+    [(_) #`(quote-srcloc #,stx)]
+    [(_ loc)
+     (with-syntax ([(arg ...) (build-source-location-list #'loc)])
+       #'(make-srcloc (quote arg) ...))]))
+
+(define-syntax (quote-source-file stx)
+  (syntax-case stx ()
+    [(_) #`(quote-source-file #,stx)]
+    [(_ loc) #`(quote #,(source-location-source #'loc))]))
+
+(define-syntax (quote-line-number stx)
+  (syntax-case stx ()
+    [(_) #`(quote-line-number #,stx)]
+    [(_ loc) #`(quote #,(source-location-line #'loc))]))
+
+(define-syntax (quote-column-number stx)
+  (syntax-case stx ()
+    [(_) #`(quote-column-number #,stx)]
+    [(_ loc) #`(quote #,(source-location-column #'loc))]))
+
+(define-syntax (quote-character-position stx)
+  (syntax-case stx ()
+    [(_) #`(quote-character-position #,stx)]
+    [(_ loc) #`(quote #,(source-location-position #'loc))]))
+
+(define-syntax (quote-character-span stx)
+  (syntax-case stx ()
+    [(_) #`(quote-character-span #,stx)]
+    [(_ loc) #`(quote #,(source-location-span #'loc))]))
+
+(define-syntax-rule (quote-module-name)
+  (variable-reference->module-name (#%variable-reference)))
+
+(define-syntax-rule (quote-module-path)
+  (variable-reference->module-path (#%variable-reference)))
+
+(define (variable-reference->module-path var)
+  (module-name->module-path
+   (variable-reference->module-name var)))
+
+(define (variable-reference->module-name var)
+  (let* ([rmp (variable-reference->resolved-module-path var)])
+    (if (resolved-module-path? rmp)
+      (resolved-module-path-name rmp)
+      rmp)))
+
+(define (module-name->module-path name)
+  (cond
+   [(path? name) `(file ,(path->string name))]
+   [(symbol? name) `(quote ,name)]
+   [else 'top-level]))