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

Minor evaluator tweaks

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2014-12-07 19:03:19 +01:00
parent e6a42e6765
commit 5bfc0653d6
3 changed files with 23 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/eval.c
View file

@ -413,7 +413,7 @@ eval (SCM x, SCM env)
return mx; return mx;
else else
{ {
SCM mod, var; SCM var;
var = scm_sys_resolve_variable (mx, env_tail (env)); var = scm_sys_resolve_variable (mx, env_tail (env));
scm_set_cdr_x (x, var); scm_set_cdr_x (x, var);

13
libguile/memoize.c
View file

@ -750,10 +750,15 @@ unmemoize (const SCM expr)
unmemoize (CAR (args)), unmemoize (CAR (args)),
unmemoize (CDR (args))); unmemoize (CDR (args)));
case SCM_M_RESOLVE: case SCM_M_RESOLVE:
return (SCM_VARIABLEP (args) || scm_is_symbol (args)) ? args if (SCM_VARIABLEP (args))
: scm_list_3 (scm_is_true (CDDR (args)) ? scm_sym_at : scm_sym_atat, return args;
scm_i_finite_list_copy (CAR (args)), else if (scm_is_symbol (CDR (args)))
CADR (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: case SCM_M_CALL_WITH_PROMPT:
return scm_list_4 (scm_from_latin1_symbol ("call-with-prompt"), return scm_list_4 (scm_from_latin1_symbol ("call-with-prompt"),
unmemoize (CAR (args)), unmemoize (CAR (args)),

15
module/ice-9/eval.scm
View file

@ -279,9 +279,11 @@
;; we compile `case' effectively, this situation will improve. ;; we compile `case' effectively, this situation will improve.
(define-syntax mx-match (define-syntax mx-match
(lambda (x) (lambda (x)
(syntax-case x (quote) (syntax-case x (quote else)
((_ mx data tag) ((_ mx data tag)
#'(error "what" mx)) #'(error "what" mx))
((_ mx data tag (else body))
#'body)
((_ mx data tag (('type pat) body) c* ...) ((_ mx data tag (('type pat) body) c* ...)
#`(if (eqv? tag #,(or (memoized-typecode (syntax->datum #'type)) #`(if (eqv? tag #,(or (memoized-typecode (syntax->datum #'type))
(error "not a typecode" #'type))) (error "not a typecode" #'type)))
@ -464,7 +466,16 @@
(call eval proc nargs args env))) (call eval proc nargs args env)))
(('box-ref box) (('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) (('resolve var-or-loc)
(if (variable? var-or-loc) (if (variable? var-or-loc)