[PATCH] Add inspection command "source (,src)" which shows Scheme code of loaded module

[Nala Ginrut]

Attached patch added an inspection command "source" to display the
Scheme code of loaded module, it'll be useful for folks:

-------------Scheme proc------------
scheme@(guile-user)> ,use (srfi srfi-1)
scheme@(guile-user)> ,src any
(define (any pred ls . lists)
  (check-arg procedure? pred any)
  (if (null? lists)
    (any1 pred ls)
    (let lp ((lists (cons ls lists)))
      (cond ((any1 null? lists) #f)
            ((any1 null? (map cdr lists))
             (apply pred (map car lists)))
            (else
             (or (apply pred (map car lists))
                 (lp (map cdr lists))))))))
--------------------end-------------------------


C implemented proc will give a notion.
-------------------cut------------
scheme@(guile-user)> ,src read
"It's inner procedure implemented with C"
-------------------end------------------------


proc defined in REPL shows nothing.
-----------------cut-----------
scheme@(guile-user)> (define (func) 1)
scheme@(guile-user)> ,src func
-----------------end-----------

non-proc shows nothing.
--------------cut------------------
scheme@(guile-user)> (define a 1)
scheme@(guile-user)> ,src a
--------------end------------------


Happy hacking!


>From 454af1f4326d600d6044de903b12812dfd9310ad Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalagin...@gmail.com>
Date: Sat, 30 Mar 2013 21:48:35 +0800
Subject: [PATCH] Add src command in REPL to show Scheme code of loaded module

* system/repl/command.scm: Add inspection command "source (,src)"
  which shows Scheme code of loaded module.
---
 module/system/repl/command.scm |   36 +++++++++++++++++++++++++++++++++++-
 1 file changed, 35 insertions(+), 1 deletion(-)

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 8ad00da..bda6dfe 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -65,7 +65,7 @@
               (tracepoint tp)
               (traps) (delete del) (disable) (enable)
               (registers regs))
-    (inspect  (inspect i) (pretty-print pp))
+    (inspect  (inspect i) (pretty-print pp) (source src))
     (system   (gc) (statistics stat) (option o)
               (quit q continue cont))))
 
@@ -869,6 +869,40 @@ Pretty-print the result(s) of evaluating EXP."
          (pp x))
        args))))
 
+(define (get-src source)
+  (define any (@ (srfi srfi-1) any))
+  (define (skip-lines port n)
+    (cond
+     ((zero? n) port)
+     (else (read-line port) (skip-lines port (1- n)))))
+  
+  (let* ((file (source:file source))
+         (line (source:line source))
+         (fp (any (lambda (x) 
+                    (let ((f (string-append x "/" file))) 
+                      (if (file-exists? f) (open-input-file f) #f))) %load-path)))
+    (skip-lines fp line)
+    (let ((src (read fp)))
+      (close fp)
+      src)))
+
+(define (print-src p)
+  (define (get-program-src p)
+    (let ((source (program-source p 0)))
+      (cond
+       ((not source) "It's inner procedure implemented with C")
+       ((not (source:file source)) #f)
+       (else (get-src source)))))
+  (let ((src (and (program? p) (get-program-src p))))
+    (and src (pp src))))
+
+(define-meta-command (source repl (form))
+  "source PROC
+Pretty-print the source code of PROC"
+  (call-with-values (repl-prepare-eval-thunk repl (repl-parse repl form))
+    (lambda args
+      (for-each print-src args))))
+
 
 ;;;
 ;;; System commands
-- 
1.7.10.4