From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Sat, 29 Apr 1995 01:05:08 +0000 (+0000)
Subject: Tidying.
X-Git-Tag: 20090517-FFI~6376
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=cc9518551544ffda47e6ecee38170a745aa98cc0;p=mit-scheme.git
Tidying.
---
diff --git a/v8/src/compiler/midend/lamlift.scm b/v8/src/compiler/midend/lamlift.scm
index a4a6ad2e8..b12a43442 100644
--- a/v8/src/compiler/midend/lamlift.scm
+++ b/v8/src/compiler/midend/lamlift.scm
@@ -1,8 +1,8 @@
#| -*-Scheme-*-
-$Id: lamlift.scm,v 1.5 1995/03/11 16:01:01 adams Exp $
+$Id: lamlift.scm,v 1.6 1995/04/29 01:02:49 adams Exp $
-Copyright (c) 1994 Massachusetts Institute of Technology
+Copyright (c) 1994-1995 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
@@ -128,7 +128,7 @@ MIT in each case. |#
(let ((bindings* (lamlift/bindings env* env bindings)))
(set-lamlift/env/split?! env* 'UNNECESSARY)
`(CALL ,rator*
- ,@(lmap cadr bindings*))))))))
+ ,@(map cadr bindings*))))))))
(else
`(CALL ,(lamlift/expr env rator)
,(lamlift/expr env cont)
@@ -169,9 +169,9 @@ MIT in each case. |#
(illegal expr))))
(define (lamlift/expr* env exprs)
- (lmap (lambda (expr)
- (lamlift/expr env expr))
- exprs))
+ (map (lambda (expr)
+ (lamlift/expr env expr))
+ exprs))
(define (lamlift/remember new old)
(code-rewrite/remember new old))
@@ -303,20 +303,20 @@ MIT in each case. |#
binding)))))
(define (lamlift/renames env names)
- (lmap (lambda (name)
- (cons name
- (if (not (lamlift/bound? env name))
- name
- (variable/rename name))))
- names))
+ (map (lambda (name)
+ (cons name
+ (if (not (lamlift/bound? env name))
+ name
+ (variable/rename name))))
+ names))
(define (lamlift/rename-lambda-list lambda-list pairs)
- (lmap (lambda (token)
- (let ((pair (assq token pairs)))
- (if (not pair)
- token
- (cdr pair))))
- lambda-list))
+ (map (lambda (token)
+ (let ((pair (assq token pairs)))
+ (if (not pair)
+ token
+ (cdr pair))))
+ lambda-list))
(define (lamlift/bound? env name)
(let loop ((env env))
@@ -330,7 +330,7 @@ MIT in each case. |#
(lamlift/env/context outer-env)
bindings)
outer-env
- (lmap car bindings)))
+ (map car bindings)))
(expr* `(,keyword
,(lamlift/bindings
inner-env
@@ -341,18 +341,18 @@ MIT in each case. |#
expr*))
(define (lamlift/bindings binding-env body-env bindings)
- (lmap (lambda (binding)
- (let ((name (car binding))
- (value (cadr binding)))
- (list
- name
- (if (not (LAMBDA/? value))
- (lamlift/expr body-env value)
- (call-with-values
- (lambda ()
- (lamlift/lambda** 'DYNAMIC ; bindings are dynamic
- body-env
- value))
+ (map (lambda (binding)
+ (let ((name (car binding))
+ (value (cadr binding)))
+ (list
+ name
+ (if (not (LAMBDA/? value))
+ (lamlift/expr body-env value)
+ (call-with-values
+ (lambda ()
+ (lamlift/lambda** 'DYNAMIC ; bindings are dynamic
+ body-env
+ value))
(lambda (value* lambda-body-env)
(let ((binding
(or (lamlift/binding/find
@@ -361,7 +361,7 @@ MIT in each case. |#
(set-lamlift/env/binding! lambda-body-env binding)
(set-lamlift/binding/value! binding lambda-body-env)
value*)))))))
- bindings))
+ bindings))
(define (lamlift/analyze! env)
(lamlift/decide-split! env)
@@ -469,10 +469,10 @@ MIT in each case. |#
(define (lamlift/decide/letrec! letrec-env)
(define (decide-remaining-children! child-bindings-done)
- (let ((children-done (lmap lamlift/binding/value child-bindings-done)))
+ (let ((children-done (map lamlift/binding/value child-bindings-done)))
(for-each (lambda (child)
(lamlift/decide!* (lamlift/env/children child)))
- children-done)
+ children-done)
(lamlift/decide!*
(delq* children-done (lamlift/env/children letrec-env)))))
@@ -494,14 +494,14 @@ MIT in each case. |#
(let ((env* (lamlift/binding/value binding)))
(eq? (lamlift/env/split? env*) 'NO))))))
(for-each
- (lambda (binding)
- (let ((env* (lamlift/binding/value binding)))
- ;; No bindings need be added before lifting this,
- ;; because all free references from a static frame
- ;; are to static variables and hence lexically
- ;; visible after lifting.
- (set-lamlift/env/extended! env* '())))
- splits)
+ (lambda (binding)
+ (let ((env* (lamlift/binding/value binding)))
+ ;; No bindings need be added before lifting this,
+ ;; because all free references from a static frame
+ ;; are to static variables and hence lexically
+ ;; visible after lifting.
+ (set-lamlift/env/extended! env* '())))
+ splits)
(decide-remaining-children! splits)))
(else
(lamlift/decide/letrec!/dynamic-frame letrec-env)
@@ -722,12 +722,12 @@ MIT in each case. |#
;; Should be modified to preserve complete alpha renaming
`(LAMBDA ,orig-lambda-list
(CALL (LOOKUP ,body-lambda-name)
- ,@(lmap (lambda (name)
- (if (or *after-cps-conversion?*
- (not (continuation-variable? name)))
- `(LOOKUP ,name)
- `(QUOTE #F)))
- lifted-lambda-list)))))
+ ,@(map (lambda (name)
+ (if (or *after-cps-conversion?*
+ (not (continuation-variable? name)))
+ `(LOOKUP ,name)
+ `(QUOTE #F)))
+ lifted-lambda-list)))))
(lift-stub?
(or
;; The stub can drift to a static frame, the stub is named,
diff --git a/v8/src/compiler/midend/rtlgen.scm b/v8/src/compiler/midend/rtlgen.scm
index 6aae57832..139a285cb 100644
--- a/v8/src/compiler/midend/rtlgen.scm
+++ b/v8/src/compiler/midend/rtlgen.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: rtlgen.scm,v 1.25 1995/04/27 02:48:47 adams Exp $
+$Id: rtlgen.scm,v 1.26 1995/04/29 01:03:15 adams Exp $
Copyright (c) 1994 Massachusetts Institute of Technology
@@ -1346,7 +1346,7 @@ MIT in each case. |#
(define (rtlgen/let* state bindings body rtlgen/body rtlgen/state/new-env)
(let* ((env (rtlgen/state/env state))
- (rands (rtlgen/expr* state (lmap cadr bindings))))
+ (rands (rtlgen/expr* state (map cadr bindings))))
(rtlgen/body (rtlgen/state/new-env
state
(map* env
diff --git a/v8/src/compiler/midend/staticfy.scm b/v8/src/compiler/midend/staticfy.scm
index ea8194d02..1164a42af 100644
--- a/v8/src/compiler/midend/staticfy.scm
+++ b/v8/src/compiler/midend/staticfy.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: staticfy.scm,v 1.1 1994/11/19 02:04:29 adams Exp $
+$Id: staticfy.scm,v 1.2 1995/04/29 01:05:08 adams Exp $
Copyright (c) 1994 Massachusetts Institute of Technology
@@ -64,11 +64,11 @@ MIT in each case. |#
(define-staticfier LETREC (env bindings body)
(let ((env* (staticfy/bind (staticfy/env/context env)
env
- (lmap car bindings))))
- `(LETREC ,(lmap (lambda (binding)
- (list (car binding)
- (staticfy/expr env* (cadr binding))))
- bindings)
+ (map car bindings))))
+ `(LETREC ,(map (lambda (binding)
+ (list (car binding)
+ (staticfy/expr env* (cadr binding))))
+ bindings)
,(staticfy/expr env* body))))
(define-staticfier QUOTE (env object)
@@ -103,11 +103,11 @@ MIT in each case. |#
(define-staticfier LET (env bindings body)
(if (eq? (staticfy/env/context env) 'DYNAMIC)
- `(LET ,(lmap (lambda (binding)
- (list (car binding)
- (staticfy/expr env (cadr binding))))
- bindings)
- ,(staticfy/expr (staticfy/bind 'DYNAMIC env (lmap car bindings))
+ `(LET ,(map (lambda (binding)
+ (list (car binding)
+ (staticfy/expr env (cadr binding))))
+ bindings)
+ ,(staticfy/expr (staticfy/bind 'DYNAMIC env (map car bindings))
body))
(staticfy/let* staticfy/letify
env
@@ -119,46 +119,46 @@ MIT in each case. |#
(define (staticfy/pseudo-letify rator bindings body)
`(CALL ,(staticfy/remember
- `(LAMBDA (,(car (cadr rator)) ,@(lmap car bindings))
+ `(LAMBDA (,(car (cadr rator)) ,@(map car bindings))
,body)
rator)
(QUOTE #F)
- ,@(lmap cadr bindings)))
+ ,@(map cadr bindings)))
(define (staticfy/let* letify env bindings body)
- (let* ((bindings* (lmap (lambda (binding)
- (list (car binding)
- (staticfy/expr env (cadr binding))))
- bindings))
+ (let* ((bindings* (map (lambda (binding)
+ (list (car binding)
+ (staticfy/expr env (cadr binding))))
+ bindings))
(env* (staticfy/bind (staticfy/env/context env)
env
- (lmap car bindings)))
+ (map car bindings)))
(body* (staticfy/expr env* body)))
(call-with-values
- (lambda ()
- (list-split bindings*
- (lambda (binding*)
- (staticfy/simple? (cadr binding*)))))
- (lambda (simple hairy)
- (if (null? hairy)
- (letify bindings* body*)
- (begin
- (for-each
- (lambda (hairy)
- (let* ((name (car hairy))
- (binding (assq name (staticfy/env/bindings env*))))
- (for-each
- (lambda (ref)
- (form/rewrite!
- ref
- `(CALL (QUOTE ,%static-binding-ref)
- (QUOTE #F)
- (LOOKUP ,name)
- (QUOTE ,name))))
- (cdr binding))))
- hairy)
- (letify
- (lmap (lambda (binding*)
+ (lambda ()
+ (list-split bindings*
+ (lambda (binding*)
+ (staticfy/simple? (cadr binding*)))))
+ (lambda (simple hairy)
+ (if (null? hairy)
+ (letify bindings* body*)
+ (begin
+ (for-each
+ (lambda (hairy)
+ (let* ((name (car hairy))
+ (binding (assq name (staticfy/env/bindings env*))))
+ (for-each
+ (lambda (ref)
+ (form/rewrite!
+ ref
+ `(CALL (QUOTE ,%static-binding-ref)
+ (QUOTE #F)
+ (LOOKUP ,name)
+ (QUOTE ,name))))
+ (cdr binding))))
+ hairy)
+ (letify
+ (map (lambda (binding*)
(if (memq binding* simple)
simple
(let ((name (car binding*)))
@@ -168,10 +168,10 @@ MIT in each case. |#
(QUOTE ,%unassigned)
(QUOTE ,name))))))
bindings*)
- (beginnify
- (append
- (let ((actions*
- (lmap (lambda (hairy)
+ (beginnify
+ (append
+ (let ((actions*
+ (map (lambda (hairy)
(let ((name (car hairy)))
`(CALL (QUOTE ,%static-binding-set!)
(QUOTE #F)
@@ -179,14 +179,14 @@ MIT in each case. |#
,(cadr hairy)
(QUOTE ,name))))
hairy)))
- (case *order-of-argument-evaluation*
- ((ANY LEFT-TO-RIGHT) actions*)
- ((RIGHT-TO_LEFT) (reverse actions*))
- (else
- (configuration-error
- "Unknown order of argument evaluation"
- *order-of-argument-evaluation*))))
- (list body*))))))))))
+ (case *order-of-argument-evaluation*
+ ((ANY LEFT-TO-RIGHT) actions*)
+ ((RIGHT-TO_LEFT) (reverse actions*))
+ (else
+ (configuration-error
+ "Unknown order of argument evaluation"
+ *order-of-argument-evaluation*))))
+ (list body*))))))))))
(define (staticfy/expr env expr)
(if (not (pair? expr))
@@ -217,9 +217,9 @@ MIT in each case. |#
(illegal expr))))
(define (staticfy/expr* env exprs)
- (lmap (lambda (expr)
- (staticfy/expr env expr))
- exprs))
+ (map (lambda (expr)
+ (staticfy/expr env expr))
+ exprs))
(define (staticfy/remember new old)
(code-rewrite/remember new old))
@@ -264,4 +264,4 @@ MIT in each case. |#
(define-integrable (staticfy/bind context env names)
(staticfy/env/make context
env
- (lmap list names)))
\ No newline at end of file
+ (map list names)))
\ No newline at end of file