lexer: Port to Mes.
* gash/compat.scm [mes] (define-inlinable): New syntax. [mes] (*fluid-accessor*): New variable. [mes] (make-parameter): New procedure. [mes] (parameterize): New syntax. [mes] (set-port-line!): New procedure. [mes] (string-every): New procedure. * gash/compat/textual-ports.scm [mes] (<soft-input-port>): New record type. [mes] (make-soft-port): New procedure. [mes] (push-soft-input-port-buffer!): New procedure. [mes] (pop-soft-input-port-buffer!): New procedure. [mes] (get-char): New procedure. [mes] (unget-char): New procedure. [mes] (lookahead-char): New procedure. * gash/lexer.scm: Import '(gash compat)' and '(srfi srfi-14)'.
This commit is contained in:
parent
ead347128a
commit
e37ef0faba
|
@ -79,3 +79,38 @@
|
|||
('block _IOFBF))))
|
||||
((@ (guile) setvbuf) port mode size)))
|
||||
(export! setvbuf)))
|
||||
|
||||
(when-mes
|
||||
(export define-inlinable
|
||||
make-parameter
|
||||
parameterize
|
||||
set-port-line!
|
||||
string-every)
|
||||
|
||||
(define-macro (define-inlinable . rest)
|
||||
`(define ,@rest))
|
||||
|
||||
;; This is cute, but maybe a record would be better.
|
||||
(define *fluid-accessor* (list 'fluid-accessor))
|
||||
|
||||
(define (make-parameter init)
|
||||
(define fluid (make-fluid init))
|
||||
(lambda args
|
||||
(if (null? args)
|
||||
(fluid-ref fluid)
|
||||
(let ((new-value (car args)))
|
||||
(if (eq? new-value *fluid-accessor*)
|
||||
fluid
|
||||
(let ((old-value (fluid-ref fluid)))
|
||||
(fluid-set! new-value)
|
||||
old-value))))))
|
||||
|
||||
(define-syntax-rule (parameterize ((param value) ...) body ...)
|
||||
(with-fluids (((param (@@ (gash compat) *fluid-accessor*)) value) ...)
|
||||
body ...))
|
||||
|
||||
(define (set-port-line! port line)
|
||||
#f)
|
||||
|
||||
(define (string-every pred str)
|
||||
(every pred (string->list str))))
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; Gash -- Guile As SHell
|
||||
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
|
||||
;;; Copyright © 2019, 2022 Timothy Sample <samplet@ngyro.com>
|
||||
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of Gash.
|
||||
|
@ -45,3 +45,49 @@
|
|||
lookahead-char
|
||||
put-char
|
||||
unget-char)))
|
||||
|
||||
(when-mes
|
||||
(export make-soft-port
|
||||
get-char
|
||||
unget-char
|
||||
lookahead-char)
|
||||
|
||||
(define-record-type <soft-input-port>
|
||||
(make-soft-input-port thunk buffer)
|
||||
soft-input-port?
|
||||
(thunk soft-input-port-thunk)
|
||||
(buffer soft-input-port-buffer set-soft-input-port-buffer!))
|
||||
|
||||
(define (make-soft-port pv modes)
|
||||
(unless (equal? modes "r")
|
||||
(error "Soft ports must have mode \"r\""))
|
||||
(make-soft-input-port (vector-ref pv 3) '()))
|
||||
|
||||
(define (push-soft-input-port-buffer! sip char)
|
||||
(let ((buffer (soft-input-port-buffer sip)))
|
||||
(set-soft-input-port-buffer! sip (cons char buffer))))
|
||||
|
||||
(define (pop-soft-input-port-buffer! sip)
|
||||
(let* ((buffer (soft-input-port-buffer sip))
|
||||
(result (car buffer)))
|
||||
(set-soft-input-port-buffer! sip (cdr buffer))
|
||||
result))
|
||||
|
||||
(define (get-char port)
|
||||
(if (soft-input-port? port)
|
||||
(let ((thunk (soft-input-port-thunk port))
|
||||
(buffer (soft-input-port-buffer port)))
|
||||
(if (null? buffer)
|
||||
(thunk)
|
||||
(pop-soft-input-port-buffer! port)))
|
||||
(with-input-from-port port read-char)))
|
||||
|
||||
(define (unget-char port char)
|
||||
(if (soft-input-port? port)
|
||||
(push-soft-input-port-buffer! port char)
|
||||
(with-input-from-port port (lambda () (unread-char char)))))
|
||||
|
||||
(define (lookahead-char port)
|
||||
(let ((result (get-char port)))
|
||||
(unget-char port result)
|
||||
result)))
|
||||
|
|
|
@ -17,12 +17,14 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash lexer)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash compat textual-ports)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-14)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (system base lalr)
|
||||
#:export (read-bracketed-command
|
||||
|
|
Loading…
Reference in New Issue