diff options
Diffstat (limited to 'scheme/racket')
| -rw-r--r-- | scheme/racket/geiser.rkt | 1 | ||||
| -rw-r--r-- | scheme/racket/geiser/eval.rkt | 22 | ||||
| -rw-r--r-- | scheme/racket/geiser/modules.rkt | 6 | ||||
| -rw-r--r-- | scheme/racket/geiser/server.rkt | 24 | ||||
| -rw-r--r-- | scheme/racket/geiser/user.rkt | 57 |
5 files changed, 77 insertions, 33 deletions
diff --git a/scheme/racket/geiser.rkt b/scheme/racket/geiser.rkt index 1ab7983..44a2ed8 100644 --- a/scheme/racket/geiser.rkt +++ b/scheme/racket/geiser.rkt @@ -20,5 +20,6 @@ (require errortrace) (require geiser/user) +(init-geiser-repl) ;;; geiser.rkt ends here diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt index 4e7f3db..78db857 100644 --- a/scheme/racket/geiser/eval.rkt +++ b/scheme/racket/geiser/eval.rkt @@ -17,15 +17,13 @@ compile-file macroexpand make-repl-reader) + (require geiser/enter geiser/modules geiser/autodoc) (require errortrace/errortrace-lib) (define last-result (void)) -(define namespace->module-name - (compose module-path-name->name namespace->module-path-name)) - (define last-namespace (make-parameter (current-namespace))) (define (exn-key e) @@ -55,10 +53,11 @@ (append last-result `((output . ,output))))) (define (eval-in form spec lang) - (call-with-result - (lambda () - (update-signature-cache spec form) - (eval form (module-spec->namespace spec lang))))) + (write (call-with-result + (lambda () + (update-signature-cache spec form) + (eval form (module-spec->namespace spec lang))))) + (newline)) (define compile-in eval-in) @@ -74,10 +73,9 @@ (lambda () (pretty-print (syntax->datum ((if all expand expand-once) form))))))) -(define (make-repl-reader builtin-reader) - (lambda (ns) - (last-namespace ns) - (printf "racket@~a" (namespace->module-name ns)) - (builtin-reader))) +(define (make-repl-reader reader) + (lambda () + (last-namespace (current-namespace)) + (reader))) ;;; eval.rkt ends here diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt index 9b640ec..0591a92 100644 --- a/scheme/racket/geiser/modules.rkt +++ b/scheme/racket/geiser/modules.rkt @@ -14,6 +14,7 @@ (provide load-module ensure-module-spec module-spec->namespace + namespace->module-name namespace->module-path-name module-path-name->name module-spec->path-name @@ -74,11 +75,14 @@ (call-with-values (lambda () (split-path path)) (lambda (_ basename __) (path->string basename))) (regexp-replace "\\.[^./]*$" real-path "")))] - [(eq? path '#%kernel) "(kernel)"] + ;; [(eq? path '#%kernel) "(kernel)"] [(string? path) path] [(symbol? path) (symbol->string path)] [else ""])) +(define namespace->module-name + (compose module-path-name->name namespace->module-path-name)) + (define (skippable-dir? path) (call-with-values (lambda () (split-path path)) (lambda (_ basename __) diff --git a/scheme/racket/geiser/server.rkt b/scheme/racket/geiser/server.rkt new file mode 100644 index 0000000..cf86b2c --- /dev/null +++ b/scheme/racket/geiser/server.rkt @@ -0,0 +1,24 @@ +;;; server.rkt -- REPL server + +;; Copyright (c) 2010 Jose Antonio Ortega Ruiz + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the Modified BSD License. You should +;; have received a copy of the license along with this program. If +;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. + +;; Start date: Sat Nov 06, 2010 15:15 + +#lang racket/base + +(require geiser/user mzlib/thread) +(provide run-geiser-server start-geiser) + +(define (run-geiser-server port enforce-module-constants) + (run-server port + (lambda (in out) + (run-geiser-repl in out enforce-module-constants)) + #f)) + +(define (start-geiser (port 1969) (enforce-module-constants #f)) + (thread (lambda () (run-geiser-server port enforce-module-constants)))) diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt index 20f8a00..37763b9 100644 --- a/scheme/racket/geiser/user.rkt +++ b/scheme/racket/geiser/user.rkt @@ -11,9 +11,10 @@ #lang racket/base -(provide enter!) +(provide init-geiser-repl run-geiser-repl enter!) -(require geiser/main geiser/enter geiser/eval (for-syntax racket/base)) +(require (for-syntax racket/base) + geiser/main geiser/enter geiser/eval geiser/modules) (define top-namespace (current-namespace)) @@ -29,37 +30,53 @@ mod)))) (define orig-loader (current-load/use-compiled)) +(define geiser-loader (module-loader orig-loader)) -(define orig-reader (current-prompt-read)) +(define geiser-send-null (make-parameter #f)) (define (geiser-eval) (define geiser-main (module->namespace 'geiser/main)) - (let* ((mod (read)) - (lang (read)) - (form (read))) + (geiser-send-null #t) + (let* ([mod (read)] + [lang (read)] + [form (read)]) (datum->syntax #f (list 'quote - (cond ((equal? form '(unquote apply)) - (let* ((proc (eval (read) geiser-main)) - (args (read))) - ((geiser:eval lang) `(,proc ,@args) mod))) - (else ((geiser:eval lang) form mod))))))) + (cond [(equal? form '(unquote apply)) + (let* ([proc (eval (read) geiser-main)] + [args (read)]) + ((geiser:eval lang) `(,proc ,@args) mod))] + [else ((geiser:eval lang) form mod)]))))) (define (geiser-read) - (let ((form (orig-reader))) + (if (geiser-send-null) + (begin (geiser-send-null #f) + (write-char #\nul)) + (printf "racket@~a> " (namespace->module-name (current-namespace)))) + (flush-output) + (let* ([in (current-input-port)] + [form ((current-read-interaction) (object-name in) in)]) (syntax-case form () - ((uq cmd) (eq? 'unquote (syntax-e #'uq)) + [(uq cmd) (eq? 'unquote (syntax-e #'uq)) (case (syntax-e #'cmd) ((enter) (enter! (read) #'cmd)) ((geiser-eval) (geiser-eval)) ((geiser-no-values) (datum->syntax #f (void))) - (else form))) - (_ form)))) + (else form))] + [_ form]))) -(define (init) +(define geiser-prompt-read (make-repl-reader geiser-read)) + +(define (init-geiser-repl) (compile-enforce-module-constants #f) - (current-load/use-compiled (module-loader orig-loader)) - (current-prompt-read - (compose (make-repl-reader geiser-read) current-namespace))) + (current-load/use-compiled geiser-loader) + (current-prompt-read geiser-prompt-read)) -(init) +(define (run-geiser-repl in out enforce-module-constants) + (parameterize [(compile-enforce-module-constants enforce-module-constants) + (current-input-port in) + (current-output-port out) + (current-error-port out) + (current-load/use-compiled geiser-loader) + (current-prompt-read geiser-prompt-read)] + (read-eval-print-loop))) |