*** empty log message ***

[bpt/guile.git] / module / system / repl / command.scm

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 1d37472..4a08eda 100644 (file)
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -24,10 +24,13 @@
   :use-module (system base compile)
   :use-module (system repl common)
   :use-module (system vm core)
+  :autoload (system base language) (lookup-language)
   :autoload (system il glil) (pprint-glil)
   :autoload (system vm disasm) (disassemble-program disassemble-objcode)
-  :autoload (system vm trace) (vm-trace)
+  :autoload (system vm trace) (vm-trace vm-trace-on vm-trace-off)
   :autoload (system vm profile) (vm-profile)
+  :autoload (system vm debugger) (vm-debugger)
+  :autoload (system vm backtrace) (vm-backtrace)
   :use-module (ice-9 format)
   :use-module (ice-9 session)
   :use-module (ice-9 documentation))
@@ -44,8 +47,8 @@
     (compile  (compile c) (compile-file cc)
              (disassemble x) (disassemble-file xx))
     (profile  (time t) (profile pr))
-    (debug    (backtrace bt) (debugger db) (trace r) (step st))
-    (system   (gc) (statistics st))))
+    (debug    (backtrace bt) (debugger db) (trace tr) (step st))
+    (system   (gc) (statistics stat))))
 
 (define (group-name g) (car g))
 (define (group-commands g) (cdr g))
@@ -109,7 +112,7 @@
               (if c
                   (cond ((memq :h opts) (display-command c))
                         (else (apply (command-procedure c)
-                                     repl (append! args opts))))
+                                     repl (append! args (reverse! opts)))))
                   (user-error "Unknown meta command: ~A" key))))))))
 
 \f
@@ -159,7 +162,21 @@ Show description/documentation."
 (define (option repl . args)
   "option [KEY VALUE]
 List/show/set options."
-  (display "Not implemented yet\n"))
+  (match args
+    (()
+     (for-each (lambda (key+val)
+                (format #t "~A\t~A\n" (car key+val) (cdr key+val)))
+              repl.options))
+    ((key)
+     (display (repl-option-ref repl key))
+     (newline))
+    ((key val)
+     (repl-option-set! repl key val)
+     (case key
+       ((trace)
+       (if val
+           (apply vm-trace-on repl.env.vm val)
+           (vm-trace-off repl.env.vm)))))))
 
 (define (quit repl)
   "quit
@@ -221,15 +238,12 @@ Import modules / List those imported."
   "load FILE
 Load a file in the current module.
 
-  -f    Load source file (see `compile')
-  -r    Trace loading (see `trace')"
+  -f    Load source file (see `compile')"
   (let* ((file (->string file))
         (objcode (if (memq :f opts)
                      (apply load-source-file file opts)
                      (apply load-file file opts))))
-    (if (memq :r opts)
-       (apply vm-trace repl.env.vm objcode opts)
-       (vm-load repl.env.vm objcode))))
+    (vm-load repl.env.vm objcode)))
 
 (define (binding repl . opts)
   "binding
@@ -267,10 +281,11 @@ Generate compiled code.
          ((memq :c opts) (pprint-glil x))
          (else (disassemble-objcode x)))))
 
+(define guile:compile-file compile-file)
 (define (compile-file repl file . opts)
   "compile-file FILE
 Compile a file."
-  (apply repl-compile-file repl (->string file) opts))
+  (apply guile:compile-file (->string file) opts))
 
 (define (disassemble repl prog)
   "disassemble PROGRAM
@@ -320,16 +335,15 @@ Profile execution."
 ;;; Debug commands
 ;;;
 
-(define guile:backtrace backtrace)
 (define (backtrace repl)
   "backtrace
-Show backtrace (if any)."
-  (guile:backtrace))
+Display backtrace."
+  (vm-backtrace repl.env.vm))
 
 (define (debugger repl)
   "debugger
 Start debugger."
-  (debug))
+  (vm-debugger repl.env.vm))
 
 (define (trace repl form . opts)
   "trace FORM