improve sugar/include

pull/2/head
Matthew Butterick 9 years ago
parent 8d39746d6c
commit b008bbfc18

@ -84,17 +84,27 @@
(cons r (loop)))))])
;; Here's where we'll separate the content of the file from the #lang line.
;; 'content' is a one-member list with the file as a syntax object.
(define content-syntax (car content)) ; save the syntax object (its context will be needed momentarily)
;; peel the wrapper off the file. it will come in like so
;; (module foo whatever/lang (#%module-begin expr ...))
;; the guts are the (expr ...). To get them, we want the cdr of the fourth element.
(define fourth cadddr) ; we don't have `fourth` in the syntax environment.
;; get the guts and package them back into a syntax object using the saved content-syntax as context.
(local-require racket/match)
(define guts (match (syntax->datum content-syntax)
[(list 'module modname lang (list '#%module-begin exprs ...)) exprs]))
(define content-guts (datum->syntax content-syntax guts))
;; the resulting material will be stored in 'content-guts'.
;; 'content' is a list of syntax objects from the source file.
;; Each object corresponds to a top-level expression in the file, converted to syntax.
;; If the file has a #lang line, there's only one expression (because the #lang expands to a single `module` form).
;; If it doesn't, then there are an indefinite number of expressions.
;; So we'll handle both types with a match.
(define content-guts
(cond
[(not (null? content))
(define content-syntax (car content)) ; save the first syntax object (its context will be needed momentarily)
;; peel the wrapper off the file. it will come in like so
;; (module foo whatever/lang (#%module-begin expr ...))
;; the guts are the (expr ...). To get them, we want the cdr of the fourth element.
(define fourth cadddr) ; we don't have `fourth` in the syntax environment.
;; get the guts and package them back into a syntax object using the saved content-syntax as context.
(local-require racket/match racket/function)
(define guts-data (match (map syntax->datum content)
[(list (list 'module modname lang (list '#%module-begin exprs ...))) exprs]
[(list exprs ...) exprs]))
(map (curry datum->syntax content-syntax) guts-data)]
[else null]))
(close-input-port p)
;; Preserve src info for content, but set its
;; lexical context to be that of the include expression

@ -5,7 +5,7 @@
@title{Include}
@defmodule[sugar/include]
@defform[(include-without-lang-line path)]
Like @racket[include], but strips off the @tt{#lang} line of the file. Why? So you can take the code from a working source file and recompile it under a different @tt{#lang}. Why? Well, you could take code from a @tt{#lang typed/racket} source file and recompile as @tt{#lang typed/racket/no-check}. Why? Because then you could invoke your code natively from typed and untyped environments.
@defform[(include-without-lang-line path-spec)]
Inline the syntax in the file designated by @racket[_path-spec], after stripping off the @tt{#lang} line of the file (if it exists, otherwise just @racket[include] the file as usual).
Please, don't use this on a file without a @tt{#lang} line. For that, just use @racket[include].
Why? So you can take the code from a working source file and recompile it under a different @tt{#lang}. Why? Well, you could take code from a @tt{#lang typed/racket} source file and recompile as @tt{#lang typed/racket/no-check}. Why? Because then you could make typed and untyped modules from the same code without the mandatory contracts imposed by @racket[require/typed].

@ -0,0 +1 @@
(define no-lang-symbol 'bar)

@ -193,4 +193,12 @@
(provide included-symbol))
(require 'include-test)
(check-equal? included-symbol 'bar)
(check-equal? included-symbol 'bar)
(module no-lang-line-include-test racket/base
(require sugar/include)
(include-without-lang-line "test/no-lang-line-source.rkt")
(provide no-lang-symbol))
(require 'no-lang-line-include-test)
(check-equal? no-lang-symbol 'bar)
Loading…
Cancel
Save