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

eval: Store docstrings for lambdas.

Browse source 
Fixes <http://bugs.gnu.org/12173>.
Reported by Ian Price <ianprice90@googlemail.com>.

* libguile/memoize.c (MAKMEMO_LAMBDA): New `docstring' parameter.  Add
  it as the second argument of `SCM_M_LAMBDA'.  Update caller.
  (memoize)[SCM_M_LAMBDA]: Extract docstring from EXP; when `memoize'
  returns, add the docstring to the lambda's arguments.
  (unmemoize)[SCM_M_LAMBDA]: Adjust to new argument layout of
  `SCM_M_LAMBDA'.
* libguile/eval.c (BOOT_CLOSURE_NUM_REQUIRED_ARGS,
  BOOT_CLOSURE_HAS_REST_ARGS, BOOT_CLOSURE_IS_REST,
  BOOT_CLOSURE_PARSE_FULL): Adjust to new argument layout of
  `SCM_M_LAMBDA'.
* module/ice-9/eval.scm (primitive-eval)[make-general-closure]:
  Likewise.
  [eval]: When EXP is a lambda, match its docstring; when the docstring
  is not #f, add it to the closures procedure properties.
* test-suite/tests/eval.test ("docstrings"): New test prefix.

* libguile/procs.c (sym_documentation): Rename to...
  (scm_sym_documentation): ... this.  Make it global.
* libguile/procs.h (scm_sym_documentation): New declaration.
This commit is contained in:
Ludovic Courtès 2012-11-28 16:42:49 +01:00
parent fc32c44995
commit c438cd7175
6 changed files with 130 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

101
libguile/memoize.c
View file

@ -1,6 +1,7 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
* Free Software Foundation, Inc.
*
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
* 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
* 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
* as published by the Free Software Foundation; either version 3 of
@ -78,8 +79,9 @@ scm_t_bits scm_tc16_memoized;
#define FULL_ARITY(nreq, rest, nopt, kw, inits, alt) \
scm_list_n (SCM_I_MAKINUM (nreq), rest, SCM_I_MAKINUM (nopt), kw, inits, \
alt, SCM_UNDEFINED)
#define MAKMEMO_LAMBDA(body, arity) \
MAKMEMO (SCM_M_LAMBDA, (scm_cons (body, arity)))
#define MAKMEMO_LAMBDA(body, arity, docstring) \
MAKMEMO (SCM_M_LAMBDA, \
scm_cons (body, scm_cons (docstring, arity)))
#define MAKMEMO_LET(inits, body) \
MAKMEMO (SCM_M_LET, scm_cons (inits, body))
#define MAKMEMO_QUOTE(exp) \
@ -268,7 +270,21 @@ memoize (SCM exp, SCM env)
case SCM_EXPANDED_LAMBDA:
/* The body will be a lambda-case. */
return memoize (REF (exp, LAMBDA, BODY), env);
{
SCM meta, docstring, proc;
meta = REF (exp, LAMBDA, META);
docstring = scm_assoc_ref (meta, scm_sym_documentation);
proc = memoize (REF (exp, LAMBDA, BODY), env);
if (scm_is_string (docstring))
{
SCM args = SCM_MEMOIZED_ARGS (proc);
SCM_SETCAR (SCM_CDR (args), docstring);
}
return proc;
}
case SCM_EXPANDED_LAMBDA_CASE:
{
@ -350,7 +366,8 @@ memoize (SCM exp, SCM env)
else
arity = FULL_ARITY (nreq, rest, nopt, kw, minits, SCM_BOOL_F);
return MAKMEMO_LAMBDA (memoize (body, new_env), arity);
return MAKMEMO_LAMBDA (memoize (body, new_env), arity,
SCM_BOOL_F /* docstring */);
}
case SCM_EXPANDED_LET:
@ -640,39 +657,43 @@ unmemoize (const SCM expr)
return scm_list_4 (scm_sym_if, unmemoize (scm_car (args)),
unmemoize (scm_cadr (args)), unmemoize (scm_cddr (args)));
case SCM_M_LAMBDA:
if (scm_is_null (CDDR (args)))
return scm_list_3 (scm_sym_lambda,
scm_make_list (CADR (args), sym_placeholder),
unmemoize (CAR (args)));
else if (scm_is_null (CDDDR (args)))
{
SCM formals = scm_make_list (CADR (args), sym_placeholder);
return scm_list_3 (scm_sym_lambda,
scm_is_true (CADDR (args))
? scm_cons_star (sym_placeholder, formals)
: formals,
unmemoize (CAR (args)));
}
else
{
SCM body = CAR (args), spec = CDR (args), alt, tail;
alt = CADDR (CDDDR (spec));
if (scm_is_true (alt))
tail = CDR (unmemoize (alt));
else
tail = SCM_EOL;
return scm_cons
(sym_case_lambda_star,
scm_cons (scm_list_2 (scm_list_5 (CAR (spec),
CADR (spec),
CADDR (spec),
CADDDR (spec),
unmemoize_exprs (CADR (CDDDR (spec)))),
unmemoize (body)),
tail));
}
{
SCM body = CAR (args), spec = CDDR (args);
if (scm_is_null (CDR (spec)))
return scm_list_3 (scm_sym_lambda,
scm_make_list (CAR (spec), sym_placeholder),
unmemoize (CAR (args)));
else if (scm_is_null (SCM_CDDR (spec)))
{
SCM formals = scm_make_list (CAR (spec), sym_placeholder);
return scm_list_3 (scm_sym_lambda,
scm_is_true (CADR (spec))
? scm_cons_star (sym_placeholder, formals)
: formals,
unmemoize (CAR (args)));
}
else
{
SCM alt, tail;
alt = CADDR (CDDDR (spec));
if (scm_is_true (alt))
tail = CDR (unmemoize (alt));
else
tail = SCM_EOL;
return scm_cons
(sym_case_lambda_star,
scm_cons (scm_list_2 (scm_list_5 (CAR (spec),
CADR (spec),
CADDR (spec),
CADDDR (spec),
unmemoize_exprs (CADR (CDDDR (spec)))),
unmemoize (body)),
tail));
}
}
case SCM_M_LET:
return scm_list_3 (scm_sym_let,
unmemoize_bindings (CAR (args)),