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

added $n-start-pos and $n-end-pos

Browse Source 
svn: r14171

original commit: cca41988afc42e7765a9790c0e8bf4446b9920ec
tokens
Robby Findler 15 years ago
parent 0a0ea622fc
commit 9159d9aef8
2 changed files with 51 additions and 30 deletions
Show Stats Download Patch File Download Diff File

18
collects/parser-tools/parser-tools.scrbl
Unescape Escape View File

@ -526,23 +526,27 @@ the right choice when using @scheme[lexer] in other situations.
Each action is scheme code that has the same scope as its Each action is scheme code that has the same scope as its
parser's definition, except that the variables @scheme[$1], ..., parser's definition, except that the variables @scheme[$1], ...,
@schemeidfont{$}@math{n} are bound, where @math{n} is the number @schemeidfont{$}@math{i} are bound, where @math{i} is the number
of @scheme[grammar-id]s in the corresponding production. Each of @scheme[grammar-id]s in the corresponding production. Each
@schemeidfont{$}@math{i} is bound to the result of the action @schemeidfont{$}@math{k} is bound to the result of the action
for the @math{i}@superscript{th} grammar symbol on the right of for the @math{k}@superscript{th} grammar symbol on the right of
the production, if that grammar symbol is a non-terminal, or the the production, if that grammar symbol is a non-terminal, or the
value stored in the token if the grammar symbol is a terminal. value stored in the token if the grammar symbol is a terminal.
If the @scheme[src-pos] option is present in the parser, then If the @scheme[src-pos] option is present in the parser, then
variables @scheme[$1-start-pos], ..., variables @scheme[$1-start-pos], ...,
@schemeidfont{$}@math{n}@schemeidfont{-start-pos} and @schemeidfont{$}@math{i}@schemeidfont{-start-pos} and
@scheme[$1-end-pos], ..., @scheme[$1-end-pos], ...,
@schemeidfont{$}@math{n}@schemeidfont{-end-pos} and are also @schemeidfont{$}@math{i}@schemeidfont{-end-pos} and are also
available, and they refer to the position structures available, and they refer to the position structures
corresponding to the start and end of the corresponding corresponding to the start and end of the corresponding
@scheme[grammar-symbol]. Grammar symbols defined as empty-tokens @scheme[grammar-symbol]. Grammar symbols defined as empty-tokens
have no @schemeidfont{$}@math{i} associated, but do have have no @schemeidfont{$}@math{k} associated, but do have
@schemeidfont{$}@math{k}@schemeidfont{-start-pos} and
@schemeidfont{$}@math{k}@schemeidfont{-end-pos}.
Also @schemeidfont{$n-start-pos} and @schemeidfont{$n-end-pos}
are bound to the largest start and end positions, (i.e.,
@schemeidfont{$}@math{i}@schemeidfont{-start-pos} and @schemeidfont{$}@math{i}@schemeidfont{-start-pos} and
@schemeidfont{$}@math{i}@schemeidfont{-end-pos}. @schemeidfont{$}@math{i}@schemeidfont{-end-pos}).
All of the productions for a given non-terminal must be grouped All of the productions for a given non-terminal must be grouped
with it. That is, no @scheme[non-terminal-id] may appear twice with it. That is, no @scheme[non-terminal-id] may appear twice

63
collects/parser-tools/private-yacc/input-file-parser.ss
Unescape Escape View File

@ -18,9 +18,10 @@
(define stx-for-original-property (read-syntax #f (open-input-string "original"))) (define stx-for-original-property (read-syntax #f (open-input-string "original")))
;; get-args: ??? ;; get-args: ??? -> (values (listof syntax) (or/c #f (cons integer? stx)))
(define (get-args i rhs src-pos term-defs) (define (get-args i rhs src-pos term-defs)
(let ((empty-table (make-hash-table))) (let ((empty-table (make-hash-table))
(biggest-pos #f))
(hash-table-put! empty-table 'error #t) (hash-table-put! empty-table 'error #t)
(for-each (lambda (td) (for-each (lambda (td)
(let ((v (syntax-local-value td))) (let ((v (syntax-local-value td)))
@ -29,24 +30,31 @@
(hash-table-put! empty-table (syntax-object->datum s) #t)) (hash-table-put! empty-table (syntax-object->datum s) #t))
(syntax->list (e-terminals-def-t v)))))) (syntax->list (e-terminals-def-t v))))))
term-defs) term-defs)
(let get-args ((i i) (let ([args
(rhs rhs)) (let get-args ((i i)
(cond (rhs rhs))
((null? rhs) null) (cond
(else ((null? rhs) null)
(let ((b (car rhs)) (else
(name (if (hash-table-get empty-table (syntax-object->datum (car rhs)) (lambda () #f)) (let ((b (car rhs))
(gensym) (name (if (hash-table-get empty-table (syntax-object->datum (car rhs)) (lambda () #f))
(string->symbol (format "$~a" i))))) (gensym)
(cond (string->symbol (format "$~a" i)))))
(src-pos (cond
`(,(datum->syntax-object b name b stx-for-original-property) (src-pos
,(datum->syntax-object b (string->symbol (format "$~a-start-pos" i)) b stx-for-original-property) (let ([start-pos-id
,(datum->syntax-object b (string->symbol (format "$~a-end-pos" i)) b stx-for-original-property) (datum->syntax-object b (string->symbol (format "$~a-start-pos" i)) b stx-for-original-property)]
,@(get-args (add1 i) (cdr rhs)))) [end-pos-id
(else (datum->syntax-object b (string->symbol (format "$~a-end-pos" i)) b stx-for-original-property)])
`(,(datum->syntax-object b name b stx-for-original-property) (set! biggest-pos (cons start-pos-id end-pos-id))
,@(get-args (add1 i) (cdr rhs))))))))))) `(,(datum->syntax-object b name b stx-for-original-property)
,start-pos-id
,end-pos-id
,@(get-args (add1 i) (cdr rhs)))))
(else
`(,(datum->syntax-object b name b stx-for-original-property)
,@(get-args (add1 i) (cdr rhs)))))))))])
(values args biggest-pos))))
;; Given the list of terminal symbols and the precedence/associativity definitions, ;; Given the list of terminal symbols and the precedence/associativity definitions,
;; builds terminal structures (See grammar.ss) ;; builds terminal structures (See grammar.ss)
@ -250,9 +258,18 @@
;; parse-action: syntax-object * syntax-object -> syntax-object ;; parse-action: syntax-object * syntax-object -> syntax-object
(parse-action (parse-action
(lambda (rhs act) (lambda (rhs act)
(quasisyntax/loc act (let-values ([(args biggest) (get-args 1 (syntax->list rhs) src-pos term-defs)])
(lambda #,(get-args 1 (syntax->list rhs) src-pos term-defs) (let ([act
#,act)))) (if biggest
(with-syntax ([$n-start-pos (datum->syntax-object (car biggest) '$n-start-pos)]
[$n-end-pos (datum->syntax-object (cdr biggest) '$n-end-pos)])
#`(let ([$n-start-pos #,(car biggest)]
[$n-end-pos #,(cdr biggest)])
#,act))
act)])
(quasisyntax/loc act
(lambda #,args
#,act))))))
;; parse-prod+action: non-term * syntax-object -> production ;; parse-prod+action: non-term * syntax-object -> production
(parse-prod+action (parse-prod+action

Write Preview
Loading…
Cancel
Save