This commit is contained in:
Justin Ethier 2018-11-21 19:08:45 -05:00
parent 03b2dd7181
commit 7a1b28db37

View file

@ -450,6 +450,9 @@
(define (c-compile-vector exp use-alloca) (define (c-compile-vector exp use-alloca)
(letrec ((cvar-name (mangle (gensym 'vec))) (letrec ((cvar-name (mangle (gensym 'vec)))
(len (vector-length exp)) (len (vector-length exp))
(addr-op (if use-alloca "" "&"))
(deref-op (if use-alloca "->" "."))
(c-make-macro (if use-alloca "alloca_empty_vector" "make_empty_vector"))
;; Generate code for each member of the vector ;; Generate code for each member of the vector
(loop (loop
(lambda (i code) (lambda (i code)
@ -467,26 +470,26 @@
(c:allocs idx-code) ;; Member alloc at index i (c:allocs idx-code) ;; Member alloc at index i
(list ;; Assign this member to vector (list ;; Assign this member to vector
(string-append (string-append
cvar-name ".elements[" (number->string i) "] = " cvar-name deref-op "elements[" (number->string i) "] = "
(c:body idx-code) (c:body idx-code)
";"))))))))) ";")))))))))
) )
(cond (cond
((zero? len) ((zero? len)
(c-code/vars (c-code/vars
(string-append "&" cvar-name) ; Code is just the variable name (string-append addr-op cvar-name) ; Code is just the variable name
(list ; Allocate empty vector (list ; Allocate empty vector
(string-append (string-append
"make_empty_vector(" cvar-name ");")))) c-make-macro "(" cvar-name ");"))))
(else (else
(let ((code (let ((code
(c-code/vars (c-code/vars
(string-append "&" cvar-name) ; Code body is just var name (string-append addr-op cvar-name) ; Code body is just var name
(list ; Allocate the vector (list ; Allocate the vector
(string-append (string-append
"make_empty_vector(" cvar-name ");" c-make-macro "(" cvar-name ");"
cvar-name ".num_elements = " (number->string len) ";" cvar-name deref-op "num_elements = " (number->string len) ";"
cvar-name ".elements = (object *)alloca(sizeof(object) * " cvar-name deref-op "elements = (object *)alloca(sizeof(object) * "
(number->string len) ");"))))) (number->string len) ");")))))
(loop 0 code)))))) (loop 0 code))))))
@ -590,8 +593,7 @@
;; TODO: use-alloc support ;; TODO: use-alloc support
(c-compile-scalars exp use-alloca)) (c-compile-scalars exp use-alloca))
((vector? exp) ((vector? exp)
;; TODO: use-alloc support (c-compile-vector exp #t)) ;;use-alloca))
(c-compile-vector exp use-alloca))
((bytevector? exp) ((bytevector? exp)
(c-compile-bytevector exp use-alloca)) (c-compile-bytevector exp use-alloca))
((bignum? exp) ((bignum? exp)