From 4a8740595df89ae29fe3eef0f133e78787665b9a Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Mon, 23 Jan 2012 12:31:33 +0100
Subject: [PATCH 2/3] add syntax-module

* module/ice-9/psyntax.scm (syntax-module): New accessor for syntax
  objects.
* module/ice-9/psyntax-pp.scm: Regenerate.

* module/ice-9/boot-9.scm: Declare syntax-module.

* doc/ref/api-macros.texi: Document it.
---
 doc/ref/api-macros.texi     |    5 +
 module/ice-9/boot-9.scm     |    1 +
 module/ice-9/psyntax-pp.scm |14124 ++++++++++++++++++++++---------------------
 module/ice-9/psyntax.scm    |    5 +
 4 files changed, 7082 insertions(+), 7053 deletions(-)

diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 02b5d5c..2b6f15a 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -706,6 +706,11 @@ Return the source properties that correspond to the syntax object
 @var{x}.  @xref{Source Properties}, for more information.
 @end deffn
 
+@deffn {Scheme Procedure} syntax-module id
+Return the name of the module whose source contains the identifier
+@var{id}.
+@end deffn
+
 @deffn {Scheme Procedure} syntax-local-binding id
 Resolve the identifer @var{id}, a syntax object, within the current
 lexical environment, and return two values, the binding type and a
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index cd55203..3914ff3 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -385,6 +385,7 @@ If there is no handler at all, Guile prints an error and then exits."
 (define datum->syntax #f)
 (define syntax->datum #f)
 (define syntax-source #f)
+(define syntax-module #f)
 (define identifier? #f)
 (define generate-temporaries #f)
 (define bound-identifier=? #f)
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 024bb85..00cb549 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2525,6 +2525,11 @@
     (set! syntax-source
           (lambda (x) (source-annotation x)))
 
+    (set! syntax-module
+          (lambda (id)
+            (arg-check nonsymbol-id? id 'syntax-module)
+            (cdr (syntax-object-module id))))
+
     (set! syntax-local-binding
           (lambda (id)
             (arg-check nonsymbol-id? id 'syntax-local-binding)
-- 
1.7.8.3