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

.

Browse Source 
original commit: 8f7a5eef7d519eddac9931d8a0252f2f591c4552
tokens
Matthew Flatt 20 years ago
parent 4866d90396
commit d7df17ee88
2 changed files with 31 additions and 22 deletions
Show Stats Download Patch File Download Diff File

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

@ -33,8 +33,6 @@
;; A regular expression operator ;; A regular expression operator
char-set) char-set)
(define file-path (make-parameter #f))
;; wrap-action: syntax-object src-pos? -> syntax-object ;; wrap-action: syntax-object src-pos? -> syntax-object
(define-for-syntax (wrap-action action src-pos?) (define-for-syntax (wrap-action action src-pos?)
(with-syntax ((action-stx (with-syntax ((action-stx
@ -90,17 +88,25 @@
(module-or-top-identifier=? (syntax special) x)) (module-or-top-identifier=? (syntax special) x))
ids))) ids)))
(_ #t))) (_ #t)))
spec/re-act-lst))) spec/re-act-lst))
(let-values (((trans start actions no-look disappeared-uses) (name-lst (map (lambda (x) (datum->syntax-object #f (gensym))) re-act-lst))
(build-lexer re-act-lst))) (act-lst (map (lambda (x) (stx-car (stx-cdr x))) re-act-lst))
(re-actname-lst (map (lambda (re-act name)
(list (stx-car re-act)
name))
re-act-lst
name-lst)))
(let-values (((trans start action-names no-look disappeared-uses)
(build-lexer re-actname-lst)))
(with-syntax ((start-state-stx start) (with-syntax ((start-state-stx start)
(trans-table-stx trans) (trans-table-stx trans)
(no-lookahead-stx no-look) (no-lookahead-stx no-look)
(actions-stx ((name ...) name-lst)
`(vector ,@(map (lambda (a) ((act ...) (map (lambda (a)
(if a (wrap-action a src-pos?) #f)) (wrap-action a src-pos?))
(vector->list actions)))) act-lst))
(spec-act-stx ((act-name ...) (vector->list action-names))
(spec-act-stx
(wrap-action spec-act src-pos?)) (wrap-action spec-act src-pos?))
(spec-error-act-stx (spec-error-act-stx
(wrap-action spec-error-act src-pos?)) (wrap-action spec-error-act src-pos?))
@ -111,15 +117,16 @@
(eof-act-stx (wrap-action eof-act src-pos?))) (eof-act-stx (wrap-action eof-act src-pos?)))
(syntax-property (syntax-property
(syntax/loc stx (syntax/loc stx
(lexer-body start-state-stx (let ([name act] ...)
trans-table-stx (lexer-body start-state-stx
actions-stx trans-table-stx
no-lookahead-stx (vector act-name ...)
spec-act-stx no-lookahead-stx
spec-error-act-stx spec-act-stx
has-comment-act?-stx spec-error-act-stx
spec-comment-act-stx has-comment-act?-stx
eof-act-stx)) spec-comment-act-stx
eof-act-stx)))
'disappeared-use 'disappeared-use
disappeared-uses))))))))) disappeared-uses)))))))))
@ -300,7 +307,8 @@
;(printf "(read-string ~e port) = ~e~n" longest-match-length match) ;(printf "(read-string ~e port) = ~e~n" longest-match-length match)
(do-match lb first-pos longest-match-action match))) (do-match lb first-pos longest-match-action match)))
(define file-path (make-parameter #f))
(define (do-match ip first-pos action value) (define (do-match ip first-pos action value)
#;(printf "(action ~a ~a ~a ~a)~n" #;(printf "(action ~a ~a ~a ~a)~n"
(position-offset first-pos) (position-offset (get-position ip)) value ip) (position-offset first-pos) (position-offset (get-position ip)) value ip)

5
collects/parser-tools/private-lex/front.ss
Unescape Escape View File

@ -1,6 +1,7 @@
(module front mzscheme (module front mzscheme
(require (prefix is: (lib "integer-set.ss")) (require (prefix is: (lib "integer-set.ss"))
(lib "list.ss") (lib "list.ss")
(lib "stx.ss" "syntax")
"util.ss" "util.ss"
"stx.ss" "stx.ss"
"re.ss" "re.ss"
@ -132,8 +133,8 @@
(define (build-lexer sos) (define (build-lexer sos)
(let* ((disappeared-uses (box null)) (let* ((disappeared-uses (box null))
(s-re-acts (map (lambda (so) (s-re-acts (map (lambda (so)
(cons (parse (car (syntax->list so)) disappeared-uses) (cons (parse (stx-car so) disappeared-uses)
(cadr (syntax->list so)))) (stx-car (stx-cdr so))))
sos)) sos))
(cache (make-cache)) (cache (make-cache))

Write Preview
Loading…
Cancel
Save