From 15d5a4d105851e3444b7487c4dacb9fc3dac995b Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Thu, 22 Sep 1988 18:42:57 +0000 Subject: [PATCH] (force (delay x)) ==> x (new optimization) --- v7/src/sf/subst.scm | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/v7/src/sf/subst.scm b/v7/src/sf/subst.scm index eed448bad..c0f3f949d 100644 --- a/v7/src/sf/subst.scm +++ b/v7/src/sf/subst.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/subst.scm,v 4.2 1988/08/09 19:59:12 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/subst.scm,v 4.3 1988/09/22 18:42:57 jrm Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -821,11 +821,22 @@ forms are simply removed. (set! combination/optimizing-make (lambda (operator operands) - (cond ((and (foldable-operator? operator) - (foldable-constants? operands)) + (cond ( ;; fold constants + (and (foldable-operator? operator) + (foldable-constants? operands)) (constant/make (apply (constant/value operator) (map foldable-constant-value operands)))) + + ;; (force (delay x)) ==> x + ((and (constant? operator) + (primitive-procedure? (constant/value operator)) + (eq? (constant/value operator) + (make-primitive-procedure 'FORCE)) + (eq? (length operands) 1) + (delay? (car operands))) + (delay/expression (car operands))) + ((and (procedure? operator) (null? (procedure/optional operator)) (not (procedure/rest operator)) -- 2.25.1