From: Mike D. Lowis <mike@mdlowis.com>
Date: Wed, 25 Jul 2012 18:07:28 +0000 (-0400)
Subject: Added port wrapper that holds file/string location metadata
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=a8025182bdabcb7b026595870c5d5bc552c18323;p=archive%2Fdlang-scm.git

Added port wrapper that holds file/string location metadata
---

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)