mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
replace cenv with things in <repl> and fluids; remove the `use' meta-command
* module/system/base/compile.scm (<cenv>): No more cenv, it was a useless data structure. * module/system/repl/command.scm (*command-table*): Remove `use', it's the same as `import'. Otherwise in this file, adapt to the repl having direct pointers to the vm and the language, and to the module being in the current-module fluid. * module/system/repl/repl.scm (prompting-meta-read): * module/system/repl/common.scm (<repl>): The repl now has a direct pointer to the vm and language. Adapt accordingly.
This commit is contained in:
parent
cd9d95d760
commit
db917b4152
4 changed files with 39 additions and 73 deletions
|
@ -28,8 +28,7 @@
|
|||
:select (the-vm vm-load objcode->u8vector))
|
||||
:use-module (system vm assemble)
|
||||
:use-module (ice-9 regex)
|
||||
:export (<cenv> make-cenv cenv? cenv-vm cenv-language cenv-module
|
||||
syntax-error compile-file load-source-file load-file
|
||||
:export (syntax-error compile-file load-source-file load-file
|
||||
compiled-file-name
|
||||
scheme-eval read-file-in compile-in))
|
||||
|
||||
|
@ -37,8 +36,6 @@
|
|||
;;; Compiler environment
|
||||
;;;
|
||||
|
||||
(define-record (<cenv> vm language module))
|
||||
|
||||
(define (syntax-error loc msg exp)
|
||||
(throw 'syntax-error loc msg exp))
|
||||
|
||||
|
|
|
@ -44,7 +44,7 @@
|
|||
|
||||
(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))
|
||||
(module (module m) (import i) (load l) (binding b))
|
||||
(language (language L))
|
||||
(compile (compile c) (compile-file cc)
|
||||
(disassemble x) (disassemble-file xx))
|
||||
|
@ -176,7 +176,7 @@ List/show/set options."
|
|||
(repl-option-set! repl key val)
|
||||
(case key
|
||||
((trace)
|
||||
(let ((vm (cenv-vm (repl-env repl))))
|
||||
(let ((vm (repl-vm repl)))
|
||||
(if val
|
||||
(apply vm-trace-on vm val)
|
||||
(vm-trace-off vm))))))))
|
||||
|
@ -195,27 +195,8 @@ Quit this session."
|
|||
"module [MODULE]
|
||||
Change modules / Show current module."
|
||||
(pmatch args
|
||||
(() (puts (binding (cenv-module (repl-env repl)))))))
|
||||
|
||||
(define (use repl . args)
|
||||
"use [MODULE ...]
|
||||
Use modules."
|
||||
(define (use name)
|
||||
(let ((mod (resolve-interface name)))
|
||||
(if mod
|
||||
(module-use! (cenv-module (repl-env repl)) mod)
|
||||
(user-error "No such module: ~A" name))))
|
||||
(if (null? args)
|
||||
(for-each puts (map module-name
|
||||
(cons (cenv-module (repl-env repl))
|
||||
(module-uses (cenv-module (repl-env repl))))))
|
||||
(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)))
|
||||
(() (puts (module-name (current-module))))
|
||||
((,mod-name) (set-current-module (resolve-module mod-name)))))
|
||||
|
||||
(define (import repl . args)
|
||||
"import [MODULE ...]
|
||||
|
@ -223,20 +204,11 @@ Import modules / List those imported."
|
|||
(define (use name)
|
||||
(let ((mod (resolve-interface name)))
|
||||
(if mod
|
||||
(module-use! (cenv-module (repl-env repl)) mod)
|
||||
(module-use! (current-module) mod)
|
||||
(user-error "No such module: ~A" name))))
|
||||
(if (null? args)
|
||||
(for-each puts (map module-name
|
||||
(cons (cenv-module (repl-env repl))
|
||||
(module-uses (cenv-module (repl-env repl))))))
|
||||
(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)))
|
||||
(for-each puts (map module-name (module-uses (current-module))))
|
||||
(for-each use args)))
|
||||
|
||||
(define (load repl file . opts)
|
||||
"load FILE
|
||||
|
@ -247,13 +219,13 @@ Load a file in the current module.
|
|||
(objcode (if (memq :f opts)
|
||||
(apply load-source-file file opts)
|
||||
(apply load-file file opts))))
|
||||
(vm-load (cenv-vm (repl-env repl)) objcode)))
|
||||
(vm-load (repl-vm repl) objcode)))
|
||||
|
||||
(define (binding repl . opts)
|
||||
"binding
|
||||
List current bindings."
|
||||
(fold (lambda (s v d) (format #t "~23A ~A\n" s v)) #f
|
||||
(cenv-module (repl-env repl))))
|
||||
(module-for-each (lambda (k v) (format #t "~23A ~A\n" k v))
|
||||
(current-module)))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -263,7 +235,7 @@ List current bindings."
|
|||
(define (language repl name)
|
||||
"language LANGUAGE
|
||||
Change languages."
|
||||
(set! (cenv-language (repl-env repl)) (lookup-language name))
|
||||
(set! (repl-language repl) (lookup-language name))
|
||||
(repl-welcome repl))
|
||||
|
||||
|
||||
|
@ -310,13 +282,13 @@ Disassemble a file."
|
|||
(define (time repl form)
|
||||
"time FORM
|
||||
Time execution."
|
||||
(let* ((vms-start (vm-stats (cenv-vm (repl-env repl))))
|
||||
(let* ((vms-start (vm-stats (repl-vm repl)))
|
||||
(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 (cenv-vm (repl-env repl)))))
|
||||
(vms-end (vm-stats (repl-vm repl))))
|
||||
(define (get proc start end)
|
||||
(/ (- (proc end) (proc start)) internal-time-units-per-second))
|
||||
(repl-print repl result)
|
||||
|
@ -334,7 +306,7 @@ Time execution."
|
|||
"profile FORM
|
||||
Profile execution."
|
||||
(apply vm-profile
|
||||
(cenv-vm (repl-env repl))
|
||||
(repl-vm repl)
|
||||
(repl-compile repl form)
|
||||
opts))
|
||||
|
||||
|
@ -346,12 +318,12 @@ Profile execution."
|
|||
(define (backtrace repl)
|
||||
"backtrace
|
||||
Display backtrace."
|
||||
(vm-backtrace (cenv-vm (repl-env repl))))
|
||||
(vm-backtrace (repl-vm repl)))
|
||||
|
||||
(define (debugger repl)
|
||||
"debugger
|
||||
Start debugger."
|
||||
(vm-debugger (cenv-vm (repl-env repl))))
|
||||
(vm-debugger (repl-vm repl)))
|
||||
|
||||
(define (trace repl form . opts)
|
||||
"trace FORM
|
||||
|
@ -361,7 +333,7 @@ Trace execution.
|
|||
-l Display local variables
|
||||
-e Display external variables
|
||||
-b Bytecode level trace"
|
||||
(apply vm-trace (cenv-vm (repl-env repl)) (repl-compile repl form) opts))
|
||||
(apply vm-trace (repl-vm repl) (repl-compile repl form) opts))
|
||||
|
||||
(define (step repl)
|
||||
"step FORM
|
||||
|
@ -383,7 +355,7 @@ Garbage collection."
|
|||
"statistics
|
||||
Display statistics."
|
||||
(let ((this-tms (times))
|
||||
(this-vms (vm-stats (cenv-vm (repl-env repl))))
|
||||
(this-vms (vm-stats (repl-vm repl)))
|
||||
(this-gcs (gc-stats))
|
||||
(last-tms (repl-tm-stats repl))
|
||||
(last-vms (repl-vm-stats repl))
|
||||
|
|
|
@ -24,8 +24,8 @@
|
|||
:use-module (system base compile)
|
||||
:use-module (system base language)
|
||||
:use-module (system vm core)
|
||||
:export (<repl> make-repl repl-env repl-options repl-tm-stats
|
||||
repl-gc-stats repl-vm-stats
|
||||
:export (<repl> make-repl repl-vm repl-language repl-options
|
||||
repl-tm-stats repl-gc-stats repl-vm-stats
|
||||
repl-welcome repl-prompt repl-read repl-compile repl-eval
|
||||
repl-print repl-option-ref repl-option-set!
|
||||
puts ->string user-error))
|
||||
|
@ -35,50 +35,47 @@
|
|||
;;; Repl type
|
||||
;;;
|
||||
|
||||
(define-record (<repl> env options tm-stats gc-stats vm-stats))
|
||||
(define-record (<repl> vm language options tm-stats gc-stats vm-stats))
|
||||
|
||||
(define repl-default-options
|
||||
'((trace . #f)))
|
||||
|
||||
(define %make-repl make-repl)
|
||||
(define (make-repl lang)
|
||||
(let ((cenv (make-cenv :vm (the-vm)
|
||||
:language (lookup-language lang)
|
||||
:module (current-module))))
|
||||
(%make-repl :env cenv
|
||||
:options repl-default-options
|
||||
:tm-stats (times)
|
||||
:gc-stats (gc-stats)
|
||||
:vm-stats (vm-stats (cenv-vm cenv)))))
|
||||
(%make-repl :vm (the-vm)
|
||||
:language (lookup-language lang)
|
||||
:options repl-default-options
|
||||
:tm-stats (times)
|
||||
:gc-stats (gc-stats)
|
||||
:vm-stats (vm-stats (the-vm))))
|
||||
|
||||
(define (repl-welcome repl)
|
||||
(let ((language (cenv-language (repl-env repl))))
|
||||
(let ((language (repl-language repl)))
|
||||
(format #t "~A interpreter ~A on Guile ~A\n"
|
||||
(language-title language) (language-version language) (version)))
|
||||
(display "Copyright (C) 2001 Free Software Foundation, Inc.\n\n")
|
||||
(display "Copyright (C) 2001-2008 Free Software Foundation, Inc.\n\n")
|
||||
(display "Enter `,help' for help.\n"))
|
||||
|
||||
(define (repl-prompt repl)
|
||||
(format #f "~A@~A> " (language-name (cenv-language (repl-env repl)))
|
||||
(module-name (cenv-module (repl-env repl)))))
|
||||
(format #f "~A@~A> " (language-name (repl-language repl))
|
||||
(module-name (current-module))))
|
||||
|
||||
(define (repl-read repl)
|
||||
((language-reader (cenv-language (repl-env repl)))))
|
||||
((language-reader (repl-language repl))))
|
||||
|
||||
(define (repl-compile repl form . opts)
|
||||
(apply compile-in form (cenv-module (repl-env repl))
|
||||
(cenv-language (repl-env repl)) opts))
|
||||
(apply compile-in form (current-module) (repl-language repl) opts))
|
||||
|
||||
(define (repl-eval repl form)
|
||||
(let ((eval (language-evaluator (cenv-language (repl-env repl)))))
|
||||
(let ((eval (language-evaluator (repl-language repl))))
|
||||
(if eval
|
||||
(eval form (cenv-module (repl-env repl)))
|
||||
(vm-load (cenv-vm (repl-env repl)) (repl-compile repl form)))))
|
||||
(eval form (current-module))
|
||||
(vm-load (repl-vm repl) (repl-compile repl form)))))
|
||||
|
||||
(define (repl-print repl val)
|
||||
(if (not (eq? val *unspecified*))
|
||||
(begin
|
||||
((language-printer (cenv-language (repl-env repl))) val)
|
||||
((language-printer (repl-language repl)) val)
|
||||
(newline))))
|
||||
|
||||
(define (repl-option-ref repl key)
|
||||
|
|
|
@ -45,7 +45,7 @@
|
|||
;; to be able to re-use the existing readline machinery.
|
||||
(define (prompting-meta-read repl)
|
||||
(let ((prompt (lambda () (repl-prompt repl)))
|
||||
(lread (language-reader (cenv-language (repl-env repl)))))
|
||||
(lread (language-reader (repl-language repl))))
|
||||
(with-fluid* current-reader (meta-reader lread)
|
||||
(lambda () (repl-reader (lambda () (repl-prompt repl)))))))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue