source tracking for nyacc parser is coming

[Matt Wette]

Hi All,

I just wanted to give an update on this requested feature for nyacc.

I've been working on adding source location tracking to nyacc's
parser.  I believe I have a working implementation.  It should
appear in future release 1.06.0 (vs latest release 1.05.0). If
you want to work with it it's on the dev-1.06 branch in git
(i.e., git://git.savannah.nongnu.org/nyacc.git).  The parser
code, with annotations "=>" indicating changes, is shown below.

To demonstrate, I have implemented it in a language I'm working
on called TCLish.   In nyacc, the lexical analyzer returns pairs
(token-type . token-value).  I attach source-properties to these
pairs.  The parser is able to propapate them through the parsing
phase.  In the AST-to-tree-IL phase I transfer the source-properties
to the external tree-IL representation.  Guile takes care of the
rest.  (Note: in the lexical analyzer, I'm not bothering to
trace column: that gets set to zero.)

I generated the file, demo.tsh, with contents:

    proc baz { } {
      puts 1 2 3
    }

    proc bar { } {
      set x (1 + 2)
      baz
    }

    proc foo { } {
      set x (3 + 4)
      bar
    }

Now I run the tsh interpreter and source demo.tsh, then call "foo":
    scheme@(guile-user)> ,L nx-tsh
    Happy hacking with nx-tsh!  To switch back, type `,L scheme'.
    nx-tsh@(guile-user)> source "demo.tsh"
    nx-tsh@(guile-user)> foo
    ice-9/boot-9.scm:1685:16: In procedure raise-exception:
    In procedure string=: Wrong type argument in position 1 (expecting string): 
1

    Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
    nx-tsh@(guile-user) [1]> ,bt
    In demo.tsh:
         13:0  5 (foo)                <= line number traceback
          8:0  4 (bar)                <= line number traceback
          3:0  3 (baz)                <= line number traceback
    In nyacc/lang/tsh/xlib.scm:
        81:12  2 (tsh:puts _ _ _)
    In unknown file:
               1 (string=? 1 "-nonewline")
    In ice-9/boot-9.scm:
      1685:16  0 (raise-exception _ #:continuable? _)


Here is the updated code for the (numeric) parser,
with new/mod lines denoted with `=>':

(define* (make-lalr-parser/num mach #:key (skip-if-unexp '()) interactive env)
  (let* ((len-v (assq-ref mach 'len-v))
         (rto-v (assq-ref mach 'rto-v))
         (pat-v (assq-ref mach 'pat-v))
         (xct-v (make-xct (assq-ref mach 'act-v) env))
         (ntab (assq-ref mach 'ntab))
         (start (assq-ref (assq-ref mach 'mtab) '$start)))
    (lambda* (lexr #:key debug)
      (let loop ((state (list 0))       ; state stack
                 (stack (list '$@))     ; semantic value stack
                 (nval #f)              ; non-terminal from prev reduction
                 (lval #f))             ; lexical value (from lex'r)
        (cond
         ((and interactive nval
               (eqv? (car nval) start)
               (zero? (car state)))     ; done
          (cdr nval))
         ((not (or nval lval))
          (if (eqv? $default (caar (vector-ref pat-v (car state))))
=>         (loop state stack (cons-source stack $default #f) lval)
              (loop state stack nval (lexr))))           ; reload
         (else
          (let* ((laval (or nval lval))
                 (tval (car laval))
                 (sval (cdr laval))
                 (stxl (vector-ref pat-v (car state)))
                 (stx (or (assq-ref stxl tval)
                          (and (not (memq tval skip-if-unexp))
                               (assq-ref stxl $default))
                          #f)))         ; error
            (if debug (dmsg/n (car state) (if nval tval sval) stx ntab))
            (cond
             ((eq? #f stx)              ; error
              (if (memq tval skip-if-unexp)
                  (loop state stack #f #f)
                  (parse-error state laval)))
             ((negative? stx)           ; reduce
              (let* ((gx (abs stx))
                     (gl (vector-ref len-v gx))
                     ($$ (apply (vector-ref xct-v gx) stack))
=>                (pobj (if (zero? gl) laval (list-tail stack (1- gl))))
=>                (pval (source-properties pobj))
=>                (tval (cons-source pobj (vector-ref rto-v gx) $$)))
=>           (if (supports-source-properties? $$)
=>               (set-source-properties! $$ pval))
                (loop (list-tail state gl) (list-tail stack gl) tval lval)))
             ((positive? stx)           ; shift
=>         (loop (cons stx state) (cons-source laval sval stack)
                    #f (if nval lval #f)))
             (else                      ; accept
              (car stack))))))))))

Matt