diff options
author | Andy Wingo <wingo@pobox.com> | 2011-06-02 19:13:32 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-06-02 19:13:32 +0200 |
commit | 6fc3eae4772bc2c5dc3e2b377ca481eef9aa52f5 (patch) | |
tree | 898c7e79ed0e5045692e619eda2a6e6a840462b0 /libguile | |
parent | a881a4ae3bc1f2cc00ac7274e286271b6f55287c (diff) | |
download | guile-6fc3eae4772bc2c5dc3e2b377ca481eef9aa52f5.tar.gz |
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.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/eval.c | 7 | ||||
-rw-r--r-- | libguile/expand.c | 10 | ||||
-rw-r--r-- | libguile/expand.h | 19 | ||||
-rw-r--r-- | libguile/memoize.c | 45 | ||||
-rw-r--r-- | libguile/memoize.h | 4 |
5 files changed, 50 insertions, 35 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index e008b3a08..e1d03484d 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -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: diff --git a/libguile/expand.c b/libguile/expand.c index af6eb7d12..78dd4cac4 100644 --- a/libguile/expand.c +++ b/libguile/expand.c @@ -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); diff --git a/libguile/expand.h b/libguile/expand.h index b4e6a2132..f5e7af5d4 100644 --- a/libguile/expand.h +++ b/libguile/expand.h @@ -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 \ diff --git a/libguile/memoize.c b/libguile/memoize.c index d1537f9fb..801088ccb 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -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: diff --git a/libguile/memoize.h b/libguile/memoize.h index 26bd5b1c1..da78b06fa 100644 --- a/libguile/memoize.h +++ b/libguile/memoize.h @@ -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, |