*** empty log message ***

original commit: 36bccc62d0555fc59aa6fddfe90b15012dd66c8f
tokens
Scott Owens 23 years ago
parent 00bae08fd7
commit 024d9d45cf

@ -10,7 +10,7 @@
(provide lex define-lex-abbrev define-lex-abbrevs (provide lex define-lex-abbrev define-lex-abbrevs
make-lex-buf make-lex-buf
get-position position-offset position-line position-col position? get-position position-offset position-line position-col position?
define-tokens define-empty-tokens) define-tokens define-empty-tokens token-value token-name token?)
(define-syntax lex (define-syntax lex

@ -12,19 +12,36 @@
(let* ((grammar (parse-input start end input-terms assocs prods runtime)) (let* ((grammar (parse-input start end input-terms assocs prods runtime))
(table (build-table grammar filename)) (table (build-table grammar filename))
(table-code (table-code
(cons 'vector `((lambda (table-list)
(map (lambda (action) (let ((v (list->vector table-list)))
(let loop ((i 0))
(cond
((< i (vector-length v))
(let ((vi (vector-ref v i)))
(cond (cond
((shift? action) ((list? vi)
`(make-shift ,(shift-state action))) (vector-set! v i
((reduce? action) (cond
`(make-reduce ,(reduce-prod-num action) ((eq? 's (car vi))
,(reduce-lhs-num action) (make-shift (cadr vi)))
,(reduce-rhs-length action))) ((eq? 'r (car vi))
((accept? action) (make-reduce (cadr vi) (caddr vi) (cadddr vi)))
`(make-accept)) ((eq? 'a (car vi)) (make-accept)))))))
(else action))) (loop (add1 i)))
(vector->list table)))) (else v)))))
(quote
,(map (lambda (action)
(cond
((shift? action)
`(s ,(shift-state action)))
((reduce? action)
`(r ,(reduce-prod-num action)
,(reduce-lhs-num action)
,(reduce-rhs-length action)))
((accept? action)
`(a))
(else action)))
(vector->list table)))))
(num-non-terms (length (grammar-non-terms grammar))) (num-non-terms (length (grammar-non-terms grammar)))

Loading…
Cancel
Save