mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
original commit: 4e9ab6a96f6c37d0f561bba49043d3b36ff1baa4
tokens
Scott Owens 23 years ago
parent 3b49e208ac
commit 09d88646df
1 changed files with 65 additions and 68 deletions
Show Stats Download Patch File Download Diff File

133
collects/parser-tools/lex.ss
Unescape Escape View File

@ -40,23 +40,19 @@
(actions-stx `(vector ,@(vector->list (table-actions table))))) (actions-stx `(vector ,@(vector->list (table-actions table)))))
(if wrap? (if wrap?
(syntax (syntax
(let-values (((a b c d e) (lexer-body start-state-stx
(values start-state-stx trans-table-stx
trans-table-stx eof-table-stx
eof-table-stx actions-stx
actions-stx no-lookahead-stx
no-lookahead-stx))) #t))
(lambda (lb)
(lexer-body lb a b c d e #t))))
(syntax (syntax
(let-values (((a b c d e) (lexer-body start-state-stx
(values start-state-stx trans-table-stx
trans-table-stx eof-table-stx
eof-table-stx actions-stx
actions-stx no-lookahead-stx
no-lookahead-stx))) #f))))))))))))
(lambda (lb)
(lexer-body lb a b c d e #f))))))))))))))
(values (values
(build-lexer #f) (build-lexer #f)
(build-lexer #t)))) (build-lexer #t))))
@ -100,58 +96,59 @@
(define (lexer-body lb start-state trans-table eof-table actions no-lookahead wrap?) (define (lexer-body start-state trans-table eof-table actions no-lookahead wrap?)
(unless (lex-buffer? lb) (lambda (lb)
(raise-type-error (unless (lex-buffer? lb)
'lexer (raise-type-error
"lex-buf" 'lexer
0 "lex-buf"
lb)) 0
(let ((first-pos (get-position lb))) lb))
(let lexer-loop ( (let ((first-pos (get-position lb)))
;; current-state (let lexer-loop (
(state start-state) ;; current-state
;; the character to transition on (state start-state)
(char (next-char lb)) ;; the character to transition on
;; action for the longest match seen thus far (char (next-char lb))
;; including a match at the current state ;; action for the longest match seen thus far
(longest-match-action ;; including a match at the current state
(vector-ref actions start-state)) (longest-match-action
;; how many characters have been read (vector-ref actions start-state))
;; including the one just read ;; how many characters have been read
(length 1) ;; including the one just read
;; how many characters are in the longest match (length 1)
(longest-match-length 1)) ;; how many characters are in the longest match
(let ((next-state (longest-match-length 1))
(cond (let ((next-state
((eof-object? char) (cond
(vector-ref eof-table state)) ((eof-object? char)
(else (vector-ref eof-table state))
(vector-ref (else
trans-table (vector-ref
(bitwise-ior (char->integer char) trans-table
(arithmetic-shift state 8))))))) (bitwise-ior (char->integer char)
(cond (arithmetic-shift state 8)))))))
((not next-state) (cond
(do-match lb first-pos longest-match-length longest-match-action wrap?)) ((not next-state)
((vector-ref no-lookahead next-state) (do-match lb first-pos longest-match-length longest-match-action wrap?))
(let ((act (vector-ref actions next-state))) ((vector-ref no-lookahead next-state)
(do-match lb (let ((act (vector-ref actions next-state)))
first-pos (do-match lb
(if act length longest-match-length) first-pos
(if act act longest-match-action) (if act length longest-match-length)
wrap?))) (if act act longest-match-action)
(else wrap?)))
(let ((act (vector-ref actions next-state))) (else
(lexer-loop next-state (let ((act (vector-ref actions next-state)))
(next-char lb) (lexer-loop next-state
(if act (next-char lb)
act (if act
longest-match-action) act
(add1 length) longest-match-action)
(if act (add1 length)
length (if act
longest-match-length))))))))) length
longest-match-length))))))))))
(define (do-match lb first-pos longest-match-length longest-match-action wrap?) (define (do-match lb first-pos longest-match-length longest-match-action wrap?)
(let* ((match (get-match lb longest-match-length)) (let* ((match (get-match lb longest-match-length))

Write Preview
Loading…
Cancel
Save