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:
Timothy Sample 2022-04-28 10:02:16 -06:00
parent ead347128a
commit e37ef0faba
3 changed files with 84 additions and 1 deletions

View File

@ -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))))

View File

@ -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)))

View File

@ -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