From 564e8af5ee29827ee51800e33d89c25ef0627bc2 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Wed, 25 Jan 2012 07:46:58 -0800 Subject: [PATCH] Use sequence-immediate-first instead of sequence-first. --- src/compiler/fggen/fggen.scm | 13 +++++++------ src/runtime/scomb.scm | 24 ++++++++++++------------ src/runtime/unsyn.scm | 4 ++-- 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/src/compiler/fggen/fggen.scm b/src/compiler/fggen/fggen.scm index a3cce7eba..e04d116ab 100644 --- a/src/compiler/fggen/fggen.scm +++ b/src/compiler/fggen/fggen.scm @@ -504,14 +504,15 @@ USA. (if (scode/sequence? expression) ;; This is done in a funny way to enforce processing in sequence order. ;; In this way, compile-by-procedures compiles in a predictable order. - (let ((first (generate/subproblem/effect - block continuation context - (scode/sequence-first expression) 'SEQUENCE-2-SECOND - expression))) + (let ((first-action + (generate/subproblem/effect + block continuation context + (scode/sequence-immediate-first expression) 'SEQUENCE-2-SECOND + expression))) ((scfg*ctype->ctype! continuation) - first + first-action (generate/expression block continuation context - (scode/sequence-second expression)))) + (scode/sequence-immediate-second expression)))) (error "Not a sequence" expression))) (define (generate/conditional block continuation context expression) diff --git a/src/runtime/scomb.scm b/src/runtime/scomb.scm index 1d7155360..5a6ccdf96 100644 --- a/src/runtime/scomb.scm +++ b/src/runtime/scomb.scm @@ -38,8 +38,8 @@ USA. (define-integrable (sequence? object) (object-type? (ucode-type sequence-2) object)) -(define-integrable (%sequence-first sequence) (&pair-car sequence)) -(define-integrable (%sequence-second sequence) (&pair-cdr sequence)) +(define-integrable (%sequence-immediate-first sequence) (&pair-car sequence)) +(define-integrable (%sequence-immediate-second sequence) (&pair-cdr sequence)) (define-guarantee sequence "SCode sequence") @@ -53,29 +53,29 @@ USA. (define (sequence-first expression) (guarantee-sequence expression 'SEQUENCE-FIRST) - (%sequence-first expression)) + (%sequence-immediate-first expression)) (define (sequence-second expression) (guarantee-sequence expression 'SEQUENCE-SECOND) - (%sequence-second expression)) + (%sequence-immediate-second expression)) (define (sequence-immediate-first expression) (guarantee-sequence expression 'SEQUENCE-IMMEDIATE-FIRST) - (%sequence-first expression)) + (%sequence-immediate-first expression)) (define (sequence-immediate-second expression) (guarantee-sequence expression 'SEQUENCE-IMMEDIATE-SECOND) - (%sequence-second expression)) + (%sequence-immediate-second expression)) (define (sequence-immediate-actions expression) (guarantee-sequence expression 'SEQUENCE-IMMEDIATE-ACTIONS) - (list (%sequence-first expression) - (%sequence-second expression))) + (list (%sequence-immediate-first expression) + (%sequence-immediate-second expression))) (define (sequence-actions expression) (if (sequence? expression) - (append! (sequence-actions (%sequence-first expression)) - (sequence-actions (%sequence-second expression))) + (append! (sequence-actions (%sequence-immediate-first expression)) + (sequence-actions (%sequence-immediate-second expression))) (list expression))) (define (sequence-components expression receiver) @@ -83,8 +83,8 @@ USA. (define (copy-sequence expression) (guarantee-sequence expression 'COPY-SEQUENCE) - (%make-sequence (%sequence-first expression) - (%sequence-second expression))) + (%make-sequence (%sequence-immediate-first expression) + (%sequence-immediate-second expression))) ;;;; Conditional diff --git a/src/runtime/unsyn.scm b/src/runtime/unsyn.scm index e7f3cedd3..5dfa1c85e 100644 --- a/src/runtime/unsyn.scm +++ b/src/runtime/unsyn.scm @@ -385,10 +385,10 @@ USA. (define (unsyntax-lambda-body-sequence body) (if (sequence? body) - (let ((first-action (sequence-first body))) + (let ((first-action (sequence-immediate-first body))) (if (block-declaration? first-action) `((DECLARE ,@(block-declaration-text first-action)) - ,@(unsyntax-sequence (sequence-second body))) + ,@(unsyntax-sequence (sequence-immediate-second body))) (unsyntax-sequence body))) (list (unsyntax-object body)))) -- 2.25.1