partial-include.rkt (2135B)
1 #lang racket/base 2 (provide include-without-first-line) 3 4 (require (for-syntax racket/base)) 5 6 (define-for-syntax (replace-context ctx stx) 7 (define (recur e) 8 (cond 9 [(syntax? e) (datum->syntax ctx (recur (syntax-e e)) e e)] 10 [(pair? e) (cons (recur (car e)) (recur (cdr e)))] 11 [(null? e) e] 12 [(vector? e) ((if (immutable? e) 13 vector->immutable-vector 14 (λ (v) v)) 15 (list->vector 16 (recur (vector->list e))))] 17 [(hash? e) ((if (immutable? e) 18 (cond [(hash-eq? e) make-immutable-hasheq] 19 [(hash-eqv? e) make-immutable-hasheqv] 20 [else make-immutable-hash]) 21 (cond [(hash-eq? e) make-hasheq] 22 [(hash-eqv? e) make-hasheqv] 23 [else make-hash])) 24 (recur (hash->list e)))] 25 [(prefab-struct-key e) => (λ (k) 26 (apply make-prefab-struct 27 k 28 (recur (cdr 29 (vector->list 30 (struct->vector e))))))] 31 [(box? e) ((if (immutable? e) box-immutable box) 32 (recur (unbox e)))] 33 [else e])) 34 (recur stx)) 35 36 (define-syntax (include-without-first-line stx) 37 (syntax-case stx () 38 [(_ filename1-stx . filename+-stx) 39 (let*-values ([(user-filename) (map syntax-e 40 (syntax->list 41 #'(filename1-stx . filename+-stx)))] 42 [(base _1 _2) (split-path (syntax-source #'filename1-stx))] 43 [(filename) (apply build-path base user-filename)]) 44 (with-input-from-file filename 45 (λ () 46 (read-line) ;; discard the first line. 47 (replace-context 48 #'filename1-stx 49 #`(begin 50 . #,(for/list ([rd (in-producer read-syntax eof filename)]) 51 rd))))))]))