mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-07 05:06:37 +02:00
adding SRFI-0 cond-expand
This commit is contained in:
parent
e0c4d1d5bf
commit
9d44cbd99a
6 changed files with 39 additions and 7 deletions
1
Makefile
1
Makefile
|
@ -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
12
TODO
|
@ -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
|
||||
|
|
|
@ -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
3
eval.c
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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,
|
||||
|
|
20
init.scm
20
init.scm
|
@ -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))))))))
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue