adding SRFI-0 cond-expand

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 $@ $<

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
+** DONE pathname library
-** TODO uri 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

config.scm

@@ -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)))))))
 

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;
 }

include/chibi/sexp.h

@@ -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,

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))))))))
+