mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

finish dedottifying

Browse source 
* module/system/base/compile.scm: Dedottify.

* module/system/base/language.scm: Export language accessors.

* module/system/repl/common.scm: Dedottify. It's ugly, I know.
This commit is contained in:
Andy Wingo 2008-05-04 16:25:36 +02:00
parent ce0925e14e
commit 44f38a1f36
3 changed files with 23 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/system/base/compile.scm
View file

@ -112,16 +112,16 @@
;;;
(define-public (read-file-in file lang)
(call-with-input-file file lang.read-file))
(call-with-input-file file (language-read-file lang)))
(define-public (compile-in x e lang . opts)
(catch 'result
(lambda ()
;; expand
(set! x (lang.expander x e))
(set! x ((language-expander lang) x e))
(if (memq :e opts) (throw 'result x))
;; translate
(set! x (lang.translator x e))
(set! x ((language-translator lang) x e))
(if (memq :t opts) (throw 'result x))
;; compile
(set! x (apply compile x e opts))

5
module/system/base/language.scm
View file

@ -21,7 +21,10 @@
(define-module (system base language)
:use-syntax (system base syntax)
:export (define-language lookup-language))
:export (define-language lookup-language
language-name language-title language-version language-reader
language-printer language-read-file language-expander
language-translator language-evaluator language-environment))
;;;

30
module/system/repl/common.scm
View file

@ -46,42 +46,44 @@
:options repl-default-options
:tm-stats (times)
:gc-stats (gc-stats)
:vm-stats (vm-stats cenv.vm))))
:vm-stats (vm-stats (cenv-vm cenv)))))
(define-public (repl-welcome repl)
(format #t "~A interpreter ~A on Guile ~A\n"
repl.env.language.title repl.env.language.version (version))
(let ((language (cenv-language (repl-env 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 "Enter `,help' for help.\n"))
(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)))
(format #t "~A@~A> " (language-name (cenv-language (repl-env repl)))
(module-name (cenv-module (repl-env repl))))
(force-output))
(define-public (repl-read repl)
(repl.env.language.reader))
((language-reader (cenv-language (repl-env repl)))))
(define-public (repl-compile repl form . opts)
(apply compile-in form repl.env.module repl.env.language opts))
(apply compile-in form (cenv-module (repl-env repl))
(cenv-language (repl-env repl)) opts))
(define-public (repl-eval repl form)
(let ((eval repl.env.language.evaluator))
(let ((eval (language-evaluator (cenv-language (repl-env repl)))))
(if eval
(eval form repl.env.module)
(vm-load repl.env.vm (repl-compile repl form)))))
(eval form (cenv-module (repl-env repl)))
(vm-load (cenv-vm (repl-env repl)) (repl-compile repl form)))))
(define-public (repl-print repl val)
(if (not (eq? val *unspecified*))
(begin
(repl.env.language.printer val)
((language-printer (cenv-language (repl-env repl))) val)
(newline))))
(define-public (repl-option-ref repl key)
(assq-ref repl.options key))
(assq-ref (repl-options repl) key))
(define-public (repl-option-set! repl key val)
(set! repl.options (assq-set! repl.options key val)))
(set! (repl-options repl) (assq-set! (repl-options repl) key val)))
;;;