mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

move procedure-name and procedure-source to procprop.c

Browse source 
* libguile/procprop.h:
* libguile/procprop.c (scm_procedure_name, scm_procedure_source): Move
  these functions here, from debug.[ch].
This commit is contained in:
Andy Wingo 2013-05-05 17:52:59 +02:00
parent cb86cbd71d
commit e2cbf527c4
4 changed files with 49 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

41
libguile/debug.c
View file

@ -1,5 +1,5 @@
/* Debugging extensions for Guile /* 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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 #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

4
libguile/debug.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_DEBUG_H #ifndef SCM_DEBUG_H
#define 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. * Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * 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_local_eval (SCM exp, SCM env);
SCM_API SCM scm_reverse_lookup (SCM env, SCM data); 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_API SCM scm_debug_options (SCM setting);
SCM_INTERNAL void scm_init_debug (void); SCM_INTERNAL void scm_init_debug (void);

45
libguile/procprop.c
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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 #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 void
scm_init_procprop () scm_init_procprop ()

4
libguile/procprop.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PROCPROP_H #ifndef SCM_PROCPROP_H
#define 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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_set_procedure_properties_x (SCM proc, SCM alist);
SCM_API SCM scm_procedure_property (SCM proc, SCM key); 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_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); SCM_INTERNAL void scm_init_procprop (void);
#endif /* SCM_PROCPROP_H */ #endif /* SCM_PROCPROP_H */