diff options
-rw-r--r-- | module/ice-9/eval.scm | 126 |
1 files changed, 77 insertions, 49 deletions
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index 5d2bfb73a..454fc4f69 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -188,24 +188,66 @@ (mx-match mx data tag c ...))))))) +;;; +;;; On 18 Feb 2010, I did a profile of how often the various memoized expression +;;; types occur when getting to a prompt on a fresh build. Here are the numbers +;;; I got: +;;; +;;; lexical-ref: 32933054 +;;; call: 20281547 +;;; toplevel-ref: 13228724 +;;; if: 9156156 +;;; quote: 6610137 +;;; let: 2619707 +;;; lambda: 1010921 +;;; begin: 948945 +;;; lexical-set: 509862 +;;; call-with-values: 139668 +;;; apply: 49402 +;;; module-ref: 14468 +;;; define: 1259 +;;; toplevel-set: 328 +;;; dynwind: 162 +;;; with-fluids: 0 +;;; call/cc: 0 +;;; module-set: 0 +;;; +;;; So until we compile `case' into a computed goto, we'll order the clauses in +;;; `eval' in this order, to put the most frequent cases first. +;;; + (define primitive-eval (let () ;; The "engine". EXP is a memoized expression. (define (eval exp env) (memoized-expression-case exp - (('begin (first . rest)) - (let lp ((first first) (rest rest)) - (if (null? rest) - (eval first env) - (begin - (eval first env) - (lp (car rest) (cdr rest)))))) + (('lexical-ref n) + (let lp ((n n) (env env)) + (if (zero? n) + (car env) + (lp (1- n) (cdr env))))) + (('call (f nargs . args)) + (let ((proc (eval f env))) + (call eval proc nargs args env))) + + (('toplevel-ref var-or-sym) + (variable-ref + (if (variable? var-or-sym) + var-or-sym + (let lp ((env env)) + (if (pair? env) + (lp (cdr env)) + (memoize-variable-access! exp (capture-env env))))))) + (('if (test consequent . alternate)) (if (eval test env) (eval consequent env) (eval alternate env))) + (('quote x) + x) + (('let (inits . body)) (let lp ((inits inits) (new-env (capture-env env))) (if (null? inits) @@ -216,36 +258,13 @@ (('lambda (nreq rest? . body)) (make-closure eval nreq rest? body (capture-env env))) - (('quote x) - x) - - (('define (name . x)) - (define! name (eval x env))) - - (('dynwind (in exp . out)) - (dynamic-wind (eval in env) - (lambda () (eval exp env)) - (eval out env))) - - (('apply (f args)) - (apply (eval f env) (eval args env))) - - (('call (f nargs . args)) - (let ((proc (eval f env))) - (call eval proc nargs args env))) - - (('call/cc proc) - (call/cc (eval proc env))) - - (('call-with-values (producer . consumer)) - (call-with-values (eval producer env) - (eval consumer env))) - - (('lexical-ref n) - (let lp ((n n) (env env)) - (if (zero? n) - (car env) - (lp (1- n) (cdr env))))) + (('begin (first . rest)) + (let lp ((first first) (rest rest)) + (if (null? rest) + (eval first env) + (begin + (eval first env) + (lp (car rest) (cdr rest)))))) (('lexical-set! (n . x)) (let ((val (eval x env))) @@ -254,15 +273,22 @@ (set-car! env val) (lp (1- n) (cdr env)))))) - (('toplevel-ref var-or-sym) + (('call-with-values (producer . consumer)) + (call-with-values (eval producer env) + (eval consumer env))) + + (('apply (f args)) + (apply (eval f env) (eval args env))) + + (('module-ref var-or-spec) (variable-ref - (if (variable? var-or-sym) - var-or-sym - (let lp ((env env)) - (if (pair? env) - (lp (cdr env)) - (memoize-variable-access! exp (capture-env env))))))) + (if (variable? var-or-spec) + var-or-spec + (memoize-variable-access! exp #f)))) + (('define (name . x)) + (define! name (eval x env))) + (('toplevel-set! (var-or-sym . x)) (variable-set! (if (variable? var-or-sym) @@ -273,11 +299,13 @@ (memoize-variable-access! exp (capture-env env))))) (eval x env))) - (('module-ref var-or-spec) - (variable-ref - (if (variable? var-or-spec) - var-or-spec - (memoize-variable-access! exp #f)))) + (('dynwind (in exp . out)) + (dynamic-wind (eval in env) + (lambda () (eval exp env)) + (eval out env))) + + (('call/cc proc) + (call/cc (eval proc env))) (('module-set! (x . var-or-spec)) (variable-set! |