*** empty log message ***

module/language/elisp/spec.scm

@@ -1,29 +1,59 @@
-;;; Guile Emac Lisp language specification
+;;; Guile Emac Lisp
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
-;; This file is part of Guile VM.
+;; This program is free software; you can redistribute it and/or modify
-
-;; Guile VM is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 ;; 
-;; Guile VM is distributed in the hope that it will be useful,
+;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; 
 ;; You should have received a copy of the GNU General Public License
-;; along with Guile VM; see the file COPYING.  If not, write to
+;; along with this program; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Code:
+
 (define-module (lang elisp spec)
   :use-module (system lang language)
-  :use-module (lang elisp translate)
   :export (elisp))
 
+
+;;;
+;;; Translator
+;;;
+
+(define (translate x)
+  (if (pair? x)
+      (translate-pair x)
+      x))
+
+(define (translate-pair x)
+  (let ((name (car x)) (args (cdr x)))
+    (case name
+      ((quote) `(@quote ,@args))
+      ((defvar) `(@define ,@(map translate args)))
+      ((setq) `(@set! ,@(map translate args)))
+      ((if) `(@if ,(translate (car args))
+		  (@begin ,@(map translate (cdr args)))))
+      ((and) `(@and ,@(map translate args)))
+      ((or) `(@or ,@(map translate args)))
+      ((progn) `(@begin ,@(map translate args)))
+      ((defun) `(@define ,(car args)
+			 (@lambda ,(cadr args) ,@(map translate (cddr args)))))
+      ((lambda) `(@lambda ,(car args) ,@(map translate (cdr args))))
+      (else x))))
+
+
+;;;
+;;; Language definition
+;;;
+
 (define-language elisp
   #:title	"Emacs Lisp"
   #:version	"0.0"

module/language/elisp/translate.scm

@@ -1,45 +0,0 @@
-;;; Emacs Lisp to GHIL translator
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; This file is part of Guile VM.
-
-;; Guile VM is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;; 
-;; Guile VM is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;; 
-;; You should have received a copy of the GNU General Public License
-;; along with Guile VM; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(define-module (lang elisp translate)
-  :export (translate))
-
-(define (translate x) (trans x))
-
-(define (trans x)
-  (if (pair? x)
-      (trans-pair x)
-      x))
-
-(define (trans-pair x)
-  (let ((name (car x)) (args (cdr x)))
-    (case name
-      ((quote) `(@quote ,@args))
-      ((defvar) `(@define ,@(map trans args)))
-      ((setq) `(@set! ,@(map trans args)))
-      ((if) `(@if ,(trans (car args)) (@begin ,@(map trans (cdr args)))))
-      ((and) `(@and ,@(map trans args)))
-      ((or) `(@or ,@(map trans args)))
-      ((progn) `(@begin ,@(map trans args)))
-      ((defun) `(@define ,(car args)
-			 (@lambda ,(cadr args) ,@(map trans (cddr args)))))
-      ((lambda) `(@lambda ,(car args) ,@(map trans (cdr args))))
-      (else x))))

module/language/ghil/spec.scm

@@ -2,21 +2,23 @@
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
-;; Guile VM is free software; you can redistribute it and/or modify
+;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 ;; 
-;; Guile VM is distributed in the hope that it will be useful,
+;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; 
 ;; You should have received a copy of the GNU General Public License
-;; along with Guile VM; see the file COPYING.  If not, write to
+;; along with this program; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Code:
+
 (define-module (language ghil spec)
   :use-module (system base language)
   :export (ghil))

module/language/gscheme/spec.scm

@@ -2,21 +2,23 @@
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
-;; Guile VM is free software; you can redistribute it and/or modify
+;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 ;; 
-;; Guile VM is distributed in the hope that it will be useful,
+;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; 
 ;; You should have received a copy of the GNU General Public License
-;; along with Guile VM; see the file COPYING.  If not, write to
+;; along with this program; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Code:
+
 (define-module (language gscheme spec)
   :use-module (system base language)
   :use-module (ice-9 match)

module/language/r5rs/core.il

@@ -2,23 +2,23 @@
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
-;; This file is part of Guile VM.
+;; This program is free software; you can redistribute it and/or modify
-
-;; Guile VM is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 ;; 
-;; Guile VM is distributed in the hope that it will be useful,
+;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; 
 ;; You should have received a copy of the GNU General Public License
-;; along with Guile VM; see the file COPYING.  If not, write to
+;; along with this program; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Code:
+
 ;; Non standard procedures
 
 (@define void (@lambda () (@void)))

module/language/r5rs/expand.scm

@@ -1,21 +1,23 @@
-;;;; 	Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+;;; R5RS syntax expander
-;;;; 
+
-;;;; This program is free software; you can redistribute it and/or modify
+;; Copyright (C) 2001 Free Software Foundation, Inc.
-;;;; it under the terms of the GNU General Public License as published by
+
-;;;; the Free Software Foundation; either version 2, or (at your option)
+;; This program is free software; you can redistribute it and/or modify
-;;;; any later version.
+;; it under the terms of the GNU General Public License as published by
-;;;; 
+;; the Free Software Foundation; either version 2, or (at your option)
-;;;; This program is distributed in the hope that it will be useful,
+;; any later version.
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; 
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; This program is distributed in the hope that it will be useful,
-;;;; GNU General Public License for more details.
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; 
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; You should have received a copy of the GNU General Public License
+;; GNU General Public License for more details.
-;;;; along with this software; see the file COPYING.  If not, write to
+;; 
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; You should have received a copy of the GNU General Public License
-;;;; Boston, MA 02111-1307 USA
+;; along with this program; see the file COPYING.  If not, write to
-;;;; 
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
 
 (define-module (language r5rs expand)
   :export (expand void

module/language/r5rs/null.il

@@ -2,17 +2,19 @@
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
-;; Guile VM is free software; you can redistribute it and/or modify
+;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 ;; 
-;; Guile VM is distributed in the hope that it will be useful,
+;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; 
 ;; You should have received a copy of the GNU General Public License
-;; along with Guile VM; see the file COPYING.  If not, write to
+;; along with this program; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
+
+;;; Code:

module/language/r5rs/psyntax.boot

@@ -1,21 +1,23 @@
-;;;; 	Copyright (C) 1997, 2000 Free Software Foundation, Inc.
+;;; psyntax.ss -> psyntax.scm
-;;;; 
+
-;;;; This program is free software; you can redistribute it and/or modify
+;; Copyright (C) 2001 Free Software Foundation, Inc.
-;;;; it under the terms of the GNU General Public License as published by
+
-;;;; the Free Software Foundation; either version 2, or (at your option)
+;; This program is free software; you can redistribute it and/or modify
-;;;; any later version.
+;; it under the terms of the GNU General Public License as published by
-;;;; 
+;; the Free Software Foundation; either version 2, or (at your option)
-;;;; This program is distributed in the hope that it will be useful,
+;; any later version.
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; 
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; This program is distributed in the hope that it will be useful,
-;;;; GNU General Public License for more details.
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; 
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; You should have received a copy of the GNU General Public License
+;; GNU General Public License for more details.
-;;;; along with this software; see the file COPYING.  If not, write to
+;; 
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; You should have received a copy of the GNU General Public License
-;;;; Boston, MA 02111-1307 USA
+;; along with this program; see the file COPYING.  If not, write to
-;;;; 
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
 
 (define sc-expand #f)
 (define $sc-put-cte #f)

module/language/r5rs/spec.scm

@@ -1,30 +1,59 @@
-;;; Guile R5RS specification
+;;; Guile R5RS
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
-;; This file is part of Guile VM.
+;; This program is free software; you can redistribute it and/or modify
-
-;; Guile VM is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 ;; 
-;; Guile VM is distributed in the hope that it will be useful,
+;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; 
 ;; You should have received a copy of the GNU General Public License
-;; along with Guile VM; see the file COPYING.  If not, write to
+;; along with this program; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Code:
+
 (define-module (language r5rs spec)
   :use-module (system base language)
   :use-module (language r5rs expand)
   :use-module (language r5rs translate)
   :export (r5rs))
 
+
+;;;
+;;; Translator
+;;;
+
+(define (translate x) (if (pair? x) (translate-pair x) x))
+
+(define (translate-pair x)
+  (let ((name (car x)) (args (cdr x)))
+    (case name
+      ((quote) (cons '@quote args))
+      ((define set! if and or begin)
+       (cons (symbol-append '@ name) (map translate args)))
+      ((let let* letrec)
+       (cons* (symbol-append '@ name)
+	      (map (lambda (b)
+		     (cons (car b) (map translate (cdr b))))
+		   (car args))
+	      (map translate (cdr args))))
+      ((lambda)
+       (cons* '@lambda (car args) (map translate (cdr args))))
+      (else
+       (cons (translate name) (map translate args))))))
+
+
+;;;
+;;; Language definition
+;;;
+
 (define-language r5rs
   :title	"Standard Scheme (R5RS + syntax-case)"
   :version	"0.3"

module/language/r5rs/translate.scm

@@ -1,60 +0,0 @@
-;;; translate.scm --- Scheme to Guile IL translator
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; This file is part of Guile VM.
-
-;; Guile VM is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;; 
-;; Guile VM is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;; 
-;; You should have received a copy of the GNU General Public License
-;; along with Guile VM; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(define-module (language r5rs translate)
-  :export (translate))
-
-(define (translate x) (trans x))
-
-(define (trans x) (if (pair? x) (trans-pair x) x))
-
-(define (trans-pair x)
-  (let ((name (car x)) (args (cdr x)))
-    (let ((il (case name
-		((quote) (cons '@quote args))
-		((define set! if and or begin)
-		 (cons (symbol-append '@ name) (map trans args)))
-		((let let* letrec)
-		 (cons* (symbol-append '@ name)
-			(map (lambda (b)
-			       (cons (car b) (map trans (cdr b))))
-			     (car args))
-			(map trans (cdr args))))
-		((lambda)
-		 (cons* '@lambda (trans-formals (car args))
-			(map trans (cdr args))))
-		(else
-		 (cons (trans name) (map trans args)))))
-	  (props (source-properties x)))
-      (if (not (null? props))
-	  (set-source-properties! il props))
-      il)))
-
-(define (trans-formals formals)
-  (cond ((symbol? formals) `(:rest ,formals))
-	((or (null? formals) (null? (cdr (last-pair formals)))) formals)
-	(else
-	 (let* ((list (list-copy formals))
-		(last (last-pair list)))
-	   (set-cdr! last `(:rest ,(cdr last)))
-	   list))))
-
-;;; translate.scm ends here

module/system/repl/command.gs

@@ -0,0 +1,488 @@
+;;; Repl commands
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define (puts x) (display x) (newline))
+
+(define (user-error msg . args)
+  (throw 'user-error #f msg args #f))
+
+
+;;;
+;;; Meta command
+;;;
+
+(define *command-table*
+  '((help     (help h) (apropos a) (describe d) (option o) (quit q))
+    (module   (module m) (use u) (import i) (load l) (binding b) (lsmod lm))
+    (package  (package p) (lspkg lp) (autopackage) (globals g))
+    (language (language L))
+    (compile  (compile c) (compile-file cc)
+	      (disassemble x) (disassemble-file xx))
+    (profile  (time t) (profile pr))
+    (debug    (backtrace bt) (debugger db) (trace tr) (step st))
+    (system   (statistics stat) (gc))))
+
+(define (group-name g) (car g))
+(define (group-commands g) (cdr g))
+
+(define *command-module* (current-module))
+(define (command-name c) (car c))
+(define (command-abbrev c) (if (null? (cdr c)) #f (cadr c)))
+(define (command-procedure c) (module-ref *command-module* (command-name c)))
+(define (command-doc c) (procedure-documentation (command-procedure c)))
+
+(define (command-usage c)
+  (let ((doc (command-doc c)))
+    (substring doc 0 (string-index doc #\newline))))
+
+(define (command-summary c)
+  (let* ((doc (command-doc c))
+	 (start (1+ (string-index doc #\newline))))
+    (cond ((string-index doc #\newline start)
+	   => (lambda (end) (substring doc start end)))
+	  (else (substring doc start)))))
+
+(define (lookup-group name)
+  (assq name *command-table*))
+
+(define (lookup-command key)
+  (let loop ((groups *command-table*) (commands '()))
+    (cond ((and (null? groups) (null? commands)) #f)
+	  ((null? commands)
+	   (loop (cdr groups) (cdar groups)))
+	  ((memq key (car commands)) (car commands))
+	  (else (loop groups (cdr commands))))))
+
+(define (display-group group . opts)
+  (format #t "~:(~A~) Commands [abbrev]:~2%" (group-name group))
+  (for-each (lambda (c)
+	      (display-summary (command-usage c)
+			       (command-abbrev c)
+			       (command-summary c)))
+	    (group-commands group))
+  (newline))
+
+(define (display-command command)
+  (display "Usage: ")
+  (display (command-doc command))
+  (newline))
+
+(define (display-summary usage abbrev summary)
+  (let ((abbrev (if abbrev (format #f "[,~A]" abbrev) "")))
+    (format #t " ,~24A ~8@A - ~A\n" usage abbrev summary)))
+
+(define (meta-command repl line)
+  (let ((input (call-with-input-string (string-append "(" line ")") read)))
+    (if (not (null? input))
+	(do ((key (car input))
+	     (args (cdr input) (cdr args))
+	     (opts '() (cons (make-keyword-from-dash-symbol (car args)) opts)))
+	    ((or (null? args)
+		 (not (symbol? (car args)))
+		 (not (eq? (string-ref (symbol->string (car args)) 0) #\-)))
+	     (let ((c (lookup-command key)))
+	       (if c
+		   (cond ((memq :h opts) (display-command c))
+			 (else (apply (command-procedure c)
+				      repl (append! args opts))))
+		   (user-error "Unknown meta command: ~A" key))))))))
+
+
+;;;
+;;; Help commands
+;;;
+
+(define (help repl . args)
+  "help [GROUP]
+Show help messages.
+The optional argument can be either one of command groups or
+command names.  Without argument, a list of help commands and
+all command groups are displayed, as you have already seen :)"
+  (match args
+    (()
+     (display-group (lookup-group 'help))
+     (display "Command Groups:\n\n")
+     (display-summary "help all" #f "List all commands")
+     (for-each (lambda (g)
+		 (let* ((name (symbol->string (group-name g)))
+			(usage (string-append "help " name))
+			(header (string-append "List " name " commands")))
+		   (display-summary usage #f header)))
+	       (cdr *command-table*))
+     (newline)
+     (display "Enter `,COMMAND -h' to display documentation of each command.")
+     (newline))
+    (('all)
+     (for-each display-group *command-table*))
+    ((? lookup-group group)
+     (display-group (lookup-group group)))
+    (else (user-error "Unknown command group: ~A" (car args)))))
+
+(define guile-apropos apropos)
+(define (apropos repl regexp)
+  "apropos [options] REGEXP
+Find bindings/modules/packages."
+  (guile-apropos (object->string regexp display)))
+
+(define (describe repl obj)
+  "describe OBJ
+Show description/documentation."
+  (display "Not implemented yet\n"))
+
+(define (option repl . args)
+  "option [KEY [VALUE]]
+List/show/set options."
+  (display "Not implemented yet\n"))
+
+(define (quit repl)
+  "quit
+Quit this session."
+  (throw 'quit))
+
+
+;;;
+;;; Module commands
+;;;
+
+(define (module repl . args)
+  "module [MODULE]
+Change modules / Show current module."
+  (match args
+    (() (puts (binding repl.module)))))
+
+(define (use repl . args)
+  "use [MODULE ...]
+Use modules."
+  (define (use name)
+    (let ((mod (resolve-interface name)))
+      (if mod
+	  (module-use! repl.module mod)
+	  (user-error "No such module: ~A" name))))
+  (if (null? args)
+      (for-each puts (map module-name
+			  (cons repl.module (module-uses repl.module))))
+      (for-each (lambda (name)
+		  (cond
+		   ((pair? name) (use name))
+		   ((symbol? name)
+		    (cond ((find-one-module (symbol->string name)) => use)))
+		   (else (user-error "Invalid module name: ~A" name))))
+		args)))
+
+(define (import repl . args)
+  "import [MODULE ...]
+Import modules / List those imported."
+  (define (use name)
+    (let ((mod (resolve-interface name)))
+      (if mod
+	  (module-use! repl.module mod)
+	  (user-error "No such module: ~A" name))))
+  (if (null? args)
+      (for-each puts (map module-name
+			  (cons repl.module (module-uses repl.module))))
+      (for-each (lambda (name)
+		  (cond
+		   ((pair? name) (use name))
+		   ((symbol? name)
+		    (and-let* ((m (find-one-module (symbol->string name))))
+		      (puts m) (use m)))
+		   (else (user-error "Invalid module name: ~A" name))))
+		args)))
+
+(define (load repl file . opts)
+  "load [options] FILE
+Load a file in the current module."
+  (apply repl-load-file repl (->string file) opts))
+
+(define (binding repl . opts)
+  "binding [-a]
+List current bindings."
+  (fold (lambda (s v d) (format #t "~23A ~A\n" s v)) #f repl.module))
+
+(define (lsmod repl . args)
+  "lsmod
+."
+  (define (use name)
+    (set! repl.module (resolve-module name))
+    (module-use! repl.module repl.value-history))
+  (if (null? args)
+      (use '(guile-user))
+      (let ((name (car args)))
+	(cond
+	 ((pair? name) (use name))
+	 ((symbol? name)
+	  (and-let* ((m (find-one-module (symbol->string name))))
+	    (puts m) (use m)))
+	 (else (user-error "Invalid module name: ~A" name))))))
+
+
+;;;
+;;; Package commands
+;;;
+
+(define (package repl)
+  "package [PACKAGE]
+List available packages/modules."
+  (for-each puts (find-module "")))
+
+(define (lspkg repl)
+  "lspkg
+List available packages/modules."
+  (for-each puts (find-module "")))
+
+(define (autopackage repl)
+  "autopackage
+List available packages/modules."
+  (for-each puts (find-module "")))
+
+(define (globals repl)
+  "globals
+List all global variables."
+  (global-fold (lambda (s v d) (format #t "~A\t~S\n" s v)) #f))
+
+
+;;;
+;;; Language commands
+;;;
+
+(define (language repl name)
+  "language LANGUAGE
+Change languages."
+  (set! repl.language (lookup-language name))
+  (repl-welcome repl))
+
+
+;;;
+;;; Compile commands
+;;;
+
+(define (compile repl form . opts)
+  "compile [options] FORM
+Generate compiled code.
+
+  -e    Stop after expanding syntax/macro
+  -t    Stop after translating into GHIL
+  -c    Stop after generating GLIL
+  -l    Stop before linking
+  -o    Compile into bytecode
+
+  -O    Enable optimization
+  -D    Add debug information"
+  (let ((x (apply repl-compile repl form opts)))
+    (cond ((null? opts)
+	   (disassemble-program x))
+	  ((memq :l opts)
+	   (disassemble-bytecode x))
+	  ((memq :c opts)
+	   (pprint-glil x))
+	  (else
+	   (puts x)))))
+
+(define (compile-file repl file . opts)
+  "compile-file [options] FILE
+Compile a file."
+  (apply repl-compile-file repl (->string file) opts))
+
+(define (disassemble repl prog)
+  "disassemble PROGRAM
+Disassemble a program."
+  (disassemble-program (repl.vm (repl-compile repl prog))))
+
+(define (disassemble-file repl file)
+  "disassemble-file FILE
+Disassemble a file."
+  (disassemble-bytecode (load-file-in (->string file)
+				      repl.module
+				      repl.language)))
+
+(define (->string x)
+  (object->string x display))
+
+
+;;;
+;;; Profile commands
+;;;
+
+(define (profile repl form . opts)
+  "profile FORM
+Profile execution."
+  (apply vm-profile repl.vm (repl-compile repl form) opts))
+
+
+;;;
+;;; Debug commands
+;;;
+
+(define guile-backtrace backtrace)
+(define (backtrace repl)
+  "backtrace
+Show backtrace (if any)."
+  (guile-backtrace))
+
+(define (debugger repl)
+  "debugger
+Start debugger."
+  (debug))
+
+(define (trace repl form . opts)
+  "trace [-a] FORM
+Trace execution."
+  (apply vm-trace repl.vm (repl-compile repl form) opts))
+
+(define (step repl)
+  "step FORM
+Step execution."
+  (display "Not implemented yet\n"))
+
+
+;;;
+;;; System commands 
+;;;
+
+(define (time repl form)
+  "time FORM
+Time execution."
+  (let* ((vms-start (vm-stats repl.vm))
+	 (gc-start (gc-run-time))
+	 (tms-start (times))
+	 (result (repl-eval repl form))
+	 (tms-end (times))
+	 (gc-end (gc-run-time))
+	 (vms-end (vm-stats repl.vm)))
+    (define (get proc start end)
+      (/ (- (proc end) (proc start)) internal-time-units-per-second))
+    (repl-print repl result)
+    (display "clock utime stime cutime cstime gctime\n")
+    (format #t "~5,2F ~5,2F ~5,2F ~6,2F ~6,2F ~6,2F\n"
+	    (get tms:clock tms-start tms-end)
+	    (get tms:utime tms-start tms-end)
+	    (get tms:stime tms-start tms-end)
+	    (get tms:cutime tms-start tms-end)
+	    (get tms:cstime tms-start tms-end)
+	    (get id gc-start gc-end))
+    result))
+
+;;;
+;;; Statistics
+;;;
+
+(define guile-gc gc)
+(define (gc repl)
+  "gc
+Garbage collection."
+  (guile-gc))
+
+(define (display-stat title flag field1 field2 unit)
+  (let ((str (format #f "~~20~AA ~~10@A /~~10@A ~~A~~%" (if flag "" "@"))))
+    (format #t str title field1 field2 unit)))
+
+(define (display-stat-title title field1 field2)
+  (display-stat title #t field1 field2 ""))
+
+(define (display-diff-stat title flag this last unit)
+  (display-stat title flag (- this last) this unit))
+
+(define (display-time-stat title this last)
+  (define (conv num)
+    (format #f "~10,2F" (/ num internal-time-units-per-second)))
+  (display-stat title #f (conv (- this last)) (conv this) "s"))
+
+(define (display-mips-stat title this-time this-clock last-time last-clock)
+  (define (mips time clock)
+    (if (= time 0) "----" (format #f "~10,2F" (/ clock time 1000000))))
+  (display-stat title #f
+		(mips (- this-time last-time) (- this-clock last-clock))
+		(mips this-time this-clock) "mips"))
+
+(define (statistics repl)
+  "statistics
+Display statistics."
+  (let ((this-tms (times))
+	(this-vms (vm-stats repl.vm))
+	(this-gcs (gc-stats))
+	(last-tms repl.tm-stats)
+	(last-vms repl.vm-stats)
+	(last-gcs repl.gc-stats))
+    ;; GC times
+    (let ((this-times  (assq-ref this-gcs 'gc-times))
+	  (last-times  (assq-ref last-gcs 'gc-times)))
+      (display-diff-stat "GC times:" #t this-times last-times "times")
+      (newline))
+    ;; Memory size
+    (let ((this-cells  (assq-ref this-gcs 'cells-allocated))
+	  (this-heap   (assq-ref this-gcs 'cell-heap-size))
+	  (this-bytes  (assq-ref this-gcs 'bytes-malloced))
+	  (this-malloc (assq-ref this-gcs 'gc-malloc-threshold)))
+      (display-stat-title "Memory size:" "current" "limit")
+      (display-stat "heap" #f this-cells this-heap "cells")
+      (display-stat "malloc" #f this-bytes this-malloc "bytes")
+      (newline))
+    ;; Cells collected
+    (let ((this-marked (assq-ref this-gcs 'cells-marked))
+	  (last-marked (assq-ref last-gcs 'cells-marked))
+	  (this-swept  (assq-ref this-gcs 'cells-swept))
+	  (last-swept  (assq-ref last-gcs 'cells-swept)))
+      (display-stat-title "Cells collected:" "diff" "total")
+      (display-diff-stat "marked" #f this-marked last-marked "cells")
+      (display-diff-stat "swept" #f this-swept last-swept "cells")
+      (newline))
+    ;; GC time taken
+    (let ((this-mark  (assq-ref this-gcs 'gc-mark-time-taken))
+	  (last-mark  (assq-ref last-gcs 'gc-mark-time-taken))
+	  (this-sweep (assq-ref this-gcs 'gc-sweep-time-taken))
+	  (last-sweep (assq-ref last-gcs 'gc-sweep-time-taken))
+	  (this-total (assq-ref this-gcs 'gc-time-taken))
+	  (last-total (assq-ref last-gcs 'gc-time-taken)))
+      (display-stat-title "GC time taken:" "diff" "total")
+      (display-time-stat "mark" this-mark last-mark)
+      (display-time-stat "sweep" this-sweep last-sweep)
+      (display-time-stat "total" this-total last-total)
+      (newline))
+    ;; Process time spent
+    (let ((this-utime  (tms:utime this-tms))
+	  (last-utime  (tms:utime last-tms))
+	  (this-stime  (tms:stime this-tms))
+	  (last-stime  (tms:stime last-tms))
+	  (this-cutime (tms:cutime this-tms))
+	  (last-cutime (tms:cutime last-tms))
+	  (this-cstime (tms:cstime this-tms))
+	  (last-cstime (tms:cstime last-tms)))
+      (display-stat-title "Process time spent:" "diff" "total")
+      (display-time-stat "user" this-utime last-utime)
+      (display-time-stat "system" this-stime last-stime)
+      (display-time-stat "child user" this-cutime last-cutime)
+      (display-time-stat "child system" this-cstime last-cstime)
+      (newline))
+    ;; VM statistics
+    (let ((this-time  (vms:time this-vms))
+	  (last-time  (vms:time last-vms))
+	  (this-clock (vms:clock this-vms))
+	  (last-clock (vms:clock last-vms)))
+      (display-stat-title "VM statistics:" "diff" "total")
+      (display-time-stat "time spent" this-time last-time)
+      (display-diff-stat "bogoclock" #f this-clock last-clock "clock")
+      (display-mips-stat "bogomips" this-time this-clock last-time last-clock)
+      (newline))
+    ;; Save statistics
+    ;; Save statistics
+    (set! repl.tm-stats this-tms)
+    (set! repl.vm-stats this-vms)
+    (set! repl.gc-stats this-gcs)))

module/system/repl/command.scm

@@ -1,4 +1,4 @@
-;;; REPL commands
+;;; Repl commands
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
@@ -35,4 +35,4 @@
   :use-module (ice-9 debugger)
   :export (meta-command))
 
-(load "command.gsm")
+(load "command.gs")

module/system/repl/common.scm

@@ -1,4 +1,4 @@
-;;; common.scm --- Repl common routines
+;;; Repl common routines
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
@@ -89,5 +89,3 @@
 (define (repl-load-file repl file . opts)
   (let ((bytes (apply load-file-in file repl.module repl.language opts)))
     (repl.vm (vm-load repl.vm bytes))))
-
-;;; common.scm ends here

module/system/repl/describe.scm

@@ -1,4 +1,4 @@
-;;; describe.scm --- describe objects
+;;; Describe objects
 
 ;; Copyright (C) 2001 Free Software Foundation, Inc.
 
@@ -360,5 +360,3 @@
 (define-method (display-documentation (obj <method>))
   (let ((doc (procedure-documentation (method-procedure obj))))
     (if doc (format-documentation doc) (next-method))))
-
-;;; describe.scm ends here