Adding include and include-ci to (scheme base).

The cwd is undefined - these macros are useless.

lib/scheme/base.sld

@@ -25,7 +25,8 @@
    error-object-irritants error-object-message error-object?  even?
    exact exact-integer-sqrt exact-integer?  exact?  expt features floor
    flush-output-port for-each gcd get-output-bytevector get-output-string
-   guard if import inexact inexact?  input-port?  integer->char
+   guard if import include include-ci inexact inexact?  input-port?
+   integer->char
    integer?  lambda lcm length let let* let*-values let-syntax let-values
    letrec letrec* letrec-syntax list list->string list->vector list-copy
    list-ref list-set!  list-tail list?  make-bytevector make-list

lib/scheme/extras.scm

@@ -1,4 +1,28 @@
 
+(define (read-sexps file . o)
+  (let ((in (open-input-file file)))
+    (if (and (pair? o) (car o))
+        (set-port-fold-case! in #t))
+    (let lp ((res '()))
+      (let ((x (read in)))
+        (if (eof-object? x) res (lp (cons x res)))))))
+
+(define-syntax include
+  (er-macro-transformer
+   (lambda (expr rename compare)
+     (let lp ((files (cdr expr)) (res '()))
+       (cond
+        ((null? files) (cons (rename 'begin) (reverse res)))
+        (else (lp (cdr files) (append (read-sexps (car files)) res))))))))
+
+(define-syntax include-ci
+  (er-macro-transformer
+   (lambda (expr rename compare)
+     (let lp ((files (cdr expr)) (res '()))
+       (cond
+        ((null? files) (cons (rename 'begin) (reverse res)))
+        (else (lp (cdr files) (append (read-sexps (car files) #t) res))))))))
+
 (define (features) *features*)
 
 (define exact inexact->exact)