source: project/release/4/genturfahi/trunk/junla.scm @ 22102

Last change on this file since 22102 was 22102, checked in by Alan Post, 10 years ago

genturfa'i: add debug and profile support to parser.

This is a fairly substantial patch, adding all of the framework to
produce debug output and profiling information from the parser.
When these options are not enabled, there is a small initialization
penalty and no runtime penalty to the parser.

When debug in enabled, a file is written containing a symbolic
expression describing the path taken by the parser while it matches
the input.

When profile is enabled, timing for non-terminal rules and operators
is written as an association list. This information isn't perfect
yet, as it doesn't subtract containing rules from the timing of
outer rules. For purposes of debugging performance, however, it is
good enough. It allowed me to find some performance issues in the
memoization code, a patch for which is coming up.

File size: 3.8 KB
Line 
1;;;;
2;;;; genturfahi - lo la .ckim. ke pe'a jajgau ratcu ke'e genturfa'i
3;;;;            `-> A Scheme packrat parser.
4;;;;
5;;;; Copyright (c) 2010 ".alyn.post." <alyn.post@lodockikumazvati.org>
6;;;;
7;;;; Permission to use, copy, modify, and/or distribute this software for any
8;;;; purpose with or without fee is hereby granted, provided that the above
9;;;; copyright notice and this permission notice appear in all copies.
10;;;;
11;;;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12;;;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13;;;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14;;;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15;;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16;;;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17;;;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18;;;;
19
20;;;
21;;; profile - parser profiling
22;;;
23
24(define-record-type javni-merli
25  (make-javni-merli temci klani mapti namapti)
26  javni-merli?
27  (temci   javni-merli-temci   set-javni-merli-temci!)
28  (klani   javni-merli-klani   set-javni-merli-klani!)
29  (mapti   javni-merli-mapti   set-javni-merli-mapti!)
30  (namapti javni-merli-namapti set-javni-merli-namapti!))
31
32(define-values (junla-datni nunjavni-junla)
33  (let ((rodamerli (make-hash-table string=?)))
34    (values
35      (lambda ()
36        (define (hash->? x y)
37          (javni-merli->? (cdr x) (cdr y)))
38
39        ; we want reverse sorting, use greater-than.
40        (define (javni-merli->? x y)
41          (> (javni-merli-temci x) (javni-merli-temci y)))
42
43        (define (datni cmene javni-merli)
44          (let ((temci   (javni-merli-temci   javni-merli))
45                (klani   (javni-merli-klani   javni-merli))
46                (mapti   (javni-merli-mapti   javni-merli))
47                (namapti (javni-merli-namapti javni-merli)))
48
49            ; output an association list of non-terminal name
50            ; and that non-terminal's profile measurment, which
51            ; itself is an association list of measurements to
52            ; values.
53            ;
54            `(,cmene (("temci"   ,temci)
55                      ("klani"   ,klani)
56                      ("mapti"   ,mapti)
57                      ("namapti" ,namapti)))))
58
59        (map (lambda (x) (datni (car x) (cdr x)))
60             (sort! (hash-table->alist rodamerli) hash->?)))
61
62      (lambda (cmene javni)
63        (let ((javni-merli (make-javni-merli 0 0 0 0)))
64          (define (javni-junla porsi mapti namapti #!rest cmene-sumti) 
65                  ; start the timer
66            (let ((cfari (time->seconds (current-time))))
67
68              (define (sisti)
69                      ; stop the timer
70                (let ((fanmo (time->seconds (current-time)))
71                      (temci (javni-merli-temci javni-merli))
72                      (klani (javni-merli-klani javni-merli)))
73                  (set-javni-merli-temci! javni-merli (+ temci (- fanmo cfari)))
74                  (set-javni-merli-klani! javni-merli (+ 1 klani))))
75
76              (define (mapti-junla porsi nunvalsi)
77                (sisti)
78                (let ((mapti-klani (javni-merli-mapti javni-merli)))
79                  (set-javni-merli-mapti! javni-merli (+ 1 mapti-klani)))
80                (mapti porsi nunvalsi))
81
82              (define (namapti-junla porsi)
83                (sisti)
84                (let ((namapti-klani (javni-merli-namapti javni-merli)))
85                  (set-javni-merli-namapti! javni-merli (+ 1 namapti-klani)))
86                (namapti porsi))
87
88              (apply javni porsi mapti-junla namapti-junla cmene-sumti)))
89
90            ; register our profile metrics for the profile report.
91            (hash-table-set! rodamerli cmene javni-merli)
92
93            javni-junla)))))
Note: See TracBrowser for help on using the repository browser.