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

*** empty log message ***

Browse Source 
original commit: 17e9ac305563e736049bef0b956ca048284a8117
tokens
Scott Owens 21 years ago
parent 7ce12965f5
commit 08792e684e
1 changed files with 84 additions and 72 deletions
Show Stats Download Patch File Download Diff File

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

@ -60,10 +60,17 @@
"expects regular expression / action pairs"
x))))
(syntax->list (syntax (re-act ...))))
(let* ((spec/re-act-lst (syntax->list (syntax (re-act ...))))
(spec-act (get-special-action spec/re-act-lst 'special #'here))
(spec-comment-act (get-special-action spec/re-act-lst 'special-comment #'here))
(re-act-lst (filter-out-specials spec/re-act-lst '(special special-comment))))
(let* ((error-continue-arg (gensym))
(spec/re-act-lst
(syntax->list (syntax (re-act ...))))
(spec-act
(get-special-action spec/re-act-lst 'special #'(void)))
(spec-comment-act
(get-special-action spec/re-act-lst 'special-comment
#`(#,error-continue-arg input-port)))
(re-act-lst
(filter-out-specials spec/re-act-lst
'(special special-comment special-error))))
(let ((table (generate-table re-act-lst stx)))
(with-syntax ((start-state-stx (table-start table))
(trans-table-stx (table-trans table))
@ -79,7 +86,8 @@
(spec-comment-act-stx
(datum->syntax-object
spec-comment-act
`(lambda (start-pos end-pos ,(gensym) return-without-pos input-port)
`(lambda (start-pos end-pos ,error-continue-arg
return-without-pos input-port)
,spec-comment-act)
spec-comment-act))
(wrap? wrap?))
@ -143,10 +151,12 @@
(let ((first-pos (get-position ip)))
(let-values (((longest-match-length length longest-match-action)
(lexer ip peek-string)))
(check-match ip first-pos longest-match-length length (vector-ref actions longest-match-action) wrap?)))))
(check-match ip first-pos longest-match-length length
(vector-ref actions longest-match-action) wrap?)))))
(define (lexer-body start-state trans-table eof-table actions no-lookahead
special-action special-comment-action wrap?)
(letrec ((lexer
(lambda (ip)
(unless (input-port? ip)
(raise-type-error
@ -160,7 +170,7 @@
((eq? 'special first-char)
(let* ((comment? #f)
(spec (with-handlers ((exn:special-comment?
(lambda (x) (set! comment? #t) #f)))
(lambda (x) (set! comment? #t) lexer)))
(read-char-or-special ip))))
(do-match ip first-pos (if comment?
special-comment-action
@ -193,7 +203,8 @@
(+ (char->integer char) (* 256 state)))))))
(cond
((not next-state)
(check-match ip first-pos longest-match-length length longest-match-action wrap?))
(check-match ip first-pos longest-match-length
length longest-match-action wrap?))
((vector-ref no-lookahead next-state)
(let ((act (vector-ref actions next-state)))
(check-match ip
@ -212,7 +223,8 @@
(add1 length)
(if act
length
longest-match-length))))))))))))
longest-match-length)))))))))))))
lexer))
(define id (lambda (x) x))

Write Preview
Loading…
Cancel
Save