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

*** empty log message ***

Browse Source 
original commit: 8dbe810312aadedc507b7f46983dfd5d186ff11b
tokens
Scott Owens 21 years ago
parent 32b3bac532
commit 17bc737220
1 changed files with 4 additions and 8 deletions
Show Stats Download Patch File Download Diff File

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

@ -65,7 +65,7 @@
(spec-act (spec-act
(get-special-action spec/re-act-lst 'special #'(void))) (get-special-action spec/re-act-lst 'special #'(void)))
(spec-error-act (spec-error-act
(get-special-action spec/re-act-lst 'special-error #'#f)) (get-special-action spec/re-act-lst 'special-error #'(raise exception)))
(spec-comment-act (spec-comment-act
(get-special-action spec/re-act-lst 'special-comment #'#f)) (get-special-action spec/re-act-lst 'special-comment #'#f))
(re-act-lst (re-act-lst
@ -79,10 +79,9 @@
(actions-stx `(vector ,@(vector->list (table-actions table)))) (actions-stx `(vector ,@(vector->list (table-actions table))))
(spec-act-stx (spec-act-stx
(wrap-action spec-act 'special #'here spec-act)) (wrap-action spec-act 'special #'here spec-act))
(has-error-act?-stx (if spec-error-act #t #f))
(spec-error-act-stx (spec-error-act-stx
(wrap-action spec-error-act 'exception #'here spec-error-act)) (wrap-action spec-error-act 'exception #'here spec-error-act))
(has-comment-act?-stx (if spec-comment-act #t #f)) (has-comment-act?-stx (if (syntax-e spec-comment-act) #t #f))
(spec-comment-act-stx (spec-comment-act-stx
(wrap-action spec-comment-act (gensym) #'here spec-comment-act)) (wrap-action spec-comment-act (gensym) #'here spec-comment-act))
(wrap? wrap?)) (wrap? wrap?))
@ -93,7 +92,6 @@
actions-stx actions-stx
no-lookahead-stx no-lookahead-stx
spec-act-stx spec-act-stx
has-error-act?-stx
spec-error-act-stx spec-error-act-stx
has-comment-act?-stx has-comment-act?-stx
spec-comment-act-stx spec-comment-act-stx
@ -153,7 +151,7 @@
(vector-ref actions longest-match-action) wrap?))))) (vector-ref actions longest-match-action) wrap?)))))
(define (lexer-body start-state trans-table eof-table actions no-lookahead (define (lexer-body start-state trans-table eof-table actions no-lookahead
special-action has-special-error-action? special-error-action special-action special-error-action
has-special-comment-action? special-comment-action wrap?) has-special-comment-action? special-comment-action wrap?)
(letrec ((lexer (letrec ((lexer
(lambda (ip) (lambda (ip)
@ -172,13 +170,11 @@
(spec (with-handlers ((exn:special-comment? (spec (with-handlers ((exn:special-comment?
(lambda (x) (set! comment? #t))) (lambda (x) (set! comment? #t)))
(not-break-exn? (not-break-exn?
(lambda (ex) (set! error? ex)))) (lambda (ex) (set! error? #t) ex)))
(read-char-or-special ip)))) (read-char-or-special ip))))
(cond (cond
((and comment? (not has-special-comment-action?)) ((and comment? (not has-special-comment-action?))
(lexer ip)) (lexer ip))
((and error? (not has-special-error-action?))
(raise error?))
(else (else
(do-match ip first-pos (cond (do-match ip first-pos (cond
(comment? special-comment-action) (comment? special-comment-action)

Write Preview
Loading…
Cancel
Save