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

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

genturfa'i: klani is the sum of mapti and namapti, and can be calculated.

This change affects the output of the profiling report.

File size: 3.5 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 mapti namapti)
26  javni-merli?
27  (temci   javni-merli-temci   set-javni-merli-temci!)
28  (mapti   javni-merli-mapti   set-javni-merli-mapti!)
29  (namapti javni-merli-namapti set-javni-merli-namapti!))
30
31(define-values (junla-datni nunjavni-junla)
32  (let ((rodamerli (make-hash-table string=?)))
33    (values
34      (lambda ()
35        (define (hash->? x y)
36          (javni-merli->? (cdr x) (cdr y)))
37
38        ; we want reverse sorting, use greater-than.
39        (define (javni-merli->? x y)
40          (> (javni-merli-temci x) (javni-merli-temci y)))
41
42        (define (datni cmene javni-merli)
43          (let ((temci   (javni-merli-temci   javni-merli))
44                (mapti   (javni-merli-mapti   javni-merli))
45                (namapti (javni-merli-namapti javni-merli)))
46
47            ; output an association list of non-terminal name
48            ; and that non-terminal's profile measurment, which
49            ; itself is an association list of measurements to
50            ; values.
51            ;
52            `(,cmene (("temci"   ,temci)
53                      ("mapti"   ,mapti)
54                      ("namapti" ,namapti)))))
55
56        (map (lambda (x) (datni (car x) (cdr x)))
57             (sort! (hash-table->alist rodamerli) hash->?)))
58
59      (lambda (cmene javni)
60        (let ((javni-merli (make-javni-merli 0 0 0)))
61          (define (javni-junla porsi mapti namapti #!rest cmene-sumti) 
62                  ; start the timer
63            (let ((cfari (time->seconds (current-time))))
64
65              (define (sisti)
66                      ; stop the timer
67                (let ((fanmo (time->seconds (current-time)))
68                      (temci (javni-merli-temci javni-merli)))
69                  (set-javni-merli-temci! javni-merli
70                                          (+ temci (- fanmo cfari)))))
71
72              (define (mapti-junla porsi nunvalsi)
73                (sisti)
74                (let ((mapti-klani (javni-merli-mapti javni-merli)))
75                  (set-javni-merli-mapti! javni-merli (+ 1 mapti-klani)))
76                (mapti porsi nunvalsi))
77
78              (define (namapti-junla porsi)
79                (sisti)
80                (let ((namapti-klani (javni-merli-namapti javni-merli)))
81                  (set-javni-merli-namapti! javni-merli (+ 1 namapti-klani)))
82                (namapti porsi))
83
84              (apply javni porsi mapti-junla namapti-junla cmene-sumti)))
85
86            ; register our profile metrics for the profile report.
87            (hash-table-set! rodamerli cmene javni-merli)
88
89            javni-junla)))))
Note: See TracBrowser for help on using the repository browser.