From f5b0e0f1faa23724d7e618d8ddd90b9e24572e26 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 10 Nov 2019 10:32:16 +0100 Subject: [PATCH] mes: srfi-9: Guile interface compliancy. * 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. --- mes/module/srfi/srfi-9-struct.mes | 28 +++++++++++--------- mes/module/srfi/srfi-9-vector.mes | 38 +++++++++++++++++---------- mes/module/srfi/srfi-9/gnu-struct.mes | 10 +++---- 3 files changed, 44 insertions(+), 32 deletions(-) diff --git a/mes/module/srfi/srfi-9-struct.mes b/mes/module/srfi/srfi-9-struct.mes index 0f509203..0d4f50da 100644 --- a/mes/module/srfi/srfi-9-struct.mes +++ b/mes/module/srfi/srfi-9-struct.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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) diff --git a/mes/module/srfi/srfi-9-vector.mes b/mes/module/srfi/srfi-9-vector.mes index f9b436ef..205c9d6a 100644 --- a/mes/module/srfi/srfi-9-vector.mes +++ b/mes/module/srfi/srfi-9-vector.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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) diff --git a/mes/module/srfi/srfi-9/gnu-struct.mes b/mes/module/srfi/srfi-9/gnu-struct.mes index aacfc4d1..a8d97fb2 100644 --- a/mes/module/srfi/srfi-9/gnu-struct.mes +++ b/mes/module/srfi/srfi-9/gnu-struct.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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)))))