#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syerly.scm,v 1.7 1988/08/31 06:40:22 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syerly.scm,v 1.8 1991/10/30 20:48:53 cph Exp $
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
((CONS*)
(apply cons* (map scode/unquasiquote operands)))
((APPEND)
- (mapcan (lambda (component)
- (if (scode/constant? component)
- (scode/constant-value component)
- (list (list 'UNQUOTE-SPLICING component))))
- operands))
+ (append-map (lambda (component)
+ (if (scode/constant? component)
+ (scode/constant-value component)
+ (list (list 'UNQUOTE-SPLICING component))))
+ operands))
(else (list 'UNQUOTE exp))))
(cond ((eq? operator cons)
;; integrations
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/constr.scm,v 1.1 1989/04/26 05:11:06 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/constr.scm,v 1.2 1991/10/30 20:49:47 cph Exp $
-Copyright (c) 1989 Massachusetts Institute of Technology
+Copyright (c) 1989-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
elements
(begin
(mark! node)
- (update! node (safe-mapcan transitively-close*! elements))
+ (update! node (append-map transitively-close*! elements))
(select node))))))
-
-(define-integrable (safe-mapcan procedure list)
- (mapcan (lambda (item) (list-copy (procedure item))) list))
\f
(define (order-per-constraints elements constraint-graph)
(order-per-constraints/extracted
(with-new-node-marks
(lambda ()
- (mapcan doit entry-nodes))))
+ (append-map! doit entry-nodes))))
(define *constraint-generation*)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/param.scm,v 1.2 1989/10/26 07:36:59 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/param.scm,v 1.3 1991/10/30 20:50:56 cph Exp $
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(append (block-children block) (block-disowned-children block))))
(if (null? children)
(list block)
- (cons block (mapcan linearize-block-tree children)))))
+ (cons block (append-map! linearize-block-tree children)))))
(define (interesting-variable? variable)
;;; variables that will be in cells are eliminated from
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 4.28 1991/07/25 02:34:19 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 4.29 1991/10/30 20:52:36 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
(define (setup-source-nodes!)
(let ((filenames
- (mapcan (lambda (subdirectory)
- (map (lambda (pathname)
- (string-append subdirectory
- "/"
- (pathname-name pathname)))
- (directory-read
- (string-append subdirectory
- "/"
- source-file-expression))))
- '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
- "machines/bobcat"))))
+ (append-map!
+ (lambda (subdirectory)
+ (map (lambda (pathname)
+ (string-append subdirectory
+ "/"
+ (pathname-name pathname)))
+ (directory-read
+ (string-append subdirectory
+ "/"
+ source-file-expression))))
+ '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
+ "machines/bobcat"))))
(if (null? filenames)
(error "Can't find source files of compiler"))
(set! source-filenames filenames))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/inerly.scm,v 1.6 1988/08/31 06:00:59 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/inerly.scm,v 1.7 1991/10/30 20:53:14 cph Exp $
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(define (make-ea-transformer #!optional modes keywords)
(make-database-transformer
- (mapcan (lambda (rule)
- (apply
- (lambda (pattern variables categories expression)
- (if (and (or (default-object? modes)
- (eq-subset? modes categories))
- (or (default-object? keywords)
- (not (memq (car pattern) keywords))))
- (list (early-make-rule pattern variables expression))
- '()))
- rule))
- early-ea-database)))
+ (append-map! (lambda (rule)
+ (apply
+ (lambda (pattern variables categories expression)
+ (if (and (or (default-object? modes)
+ (eq-subset? modes categories))
+ (or (default-object? keywords)
+ (not (memq (car pattern) keywords))))
+ (list (early-make-rule pattern variables expression))
+ '()))
+ rule))
+ early-ea-database)))
(define (eq-subset? s1 s2)
(or (null? s1)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/decls.scm,v 1.3 1991/07/25 02:40:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/decls.scm,v 1.4 1991/10/30 20:56:59 cph Exp $
$MC68020-Header: decls.scm,v 4.27 90/05/03 15:17:08 GMT jinx Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
(define (setup-source-nodes!)
(let ((filenames
- (mapcan (lambda (subdirectory)
- (map (lambda (pathname)
- (string-append subdirectory
- "/"
- (pathname-name pathname)))
- (directory-read
- (string-append subdirectory
- "/"
- source-file-expression))))
- '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
- "machines/mips"))))
+ (append-map!
+ (lambda (subdirectory)
+ (map (lambda (pathname)
+ (string-append subdirectory
+ "/"
+ (pathname-name pathname)))
+ (directory-read
+ (string-append subdirectory
+ "/"
+ source-file-expression))))
+ '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
+ "machines/mips"))))
(if (null? filenames)
(error "Can't find source files of compiler"))
(set! source-filenames filenames))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/decls.scm,v 4.28 1991/07/25 02:35:19 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/decls.scm,v 4.29 1991/10/30 20:51:43 cph Exp $
$MC68020-Header: decls.scm,v 4.27 90/05/03 15:17:08 GMT jinx Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
(define (setup-source-nodes!)
(let ((filenames
- (mapcan (lambda (subdirectory)
- (map (lambda (pathname)
- (string-append subdirectory
- "/"
- (pathname-name pathname)))
- (directory-read
- (string-append subdirectory
- "/"
- source-file-expression))))
- '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
- "machines/spectrum"))))
+ (append-map!
+ (lambda (subdirectory)
+ (map (lambda (pathname)
+ (string-append subdirectory
+ "/"
+ (pathname-name pathname)))
+ (directory-read
+ (string-append subdirectory
+ "/"
+ source-file-expression))))
+ '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
+ "machines/spectrum"))))
(if (null? filenames)
(error "Can't find source files of compiler"))
(set! source-filenames filenames))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/decls.scm,v 4.6 1991/07/25 02:38:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/decls.scm,v 4.7 1991/10/30 20:54:22 cph Exp $
$MC68020-Header: decls.scm,v 4.27 90/05/03 15:17:08 GMT jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
(define (setup-source-nodes!)
(let ((filenames
- (mapcan (lambda (subdirectory)
- (map (lambda (pathname)
- (string-append subdirectory
- "/"
- (pathname-name pathname)))
- (directory-read
- (string-append subdirectory
- "/"
- source-file-expression))))
- '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
- "machines/vax"))))
+ (append-map!
+ (lambda (subdirectory)
+ (map (lambda (pathname)
+ (string-append subdirectory
+ "/"
+ (pathname-name pathname)))
+ (directory-read
+ (string-append subdirectory
+ "/"
+ source-file-expression))))
+ '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
+ "machines/vax"))))
(if (null? filenames)
(error "Can't find source files of compiler"))
(set! source-filenames filenames))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/inerly.scm,v 1.5 1989/05/17 20:29:02 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/inerly.scm,v 1.6 1991/10/30 20:53:57 cph Exp $
$MC68020-Header: inerly.scm,v 1.6 88/08/31 06:00:59 GMT cph Exp $
-Copyright (c) 1987, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(define (make-ea-transformer category type)
type ; ignored
(make-database-transformer
- (mapcan (lambda (rule)
- (apply
- (lambda (pattern variables categories expression)
- (if (memq category categories)
- (list (early-make-rule pattern variables expression))
- '()))
- rule))
- early-ea-database)))
+ (append-map! (lambda (rule)
+ (apply
+ (lambda (pattern variables categories expression)
+ (if (memq category categories)
+ (list (early-make-rule pattern variables expression))
+ '()))
+ rule))
+ early-ea-database)))
\f
;;;; Early effective address assembly.
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/anfile.scm,v 1.4 1990/10/05 11:36:32 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/anfile.scm,v 1.5 1991/10/30 20:59:06 cph Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(cond ((comment? expression)
(process-top-level (comment-expression expression)))
((sequence? expression)
- (mapcan process-top-level (sequence-actions expression)))
+ (append-map! process-top-level (sequence-actions expression)))
(else
(list expression))))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/object.scm,v 1.3 1990/10/04 10:21:24 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/object.scm,v 1.4 1991/10/30 20:58:35 cph Exp $
-Copyright (c) 1988, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(define (make-package name file-cases initialization parent)
(let ((files
- (mapcan (lambda (file-case)
- (mapcan (lambda (clause) (list-copy (cdr clause)))
- (cdr file-case)))
- file-cases)))
+ (append-map! (lambda (file-case)
+ (append-map cdr (cdr file-case)))
+ file-cases)))
(%make-package name
file-cases
files
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/defstr.scm,v 14.17 1991/04/08 22:26:18 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/defstr.scm,v 14.18 1991/10/30 21:00:11 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
`(ACCESS ,name #F))
(define (accessor-definitions structure)
- (mapcan (lambda (slot)
- (let ((accessor-name
- (if (structure/conc-name structure)
- (symbol-append (structure/conc-name structure)
- (slot/name slot))
- (slot/name slot))))
- (if (eq? (structure/scheme-type structure) 'RECORD)
- `((DECLARE (INTEGRATE-OPERATOR ,accessor-name))
- (DEFINE ,accessor-name
- (,(absolute 'RECORD-ACCESSOR)
- ,(structure/type structure)
- ',(slot/name slot))))
- `((DECLARE (INTEGRATE-OPERATOR ,accessor-name))
- (DEFINE (,accessor-name STRUCTURE)
- (DECLARE (INTEGRATE STRUCTURE))
- ,(case (structure/scheme-type structure)
- ((VECTOR)
- `(,(absolute 'VECTOR-REF)
- STRUCTURE
- ,(slot/index slot)))
- ((LIST)
- `(,(absolute 'LIST-REF)
- STRUCTURE
- ,(slot/index slot)))
- (error "Unknown scheme type" structure)))))))
- (structure/slots structure)))
+ (append-map! (lambda (slot)
+ (let ((accessor-name
+ (if (structure/conc-name structure)
+ (symbol-append (structure/conc-name structure)
+ (slot/name slot))
+ (slot/name slot))))
+ (if (eq? (structure/scheme-type structure) 'RECORD)
+ `((DECLARE (INTEGRATE-OPERATOR ,accessor-name))
+ (DEFINE ,accessor-name
+ (,(absolute 'RECORD-ACCESSOR)
+ ,(structure/type structure)
+ ',(slot/name slot))))
+ `((DECLARE (INTEGRATE-OPERATOR ,accessor-name))
+ (DEFINE (,accessor-name STRUCTURE)
+ (DECLARE (INTEGRATE STRUCTURE))
+ ,(case (structure/scheme-type structure)
+ ((VECTOR)
+ `(,(absolute 'VECTOR-REF)
+ STRUCTURE
+ ,(slot/index slot)))
+ ((LIST)
+ `(,(absolute 'LIST-REF)
+ STRUCTURE
+ ,(slot/index slot)))
+ (error "Unknown scheme type" structure)))))))
+ (structure/slots structure)))
\f
(define (settor-definitions structure)
- (mapcan (lambda (slot)
- (if (slot/read-only? slot)
- '()
- (let ((settor-name
- (if (structure/conc-name structure)
- (symbol-append 'SET-
- (structure/conc-name structure)
- (slot/name slot)
- '!)
- (symbol-append 'SET-
- (slot/name slot)
- '!))))
- (if (eq? (structure/scheme-type structure) 'RECORD)
- `((DECLARE (INTEGRATE-OPERATOR ,settor-name))
- (DEFINE ,settor-name
- (,(absolute 'RECORD-UPDATER)
- ,(structure/type structure)
- ',(slot/name slot))))
- `((DECLARE (INTEGRATE-OPERATOR ,settor-name))
- (DEFINE (,settor-name STRUCTURE VALUE)
- (DECLARE (INTEGRATE STRUCTURE VALUE))
- ,(case (structure/scheme-type structure)
- ((VECTOR)
- `(,(absolute 'VECTOR-SET!) STRUCTURE
- ,(slot/index slot)
- VALUE))
- ((LIST)
- `(,(absolute 'SET-CAR!)
- (,(absolute 'LIST-TAIL) STRUCTURE
- ,(slot/index slot))
- VALUE))
- (else
- (error "Unknown scheme type" structure)))))))))
- (structure/slots structure)))
+ (append-map!
+ (lambda (slot)
+ (if (slot/read-only? slot)
+ '()
+ (let ((settor-name
+ (if (structure/conc-name structure)
+ (symbol-append 'SET-
+ (structure/conc-name structure)
+ (slot/name slot)
+ '!)
+ (symbol-append 'SET-
+ (slot/name slot)
+ '!))))
+ (if (eq? (structure/scheme-type structure) 'RECORD)
+ `((DECLARE (INTEGRATE-OPERATOR ,settor-name))
+ (DEFINE ,settor-name
+ (,(absolute 'RECORD-UPDATER)
+ ,(structure/type structure)
+ ',(slot/name slot))))
+ `((DECLARE (INTEGRATE-OPERATOR ,settor-name))
+ (DEFINE (,settor-name STRUCTURE VALUE)
+ (DECLARE (INTEGRATE STRUCTURE VALUE))
+ ,(case (structure/scheme-type structure)
+ ((VECTOR)
+ `(,(absolute 'VECTOR-SET!) STRUCTURE
+ ,(slot/index slot)
+ VALUE))
+ ((LIST)
+ `(,(absolute 'SET-CAR!)
+ (,(absolute 'LIST-TAIL) STRUCTURE
+ ,(slot/index slot))
+ VALUE))
+ (else
+ (error "Unknown scheme type" structure)))))))))
+ (structure/slots structure)))
\f
(define (constructor-definitions structure)
`(,@(map (lambda (boa-constructor)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/pardec.scm,v 4.4 1991/10/01 21:38:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/pardec.scm,v 4.5 1991/10/30 21:01:22 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
(map procedure (declarations/after declarations))))
(define (declarations/integrated-variables declarations)
- (mapcan (lambda (binding)
- (if (and (eq? 'INTEGRATE (binding/operation binding))
- (eq? 'NO-VALUES (binding/values binding)))
- (list-copy (binding/names binding))
- '()))
- (declarations/after declarations)))
+ (append-map (lambda (binding)
+ (if (and (eq? 'INTEGRATE (binding/operation binding))
+ (eq? 'NO-VALUES (binding/values binding)))
+ (binding/names binding)
+ '()))
+ (declarations/after declarations)))
(define-structure (declarations
(type vector)
(intern-type (vector-ref extern 2)
(vector-ref extern 3)))))
table
- (mapcan read-externs-file
- (mapcan specification->pathnames specifications)))))
+ (append-map! read-externs-file
+ (append-map! specification->pathnames specifications)))))
(define (specification->pathnames specification)
(let ((value
projects / mit-scheme.git / commitdiff