Author: yamakenz
Date: Mon Apr 28 15:03:46 2008
New Revision: 5460
Modified:
trunk/scm/init.scm
trunk/scm/light-record.scm
trunk/scm/util.scm
trunk/test/test-util.scm
Log:
* This commit replace the legacy define-record implementation
with the light-record based one
* scm/light-record.scm
- (define-record): Fix broken macro expansion
* scm/util.scm
- (define-record): Removed
* scm/init.scm
- Require light-record.scm as temporary workaround
* test/test-util.scm
- Update passed revision record. All tests including
define-record are passed
Modified: trunk/scm/init.scm
==============================================================================
--- trunk/scm/init.scm (original)
+++ trunk/scm/init.scm Mon Apr 28 15:03:46 2008
@@ -114,6 +114,11 @@
(if (not (retrieve-im 'direct))
(require-module "direct"))))
+;; FIXME: Temporary workaround to resolve circular dependency of
+;; util.scm and light-record.scm. Record users should explicitly
+;; require light-record.scm. -- YamaKen 2008-04-29
+(require "light-record.scm")
+
(require "plugin.scm")
(require "custom-rt.scm")
(require "key.scm")
Modified: trunk/scm/light-record.scm
==============================================================================
--- trunk/scm/light-record.scm (original)
+++ trunk/scm/light-record.scm Mon Apr 28 15:03:46 2008
@@ -235,7 +235,7 @@
;; (e.g. (list-ref spec 2) and so on may be used)
(define define-record
(lambda (rec-name fld-specs)
- (eval `(define-list-record ,rec-name ,fld-specs)
+ (eval `(define-list-record ,rec-name ',fld-specs)
(interaction-environment))
(let ((constructor-name (make-record-constructor-name rec-name))
(legacy-constructor-name (symbol-append rec-name %HYPHEN-SYM 'new)))
Modified: trunk/scm/util.scm
==============================================================================
--- trunk/scm/util.scm (original)
+++ trunk/scm/util.scm Mon Apr 28 15:03:46 2008
@@ -218,51 +218,6 @@
(definition (list 'lambda args body)))
(eval definition another-env))))
-;; See test/test-util.scm to know what define-record does.
-;; rec-spec requires list of list rather than alist to keep
-;; extensibility (e.g. (nth 2 spec) and so on may be used)
-(define define-record
- (lambda (rec-sym rec-spec)
- (for-each (lambda (spec index)
- (let* ((elem-sym (list-ref spec 0))
- (default (list-ref spec 1))
- (getter-sym (symbol-append rec-sym hyphen-sym elem-sym))
- (getter (lambda (rec)
- (list-ref rec index)))
- (setter-sym (symbol-append
- rec-sym hyphen-sym 'set- elem-sym '!))
- (setter (lambda (rec val)
- (set-car! (list-tail rec index)
- val))))
- (eval (list 'define getter-sym getter)
- (interaction-environment))
- (eval (list 'define setter-sym setter)
- (interaction-environment))))
- rec-spec
- (iota (length rec-spec)))
- (let ((creator-sym (symbol-append rec-sym hyphen-sym 'new))
- (creator (let ((defaults (map cadr rec-spec)))
- (lambda init-lst
- (cond
- ((null? init-lst)
- (list-copy defaults))
- ;; fast path
- ((= (length init-lst)
- (length defaults))
- (list-copy init-lst))
- ;; others
- ((< (length init-lst)
- (length defaults))
- (let* ((rest-defaults (list-tail defaults
- (length init-lst)))
- (complemented-init-lst (append init-lst
- rest-defaults)))
- (list-copy complemented-init-lst)))
- (else
- #f))))))
- (eval (list 'define creator-sym creator)
- (interaction-environment)))))
-
;; for direct candidate selection
(define number->candidate-index
(lambda (n)
Modified: trunk/test/test-util.scm
==============================================================================
--- trunk/test/test-util.scm (original)
+++ trunk/test/test-util.scm Mon Apr 28 15:03:46 2008
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; These tests are passed at revision 5329 (new repository)
+;; These tests are passed at revision 5460 (new repository)
(use test.unit)
