From: Guillermo J. Rozas Date: Fri, 15 Sep 1989 17:18:08 +0000 (+0000) Subject: Fix bug in 1d-table/alist, and add 1d-table/for-each. X-Git-Tag: 20090517-FFI~11799 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ebfbee4da2a801af6d3fd62a9e205ae067101673;p=mit-scheme.git Fix bug in 1d-table/alist, and add 1d-table/for-each. --- diff --git a/v7/src/runtime/prop1d.scm b/v7/src/runtime/prop1d.scm index ea832f293..7f3260437 100644 --- a/v7/src/runtime/prop1d.scm +++ b/v7/src/runtime/prop1d.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/prop1d.scm,v 14.3 1989/06/06 22:28:51 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/prop1d.scm,v 14.4 1989/09/15 17:16:35 jinx Rel $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -142,4 +142,21 @@ MIT in each case. |# (loop previous next result)) (loop alist next - (cons (cons key (system-pair-cdr entry)) result)))))))) \ No newline at end of file + (cons (cons (and (not (eq? key false-key)) key) + (system-pair-cdr entry)) + result)))))))) + +(define (1d-table/for-each proc table) + (let loop ((previous table) (alist (cdr table))) + (if (not (null? alist)) + (let ((entry (car alist)) + (next (cdr alist))) + (let ((key (system-pair-car entry))) + (if key + (begin + (proc (and (not (eq? key false-key)) key) + (system-pair-cdr entry)) + (loop alist next)) + (begin + (set-cdr! previous next) + (loop previous next)))))))) \ No newline at end of file diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index 12d60334f..9918bd271 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.56 1989/08/18 19:15:16 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.57 1989/09/15 17:18:08 jinx Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -45,7 +45,7 @@ MIT in each case. |# '())) (add-system! microcode-system) (add-event-receiver! event:after-restore snarf-microcode-version!) - (add-identification! "Runtime" 14 56)) + (add-identification! "Runtime" 14 57)) (define microcode-system) (define (snarf-microcode-version!)