Compile macros as the macro_type

This commit is contained in:
Justin Ethier 2015-08-11 22:50:30 -04:00
parent 894dc6b6d2
commit e69c21eb16
2 changed files with 24 additions and 13 deletions

View file

@ -182,6 +182,8 @@
"\");\n" "\");\n"
))) )))
(define (st:->var trace)
(cdr trace))
;; END st helpers ;; END st helpers
;;; Compilation routines. ;;; Compilation routines.
@ -987,6 +989,7 @@
(closure->fv exp))) ; Note these are not necessarily symbols, but in cc form (closure->fv exp))) ; Note these are not necessarily symbols, but in cc form
(cv-name (mangle (gensym 'c))) (cv-name (mangle (gensym 'c)))
(lid (allocate-lambda (c-compile-lambda lam trace))) (lid (allocate-lambda (c-compile-lambda lam trace)))
(macro? (assoc (st:->var trace) (get-macros)))
(create-nclosure (lambda () (create-nclosure (lambda ()
(string-append (string-append
"closureN_type " cv-name ";\n" "closureN_type " cv-name ";\n"
@ -1005,18 +1008,26 @@
(car vars) ";\n" (car vars) ";\n"
(loop (+ i 1) (cdr vars)))))))) (loop (+ i 1) (cdr vars))))))))
(create-mclosure (lambda () (create-mclosure (lambda ()
(string-append (let ((prefix
"mclosure" (number->string (length free-vars)) "(" cv-name ", " (if macro?
;; NOTE: "mmacro"
;; Hopefully will not cause issues with varargs when casting to (string-append
;; generic function type below. Works fine in gcc, not sure if "mclosure"
;; this is portable to other compilers though (number->string (length free-vars))))))
"(function_type)__lambda_" (number->string lid) (string-append
(if (> (length free-vars) 0) "," "") prefix
(string-join free-vars ", ") "(" cv-name ", "
");" ;; NOTE:
cv-name ".num_args = " (number->string (compute-num-args lam)) ";" ;; Hopefully will not cause issues with varargs when casting to
)))) ;; generic function type below. Works fine in gcc, not sure if
;; this is portable to other compilers though
"(function_type)__lambda_" (number->string lid)
(if (> (length free-vars) 0) "," "")
(string-join free-vars ", ")
");"
cv-name ".num_args = " (number->string (compute-num-args lam)) ";"
)))))
;(trace:info (list 'JAE-DEBUG trace macro?))
(c-code/vars (c-code/vars
(string-append "&" cv-name) (string-append "&" cv-name)
(list (list

View file

@ -47,4 +47,4 @@
(define x 1) (define x 1)
(write x) (write x)
(write (write
(eval 'x)) (eval '(or 1 2 x)))