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

Added "include-into" macro. 

(include-into ctxt "filename") included the contents of the file
  as if they were present in the context ctxt (which must be an
  identifier).  
  (include-into here "filename") would do the same thing as
  (include "filename")
This commit is contained in:
Abdulaziz Ghuloum 2007-12-05 03:26:56 -05:00
parent 4318a7cea7
commit e874d2d0a0
3 changed files with 32 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1185 1186

2
scheme/makefile.ss
View File

@ -130,6 +130,7 @@
[record-constructor-descriptor (core-macro . record-constructor-descriptor)] [record-constructor-descriptor (core-macro . record-constructor-descriptor)]
[define-struct (macro . define-struct)] [define-struct (macro . define-struct)]
[include (macro . include)] [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)]
@ -271,6 +272,7 @@
[parameterize i parameters] [parameterize i parameters]
[define-struct i] [define-struct i]
[include i] [include i]
[include-into i]
[time i] [time i]
[trace-lambda i] [trace-lambda i]
[trace-define i] [trace-define i]

32
scheme/psyntax.expander.ss
View File

@ -1275,21 +1275,34 @@
((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")))))))))))
(define include-macro (begin ; module (include-macro include-into-macro)
(lambda (e) ; no module to keep portable!
(syntax-match e () ; dump everything in top-level, sure.
((id filename) (define (do-include stx id filename)
(let ((filename (stx->datum filename))) (let ((filename (stx->datum filename)))
(unless (string? filename) (stx-error e)) (unless (and (string? filename) (id? id))
(stx-error stx))
(cons
(bless 'begin)
(with-input-from-file filename (with-input-from-file filename
(lambda () (lambda ()
(let f ((ls '())) (let f ((ls '()))
(let ((x (read))) (let ((x (read)))
(cond (cond
((eof-object? x) ((eof-object? x) (reverse ls))
(cons (bless 'begin) (else
(datum->stx id (reverse ls)))) (f (cons (datum->stx id x) ls)))))))))))
(else (f (cons 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)
@ -2298,6 +2311,7 @@
((trace-lambda) trace-lambda-macro) ((trace-lambda) trace-lambda-macro)
((trace-define) trace-define-macro) ((trace-define) trace-define-macro)
((define-condition-type) define-condition-type-macro) ((define-condition-type) define-condition-type-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))))