PR 10344

svn: r15545

collects/parser-tools/parser-tools.scrbl

@@ -216,8 +216,10 @@ are a few examples, using @scheme[:] prefixed SRE syntax:
        no @scheme[(special)] rule is present, the lexer returns
        @scheme[(void)].}]
 
-    End-of-files, specials, special-comments and special-errors can
-    never be part of a lexeme with surrounding characters.
+    End-of-files, specials, special-comments and special-errors cannot
+    be parsed via a rule using an ordinary regular expression
+    (but dropping down and manipulating the port to handle them
+     is possible in some situations).
 
     Since the lexer gets its source information from the port, use
     @scheme[port-count-lines!] to enable the tracking of line and

collects/syntax-color/scheme-lexer.ss

@@ -235,6 +235,18 @@
         (else
          (read-char i)
          (cons next (special-read-line i))))))
+  
+  (define (read-line/skip-over-specials i)
+    (let loop ()
+      (let ((next (peek-char-or-special i)))
+        (cond
+          ((or (eq? next #\newline) (eof-object? next))
+           null)
+          (else
+           (read-char-or-special i)
+           (if (char? next)
+               (cons next (loop))
+               (loop)))))))
           
   (define (get-here-string start-pos i)
     (let* ((ender (list->string (special-read-line i)))
@@ -273,6 +285,11 @@
       (ret lexeme 'constant #f start-pos end-pos)]
      [keyword (ret lexeme 'parenthesis #f start-pos end-pos)]
      [str (ret lexeme 'string #f start-pos end-pos)]
+     [";"
+      (values (apply string (read-line/skip-over-specials input-port)) 'comment #f 
+              (position-offset start-pos)
+              (get-offset input-port))]
+     #;
      [line-comment
       (ret lexeme 'comment #f start-pos end-pos)]
      ["#;"

collects/tests/syntax-color/scheme-lexer.ss

@@ -1,4 +1,6 @@
-;; Not tested:
+#lang scheme
+
+;; Not well tested:
 ;;  Non-character input data (i.e. specials)
 ;;  The R5RS part of numbers
 ;; 
@@ -40,22 +42,35 @@
      (cons (make-string (- end start) (char kind))
            (lex f p)))))
       
-(define (test input expected . num-toks)
-  (let* ((l (lex scheme-lexer (open-input-string input)))
+(define (test input expected [e-n (chunks (string->list expected))])
+  (let* ([p (input->port input)]
+         (l (lex scheme-lexer p))
          (s (apply string-append l)))
+    (close-input-port p)
     (unless (string=? s expected)
-      (printf "input   : ~a~n" input)
+      (printf "input   : ~s~n" input)
       (printf "output  : ~s~n" s)
       (printf "expected: ~s~n~n" expected))
-    (let ((e-n
-           (cond
-             ((not (null? num-toks)) (car num-toks))
-             (else (chunks (string->list expected)))))
-          (a-n (length l)))
+    (let ((a-n (length l)))
       (unless (= e-n a-n)
         (printf "input   : ~a~n" input)
         (printf "expected: ~a tokens~n" e-n)
         (printf "got     : ~a tokens~n~n" a-n)))))
+
+(define (input->port input) 
+  (let-values ([(in out) (make-pipe-with-specials)])
+    (thread
+     (λ ()
+       (let loop ([input input])
+         (cond
+           [(list? input) 
+            (for-each loop input)]
+           [(string? input)
+            (display input out)]
+           [else
+            (write-special input out)]))
+       (close-output-port out)))
+    in))
       
 ;; Delimiters
 (test " " " ")
@@ -400,11 +415,14 @@ end-string
       
       
 ;; Comments
+(test ";ab" ";;;")
 (test #<<end-string
 1 a; asd\
 1 ;a
 end-string
     "c i;;;;;; c ;;")
+(test '(";a" 1 "b") ";;;;" 1)  ;; a special comment
+(test '(";a" 1 "b\n1" 1) ";;;; cn" 4)
 
 (test "#||#" ";;;;")
 (test "#|#||#|#" ";;;;;;;;")