summaryrefslogtreecommitdiff
path: root/module/system/repl
diff options
context:
space:
mode:
Diffstat (limited to 'module/system/repl')
-rw-r--r--module/system/repl/.cvsignore1
-rw-r--r--module/system/repl/command.scm205
-rw-r--r--module/system/repl/common.scm86
-rw-r--r--module/system/repl/describe.scm19
-rw-r--r--module/system/repl/repl.scm6
5 files changed, 136 insertions, 181 deletions
diff --git a/module/system/repl/.cvsignore b/module/system/repl/.cvsignore
new file mode 100644
index 000000000..e796b66a8
--- /dev/null
+++ b/module/system/repl/.cvsignore
@@ -0,0 +1 @@
+*.go
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index c665499d1..1d374722a 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -21,37 +21,31 @@
(define-module (system repl command)
:use-syntax (system base syntax)
- :use-module (system base language)
+ :use-module (system base compile)
:use-module (system repl common)
- :use-module (system il glil)
:use-module (system vm core)
+ :autoload (system il glil) (pprint-glil)
+ :autoload (system vm disasm) (disassemble-program disassemble-objcode)
:autoload (system vm trace) (vm-trace)
- :autoload (system vm disasm) (disassemble-program disassemble-dumpcode)
:autoload (system vm profile) (vm-profile)
:use-module (ice-9 format)
:use-module (ice-9 session)
- :export (meta-command))
-
-(define (puts x) (display x) (newline))
-
-(define (user-error msg . args)
- (throw 'user-error #f msg args #f))
+ :use-module (ice-9 documentation))
;;;
-;;; Meta command
+;;; Meta command interface
;;;
(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))
+ (module (module m) (use u) (import i) (load l) (binding b))
(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))))
+ (debug (backtrace bt) (debugger db) (trace r) (step st))
+ (system (gc) (statistics st))))
(define (group-name g) (car g))
(define (group-commands g) (cdr g))
@@ -102,7 +96,7 @@
(let ((abbrev (if abbrev (format #f "[,~A]" abbrev) "")))
(format #t " ,~24A ~8@A - ~A\n" usage abbrev summary)))
-(define (meta-command repl line)
+(define-public (meta-command repl line)
(let ((input (call-with-input-string (string-append "(" line ")") read)))
(if (not (null? input))
(do ((key (car input))
@@ -125,10 +119,10 @@
(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 :)"
+List available meta commands.
+A command group name can be given as an optional argument.
+Without any argument, a list of help commands and command groups
+are displayed, as you have already seen ;)"
(match args
(()
(display-group (lookup-group 'help))
@@ -141,27 +135,29 @@ all command groups are displayed, as you have already seen :)"
(display-summary usage #f header)))
(cdr *command-table*))
(newline)
- (display "Enter `,COMMAND -h' to display documentation of each command.")
+ (display "Type `,COMMAND -h' to show 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)))))
+ (else
+ (user-error "Unknown command group: ~A" (car args)))))
-(define guile-apropos apropos)
+(define guile:apropos apropos)
(define (apropos repl regexp)
- "apropos [options] REGEXP
+ "apropos REGEXP
Find bindings/modules/packages."
- (guile-apropos (object->string regexp display)))
+ (guile:apropos (->string regexp)))
(define (describe repl obj)
"describe OBJ
Show description/documentation."
- (display "Not implemented yet\n"))
+ (display (object-documentation (repl-eval repl obj)))
+ (newline))
(define (option repl . args)
- "option [KEY [VALUE]]
+ "option [KEY VALUE]
List/show/set options."
(display "Not implemented yet\n"))
@@ -179,7 +175,7 @@ Quit this session."
"module [MODULE]
Change modules / Show current module."
(match args
- (() (puts (binding repl.module)))))
+ (() (puts (binding repl.env.module)))))
(define (use repl . args)
"use [MODULE ...]
@@ -187,11 +183,12 @@ Use modules."
(define (use name)
(let ((mod (resolve-interface name)))
(if mod
- (module-use! repl.module mod)
+ (module-use! repl.env.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))))
+ (cons repl.env.module
+ (module-uses repl.env.module))))
(for-each (lambda (name)
(cond
((pair? name) (use name))
@@ -206,11 +203,11 @@ Import modules / List those imported."
(define (use name)
(let ((mod (resolve-interface name)))
(if mod
- (module-use! repl.module mod)
+ (module-use! repl.env.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))))
+ (cons repl.env.module (module-uses repl.env.module))))
(for-each (lambda (name)
(cond
((pair? name) (use name))
@@ -221,55 +218,23 @@ Import modules / List those imported."
args)))
(define (load repl file . opts)
- "load [options] FILE
-Load a file in the current module."
- (apply repl-load-file repl (->string file) opts))
+ "load FILE
+Load a file in the current module.
+
+ -f Load source file (see `compile')
+ -r Trace loading (see `trace')"
+ (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))))
(define (binding repl . opts)
- "binding [-a]
+ "binding
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))
+ (fold (lambda (s v d) (format #t "~23A ~A\n" s v)) #f repl.env.module))
;;;
@@ -279,7 +244,7 @@ List all global variables."
(define (language repl name)
"language LANGUAGE
Change languages."
- (set! repl.language (lookup-language name))
+ (set! repl.env.language (lookup-language name))
(repl-welcome repl))
@@ -288,7 +253,7 @@ Change languages."
;;;
(define (compile repl form . opts)
- "compile [options] FORM
+ "compile FORM
Generate compiled code.
-e Stop after expanding syntax/macro
@@ -300,10 +265,10 @@ Generate compiled code.
(let ((x (apply repl-compile repl form opts)))
(cond ((or (memq :e opts) (memq :t opts)) (puts x))
((memq :c opts) (pprint-glil x))
- (else (disassemble-dumpcode x)))))
+ (else (disassemble-objcode x)))))
(define (compile-file repl file . opts)
- "compile-file [options] FILE
+ "compile-file FILE
Compile a file."
(apply repl-compile-file repl (->string file) opts))
@@ -315,31 +280,51 @@ Disassemble a program."
(define (disassemble-file repl file)
"disassemble-file FILE
Disassemble a file."
- (disassemble-dumpcode (load-dumpcode (->string file))))
-
-(define (->string x)
- (object->string x display))
+ (disassemble-objcode (load-objcode (->string file))))
;;;
;;; Profile commands
;;;
+(define (time repl form)
+ "time FORM
+Time execution."
+ (let* ((vms-start (vm-stats repl.env.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.env.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 identity gc-start gc-end))
+ result))
+
(define (profile repl form . opts)
"profile FORM
Profile execution."
- (apply vm-profile repl.vm (repl-compile repl form) opts))
+ (apply vm-profile repl.env.vm (repl-compile repl form) opts))
;;;
;;; Debug commands
;;;
-(define guile-backtrace backtrace)
+(define guile:backtrace backtrace)
(define (backtrace repl)
"backtrace
Show backtrace (if any)."
- (guile-backtrace))
+ (guile:backtrace))
(define (debugger repl)
"debugger
@@ -347,9 +332,14 @@ Start debugger."
(debug))
(define (trace repl form . opts)
- "trace [-b] FORM
-Trace execution."
- (apply vm-trace repl.vm (repl-compile repl form) opts))
+ "trace FORM
+Trace execution.
+
+ -s Display stack
+ -l Display local variables
+ -e Display external variables
+ -b Bytecode level trace"
+ (apply vm-trace repl.env.vm (repl-compile repl form) opts))
(define (step repl)
"step FORM
@@ -361,44 +351,17 @@ Step execution."
;;; 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))
-
-(define guile-gc gc)
+(define guile:gc gc)
(define (gc repl)
"gc
Garbage collection."
- (guile-gc))
-
-;;;
-;;; Statistics
-;;;
+ (guile:gc))
(define (statistics repl)
"statistics
Display statistics."
(let ((this-tms (times))
- (this-vms (vm-stats repl.vm))
+ (this-vms (vm-stats repl.env.vm))
(this-gcs (gc-stats))
(last-tms repl.tm-stats)
(last-vms repl.vm-stats)
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 651bd5205..4bd8986a9 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -22,70 +22,66 @@
(define-module (system repl common)
:use-module (oop goops)
:use-syntax (system base syntax)
+ :use-module (system base compile)
:use-module (system base language)
:use-module (system vm core)
- :use-module (system vm trace)
- :export (make-repl repl-welcome repl-prompt repl-read repl-compile
- repl-eval repl-print repl-compile-file repl-load-file))
+ :use-module (system vm trace))
;;;
-;;; Repl
+;;; Repl type
;;;
-(define-vm-class <repl> ()
- vm language module value-count value-history tm-stats vm-stats gc-stats)
+(define-vm-class <repl> () env tm-stats vm-stats gc-stats)
-(define (make-repl lang)
- (let ((vm (the-vm)))
+(define-public (make-repl lang)
+ (let ((cenv (make-cenv :vm (the-vm)
+ :language (lookup-language lang)
+ :module (current-module))))
(make <repl>
- :vm vm
- :language (lookup-language lang)
- :module (current-module) ;; (global-ref 'user)
- :value-count 0
-; :value-history (make-vmodule)
+ :env cenv
:tm-stats (times)
- :vm-stats (vm-stats vm)
+ :vm-stats (vm-stats cenv.vm)
:gc-stats (gc-stats))))
-(define (repl-welcome repl)
+(define-public (repl-welcome repl)
(format #t "~A interpreter ~A on Guile ~A\n"
- repl.language.title repl.language.version (version))
+ repl.env.language.title repl.env.language.version (version))
(display "Copyright (C) 2001 Free Software Foundation, Inc.\n\n")
(display "Enter `,help' for help.\n"))
-(define (repl-prompt repl)
- (format #t "~A@~A> " repl.language.name 'guile)
- ;; (env-identifier repl.module))
- (force-output))
+(define-public (repl-prompt repl)
+ (let ((module-name (car (last-pair (module-name repl.env.module)))))
+ (format #t "~A@~A> " repl.env.language.name module-name)
+ (force-output)))
-(define (repl-read repl . args)
- (apply read-in repl.language args))
+(define-public (repl-read repl)
+ (repl.env.language.reader))
-(define (repl-compile repl form . opts)
- (apply compile-in form repl.module repl.language opts))
+(define-public (repl-compile repl form . opts)
+ (apply compile-in form repl.env.module repl.env.language opts))
-(define (repl-eval repl form)
- (let ((eval repl.language.evaluator))
+(define-public (repl-eval repl form)
+ (let ((eval repl.env.language.evaluator))
(if eval
- (eval form repl.module)
- (vm-load repl.vm (repl-compile repl form)))))
+ (eval form repl.env.module)
+ (vm-load repl.env.vm (repl-compile repl form)))))
-(define (repl-print repl val)
+(define-public (repl-print repl val)
(if (not (eq? val *unspecified*))
- (let* ((num (1+ repl.value-count))
- (sym (string->symbol (format #f "$~A" num))))
-; (vmodule-define repl.value-history sym val)
- (format #t "~A = " sym)
- (print-in val repl.language)
- (newline)
- (set! repl.value-count num))))
-
-(define (repl-compile-file repl file . opts)
- (apply compile-file-in file repl.language opts))
-
-(define (repl-load-file repl file . opts)
- (let ((bytes (apply repl-compile-file repl file opts)))
- (if (or (memq :b opts) (memq :r opts))
- (apply vm-trace repl.vm bytes opts)
- (vm-load repl.vm bytes))))
+ (begin
+ (repl.env.language.printer val)
+ (newline))))
+
+
+;;;
+;;; Utilities
+;;;
+
+(define-public (puts x) (display x) (newline))
+
+(define-public (->string x)
+ (object->string x display))
+
+(define-public (user-error msg . args)
+ (throw 'user-error #f msg args #f))
diff --git a/module/system/repl/describe.scm b/module/system/repl/describe.scm
index 966ea7d46..15f0b0b04 100644
--- a/module/system/repl/describe.scm
+++ b/module/system/repl/describe.scm
@@ -22,16 +22,15 @@
(define-module (system repl describe)
:use-module (oop goops)
:use-module (ice-9 regex)
- :use-module (ice-9 format))
+ :use-module (ice-9 format)
+ :use-module (ice-9 and-let-star)
+ :export (describe))
-(define *describe-format* #t)
-
-(define-public (describe symbol)
- (assert symbol? symbol)
+(define-method (describe (symbol <symbol>))
(format #t "`~s' is " symbol)
(if (not (defined? symbol))
(display "not defined in the current module.\n")
- (describe-object (eval symbol))))
+ (describe-object (module-ref (current-module) symbol))))
;;;
@@ -302,13 +301,13 @@
;;; Instances
;;;
-(define-method display-type ((obj <object>))
+(define-method (display-type (obj <object>))
(display-class <object> "an instance")
(display " of class ")
(display-class (class-of obj))
(display ".\n"))
-(define-method display-value ((obj <object>))
+(define-method (display-value (obj <object>))
(display-slot-list #f obj (class-slots (class-of obj))))
@@ -316,13 +315,13 @@
;;; Generic functions
;;;
-(define-method display-type ((obj <generic>))
+(define-method (display-type (obj <generic>))
(display-class <generic> "a generic function")
(display " of class ")
(display-class (class-of obj))
(display ".\n"))
-(define-method display-value ((obj <generic>))
+(define-method (display-value (obj <generic>))
(display-list #f (generic-function-methods obj)))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 5c01c8b3a..73473af8c 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -23,14 +23,11 @@
:use-syntax (system base syntax)
:use-module (system repl common)
:use-module (system repl command)
- :use-module (system vm frame)
:use-module (ice-9 rdelim)
:export (start-repl))
(define (start-repl lang)
(let ((repl (make-repl lang)))
-;; (set-current-vmodule! repl.module)
-;; (set-current-evaluator! repl.vm)
(repl-welcome repl)
(let prompt-loop ()
(repl-prompt repl)
@@ -38,8 +35,7 @@
(lambda ()
(if (eq? (next-char #t) #\,)
;; meta command
- (begin (read-char)
- (meta-command repl (read-line)))
+ (begin (read-char) (meta-command repl (read-line)))
;; evaluation
(let rep-loop ()
(repl-print repl (repl-eval repl (repl-read repl)))