72 lines
2.4 KiB
Racket
72 lines
2.4 KiB
Racket
#lang racket/base
|
|
(require racket/contract/base
|
|
unstable/options)
|
|
(provide lexer/c (struct-out dont-stop))
|
|
|
|
(struct dont-stop (val) #:transparent)
|
|
|
|
(define lexer/c
|
|
(option/c
|
|
(or/c (->i ([in (and/c input-port? port-counts-lines?)])
|
|
(values [txt any/c]
|
|
[type symbol?]
|
|
[paren (or/c symbol? #f)]
|
|
[start (or/c exact-positive-integer? #f)]
|
|
[end (start type) (end/c start type)]))
|
|
(->i ([in (and/c input-port? port-counts-lines?)]
|
|
[offset exact-nonnegative-integer?]
|
|
[mode (not/c dont-stop?)])
|
|
(values [txt any/c]
|
|
[type symbol?]
|
|
[paren (or/c symbol? #f)]
|
|
[start (or/c exact-positive-integer? #f)]
|
|
[end (start type) (end/c start type)]
|
|
[backup exact-nonnegative-integer?]
|
|
[new-mode any/c])))
|
|
#:tester (λ (lexer) (try-some-random-streams lexer))))
|
|
|
|
(define (try-some-random-streams lexer)
|
|
(define 3ary-lexer
|
|
(cond
|
|
[(procedure-arity-includes? lexer 1)
|
|
(λ (in offset mode)
|
|
(define-values (txt type paren start end) (lexer in))
|
|
(values txt type paren start end 0 #f))]
|
|
[else lexer]))
|
|
(for ([x (in-range 10)])
|
|
(define size (random 100))
|
|
(define (quash-backslash-r c)
|
|
;; it isn't clear the spec is right in
|
|
;; the case of \r\n combinations, so we
|
|
;; punt for now
|
|
(if (equal? c #\return) #\newline c))
|
|
(define s (build-string
|
|
size
|
|
(λ (c)
|
|
(quash-backslash-r
|
|
(case (random 3)
|
|
[(0)
|
|
(define s " ()@{}\"λΣ\0")
|
|
(string-ref s (random (string-length s)))]
|
|
[(1 2)
|
|
(integer->char (random 255))])))))
|
|
(define in (open-input-string s))
|
|
(port-count-lines! in)
|
|
(let loop ([mode #f][offset 0])
|
|
(define-values (txt type paren start end backup new-mode)
|
|
(3ary-lexer in offset mode))
|
|
(cond
|
|
[(equal? type 'eof) #t]
|
|
[(< end size) (loop new-mode end)]
|
|
[else #f]))))
|
|
|
|
(define (end/c start type)
|
|
(cond
|
|
[(equal? 'eof type)
|
|
(or/c exact-positive-integer? #f)]
|
|
[start
|
|
(and/c exact-positive-integer?
|
|
(>/c start))]
|
|
[else
|
|
#f]))
|