Bug fixes for listing inlinables

This commit is contained in:
Justin Ethier 2017-04-17 16:59:41 +00:00
parent 3fbdbb2e72
commit 396888f1b8

View file

@ -1333,9 +1333,8 @@
(cond (cond
((not program?) ((not program?)
(emit* "void c_" (lib:name->string lib-name) "_inlinable_lambdas(void *data, int argc, closure cont, object value){ ") (emit* "void c_" (lib:name->string lib-name) "_inlinable_lambdas(void *data, int argc, closure cont, object value){ ")
(emit* "make_pair(head, NULL, NULL);")
(let ((pairs '()) (let ((pairs '())
(head-pair "NULL")) (head-pair #f))
(for-each (for-each
(lambda (g) (lambda (g)
(let ((cvar-sym (mangle (gensym 'cvar))) (let ((cvar-sym (mangle (gensym 'cvar)))
@ -1346,13 +1345,33 @@
(emits* (emits*
"make_pair(" pair-sym ", find_or_add_symbol(\"" (symbol->string g) "make_pair(" pair-sym ", find_or_add_symbol(\"" (symbol->string g)
"\"), &" cvar-sym ");\n") "\"), &" cvar-sym ");\n")
(set! pairs (cons pair-sym pairs)) (set! pairs (cons pair-sym pairs))))
(set! head-pair pair-sym)
))
*global-inlines*) *global-inlines*)
;; TODO: need to link the pairs ;; Link the pairs
(emit* "car(&head) = &" head-pair ";") (let loop ((code '())
(emit* "(((closure)cont)->fn)(data, 1, cont, &head);") (ps pairs)
(cs (map (lambda (_) (mangle (gensym 'c))) pairs)))
(cond
((null? ps)
(for-each
(lambda (str)
(emits str))
code))
((null? (cdr ps))
(if (not head-pair)
(set! head-pair (car cs)))
(loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", NULL);\n") code)
(cdr ps)
(cdr cs)))
(else
(if (not head-pair)
(set! head-pair (car cs)))
(loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", &" (cadr cs) ");\n") code)
(cdr ps)
(cdr cs)))))
(if head-pair
(emit* "(((closure)cont)->fn)(data, 1, cont, &" head-pair ");")
(emit* "(((closure)cont)->fn)(data, 1, cont, NULL);"))
(emit* " } ")) (emit* " } "))
)) ))