43 lines
1.2 KiB
Scheme
43 lines
1.2 KiB
Scheme
|
; Copyright (c) 1994 by Richard Kelsey. See file COPYING.
|
||
|
|
|
||
|
|
|
||
|
|
(define-c-generator make-record #t
|
||
|
|
(lambda (args)
|
||
|
|
(bug "no eval method for MAKE-RECORD"))
|
||
|
|
(lambda (call depth)
|
||
|
|
(reconstruct-make-record call depth))
|
||
|
|
(lambda (call port indent)
|
||
|
|
(let ((type (node-type call)))
|
||
|
|
(write-c-coercion type port)
|
||
|
|
(format port "malloc(sizeof(")
|
||
|
|
(display-c-type (pointer-type-to type) #f port)
|
||
|
|
(format port ") * ")
|
||
|
|
(c-value (call-arg call 0) port)
|
||
|
|
(format port ")"))))
|
||
|
|
|
||
|
|
(define (reconstruct-make-record call depth)
|
||
|
|
(let* ((args (call-exp-args call))
|
||
|
|
(arg-types (call-arg-types (cdr args) depth))
|
||
|
|
(record-type (quote-exp-value (car args)))
|
||
|
|
(type (record-type-type record-type))
|
||
|
|
(maker-type (record-type-maker-type record-type)))
|
||
|
|
(unify! maker-type (make-arrow-type arg-types type))
|
||
|
|
type))
|
||
|
|
|
||
|
|
(define-c-scheme-primop make-record
|
||
|
|
'allocate
|
||
|
|
(lambda (call)
|
||
|
|
(record-type-type (literal-value (node-ref call 0))))
|
||
|
|
default-simplifier)
|
||
|
|
|
||
|
|
(define-scheme-primop record-ref
|
||
|
|
'read
|
||
|
|
(lambda (call)
|
||
|
|
(record-slot-type (literal-value (node-ref call 0))))
|
||
|
|
default-simplifier)
|
||
|
|
|
||
|
|
(define-scheme-primop record-set!
|
||
|
|
'write
|
||
|
|
(lambda (call) type/unit)
|
||
|
|
default-simplifier)
|