From c708ebf9eca652f461185c46800176d659fe43aa Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Sat, 11 Feb 1995 02:50:11 +0000 Subject: [PATCH] IFs with sufficiently simple subexpressions are now handled piecemeal, reducing all the intermediate procedures that ensue when generic arithmetic operations are expanded early. --- v8/src/compiler/midend/cpsconv.scm | 44 ++++++++++++++++-------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/v8/src/compiler/midend/cpsconv.scm b/v8/src/compiler/midend/cpsconv.scm index da3c91255..9658c110d 100644 --- a/v8/src/compiler/midend/cpsconv.scm +++ b/v8/src/compiler/midend/cpsconv.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: cpsconv.scm,v 1.4 1994/11/26 16:56:47 gjr Exp $ +$Id: cpsconv.scm,v 1.5 1995/02/11 02:50:11 adams Exp $ Copyright (c) 1994 Massachusetts Institute of Technology @@ -52,13 +52,13 @@ MIT in each case. |# (define-macro (define-cps-converter keyword bindings . body) (let ((proc-name (symbol-append 'CPSCONV/ keyword))) (call-with-values - (lambda () (%matchup (cdr bindings) '(handler cont) '(cdr form))) - (lambda (names code) - `(define ,proc-name - (named-lambda (,proc-name cont form) - (let ((handler (lambda ,(cons (car bindings) names) ,@body))) - (cpsconv/remember ,code - form)))))))) + (lambda () (%matchup (cdr bindings) '(handler cont) '(cdr form))) + (lambda (names code) + `(DEFINE ,proc-name + (NAMED-LAMBDA (,proc-name CONT FORM) + (LET ((HANDLER (LAMBDA ,(cons (car bindings) names) ,@body))) + (CPSCONV/REMEMBER ,code + form)))))))) (define-cps-converter LOOKUP (cont name) (cpsconv/return form cont `(LOOKUP ,name))) @@ -295,18 +295,22 @@ MIT in each case. |# next))))))) (define-cps-converter IF (cont pred conseq alt) - ;; This does anchor pointing by default? - (let ((consname (cpsconv/new-name 'CONS)) - (altname (cpsconv/new-name 'ALT)) - (ignore1 (cpsconv/new-ignored-continuation)) - (ignore2 (cpsconv/new-ignored-continuation))) - `(LET ((,consname (LAMBDA (,ignore1) ,(cpsconv/expr cont conseq))) - (,altname (LAMBDA (,ignore2) ,(cpsconv/expr cont alt)))) - ,(cpsconv/expr - (cpsconv/predicate-continuation - consname altname - (cpsconv/dbg-continuation/make 'PREDICATE form pred)) - pred)))) + (if (and (form/simple&side-effect-free? pred) + (form/pseudo-simple&side-effect-free? conseq) + (form/pseudo-simple&side-effect-free? alt)) + (cpsconv/return form cont (cpsconv/simple/copy form)) + ;; This does anchor pointing by default? + (let ((consname (cpsconv/new-name 'CONS)) + (altname (cpsconv/new-name 'ALT)) + (ignore1 (cpsconv/new-ignored-continuation)) + (ignore2 (cpsconv/new-ignored-continuation))) + `(LET ((,consname (LAMBDA (,ignore1) ,(cpsconv/expr cont conseq))) + (,altname (LAMBDA (,ignore2) ,(cpsconv/expr cont alt)))) + ,(cpsconv/expr + (cpsconv/predicate-continuation + consname altname + (cpsconv/dbg-continuation/make 'PREDICATE form pred)) + pred))))) (define (cpsconv/expr cont expr) (if (not (pair? expr)) -- 2.25.1