diff --git a/collects/parser-tools/parser-tools.scrbl b/collects/parser-tools/parser-tools.scrbl index e0cbd21..a49958d 100644 --- a/collects/parser-tools/parser-tools.scrbl +++ b/collects/parser-tools/parser-tools.scrbl @@ -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 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 - @schemeidfont{$}@math{i} is bound to the result of the action - for the @math{i}@superscript{th} grammar symbol on the right of + @schemeidfont{$}@math{k} is bound to the result of the action + for the @math{k}@superscript{th} grammar symbol on the right of the production, if that grammar symbol is a non-terminal, or the value stored in the token if the grammar symbol is a terminal. If the @scheme[src-pos] option is present in the parser, then variables @scheme[$1-start-pos], ..., - @schemeidfont{$}@math{n}@schemeidfont{-start-pos} and + @schemeidfont{$}@math{i}@schemeidfont{-start-pos} and @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 corresponding to the start and end of the corresponding @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{-end-pos}. + @schemeidfont{$}@math{i}@schemeidfont{-end-pos}). All of the productions for a given non-terminal must be grouped with it. That is, no @scheme[non-terminal-id] may appear twice diff --git a/collects/parser-tools/private-yacc/input-file-parser.ss b/collects/parser-tools/private-yacc/input-file-parser.ss index c8508f6..5c6771c 100644 --- a/collects/parser-tools/private-yacc/input-file-parser.ss +++ b/collects/parser-tools/private-yacc/input-file-parser.ss @@ -18,9 +18,10 @@ (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) - (let ((empty-table (make-hash-table))) + (let ((empty-table (make-hash-table)) + (biggest-pos #f)) (hash-table-put! empty-table 'error #t) (for-each (lambda (td) (let ((v (syntax-local-value td))) @@ -29,24 +30,31 @@ (hash-table-put! empty-table (syntax-object->datum s) #t)) (syntax->list (e-terminals-def-t v)))))) term-defs) - (let get-args ((i i) - (rhs rhs)) - (cond - ((null? rhs) null) - (else - (let ((b (car rhs)) - (name (if (hash-table-get empty-table (syntax-object->datum (car rhs)) (lambda () #f)) - (gensym) - (string->symbol (format "$~a" i))))) - (cond - (src-pos - `(,(datum->syntax-object b name b stx-for-original-property) - ,(datum->syntax-object b (string->symbol (format "$~a-start-pos" i)) b stx-for-original-property) - ,(datum->syntax-object b (string->symbol (format "$~a-end-pos" i)) b stx-for-original-property) - ,@(get-args (add1 i) (cdr rhs)))) - (else - `(,(datum->syntax-object b name b stx-for-original-property) - ,@(get-args (add1 i) (cdr rhs))))))))))) + (let ([args + (let get-args ((i i) + (rhs rhs)) + (cond + ((null? rhs) null) + (else + (let ((b (car rhs)) + (name (if (hash-table-get empty-table (syntax-object->datum (car rhs)) (lambda () #f)) + (gensym) + (string->symbol (format "$~a" i))))) + (cond + (src-pos + (let ([start-pos-id + (datum->syntax-object b (string->symbol (format "$~a-start-pos" i)) b stx-for-original-property)] + [end-pos-id + (datum->syntax-object b (string->symbol (format "$~a-end-pos" i)) b stx-for-original-property)]) + (set! biggest-pos (cons start-pos-id end-pos-id)) + `(,(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, ;; builds terminal structures (See grammar.ss) @@ -250,9 +258,18 @@ ;; parse-action: syntax-object * syntax-object -> syntax-object (parse-action (lambda (rhs act) - (quasisyntax/loc act - (lambda #,(get-args 1 (syntax->list rhs) src-pos term-defs) - #,act)))) + (let-values ([(args biggest) (get-args 1 (syntax->list rhs) src-pos term-defs)]) + (let ([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