mes: srfi-9: Guile interface compatibility.
* mes/module/srfi/srfi-9-struct.mes (record-constructor): Remove name argument, make field-names optional. Update users. * mes/module/srfi/srfi-9-vector.mes: Likewise. * mes/module/srfi/srfi-9/gnu-struct.mes: Update.
This commit is contained in:
Jan Nieuwenhuizen
Jan (janneke) Nieuwenhuizen
parent
1f56ef6c33
commit
698598850e
|
|
@ -1,7 +1,7 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
|
|
@ -22,11 +22,11 @@
|
|||
|
||||
;;; srfi-9.mes - records, based on struct.
|
||||
|
||||
(define-macro (define-record-type name constructor+params predicate . fields)
|
||||
(define-macro (define-record-type name constructor+field-names predicate . fields)
|
||||
(let ((type (make-record-type name (map car fields))))
|
||||
`(begin
|
||||
(define ,name ,type)
|
||||
(define ,(car constructor+params) ,(record-constructor type name (cdr constructor+params)))
|
||||
(define ,(car constructor+field-names) ,(record-constructor type (cdr constructor+field-names)))
|
||||
(define ,predicate ,(record-predicate type))
|
||||
(define-record-accessors ,type ,@fields))))
|
||||
|
||||
|
|
@ -43,6 +43,9 @@
|
|||
(define (record-type o)
|
||||
(struct-ref o 2))
|
||||
|
||||
(define (record-field-names o)
|
||||
(struct-ref o 3))
|
||||
|
||||
(define (record-predicate type)
|
||||
(lambda (o)
|
||||
(and (record? o)
|
||||
|
|
@ -52,12 +55,14 @@
|
|||
(and (struct? o)
|
||||
(record-type? (struct-vtable o))))
|
||||
|
||||
(define (record-constructor type name params)
|
||||
(let ((fields (record-fields type))
|
||||
(record-type (record-type type)))
|
||||
(define (record-constructor type . field-names)
|
||||
(let* ((fields (record-field-names type))
|
||||
(name (record-type type))
|
||||
(field-names (if (null? field-names) fields
|
||||
(car field-names))))
|
||||
(lambda (. o)
|
||||
(if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
|
||||
(let ((rest (make-list (- (length fields) (length params)))))
|
||||
(if (not (= (length o) (length field-names))) (error "wrong number of arguments for record-constructor")
|
||||
(let ((rest (make-list (- (length fields) (length field-names)))))
|
||||
(make-struct type (cons name (append o rest)) record-printer))))))
|
||||
|
||||
(define record-printer *unspecified*) ; TODO
|
||||
|
|
@ -65,7 +70,7 @@
|
|||
(display "#<")
|
||||
(display (record-type o))
|
||||
(let* ((vtable (struct-vtable o))
|
||||
(fields (record-fields vtable)))
|
||||
(fields (record-field-names vtable)))
|
||||
(for-each (lambda (field)
|
||||
(display " ")
|
||||
(display field)
|
||||
|
|
@ -74,9 +79,6 @@
|
|||
fields))
|
||||
(display ">"))
|
||||
|
||||
(define (record-fields o)
|
||||
(struct-ref o 3))
|
||||
|
||||
(define-macro (define-record-accessors type . fields)
|
||||
`(begin
|
||||
,@(map (lambda (field)
|
||||
|
|
@ -103,7 +105,7 @@
|
|||
(struct-set! o i v)))))
|
||||
|
||||
(define (record-field-index type field)
|
||||
(+ 3 (or (lst-index (record-fields type) field)
|
||||
(+ 3 (or (lst-index (record-field-names type) field)
|
||||
(error "no such field" type field))))
|
||||
|
||||
(define (lst-index lst o)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
|
|
@ -22,11 +22,11 @@
|
|||
|
||||
;;; srfi-9-vector.mes - records, based on vector
|
||||
|
||||
(define-macro (define-record-type type constructor+params predicate . fields)
|
||||
(define-macro (define-record-type type constructor+field-names predicate . fields)
|
||||
(let ((record (make-record-type type (map car fields))))
|
||||
`(begin
|
||||
(define ,type ,record)
|
||||
(define ,(car constructor+params) ,(record-constructor record (cdr constructor+params)))
|
||||
(define ,(car constructor+field-names) ,(record-constructor record (cdr constructor+field-names)))
|
||||
(define ,predicate ,(record-predicate record))
|
||||
(define-record-accessors ,record ,@fields))))
|
||||
|
||||
|
|
@ -34,25 +34,35 @@
|
|||
(list->vector (list '*record-type* type fields (length fields))))
|
||||
|
||||
(define (record-type? o)
|
||||
(eq? (record-type o) '*record-type*))
|
||||
(eq? (record-type-type o) '*record-type*))
|
||||
|
||||
(define (record? o)
|
||||
(eq? (record-type-type o) '*record*))
|
||||
|
||||
(define (record-type-type o)
|
||||
(vector-ref o 0))
|
||||
|
||||
(define (record-type o)
|
||||
(vector-ref o 0))
|
||||
(vector-ref o 1))
|
||||
|
||||
(define (record-field-names o)
|
||||
(vector-ref o 2))
|
||||
|
||||
(define (record-predicate type)
|
||||
(lambda (o)
|
||||
(and (vector? o)
|
||||
(or (record-type? o)
|
||||
(record? o))
|
||||
(eq? (record-type o) type))))
|
||||
|
||||
(define (record-constructor type params)
|
||||
(let ((fields (record-fields type)))
|
||||
(define (record-constructor type . field-names)
|
||||
(let* ((fields (record-field-names type))
|
||||
(field-names (if (null? field-names) fields
|
||||
(car field-names))))
|
||||
(lambda (. o)
|
||||
(if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
|
||||
(let ((rest (make-list (- (length fields) (length params)))))
|
||||
(list->vector (cons type (append o rest))))))))
|
||||
|
||||
(define (record-fields o)
|
||||
(vector-ref o 2))
|
||||
(if (not (= (length o) (length field-names))) (error "wrong number of arguments for record-constructor")
|
||||
(let ((rest (make-list (- (length fields) (length field-names)))))
|
||||
(list->vector (cons* '*record* type (append o rest))))))))
|
||||
|
||||
(define-macro (define-record-accessors type . fields)
|
||||
`(begin
|
||||
|
|
@ -80,7 +90,7 @@
|
|||
(vector-set! o i v)))))
|
||||
|
||||
(define (record-field-index type field)
|
||||
(1+ (or (lst-index (record-fields type) field)
|
||||
(1+ (or (lst-index (record-field-names type) field)
|
||||
(error "no such field" type field))))
|
||||
|
||||
(define (lst-index lst o)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
|
|
@ -22,8 +22,8 @@
|
|||
|
||||
;;; srfi-9.mes - GNU immutable records.
|
||||
|
||||
(define-macro (define-immutable-record-type type constructor+params predicate . fields)
|
||||
`(define-record-type ,type ,constructor+params ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
|
||||
(define-macro (define-immutable-record-type type constructor+parameters predicate . fields)
|
||||
`(define-record-type ,type ,constructor+parameters ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
|
||||
|
||||
(define-macro (set-field o getters value)
|
||||
`(let ((getter ,(car getters)))
|
||||
|
|
@ -33,6 +33,6 @@
|
|||
(define (field->value field)
|
||||
(if (eq? set field) ,value
|
||||
((record-getter type field) ,o)))
|
||||
(let* ((fields (record-fields type))
|
||||
(let* ((fields (record-field-names type))
|
||||
(values (map field->value fields)))
|
||||
(apply (record-constructor type name fields) values)))))
|
||||
(apply (record-constructor type fields) values)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue