diff --git a/gash/compat.scm b/gash/compat.scm index 47a7abd..4e0100c 100644 --- a/gash/compat.scm +++ b/gash/compat.scm @@ -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)))) diff --git a/gash/compat/textual-ports.scm b/gash/compat/textual-ports.scm index 26482f8..8e0c461 100644 --- a/gash/compat/textual-ports.scm +++ b/gash/compat/textual-ports.scm @@ -1,5 +1,5 @@ ;;; Gash -- Guile As SHell -;;; Copyright © 2019 Timothy Sample +;;; Copyright © 2019, 2022 Timothy Sample ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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 + (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))) diff --git a/gash/lexer.scm b/gash/lexer.scm index 9c5ab34..7e0e1e1 100644 --- a/gash/lexer.scm +++ b/gash/lexer.scm @@ -17,12 +17,14 @@ ;;; along with Gash. If not, see . (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