1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
; Copyright (c) 1993-2008 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)
|
