Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-06 12:46:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added quasi-quote macro from chibi

Browse source
This commit is contained in:
Justin Ethier 2015-03-26 16:42:25 -04:00
parent b578e13509
commit 111b279b96
1 changed files with 31 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
trans.scm
View file

@ -287,6 +287,37 @@
`(,(rename 'begin) ,@(cdar ls))))
((check (caar ls)) `(,(rename 'begin) ,@(cdar ls)))
(else (expand (cdr ls)))))))
(cons 'quasiquote
;; Based on the quasiquote macro from Chibi scheme
(lambda (expr rename compare)
(define (qq x d)
(cond
((pair? x)
(cond
((compare (rename 'unquote) (car x))
(if (<= d 0)
(cadr x)
(list (rename 'list) (list (rename 'quote) 'unquote)
(qq (cadr x) (- d 1)))))
((compare (rename 'unquote-splicing) (car x))
(if (<= d 0)
(list (rename 'cons) (qq (car x) d) (qq (cdr x) d))
(list (rename 'list) (list (rename 'quote) 'unquote-splicing)
(qq (cadr x) (- d 1)))))
((compare (rename 'quasiquote) (car x))
(list (rename 'list) (list (rename 'quote) 'quasiquote)
(qq (cadr x) (+ d 1))))
((and (<= d 0) (pair? (car x))
(compare (rename 'unquote-splicing) (caar x)))
(if (null? (cdr x))
(cadr (car x))
(list (rename 'append) (cadr (car x)) (qq (cdr x) d))))
(else
(list (rename 'cons) (qq (car x) d) (qq (cdr x) d)))))
((vector? x) (list (rename 'list->vector) (qq (vector->list x) d)))
((if (symbol? x) #t (null? x)) (list (rename 'quote) x))
(else x)))
(qq (cadr expr) 0)))
))