;;; 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
(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))
(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
;;; 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
(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))
(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
;;; 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
(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))
(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))
(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
(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)
(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))))
(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)
(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
HCoop / bpt / guile.git / commitdiff