mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
remove program-name, program-documentation
* libguile/programs.h: * libguile/programs.c (scm_program_name): Remove. procedure-name is sufficient. * module/system/vm/program.scm (program-name): Remove from exports list. (program-documentation): Remove; procedure-documentation is sufficient. * libguile/debug.c (scm_procedure_name): Remove special case for programs. * module/language/tree-il/analyze.scm (validate-arity): Use procedure-name. * module/ice-9/documentation.scm (object-documentation): Just use procedure-documentation, without special cases for programs.
This commit is contained in:
parent
07e424b753
commit
1e23b461ec
6 changed files with 5 additions and 33 deletions
|
@ -137,15 +137,10 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
|
||||||
"Return the name of the procedure @var{proc}")
|
"Return the name of the procedure @var{proc}")
|
||||||
#define FUNC_NAME s_scm_procedure_name
|
#define FUNC_NAME s_scm_procedure_name
|
||||||
{
|
{
|
||||||
SCM name;
|
|
||||||
|
|
||||||
SCM_VALIDATE_PROC (1, proc);
|
SCM_VALIDATE_PROC (1, proc);
|
||||||
while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
|
while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
|
||||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
proc = SCM_STRUCT_PROCEDURE (proc);
|
||||||
name = scm_procedure_property (proc, scm_sym_name);
|
return scm_procedure_property (proc, scm_sym_name);
|
||||||
if (scm_is_false (name) && SCM_PROGRAM_P (proc))
|
|
||||||
name = scm_program_name (proc);
|
|
||||||
return name;
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -260,16 +260,6 @@ scm_i_program_properties (SCM program)
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
SCM_DEFINE (scm_program_name, "program-name", 1, 0, 0,
|
|
||||||
(SCM program),
|
|
||||||
"")
|
|
||||||
#define FUNC_NAME s_scm_program_name
|
|
||||||
{
|
|
||||||
SCM_VALIDATE_PROGRAM (1, program);
|
|
||||||
return scm_assq_ref (scm_i_program_properties (program), scm_sym_name);
|
|
||||||
}
|
|
||||||
#undef FUNC_NAME
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_program_source, "program-source", 2, 0, 0,
|
SCM_DEFINE (scm_program_source, "program-source", 2, 0, 0,
|
||||||
(SCM program, SCM ip),
|
(SCM program, SCM ip),
|
||||||
"")
|
"")
|
||||||
|
|
|
@ -56,7 +56,6 @@ SCM_API SCM scm_program_bindings (SCM program);
|
||||||
SCM_API SCM scm_program_sources (SCM program);
|
SCM_API SCM scm_program_sources (SCM program);
|
||||||
SCM_API SCM scm_program_source (SCM program, SCM ip);
|
SCM_API SCM scm_program_source (SCM program, SCM ip);
|
||||||
SCM_API SCM scm_program_arities (SCM program);
|
SCM_API SCM scm_program_arities (SCM program);
|
||||||
SCM_API SCM scm_program_name (SCM program);
|
|
||||||
SCM_API SCM scm_program_objects (SCM program);
|
SCM_API SCM scm_program_objects (SCM program);
|
||||||
SCM_API SCM scm_program_module (SCM program);
|
SCM_API SCM scm_program_module (SCM program);
|
||||||
SCM_API SCM scm_program_num_free_variables (SCM program);
|
SCM_API SCM scm_program_num_free_variables (SCM program);
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
;;;; Copyright (C) 2000,2001, 2002, 2003, 2006, 2009 Free Software Foundation, Inc.
|
;;;; Copyright (C) 2000,2001, 2002, 2003, 2006, 2009, 2010 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
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -80,7 +80,6 @@
|
||||||
|
|
||||||
(define-module (ice-9 documentation)
|
(define-module (ice-9 documentation)
|
||||||
:use-module (ice-9 rdelim)
|
:use-module (ice-9 rdelim)
|
||||||
:use-module ((system vm program) :select (program? program-documentation))
|
|
||||||
:export (file-commentary
|
:export (file-commentary
|
||||||
documentation-files search-documentation-files
|
documentation-files search-documentation-files
|
||||||
object-documentation)
|
object-documentation)
|
||||||
|
@ -184,20 +183,13 @@
|
||||||
(cond ((null? files) documentation-files)
|
(cond ((null? files) documentation-files)
|
||||||
(else files))))
|
(else files))))
|
||||||
|
|
||||||
;; helper until the procedure documentation property is cleaned up
|
|
||||||
(define (proc-doc proc)
|
|
||||||
(or (procedure-documentation proc)
|
|
||||||
(procedure-property proc 'documentation)))
|
|
||||||
|
|
||||||
(define (object-documentation object)
|
(define (object-documentation object)
|
||||||
"Return the docstring for OBJECT.
|
"Return the docstring for OBJECT.
|
||||||
OBJECT can be a procedure, macro or any object that has its
|
OBJECT can be a procedure, macro or any object that has its
|
||||||
`documentation' property set."
|
`documentation' property set."
|
||||||
(or (and (procedure? object)
|
(or (and (procedure? object)
|
||||||
(proc-doc object))
|
(procedure-documentation object))
|
||||||
(object-property object 'documentation)
|
(object-property object 'documentation)
|
||||||
(and (program? object)
|
|
||||||
(program-documentation object))
|
|
||||||
(and (macro? object)
|
(and (macro? object)
|
||||||
(object-documentation (macro-transformer object)))
|
(object-documentation (macro-transformer object)))
|
||||||
(and (procedure? object)
|
(and (procedure? object)
|
||||||
|
|
|
@ -996,7 +996,7 @@ accurate information is missing from a given `tree-il' element."
|
||||||
(length x))
|
(length x))
|
||||||
0))
|
0))
|
||||||
(cond ((program? proc)
|
(cond ((program? proc)
|
||||||
(values (program-name proc)
|
(values (procedure-name proc)
|
||||||
(map (lambda (a)
|
(map (lambda (a)
|
||||||
(list (arity:nreq a) (arity:nopt a) (arity:rest? a)
|
(list (arity:nreq a) (arity:nopt a) (arity:rest? a)
|
||||||
(map car (arity:kw a))
|
(map car (arity:kw a))
|
||||||
|
|
|
@ -28,7 +28,6 @@
|
||||||
|
|
||||||
source:addr source:line source:column source:file
|
source:addr source:line source:column source:file
|
||||||
program-sources program-source
|
program-sources program-source
|
||||||
program-documentation program-name
|
|
||||||
|
|
||||||
program-bindings program-bindings-by-index program-bindings-for-ip
|
program-bindings program-bindings-by-index program-bindings-for-ip
|
||||||
program-arities program-arity arity:start arity:end
|
program-arities program-arity arity:start arity:end
|
||||||
|
@ -63,9 +62,6 @@
|
||||||
(define (source:column source)
|
(define (source:column source)
|
||||||
(cdddr source))
|
(cdddr source))
|
||||||
|
|
||||||
(define (program-documentation prog)
|
|
||||||
(procedure-property prog 'documentation))
|
|
||||||
|
|
||||||
(define (collapse-locals locs)
|
(define (collapse-locals locs)
|
||||||
(let lp ((ret '()) (locs locs))
|
(let lp ((ret '()) (locs locs))
|
||||||
(if (null? locs)
|
(if (null? locs)
|
||||||
|
@ -196,7 +192,7 @@
|
||||||
|
|
||||||
(define (write-program prog port)
|
(define (write-program prog port)
|
||||||
(format port "#<procedure ~a~a>"
|
(format port "#<procedure ~a~a>"
|
||||||
(or (program-name prog)
|
(or (procedure-name prog)
|
||||||
(and=> (program-source prog 0)
|
(and=> (program-source prog 0)
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
(format #f "~a at ~a:~a:~a"
|
(format #f "~a at ~a:~a:~a"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue