From dfe5b1eb7499fdd8c67b6252f93c413462128421 Mon Sep 17 00:00:00 2001 From: "Mike D. Lowis" 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 7c616db..545a96f 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 7828996..64904f9 100644 --- a/source/parse-utils.scm +++ b/source/parse-utils.scm @@ -22,6 +22,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.54.0