From ef2e7fd0d5ef0e5c36a91061900bd211cef64e37 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 19 Dec 1988 20:27:47 +0000 Subject: [PATCH] Rewrite the handling of SCode quotation expressions to allow `car' to be constant folded by the compiler. --- v7/src/compiler/fggen/fggen.scm | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) diff --git a/v7/src/compiler/fggen/fggen.scm b/v7/src/compiler/fggen/fggen.scm index 565ea8252..51f606467 100644 --- a/v7/src/compiler/fggen/fggen.scm +++ b/v7/src/compiler/fggen/fggen.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/fggen.scm,v 4.12 1988/12/12 21:51:40 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/fggen.scm,v 4.13 1988/12/19 20:27:47 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -724,8 +724,23 @@ MIT in each case. |# block continuation (scode/make-combination - (ucode-primitive car) - (list (list (scode/quotation-expression expression)))))) + (ucode-primitive system-pair-car) + (list (make-constant-quotation expression))))) + +(define (generate/constant-quotation block continuation expression) + (continue/rvalue-constant + block + continuation + (make-constant (scode/constant-quotation-expression expression)))) + +(define-integrable (scode/make-constant-quotation name) + (cons constant-quotation-tag name)) + +(define-integrable (scode/constant-quotation-expression expression) + (cdr expression)) + +(define constant-quotation-tag + "constant-quotation") ;;;; Dispatcher @@ -758,9 +773,12 @@ MIT in each case. |# (generate/combination block continuation expression)))))) (generate/pair (lambda (block continuation expression) - (if (eq? (car expression) safe-variable-tag) - (generate/safe-variable block continuation expression) - (generate/constant block continuation expression))))) + (cond ((eq? (car expression) safe-variable-tag) + (generate/safe-variable block continuation expression)) + ((eq? (car expression) constant-quotation-tag) + (generate/constant-quotation block continuation expression)) + (else + (generate/constant block continuation expression)))))) (let-syntax ((dispatch-entry -- 2.25.1