artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

srfi-9 records!

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-24 00:14:40 +02:00
parent 711a29f4f9
commit 28ae662e0e
5 changed files with 33 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lib/record.mes Normal file
View file

@ -0,0 +1,6 @@
(define make-record make-vector)
(define record-set! vector-set!)
(define record? vector?)
(define (record-type x) (vector-ref x 0))
(define record-ref vector-ref)

10
lib/srfi/srfi-9.scm
View file

@ -2,7 +2,7 @@
;; There's no implicit name concatenation, so it can be defined ;; There's no implicit name concatenation, so it can be defined
;; entirely using syntax-rules. Example: ;; entirely using syntax-rules. Example:
;; (define-record-type foo type/foo ;; (define-record-type foo
;; (make-foo x y) ;; (make-foo x y)
;; foo? - predicate name is optional ;; foo? - predicate name is optional
;; (x foo-x) ;; (x foo-x)
@ -13,18 +13,18 @@
(define-syntax define-record-type (define-syntax define-record-type
(syntax-rules () (syntax-rules ()
((define-record-type id type ((define-record-type type
(constructor arg ...) (constructor arg ...)
(field . field-stuff) (field . field-stuff)
...) ...)
(begin (define type (make-record-type 'id '(field ...))) (begin (define type (make-record-type 'type '(field ...)))
(define constructor (record-constructor type '(arg ...))) (define constructor (record-constructor type '(arg ...)))
(define-accessors type (field . field-stuff) ...))) (define-accessors type (field . field-stuff) ...)))
((define-record-type id type ((define-record-type type
(constructor arg ...) (constructor arg ...)
pred pred
more ...) more ...)
(begin (define-record-type id type (begin (define-record-type type
(constructor arg ...) (constructor arg ...)
more ...) more ...)
(define pred (record-predicate type)))))) (define pred (record-predicate type))))))

10
mes.c
View file

@ -835,9 +835,13 @@ display_helper (scm *x, bool cont, char *sep, bool quote)
if (!cont) printf (")"); if (!cont) printf (")");
} }
else if (x->type == VECTOR) { else if (x->type == VECTOR) {
printf ("#[%d](", x->length); printf ("#(", x->length);
// for (int i = 0; i < x->length; i++) for (int i = 0; i < x->length; i++) {
// display_helper (x->vector[i], true, i ? " " : "", false); if (x->vector[i]->type == VECTOR)
printf ("%s#(...)", i ? " " : "");
else
display_helper (x->vector[i], true, i ? " " : "", false);
}
printf (")"); printf (")");
} }
else if (atom_p (x) == &scm_t) printf ("%s", x->name); else if (atom_p (x) == &scm_t) printf ("%s", x->name);

15
record.mes Normal file
View file

@ -0,0 +1,15 @@
(define-record-type lexical-token
(make-lexical-token category source value)
lexical-token?
(category lexical-token-category)
(source lexical-token-source)
(value lexical-token-value))
(define tok (make-lexical-token 'x 'y 'z))
(display "tok?: ")
(display (lexical-token? tok))
(newline)
(display tok)
(newline)

7
syntax.mes
View file

@ -39,8 +39,6 @@
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(display "mes:define-syntax...")
(define-macro (define-syntax macro-name transformer . stuff) (define-macro (define-syntax macro-name transformer . stuff)
`(define-macro (,macro-name . args) `(define-macro (,macro-name . args)
(,transformer (cons ',macro-name args) (,transformer (cons ',macro-name args)
@ -58,11 +56,6 @@
;; ((or e1 e ...) (let ((temp e1)) ;; ((or e1 e ...) (let ((temp e1))
;; (if temp temp (or e ...)))))) ;; (if temp temp (or e ...))))))
(newline)
(display "mes:define-syntax syntax-rules...")
(newline)
(define-syntax syntax-rules (define-syntax syntax-rules
(let () (let ()
(define name? symbol?) (define name? symbol?)