- 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:
Abdulaziz Ghuloum
parent
2653cedee1
commit
f13876d385
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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_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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Binary file not shown.
Binary file not shown.
|
|
@ -1846,6 +1846,7 @@
|
|||
|
||||
(begin ;;; DEFINITIONS
|
||||
(module (wordsize)
|
||||
(import (ikarus include))
|
||||
(include "ikarus.config.ss"))
|
||||
(define wordshift
|
||||
(case wordsize
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@
|
|||
(except (ikarus) fasl-write write-byte))
|
||||
|
||||
(module (wordsize)
|
||||
(import (ikarus include))
|
||||
(include "ikarus.config.ss"))
|
||||
|
||||
;;; (define-syntax fxshift
|
||||
|
|
|
|||
|
|
@ -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))]))))
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@
|
|||
|
||||
|
||||
(module (wordsize)
|
||||
(import (ikarus include))
|
||||
(include "ikarus.config.ss"))
|
||||
|
||||
(define fold
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
1798
|
||||
1799
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue