* [PATCH] Allow user-defined meta-commands
@ 2010-11-01 0:28 Andreas Rottmann
2010-11-01 3:55 ` Jose A. Ortega Ruiz
0 siblings, 1 reply; 2+ messages in thread
From: Andreas Rottmann @ 2010-11-01 0:28 UTC (permalink / raw)
To: Guile Development
[-- Attachment #1: Type: text/plain, Size: 1561 bytes --]
Besides allowing user-defined meta-commands, this change also refactors
the meta-command machinery to split reading a command's arguments from
the procedure actually implementing it, and hence allows nesting
meta-commands. As an example of such a command, ",in" is added as a new
meta-command.
* module/system/repl/command.scm: Export `define-meta-command'.
(*command-module*): Replaced by the hash table `*command-infos*'.
(command-info, make-command-info, command-info-procedure)
(command-info-arguments-reader): New procedures, encapsulating the
information about a meta-command.
(command-procedure): Adapted to use the `command-info' lookup
procedure.
(read-command-arguments): New auxiliary procedure invoking a command's
argument reader procedure.
(meta-command): Adapted to the split of reading arguments and
executing a command.
(add-meta-command!): New auxiliary procedure, registers a meta
command's procedure and argument reader into `*command-infos* and
`*command-table*.
(define-meta-command): Extended to allow specification of the command's
category; split the argument reader and actual command procedure.
(guile:apropos, guile:load, guile:compile-file, guile:gc): Remove these
aliases, they are unnecessary as we now use a hash table instead of the
module to store the commands.
(in): New meta-command, which evaluates an expression, or alternatively
executes another meta-command, in the context of a specific module.
* doc/ref/scheme-using.texi (Module Commands): Document the `in'
meta-command.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: eval-meta-command.diff --]
[-- Type: text/x-diff, Size: 11500 bytes --]
From: Andreas Rottmann <a.rottmann@gmx.at>
Subject: Allow user-defined meta-commands
Besides allowing user-defined meta-commands, this change also refactors
the meta-command machinery to split reading a command's arguments from
the procedure actually implementing it, and hence allows nesting
meta-commands. As an example of such a command, ",in" is added as a new
meta-command.
* module/system/repl/command.scm: Export `define-meta-command'.
(*command-module*): Replaced by the hash table `*command-infos*'.
(command-info, make-command-info, command-info-procedure)
(command-info-arguments-reader): New procedures, encapsulating the
information about a meta-command.
(command-procedure): Adapted to use the `command-info' lookup
procedure.
(read-command-arguments): New auxiliary procedure invoking a command's
argument reader procedure.
(meta-command): Adapted to the split of reading arguments and
executing a command.
(add-meta-command!): New auxiliary procedure, registers a meta
command's procedure and argument reader into `*command-infos* and
`*command-table*.
(define-meta-command): Extended to allow specification of the command's
category; split the argument reader and actual command procedure.
(guile:apropos, guile:load, guile:compile-file, guile:gc): Remove these
aliases, they are unnecessary as we now use a hash table instead of the
module to store the commands.
(in): New meta-command, which evaluates an expression, or alternatively
executes another meta-command, in the context of a specific module.
* doc/ref/scheme-using.texi (Module Commands): Document the `in'
meta-command.
---
doc/ref/scheme-using.texi | 7 ++
module/system/repl/command.scm | 135 +++++++++++++++++++++++++++------------
2 files changed, 100 insertions(+), 42 deletions(-)
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index 223295c..7700cbe 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -227,6 +227,13 @@ Load a file in the current module.
List current bindings.
@end deffn
+@deffn {REPL Command} in module expression
+@deffnx {REPL Command} in module command [args ...]
+Evaluate an expression, or alternatively, execute another meta-command
+in the context of a module. For example, @samp{,in (foo bar) ,binding}
+will show the bindings in the module @code{(foo bar)}.
+@end deffn
+
@node Language Commands
@subsubsection Language Commands
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 4fc2038..9933b0d 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -41,7 +41,7 @@
#:use-module ((ice-9 pretty-print) #:select ((pretty-print . pp)))
#:use-module ((system vm inspect) #:select ((inspect . %inspect)))
#:use-module (statprof)
- #:export (meta-command))
+ #:export (meta-command define-meta-command))
\f
;;;
@@ -50,7 +50,7 @@
(define *command-table*
'((help (help h) (show) (apropos a) (describe d))
- (module (module m) (import use) (load l) (binding b))
+ (module (module m) (import use) (load l) (binding b) (in))
(language (language L))
(compile (compile c) (compile-file cc)
(disassemble x) (disassemble-file xx))
@@ -74,12 +74,22 @@
(define (group-name g) (car g))
(define (group-commands g) (cdr g))
-(define *command-module* (current-module))
+(define *command-infos* (make-hash-table))
(define (command-name c) (car c))
(define (command-abbrevs c) (cdr c))
-(define (command-procedure c) (module-ref *command-module* (command-name c)))
+(define (command-info c) (hashq-ref *command-infos* (command-name c)))
+(define (command-procedure c) (command-info-procedure (command-info c)))
(define (command-doc c) (procedure-documentation (command-procedure c)))
+(define (make-command-info proc arguments-reader)
+ (cons proc arguments-reader))
+
+(define (command-info-procedure info)
+ (car info))
+
+(define (command-info-arguments-reader info)
+ (cdr info))
+
(define (command-usage c)
(let ((doc (command-doc c)))
(substring doc 0 (string-index doc #\newline))))
@@ -148,6 +158,9 @@
(force-output)
*unspecified*)))
+(define (read-command-arguments c repl)
+ ((command-info-arguments-reader (command-info c)) repl))
+
(define read-line
(let ((orig-read-line read-line))
(lambda (repl)
@@ -160,40 +173,56 @@
((not (symbol? command))
(format #t "Meta-command not a symbol: ~s~%" command))
((lookup-command command)
- => (lambda (c) ((command-procedure c) repl)))
+ => (lambda (c)
+ (and=> (read-command-arguments c repl)
+ (lambda (args) (apply (command-procedure c) repl args)))))
(else
(format #t "Unknown meta command: ~A~%" command)))))
+(define (add-meta-command! name category proc argument-reader)
+ (hashq-set! *command-infos* name (make-command-info proc argument-reader))
+ (if category
+ (let ((entry (assq category *command-table*)))
+ (if entry
+ (set-cdr! entry (append (cdr entry) (list (list name))))
+ (set! *command-table*
+ (append *command-table*
+ (list (list category (list name)))))))))
+
(define-syntax define-meta-command
(syntax-rules ()
- ((_ (name repl (expression0 ...) . datums) docstring b0 b1 ...)
- (define (name repl)
- docstring
- (define (handle-read-error form-name key args)
- (pmatch args
- ((,subr ,msg ,args . ,rest)
- (format #t "Throw to key `~a' while reading ~@[argument `~A' of ~]command `~A':\n"
- key form-name 'name)
- (display-error #f (current-output-port) subr msg args rest))
- (else
- (format #t "Throw to key `~a' with args `~s' while reading ~@[ argument `~A' of ~]command `~A'.\n"
- key args form-name 'name)))
- (abort))
-
- (% (let* ((expression0
- (catch #t
- (lambda ()
- (repl-reader ""
- (lambda* (#:optional (port (repl-inport repl)))
- ((language-reader (repl-language repl))
- port (current-module)))))
- (lambda (k . args)
- (handle-read-error 'expression0 k args))))
- ...)
- (apply (lambda* datums
- (with-output-to-port (repl-outport repl)
- (lambda () b0 b1 ...)))
+ ((_ ((name category) repl (expression0 ...) . datums) docstring b0 b1 ...)
+ (add-meta-command!
+ 'name
+ 'category
+ (lambda* (repl expression0 ... . datums)
+ docstring
+ (with-output-to-port (repl-outport repl)
+ (lambda () b0 b1 ...)))
+ (lambda (repl)
+ (define (handle-read-error form-name key args)
+ (pmatch args
+ ((,subr ,msg ,args . ,rest)
+ (format #t "Throw to key `~a' while reading ~@[argument `~A' of ~]command `~A':\n"
+ key form-name 'name)
+ (display-error #f (current-output-port) subr msg args rest))
+ (else
+ (format #t "Throw to key `~a' with args `~s' while reading ~@[ argument `~A' of ~]command `~A'.\n"
+ key args form-name 'name)))
+ (abort))
+ (% (let* ((expression0
(catch #t
+ (lambda ()
+ (repl-reader ""
+ (lambda* (#:optional (port (repl-inport repl)))
+ ((language-reader (repl-language repl))
+ port (current-module)))))
+ (lambda (k . args)
+ (handle-read-error 'expression0 k args))))
+ ...)
+ (append
+ (list expression0 ...)
+ (catch #t
(lambda ()
(let ((port (open-input-string (read-line repl))))
(let lp ((out '()))
@@ -203,10 +232,18 @@
(lp (cons x out)))))))
(lambda (k . args)
(handle-read-error #f k args)))))
- (lambda (k) #f)))) ; the abort handler
+ (lambda (k) #f))))) ; the abort handler
+
+ ((_ ((name category) repl . datums) docstring b0 b1 ...)
+ (define-meta-command ((name category) repl () . datums)
+ docstring b0 b1 ...))
+
+ ((_ (name repl (expression0 ...) . datums) docstring b0 b1 ...)
+ (define-meta-command ((name #f) repl (expression0 ...) . datums)
+ docstring b0 b1 ...))
((_ (name repl . datums) docstring b0 b1 ...)
- (define-meta-command (name repl () . datums)
+ (define-meta-command ((name #f) repl () . datums)
docstring b0 b1 ...))))
@@ -297,11 +334,10 @@ Version information."
(display *version*)
(newline))
-(define guile:apropos apropos)
(define-meta-command (apropos repl regexp)
"apropos REGEXP
Find bindings/modules/packages."
- (guile:apropos (->string regexp)))
+ (apropos (->string regexp)))
(define-meta-command (describe repl (form))
"describe OBJ
@@ -355,11 +391,10 @@ Import modules / List those imported."
(for-each puts (map module-name (module-uses (current-module))))
(for-each use args))))
-(define guile:load load)
(define-meta-command (load repl file)
"load FILE
Load a file in the current module."
- (guile:load (->string file)))
+ (load (->string file)))
(define-meta-command (binding repl)
"binding
@@ -367,6 +402,24 @@ List current bindings."
(module-for-each (lambda (k v) (format #t "~23A ~A\n" k v))
(current-module)))
+(define-meta-command (in repl module command-or-expression . args)
+ "in MODULE COMMAND-OR-EXPRESSION
+Evaluate an expression or command in the context of module."
+ (let ((m (resolve-module module #:ensure #f)))
+ (if m
+ (pmatch command-or-expression
+ (('unquote ,command) (guard (lookup-command command))
+ (save-module-excursion
+ (lambda ()
+ (set-current-module m)
+ (apply (command-procedure (list command)) repl args))))
+ (,expression
+ (guard (null? args))
+ (repl-print repl (eval expression m)))
+ (else
+ (format #t "Invalid arguments to `in': expected a single expression or a command.\n")))
+ (format #t "No such module: ~s\n" module))))
+
\f
;;;
;;; Language commands
@@ -393,11 +446,10 @@ Generate compiled code."
(cond ((objcode? x) (guile:disassemble x))
(else (repl-print repl x)))))
-(define guile:compile-file compile-file)
(define-meta-command (compile-file repl file . opts)
"compile-file FILE
Compile a file."
- (guile:compile-file (->string file) #:opts opts))
+ (compile-file (->string file) #:opts opts))
(define (guile:disassemble x)
((@ (language assembly disassemble) disassemble) x))
@@ -780,11 +832,10 @@ Pretty-print the result(s) of evaluating EXP."
;;; System commands
;;;
-(define guile:gc gc)
(define-meta-command (gc repl)
"gc
Garbage collection."
- (guile:gc))
+ (gc))
(define-meta-command (statistics repl)
"statistics
--
tg: (01a4f0a..) t/eval-meta-command (depends on: master)
[-- Attachment #3: Type: text/plain, Size: 63 bytes --]
Regards, Rotty
--
Andreas Rottmann -- <http://rotty.yi.org/>
^ permalink raw reply related [flat|nested] 2+ messages in thread
* Re: [PATCH] Allow user-defined meta-commands
2010-11-01 0:28 [PATCH] Allow user-defined meta-commands Andreas Rottmann
@ 2010-11-01 3:55 ` Jose A. Ortega Ruiz
0 siblings, 0 replies; 2+ messages in thread
From: Jose A. Ortega Ruiz @ 2010-11-01 3:55 UTC (permalink / raw)
To: guile-devel
On Mon, Nov 01 2010, Andreas Rottmann wrote:
> Besides allowing user-defined meta-commands, this change also refactors
> the meta-command machinery to split reading a command's arguments from
> the procedure actually implementing it, and hence allows nesting
> meta-commands. As an example of such a command, ",in" is added as a new
> meta-command.
As another example of where this patch is useful, i've got a branch of
geiser that uses new meta-commands to implement the interaction between
emacs and guile. Besides making the code cleaner and the interaction
much more robust, it has allowed us to support r6rs libraries. So here's
hope that this patch will be accepted :)
jao
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2010-11-01 3:55 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-11-01 0:28 [PATCH] Allow user-defined meta-commands Andreas Rottmann
2010-11-01 3:55 ` Jose A. Ortega Ruiz
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).