conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* $base-rtd is gone.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 22:59:09 -04:00
parent f5acd68e4d
commit c0bf35338d
4 changed files with 7 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

2
src/ikarus.fasl.ss
View File

@ -189,7 +189,7 @@
(make-graph (code-reloc-vector x) h)] (make-graph (code-reloc-vector x) h)]
[(record? x) [(record? x)
(when (eq? x (base-rtd)) (when (eq? x (base-rtd))
(error 'fasl-write "$base-rtd is not writable")) (error 'fasl-write "base-rtd is not writable"))
(let ([rtd (record-type-descriptor x)]) (let ([rtd (record-type-descriptor x)])
(cond (cond
[(eq? rtd (base-rtd)) [(eq? rtd (base-rtd))

12
src/ikarus.records.ss
View File

@ -15,7 +15,7 @@
record-field-accessor record-field-mutator record? record-rtd record-field-accessor record-field-mutator record? record-rtd
record-type-descriptor record-name record-printer record-length record-type-descriptor record-name record-printer record-length
record-ref record-set!) record-ref record-set!)
(only (scheme) $record? $record-rtd $base-rtd $record-ref (only (scheme) $record? $record-rtd $record-ref
$record-set! $record $make-record $car $cdr $fxadd1 $record-set! $record $make-record $car $cdr $fxadd1
$fx< $fx= $fx+ $fx>= $fx< $fx= $fx+ $fx>=
set-top-level-value! top-level-value top-level-bound?)) set-top-level-value! top-level-value top-level-bound?))
@ -25,7 +25,7 @@
(define rtd? (define rtd?
(lambda (x) (lambda (x)
(and ($record? x) (and ($record? x)
(eq? ($record-rtd x) $base-rtd)))) (eq? ($record-rtd x) (base-rtd)))))
(define rtd-name (define rtd-name
(lambda (rtd) (lambda (rtd)
@ -69,7 +69,7 @@
(define make-rtd (define make-rtd
(lambda (name fields printer symbol) (lambda (name fields printer symbol)
($record $base-rtd name (length fields) fields printer symbol))) ($record (base-rtd) name (length fields) fields printer symbol)))
(define verify-field (define verify-field
(lambda (x) (lambda (x)
@ -254,9 +254,9 @@
(error 'record-set! "index ~s is out of range for ~s" i x)) (error 'record-set! "index ~s is out of range for ~s" i x))
($record-set! x i v)))) ($record-set! x i v))))
(set-rtd-fields! $base-rtd '(name fields length printer symbol)) (set-rtd-fields! (base-rtd) '(name fields length printer symbol))
(set-rtd-name! $base-rtd "base-rtd") (set-rtd-name! (base-rtd) "base-rtd")
(set-rtd-printer! $base-rtd (set-rtd-printer! (base-rtd)
(lambda (x p) (lambda (x p)
(unless (rtd? x) (unless (rtd? x)
(error 'record-type-printer "not an rtd")) (error 'record-type-printer "not an rtd"))

2
src/makefile.ss
View File

@ -457,7 +457,6 @@
[record-ref s i] [record-ref s i]
[record-field-accessor s i] [record-field-accessor s i]
[record-field-mutator s i] [record-field-mutator s i]
[$base-rtd s ]
[$record-set! s ] [$record-set! s ]
[$record-ref s ] [$record-ref s ]
[$record-rtd s ] [$record-rtd s ]
@ -919,7 +918,6 @@
[record-field-accessor record-field-accessor-label (core-prim . record-field-accessor)] [record-field-accessor record-field-accessor-label (core-prim . record-field-accessor)]
[record-field-mutator record-field-mutator-label (core-prim . record-field-mutator)] [record-field-mutator record-field-mutator-label (core-prim . record-field-mutator)]
;;; records/low-level ;;; records/low-level
[$base-rtd $base-rtd-label (core-prim . $base-rtd)]
[$record-set! $record-set!-label (core-prim . $record-set!)] [$record-set! $record-set!-label (core-prim . $record-set!)]
[$record-ref $record-ref-label (core-prim . $record-ref)] [$record-ref $record-ref-label (core-prim . $record-ref)]
[$record-rtd $record-rtd-label (core-prim . $record-rtd)] [$record-rtd $record-rtd-label (core-prim . $record-rtd)]