diff --git a/prelude.scm b/prelude.scm index 1e356f5..52dfe0c 100644 --- a/prelude.scm +++ b/prelude.scm @@ -65,16 +65,19 @@ (define-macro (define-record-type name constructor pred . fields) (let ([c-fields (cdr constructor)] [c (car constructor)]) (let* ([nf (map (λ (filed) - (cons (first filed) (cons (gensym) (second filed)))) - fields)] + (cons (first filed) (cons (gensym) (second filed)))) + fields)] [f-hash (make-immutable-hash nf)]) `(begin - (RECORDz - ,pred ,c ,@(map (λ (c-f) (car (hash-ref f-hash c-f))) c-fields)) - ,@(map (λ (nfe) - (let ([p (cdr nfe)]) - `(define ,(cdr p) ,(car p)))) nf) - )))) + (RECORDz + ,pred ,c ,@(map (λ (c-f) (car (hash-ref f-hash c-f))) c-fields)) + ,@(map (λ (nfe) + (let ([p (cdr nfe)]) + `(define (,(cdr p) x) + (if (,pred x) + ,(car p) + (error ,(string-append (symbol->string (cdr p)) ": isn't a " (symbol->string name)) x) + )))) nf))))) (define-record-type error-object (error-object message irritants) error-object?