- removed include and include-into from (ikarus) library

- moved include and include/lexical-context to their own 
  (ikarus include) library (source only, not in boot image).

lib/Makefile.am

@@ -1,5 +1,5 @@
 libikarusdir=$(pkglibdir)/ikarus
-dist_libikarus_DATA=ikarus/foreign.ss ikarus/ipc.ss
+dist_libikarus_DATA=ikarus/foreign.ss ikarus/ipc.ss ikarus/include.ss
 libCocoadir=$(pkglibdir)/Cocoa
 dist_libCocoa_DATA=Cocoa/helpers.ss
 

lib/Makefile.in

@@ -162,7 +162,7 @@ top_build_prefix = @top_build_prefix@
 top_builddir = @top_builddir@
 top_srcdir = @top_srcdir@
 libikarusdir = $(pkglibdir)/ikarus
-dist_libikarus_DATA = ikarus/foreign.ss ikarus/ipc.ss
+dist_libikarus_DATA = ikarus/foreign.ss ikarus/ipc.ss ikarus/include.ss
 libCocoadir = $(pkglibdir)/Cocoa
 dist_libCocoa_DATA = Cocoa/helpers.ss
 dist_pkglib_DATA = match.ss gl.ss glut.ss \

lib/ikarus/include.ss

@@ -0,0 +1,66 @@
+;;; Ikarus Scheme -- A compiler for R6RS Scheme.
+;;; Copyright (C) 2009  Abdulaziz Ghuloum
+;;; 
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License version 3 as
+;;; published by the Free Software Foundation.
+;;; 
+;;; This program is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+
+(library (ikarus include)
+  (export include include/lexical-context)
+  (import (except (ikarus) include))
+
+  (define-syntax include/lexical-context/form
+    (lambda (x)
+      (syntax-case x ()
+        [(_ filename id form who)
+         (let* ([filename^ 
+                 (let ([x (syntax->datum #'filename)])
+                   (if (string? x)
+                       x
+                       (syntax-violation #f "file name is not a string"
+                          #'form #'filename)))]
+                [content 
+                 (with-exception-handler
+                   (lambda (x)
+                     (raise-continuable 
+                       (condition 
+                         (make-who-condition #'who)
+                         x)))
+                   (lambda () 
+                     (with-input-from-file filename^
+                       (lambda ()
+                         (let loop ()
+                           (let ([x (read)])
+                             (if (eof-object? x)
+                                 '()
+                                 (cons (datum->syntax #'id x)
+                                   (loop)))))))))])
+           #`(stale-when
+               (or (not (file-exists? filename))
+                   (> (file-mtime filename) #,(file-mtime filename^)))
+               #,@content))])))
+  
+  (define-syntax include/lexical-context
+    (lambda (x)
+      (syntax-case x ()
+        [(kwd filename id)
+         (if (identifier? #'id)
+             #`(include/lexical-context/form filename id #,x kwd)
+             (syntax-violation #f "not an identifier" x #'id))])))
+
+  (define-syntax include
+    (lambda (x)
+      (syntax-case x ()
+        [(kwd filename)
+         #`(include/lexical-context/form filename kwd #,x kwd)]))))
+

scheme/Makefile.am

@@ -119,7 +119,7 @@ MAINTAINERCLEANFILES=last-revision
 ikarus.boot: $(EXTRA_DIST) ikarus.config.ss 
 	IKARUS_SRC_DIR=$(srcdir) \
   IKARUS_BUILD_DIR=$(builddir) \
-  IKARUS_LIBRARY_PATH=$(srcdir) \
+  IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
   ../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
   --r6rs-script $(srcdir)/makefile.ss
 

scheme/Makefile.in

@@ -454,7 +454,7 @@ ikarus.config.ss: Makefile last-revision ../config.h
 ikarus.boot: $(EXTRA_DIST) ikarus.config.ss 
 	IKARUS_SRC_DIR=$(srcdir) \
   IKARUS_BUILD_DIR=$(builddir) \
-  IKARUS_LIBRARY_PATH=$(srcdir) \
+  IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
   ../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
   --r6rs-script $(srcdir)/makefile.ss
 

scheme/ikarus.compiler.ss

@@ -1846,6 +1846,7 @@
 
 (begin ;;; DEFINITIONS
   (module (wordsize)
+    (import (ikarus include))
     (include "ikarus.config.ss"))
   (define wordshift
     (case wordsize

scheme/ikarus.fasl.write.ss

@@ -31,6 +31,7 @@
     (except (ikarus) fasl-write write-byte))
  
   (module (wordsize)
+    (import (ikarus include))
     (include "ikarus.config.ss"))
 
   ;;; (define-syntax fxshift 

scheme/ikarus.include-src.ss

@@ -15,7 +15,7 @@
 
 (library (ikarus.include-src)
   (export include-src)
-  (import (ikarus))
+  (import (ikarus) (ikarus include))
   (define-syntax include-src
     (lambda (x)
       (syntax-case x ()
@@ -25,4 +25,4 @@
                           (or (getenv "IKARUS_SRC_DIR") ".") 
                           "/"
                           (syntax->datum #'filename))])
-           #'(include-into ctxt filename))]))))
+           #'(include/lexical-context filename ctxt))]))))

scheme/ikarus.intel-assembler.ss

@@ -25,6 +25,7 @@
 
 
 (module (wordsize)
+  (import (ikarus include))
   (include "ikarus.config.ss"))
 
 (define fold

scheme/ikarus.main.ss

@@ -20,7 +20,7 @@
 
 (library (ikarus startup)
   (export print-greeting init-library-path host-info split-path)
-  (import (except (ikarus) host-info))
+  (import (except (ikarus) host-info) (ikarus include))
   (include "ikarus.config.ss")
 
   (define (host-info) target)

scheme/last-revision

@@ -1 +1 @@
-1798
+1799

scheme/makefile.ss

@@ -144,8 +144,6 @@
     [let*-values         (macro . let*-values)]
     [define-struct       (macro . define-struct)]
     [case                (macro . case)]
-    [include             (macro . include)]
-    [include-into        (macro . include-into)]
     [syntax-rules        (macro . syntax-rules)]
     [quasiquote          (macro . quasiquote)]
     [quasisyntax         (macro . quasisyntax)]
@@ -295,8 +293,6 @@
     [type-descriptor                             i]
     [parameterize                                i parameters]
     [define-struct                               i]
-    [include                                     i]
-    [include-into                                i]
     [stale-when                                  i]
     [time                                        i]
     [trace-lambda                                i]

scheme/psyntax.expander.ss

@@ -1542,35 +1542,6 @@
                   ((e e* ...) `(if ,e (begin . ,e*) ,(f (car cls*) (cdr cls*))))
                   (_ (stx-error stx "invalid last clause")))))))))))
   
-  (begin ; module (include-macro include-into-macro)
-         ; no module to keep portable! 
-         ; dump everything in top-level, sure.
-    (define (do-include stx id filename)
-      (let ((filename (stx->datum filename)))
-        (unless (and (string? filename) (id? id))
-          (stx-error stx))
-        (cons 
-          (bless 'begin)
-          (with-input-from-file filename
-            (lambda ()
-              (let f ((ls '()))
-                (let ((x (read-annotated)))
-                  (cond
-                    ((eof-object? x) (reverse ls))
-                    (else
-                     (f (cons (datum->stx id x) ls)))))))))))
-    (define include-macro
-      (lambda (e)
-        (syntax-match e ()
-          ((id filename)
-           (do-include e id filename)))))
-    (define include-into-macro
-      (lambda (e)
-        (syntax-match e ()
-          ((_ id filename)
-           (do-include e id filename))))))
-
-  
   (define syntax-rules-macro
     (lambda (e)
       (syntax-match e ()
@@ -2611,7 +2582,6 @@
          (case x
            ((define-record-type)    define-record-type-macro)
            ((define-struct)         define-struct-macro)
-           ((include)               include-macro)
            ((cond)                  cond-macro)
            ((let)                   let-macro)
            ((do)                    do-macro)
@@ -2642,7 +2612,6 @@
            ((trace-letrec-syntax)   trace-letrec-syntax-macro)
            ((define-condition-type) define-condition-type-macro)
            ((parameterize)          parameterize-macro)
-           ((include-into)          include-into-macro)
            ((eol-style)
             (lambda (x) 
               (symbol-macro x '(none lf cr crlf nel crnel ls))))