mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-04 19:56:34 +02:00
Added (record?)
This commit is contained in:
parent
9e5c1d963e
commit
fc6647fbb3
4 changed files with 19 additions and 6 deletions
|
@ -22,6 +22,8 @@
|
||||||
(let ((k (kons 1 2)))
|
(let ((k (kons 1 2)))
|
||||||
(set-kar! k 3)
|
(set-kar! k 3)
|
||||||
(kar k)) ;=. 3
|
(kar k)) ;=. 3
|
||||||
|
(record? (kons 1 2))
|
||||||
|
(record? (cons 1 2))
|
||||||
))
|
))
|
||||||
|
|
||||||
;(define <pare> (register-simple-type <pare> #f (quote (x y))))
|
;(define <pare> (register-simple-type <pare> #f (quote (x y))))
|
||||||
|
|
|
@ -182,9 +182,17 @@
|
||||||
; open-input-string
|
; open-input-string
|
||||||
; open-output-string
|
; open-output-string
|
||||||
;
|
;
|
||||||
; for a lot of the following, need begin-splicing, or syntax-rules
|
; ;; no binary/text ports yet
|
||||||
; binary-port?
|
; binary-port?
|
||||||
|
; textual-port?
|
||||||
|
;
|
||||||
|
; ;; syntax-rules
|
||||||
|
; syntax-error
|
||||||
|
; syntax-rules
|
||||||
|
; parameterize
|
||||||
; define-values
|
; define-values
|
||||||
|
;
|
||||||
|
; for a lot of the following, need begin-splicing, or syntax-rules
|
||||||
; guard
|
; guard
|
||||||
; import
|
; import
|
||||||
; include
|
; include
|
||||||
|
@ -193,11 +201,6 @@
|
||||||
; let-values
|
; let-values
|
||||||
; letrec*
|
; letrec*
|
||||||
; letrec-syntax
|
; letrec-syntax
|
||||||
; parameterize
|
|
||||||
; record?
|
|
||||||
; syntax-error
|
|
||||||
; syntax-rules
|
|
||||||
; textual-port?
|
|
||||||
;;;;
|
;;;;
|
||||||
)
|
)
|
||||||
(begin
|
(begin
|
||||||
|
|
|
@ -4,6 +4,7 @@
|
||||||
;;; This is based on the implementation of SRFI 9 from chibi scheme
|
;;; This is based on the implementation of SRFI 9 from chibi scheme
|
||||||
(define-library (srfi 9)
|
(define-library (srfi 9)
|
||||||
(export
|
(export
|
||||||
|
record?
|
||||||
define-record-type
|
define-record-type
|
||||||
register-simple-type
|
register-simple-type
|
||||||
make-type-predicate
|
make-type-predicate
|
||||||
|
@ -51,6 +52,11 @@
|
||||||
(lambda (obj val)
|
(lambda (obj val)
|
||||||
(vector-set! (vector-ref obj 2) idx val)))
|
(vector-set! (vector-ref obj 2) idx val)))
|
||||||
|
|
||||||
|
(define (record? obj)
|
||||||
|
(and (vector? obj)
|
||||||
|
(> (vector-length obj) 0)
|
||||||
|
(equal? record-marker (vector-ref obj 0))))
|
||||||
|
|
||||||
(define-syntax define-record-type
|
(define-syntax define-record-type
|
||||||
(er-macro-transformer
|
(er-macro-transformer
|
||||||
(lambda (expr rename compare)
|
(lambda (expr rename compare)
|
||||||
|
|
|
@ -336,6 +336,8 @@
|
||||||
(set-kar! k 3)
|
(set-kar! k 3)
|
||||||
(kar k))
|
(kar k))
|
||||||
3)
|
3)
|
||||||
|
(assert:equal "Record type predicate (t)" (record? (kons 1 2)) #t)
|
||||||
|
(assert:equal "Record type predicate (f)" (record? (cons 1 2)) #f)
|
||||||
;; END records
|
;; END records
|
||||||
|
|
||||||
; TODO: use display, output without surrounding quotes
|
; TODO: use display, output without surrounding quotes
|
||||||
|
|
Loading…
Add table
Reference in a new issue