*** empty log message ***

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

@ -1,19 +1,27 @@
(module parser-actions mzscheme
(require "grammar.ss")
(provide (all-defined))
(provide (all-defined-except make-reduce make-reduce*)
(rename make-reduce* make-reduce))
;; An action is
;; - (make-shift int)
;; - (make-reduce prod)
;; - (make-reduce prod runtime-action)
;; - (make-accept)
;; - (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 (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 (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
;; non-negative-int (shift)
@ -24,11 +32,7 @@
(define (action->runtime-action a)
(cond
((shift? a) (shift-state a))
((reduce? a)
(let ((p (reduce-prod a)))
(vector (prod-index p)
(gram-sym-symbol (prod-lhs p))
(vector-length (prod-rhs p)))))
((reduce? a) (reduce-runtime-reduce a))
((accept? a) 'accept)
((goto? a) (- (+ (goto-state a) 1)))))

@ -69,7 +69,7 @@
#`(when #f
(let ((bind void) ... (tmp void) ...)
(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)
(let* ((grammar (parse-input input-terms start end assocs prods src-pos))
(table (build-table grammar filename suppress))
@ -79,6 +79,28 @@
(for-each (lambda (term)
(hash-table-put! all-tokens (gram-sym-symbol term) #t))
(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
all-tokens
actions-code

@ -227,7 +227,8 @@
(term-vector (list->vector (send g get-terms)))
(end-terms (send g get-end-terms))
(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
(lambda (trans-key/state)
@ -253,10 +254,15 @@
(bit-vector-for-each
(lambda (term-index)
(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
(kernel-index state)
(vector-ref term-vector term-index)
(make-reduce item-prod))))
r))))
(get-lookahead state item-prod))))
(append (hash-table-get (send a get-epsilon-trans) state (lambda () null))
(filter (lambda (item)

Loading…
Cancel
Save