*** empty log message ***

original commit: 76e737f04605b6052fe113760324c78d1aa1d1ae
tokens
Scott Owens 20 years ago
parent a70c571026
commit 565b7b9715

@ -1,19 +1,27 @@
(module parser-actions mzscheme (module parser-actions mzscheme
(require "grammar.ss") (require "grammar.ss")
(provide (all-defined)) (provide (all-defined-except make-reduce make-reduce*)
(rename make-reduce* make-reduce))
;; An action is ;; An action is
;; - (make-shift int) ;; - (make-shift int)
;; - (make-reduce prod) ;; - (make-reduce prod runtime-action)
;; - (make-accept) ;; - (make-accept)
;; - (make-goto int) ;; - (make-goto int)
;; A reduce contains a runtime-reduce so that sharing of the reduces can
;; be easily transferred to sharing of runtime-reduces.
(define-struct action () (make-inspector)) (define-struct action () (make-inspector))
(define-struct (shift action) (state) (make-inspector)) (define-struct (shift action) (state) (make-inspector))
(define-struct (reduce action) (prod) (make-inspector)) (define-struct (reduce action) (prod runtime-reduce) (make-inspector))
(define-struct (accept action) () (make-inspector)) (define-struct (accept action) () (make-inspector))
(define-struct (goto action) (state) (make-inspector)) (define-struct (goto action) (state) (make-inspector))
(define (make-reduce* p)
(make-reduce p
(vector (prod-index p)
(gram-sym-symbol (prod-lhs p))
(vector-length (prod-rhs p)))))
;; A runtime-action is ;; A runtime-action is
;; non-negative-int (shift) ;; non-negative-int (shift)
@ -24,11 +32,7 @@
(define (action->runtime-action a) (define (action->runtime-action a)
(cond (cond
((shift? a) (shift-state a)) ((shift? a) (shift-state a))
((reduce? a) ((reduce? a) (reduce-runtime-reduce a))
(let ((p (reduce-prod a)))
(vector (prod-index p)
(gram-sym-symbol (prod-lhs p))
(vector-length (prod-rhs p)))))
((accept? a) 'accept) ((accept? a) 'accept)
((goto? a) (- (+ (goto-state a) 1))))) ((goto? a) (- (+ (goto-state a) 1)))))

@ -69,7 +69,7 @@
#`(when #f #`(when #f
(let ((bind void) ... (tmp void) ...) (let ((bind void) ... (tmp void) ...)
(void bound ... ... term-group ... start ... end ... prec ...)))))) (void bound ... ... term-group ... start ... end ... prec ...))))))
(require (lib "list.ss") "parser-actions.ss")
(define (build-parser filename src-pos suppress input-terms start end assocs prods) (define (build-parser filename src-pos suppress input-terms start end assocs prods)
(let* ((grammar (parse-input input-terms start end assocs prods src-pos)) (let* ((grammar (parse-input input-terms start end assocs prods src-pos))
(table (build-table grammar filename suppress)) (table (build-table grammar filename suppress))
@ -79,6 +79,28 @@
(for-each (lambda (term) (for-each (lambda (term)
(hash-table-put! all-tokens (gram-sym-symbol term) #t)) (hash-table-put! all-tokens (gram-sym-symbol term) #t))
(send grammar get-terms)) (send grammar get-terms))
#;(let ((num-states (vector-length table))
(num-gram-syms (+ (send grammar get-num-terms)
(send grammar get-num-non-terms)))
(num-ht-entries (apply + (map length (vector->list table))))
(num-reduces
(let ((ht (make-hash-table)))
(for-each
(lambda (x)
(when (reduce? x)
(hash-table-put! ht x #t)))
(map cdr (apply append (vector->list table))))
(length (hash-table-map ht void)))))
(printf "~a states, ~a grammar symbols, ~a hash-table entries, ~a reduces~n"
num-states num-gram-syms num-ht-entries num-reduces)
(printf "~a -- ~aKB, previously ~aKB~n"
(/ (+ 2 num-states
(* 4 num-states) (* 2 1.5 num-ht-entries)
(* 5 num-reduces)) 256.0)
(/ (+ 2 num-states
(* 4 num-states) (* 2 2.3 num-ht-entries)
(* 5 num-reduces)) 256.0)
(/ (+ 2 (* num-states num-gram-syms) (* 5 num-reduces)) 256.0)))
(values table (values table
all-tokens all-tokens
actions-code actions-code

@ -227,7 +227,8 @@
(term-vector (list->vector (send g get-terms))) (term-vector (list->vector (send g get-terms)))
(end-terms (send g get-end-terms)) (end-terms (send g get-end-terms))
(table (make-parse-table (send a get-num-states))) (table (make-parse-table (send a get-num-states)))
(get-lookahead (compute-LA a g))) (get-lookahead (compute-LA a g))
(reduce-cache (make-hash-table 'equal)))
(for-each (for-each
(lambda (trans-key/state) (lambda (trans-key/state)
@ -253,10 +254,15 @@
(bit-vector-for-each (bit-vector-for-each
(lambda (term-index) (lambda (term-index)
(unless (start-item? item) (unless (start-item? item)
(let ((r (hash-table-get reduce-cache item-prod
(lambda ()
(let ((r (make-reduce item-prod)))
(hash-table-put! reduce-cache item-prod r)
r)))))
(table-add! table (table-add! table
(kernel-index state) (kernel-index state)
(vector-ref term-vector term-index) (vector-ref term-vector term-index)
(make-reduce item-prod)))) r))))
(get-lookahead state item-prod)))) (get-lookahead state item-prod))))
(append (hash-table-get (send a get-epsilon-trans) state (lambda () null)) (append (hash-table-get (send a get-epsilon-trans) state (lambda () null))
(filter (lambda (item) (filter (lambda (item)

Loading…
Cancel
Save