From 41e2a28109bc8784f2d3ffc8dae3d2bac4742141 Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Sun, 12 Mar 1995 05:59:29 +0000 Subject: [PATCH] Tidying. --- v8/src/compiler/midend/alpha.scm | 51 ++++++----------- v8/src/compiler/midend/applicat.scm | 86 ++++++++++++----------------- v8/src/compiler/midend/assconv.scm | 70 +++++++++++------------ v8/src/compiler/midend/laterew.scm | 63 +++++++++------------ v8/src/compiler/midend/stackopt.scm | 48 ++++++---------- 5 files changed, 134 insertions(+), 184 deletions(-) diff --git a/v8/src/compiler/midend/alpha.scm b/v8/src/compiler/midend/alpha.scm index debac8d48..8159e5b28 100644 --- a/v8/src/compiler/midend/alpha.scm +++ b/v8/src/compiler/midend/alpha.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: alpha.scm,v 1.5 1995/01/19 04:51:16 adams Exp $ +$Id: alpha.scm,v 1.6 1995/03/12 05:53:10 adams Exp $ Copyright (c) 1988-1994 Massachusetts Institute of Technology @@ -101,7 +101,7 @@ MIT in each case. |# (alphaconv/let-like 'LETREC state env bindings body)) (define (alphaconv/let-like keyword state env bindings body) - (let* ((names (lmap car bindings)) + (let* ((names (map car bindings)) (new-names (alphaconv/renamings env names)) (inner-env (alphaconv/env/extend env names new-names)) (expr-env (if (eq? keyword 'LETREC) inner-env env)) @@ -148,42 +148,27 @@ MIT in each case. |# (illegal expr)) (let ((new-expr (case (car expr) - ((QUOTE) - (alphaconv/quote state env expr)) - ((LOOKUP) - (alphaconv/lookup state env expr)) - ((LAMBDA) - (alphaconv/lambda state env expr)) - ((LET) - (alphaconv/let state env expr)) - ((DECLARE) - (alphaconv/declare state env expr)) - ((CALL) - (alphaconv/call state env expr)) - ((BEGIN) - (alphaconv/begin state env expr)) - ((IF) - (alphaconv/if state env expr)) - ((LETREC) - (alphaconv/letrec state env expr)) - ((SET!) - (alphaconv/set! state env expr)) - ((UNASSIGNED?) - (alphaconv/unassigned? state env expr)) - ((OR) - (alphaconv/or state env expr)) - ((DELAY) - (alphaconv/delay state env expr)) - ((ACCESS DEFINE IN-PACKAGE THE-ENVIRONMENT) - (no-longer-legal expr)) + ((QUOTE) (alphaconv/quote state env expr)) + ((LOOKUP) (alphaconv/lookup state env expr)) + ((LAMBDA) (alphaconv/lambda state env expr)) + ((LET) (alphaconv/let state env expr)) + ((DECLARE) (alphaconv/declare state env expr)) + ((CALL) (alphaconv/call state env expr)) + ((BEGIN) (alphaconv/begin state env expr)) + ((IF) (alphaconv/if state env expr)) + ((LETREC) (alphaconv/letrec state env expr)) + ((SET!) (alphaconv/set! state env expr)) + ((UNASSIGNED?) (alphaconv/unassigned? state env expr)) + ((OR) (alphaconv/or state env expr)) + ((DELAY) (alphaconv/delay state env expr)) (else (illegal expr))))) ((alphaconv/state/remember state) new-expr expr))) (define (alphaconv/expr* state env exprs) - (lmap (lambda (expr) - (alphaconv/expr state env expr)) - exprs)) + (map (lambda (expr) + (alphaconv/expr state env expr)) + exprs)) (define-integrable (alphaconv/remember new old) (code-rewrite/remember new old)) diff --git a/v8/src/compiler/midend/applicat.scm b/v8/src/compiler/midend/applicat.scm index d89ac73e6..9e7d839f7 100644 --- a/v8/src/compiler/midend/applicat.scm +++ b/v8/src/compiler/midend/applicat.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: applicat.scm,v 1.2 1995/02/02 19:35:50 adams Exp $ +$Id: applicat.scm,v 1.3 1995/03/12 05:57:14 adams Exp $ Copyright (c) 1994 Massachusetts Institute of Technology @@ -57,11 +57,11 @@ MIT in each case. |# (define-applicator LAMBDA (env lambda-list body) `(LAMBDA ,lambda-list - ,(applicat/expr (append (lmap (lambda (name) - (list name false)) - (lambda-list->names lambda-list)) - env) - body))) + ,(applicat/expr (append (map (lambda (name) + (list name false)) + (lambda-list->names lambda-list)) + env) + body))) (define-applicator QUOTE (env object) env ; ignored @@ -129,67 +129,53 @@ MIT in each case. |# (default)))) (define-applicator LET (env bindings body) - `(LET ,(lmap (lambda (binding) - (list (car binding) - (applicat/expr env (cadr binding)))) - bindings) + `(LET ,(map (lambda (binding) + (list (car binding) + (applicat/expr env (cadr binding)))) + bindings) ,(applicat/expr - (append (lmap (lambda (binding) - (list (car binding) - (let ((value (cadr binding))) - (and (pair? value) - (eq? (car value) 'LAMBDA))))) - bindings) + (append (map (lambda (binding) + (list (car binding) + (let ((value (cadr binding))) + (LAMBDA/? value)))) + bindings) env) body))) (define-applicator LETREC (env bindings body) (let ((env* - (append (lmap (lambda (binding) - (list (car binding) - (let ((value (cadr binding))) - (and (pair? value) - (eq? (car value) 'LAMBDA))))) - bindings) + (append (map (lambda (binding) + (list (car binding) + (let ((value (cadr binding))) + (LAMBDA/? value)))) + bindings) env))) - `(LETREC ,(lmap (lambda (binding) - (list (car binding) - (applicat/expr env* (cadr binding)))) - bindings) + `(LETREC ,(map (lambda (binding) + (list (car binding) + (applicat/expr env* (cadr binding)))) + bindings) ,(applicat/expr env* body)))) (define (applicat/expr env expr) (if (not (pair? expr)) (illegal expr)) (case (car expr) - ((QUOTE) - (applicat/quote env expr)) - ((LOOKUP) - (applicat/lookup env expr)) - ((LAMBDA) - (applicat/lambda env expr)) - ((LET) - (applicat/let env expr)) - ((DECLARE) - (applicat/declare env expr)) - ((CALL) - (applicat/call env expr)) - ((BEGIN) - (applicat/begin env expr)) - ((IF) - (applicat/if env expr)) - ((LETREC) - (applicat/letrec env expr)) - ((SET! UNASSIGNED? OR DELAY - ACCESS DEFINE IN-PACKAGE THE-ENVIRONMENT) - (no-longer-legal expr)) + ((QUOTE) (applicat/quote env expr)) + ((LOOKUP) (applicat/lookup env expr)) + ((LAMBDA) (applicat/lambda env expr)) + ((LET) (applicat/let env expr)) + ((DECLARE) (applicat/declare env expr)) + ((CALL) (applicat/call env expr)) + ((BEGIN) (applicat/begin env expr)) + ((IF) (applicat/if env expr)) + ((LETREC) (applicat/letrec env expr)) (else (illegal expr)))) (define (applicat/expr* env exprs) - (lmap (lambda (expr) - (applicat/expr env expr)) - exprs)) + (map (lambda (expr) + (applicat/expr env expr)) + exprs)) (define (applicat/remember new old) (code-rewrite/remember new old)) diff --git a/v8/src/compiler/midend/assconv.scm b/v8/src/compiler/midend/assconv.scm index 5d24066d5..cdb0bc290 100644 --- a/v8/src/compiler/midend/assconv.scm +++ b/v8/src/compiler/midend/assconv.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: assconv.scm,v 1.5 1995/02/21 06:20:05 adams Exp $ +$Id: assconv.scm,v 1.6 1995/03/12 05:59:29 adams Exp $ Copyright (c) 1994 Massachusetts Institute of Technology @@ -110,26 +110,26 @@ MIT in each case. |# (lambda (shadowed body*) `(LAMBDA ,(if (null? shadowed) lambda-list - (lmap (lambda (name) - (if (memq name shadowed) - (assconv/new-name 'IGNORED) - name)) - lambda-list)) + (map (lambda (name) + (if (memq name shadowed) + (assconv/new-name 'IGNORED) + name)) + lambda-list)) ,body*)))) (define-assignment-converter LET (env bindings body) (call-with-values (lambda () - (assconv/binding-body env (lmap car bindings) body)) + (assconv/binding-body env (map car bindings) body)) (lambda (shadowed body*) - `(LET ,(lmap (lambda (binding) - (list (car binding) - (assconv/expr env (cadr binding)))) - (if (null? shadowed) - bindings - (list-transform-negative bindings - (lambda (binding) - (memq (car binding) shadowed))))) + `(LET ,(map (lambda (binding) + (list (car binding) + (assconv/expr env (cadr binding)))) + (if (null? shadowed) + bindings + (list-transform-negative bindings + (lambda (binding) + (memq (car binding) shadowed))))) ,body*)))) (define-assignment-converter LOOKUP (env name) @@ -208,9 +208,9 @@ MIT in each case. |# (illegal expr)))) (define (assconv/expr* env exprs) - (lmap (lambda (expr) - (assconv/expr env expr)) - exprs)) + (map (lambda (expr) + (assconv/expr env expr)) + exprs)) (define (assconv/remember new old) (code-rewrite/remember new old) @@ -271,7 +271,7 @@ MIT in each case. |# (define (assconv/binding-body env names body) ;; (values shadowed-names body*) - (let* ((frame (lmap assconv/binding/make names)) + (let* ((frame (map assconv/binding/make names)) (env* (cons frame env)) (body* (assconv/expr env* body)) (assigned @@ -292,7 +292,7 @@ MIT in each case. |# (assconv/single-analyze ssa-candidates body*)) (lambda (let-like letrec-like) (assconv/bind-cells - (lmap assconv/binding/name (append let-like letrec-like)) + (map assconv/binding/name (append let-like letrec-like)) (list-transform-negative assigned (lambda (binding) (or (memq binding let-like) @@ -328,14 +328,14 @@ MIT in each case. |# (for-each assconv/cellify! bindings) (values shadowed-names - `(LET ,(lmap (lambda (binding) - (let ((name (assconv/binding/name binding))) - `(,(assconv/binding/cell-name binding) - (CALL (QUOTE ,%make-cell) - (QUOTE #F) - (LOOKUP ,name) - (QUOTE ,name))))) - bindings) + `(LET ,(map (lambda (binding) + (let ((name (assconv/binding/name binding))) + `(,(assconv/binding/cell-name binding) + (CALL (QUOTE ,%make-cell) + (QUOTE #F) + (LOOKUP ,name) + (QUOTE ,name))))) + bindings) ,body))))) (define (default) @@ -366,9 +366,9 @@ MIT in each case. |# (define (assconv/letify keyword bindings body) `(,keyword - ,(lmap (lambda (binding) - (let* ((ass (car (assconv/binding/assignments binding))) - (value (set!/expr ass))) + ,(map (lambda (binding) + (let* ((ass (car (assconv/binding/assignments binding))) + (value (set!/expr ass))) (form/rewrite! ass `(QUOTE ,%unassigned)) `(,(assconv/binding/name binding) ,value))) bindings) @@ -454,10 +454,10 @@ MIT in each case. |# (if (not (pair? body)) (values '() '()) (let ((single-assignments - (lmap (lambda (binding) - (cons (car (assconv/binding/assignments binding)) - binding)) - ssa-candidates)) + (map (lambda (binding) + (cons (car (assconv/binding/assignments binding)) + binding)) + ssa-candidates)) (finish (lambda (bindings) (values diff --git a/v8/src/compiler/midend/laterew.scm b/v8/src/compiler/midend/laterew.scm index 53ba1c9a5..a769cae70 100644 --- a/v8/src/compiler/midend/laterew.scm +++ b/v8/src/compiler/midend/laterew.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: laterew.scm,v 1.4 1995/02/26 16:28:48 adams Exp $ +$Id: laterew.scm,v 1.5 1995/03/12 05:44:38 adams Exp $ Copyright (c) 1994 Massachusetts Institute of Technology @@ -43,12 +43,12 @@ MIT in each case. |# (define-macro (define-late-rewriter keyword bindings . body) (let ((proc-name (symbol-append 'LATEREW/ keyword))) (call-with-values - (lambda () (%matchup bindings '(handler) '(cdr form))) - (lambda (names code) - `(define ,proc-name - (let ((handler (lambda ,names ,@body))) - (named-lambda (,proc-name form) - (laterew/remember ,code form)))))))) + (lambda () (%matchup bindings '(handler) '(cdr form))) + (lambda (names code) + `(DEFINE ,proc-name + (LET ((HANDLER (LAMBDA ,names ,@body))) + (NAMED-LAMBDA (,proc-name FORM) + (LATEREW/REMEMBER ,code FORM)))))))) (define-late-rewriter LOOKUP (name) `(LOOKUP ,name)) @@ -58,17 +58,17 @@ MIT in each case. |# ,(laterew/expr body))) (define-late-rewriter LET (bindings body) - `(LET ,(lmap (lambda (binding) - (list (car binding) - (laterew/expr (cadr binding)))) - bindings) + `(LET ,(map (lambda (binding) + (list (car binding) + (laterew/expr (cadr binding)))) + bindings) ,(laterew/expr body))) (define-late-rewriter LETREC (bindings body) - `(LETREC ,(lmap (lambda (binding) - (list (car binding) - (laterew/expr (cadr binding)))) - bindings) + `(LETREC ,(map (lambda (binding) + (list (car binding) + (laterew/expr (cadr binding)))) + bindings) ,(laterew/expr body))) (define-late-rewriter QUOTE (object) @@ -99,31 +99,22 @@ MIT in each case. |# (if (not (pair? expr)) (illegal expr)) (case (car expr) - ((QUOTE) - (laterew/quote expr)) - ((LOOKUP) - (laterew/lookup expr)) - ((LAMBDA) - (laterew/lambda expr)) - ((LET) - (laterew/let expr)) - ((DECLARE) - (laterew/declare expr)) - ((CALL) - (laterew/call expr)) - ((BEGIN) - (laterew/begin expr)) - ((IF) - (laterew/if expr)) - ((LETREC) - (laterew/letrec expr)) + ((QUOTE) (laterew/quote expr)) + ((LOOKUP) (laterew/lookup expr)) + ((LAMBDA) (laterew/lambda expr)) + ((LET) (laterew/let expr)) + ((DECLARE) (laterew/declare expr)) + ((CALL) (laterew/call expr)) + ((BEGIN) (laterew/begin expr)) + ((IF) (laterew/if expr)) + ((LETREC) (laterew/letrec expr)) (else (illegal expr)))) (define (laterew/expr* exprs) - (lmap (lambda (expr) - (laterew/expr expr)) - exprs)) + (map (lambda (expr) + (laterew/expr expr)) + exprs)) (define (laterew/remember new old) (code-rewrite/remember new old)) diff --git a/v8/src/compiler/midend/stackopt.scm b/v8/src/compiler/midend/stackopt.scm index 3da2f2e60..33ca45185 100644 --- a/v8/src/compiler/midend/stackopt.scm +++ b/v8/src/compiler/midend/stackopt.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: stackopt.scm,v 1.4 1995/01/20 22:23:42 adams Exp $ +$Id: stackopt.scm,v 1.5 1995/03/12 05:48:16 adams Exp $ Copyright (c) 1994 Massachusetts Institute of Technology @@ -145,17 +145,17 @@ End of Big Note A |# (define-stack-optimizer LET (state bindings body) - `(LET ,(lmap (lambda (binding) - (list (car binding) - (stackopt/expr false (cadr binding)))) - bindings) + `(LET ,(map (lambda (binding) + (list (car binding) + (stackopt/expr false (cadr binding)))) + bindings) ,(stackopt/expr state body))) (define-stack-optimizer LETREC (state bindings body) - `(LETREC ,(lmap (lambda (binding) - (list (car binding) - (stackopt/expr false (cadr binding)))) - bindings) + `(LETREC ,(map (lambda (binding) + (list (car binding) + (stackopt/expr false (cadr binding)))) + bindings) ,(stackopt/expr state body))) (define-stack-optimizer QUOTE (state object) @@ -246,27 +246,15 @@ End of Big Note A |# (if (not (pair? expr)) (illegal expr)) (case (car expr) - ((QUOTE) - (stackopt/quote state expr)) - ((LOOKUP) - (stackopt/lookup state expr)) - ((LAMBDA) - (stackopt/lambda state expr)) - ((LET) - (stackopt/let state expr)) - ((DECLARE) - (stackopt/declare state expr)) - ((CALL) - (stackopt/call state expr)) - ((BEGIN) - (stackopt/begin state expr)) - ((IF) - (stackopt/if state expr)) - ((LETREC) - (stackopt/letrec state expr)) - ((SET! UNASSIGNED? OR DELAY - ACCESS DEFINE IN-PACKAGE THE-ENVIRONMENT) - (no-longer-legal expr)) + ((QUOTE) (stackopt/quote state expr)) + ((LOOKUP) (stackopt/lookup state expr)) + ((LAMBDA) (stackopt/lambda state expr)) + ((LET) (stackopt/let state expr)) + ((DECLARE) (stackopt/declare state expr)) + ((CALL) (stackopt/call state expr)) + ((BEGIN) (stackopt/begin state expr)) + ((IF) (stackopt/if state expr)) + ((LETREC) (stackopt/letrec state expr)) (else (illegal expr)))) -- 2.25.1