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

svn: r14171

original commit: cca41988afc42e7765a9790c0e8bf4446b9920ec

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

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