From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Nala Ginrut Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Add inspection command "source (,src)" which shows Scheme code of loaded module Date: Sat, 30 Mar 2013 21:57:40 +0800 Organization: HFG Message-ID: <1364651860.2730.71.camel@Renee-desktop.suse> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-prdi8AR423Vo+sWp6kxI" X-Trace: ger.gmane.org 1364651878 2089 80.91.229.3 (30 Mar 2013 13:57:58 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 30 Mar 2013 13:57:58 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Mar 30 14:58:23 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1ULwIT-0005oQ-CL for guile-devel@m.gmane.org; Sat, 30 Mar 2013 14:58:17 +0100 Original-Received: from localhost ([::1]:46016 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ULwI5-00036h-50 for guile-devel@m.gmane.org; Sat, 30 Mar 2013 09:57:53 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:34823) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ULwHy-00035l-Va for guile-devel@gnu.org; Sat, 30 Mar 2013 09:57:49 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ULwHx-0005pN-B1 for guile-devel@gnu.org; Sat, 30 Mar 2013 09:57:46 -0400 Original-Received: from mail-pa0-f46.google.com ([209.85.220.46]:55206) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ULwHx-0005oi-4E for guile-devel@gnu.org; Sat, 30 Mar 2013 09:57:45 -0400 Original-Received: by mail-pa0-f46.google.com with SMTP id rl6so712744pac.19 for ; Sat, 30 Mar 2013 06:57:44 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=x-received:message-id:subject:from:to:date:organization :content-type:x-mailer:mime-version; bh=Xy+5yqTnuzBz4Pdqyf0xt1qEZtdaCtYaNsUyD7xpiio=; b=aDG/OsJc4Sq6/+9Et92OzR6ue/jsTHuWEaML6fpCqBZKhU9ASMsicpmdlHTZl8BtLf iUFQwdDOkIOVA6k1P3SFmC71LIK07f3wqoO313GHP06Y98CtDC8z3ApHPv9FnEZv1hse 0fsd+rA10ADsLfiO+TbetIZJSst/ZKUhUnodQu/q8bkLgCiMpSjF/tm5MNWr3FUlmTUO AnF0rnu3RTEMfB3h7BNMPhtRY1cW3NtJGBgmXFOm879rkI0ILztXb/gkB4OvIAVqZfAH qnSzNmfoo//fH0yYiYZt54DdKptXCHsGYvFFGhlcRc1cYGSHDNvEvlZSrtuZucb1FIE9 zH+A== X-Received: by 10.66.52.76 with SMTP id r12mr9669027pao.217.1364651864083; Sat, 30 Mar 2013 06:57:44 -0700 (PDT) Original-Received: from [192.168.100.102] ([183.13.168.11]) by mx.google.com with ESMTPS id qb10sm6635655pbb.43.2013.03.30.06.57.42 (version=SSLv3 cipher=RC4-SHA bits=128/128); Sat, 30 Mar 2013 06:57:43 -0700 (PDT) X-Mailer: Evolution 3.4.4 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-Received-From: 209.85.220.46 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:16060 Archived-At: --=-prdi8AR423Vo+sWp6kxI Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: 7bit 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! --=-prdi8AR423Vo+sWp6kxI Content-Disposition: attachment; filename*0=0001-Add-src-command-in-REPL-to-show-Scheme-code-of-loade.pat; filename*1=ch Content-Type: text/x-patch; name="0001-Add-src-command-in-REPL-to-show-Scheme-code-of-loade.patch"; charset="UTF-8" Content-Transfer-Encoding: 7bit >From 454af1f4326d600d6044de903b12812dfd9310ad Mon Sep 17 00:00:00 2001 From: Nala Ginrut 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 --=-prdi8AR423Vo+sWp6kxI--