mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-21 19:20:21 +02:00
sequence of expressions -> seq of head and tail
* libguile/expand.h: * module/language/tree-il.scm: Rename "sequence" to "seq", and instead of taking a list of expressions, take a head and a tail. * module/language/tree-il/analyze.scm: * module/language/tree-il/compile-glil.scm: * module/language/tree-il/fix-letrec.scm: * module/language/tree-il/spec.scm: * module/language/elisp/compile-tree-il.scm: * module/ice-9/psyntax.scm: * module/ice-9/psyntax-pp.scm: * module/ice-9/eval.scm: * libguile/memoize.h: * libguile/memoize.c: * libguile/expand.c: * libguile/eval.c: Adapt to the new seq format.
This commit is contained in:
parent
a881a4ae3b
commit
6fc3eae477
14 changed files with 194 additions and 172 deletions
|
@ -229,10 +229,9 @@ eval (SCM x, SCM env)
|
|||
mx = SCM_MEMOIZED_ARGS (x);
|
||||
switch (SCM_MEMOIZED_TAG (x))
|
||||
{
|
||||
case SCM_M_BEGIN:
|
||||
for (; !scm_is_null (CDR (mx)); mx = CDR (mx))
|
||||
eval (CAR (mx), env);
|
||||
x = CAR (mx);
|
||||
case SCM_M_SEQ:
|
||||
eval (CAR (mx), env);
|
||||
x = CDR (mx);
|
||||
goto loop;
|
||||
|
||||
case SCM_M_IF:
|
||||
|
|
|
@ -73,8 +73,8 @@ static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES];
|
|||
SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate)
|
||||
#define CALL(src, proc, exps) \
|
||||
SCM_MAKE_EXPANDED_CALL(src, proc, exps)
|
||||
#define SEQUENCE(src, exps) \
|
||||
SCM_MAKE_EXPANDED_SEQUENCE(src, exps)
|
||||
#define SEQ(src, head, tail) \
|
||||
SCM_MAKE_EXPANDED_SEQ(src, head, tail)
|
||||
#define LAMBDA(src, meta, body) \
|
||||
SCM_MAKE_EXPANDED_LAMBDA(src, meta, body)
|
||||
#define LAMBDA_CASE(src, req, opt, rest, kw, inits, gensyms, body, alternate) \
|
||||
|
@ -396,7 +396,9 @@ expand_sequence (const SCM forms, const SCM env)
|
|||
if (scm_is_null (CDR (forms)))
|
||||
return expand (CAR (forms), env);
|
||||
else
|
||||
return SEQUENCE (SCM_BOOL_F, expand_exprs (forms, env));
|
||||
return SEQ (scm_source_properties (forms),
|
||||
expand (CAR (forms), env),
|
||||
expand_sequence (CDR (forms), env));
|
||||
}
|
||||
|
||||
|
||||
|
@ -1245,7 +1247,7 @@ scm_init_expand ()
|
|||
DEFINE_NAMES (CONDITIONAL);
|
||||
DEFINE_NAMES (CALL);
|
||||
DEFINE_NAMES (PRIMCALL);
|
||||
DEFINE_NAMES (SEQUENCE);
|
||||
DEFINE_NAMES (SEQ);
|
||||
DEFINE_NAMES (LAMBDA);
|
||||
DEFINE_NAMES (LAMBDA_CASE);
|
||||
DEFINE_NAMES (LET);
|
||||
|
|
|
@ -49,7 +49,7 @@ typedef enum
|
|||
SCM_EXPANDED_CONDITIONAL,
|
||||
SCM_EXPANDED_CALL,
|
||||
SCM_EXPANDED_PRIMCALL,
|
||||
SCM_EXPANDED_SEQUENCE,
|
||||
SCM_EXPANDED_SEQ,
|
||||
SCM_EXPANDED_LAMBDA,
|
||||
SCM_EXPANDED_LAMBDA_CASE,
|
||||
SCM_EXPANDED_LET,
|
||||
|
@ -255,17 +255,18 @@ enum
|
|||
#define SCM_MAKE_EXPANDED_PRIMCALL(src, name, args) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_PRIMCALL], 0, SCM_NUM_EXPANDED_PRIMCALL_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (args))
|
||||
|
||||
#define SCM_EXPANDED_SEQUENCE_TYPE_NAME "sequence"
|
||||
#define SCM_EXPANDED_SEQUENCE_FIELD_NAMES \
|
||||
{ "src", "exps", }
|
||||
#define SCM_EXPANDED_SEQ_TYPE_NAME "seq"
|
||||
#define SCM_EXPANDED_SEQ_FIELD_NAMES \
|
||||
{ "src", "head", "tail", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_SEQUENCE_SRC,
|
||||
SCM_EXPANDED_SEQUENCE_EXPS,
|
||||
SCM_NUM_EXPANDED_SEQUENCE_FIELDS,
|
||||
SCM_EXPANDED_SEQ_SRC,
|
||||
SCM_EXPANDED_SEQ_HEAD,
|
||||
SCM_EXPANDED_SEQ_TAIL,
|
||||
SCM_NUM_EXPANDED_SEQ_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_MAKE_EXPANDED_SEQ(src, head, tail) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_SEQ], 0, SCM_NUM_EXPANDED_SEQ_FIELDS, SCM_UNPACK (src), SCM_UNPACK (head), SCM_UNPACK (tail))
|
||||
|
||||
#define SCM_EXPANDED_LAMBDA_TYPE_NAME "lambda"
|
||||
#define SCM_EXPANDED_LAMBDA_FIELD_NAMES \
|
||||
|
|
|
@ -67,8 +67,8 @@ scm_t_bits scm_tc16_memoized;
|
|||
#define MAKMEMO(n, args) \
|
||||
(scm_cell (scm_tc16_memoized | ((n) << 16), SCM_UNPACK (args)))
|
||||
|
||||
#define MAKMEMO_BEGIN(exps) \
|
||||
MAKMEMO (SCM_M_BEGIN, exps)
|
||||
#define MAKMEMO_SEQ(head,tail) \
|
||||
MAKMEMO (SCM_M_SEQ, scm_cons (head, tail))
|
||||
#define MAKMEMO_IF(test, then, else_) \
|
||||
MAKMEMO (SCM_M_IF, scm_cons (test, scm_cons (then, else_)))
|
||||
#define FIXED_ARITY(nreq) \
|
||||
|
@ -124,7 +124,7 @@ scm_t_bits scm_tc16_memoizer;
|
|||
/* This table must agree with the list of M_ constants in memoize.h */
|
||||
static const char *const memoized_tags[] =
|
||||
{
|
||||
"begin",
|
||||
"seq",
|
||||
"if",
|
||||
"lambda",
|
||||
"let",
|
||||
|
@ -277,8 +277,9 @@ memoize (SCM exp, SCM env)
|
|||
return MAKMEMO_CALL (proc, scm_ilength (args), args);
|
||||
}
|
||||
|
||||
case SCM_EXPANDED_SEQUENCE:
|
||||
return MAKMEMO_BEGIN (memoize_exps (REF (exp, SEQUENCE, EXPS), env));
|
||||
case SCM_EXPANDED_SEQ:
|
||||
return MAKMEMO_SEQ (memoize (REF (exp, SEQ, HEAD), env),
|
||||
memoize (REF (exp, SEQ, TAIL), env));
|
||||
|
||||
case SCM_EXPANDED_LAMBDA:
|
||||
/* The body will be a lambda-case. */
|
||||
|
@ -408,18 +409,21 @@ memoize (SCM exp, SCM env)
|
|||
|
||||
if (in_order_p)
|
||||
{
|
||||
SCM body_exps = SCM_EOL;
|
||||
SCM body_exps = SCM_EOL, seq;
|
||||
for (; scm_is_pair (exps); exps = CDR (exps), i--)
|
||||
body_exps = scm_cons (MAKMEMO_LEX_SET (i-1,
|
||||
memoize (CAR (exps), new_env)),
|
||||
body_exps);
|
||||
body_exps = scm_cons (memoize (body, new_env), body_exps);
|
||||
body_exps = scm_reverse_x (body_exps, SCM_UNDEFINED);
|
||||
return MAKMEMO_LET (undefs, MAKMEMO_BEGIN (body_exps));
|
||||
|
||||
seq = memoize (body, new_env);
|
||||
for (; scm_is_pair (body_exps); body_exps = CDR (body_exps))
|
||||
seq = MAKMEMO_SEQ (CAR (body_exps), seq);
|
||||
|
||||
return MAKMEMO_LET (undefs, seq);
|
||||
}
|
||||
else
|
||||
{
|
||||
SCM sets = SCM_EOL, inits = SCM_EOL;
|
||||
SCM sets = SCM_EOL, inits = SCM_EOL, set_seq;
|
||||
for (; scm_is_pair (exps); exps = CDR (exps), i--)
|
||||
{
|
||||
sets = scm_cons (MAKMEMO_LEX_SET ((i-1) + nvars,
|
||||
|
@ -428,10 +432,18 @@ memoize (SCM exp, SCM env)
|
|||
inits = scm_cons (memoize (CAR (exps), new_env), inits);
|
||||
}
|
||||
inits = scm_reverse_x (inits, SCM_UNDEFINED);
|
||||
return MAKMEMO_LET
|
||||
(undefs,
|
||||
MAKMEMO_BEGIN (scm_list_2 (MAKMEMO_LET (inits, MAKMEMO_BEGIN (sets)),
|
||||
memoize (body, new_env))));
|
||||
|
||||
sets = scm_reverse_x (sets, SCM_UNDEFINED);
|
||||
if (scm_is_null (sets))
|
||||
return memoize (body, env);
|
||||
|
||||
for (set_seq = CAR (sets), sets = CDR (sets); scm_is_pair (sets);
|
||||
sets = CDR (sets))
|
||||
set_seq = MAKMEMO_SEQ (CAR (sets), set_seq);
|
||||
|
||||
return MAKMEMO_LET (undefs,
|
||||
MAKMEMO_SEQ (MAKMEMO_LET (inits, set_seq),
|
||||
memoize (body, new_env)));
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -622,8 +634,9 @@ unmemoize (const SCM expr)
|
|||
{
|
||||
case SCM_M_APPLY:
|
||||
return scm_cons (scm_sym_atapply, unmemoize_exprs (args));
|
||||
case SCM_M_BEGIN:
|
||||
return scm_cons (scm_sym_begin, unmemoize_exprs (args));
|
||||
case SCM_M_SEQ:
|
||||
return scm_list_3 (scm_sym_begin, unmemoize (CAR (args)),
|
||||
unmemoize (CDR (args)));
|
||||
case SCM_M_CALL:
|
||||
return scm_cons (unmemoize (CAR (args)), unmemoize_exprs (CDDR (args)));
|
||||
case SCM_M_CONT:
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
#ifndef SCM_MEMOIZE_H
|
||||
#define SCM_MEMOIZE_H
|
||||
|
||||
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010
|
||||
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2011
|
||||
* Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
|
@ -72,7 +72,7 @@ SCM_INTERNAL scm_t_bits scm_tc16_memoized;
|
|||
|
||||
enum
|
||||
{
|
||||
SCM_M_BEGIN,
|
||||
SCM_M_SEQ,
|
||||
SCM_M_IF,
|
||||
SCM_M_LAMBDA,
|
||||
SCM_M_LET,
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue