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)]
[define-struct (macro . define-struct)]
[include (macro . include)]
[include-into (macro . include-into)]
[syntax-rules (macro . syntax-rules)]
[quasiquote (macro . quasiquote)]
[quasisyntax (macro . quasisyntax)]
@ -271,6 +272,7 @@
[parameterize i parameters]
[define-struct i]
[include i]
[include-into i]
[time i]
[trace-lambda i]
[trace-define i]

44
scheme/psyntax.expander.ss
View File

@ -1275,21 +1275,34 @@
((e e* ...) `(if ,e (begin . ,e*) ,(f (car cls*) (cdr cls*))))
(_ (stx-error stx "invalid last clause")))))))))))
(define include-macro
(lambda (e)
(syntax-match e ()
((id filename)
(let ((filename (stx->datum filename)))
(unless (string? filename) (stx-error e))
(with-input-from-file filename
(lambda ()
(let f ((ls '()))
(let ((x (read)))
(cond
((eof-object? x)
(cons (bless 'begin)
(datum->stx id (reverse ls))))
(else (f (cons x ls)))))))))))))
(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)))
(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)
@ -2298,6 +2311,7 @@
((trace-lambda) trace-lambda-macro)
((trace-define) trace-define-macro)
((define-condition-type) define-condition-type-macro)
((include-into) include-into-macro)
((eol-style)
(lambda (x)
(symbol-macro x '(none lf cr crlf nel crnel ls))))