diff --git a/OLD-syndicate/pattern.rkt b/OLD-syndicate/pattern.rkt new file mode 100644 index 0000000..87eee22 --- /dev/null +++ b/OLD-syndicate/pattern.rkt @@ -0,0 +1,240 @@ +#lang racket/base + +(provide (struct-out discard) + (struct-out capture) + + (for-syntax analyse-pattern + instantiate-pattern->pattern + instantiate-pattern->value + desc->key + desc->skeleton-proj + desc->skeleton-stx + desc->capture-proj + desc->capture-names + desc->assertion-stx) + + (all-from-out "pattern-expander.rkt")) + +(require (for-syntax racket/base)) +(require (for-syntax racket/match)) +(require (for-syntax racket/struct-info)) +(require (for-syntax syntax/stx)) +(require "pattern-expander.rkt") + +(struct discard () #:prefab) +(struct capture (detail) #:prefab) + +;;--------------------------------------------------------------------------- +;; ## Analysing patterns +;; +;; Patterns generate several pieces, which work together to form +;; routing tables: +;; +;; - the *assertion* allows observers of observers to function; +;; - the `Skeleton` classifies the shape of the pattern; +;; - two `SkProj`s select constant and variable pieces from a pattern, respectively; and +;; - a `SkKey` specifies constant pieces of a pattern, matched against one of the `SkProj`s. +;; +;; The other `SkProj` generates a second `SkKey` which is used as the +;; input to a handler function. + +(define-for-syntax orig-insp + (variable-reference->module-declaration-inspector (#%variable-reference))) + +(begin-for-syntax + (define (dollar-id? stx) + (and (identifier? stx) + (char=? (string-ref (symbol->string (syntax-e stx)) 0) #\$))) + + (define (undollar stx) + (and (dollar-id? stx) + (datum->syntax stx (string->symbol (substring (symbol->string (syntax-e stx)) 1))))) + + (define (discard-id? stx) + (and (identifier? stx) + (free-identifier=? #'_ stx))) + + (define (id-value stx) + (and (identifier? stx) + (syntax-local-value stx (lambda () #f)))) + + (define (list-id? stx) + (and (identifier? stx) + (free-identifier=? #'list stx))) + + (define (vector-id? stx) + (and (identifier? stx) + (free-identifier=? #'vector stx))) + + (define (analyse-pattern stx) + (define disarmed-stx (syntax-disarm stx orig-insp)) + (syntax-case disarmed-stx ($ quasiquote unquote quote) + [(expander args ...) + (pattern-expander-id? #'expander) + (pattern-expander-transform disarmed-stx + (lambda (result) + (analyse-pattern (syntax-rearm result stx))))] + + ;; Extremely limited support for quasiquoting and quoting + [(quasiquote (unquote p)) (analyse-pattern #'p)] + [(quasiquote (p ...)) (analyse-pattern #'(list (quasiquote p) ...))] + [(quasiquote p) (list 'atom stx)] + [(quote p) (list 'atom stx)] + + [(ctor piece ...) + (struct-info? (id-value #'ctor)) + (list* 'compound + (extract-struct-info (id-value #'ctor)) + (stx-map analyse-pattern #'(piece ...)))] + [(list piece ...) + (list-id? #'list) + (list* 'compound + 'list + (stx-map analyse-pattern #'(piece ...)))] + [(vector piece ...) + (vector-id? #'vector) + (list* 'compound + 'vector + (stx-map analyse-pattern #'(piece ...)))] + [id + (dollar-id? #'id) + (list 'capture (undollar #'id) (list 'discard))] + [($ id p) + (list 'capture #'id (analyse-pattern #'p))] + [id + (discard-id? #'id) + (list 'discard)] + [_ + (list 'atom stx)])) + + (define (instantiate-pattern->pattern stx) + (define disarmed-stx (syntax-disarm stx orig-insp)) + (syntax-case disarmed-stx ($ quasiquote unquote quote) + [(expander args ...) + (pattern-expander-id? #'expander) + (pattern-expander-transform disarmed-stx + (lambda (result) + (instantiate-pattern->pattern (syntax-rearm result stx))))] + + ;; Extremely limited support for quasiquoting and quoting + [(quasiquote (unquote p)) (instantiate-pattern->pattern #'p)] + [(quasiquote (p ...)) (instantiate-pattern->pattern #'(list (quasiquote p) ...))] + [(quasiquote p) stx] + [(quote p) stx] + + [(ctor piece ...) + (struct-info? (id-value #'ctor)) + (quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->pattern #'(piece ...))))] + [(list piece ...) + (list-id? #'list) + (quasisyntax/loc stx (list #,@(stx-map instantiate-pattern->pattern #'(piece ...))))] + [(vector piece ...) + (vector-id? #'vector) + (quasisyntax/loc stx (vector #,@(stx-map instantiate-pattern->pattern #'(piece ...))))] + [id + (dollar-id? #'id) + (undollar #'id)] + [($ id p) + #'id] + [id + (discard-id? #'id) + #'id] + [other + #'other])) + + (define (instantiate-pattern->value stx) + (define disarmed-stx (syntax-disarm stx orig-insp)) + (syntax-case disarmed-stx ($ quasiquote unquote quote) + [(expander args ...) + (pattern-expander-id? #'expander) + (pattern-expander-transform disarmed-stx + (lambda (result) + (instantiate-pattern->value (syntax-rearm result stx))))] + + ;; Extremely limited support for quasiquoting and quoting + [(quasiquote (unquote p)) (instantiate-pattern->value #'p)] + [(quasiquote (p ...)) (instantiate-pattern->value #'(list (quasiquote p) ...))] + [(quasiquote p) stx] + [(quote p) stx] + + [(ctor piece ...) + (struct-info? (id-value #'ctor)) + (quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->value #'(piece ...))))] + [(list piece ...) + (list-id? #'list) + (quasisyntax/loc stx (list #,@(stx-map instantiate-pattern->value #'(piece ...))))] + [(vector piece ...) + (vector-id? #'vector) + (quasisyntax/loc stx (vector #,@(stx-map instantiate-pattern->value #'(piece ...))))] + [id + (dollar-id? #'id) + (undollar #'id)] + [($ id p) + #'id] + [id + (discard-id? #'id) + #'(discard)] + [other + #'other]))) + +;;--------------------------------------------------------------------------- + +(begin-for-syntax + (define (select-pattern-leaves desc capture-fn atom-fn) + (define (walk-node key-rev desc) + (match desc + [`(compound ,_ ,pieces ...) (walk-edge 0 key-rev pieces)] + [`(capture ,name-stx ,p) (append (capture-fn key-rev name-stx) (walk-node key-rev p))] + [`(discard) (list)] + [`(atom ,v) (atom-fn key-rev v)])) + (define (walk-edge index key-rev pieces) + (match pieces + ['() '()] + [(cons p pieces) (append (walk-node (cons index key-rev) p) + (walk-edge (+ index 1) key-rev pieces))])) + (walk-node '() desc)) + + (define (desc->key desc) + (select-pattern-leaves desc + (lambda (key-rev name-stx) (list)) + (lambda (key-rev atom) (list atom)))) + + (define (desc->skeleton-proj desc) + (select-pattern-leaves desc + (lambda (key-rev name-stx) (list)) + (lambda (key-rev atom) (list (reverse key-rev))))) + + (define (desc->skeleton-stx desc) + (match desc + [`(compound list ,pieces ...) + #`(list 'list #,@(map desc->skeleton-stx pieces))] + [`(compound vector ,pieces ...) + #`(list 'vector #,@(map desc->skeleton-stx pieces))] + [`(compound (,struct-type ,_ctor ,_pred ,_getters ,_setters ,_super) ,pieces ...) + #`(list #,struct-type #,@(map desc->skeleton-stx pieces))] + [`(capture ,_ ,p) (desc->skeleton-stx p)] + [`(discard) #'#f] + [`(atom ,atom-stx) #'#f])) + + (define (desc->capture-proj desc) + (select-pattern-leaves desc + (lambda (key-rev name-stx) (list (reverse key-rev))) + (lambda (key-rev atom) (list)))) + + (define (desc->capture-names desc) + (select-pattern-leaves desc + (lambda (key-rev name-stx) (list name-stx)) + (lambda (key-rev atom) (list)))) + + (define (desc->assertion-stx desc) + (match desc + [`(compound list ,pieces ...) + #`(list #,@(map desc->assertion-stx pieces))] + [`(compound vector ,pieces ...) + #`(vector #,@(map desc->assertion-stx pieces))] + [`(compound (,_struct-type ,ctor ,_pred ,_getters ,_setters ,_super) ,pieces ...) + #`(#,ctor #,@(map desc->assertion-stx pieces))] + [`(capture ,_ ,p) #`(capture #,(desc->assertion-stx p))] + [`(discard) #'(discard)] + [`(atom ,v) v])) + ) diff --git a/syndicate/pattern.rkt b/syndicate/pattern.rkt index 87eee22..96e6cd0 100644 --- a/syndicate/pattern.rkt +++ b/syndicate/pattern.rkt @@ -1,42 +1,48 @@ #lang racket/base -(provide (struct-out discard) - (struct-out capture) - - (for-syntax analyse-pattern - instantiate-pattern->pattern - instantiate-pattern->value - desc->key - desc->skeleton-proj - desc->skeleton-stx - desc->capture-proj - desc->capture-names - desc->assertion-stx) - - (all-from-out "pattern-expander.rkt")) +(provide (for-syntax preserves-pattern-registry + register-preserves-pattern! + analyse-pattern + analyse-pattern-bindings) + define-preserves-pattern + :pattern) (require (for-syntax racket/base)) (require (for-syntax racket/match)) +(require (for-syntax racket/list)) (require (for-syntax racket/struct-info)) +(require (for-syntax syntax/id-table)) (require (for-syntax syntax/stx)) -(require "pattern-expander.rkt") -(struct discard () #:prefab) -(struct capture (detail) #:prefab) +(require "pattern-expander.rkt") +(require "schemas/gen/dataspace-patterns.rkt") + +;;--------------------------------------------------------------------------- + +(define-for-syntax preserves-pattern-registry (make-free-id-table)) + +(define-for-syntax (register-preserves-pattern! id-stx transformer) + (free-id-table-set! preserves-pattern-registry id-stx transformer)) + +(define-syntax (define-preserves-pattern stx) + (syntax-case stx () + [(_ (ctor-stx field-stxs ...) pattern-stx bindings-stx) + #'(begin (begin-for-syntax + (register-preserves-pattern! + #'ctor-stx + (lambda (mode s) + (match mode + ['pattern + (syntax-case s () + [(_ field-stxs ...) pattern-stx] + [_ (raise-syntax-error 'ctor-stx "Invalid pattern")])] + ['bindings + (syntax-case s () + [(_ field-stxs ...) bindings-stx] + [_ (raise-syntax-error 'ctor-stx "Invalid binding-pattern")])])))) + (void))])) ;;--------------------------------------------------------------------------- -;; ## Analysing patterns -;; -;; Patterns generate several pieces, which work together to form -;; routing tables: -;; -;; - the *assertion* allows observers of observers to function; -;; - the `Skeleton` classifies the shape of the pattern; -;; - two `SkProj`s select constant and variable pieces from a pattern, respectively; and -;; - a `SkKey` specifies constant pieces of a pattern, matched against one of the `SkProj`s. -;; -;; The other `SkProj` generates a second `SkKey` which is used as the -;; input to a handler function. (define-for-syntax orig-insp (variable-reference->module-declaration-inspector (#%variable-reference))) @@ -62,13 +68,35 @@ (and (identifier? stx) (free-identifier=? #'list stx))) - (define (vector-id? stx) - (and (identifier? stx) - (free-identifier=? #'vector stx))) + (define (constructor-registered? stx) + (free-id-table-ref preserves-pattern-registry stx #f)) + + (define (member-entry key-stx pat-stx) + (define analysed (analyse-pattern pat-stx)) + (syntax-case analysed (DDiscard) + [(DDiscard) (list)] + [_ (list key-stx analysed)])) + + (define (struct-label-and-arity id-stx actual-count) + (match-define (list _type-stx ctor-stx pred-stx accessor-stxs _mutator-stxs _super) + (extract-struct-info (id-value id-stx))) + (define expected-count (length accessor-stxs)) + (when (not (= expected-count actual-count)) + (raise-syntax-error ':pattern + (format "Expected ~a arguments to ~v, but got ~a" + expected-count + ctor-stx + actual-count))) + (values (syntax-e ctor-stx) + expected-count)) (define (analyse-pattern stx) (define disarmed-stx (syntax-disarm stx orig-insp)) (syntax-case disarmed-stx ($ quasiquote unquote quote) + [(ctor args ...) + (constructor-registered? #'ctor) + ((free-id-table-ref preserves-pattern-registry #'ctor) 'pattern disarmed-stx)] + [(expander args ...) (pattern-expander-id? #'expander) (pattern-expander-transform disarmed-stx @@ -78,163 +106,89 @@ ;; Extremely limited support for quasiquoting and quoting [(quasiquote (unquote p)) (analyse-pattern #'p)] [(quasiquote (p ...)) (analyse-pattern #'(list (quasiquote p) ...))] - [(quasiquote p) (list 'atom stx)] - [(quote p) (list 'atom stx)] + [(quasiquote p) #`(DLit 'p)] + [(quote p) #`(DLit 'p)] [(ctor piece ...) (struct-info? (id-value #'ctor)) - (list* 'compound - (extract-struct-info (id-value #'ctor)) - (stx-map analyse-pattern #'(piece ...)))] - [(list piece ...) - (list-id? #'list) - (list* 'compound - 'list - (stx-map analyse-pattern #'(piece ...)))] - [(vector piece ...) - (vector-id? #'vector) - (list* 'compound - 'vector - (stx-map analyse-pattern #'(piece ...)))] + (let-values (((label arity) (struct-label-and-arity #'ctor))) + #`(DCompound-rec '#,label + #,arity + (hasheqv #,@(append* + (for/list [(n (in-naturals)) + (piece (in-list (syntax->list #'(piece ...))))] + (member-entry n piece))))))] + + [(list-stx piece ...) + (list-id? #'list-stx) + #`(DCompound-arr #,(length (syntax->list #'(piece ...))) + (hasheqv #,@(append* + (for/list [(n (in-naturals)) + (piece (in-list (syntax->list #'(piece ...))))] + (member-entry n piece)))))] + [id (dollar-id? #'id) - (list 'capture (undollar #'id) (list 'discard))] + #`(DBind '#,(undollar #'id) (DDiscard))] + [($ id p) - (list 'capture #'id (analyse-pattern #'p))] + #`(DBind 'id #,(analyse-pattern #'p))] + [id (discard-id? #'id) - (list 'discard)] - [_ - (list 'atom stx)])) + #`(DDiscard)] - (define (instantiate-pattern->pattern stx) + [other + #`(DLit other)])) + + (define (analyse-pattern-bindings stx) (define disarmed-stx (syntax-disarm stx orig-insp)) (syntax-case disarmed-stx ($ quasiquote unquote quote) + [(ctor args ...) + (constructor-registered? #'ctor) + ((free-id-table-ref preserves-pattern-registry #'ctor) 'bindings disarmed-stx)] + [(expander args ...) (pattern-expander-id? #'expander) (pattern-expander-transform disarmed-stx (lambda (result) - (instantiate-pattern->pattern (syntax-rearm result stx))))] + (analyse-pattern-bindings (syntax-rearm result stx))))] ;; Extremely limited support for quasiquoting and quoting - [(quasiquote (unquote p)) (instantiate-pattern->pattern #'p)] - [(quasiquote (p ...)) (instantiate-pattern->pattern #'(list (quasiquote p) ...))] - [(quasiquote p) stx] - [(quote p) stx] + [(quasiquote (unquote p)) (analyse-pattern-bindings #'p)] + [(quasiquote (p ...)) (analyse-pattern-bindings #'(list (quasiquote p) ...))] + [(quasiquote _p) '()] + [(quote _p) '()] [(ctor piece ...) (struct-info? (id-value #'ctor)) - (quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->pattern #'(piece ...))))] - [(list piece ...) - (list-id? #'list) - (quasisyntax/loc stx (list #,@(stx-map instantiate-pattern->pattern #'(piece ...))))] - [(vector piece ...) - (vector-id? #'vector) - (quasisyntax/loc stx (vector #,@(stx-map instantiate-pattern->pattern #'(piece ...))))] + (append-map analyse-pattern-bindings (syntax->list #'(piece ...)))] + + [(list-stx piece ...) + (list-id? #'list-stx) + (append-map analyse-pattern-bindings (syntax->list #'(piece ...)))] + [id (dollar-id? #'id) - (undollar #'id)] + (list (undollar #'id))] + [($ id p) - #'id] + (cons #'id (analyse-pattern-bindings #'p))] + [id (discard-id? #'id) - #'id] + '()] + [other - #'other])) + '()]))) - (define (instantiate-pattern->value stx) - (define disarmed-stx (syntax-disarm stx orig-insp)) - (syntax-case disarmed-stx ($ quasiquote unquote quote) - [(expander args ...) - (pattern-expander-id? #'expander) - (pattern-expander-transform disarmed-stx - (lambda (result) - (instantiate-pattern->value (syntax-rearm result stx))))] +(define-syntax (:pattern stx) + (syntax-case stx () + [(_ pat-stx) + (analyse-pattern #'pat-stx)])) - ;; Extremely limited support for quasiquoting and quoting - [(quasiquote (unquote p)) (instantiate-pattern->value #'p)] - [(quasiquote (p ...)) (instantiate-pattern->value #'(list (quasiquote p) ...))] - [(quasiquote p) stx] - [(quote p) stx] - - [(ctor piece ...) - (struct-info? (id-value #'ctor)) - (quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->value #'(piece ...))))] - [(list piece ...) - (list-id? #'list) - (quasisyntax/loc stx (list #,@(stx-map instantiate-pattern->value #'(piece ...))))] - [(vector piece ...) - (vector-id? #'vector) - (quasisyntax/loc stx (vector #,@(stx-map instantiate-pattern->value #'(piece ...))))] - [id - (dollar-id? #'id) - (undollar #'id)] - [($ id p) - #'id] - [id - (discard-id? #'id) - #'(discard)] - [other - #'other]))) - -;;--------------------------------------------------------------------------- - -(begin-for-syntax - (define (select-pattern-leaves desc capture-fn atom-fn) - (define (walk-node key-rev desc) - (match desc - [`(compound ,_ ,pieces ...) (walk-edge 0 key-rev pieces)] - [`(capture ,name-stx ,p) (append (capture-fn key-rev name-stx) (walk-node key-rev p))] - [`(discard) (list)] - [`(atom ,v) (atom-fn key-rev v)])) - (define (walk-edge index key-rev pieces) - (match pieces - ['() '()] - [(cons p pieces) (append (walk-node (cons index key-rev) p) - (walk-edge (+ index 1) key-rev pieces))])) - (walk-node '() desc)) - - (define (desc->key desc) - (select-pattern-leaves desc - (lambda (key-rev name-stx) (list)) - (lambda (key-rev atom) (list atom)))) - - (define (desc->skeleton-proj desc) - (select-pattern-leaves desc - (lambda (key-rev name-stx) (list)) - (lambda (key-rev atom) (list (reverse key-rev))))) - - (define (desc->skeleton-stx desc) - (match desc - [`(compound list ,pieces ...) - #`(list 'list #,@(map desc->skeleton-stx pieces))] - [`(compound vector ,pieces ...) - #`(list 'vector #,@(map desc->skeleton-stx pieces))] - [`(compound (,struct-type ,_ctor ,_pred ,_getters ,_setters ,_super) ,pieces ...) - #`(list #,struct-type #,@(map desc->skeleton-stx pieces))] - [`(capture ,_ ,p) (desc->skeleton-stx p)] - [`(discard) #'#f] - [`(atom ,atom-stx) #'#f])) - - (define (desc->capture-proj desc) - (select-pattern-leaves desc - (lambda (key-rev name-stx) (list (reverse key-rev))) - (lambda (key-rev atom) (list)))) - - (define (desc->capture-names desc) - (select-pattern-leaves desc - (lambda (key-rev name-stx) (list name-stx)) - (lambda (key-rev atom) (list)))) - - (define (desc->assertion-stx desc) - (match desc - [`(compound list ,pieces ...) - #`(list #,@(map desc->assertion-stx pieces))] - [`(compound vector ,pieces ...) - #`(vector #,@(map desc->assertion-stx pieces))] - [`(compound (,_struct-type ,ctor ,_pred ,_getters ,_setters ,_super) ,pieces ...) - #`(#,ctor #,@(map desc->assertion-stx pieces))] - [`(capture ,_ ,p) #`(capture #,(desc->assertion-stx p))] - [`(discard) #'(discard)] - [`(atom ,v) v])) - ) +(provide :bindings) +(define-syntax (:bindings stx) + (syntax-case stx () + [(_ pat-stx) + #`(quote #,(analyse-pattern-bindings #'pat-stx))])) diff --git a/syndicate/schema-compiler.rkt b/syndicate/schema-compiler.rkt index effcfb5..ae6e6b9 100644 --- a/syndicate/schema-compiler.rkt +++ b/syndicate/schema-compiler.rkt @@ -2,14 +2,104 @@ (provide schema-compiler-plugin) +(require racket/pretty) (require racket/match) +(require (only-in racket/file make-parent-directory*)) +(require (only-in racket/syntax format-symbol)) +(require (only-in racket/list append* append-map)) + (require preserves-schema/compiler) +(require preserves-schema/type) +(require preserves-schema/gen/schema) (define (schema-compiler-plugin schema options) (match-define (schema-compiler-options _name lookup-module-path paths) options) (define ds-path (lookup-module-path '(dataspace-patterns))) - (if (equal? ds-path (schema-translation-paths-relative-output-path paths)) - `(begin) - `(begin (require (prefix-in :pat: ,ds-path))))) + (define meta? (equal? ds-path (schema-translation-paths-relative-output-path paths))) + + (define (N sym) + (if meta? + sym + (format-symbol ":pat:~a" sym))) + + (define (def-pattern name def) + (define discard `(,(N 'DDiscard))) + + (define (pat-pattern p) + (match (unwrap p) + [(NamedSimplePattern_ name p) + `(:pattern ,(escape name))] + [(SimplePattern-any) discard] + [(SimplePattern-atom _atomKind) discard] + [(SimplePattern-embedded _interface) discard] + [(SimplePattern-lit value) `(,(N 'DLit) ',value)] + [(SimplePattern-seqof pat) discard] + [(SimplePattern-setof pat) discard] + [(SimplePattern-dictof key-pat value-pat) discard] + [(SimplePattern-Ref (Ref module-path name)) + `(:pattern-ref ,(format-symbol "~a~a" (module-path-prefix module-path) name))] + [(CompoundPattern-rec label-pat fields-pat) + (match* ((unwrap label-pat) (unwrap fields-pat)) + [((SimplePattern-lit label) (CompoundPattern-tuple field-pats)) + `(,(N 'DCompound-rec) + ',label + ,(length field-pats) + (hasheqv ,@(append* (for/list [(i (in-naturals)) + (p (in-list field-pats))] + (define s (pat-pattern p)) + (if (equal? s discard) + `() + `(,i ,s))))))] + [(_ _) `#,(raise-syntax-error ',name "Record schema cannot be used as a pattern")])] + [(CompoundPattern-tuple pats) + `(,(N 'DCompound-arr) + ,(length pats) + (hasheqv ,@(append* (for/list [(i (in-naturals)) + (p (in-list pats))] + (define s (pat-pattern p)) + (if (equal? s discard) + `() + `(,i ,p))))))] + [other (error 'pat-pattern "Unimplemented: ~v" other)])) + + (define fields (match (definition-ty def) + [(ty-unit) '()] + [(ty-record fields) (map escape (map car fields))] + [_ #f])) + + (if (not fields) + `(begin) + `(define-preserves-pattern (,name ,@fields) + ,@(match def + [(? Definition-or?) + `((raise-syntax-error ',name "Union schema cannot be used as a pattern") + (quasisyntax ()))] + [(? Definition-and?) + `((raise-syntax-error ',name "Intersection schema cannot be used as a pattern") + (quasisyntax ()))] + [(Definition-Pattern p) + `((quasisyntax ,(pat-pattern p)) + (append ,@(for/list [(f (in-list fields))] + `(analyse-pattern-bindings (syntax ,f)))))])))) + + (define exprs + `((require (prefix-in :pat: ,ds-path)) + (require syndicate/pattern) + (require (for-syntax racket/base)) + ,@(map-Schema-definitions def-pattern schema))) + + (if meta? + (let ((output-path (path-replace-extension + (schema-translation-paths-full-output-path paths) + ".meta.rkt"))) + (make-parent-directory* output-path) + (with-output-to-file output-path #:exists 'replace + (lambda () + (displayln "#lang racket/base\n") + (for [(e (in-list exprs))] + (pretty-write e) + (newline)))) + `(begin)) + `(begin ,@exprs)))