Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-19 05:39:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Compile macros as the macro_type

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

35
scheme/cyclone/cgen.sld
View file

@ -182,6 +182,8 @@
"\");\n"
)))
(define (st:->var trace)
(cdr trace))
;; END st helpers
;;; Compilation routines.
@ -987,6 +989,7 @@
(closure->fv exp))) ; Note these are not necessarily symbols, but in cc form
(cv-name (mangle (gensym 'c)))
(lid (allocate-lambda (c-compile-lambda lam trace)))
(macro? (assoc (st:->var trace) (get-macros)))
(create-nclosure (lambda ()
(string-append
"closureN_type " cv-name ";\n"
@ -1005,18 +1008,26 @@
(car vars) ";\n"
(loop (+ i 1) (cdr vars))))))))
(create-mclosure (lambda ()
(string-append
"mclosure" (number->string (length free-vars)) "(" cv-name ", "
;; NOTE:
;; 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)) ";"
))))
(let ((prefix
(if macro?
"mmacro"
(string-append
"mclosure"
(number->string (length free-vars))))))
(string-append
prefix
"(" cv-name ", "
;; NOTE:
;; 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
(string-append "&" cv-name)
(list

2
test2.scm
View file

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