re-implement macro-expansion using new semantic walker
This commit was merged in pull request #9.
This commit is contained in:
12
semen.scm
12
semen.scm
@@ -79,6 +79,15 @@
|
||||
(cons (car module-public-forms)
|
||||
acc))))))
|
||||
|
||||
(define (semen-macro-expand form)
|
||||
"Walk the form recursively and expand all macros, until none is left."
|
||||
(semen-walk-form
|
||||
form
|
||||
(lambda (subform)
|
||||
(if (sex-macro? subform)
|
||||
(apply-macro subform)
|
||||
subform))))
|
||||
|
||||
;;; TODO: for greater inspiration, see SBCL's walk.lisp
|
||||
(define (semen-walk-form form walk-fn)
|
||||
(if (atom? form) form
|
||||
@@ -97,7 +106,8 @@
|
||||
(cons new-car new-cdr)))
|
||||
|
||||
(define (process-fn sex-fn acc)
|
||||
(cons sex-fn acc))
|
||||
(let ((expanded (semen-macro-expand sex-fn)))
|
||||
(cons expanded acc)))
|
||||
|
||||
(define (process-struct sex-struct acc)
|
||||
(cons sex-struct acc))
|
||||
|
||||
@@ -23,12 +23,31 @@
|
||||
(test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn))
|
||||
(test '((return (cast float (+ a b)))) (sex-fn-body sum-fn))
|
||||
|
||||
(define sex-code
|
||||
'((defmacro (sum-var name a b c)
|
||||
`(var ,name ,(+ a b c)))
|
||||
(let ((sex-code
|
||||
'((defmacro (sum-var name a b c)
|
||||
`(var ,name ,(+ a b c)))
|
||||
|
||||
(sum-var v 1 2 3)))
|
||||
(sum-var v 1 2 3))))
|
||||
|
||||
(test '((var v 6)) (semen-process sex-code))
|
||||
(test '((var v 6)) (semen-process sex-code)))
|
||||
|
||||
;;; Macro expansion
|
||||
|
||||
(test 'a (semen-walk-form 'a identity))
|
||||
(test '(a b c) (semen-walk-form '(a b c) identity))
|
||||
|
||||
(test 'a (semen-macro-expand 'a))
|
||||
(test '(a b c) (semen-macro-expand '(a b c)))
|
||||
|
||||
(let ((sex-code-macro
|
||||
'((defmacro (x10 a)
|
||||
`(* 10 ,a))
|
||||
|
||||
(fn void foo ((int a) (int b))
|
||||
(return (+ a (x10 b)))))))
|
||||
|
||||
(test '((fn void foo ((int a) (int b))
|
||||
(return (+ a (* 10 b)))))
|
||||
(semen-process sex-code-macro)))
|
||||
|
||||
(test-end)
|
||||
|
||||
Reference in New Issue
Block a user