adding SRFI-0 cond-expand

This commit is contained in:
Alex Shinn 2009-12-16 20:15:45 +09:00
parent e0c4d1d5bf
commit 9d44cbd99a
6 changed files with 39 additions and 7 deletions

View file

@ -81,6 +81,7 @@ INCLUDES = include/chibi/sexp.h include/chibi/config.h include/chibi/install.h
include/chibi/install.h: Makefile
echo '#define sexp_so_extension "'$(SO)'"' > $@
echo '#define sexp_module_dir "'$(MODDIR)'"' >> $@
echo '#define sexp_platform "'$(PLATFORM)'"' >> $@
sexp.o: sexp.c gc.c opt/bignum.c $(INCLUDES) Makefile
$(CC) -c $(XCPPFLAGS) $(XCFLAGS) $(CLIBFLAGS) -o $@ $<

12
TODO
View file

@ -79,12 +79,14 @@
- State "DONE" [2009-10-13 Tue 14:38]
** DONE shared library includes
- State "DONE" [2009-12-08 Tue 14:39]
** TODO only/except/rename/prefix modifiers
** DONE only/except/rename/prefix modifiers
- State "DONE" [2009-12-16 Wed 18:57]
** TODO scheme-complete.el support
** TODO access individual modules from repl
* core modules
** TODO SRFI-0 cond-expand
** DONE SRFI-0 cond-expand
- State "DONE" [2009-12-16 Wed 20:12]
** DONE SRFI-9 define-record-type
- State "DONE" [2009-12-08 Tue 14:50]
** DONE SRFI-69 hash-tables
@ -95,8 +97,10 @@
- State "DONE" [2009-12-08 Tue 14:54]
** TODO network interface
** TODO posix interface
** TODO pathname library
** TODO uri library
** DONE pathname library
- State "DONE" [2009-12-16 Wed 18:58]
** DONE uri library
- State "DONE" [2009-12-16 Wed 18:58]
** TODO http library
** TODO show (formatting) library
** TODO zip library

View file

@ -124,7 +124,7 @@
mod))
(define-syntax define-module
(rsc-macro-transformer
(er-macro-transformer
(lambda (expr env)
(let ((name (cadr expr))
(body (cddr expr)))
@ -141,7 +141,7 @@
(set! *this-module* tmp))))))
(define-syntax define-config-primitive
(rsc-macro-transformer
(er-macro-transformer
(lambda (expr env)
`(define-syntax ,(cadr expr)
(er-macro-transformer
@ -198,5 +198,8 @@
(set! *modules*
(list (cons '(scheme) (make-module exports
(interaction-environment)
(list (cons 'export exports)))))))
(list (cons 'export exports))))
(cons '(srfi 0) (make-module (list 'cond-expand)
(interaction-environment)
(list (list 'export 'cond-expand)))))))

3
eval.c
View file

@ -2373,6 +2373,9 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
sexp_c_string(ctx, sexp_module_dir, -1));
sexp_env_define(ctx, e, sexp_intern(ctx, "*shared-object-extension*"),
sexp_c_string(ctx, sexp_so_extension, -1));
tmp = sexp_list1(ctx, sym=sexp_intern(ctx, sexp_platform));
sexp_push(ctx, tmp, sym=sexp_intern(ctx, "chibi"));
sexp_env_define(ctx, e, sexp_intern(ctx, "*features*"), tmp);
sexp_gc_release4(ctx);
return e;
}

View file

@ -674,6 +674,7 @@ enum sexp_context_globals {
#endif
SEXP_G_OOM_ERROR, /* out of memory exception object */
SEXP_G_OOS_ERROR, /* out of stack exception object */
SEXP_G_OPTIMIZATIONS,
SEXP_G_QUOTE_SYMBOL,
SEXP_G_QUASIQUOTE_SYMBOL,
SEXP_G_UNQUOTE_SYMBOL,

View file

@ -771,3 +771,23 @@
',(cdr mod+imps))
res))
(error "couldn't find module" (car ls))))))))))
;; SRFI-0
(define-syntax cond-expand
(er-macro-transformer
(lambda (expr rename compare)
(define (check x)
(if (pair? x)
(case (car x)
((and) (every check (cdr x)))
((or) (any check (cdr x)))
((not) (not (check (cadr x))))
(else (error "cond-expand: bad feature" x)))
(memq (identifier->symbol x) (cons 'else *features*))))
(let expand ((ls (cdr expr)))
(cond ((null? ls) (error "cond-expand: no expansions" (cdr expr)))
((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls)))
((check (caar ls)) `(,(rename 'begin) ,@(cdar ls)))
(else (expand (cdr ls))))))))