From 136d1e676741f4c91cf64e6370ab7ff9eefebbf0 Mon Sep 17 00:00:00 2001
From: Scott Owens <sowens@cs.utah.edu>
Date: Tue, 23 Apr 2002 21:44:47 +0000
Subject: [PATCH] *** empty log message ***

original commit: c4f076a14354191594aa4da43ac8de6f362ce8ac
---
 collects/parser-tools/lex.ss | 56 ++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)

diff --git a/collects/parser-tools/lex.ss b/collects/parser-tools/lex.ss
index 4f5b1f7..56edcae 100644
--- a/collects/parser-tools/lex.ss
+++ b/collects/parser-tools/lex.ss
@@ -61,6 +61,60 @@
   ;; Lex buffer is NOT thread safe
 
 
+  ;; c = char | eof
+  ;; lex-buf = 
+  ;;   (make-lex-buffer input-port int int int int)
+  (define-struct lex-buffer (ip peek-amt line-start col-start offset-start))
+
+  ;; make-lex-buf: input-port -> lex-buf
+  (define make-lex-buf
+    (case-lambda 
+     ((ip) 
+      (cond
+       ((not (input-port? ip))
+	(raise-type-error 'make-lex-buf "input-port" 0 ip))
+       (else
+	(make-lex-buffer ip 0 0 0 0))))
+     ((ip offsets)
+      (cond
+       ((not (input-port? ip))
+	(raise-type-error 'make-lex-buf "input-port" 0 ip offsets))
+       ((or (not (= 3 (length offsets)))
+	    (not (andmap integer? offsets))
+	    (not (andmap exact? offsets))
+	    (not (andmap (lambda (x) (>= x 0)) offsets)))
+	(raise-type-error 'make-lex-buf "list of 3 non-negative exact integers" 1 ip offsets))
+       (else
+	(make-lex-buffer ip 0 (car offsets) (cadr offsets) (caddr offsets)))))))
+
+  (define (next-char lb)
+    (let ((str (peek-string 1 (lex-buffer-peek-amt lb) (lex-buffer-ip lb))))
+      (cond
+       ((string? str)
+	(set-lex-buffer-peek-amt! lb (add1 (lex-buffer-peek-amt lb)))
+	(string-ref str 0))
+       (else eof))))
+
+  ;; get-match: lex-buf * int -> string
+  ;; reads the next i characters.
+  (define (get-match lb i)
+    (set-lex-buffer-peek-amt! lb 0)
+    (read-string i (lex-buffer-ip lb)))
+
+  (define-struct position (offset line col))
+  (define (get-position lb)
+    (let-values (((line col off) (port-next-location (lex-buffer-ip lb))))
+      (if (and line col)
+	  (make-position (+ (lex-buffer-offset-start lb) off)
+			 (+ (lex-buffer-line-start lb) line)
+			 (if (= line 1)
+			     (+ (lex-buffer-col-start lb) col)
+			     col))
+	  (make-position (+ (lex-buffer-offset-start lb) off) #f #f))))
+  #|
+  ;; Lex buffer is NOT thread safe
+
+
   ;; c = char | eof
   ;; lex-buf = 
   ;;   (make-lex-buffer input-port (c list) (c list) int int int (int list))
@@ -176,6 +230,8 @@
 		   (lex-buffer-col lb)))
 
 
+|#
 )
 
 
+