- 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).
This commit is contained in:
parent
2653cedee1
commit
f13876d385
|
@ -1,5 +1,5 @@
|
||||||
libikarusdir=$(pkglibdir)/ikarus
|
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
|
libCocoadir=$(pkglibdir)/Cocoa
|
||||||
dist_libCocoa_DATA=Cocoa/helpers.ss
|
dist_libCocoa_DATA=Cocoa/helpers.ss
|
||||||
|
|
||||||
|
|
|
@ -162,7 +162,7 @@ top_build_prefix = @top_build_prefix@
|
||||||
top_builddir = @top_builddir@
|
top_builddir = @top_builddir@
|
||||||
top_srcdir = @top_srcdir@
|
top_srcdir = @top_srcdir@
|
||||||
libikarusdir = $(pkglibdir)/ikarus
|
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
|
libCocoadir = $(pkglibdir)/Cocoa
|
||||||
dist_libCocoa_DATA = Cocoa/helpers.ss
|
dist_libCocoa_DATA = Cocoa/helpers.ss
|
||||||
dist_pkglib_DATA = match.ss gl.ss glut.ss \
|
dist_pkglib_DATA = match.ss gl.ss glut.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)]))))
|
||||||
|
|
|
@ -119,7 +119,7 @@ MAINTAINERCLEANFILES=last-revision
|
||||||
ikarus.boot: $(EXTRA_DIST) ikarus.config.ss
|
ikarus.boot: $(EXTRA_DIST) ikarus.config.ss
|
||||||
IKARUS_SRC_DIR=$(srcdir) \
|
IKARUS_SRC_DIR=$(srcdir) \
|
||||||
IKARUS_BUILD_DIR=$(builddir) \
|
IKARUS_BUILD_DIR=$(builddir) \
|
||||||
IKARUS_LIBRARY_PATH=$(srcdir) \
|
IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
|
||||||
../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
|
../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
|
||||||
--r6rs-script $(srcdir)/makefile.ss
|
--r6rs-script $(srcdir)/makefile.ss
|
||||||
|
|
||||||
|
|
|
@ -454,7 +454,7 @@ ikarus.config.ss: Makefile last-revision ../config.h
|
||||||
ikarus.boot: $(EXTRA_DIST) ikarus.config.ss
|
ikarus.boot: $(EXTRA_DIST) ikarus.config.ss
|
||||||
IKARUS_SRC_DIR=$(srcdir) \
|
IKARUS_SRC_DIR=$(srcdir) \
|
||||||
IKARUS_BUILD_DIR=$(builddir) \
|
IKARUS_BUILD_DIR=$(builddir) \
|
||||||
IKARUS_LIBRARY_PATH=$(srcdir) \
|
IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
|
||||||
../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
|
../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
|
||||||
--r6rs-script $(srcdir)/makefile.ss
|
--r6rs-script $(srcdir)/makefile.ss
|
||||||
|
|
||||||
|
|
Binary file not shown.
Binary file not shown.
|
@ -1846,6 +1846,7 @@
|
||||||
|
|
||||||
(begin ;;; DEFINITIONS
|
(begin ;;; DEFINITIONS
|
||||||
(module (wordsize)
|
(module (wordsize)
|
||||||
|
(import (ikarus include))
|
||||||
(include "ikarus.config.ss"))
|
(include "ikarus.config.ss"))
|
||||||
(define wordshift
|
(define wordshift
|
||||||
(case wordsize
|
(case wordsize
|
||||||
|
|
|
@ -31,6 +31,7 @@
|
||||||
(except (ikarus) fasl-write write-byte))
|
(except (ikarus) fasl-write write-byte))
|
||||||
|
|
||||||
(module (wordsize)
|
(module (wordsize)
|
||||||
|
(import (ikarus include))
|
||||||
(include "ikarus.config.ss"))
|
(include "ikarus.config.ss"))
|
||||||
|
|
||||||
;;; (define-syntax fxshift
|
;;; (define-syntax fxshift
|
||||||
|
|
|
@ -15,7 +15,7 @@
|
||||||
|
|
||||||
(library (ikarus.include-src)
|
(library (ikarus.include-src)
|
||||||
(export include-src)
|
(export include-src)
|
||||||
(import (ikarus))
|
(import (ikarus) (ikarus include))
|
||||||
(define-syntax include-src
|
(define-syntax include-src
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(syntax-case x ()
|
(syntax-case x ()
|
||||||
|
@ -25,4 +25,4 @@
|
||||||
(or (getenv "IKARUS_SRC_DIR") ".")
|
(or (getenv "IKARUS_SRC_DIR") ".")
|
||||||
"/"
|
"/"
|
||||||
(syntax->datum #'filename))])
|
(syntax->datum #'filename))])
|
||||||
#'(include-into ctxt filename))]))))
|
#'(include/lexical-context filename ctxt))]))))
|
||||||
|
|
|
@ -25,6 +25,7 @@
|
||||||
|
|
||||||
|
|
||||||
(module (wordsize)
|
(module (wordsize)
|
||||||
|
(import (ikarus include))
|
||||||
(include "ikarus.config.ss"))
|
(include "ikarus.config.ss"))
|
||||||
|
|
||||||
(define fold
|
(define fold
|
||||||
|
|
|
@ -20,7 +20,7 @@
|
||||||
|
|
||||||
(library (ikarus startup)
|
(library (ikarus startup)
|
||||||
(export print-greeting init-library-path host-info split-path)
|
(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")
|
(include "ikarus.config.ss")
|
||||||
|
|
||||||
(define (host-info) target)
|
(define (host-info) target)
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1798
|
1799
|
||||||
|
|
|
@ -144,8 +144,6 @@
|
||||||
[let*-values (macro . let*-values)]
|
[let*-values (macro . let*-values)]
|
||||||
[define-struct (macro . define-struct)]
|
[define-struct (macro . define-struct)]
|
||||||
[case (macro . case)]
|
[case (macro . case)]
|
||||||
[include (macro . include)]
|
|
||||||
[include-into (macro . include-into)]
|
|
||||||
[syntax-rules (macro . syntax-rules)]
|
[syntax-rules (macro . syntax-rules)]
|
||||||
[quasiquote (macro . quasiquote)]
|
[quasiquote (macro . quasiquote)]
|
||||||
[quasisyntax (macro . quasisyntax)]
|
[quasisyntax (macro . quasisyntax)]
|
||||||
|
@ -295,8 +293,6 @@
|
||||||
[type-descriptor i]
|
[type-descriptor i]
|
||||||
[parameterize i parameters]
|
[parameterize i parameters]
|
||||||
[define-struct i]
|
[define-struct i]
|
||||||
[include i]
|
|
||||||
[include-into i]
|
|
||||||
[stale-when i]
|
[stale-when i]
|
||||||
[time i]
|
[time i]
|
||||||
[trace-lambda i]
|
[trace-lambda i]
|
||||||
|
|
|
@ -1542,35 +1542,6 @@
|
||||||
((e e* ...) `(if ,e (begin . ,e*) ,(f (car cls*) (cdr cls*))))
|
((e e* ...) `(if ,e (begin . ,e*) ,(f (car cls*) (cdr cls*))))
|
||||||
(_ (stx-error stx "invalid last clause")))))))))))
|
(_ (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
|
(define syntax-rules-macro
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
|
@ -2611,7 +2582,6 @@
|
||||||
(case x
|
(case x
|
||||||
((define-record-type) define-record-type-macro)
|
((define-record-type) define-record-type-macro)
|
||||||
((define-struct) define-struct-macro)
|
((define-struct) define-struct-macro)
|
||||||
((include) include-macro)
|
|
||||||
((cond) cond-macro)
|
((cond) cond-macro)
|
||||||
((let) let-macro)
|
((let) let-macro)
|
||||||
((do) do-macro)
|
((do) do-macro)
|
||||||
|
@ -2642,7 +2612,6 @@
|
||||||
((trace-letrec-syntax) trace-letrec-syntax-macro)
|
((trace-letrec-syntax) trace-letrec-syntax-macro)
|
||||||
((define-condition-type) define-condition-type-macro)
|
((define-condition-type) define-condition-type-macro)
|
||||||
((parameterize) parameterize-macro)
|
((parameterize) parameterize-macro)
|
||||||
((include-into) include-into-macro)
|
|
||||||
((eol-style)
|
((eol-style)
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(symbol-macro x '(none lf cr crlf nel crnel ls))))
|
(symbol-macro x '(none lf cr crlf nel crnel ls))))
|
||||||
|
|
Loading…
Reference in New Issue