1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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:
Andy Wingo 2008-05-12 22:26:31 +02:00
parent cd9d95d760
commit db917b4152
4 changed files with 39 additions and 73 deletions

View file

@ -28,8 +28,7 @@
:select (the-vm vm-load objcode->u8vector)) :select (the-vm vm-load objcode->u8vector))
:use-module (system vm assemble) :use-module (system vm assemble)
:use-module (ice-9 regex) :use-module (ice-9 regex)
:export (<cenv> make-cenv cenv? cenv-vm cenv-language cenv-module :export (syntax-error compile-file load-source-file load-file
syntax-error compile-file load-source-file load-file
compiled-file-name compiled-file-name
scheme-eval read-file-in compile-in)) scheme-eval read-file-in compile-in))
@ -37,8 +36,6 @@
;;; Compiler environment ;;; Compiler environment
;;; ;;;
(define-record (<cenv> vm language module))
(define (syntax-error loc msg exp) (define (syntax-error loc msg exp)
(throw 'syntax-error loc msg exp)) (throw 'syntax-error loc msg exp))

View file

@ -44,7 +44,7 @@
(define *command-table* (define *command-table*
'((help (help h) (apropos a) (describe d) (option o) (quit q)) '((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)) (language (language L))
(compile (compile c) (compile-file cc) (compile (compile c) (compile-file cc)
(disassemble x) (disassemble-file xx)) (disassemble x) (disassemble-file xx))
@ -176,7 +176,7 @@ List/show/set options."
(repl-option-set! repl key val) (repl-option-set! repl key val)
(case key (case key
((trace) ((trace)
(let ((vm (cenv-vm (repl-env repl)))) (let ((vm (repl-vm repl)))
(if val (if val
(apply vm-trace-on vm val) (apply vm-trace-on vm val)
(vm-trace-off vm)))))))) (vm-trace-off vm))))))))
@ -195,27 +195,8 @@ Quit this session."
"module [MODULE] "module [MODULE]
Change modules / Show current module." Change modules / Show current module."
(pmatch args (pmatch args
(() (puts (binding (cenv-module (repl-env repl))))))) (() (puts (module-name (current-module))))
((,mod-name) (set-current-module (resolve-module mod-name)))))
(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)))
(define (import repl . args) (define (import repl . args)
"import [MODULE ...] "import [MODULE ...]
@ -223,20 +204,11 @@ Import modules / List those imported."
(define (use name) (define (use name)
(let ((mod (resolve-interface name))) (let ((mod (resolve-interface name)))
(if mod (if mod
(module-use! (cenv-module (repl-env repl)) mod) (module-use! (current-module) mod)
(user-error "No such module: ~A" name)))) (user-error "No such module: ~A" name))))
(if (null? args) (if (null? args)
(for-each puts (map module-name (for-each puts (map module-name (module-uses (current-module))))
(cons (cenv-module (repl-env repl)) (for-each use args)))
(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)))
(define (load repl file . opts) (define (load repl file . opts)
"load FILE "load FILE
@ -247,13 +219,13 @@ Load a file in the current module.
(objcode (if (memq :f opts) (objcode (if (memq :f opts)
(apply load-source-file file opts) (apply load-source-file file opts)
(apply load-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) (define (binding repl . opts)
"binding "binding
List current bindings." List current bindings."
(fold (lambda (s v d) (format #t "~23A ~A\n" s v)) #f (module-for-each (lambda (k v) (format #t "~23A ~A\n" k v))
(cenv-module (repl-env repl)))) (current-module)))
;;; ;;;
@ -263,7 +235,7 @@ List current bindings."
(define (language repl name) (define (language repl name)
"language LANGUAGE "language LANGUAGE
Change languages." Change languages."
(set! (cenv-language (repl-env repl)) (lookup-language name)) (set! (repl-language repl) (lookup-language name))
(repl-welcome repl)) (repl-welcome repl))
@ -310,13 +282,13 @@ Disassemble a file."
(define (time repl form) (define (time repl form)
"time FORM "time FORM
Time execution." 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)) (gc-start (gc-run-time))
(tms-start (times)) (tms-start (times))
(result (repl-eval repl form)) (result (repl-eval repl form))
(tms-end (times)) (tms-end (times))
(gc-end (gc-run-time)) (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) (define (get proc start end)
(/ (- (proc end) (proc start)) internal-time-units-per-second)) (/ (- (proc end) (proc start)) internal-time-units-per-second))
(repl-print repl result) (repl-print repl result)
@ -334,7 +306,7 @@ Time execution."
"profile FORM "profile FORM
Profile execution." Profile execution."
(apply vm-profile (apply vm-profile
(cenv-vm (repl-env repl)) (repl-vm repl)
(repl-compile repl form) (repl-compile repl form)
opts)) opts))
@ -346,12 +318,12 @@ Profile execution."
(define (backtrace repl) (define (backtrace repl)
"backtrace "backtrace
Display backtrace." Display backtrace."
(vm-backtrace (cenv-vm (repl-env repl)))) (vm-backtrace (repl-vm repl)))
(define (debugger repl) (define (debugger repl)
"debugger "debugger
Start debugger." Start debugger."
(vm-debugger (cenv-vm (repl-env repl)))) (vm-debugger (repl-vm repl)))
(define (trace repl form . opts) (define (trace repl form . opts)
"trace FORM "trace FORM
@ -361,7 +333,7 @@ Trace execution.
-l Display local variables -l Display local variables
-e Display external variables -e Display external variables
-b Bytecode level trace" -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) (define (step repl)
"step FORM "step FORM
@ -383,7 +355,7 @@ Garbage collection."
"statistics "statistics
Display statistics." Display statistics."
(let ((this-tms (times)) (let ((this-tms (times))
(this-vms (vm-stats (cenv-vm (repl-env repl)))) (this-vms (vm-stats (repl-vm repl)))
(this-gcs (gc-stats)) (this-gcs (gc-stats))
(last-tms (repl-tm-stats repl)) (last-tms (repl-tm-stats repl))
(last-vms (repl-vm-stats repl)) (last-vms (repl-vm-stats repl))

View file

@ -24,8 +24,8 @@
:use-module (system base compile) :use-module (system base compile)
:use-module (system base language) :use-module (system base language)
:use-module (system vm core) :use-module (system vm core)
:export (<repl> make-repl repl-env repl-options repl-tm-stats :export (<repl> make-repl repl-vm repl-language repl-options
repl-gc-stats repl-vm-stats repl-tm-stats repl-gc-stats repl-vm-stats
repl-welcome repl-prompt repl-read repl-compile repl-eval repl-welcome repl-prompt repl-read repl-compile repl-eval
repl-print repl-option-ref repl-option-set! repl-print repl-option-ref repl-option-set!
puts ->string user-error)) puts ->string user-error))
@ -35,50 +35,47 @@
;;; Repl type ;;; 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 (define repl-default-options
'((trace . #f))) '((trace . #f)))
(define %make-repl make-repl) (define %make-repl make-repl)
(define (make-repl lang) (define (make-repl lang)
(let ((cenv (make-cenv :vm (the-vm) (%make-repl :vm (the-vm)
:language (lookup-language lang) :language (lookup-language lang)
:module (current-module))))
(%make-repl :env cenv
:options repl-default-options :options repl-default-options
:tm-stats (times) :tm-stats (times)
:gc-stats (gc-stats) :gc-stats (gc-stats)
:vm-stats (vm-stats (cenv-vm cenv))))) :vm-stats (vm-stats (the-vm))))
(define (repl-welcome repl) (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" (format #t "~A interpreter ~A on Guile ~A\n"
(language-title language) (language-version language) (version))) (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")) (display "Enter `,help' for help.\n"))
(define (repl-prompt repl) (define (repl-prompt repl)
(format #f "~A@~A> " (language-name (cenv-language (repl-env repl))) (format #f "~A@~A> " (language-name (repl-language repl))
(module-name (cenv-module (repl-env repl))))) (module-name (current-module))))
(define (repl-read repl) (define (repl-read repl)
((language-reader (cenv-language (repl-env repl))))) ((language-reader (repl-language repl))))
(define (repl-compile repl form . opts) (define (repl-compile repl form . opts)
(apply compile-in form (cenv-module (repl-env repl)) (apply compile-in form (current-module) (repl-language repl) opts))
(cenv-language (repl-env repl)) opts))
(define (repl-eval repl form) (define (repl-eval repl form)
(let ((eval (language-evaluator (cenv-language (repl-env repl))))) (let ((eval (language-evaluator (repl-language repl))))
(if eval (if eval
(eval form (cenv-module (repl-env repl))) (eval form (current-module))
(vm-load (cenv-vm (repl-env repl)) (repl-compile repl form))))) (vm-load (repl-vm repl) (repl-compile repl form)))))
(define (repl-print repl val) (define (repl-print repl val)
(if (not (eq? val *unspecified*)) (if (not (eq? val *unspecified*))
(begin (begin
((language-printer (cenv-language (repl-env repl))) val) ((language-printer (repl-language repl)) val)
(newline)))) (newline))))
(define (repl-option-ref repl key) (define (repl-option-ref repl key)

View file

@ -45,7 +45,7 @@
;; to be able to re-use the existing readline machinery. ;; to be able to re-use the existing readline machinery.
(define (prompting-meta-read repl) (define (prompting-meta-read repl)
(let ((prompt (lambda () (repl-prompt 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) (with-fluid* current-reader (meta-reader lread)
(lambda () (repl-reader (lambda () (repl-prompt repl))))))) (lambda () (repl-reader (lambda () (repl-prompt repl)))))))