From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.devel Subject: [PATCH 4/6] move procedure-name and procedure-source to procprop.c Date: Mon, 27 May 2013 07:42:34 +0200 Message-ID: <1369633356-27699-5-git-send-email-wingo@pobox.com> References: <1369633356-27699-1-git-send-email-wingo@pobox.com> NNTP-Posting-Host: plane.gmane.org X-Trace: ger.gmane.org 1369633474 16197 80.91.229.3 (27 May 2013 05:44:34 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 27 May 2013 05:44:34 +0000 (UTC) Cc: Andy Wingo To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Mon May 27 07:44:34 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 1UgqET-00036V-Nx for guile-devel@m.gmane.org; Mon, 27 May 2013 07:44:33 +0200 Original-Received: from localhost ([::1]:33001 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UgqET-0000NO-D4 for guile-devel@m.gmane.org; Mon, 27 May 2013 01:44:33 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:42909) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UgqEH-0000HV-P0 for guile-devel@gnu.org; Mon, 27 May 2013 01:44:30 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UgqDw-0005v3-AF for guile-devel@gnu.org; Mon, 27 May 2013 01:44:21 -0400 Original-Received: from a-pb-sasl-quonix.pobox.com ([208.72.237.25]:47058 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UgqDw-0005uw-3v for guile-devel@gnu.org; Mon, 27 May 2013 01:44:00 -0400 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id ABB46CBD4; Mon, 27 May 2013 01:43:59 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to:cc :subject:date:message-id:in-reply-to:references; s=sasl; bh=uB6A OM3uJbttg8/rYpq7+FmbRrk=; b=fVSfpxFeZTbw/xlcTUgH8T/GaqQUPsDh8REn Lrvh9TuHuukHDU0b6EoTR553NWBzLexio6tc4jS7IXY7cXU3CYkc9R6sYshDK+7Y m4TdHhpzlIfT6v3h7mBs4xRJpuhHja0sbfQBlbJcKcd5VI9AnYgGWvLojDjWSx1e ZB1h3Gg= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:cc :subject:date:message-id:in-reply-to:references; q=dns; s=sasl; b= b1Fnm+QR5iR1n+GRv43q3+caXxK+JmDtKorFY4qhg9GNszMxtm+/Oaw/uvBoZfP7 BsYk6qZpcSnGeY05kE5T/oq1xQLKE0tx3AF5g7K7sypfqzW4SWtIDJfx/Kjhab3Y hD5fDRuli4VDr52faJfFTNPWG8ospL/BDgPvJQcWxKQ= Original-Received: from a-pb-sasl-quonix.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id 98CE5CBD3; Mon, 27 May 2013 01:43:59 -0400 (EDT) Original-Received: from localhost.localdomain (unknown [88.160.190.192]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTPSA id 0ADE7CBD2; Mon, 27 May 2013 01:43:54 -0400 (EDT) X-Mailer: git-send-email 1.7.10.4 In-Reply-To: <1369633356-27699-1-git-send-email-wingo@pobox.com> X-Pobox-Relay-ID: 6BEDAF70-C690-11E2-8812-9F710E5B5709-02397024!a-pb-sasl-quonix.pobox.com X-detected-operating-system: by eggs.gnu.org: Solaris 10 X-Received-From: 208.72.237.25 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:16447 Archived-At: * libguile/procprop.h: * libguile/procprop.c (scm_procedure_name, scm_procedure_source): Move these functions here, from debug.[ch]. --- libguile/debug.c | 41 +---------------------------------------- libguile/debug.h | 4 +--- libguile/procprop.c | 45 ++++++++++++++++++++++++++++++++++++++++++++- libguile/procprop.h | 4 +++- 4 files changed, 49 insertions(+), 45 deletions(-) diff --git a/libguile/debug.c b/libguile/debug.c index b01864f..9e63f2c 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -1,5 +1,5 @@ /* Debugging extensions for Guile - * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation + * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -115,45 +115,6 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0, } #undef FUNC_NAME - -SCM_SYMBOL (scm_sym_source, "source"); - -SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0, - (SCM proc), - "Return the name of the procedure @var{proc}") -#define FUNC_NAME s_scm_procedure_name -{ - SCM_VALIDATE_PROC (1, proc); - while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc)) - proc = SCM_STRUCT_PROCEDURE (proc); - return scm_procedure_property (proc, scm_sym_name); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, - (SCM proc), - "Return the source of the procedure @var{proc}.") -#define FUNC_NAME s_scm_procedure_source -{ - SCM src; - SCM_VALIDATE_PROC (1, proc); - - do - { - src = scm_procedure_property (proc, scm_sym_source); - if (scm_is_true (src)) - return src; - - if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc) - && SCM_HEAP_OBJECT_P ((proc = SCM_STRUCT_PROCEDURE (proc)))) - continue; - } - while (0); - - return SCM_BOOL_F; -} -#undef FUNC_NAME - diff --git a/libguile/debug.h b/libguile/debug.h index 362d9b7..e535a6a 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -3,7 +3,7 @@ #ifndef SCM_DEBUG_H #define SCM_DEBUG_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2011,2012 +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2011,2012,2013 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -44,8 +44,6 @@ typedef union scm_t_debug_info SCM_API SCM scm_local_eval (SCM exp, SCM env); SCM_API SCM scm_reverse_lookup (SCM env, SCM data); -SCM_API SCM scm_procedure_source (SCM proc); -SCM_API SCM scm_procedure_name (SCM proc); SCM_API SCM scm_debug_options (SCM setting); SCM_INTERNAL void scm_init_debug (void); diff --git a/libguile/procprop.c b/libguile/procprop.c index d37495b..472a1ca 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -212,8 +212,51 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, } #undef FUNC_NAME + +SCM_SYMBOL (scm_sym_source, "source"); + + +SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0, + (SCM proc), + "Return the name of the procedure @var{proc}") +#define FUNC_NAME s_scm_procedure_name +{ + SCM_VALIDATE_PROC (1, proc); + while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc)) + proc = SCM_STRUCT_PROCEDURE (proc); + return scm_procedure_property (proc, scm_sym_name); +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, + (SCM proc), + "Return the source of the procedure @var{proc}.") +#define FUNC_NAME s_scm_procedure_source +{ + SCM src; + SCM_VALIDATE_PROC (1, proc); + + do + { + src = scm_procedure_property (proc, scm_sym_source); + if (scm_is_true (src)) + return src; + + if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc) + && SCM_HEAP_OBJECT_P ((proc = SCM_STRUCT_PROCEDURE (proc)))) + continue; + } + while (0); + + return SCM_BOOL_F; +} +#undef FUNC_NAME + + + void scm_init_procprop () diff --git a/libguile/procprop.h b/libguile/procprop.h index 88e44ec..13fbe46 100644 --- a/libguile/procprop.h +++ b/libguile/procprop.h @@ -3,7 +3,7 @@ #ifndef SCM_PROCPROP_H #define SCM_PROCPROP_H -/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -40,6 +40,8 @@ SCM_API SCM scm_procedure_properties (SCM proc); SCM_API SCM scm_set_procedure_properties_x (SCM proc, SCM alist); SCM_API SCM scm_procedure_property (SCM proc, SCM key); SCM_API SCM scm_set_procedure_property_x (SCM proc, SCM key, SCM val); +SCM_API SCM scm_procedure_source (SCM proc); +SCM_API SCM scm_procedure_name (SCM proc); SCM_INTERNAL void scm_init_procprop (void); #endif /* SCM_PROCPROP_H */ -- 1.7.10.4