diff --git a/collects/db/main.rkt b/collects/db/main.rkt index 673c48b3e5..3a852f1e54 100644 --- a/collects/db/main.rkt +++ b/collects/db/main.rkt @@ -1,38 +1,28 @@ #lang racket/base (require (for-syntax racket/base) - "private/generic/lazy-require.rkt" - racket/runtime-path + unstable/lazy-require racket/contract "base.rkt") (provide (all-from-out "base.rkt")) -(define-lazy-require-definer define-postgresql "private/postgresql/main.rkt") -(define-lazy-require-definer define-mysql "private/mysql/main.rkt") -(define-lazy-require-definer define-sqlite3 "private/sqlite3/main.rkt") -(define-lazy-require-definer define-odbc "private/odbc/main.rkt") -(define-lazy-require-definer define-openssl 'openssl) - -(define-postgresql - postgresql-connect - postgresql-guess-socket-path - postgresql-password-hash) - -(define-mysql - mysql-connect - mysql-guess-socket-path - mysql-password-hash) - -(define-sqlite3 - sqlite3-connect) - -(define-odbc - odbc-connect - odbc-driver-connect - odbc-data-sources - odbc-drivers) - -(define-openssl - ssl-client-context?) +(lazy-require + ["private/postgresql/main.rkt" + (postgresql-connect + postgresql-guess-socket-path + postgresql-password-hash)] + ["private/mysql/main.rkt" + (mysql-connect + mysql-guess-socket-path + mysql-password-hash)] + ["private/sqlite3/main.rkt" + (sqlite3-connect)] + ["private/odbc/main.rkt" + (odbc-connect + odbc-driver-connect + odbc-data-sources + odbc-drivers)] + ['openssl + (ssl-client-context?)]) (provide/contract ;; Duplicates contracts at postgresql.rkt diff --git a/collects/db/private/generic/dsn.rkt b/collects/db/private/generic/dsn.rkt index 177b659cc1..3100dc1490 100644 --- a/collects/db/private/generic/dsn.rkt +++ b/collects/db/private/generic/dsn.rkt @@ -1,9 +1,8 @@ #lang racket/base -(require "lazy-require.rkt" +(require unstable/lazy-require racket/match racket/file - racket/list - racket/runtime-path) + racket/list) (provide dsn-connect (struct-out data-source) connector? @@ -17,13 +16,11 @@ sqlite3-data-source odbc-data-source) -(define-lazy-require-definer define-main "../../main.rkt") - -(define-main - postgresql-connect - mysql-connect - sqlite3-connect - odbc-connect) +(lazy-require + ["../../main.rkt" (postgresql-connect + mysql-connect + sqlite3-connect + odbc-connect)]) #| DSN v0.1 format diff --git a/collects/db/private/generic/lazy-require.rkt b/collects/db/private/generic/lazy-require.rkt deleted file mode 100644 index 2b217a6ad2..0000000000 --- a/collects/db/private/generic/lazy-require.rkt +++ /dev/null @@ -1,38 +0,0 @@ -#lang racket/base -(require (for-syntax racket/base) - racket/runtime-path - racket/promise) -(provide define-lazy-require-definer) - -(define-syntax (define-lazy-require-definer stx) - (syntax-case stx () - [(_ name modpath) - (begin - (unless (identifier? #'name) - (raise-syntax-error #f "expected identifier" stx #'name)) - #'(begin (define-runtime-module-path-index mpi-var modpath) - (define-syntax name (make-lazy-require-definer #'mpi-var))))])) - -(define-for-syntax (make-lazy-require-definer mpi-var) - (lambda (stx) - (syntax-case stx () - [(_ fun ...) - (begin - (for ([fun (in-list (syntax->list #'(fun ...)))]) - (unless (identifier? fun) - (raise-syntax-error #f "expected identifier for function name" stx fun))) - (with-syntax ([(fun-p ...) (generate-temporaries #'(fun ...))] - [mpi-var mpi-var]) - ;; Use 'delay/sync' because 'delay' promise is not reentrant. - ;; FIXME: OTOH, 'delay/sync' promise is not kill-safe. - #'(begin (define fun-p (delay/sync (dynamic-require mpi-var 'fun))) - ... - (define fun (make-delayed-function 'fun fun-p)) - ...)))]))) - -(define (make-delayed-function name fun-p) - (procedure-rename - (make-keyword-procedure - (lambda (kws kwargs . args) - (keyword-apply (force fun-p) kws kwargs args))) - name)) diff --git a/collects/db/private/generic/place-server.rkt b/collects/db/private/generic/place-server.rkt index 2e6e24c1c2..155007cd95 100644 --- a/collects/db/private/generic/place-server.rkt +++ b/collects/db/private/generic/place-server.rkt @@ -4,7 +4,7 @@ racket/match racket/place racket/serialize - "lazy-require.rkt" + unstable/lazy-require "interfaces.rkt" "prepared.rkt" "sql-data.rkt" @@ -31,12 +31,10 @@ where ::= (list 'sqlite3 path/sym mode-sym delay-num limit-num) (serve client-chan) (loop))) -(define-lazy-require-definer define-main "../../main.rkt") - -(define-main - sqlite3-connect - odbc-connect - odbc-driver-connect) +(lazy-require + ["../../main.rkt" (sqlite3-connect + odbc-connect + odbc-driver-connect)]) (define (serve client-chan) (match (place-channel-get client-chan) diff --git a/collects/unstable/lazy-require.rkt b/collects/unstable/lazy-require.rkt new file mode 100644 index 0000000000..e33b7cbd96 --- /dev/null +++ b/collects/unstable/lazy-require.rkt @@ -0,0 +1,37 @@ +#lang racket/base +(require (for-syntax racket/base) + racket/runtime-path + racket/promise) +(provide lazy-require + (for-syntax #%datum)) + +(define-syntax (lazy-require stx) + (syntax-case stx () + [(lazy-require [modpath (thing ...)] ...) + #`(begin (define-namespace-anchor anchor) + (lazy-require1 modpath (thing ...) anchor #,stx) + ...)])) + +(define-syntax (lazy-require1 stx) + (syntax-case stx () + [(lazy-require1 modpath (name ...) anchor orig-stx) + (with-syntax ([(defn ...) + (for/list ([name (in-list (syntax->list #'(name ...)))]) + (unless (identifier? name) + (raise-syntax-error #f "expected identifier" #'orig-stx name)) + #`(define #,name (make-lazy-function '#,name get-sym)))]) + #'(begin (define-runtime-module-path-index mpi-var modpath) + (define (get-sym sym) + (parameterize ((current-namespace (namespace-anchor->namespace anchor))) + (dynamic-require mpi-var sym))) + defn ...))])) + +(define (make-lazy-function name get-sym) + ;; Use 'delay/sync' because 'delay' promise is not reentrant. + ;; FIXME: OTOH, 'delay/sync' promise is not kill-safe. + (let ([fun-p (delay/sync (get-sym name))]) + (procedure-rename + (make-keyword-procedure + (lambda (kws kwargs . args) + (keyword-apply (force fun-p) kws kwargs args))) + name))) diff --git a/collects/unstable/scribblings/lazy-require.scrbl b/collects/unstable/scribblings/lazy-require.scrbl new file mode 100644 index 0000000000..a7453c8dc6 --- /dev/null +++ b/collects/unstable/scribblings/lazy-require.scrbl @@ -0,0 +1,24 @@ +#lang scribble/manual +@(require scribble/eval + "utils.rkt" + (for-label racket/base + racket/runtime-path + unstable/lazy-require)) + +@title[#:tag "lazy-require"]{Lazy Require} + +@defmodule[unstable/lazy-require] + +@unstable[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]] + +@defform[(lazy-require [mod-expr (imported-fun-id ...)] ...) + #:contracts ([mod-expr module-path?])]{ + +Defines each @racket[imported-fun-id] as a function that, when called, +dynamically requires the export named @racket['imported-fun-id] from +the module specified by @racket[mod-expr] and calls it with the same +arguments. + +As with @racket[define-runtime-module-path-index], @racket[mod-expr] +is evaluated both in phase 0 and phase 1. +} diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl index 3c72f03fbf..61ca638b48 100644 --- a/collects/unstable/scribblings/unstable.scrbl +++ b/collects/unstable/scribblings/unstable.scrbl @@ -88,6 +88,7 @@ Keep documentation and tests up to date. @include-section["generics.scrbl"] @include-section["hash.scrbl"] @include-section["class-iop.scrbl"] ;; Interface-oriented Programming +@include-section["lazy-require.scrbl"] @include-section["list.scrbl"] @include-section["logging.scrbl"] @include-section["markparam.scrbl"]