mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 03:30:27 +02:00
separate boot expansion from memoization
* libguile/Makefile.am: * libguile/init.c: * libguile/expand.c: * libguile/expand.h: Add new expander. The idea is that macroexpansion is one thing, and whether to compile or interpret the result of that is another thing. * libguile/memoize.c: Adapt to expand as necessary, and then memoize expanded source without worrying about syntax errors. * module/ice-9/eval.scm (make-general-closure): Allow alt clauses to not possess the full make-general-closure arity.
This commit is contained in:
Andy Wingo
parent
667361f6ce
commit
dc3e203e07
7 changed files with 1862 additions and 1102 deletions
|
|
@ -127,6 +127,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
|
|||
error.c \
|
||||
eval.c \
|
||||
evalext.c \
|
||||
expand.c \
|
||||
extensions.c \
|
||||
feature.c \
|
||||
fluids.c \
|
||||
|
|
@ -229,6 +230,7 @@ DOT_X_FILES = \
|
|||
error.x \
|
||||
eval.x \
|
||||
evalext.x \
|
||||
expand.x \
|
||||
extensions.x \
|
||||
feature.x \
|
||||
fluids.x \
|
||||
|
|
@ -328,6 +330,7 @@ DOT_DOC_FILES = \
|
|||
error.doc \
|
||||
eval.doc \
|
||||
evalext.doc \
|
||||
expand.doc \
|
||||
extensions.doc \
|
||||
feature.doc \
|
||||
fluids.doc \
|
||||
|
|
@ -487,6 +490,7 @@ modinclude_HEADERS = \
|
|||
error.h \
|
||||
eval.h \
|
||||
evalext.h \
|
||||
expand.h \
|
||||
extensions.h \
|
||||
feature.h \
|
||||
filesys.h \
|
||||
|
|
|
|||
|
|
@ -114,15 +114,26 @@ static scm_t_bits scm_tc16_boot_closure;
|
|||
#define BOOT_CLOSURE_IS_REST(x) scm_is_null (CDDDR (BOOT_CLOSURE_CODE (x)))
|
||||
/* NB: One may only call the following accessors if the closure is not REST. */
|
||||
#define BOOT_CLOSURE_IS_FULL(x) (1)
|
||||
#define BOOT_CLOSURE_PARSE_FULL(x,body,nargs,rest,nopt,kw,inits,alt) \
|
||||
do { SCM mx = BOOT_CLOSURE_CODE (x); \
|
||||
body = CAR (mx); mx = CDR (mx); \
|
||||
nreq = SCM_I_INUM (CAR (mx)); mx = CDR (mx); \
|
||||
rest = CAR (mx); mx = CDR (mx); \
|
||||
nopt = SCM_I_INUM (CAR (mx)); mx = CDR (mx); \
|
||||
kw = CAR (mx); mx = CDR (mx); \
|
||||
inits = CAR (mx); mx = CDR (mx); \
|
||||
alt = CAR (mx); \
|
||||
#define BOOT_CLOSURE_PARSE_FULL(fu_,body,nargs,rest,nopt,kw,inits,alt) \
|
||||
do { SCM fu = fu_; \
|
||||
body = CAR (fu); fu = CDR (fu); \
|
||||
\
|
||||
rest = kw = alt = SCM_BOOL_F; \
|
||||
inits = SCM_EOL; \
|
||||
nopt = 0; \
|
||||
\
|
||||
nreq = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
|
||||
if (scm_is_pair (fu)) \
|
||||
{ \
|
||||
rest = CAR (fu); fu = CDR (fu); \
|
||||
if (scm_is_pair (fu)) \
|
||||
{ \
|
||||
nopt = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
|
||||
kw = CAR (fu); fu = CDR (fu); \
|
||||
inits = CAR (fu); fu = CDR (fu); \
|
||||
alt = CAR (fu); \
|
||||
} \
|
||||
} \
|
||||
} while (0)
|
||||
static void prepare_boot_closure_env_for_apply (SCM proc, SCM args,
|
||||
SCM *out_body, SCM *out_env);
|
||||
|
|
@ -906,6 +917,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
|
|||
{
|
||||
int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc);
|
||||
SCM env = BOOT_CLOSURE_ENV (proc);
|
||||
|
||||
if (BOOT_CLOSURE_IS_FIXED (proc)
|
||||
|| (BOOT_CLOSURE_IS_REST (proc)
|
||||
&& !BOOT_CLOSURE_HAS_REST_ARGS (proc)))
|
||||
|
|
@ -931,16 +943,17 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
|
|||
{
|
||||
int i, argc, nreq, nopt;
|
||||
SCM body, rest, kw, inits, alt;
|
||||
SCM mx = BOOT_CLOSURE_CODE (proc);
|
||||
|
||||
loop:
|
||||
BOOT_CLOSURE_PARSE_FULL (proc, body, nargs, rest, nopt, kw, inits, alt);
|
||||
BOOT_CLOSURE_PARSE_FULL (mx, body, nargs, rest, nopt, kw, inits, alt);
|
||||
|
||||
argc = scm_ilength (args);
|
||||
if (argc < nreq)
|
||||
{
|
||||
if (scm_is_true (alt))
|
||||
{
|
||||
proc = alt;
|
||||
mx = alt;
|
||||
goto loop;
|
||||
}
|
||||
else
|
||||
|
|
@ -950,7 +963,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
|
|||
{
|
||||
if (scm_is_true (alt))
|
||||
{
|
||||
proc = alt;
|
||||
mx = alt;
|
||||
goto loop;
|
||||
}
|
||||
else
|
||||
|
|
@ -1048,7 +1061,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
|
|||
}
|
||||
}
|
||||
|
||||
*out_body = BOOT_CLOSURE_BODY (proc);
|
||||
*out_body = body;
|
||||
*out_env = env;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
1253
libguile/expand.c
Normal file
1253
libguile/expand.c
Normal file
File diff suppressed because it is too large
Load diff
346
libguile/expand.h
Normal file
346
libguile/expand.h
Normal file
|
|
@ -0,0 +1,346 @@
|
|||
/* classes: h_files */
|
||||
|
||||
#ifndef SCM_EXPAND_H
|
||||
#define SCM_EXPAND_H
|
||||
|
||||
/* Copyright (C) 2010
|
||||
* 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
|
||||
* the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
* 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
|
||||
#include "libguile/__scm.h"
|
||||
|
||||
|
||||
|
||||
|
||||
#ifdef BUILDING_LIBGUILE
|
||||
|
||||
/* All private for now. Ask if you want to use this. Surely this should be
|
||||
auto-generated by something; for now I wrangle it with keyboard macros. */
|
||||
|
||||
typedef enum
|
||||
{
|
||||
SCM_EXPANDED_VOID,
|
||||
SCM_EXPANDED_CONST,
|
||||
SCM_EXPANDED_PRIMITIVE_REF,
|
||||
SCM_EXPANDED_LEXICAL_REF,
|
||||
SCM_EXPANDED_LEXICAL_SET,
|
||||
SCM_EXPANDED_MODULE_REF,
|
||||
SCM_EXPANDED_MODULE_SET,
|
||||
SCM_EXPANDED_TOPLEVEL_REF,
|
||||
SCM_EXPANDED_TOPLEVEL_SET,
|
||||
SCM_EXPANDED_TOPLEVEL_DEFINE,
|
||||
SCM_EXPANDED_CONDITIONAL,
|
||||
SCM_EXPANDED_APPLICATION,
|
||||
SCM_EXPANDED_SEQUENCE,
|
||||
SCM_EXPANDED_LAMBDA,
|
||||
SCM_EXPANDED_LAMBDA_CASE,
|
||||
SCM_EXPANDED_LET,
|
||||
SCM_EXPANDED_LETREC,
|
||||
SCM_EXPANDED_DYNLET,
|
||||
SCM_NUM_EXPANDED_TYPES,
|
||||
} scm_t_expanded_type;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/* {Expanded Source}
|
||||
*/
|
||||
|
||||
SCM_INTERNAL SCM scm_exp_vtable_vtable;
|
||||
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_TYPE_NAME = scm_vtable_offset_user,
|
||||
SCM_EXPANDED_TYPE_CODE,
|
||||
SCM_EXPANDED_TYPE_FIELDS,
|
||||
};
|
||||
|
||||
#define SCM_EXPANDED_P(x) \
|
||||
(SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE (SCM_STRUCT_VTABLE (x)) == scm_exp_vtable_vtable))
|
||||
#define SCM_EXPANDED_REF(x,type,field) \
|
||||
(scm_struct_ref (x, SCM_I_MAKINUM (SCM_EXPANDED_##type##_##field)))
|
||||
#define SCM_EXPANDED_TYPE(x) \
|
||||
SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (x), SCM_EXPANDED_TYPE_CODE)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#define SCM_EXPANDED_VOID_TYPE_NAME "void"
|
||||
#define SCM_EXPANDED_VOID_FIELD_NAMES \
|
||||
{ "src" }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_VOID_SRC,
|
||||
SCM_NUM_EXPANDED_VOID_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_VOID(src) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_VOID], 0, SCM_NUM_EXPANDED_VOID_FIELDS, SCM_UNPACK (src))
|
||||
|
||||
#define SCM_EXPANDED_CONST_TYPE_NAME "const"
|
||||
#define SCM_EXPANDED_CONST_FIELD_NAMES \
|
||||
{ "src", "exp", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_CONST_SRC,
|
||||
SCM_EXPANDED_CONST_EXP,
|
||||
SCM_NUM_EXPANDED_CONST_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_CONST(src, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_CONST], 0, SCM_NUM_EXPANDED_CONST_FIELDS, SCM_UNPACK (src), SCM_UNPACK (exp))
|
||||
|
||||
#define SCM_EXPANDED_PRIMITIVE_REF_TYPE_NAME "primitive-ref"
|
||||
#define SCM_EXPANDED_PRIMITIVE_REF_FIELD_NAMES \
|
||||
{ "src", "name", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_PRIMITIVE_REF_SRC,
|
||||
SCM_EXPANDED_PRIMITIVE_REF_NAME,
|
||||
SCM_NUM_EXPANDED_PRIMITIVE_REF_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_PRIMITIVE_REF(src, name) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_PRIMITIVE_REF], 0, SCM_NUM_EXPANDED_PRIMITIVE_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name))
|
||||
|
||||
#define SCM_EXPANDED_LEXICAL_REF_TYPE_NAME "lexical-ref"
|
||||
#define SCM_EXPANDED_LEXICAL_REF_FIELD_NAMES \
|
||||
{ "src", "name", "gensym", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_LEXICAL_REF_SRC,
|
||||
SCM_EXPANDED_LEXICAL_REF_NAME,
|
||||
SCM_EXPANDED_LEXICAL_REF_GENSYM,
|
||||
SCM_NUM_EXPANDED_LEXICAL_REF_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_LEXICAL_REF(src, name, gensym) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_LEXICAL_REF], 0, SCM_NUM_EXPANDED_LEXICAL_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (gensym))
|
||||
|
||||
#define SCM_EXPANDED_LEXICAL_SET_TYPE_NAME "lexical-set"
|
||||
#define SCM_EXPANDED_LEXICAL_SET_FIELD_NAMES \
|
||||
{ "src", "name", "gensym", "exp", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_LEXICAL_SET_SRC,
|
||||
SCM_EXPANDED_LEXICAL_SET_NAME,
|
||||
SCM_EXPANDED_LEXICAL_SET_GENSYM,
|
||||
SCM_EXPANDED_LEXICAL_SET_EXP,
|
||||
SCM_NUM_EXPANDED_LEXICAL_SET_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_LEXICAL_SET(src, name, gensym, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_LEXICAL_SET], 0, SCM_NUM_EXPANDED_LEXICAL_SET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (gensym), SCM_UNPACK (exp))
|
||||
|
||||
#define SCM_EXPANDED_MODULE_REF_TYPE_NAME "module-ref"
|
||||
#define SCM_EXPANDED_MODULE_REF_FIELD_NAMES \
|
||||
{ "src", "mod", "name", "public", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_MODULE_REF_SRC,
|
||||
SCM_EXPANDED_MODULE_REF_MOD,
|
||||
SCM_EXPANDED_MODULE_REF_NAME,
|
||||
SCM_EXPANDED_MODULE_REF_PUBLIC,
|
||||
SCM_NUM_EXPANDED_MODULE_REF_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_MODULE_REF(src, mod, name, public) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_MODULE_REF], 0, SCM_NUM_EXPANDED_MODULE_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (mod), SCM_UNPACK (name), SCM_UNPACK (public))
|
||||
|
||||
#define SCM_EXPANDED_MODULE_SET_TYPE_NAME "module-set"
|
||||
#define SCM_EXPANDED_MODULE_SET_FIELD_NAMES \
|
||||
{ "src", "mod", "name", "public", "exp", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_MODULE_SET_SRC,
|
||||
SCM_EXPANDED_MODULE_SET_MOD,
|
||||
SCM_EXPANDED_MODULE_SET_NAME,
|
||||
SCM_EXPANDED_MODULE_SET_PUBLIC,
|
||||
SCM_EXPANDED_MODULE_SET_EXP,
|
||||
SCM_NUM_EXPANDED_MODULE_SET_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_MODULE_SET(src, mod, name, public, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_MODULE_SET], 0, SCM_NUM_EXPANDED_MODULE_SET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (mod), SCM_UNPACK (name), SCM_UNPACK (public), SCM_UNPACK (exp))
|
||||
|
||||
#define SCM_EXPANDED_TOPLEVEL_REF_TYPE_NAME "toplevel-ref"
|
||||
#define SCM_EXPANDED_TOPLEVEL_REF_FIELD_NAMES \
|
||||
{ "src", "name", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_TOPLEVEL_REF_SRC,
|
||||
SCM_EXPANDED_TOPLEVEL_REF_NAME,
|
||||
SCM_NUM_EXPANDED_TOPLEVEL_REF_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_REF(src, name) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_REF], 0, SCM_NUM_EXPANDED_TOPLEVEL_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name))
|
||||
|
||||
#define SCM_EXPANDED_TOPLEVEL_SET_TYPE_NAME "toplevel-set"
|
||||
#define SCM_EXPANDED_TOPLEVEL_SET_FIELD_NAMES \
|
||||
{ "src", "name", "exp", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_TOPLEVEL_SET_SRC,
|
||||
SCM_EXPANDED_TOPLEVEL_SET_NAME,
|
||||
SCM_EXPANDED_TOPLEVEL_SET_EXP,
|
||||
SCM_NUM_EXPANDED_TOPLEVEL_SET_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_SET(src, name, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_SET], 0, SCM_NUM_EXPANDED_TOPLEVEL_SET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (exp))
|
||||
|
||||
#define SCM_EXPANDED_TOPLEVEL_DEFINE_TYPE_NAME "toplevel-define"
|
||||
#define SCM_EXPANDED_TOPLEVEL_DEFINE_FIELD_NAMES \
|
||||
{ "src", "name", "exp", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_TOPLEVEL_DEFINE_SRC,
|
||||
SCM_EXPANDED_TOPLEVEL_DEFINE_NAME,
|
||||
SCM_EXPANDED_TOPLEVEL_DEFINE_EXP,
|
||||
SCM_NUM_EXPANDED_TOPLEVEL_DEFINE_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, name, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_DEFINE], 0, SCM_NUM_EXPANDED_TOPLEVEL_DEFINE_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (exp))
|
||||
|
||||
#define SCM_EXPANDED_CONDITIONAL_TYPE_NAME "conditional"
|
||||
#define SCM_EXPANDED_CONDITIONAL_FIELD_NAMES \
|
||||
{ "src", "test", "consequent", "alternate", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_CONDITIONAL_SRC,
|
||||
SCM_EXPANDED_CONDITIONAL_TEST,
|
||||
SCM_EXPANDED_CONDITIONAL_CONSEQUENT,
|
||||
SCM_EXPANDED_CONDITIONAL_ALTERNATE,
|
||||
SCM_NUM_EXPANDED_CONDITIONAL_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_CONDITIONAL], 0, SCM_NUM_EXPANDED_CONDITIONAL_FIELDS, SCM_UNPACK (src), SCM_UNPACK (test), SCM_UNPACK (consequent), SCM_UNPACK (alternate))
|
||||
|
||||
#define SCM_EXPANDED_APPLICATION_TYPE_NAME "application"
|
||||
#define SCM_EXPANDED_APPLICATION_FIELD_NAMES \
|
||||
{ "src", "proc", "exps", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_APPLICATION_SRC,
|
||||
SCM_EXPANDED_APPLICATION_PROC,
|
||||
SCM_EXPANDED_APPLICATION_EXPS,
|
||||
SCM_NUM_EXPANDED_APPLICATION_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_APPLICATION(src, proc, exps) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_APPLICATION], 0, SCM_NUM_EXPANDED_APPLICATION_FIELDS, SCM_UNPACK (src), SCM_UNPACK (proc), SCM_UNPACK (exps))
|
||||
|
||||
#define SCM_EXPANDED_SEQUENCE_TYPE_NAME "sequence"
|
||||
#define SCM_EXPANDED_SEQUENCE_FIELD_NAMES \
|
||||
{ "src", "exps", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_SEQUENCE_SRC,
|
||||
SCM_EXPANDED_SEQUENCE_EXPS,
|
||||
SCM_NUM_EXPANDED_SEQUENCE_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_SEQUENCE(src, exps) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_SEQUENCE], 0, SCM_NUM_EXPANDED_SEQUENCE_FIELDS, SCM_UNPACK (src), SCM_UNPACK (exps))
|
||||
|
||||
#define SCM_EXPANDED_LAMBDA_TYPE_NAME "lambda"
|
||||
#define SCM_EXPANDED_LAMBDA_FIELD_NAMES \
|
||||
{ "src", "meta", "body", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_LAMBDA_SRC,
|
||||
SCM_EXPANDED_LAMBDA_META,
|
||||
SCM_EXPANDED_LAMBDA_BODY,
|
||||
SCM_NUM_EXPANDED_LAMBDA_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_LAMBDA(src, meta, body) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_LAMBDA], 0, SCM_NUM_EXPANDED_LAMBDA_FIELDS, SCM_UNPACK (src), SCM_UNPACK (meta), SCM_UNPACK (body))
|
||||
|
||||
#define SCM_EXPANDED_LAMBDA_CASE_TYPE_NAME "lambda-case"
|
||||
#define SCM_EXPANDED_LAMBDA_CASE_FIELD_NAMES \
|
||||
{ "src", "req", "opt", "rest", "kw", "inits", "gensyms", "body", "alternate", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_LAMBDA_CASE_SRC,
|
||||
SCM_EXPANDED_LAMBDA_CASE_REQ,
|
||||
SCM_EXPANDED_LAMBDA_CASE_OPT,
|
||||
SCM_EXPANDED_LAMBDA_CASE_REST,
|
||||
SCM_EXPANDED_LAMBDA_CASE_KW,
|
||||
SCM_EXPANDED_LAMBDA_CASE_INITS,
|
||||
SCM_EXPANDED_LAMBDA_CASE_GENSYMS,
|
||||
SCM_EXPANDED_LAMBDA_CASE_BODY,
|
||||
SCM_EXPANDED_LAMBDA_CASE_ALTERNATE,
|
||||
SCM_NUM_EXPANDED_LAMBDA_CASE_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_LAMBDA_CASE(src, req, opt, rest, kw, inits, gensyms, body, alternate) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_LAMBDA_CASE], 0, SCM_NUM_EXPANDED_LAMBDA_CASE_FIELDS, SCM_UNPACK (src), SCM_UNPACK (req), SCM_UNPACK (opt), SCM_UNPACK (rest), SCM_UNPACK (kw), SCM_UNPACK (inits), SCM_UNPACK (gensyms), SCM_UNPACK (body), SCM_UNPACK (alternate))
|
||||
|
||||
#define SCM_EXPANDED_LET_TYPE_NAME "let"
|
||||
#define SCM_EXPANDED_LET_FIELD_NAMES \
|
||||
{ "src", "names", "gensyms", "vals", "body", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_LET_SRC,
|
||||
SCM_EXPANDED_LET_NAMES,
|
||||
SCM_EXPANDED_LET_GENSYMS,
|
||||
SCM_EXPANDED_LET_VALS,
|
||||
SCM_EXPANDED_LET_BODY,
|
||||
SCM_NUM_EXPANDED_LET_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_LET(src, names, gensyms, vals, body) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_LET], 0, SCM_NUM_EXPANDED_LET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (names), SCM_UNPACK (gensyms), SCM_UNPACK (vals), SCM_UNPACK (body))
|
||||
|
||||
#define SCM_EXPANDED_LETREC_TYPE_NAME "letrec"
|
||||
#define SCM_EXPANDED_LETREC_FIELD_NAMES \
|
||||
{ "src", "names", "gensyms", "vals", "body", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_LETREC_SRC,
|
||||
SCM_EXPANDED_LETREC_NAMES,
|
||||
SCM_EXPANDED_LETREC_GENSYMS,
|
||||
SCM_EXPANDED_LETREC_VALS,
|
||||
SCM_EXPANDED_LETREC_BODY,
|
||||
SCM_NUM_EXPANDED_LETREC_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_LETREC(src, names, gensyms, vals, body) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_LETREC], 0, SCM_NUM_EXPANDED_LETREC_FIELDS, SCM_UNPACK (src), SCM_UNPACK (names), SCM_UNPACK (gensyms), SCM_UNPACK (vals), SCM_UNPACK (body))
|
||||
|
||||
#define SCM_EXPANDED_DYNLET_TYPE_NAME "dynlet"
|
||||
#define SCM_EXPANDED_DYNLET_FIELD_NAMES \
|
||||
{ "src", "fluids", "vals", "body", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_DYNLET_SRC,
|
||||
SCM_EXPANDED_DYNLET_FLUIDS,
|
||||
SCM_EXPANDED_DYNLET_VALS,
|
||||
SCM_EXPANDED_DYNLET_BODY,
|
||||
SCM_NUM_EXPANDED_DYNLET_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_DYNLET(src, fluids, vals, body) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_DYNLET], 0, SCM_NUM_EXPANDED_DYNLET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (fluids), SCM_UNPACK (vals), SCM_UNPACK (body))
|
||||
|
||||
#endif /* BUILDING_LIBGUILE */
|
||||
|
||||
|
||||
|
||||
SCM_INTERNAL SCM scm_macroexpand (SCM exp);
|
||||
|
||||
SCM_INTERNAL void scm_init_expand (void);
|
||||
|
||||
|
||||
#endif /* SCM_EXPAND_H */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -54,6 +54,7 @@
|
|||
#include "libguile/error.h"
|
||||
#include "libguile/eval.h"
|
||||
#include "libguile/evalext.h"
|
||||
#include "libguile/expand.h"
|
||||
#include "libguile/feature.h"
|
||||
#include "libguile/filesys.h"
|
||||
#include "libguile/fluids.h"
|
||||
|
|
@ -546,6 +547,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
|
|||
scm_init_guardians (); /* requires smob_prehistory */
|
||||
scm_init_vports ();
|
||||
scm_init_standard_ports (); /* Requires fports */
|
||||
scm_init_expand (); /* Requires structs */
|
||||
scm_init_memoize (); /* Requires smob_prehistory */
|
||||
scm_init_eval (); /* Requires smob_prehistory */
|
||||
scm_init_load_path ();
|
||||
|
|
|
|||
1310
libguile/memoize.c
1310
libguile/memoize.c
File diff suppressed because it is too large
Load diff
|
|
@ -223,7 +223,15 @@
|
|||
(define (make-general-closure env body nreq rest? nopt kw inits alt)
|
||||
(define alt-proc
|
||||
(and alt
|
||||
(apply make-general-closure env (memoized-expression-data alt))))
|
||||
(let* ((body (car alt))
|
||||
(nreq (cadr alt))
|
||||
(rest (if (null? (cddr alt)) #f (caddr alt)))
|
||||
(tail (and (pair? (cddr alt)) (pair? (cdddr alt)) (cdddr alt)))
|
||||
(nopt (if tail (car tail) 0))
|
||||
(kw (and tail (cadr tail)))
|
||||
(inits (if tail (caddr tail) '()))
|
||||
(alt (and tail (cadddr tail))))
|
||||
(make-general-closure env body nreq rest nopt kw inits alt))))
|
||||
(lambda %args
|
||||
(let lp ((env env)
|
||||
(nreq* nreq)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue