get-lexer/1 for elisp that finishes after the first full expression is read.

* module/language/elisp/lexer.scm: Add get-lexer/1.
* test-suite/tests/elisp-reader.test: Test lexer/1.

module/language/elisp/lexer.scm

@@ -21,11 +21,11 @@
 
 (define-module (language elisp lexer)
   #:use-module (ice-9 regex)
-  #:export (get-lexer))
+  #:export (get-lexer get-lexer/1))
 
 ; This is the lexical analyzer for the elisp reader.  It is hand-written
-; instead of using some generator because I think that's most viable in this
+; instead of using some generator.  I think this is the best solution
-; case and easy enough.
+; because of all that fancy escape sequence handling and the like.
 
 ; Characters are handled internally as integers representing their
 ; code value.  This is necessary because elisp allows a lot of fancy modifiers
@@ -334,3 +334,24 @@
 (define (get-lexer port)
   (lambda ()
     (lex port)))
+
+
+; Build a special lexer that will only read enough for one expression and then
+; always return end-of-input.
+
+(define (get-lexer/1 port)
+  (let ((lex (get-lexer port))
+        (finished #f)
+        (paren-level 0))
+    (lambda ()
+      (if finished
+        '*eoi*
+        (let ((next (lex)))
+          (case (car next)
+            ((paren-open square-open)
+             (set! paren-level (1+ paren-level)))
+            ((paren-close square-close)
+             (set! paren-level (1- paren-level))))
+          (if (<= paren-level 0)
+            (set! finished #t))
+          next)))))

test-suite/tests/elisp-reader.test

@@ -31,13 +31,15 @@
 (define (get-string-lexer str)
   (call-with-input-string str get-lexer))
 
+(define (lex-all lexer)
+  (let iterate ((result '()))
+    (let ((token (lexer)))
+      (if (eq? token '*eoi*)
+        (reverse result)
+        (iterate (cons token result))))))
+
 (define (lex-string str)
-  (let ((lexer (get-string-lexer str)))
+  (lex-all (get-string-lexer str)))
-    (let iterate ((result '()))
-      (let ((token (lexer)))
-        (if (eq? token '*eoi*)
-          (reverse result)
-          (iterate (cons token result)))))))
 
 (with-test-prefix "Lexer"
 
@@ -113,4 +115,12 @@ test\"ab\"\\ abcd
             `(,(+ (expt 2 26) (char->integer #\[))
               ,(+ (expt 2 27) (expt 2 25) (char->integer #\Z))
               ,(- (char->integer #\X) (char->integer #\@))
-              ,(+ (expt 2 22) (expt 2 23) (expt 2 24) 32)))))
+              ,(+ (expt 2 22) (expt 2 23) (expt 2 24) 32))))
+
+  (let* ((lex1-string "((1 2) [2 [3]] 5)")
+         (lexer (call-with-input-string (string-append lex1-string " 1 2")
+                                        get-lexer/1)))
+    (pass-if "lexer/1"
+      (and (equal? (lex-all lexer) (lex-string lex1-string))
+           (eq? (lexer) '*eoi*)
+           (eq? (lexer) '*eoi*)))))