mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

peval can inline let-bound lambdas

Browse source 
* module/language/tree-il/peval.scm (peval): Better inlining of
  complicated operators.

* test-suite/tests/peval.test ("partial evaluation"): Add a couple
  tests.
This commit is contained in:
Andy Wingo 2013-02-14 17:33:40 +01:00
parent 5ad85ba15f
commit 30c3dac7a6
2 changed files with 39 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

27
module/language/tree-il/peval.scm
View file

@ -1117,7 +1117,7 @@ top-level bindings from ENV and return the resulting expression."
(make-application src apply (cons (for-value proc) args))))))
(($ <application> src orig-proc orig-args)
;; todo: augment the global env with specialized functions
(let ((proc (visit orig-proc 'operator)))
(let revisit-proc ((proc (visit orig-proc 'operator)))
(match proc
(($ <primitive-ref> _ (? constructor-primitive? name))
(cond
@ -1305,6 +1305,31 @@ top-level bindings from ENV and return the resulting expression."
(log 'inline-end result exp)
result)))))
(($ <let> _ _ _ vals _)
;; Attempt to inline `let' in the operator position.
;;
;; We have to re-visit the proc in value mode, since the
;; `let' bindings might have been introduced or renamed,
;; whereas the lambda (if any) in operator position has not
;; been renamed.
(if (or (and-map constant-expression? vals)
(and-map constant-expression? orig-args))
;; The arguments and the let-bound values commute.
(match (for-value orig-proc)
(($ <let> lsrc names syms vals body)
(log 'inline-let orig-proc)
(for-tail
(make-let lsrc names syms vals
(make-application src body orig-args))))
;; It's possible for a `let' to go away after the
;; visit due to the fact that visiting a procedure in
;; value context will prune unused bindings, whereas
;; visiting in operator mode can't because it doesn't
;; traverse through lambdas. In that case re-visit
;; the procedure.
(proc (revisit-proc proc)))
(make-application src (for-call orig-proc)
(map for-value orig-args))))
(_
(make-application src (for-call orig-proc)
(map for-value orig-args))))))

14
test-suite/tests/peval.test
View file

@ -1,7 +1,7 @@
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
;;;; Andy Wingo <wingo@pobox.com> --- May 2009
;;;;
;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; Copyright (C) 2009, 2010, 2011, 2012, 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
@ -830,6 +830,18 @@
(((x) #f #f #f () (_))
(apply (toplevel top) (lexical x _)))))))
(pass-if-peval resolve-primitives
;; The inliner sees through a `let'.
((let ((a 10)) (lambda (b) (* b 2))) 30)
(const 60))
(pass-if-peval
((lambda ()
(define (const x) (lambda (_) x))
(let ((v #f))
((const #t) v))))
(const #t))
(pass-if-peval
;; Constant folding: cons of #nil does not make list
(cons 1 #nil)