conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

- 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 2009-05-30 08:14:09 +03:00
parent 2653cedee1
commit f13876d385
15 changed files with 77 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lib/Makefile.am
View File

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

2
lib/Makefile.in
View File

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

66
lib/ikarus/include.ss Normal file
View File

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

2
scheme/Makefile.am
View File

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

2
scheme/Makefile.in
View File

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

BIN
scheme/ikarus.boot.4.prebuilt
View File

Binary file not shown.

BIN
scheme/ikarus.boot.8.prebuilt
View File

Binary file not shown.

1
scheme/ikarus.compiler.ss
View File

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

1
scheme/ikarus.fasl.write.ss
View File

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

4
scheme/ikarus.include-src.ss
View File

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

1
scheme/ikarus.intel-assembler.ss
View File

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

2
scheme/ikarus.main.ss
View File

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

2
scheme/last-revision
View File

@ -1 +1 @@
1798
1799

4
scheme/makefile.ss
View File

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

31
scheme/psyntax.expander.ss
View File

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