From e37ef0faba534d697155c2792b1d49fd19b6b99e Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Thu, 28 Apr 2022 10:02:16 -0600
Subject: [PATCH] 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)'.
---
 gash/compat.scm               | 35 +++++++++++++++++++++++++
 gash/compat/textual-ports.scm | 48 ++++++++++++++++++++++++++++++++++-
 gash/lexer.scm                |  2 ++
 3 files changed, 84 insertions(+), 1 deletion(-)

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