This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=33e9a90d7b66d174c41b2cf0c8c89d4a3fa88443 The branch, master has been updated via 33e9a90d7b66d174c41b2cf0c8c89d4a3fa88443 (commit) via 8cff7f54dcdaff5a87dce5d419b15a21d5884f48 (commit) via a4b64fa2465e02d623982d927fbf3eea7123679c (commit) from 8695854a7d0795f6a0680bbdf1fc62f2894b45aa (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 33e9a90d7b66d174c41b2cf0c8c89d4a3fa88443 Author: Andy Wingo <[email protected]> Date: Wed Oct 23 16:57:14 2013 +0200 Always resolve-primitives in the root module. * module/language/tree-il/primitives.scm (resolve-primitives): If we are compiling in the root module, ignore local definitions. commit 8cff7f54dcdaff5a87dce5d419b15a21d5884f48 Author: Andy Wingo <[email protected]> Date: Wed Oct 23 15:06:24 2013 +0200 RTL VM: Fix LOCAL_REF, LOCAL_SET for unsigned indices * libguile/vm-engine.c (LOCAL_REF, LOCAL_SET): Fix so to work with unsigned 0. Previously subtracting 1 was making the index wrap around. commit a4b64fa2465e02d623982d927fbf3eea7123679c Author: Andy Wingo <[email protected]> Date: Wed Oct 23 19:01:03 2013 +0200 Optimize closures with only required and rest arguments in eval * module/ice-9/eval.scm: Pregenerate closures with rest arguments, as we do for fixed arguments. This is important given the amount of (lambda args (apply foo args)) that we are doing lately. ----------------------------------------------------------------------- Summary of changes: libguile/vm-engine.c | 4 +- module/ice-9/eval.scm | 51 ++++++++++++++++++++++++++++---- module/language/tree-il/primitives.scm | 19 +++++++----- 3 files changed, 58 insertions(+), 16 deletions(-) diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index e2f8745..cf359c9 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -628,8 +628,8 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) case opcode: #endif -#define LOCAL_REF(i) SCM_FRAME_VARIABLE (fp, (i) - 1) -#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE (fp, (i) - 1) = o +#define LOCAL_REF(i) SCM_FRAME_VARIABLE ((fp - 1), i) +#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE ((fp - 1), i) = o #define VARIABLE_REF(v) SCM_VARIABLE_REF (v) #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o) diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index fdf16c8..1270732 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -102,6 +102,46 @@ (1- nreq) (cdr args))))))))))))) + ;; Fast case for procedures with fixed arities and a rest argument. + (define-syntax make-rest-closure + (lambda (x) + (define *max-static-argument-count* 3) + (define (make-formals n) + (map (lambda (i) + (datum->syntax + x + (string->symbol + (string (integer->char (+ (char->integer #\a) i)))))) + (iota n))) + (syntax-case x () + ((_ eval nreq body env) (not (identifier? #'env)) + #'(let ((e env)) + (make-rest-closure eval nreq body e))) + ((_ eval nreq body env) + #`(case nreq + #,@(map (lambda (nreq) + (let ((formals (make-formals nreq))) + #`((#,nreq) + (lambda (#,@formals . rest) + (eval body + (cons* rest #,@(reverse formals) env)))))) + (iota *max-static-argument-count*)) + (else + #,(let ((formals (make-formals *max-static-argument-count*))) + #`(lambda (#,@formals . more) + (let lp ((new-env (cons* #,@(reverse formals) env)) + (nreq (- nreq #,*max-static-argument-count*)) + (args more)) + (if (zero? nreq) + (eval body (cons args new-env)) + (if (null? args) + (scm-error 'wrong-number-of-args + "eval" "Wrong number of arguments" + '() #f) + (lp (cons (car args) new-env) + (1- nreq) + (cdr args))))))))))))) + (define-syntax call (lambda (x) (define *max-static-call-count* 4) @@ -212,8 +252,9 @@ (define primitive-eval (let () - ;; We pre-generate procedures with fixed arities, up to some number of - ;; arguments; see make-fixed-closure above. + ;; We pre-generate procedures with fixed arities, up to some number + ;; of arguments, and some rest arities; see make-fixed-closure and + ;; make-rest-closure above. ;; A unique marker for unbound keywords. (define unbound-arg (list 'unbound-arg)) @@ -222,7 +263,7 @@ ;; multiple arities, as with case-lambda. (define (make-general-closure env body nreq rest? nopt kw inits alt) (define alt-proc - (and alt ; (body docstring nreq ...) + (and alt ; (body docstring nreq ...) (let* ((body (car alt)) (spec (cddr alt)) (nreq (car spec)) @@ -413,9 +454,7 @@ (if (null? tail) (make-fixed-closure eval nreq body (capture-env env)) (if (null? (cdr tail)) - (make-general-closure (capture-env env) body - nreq (car tail) - 0 #f '() #f) + (make-rest-closure eval nreq body (capture-env env)) (apply make-general-closure (capture-env env) body nreq tail))))) (when docstring diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 0fe4445..c18d2b8 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -255,14 +255,17 @@ (define local-definitions (make-hash-table)) - (let collect-local-definitions ((x x)) - (record-case x - ((<toplevel-define> name) - (hashq-set! local-definitions name #t)) - ((<seq> head tail) - (collect-local-definitions head) - (collect-local-definitions tail)) - (else #f))) + ;; Assume that any definitions with primitive names in the root module + ;; have the same semantics as the primitives. + (unless (eq? mod the-root-module) + (let collect-local-definitions ((x x)) + (record-case x + ((<toplevel-define> name) + (hashq-set! local-definitions name #t)) + ((<seq> head tail) + (collect-local-definitions head) + (collect-local-definitions tail)) + (else #f)))) (post-order (lambda (x) hooks/post-receive -- GNU Guile
