|
|
@ -124,8 +124,7 @@
|
|
|
|
(else
|
|
|
|
(else
|
|
|
|
(vector-ref
|
|
|
|
(vector-ref
|
|
|
|
trans-table
|
|
|
|
trans-table
|
|
|
|
(bitwise-ior (char->integer char)
|
|
|
|
(+ (char->integer (string-ref char 0)) (* 256 state)))))))
|
|
|
|
(arithmetic-shift state 8)))))))
|
|
|
|
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
((not next-state)
|
|
|
|
((not next-state)
|
|
|
|
(do-match lb first-pos longest-match-length longest-match-action wrap?))
|
|
|
|
(do-match lb first-pos longest-match-length longest-match-action wrap?))
|
|
|
@ -159,16 +158,24 @@
|
|
|
|
(position-col first-pos)
|
|
|
|
(position-col first-pos)
|
|
|
|
(position-offset first-pos)
|
|
|
|
(position-offset first-pos)
|
|
|
|
(- (position-offset end-pos) (position-offset first-pos))))
|
|
|
|
(- (position-offset end-pos) (position-offset first-pos))))
|
|
|
|
|
|
|
|
(cond
|
|
|
|
|
|
|
|
(wrap?
|
|
|
|
(let/ec ret
|
|
|
|
(let/ec ret
|
|
|
|
(let ((act (longest-match-action
|
|
|
|
(list (longest-match-action
|
|
|
|
(lambda () first-pos)
|
|
|
|
(lambda () first-pos)
|
|
|
|
(lambda () end-pos)
|
|
|
|
(lambda () end-pos)
|
|
|
|
(lambda () match)
|
|
|
|
(lambda () match)
|
|
|
|
ret
|
|
|
|
ret
|
|
|
|
lb)))
|
|
|
|
lb)
|
|
|
|
(if wrap?
|
|
|
|
first-pos
|
|
|
|
(list act first-pos end-pos)
|
|
|
|
end-pos)))
|
|
|
|
act)))))
|
|
|
|
(else
|
|
|
|
|
|
|
|
(longest-match-action
|
|
|
|
|
|
|
|
(lambda () first-pos)
|
|
|
|
|
|
|
|
(lambda () end-pos)
|
|
|
|
|
|
|
|
(lambda () match)
|
|
|
|
|
|
|
|
(lambda (x) x)
|
|
|
|
|
|
|
|
lb)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Lex buffer is NOT thread safe
|
|
|
|
;; Lex buffer is NOT thread safe
|
|
|
@ -200,13 +207,12 @@
|
|
|
|
(port-count-lines! ip)
|
|
|
|
(port-count-lines! ip)
|
|
|
|
(make-lex-buffer ip 0 (car offsets) (cadr offsets) (caddr offsets)))))))
|
|
|
|
(make-lex-buffer ip 0 (car offsets) (cadr offsets) (caddr offsets)))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; next-char: lex-buffer -> (string or eof)
|
|
|
|
(define (next-char lb)
|
|
|
|
(define (next-char lb)
|
|
|
|
(let ((str (peek-string 1 (lex-buffer-peek-amt lb) (lex-buffer-ip lb))))
|
|
|
|
(let* ((peek-amt (lex-buffer-peek-amt lb))
|
|
|
|
(cond
|
|
|
|
(str (peek-string 1 peek-amt (lex-buffer-ip lb))))
|
|
|
|
((string? str)
|
|
|
|
(set-lex-buffer-peek-amt! lb (add1 peek-amt))
|
|
|
|
(set-lex-buffer-peek-amt! lb (add1 (lex-buffer-peek-amt lb)))
|
|
|
|
str))
|
|
|
|
(string-ref str 0))
|
|
|
|
|
|
|
|
(else eof))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; get-match: lex-buf * int -> string
|
|
|
|
;; get-match: lex-buf * int -> string
|
|
|
|
;; reads the next i characters.
|
|
|
|
;; reads the next i characters.
|
|
|
|