From db917b415291a54a75451f54eb66b9aa88af8e51 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 12 May 2008 22:26:31 +0200 Subject: [PATCH] replace cenv with things in and fluids; remove the `use' meta-command * module/system/base/compile.scm (): 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 (): The repl now has a direct pointer to the vm and language. Adapt accordingly. --- module/system/base/compile.scm | 5 +-- module/system/repl/command.scm | 64 ++++++++++------------------------ module/system/repl/common.scm | 41 ++++++++++------------ module/system/repl/repl.scm | 2 +- 4 files changed, 39 insertions(+), 73 deletions(-) diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 88256c2f2..fed52711e 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -28,8 +28,7 @@ :select (the-vm vm-load objcode->u8vector)) :use-module (system vm assemble) :use-module (ice-9 regex) - :export ( 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 ( vm language module)) - (define (syntax-error loc msg exp) (throw 'syntax-error loc msg exp)) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index b30bae390..8254f3fdb 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -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)) diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index d6039bec8..cbc8bc48e 100644 --- a/module/system/repl/common.scm +++ b/module/system/repl/common.scm @@ -24,8 +24,8 @@ :use-module (system base compile) :use-module (system base language) :use-module (system vm core) - :export ( make-repl repl-env repl-options repl-tm-stats - repl-gc-stats repl-vm-stats + :export ( 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 ( env options tm-stats gc-stats vm-stats)) +(define-record ( 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) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 5142e58d1..06fb56021 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -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)))))))