From a8025182bdabcb7b026595870c5d5bc552c18323 Mon Sep 17 00:00:00 2001
From: "Mike D. Lowis" <mike@mdlowis.com>
Date: Wed, 25 Jul 2012 14:07:28 -0400
Subject: [PATCH] Added port wrapper that holds file/string location metadata

---
 source/lexer.scm       |  2 +-
 source/parse-utils.scm | 12 ++++++++++++
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/source/lexer.scm b/source/lexer.scm
index 3173b3d..83fdffc 100644
--- a/source/lexer.scm
+++ b/source/lexer.scm
@@ -1,7 +1,7 @@
 (declare (unit lexer) (uses parse-utils))
 
 (define (dlang/lexer input)
-  (buf (buf input read-char) dlang/tokenize))
+  (buf (buf (charport input) charport-read) dlang/tokenize))
 
 (define (dlang/tokenize in)
   (let ((ch (buf-lookahead! in 1)))
diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index 85ac9d0..8c600cf 100644
--- a/source/parse-utils.scm
+++ b/source/parse-utils.scm
@@ -26,6 +26,18 @@
         (syntree=? (car ch1) (car ch2))
         (syntree-children=? (cdr ch1) (cdr ch2))))))
 
+(define-record charport port line column)
+(define (charport port) (make-charport port 0 0))
+
+(define (charport-read chprt)
+  (define ch (read-char (charport-port chprt)))
+  (if (char=? ch #\newline)
+    (begin
+      (charport-line-set! chprt (+ 1 (charport-line chprt)))
+      (charport-column-set! chprt 0))
+    (charport-column-set! chprt (+ 1 (charport-column chprt))))
+  ch)
+
 (define (char-match buf expect)
   (define actual (buf-lookahead! buf 1))
   (if (eof-object? actual)
-- 
2.52.0