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

language-readers receive environment as an arg

Browse source 
* module/language/assembly/spec.scm:
* module/language/brainfuck/spec.scm:
* module/language/bytecode/spec.scm:
* module/language/ecmascript/spec.scm:
* module/language/glil/spec.scm:
* module/language/scheme/spec.scm:
* module/language/tree-il/spec.scm: Language-readers now take two
  arguments: the port and the environment. This should allow for
  compile-environment-specific reader behavior.

* module/system/base/compile.scm (read-and-compile):
* module/system/repl/common.scm (repl-read): Pass the environment to the
  language-reader.

* module/system/repl/repl.scm (meta-reader, prompting-meta-read):
* module/system/repl/command.scm (define-meta-command): Use the second
  argument to repl-reader, so we avoid frobbing current-reader.
This commit is contained in:
Andy Wingo 2009-10-16 13:39:24 +02:00
parent a58b7fbb7e
commit 4b2afc6258
11 changed files with 47 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/language/assembly/spec.scm
View file

@ -1,6 +1,6 @@
;;; Guile Virtual Machine Assembly
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -27,7 +27,7 @@
(define-language assembly
#:title "Guile Virtual Machine Assembly Language"
#:version "2.0"
#:reader read
#:reader (lambda (port env) (read port))
#:printer write
#:parser read ;; fixme: make a verifier?
#:compilers `((bytecode . ,compile-bytecode))

2
module/language/brainfuck/spec.scm
View file

@ -37,7 +37,7 @@
(define-language brainfuck
#:title "Guile Brainfuck"
#:version "1.0"
#:reader (lambda () (read-brainfuck (current-input-port)))
#:reader (lambda (port env) (read-brainfuck port))
#:compilers `((tree-il . ,compile-tree-il)
(scheme . ,compile-scheme))
#:printer write

4
module/language/bytecode/spec.scm
View file

@ -1,6 +1,6 @@
;;; Guile Lowlevel Intermediate Language
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -32,7 +32,7 @@
(define-language bytecode
#:title "Guile Bytecode Vectors"
#:version "0.3"
#:reader read
#:reader (lambda (port env) (read port))
#:printer write
#:compilers `((objcode . ,compile-objcode))
#:decompilers `((objcode . ,decompile-objcode))

2
module/language/ecmascript/spec.scm
View file

@ -31,7 +31,7 @@
(define-language ecmascript
#:title "Guile ECMAScript"
#:version "3.0"
#:reader (lambda () (read-ecmascript/1 (current-input-port)))
#:reader (lambda (port env) (read-ecmascript/1 port))
#:compilers `((tree-il . ,compile-tree-il))
;; a pretty-printer would be interesting.
#:printer write

4
module/language/glil/spec.scm
View file

@ -1,6 +1,6 @@
;;; Guile Lowlevel Intermediate Language
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -34,7 +34,7 @@
(define-language glil
#:title "Guile Lowlevel Intermediate Language (GLIL)"
#:version "0.3"
#:reader read
#:reader (lambda (port env) (read port))
#:printer write-glil
#:parser parse-glil
#:compilers `((assembly . ,compile-asm))

25
module/language/scheme/spec.scm
View file

@ -38,19 +38,18 @@
(define-language scheme
#:title "Guile Scheme"
#:version "0.5"
#:reader (lambda args
;; Read using the compilation environment's current reader.
;; Don't use the current module's `current-reader' because
;; it might be set, e.g., to the REPL's reader, so we'd
;; enter an infinite recursion.
;; FIXME: Handle `read-options' as well.
(let* ((mod (current-compilation-environment))
(cr (and (module? mod)
(module-ref mod 'current-reader)))
(read (if (and cr (fluid-ref cr))
(fluid-ref cr)
read)))
(apply read args)))
#:reader (lambda (port env)
;; Use the binding of current-reader from the environment.
;; FIXME: Handle `read-options' as well?
((or (and=> (and=> (module-variable
(cond ((pair? env) (car env))
(env)
(else (current-module)))
'current-reader)
variable-ref)
fluid-ref)
read)
port))
#:compilers `((tree-il . ,compile-tree-il))
#:decompilers `((tree-il . ,decompile-tree-il))

2
module/language/tree-il/spec.scm
View file

@ -34,7 +34,7 @@
(define-language tree-il
#:title "Tree Intermediate Language"
#:version "1.0"
#:reader read
#:reader (lambda (port env) (read port))
#:printer write-tree-il
#:parser parse-tree-il
#:joiner join

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

@ -235,7 +235,7 @@ function should only be called from stages in the compiler tower."
(language-default-environment from))))
(let lp ((exps '()) (env #f)
(cenv (fluid-ref *compilation-environment*)))
(let ((x ((language-reader (current-language)) port)))
(let ((x ((language-reader (current-language)) port env)))
(cond
((eof-object? x)
(compile ((language-joiner joint) (reverse exps) env)

10
module/system/repl/command.scm
View file

@ -133,9 +133,13 @@
(define (name repl)
docstring
(let* ((expression0
(with-fluid* current-reader
(language-reader (repl-language repl))
(lambda () (repl-reader ""))))
(repl-reader ""
(lambda args
(let ((port (if (pair? args)
(car args)
(current-input-port))))
((language-reader (repl-language repl))
port (current-module))))))
...)
(apply (lambda datums b0 b1 ...)
(let ((port (open-input-string (read-line repl))))

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

@ -61,7 +61,8 @@
(module-name (current-module))))
(define (repl-read repl)
((language-reader (repl-language repl))))
((language-reader (repl-language repl)) (current-input-port)
(current-module)))
(define (repl-compile repl form . opts)
(let ((to (lookup-language (cond ((memq #:e opts) 'scheme)

33
module/system/repl/repl.scm
View file

@ -32,29 +32,28 @@
(define meta-command-token (cons 'meta 'command))
(define (meta-reader read)
(define (meta-reader read env)
(lambda read-args
(with-input-from-port
(if (pair? read-args) (car read-args) (current-input-port))
(lambda ()
(let ((ch (next-char #t)))
(cond ((eof-object? ch)
;; apparently sometimes even if this is eof, read will
;; wait on somethingorother. strange.
ch)
((eqv? ch #\,)
(read-char)
meta-command-token)
(else (read))))))))
(let ((port (if (pair? read-args) (car read-args) (current-input-port))))
(with-input-from-port port
(lambda ()
(let ((ch (next-char #t)))
(cond ((eof-object? ch)
;; apparently sometimes even if this is eof, read will
;; wait on somethingorother. strange.
ch)
((eqv? ch #\,)
(read-char port)
meta-command-token)
(else (read port env)))))))))
;; repl-reader is a function defined in boot-9.scm, and is replaced by
;; something else if readline has been activated. much of this hoopla is
;; to be able to re-use the existing readline machinery.
(define (prompting-meta-read repl)
(let ((prompt (lambda () (repl-prompt repl)))
(lread (language-reader (repl-language repl))))
(with-fluid* current-reader (meta-reader lread)
(lambda () (repl-reader prompt)))))
(repl-reader (lambda () (repl-prompt repl))
(meta-reader (language-reader (repl-language repl))
(current-module))))
(define (default-catch-handler . args)
(pmatch args