47 lines
1.7 KiB
Scheme
47 lines
1.7 KiB
Scheme
; Copyright (c) 1994 by Richard Kelsey. See file COPYING.
|
|
|
|
|
|
(define-complex-primitive (make-record symbol?)
|
|
(lambda (type)
|
|
(bug "no evaluator for MAKE-RECORD"))
|
|
(lambda (args node depth return?)
|
|
(let ((type-id (cadr (node-form (car args)))))
|
|
(make-pointer-type (get-record-type type-id))))
|
|
#f ; no closed form
|
|
(lambda (args type)
|
|
(make-primop-call-node (get-prescheme-primop 'make-record) args type)))
|
|
|
|
(define-complex-primitive (record-ref any? ; no RECORD? available
|
|
symbol? symbol?)
|
|
(lambda (thing type field)
|
|
(bug "no evaluator for RECORD-REF"))
|
|
(lambda (args node depth return?)
|
|
(let ((type-id (cadr (node-form (cadr args))))
|
|
(field-id (cadr (node-form (caddr args)))))
|
|
(let ((record-type (make-pointer-type (get-record-type type-id)))
|
|
(field-type (record-field-type
|
|
(get-record-type-field type-id field-id))))
|
|
(check-arg-type args 0 record-type depth node)
|
|
field-type)))
|
|
#f ; no closed form
|
|
(lambda (args type)
|
|
(make-primop-call-node (get-prescheme-primop 'record-ref) args type)))
|
|
|
|
(define-complex-primitive (record-set! any? ; no RECORD? available
|
|
any? symbol? symbol?)
|
|
(lambda (thing value type field)
|
|
(bug "no evaluator for RECORD-SET!"))
|
|
(lambda (args node depth return?)
|
|
(let ((type-id (cadr (node-form (caddr args))))
|
|
(field-id (cadr (node-form (cadddr args)))))
|
|
(let ((record-type (make-pointer-type (get-record-type type-id)))
|
|
(field-type (record-field-type
|
|
(get-record-type-field type-id field-id))))
|
|
(check-arg-type args 0 record-type depth node)
|
|
(check-arg-type args 1 field-type depth node)
|
|
type/unit)))
|
|
#f ; no closed form
|
|
(lambda (args type)
|
|
(make-primop-call-node (get-prescheme-primop 'record-set!) args type)))
|
|
|