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

move include syntax to core-syntax library

This commit is contained in:
Yuichi Nishiwaki 2014-07-22 14:34:39 +09:00
parent b17a2002f3
commit 4d108ac299
1 changed files with 23 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
piclib/prelude.scm
View File

@ -260,12 +260,34 @@
(lambda (form r c) (lambda (form r c)
`(,(r 'letrec-syntax) ,@(cdr form))))) `(,(r 'letrec-syntax) ,@(cdr form)))))
(import (scheme read) (scheme file))
(define-syntax include
(letrec ((read-file
(lambda (filename)
(let ((port (open-input-file filename)))
(dynamic-wind
(lambda () #f)
(lambda ()
(let loop ((expr (read port)) (exprs '()))
(if (eof-object? expr)
(reverse exprs)
(loop (read port) (cons expr exprs)))))
(lambda ()
(close-port port)))))))
(er-macro-transformer
(lambda (form rename compare)
(let ((filenames (cdr form)))
(let ((exprs (apply append (map read-file filenames))))
`(,(rename 'begin) ,@exprs)))))))
(export let let* letrec letrec* (export let let* letrec letrec*
quasiquote unquote unquote-splicing quasiquote unquote unquote-splicing
and or and or
cond case else => cond case else =>
do when unless do when unless
let-syntax letrec-syntax let-syntax letrec-syntax
include
_ ... syntax-error)) _ ... syntax-error))
(import (picrin core-syntax)) (import (picrin core-syntax))
@ -276,6 +298,7 @@
cond case else => cond case else =>
do when unless do when unless
let-syntax letrec-syntax let-syntax letrec-syntax
include
_ ... syntax-error) _ ... syntax-error)
;;; multiple value ;;; multiple value
@ -737,28 +760,6 @@
(export call-with-port) (export call-with-port)
;;; include syntax
(import (scheme read)
(scheme file))
(define (read-many filename)
(call-with-port (open-input-file filename)
(lambda (port)
(let loop ((expr (read port)) (exprs '()))
(if (eof-object? expr)
(reverse exprs)
(loop (read port) (cons expr exprs)))))))
(define-syntax include
(er-macro-transformer
(lambda (form rename compare)
(let ((filenames (cdr form)))
(let ((exprs (apply append (map read-many filenames))))
`(,(rename 'begin) ,@exprs))))))
(export include)
;;; syntax-rules ;;; syntax-rules
(define-library (picrin syntax-rules) (define-library (picrin syntax-rules)
(import (scheme base) (import (scheme base)