Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Constant-folding symbol->keyword* in chibi.

Browse source
This commit is contained in:
Alex Shinn 2014-07-16 23:09:59 +09:00
parent 931233a844
commit 536f9bfa90
2 changed files with 27 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lib/chibi/optional.scm
View file

@ -101,11 +101,6 @@
(define (symbol->keyword sym) (define (symbol->keyword sym)
(string->symbol (string-append (symbol->string sym) ":"))) (string->symbol (string-append (symbol->string sym) ":")))
(define-syntax symbol->keyword*
(syntax-rules ()
((symbol->keyword* sym)
(string->symbol (string-append (symbol->string sym) ":")))))
(define-syntax let-key*-to-let (define-syntax let-key*-to-let
(syntax-rules () (syntax-rules ()
((let-key*-to-let ls (vars ...) ((v d) . rest) . body) ((let-key*-to-let ls (vars ...) ((v d) . rest) . body)
@ -182,6 +177,13 @@
;;> \scheme{let*} equivalent to \scheme{let-keywords*}. Any required ;;> \scheme{let*} equivalent to \scheme{let-keywords*}. Any required
;;> \var{default} values are evaluated in left-to-right order, with ;;> \var{default} values are evaluated in left-to-right order, with
;;> all preceding \var{var}s in scope. ;;> all preceding \var{var}s in scope.
;;>
;;> \emph{Example:}
;;> \example{
;;> (let-keywords* '(b: 5)
;;> ((a 1) (b (* a 2)) (c (* b 3)))
;;> (list a b c))
;;> }
(define-syntax let-keywords* (define-syntax let-keywords*
(syntax-rules () (syntax-rules ()

22
lib/chibi/optional.sld
View file

@ -4,7 +4,20 @@
let-keywords let-keywords* keyword-ref keyword-ref*) let-keywords let-keywords* keyword-ref keyword-ref*)
(cond-expand (cond-expand
(chibi (chibi
(import (chibi))) (import (chibi))
(begin
(define-syntax symbol->keyword*
(er-macro-transformer
(lambda (expr rename compare)
(if (and (pair? (cdr expr)) (pair? (cadr expr))
(compare 'quote (car (cadr expr))))
`(,(rename 'quote)
,(string->symbol
(string-append
(symbol->string
(identifier->symbol (cadr (cadr expr)))) ":")))
`(string->symbol
(string-append (symbol->string ,(cadr expr)) ":"))))))))
(else (else
(import (scheme base)) (import (scheme base))
(begin (begin
@ -20,5 +33,10 @@
(tmp2 (if (pair? tmp) (cdr tmp) '()))) (tmp2 (if (pair? tmp) (cdr tmp) '())))
(let-optionals* tmp2 rest . body))) (let-optionals* tmp2 rest . body)))
((let-optionals* tmp tail . body) ((let-optionals* tmp tail . body)
(let ((tail tmp)) . body))))))) (let ((tail tmp)) . body))))
(define-syntax symbol->keyword*
(syntax-rules ()
((symbol->keyword* sym)
(string->symbol (string-append (symbol->string sym) ":")))
)))))
(include "optional.scm")) (include "optional.scm"))