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=14b9aa95e61e2d593bd96ab0a7675ed72d55503c The branch, wip-rtl-halloween has been updated via 14b9aa95e61e2d593bd96ab0a7675ed72d55503c (commit) via b681671ede9cefcbfa9d59169030b013f5ddfc6a (commit) from d258fcccee2d96dc3cf90cecf3f3ee9ebb25b9db (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 14b9aa95e61e2d593bd96ab0a7675ed72d55503c Author: Andy Wingo <[email protected]> Date: Fri Nov 1 18:23:51 2013 +0100 Fix order of evaluation in elisp lexer * module/language/elisp/lexer.scm (lex): Use let*, to ensure that the port position is read before reading the next char. commit b681671ede9cefcbfa9d59169030b013f5ddfc6a Author: Andy Wingo <[email protected]> Date: Fri Nov 1 18:22:58 2013 +0100 Fix contification of non-recursive closures * module/language/cps/contification.scm (compute-contification): When eliding let-bound functions, also record the cont that declares the function. (apply-contification): Instead of reifying ($values ()) gotos instead of the elided function, inline the body that binds the function directly. This ensures that the function gets contified in its own scope. ----------------------------------------------------------------------- Summary of changes: module/language/cps/contification.scm | 33 ++++++++++++++++++--------------- module/language/elisp/lexer.scm | 30 +++++++++++++++--------------- 2 files changed, 33 insertions(+), 30 deletions(-) diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm index 970432a..aa162e0 100644 --- a/module/language/cps/contification.scm +++ b/module/language/cps/contification.scm @@ -30,7 +30,7 @@ (define-module (language cps contification) #:use-module (ice-9 match) - #:use-module ((srfi srfi-1) #:select (concatenate)) + #:use-module ((srfi srfi-1) #:select (concatenate filter-map)) #:use-module (srfi srfi-26) #:use-module (language cps) #:use-module (language cps dfg) @@ -49,8 +49,8 @@ (set! call-substs (acons sym (map cons arities body-ks) call-substs))) (define (subst-return! old-tail new-tail) (set! cont-substs (acons old-tail new-tail cont-substs))) - (define (elide-function! k) - (set! fun-elisions (cons k fun-elisions))) + (define (elide-function! k cont) + (set! fun-elisions (acons k cont fun-elisions))) (define (splice-conts! scope conts) (hashq-set! cont-splices scope (append conts (hashq-ref cont-splices scope '())))) @@ -230,7 +230,7 @@ (if (and=> (bound-symbol k) (lambda (sym) (contify-fun term-k sym self tail-k arity body))) - (elide-function! k) + (elide-function! k (lookup-cont k cont-table)) (visit-fun exp))) (_ #t))))) @@ -276,10 +276,10 @@ (($ $letrec names syms funs body) ($letrec names syms funs ,(lp body))) (($ $letk conts* body) - ($letk ,(append conts* (map visit-cont cont)) + ($letk ,(append conts* (filter-map visit-cont cont)) ,body)) (body - ($letk ,(map visit-cont cont) + ($letk ,(filter-map visit-cont cont) ,body))))))) (define (visit-fun term) (rewrite-cps-exp term @@ -287,9 +287,9 @@ ($fun meta free ,(visit-cont body))))) (define (visit-cont cont) (rewrite-cps-cont cont - (($ $cont (and k (? (cut memq <> fun-elisions))) src - ($ $kargs (_) (_) body)) - (k src ($kargs () () ,(visit-term body k)))) + (($ $cont (? (cut assq <> fun-elisions))) + ;; This cont gets inlined in place of the $fun. + ,#f) (($ $cont sym src ($ $kargs names syms body)) (sym src ($kargs names syms ,(visit-term body sym)))) (($ $cont sym src ($ $kentry self tail clauses)) @@ -312,10 +312,10 @@ (($ $letrec names syms funs body) ($letrec names syms funs ,(lp body))) (($ $letk conts* body) - ($letk ,(append conts* (map visit-cont conts)) + ($letk ,(append conts* (filter-map visit-cont conts)) ,body)) (body - ($letk ,(map visit-cont conts) + ($letk ,(filter-map visit-cont conts) ,body))))) (($ $letrec names syms funs body) (rewrite-cps-term (filter (match-lambda @@ -329,10 +329,13 @@ term-k (match exp (($ $fun) - (if (memq k fun-elisions) - (build-cps-term - ($continue k ($values ()))) - (continue k (visit-fun exp)))) + (cond + ((assq-ref fun-elisions k) + => (match-lambda + (($ $kargs (_) (_) body) + (visit-term body k)))) + (else + (continue k (visit-fun exp))))) (($ $call proc args) (or (contify-call proc args) (continue k exp))) diff --git a/module/language/elisp/lexer.scm b/module/language/elisp/lexer.scm index 1933ff3..5a0e6b3 100644 --- a/module/language/elisp/lexer.scm +++ b/module/language/elisp/lexer.scm @@ -1,6 +1,6 @@ ;;; Guile Emacs Lisp -;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;;; Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -261,20 +261,20 @@ (and=> (regexp-exec lexical-binding-regexp string) (lambda (match) (not (member (match:substring match 2) '("nil" "()")))))) - (let ((return (let ((file (if (file-port? port) - (port-filename port) - #f)) - (line (1+ (port-line port))) - (column (1+ (port-column port)))) - (lambda (token value) - (let ((obj (cons token value))) - (set-source-property! obj 'filename file) - (set-source-property! obj 'line line) - (set-source-property! obj 'column column) - obj)))) - ;; Read afterwards so the source-properties are correct above - ;; and actually point to the very character to be read. - (c (read-char port))) + (let* ((return (let ((file (if (file-port? port) + (port-filename port) + #f)) + (line (1+ (port-line port))) + (column (1+ (port-column port)))) + (lambda (token value) + (let ((obj (cons token value))) + (set-source-property! obj 'filename file) + (set-source-property! obj 'line line) + (set-source-property! obj 'column column) + obj)))) + ;; Read afterwards so the source-properties are correct above + ;; and actually point to the very character to be read. + (c (read-char port))) (cond ;; End of input must be specially marked to the parser. ((eof-object? c) (return 'eof c)) hooks/post-receive -- GNU Guile
