diff options
author | Andy Wingo <wingo@pobox.com> | 2014-12-07 19:03:19 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-12-07 19:03:19 +0100 |
commit | 5bfc0653d6361ab29ed2da68eeba14cce1ec8f6c (patch) | |
tree | 0b74366bb30393f58e1173e7dbc3a9548f1e8c25 | |
parent | e6a42e676528bf56c6535a7e0c79e936a6d2a818 (diff) | |
download | guile-5bfc0653d6361ab29ed2da68eeba14cce1ec8f6c.tar.gz |
Minor evaluator tweaks
* libguile/eval.c (eval): Remove unused variable.
* libguile/memoize.c (unmemoize): Fix unmemoization.
* module/ice-9/eval.scm: Attempt to speed up common box-ref cases.
-rw-r--r-- | libguile/eval.c | 2 | ||||
-rw-r--r-- | libguile/memoize.c | 13 | ||||
-rw-r--r-- | module/ice-9/eval.scm | 15 |
3 files changed, 23 insertions, 7 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index b69b5b2b4..72f15314f 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -413,7 +413,7 @@ eval (SCM x, SCM env) return mx; else { - SCM mod, var; + SCM var; var = scm_sys_resolve_variable (mx, env_tail (env)); scm_set_cdr_x (x, var); diff --git a/libguile/memoize.c b/libguile/memoize.c index cefb26938..88a168fd8 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -750,10 +750,15 @@ unmemoize (const SCM expr) unmemoize (CAR (args)), unmemoize (CDR (args))); case SCM_M_RESOLVE: - return (SCM_VARIABLEP (args) || scm_is_symbol (args)) ? args - : scm_list_3 (scm_is_true (CDDR (args)) ? scm_sym_at : scm_sym_atat, - scm_i_finite_list_copy (CAR (args)), - CADR (args)); + if (SCM_VARIABLEP (args)) + return args; + else if (scm_is_symbol (CDR (args))) + return CDR (args); + else + return scm_list_3 + (scm_is_true (CDDDR (args)) ? scm_sym_at : scm_sym_atat, + scm_i_finite_list_copy (CADR (args)), + CADDR (args)); case SCM_M_CALL_WITH_PROMPT: return scm_list_4 (scm_from_latin1_symbol ("call-with-prompt"), unmemoize (CAR (args)), diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index f3f08992a..a1398f6d5 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -279,9 +279,11 @@ ;; we compile `case' effectively, this situation will improve. (define-syntax mx-match (lambda (x) - (syntax-case x (quote) + (syntax-case x (quote else) ((_ mx data tag) #'(error "what" mx)) + ((_ mx data tag (else body)) + #'body) ((_ mx data tag (('type pat) body) c* ...) #`(if (eqv? tag #,(or (memoized-typecode (syntax->datum #'type)) (error "not a typecode" #'type))) @@ -464,7 +466,16 @@ (call eval proc nargs args env))) (('box-ref box) - (variable-ref (eval box env))) + (memoized-expression-case box + ;; Accelerate common cases. + (('resolve var-or-loc) + (if (variable? var-or-loc) + (variable-ref var-or-loc) + (variable-ref (eval box env)))) + (('lexical-ref (depth . width)) + (variable-ref (env-ref env depth width))) + (else + (variable-ref (eval box env))))) (('resolve var-or-loc) (if (variable? var-or-loc) |