mes: srfi-9: Guile interface compliancy.
* tests/srfi-9.test: Convert to bootstrap test, do not use mes-use-module. * mes/module/srfi/srfi-9-vector.mes: Resurrect.
This commit is contained in:
parent
e8c81f283b
commit
18df035abc
|
@ -34,15 +34,19 @@
|
|||
(list->vector (list '*record-type* type fields (length fields))))
|
||||
|
||||
(define (record-type? o)
|
||||
(eq? (record-type-type o) '*record-type*))
|
||||
(eq? (record-type-descriptor o) '*record-type*))
|
||||
|
||||
(define (struct-vtable o)
|
||||
(record-type-descriptor o))
|
||||
|
||||
(define (record? o)
|
||||
(eq? (record-type-type o) '*record*))
|
||||
(and (vector? o)
|
||||
(record-type? (record-type-descriptor o))))
|
||||
|
||||
(define (record-type-type o)
|
||||
(define (record-type-descriptor o)
|
||||
(vector-ref o 0))
|
||||
|
||||
(define (record-type o)
|
||||
(define (record-type-name o)
|
||||
(vector-ref o 1))
|
||||
|
||||
(define (record-type-fields o)
|
||||
|
@ -52,17 +56,16 @@
|
|||
(lambda (o)
|
||||
(and (vector? o)
|
||||
(or (record-type? o)
|
||||
(record? o))
|
||||
(eq? (record-type o) type))))
|
||||
(record? o)))))
|
||||
|
||||
(define (record-constructor type . field-names)
|
||||
(define (record-constructor type . type-fields)
|
||||
(let* ((fields (record-type-fields type))
|
||||
(field-names (if (null? field-names) fields
|
||||
(car field-names))))
|
||||
(type-fields (if (null? type-fields) fields
|
||||
(car type-fields))))
|
||||
(lambda (. o)
|
||||
(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))))))))
|
||||
(if (not (= (length o) (length type-fields))) (error "wrong number of arguments for record-constructor")
|
||||
(let ((rest (make-list (- (length fields) (length type-fields)))))
|
||||
(list->vector (cons* type (append o rest))))))))
|
||||
|
||||
(define-macro (define-record-accessors type . fields)
|
||||
`(begin
|
||||
|
@ -79,14 +82,14 @@
|
|||
(define (record-accessor type field)
|
||||
(let ((i (record-field-index type field)))
|
||||
(lambda (o . field?)
|
||||
(if (not (eq? (record-type o) type)) (error "record accessor: record expected" type o)
|
||||
(if (not (eq? (record-type-descriptor o) type)) (error "record accessor: record expected" type o)
|
||||
(if (pair? field?) field
|
||||
(vector-ref o i))))))
|
||||
|
||||
(define (record-modifier type field)
|
||||
(let ((i (record-field-index type field)))
|
||||
(lambda (o v)
|
||||
(if (not (eq? (record-type o) type)) (error "record modifier: record expected" type o)
|
||||
(if (not (eq? (record-type-descriptor o) type)) (error "record modifier: record expected" type o)
|
||||
(vector-set! o i v)))))
|
||||
|
||||
(define (record-field-index type field)
|
||||
|
|
|
@ -27,11 +27,11 @@
|
|||
|
||||
(define-macro (set-field o getters value)
|
||||
`(let ((getter ,(car getters)))
|
||||
(let ((type (record-type ,o))
|
||||
(let ((type (record-type-descriptor ,o))
|
||||
(set (getter ,o #t)))
|
||||
(define (field->value field)
|
||||
(if (eq? set field) ,value
|
||||
((record-getter type field) ,o)))
|
||||
(let* ((fields (record-fields type))
|
||||
((record-accessor type field) ,o)))
|
||||
(let* ((fields (record-type-fields type))
|
||||
(values (map field->value fields)))
|
||||
(apply (record-constructor type fields) values)))))
|
||||
|
|
|
@ -1,12 +1,16 @@
|
|||
#! /bin/sh
|
||||
# -*-scheme-*-
|
||||
# bootstrap srfi-9
|
||||
if [ "$MES" != guile ]; then
|
||||
MES_BOOT=boot-03.scm exec ${MES-bin/mes} < $0
|
||||
fi
|
||||
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-9)' -s "$0" "$@"
|
||||
!#
|
||||
|
||||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2016,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
|
@ -31,6 +35,15 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
|
|||
|
||||
(cond-expand
|
||||
(mes
|
||||
;; bootstrap test
|
||||
(primitive-load "module/mes/test.scm")
|
||||
(primitive-load "mes/module/srfi/srfi-9-struct.mes")
|
||||
(primitive-load "mes/module/srfi/srfi-9/gnu-struct.mes")
|
||||
(define-macro (mes-use-module . rest) #t)
|
||||
|
||||
;; (primitive-load "mes/module/srfi/srfi-9-vector.mes")
|
||||
;; (primitive-load "mes/module/srfi/srfi-9/gnu-vector.mes")
|
||||
|
||||
(mes-use-module (srfi srfi-9))
|
||||
(mes-use-module (srfi srfi-9 gnu))
|
||||
(mes-use-module (mes test)))
|
||||
|
|
Loading…
Reference in New Issue