.
original commit: 18323b0c0dc832703cb5b9dfb78acc37f67bf791
This commit is contained in:
parent
b28c5d5ded
commit
13a530ee0b
|
@ -1,6 +1,7 @@
|
||||||
|
|
||||||
(module include mzscheme
|
(module include mzscheme
|
||||||
(require-for-syntax (lib "stx.ss" "syntax")
|
(require-for-syntax (lib "stx.ss" "syntax")
|
||||||
|
(lib "path-spec.ss" "syntax")
|
||||||
"private/increader.ss")
|
"private/increader.ss")
|
||||||
(require (lib "etc.ss"))
|
(require (lib "etc.ss"))
|
||||||
|
|
||||||
|
@ -14,13 +15,7 @@
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(_ orig-stx ctx loc fn reader)
|
[(_ orig-stx ctx loc fn reader)
|
||||||
;; Parse the file name
|
;; Parse the file name
|
||||||
(let ([file
|
(let ([c-file (resolve-path-spec (syntax fn) (syntax loc) (syntax orig-stx) #'build-path)]
|
||||||
(syntax-case* (syntax fn) (build-path) module-or-top-identifier=?
|
|
||||||
[fn
|
|
||||||
(string? (syntax-e (syntax fn)))
|
|
||||||
(syntax-e (syntax fn))]
|
|
||||||
[(build-path elem1 elem ...)
|
|
||||||
(apply build-path (syntax-object->datum (syntax (elem1 elem ...))))])]
|
|
||||||
[ctx (syntax ctx)]
|
[ctx (syntax ctx)]
|
||||||
[loc (syntax loc)]
|
[loc (syntax loc)]
|
||||||
[reader (syntax reader)]
|
[reader (syntax reader)]
|
||||||
|
@ -43,29 +38,6 @@
|
||||||
"reader is not a procedure of two arguments"
|
"reader is not a procedure of two arguments"
|
||||||
orig-stx))
|
orig-stx))
|
||||||
|
|
||||||
;; Complete the file name
|
|
||||||
(let ([c-file
|
|
||||||
(if (complete-path? file)
|
|
||||||
file
|
|
||||||
(path->complete-path
|
|
||||||
file
|
|
||||||
(cond
|
|
||||||
;; Src of include expression is a path?
|
|
||||||
[(and (string? (syntax-source loc))
|
|
||||||
(complete-path? (syntax-source loc)))
|
|
||||||
(let-values ([(base name dir?)
|
|
||||||
(split-path (syntax-source loc))])
|
|
||||||
(if dir?
|
|
||||||
(syntax-source loc)
|
|
||||||
base))]
|
|
||||||
;; Load relative?
|
|
||||||
[(current-load-relative-directory)]
|
|
||||||
;; Current directory
|
|
||||||
[(current-directory)]
|
|
||||||
[else (raise-syntax-error
|
|
||||||
#f
|
|
||||||
"can't determine a base path"
|
|
||||||
orig-stx)])))])
|
|
||||||
;; Open the included file
|
;; Open the included file
|
||||||
(let ([p (with-handlers ([not-break-exn?
|
(let ([p (with-handlers ([not-break-exn?
|
||||||
(lambda (exn)
|
(lambda (exn)
|
||||||
|
@ -123,7 +95,7 @@
|
||||||
(datum->syntax-object
|
(datum->syntax-object
|
||||||
(quote-syntax here)
|
(quote-syntax here)
|
||||||
`(begin ,@lexed-content)
|
`(begin ,@lexed-content)
|
||||||
orig-stx)))))))]))
|
orig-stx))))))]))
|
||||||
|
|
||||||
(define (check-fn-form fn stx)
|
(define (check-fn-form fn stx)
|
||||||
;; Check form of fn:
|
;; Check form of fn:
|
||||||
|
|
Loading…
Reference in New Issue
Block a user