*** empty log message ***

original commit: 8d5d988ce3fa041013d10351e44003908781c5f6
tokens
Scott Owens 23 years ago
parent edc6b1891e
commit 584ff1ccfb

@ -4,9 +4,6 @@
;; Constructs to create and access grammars, the internal
;; representation of the input to the parser generator.
(require (lib "list.ss")
"yacc-helper.ss")
(provide
(rename export-make-item make-item)
@ -35,7 +32,7 @@
(rename gram-prods grammar-prods)
;; Things that work on productions
prod-index prod-prec prod-rhs prod-lhs)
prod-index prod-prec prod-rhs prod-lhs prod-action)
;;---------------------- LR items --------------------------
@ -188,6 +185,6 @@
;; ------------------------ Productions ---------------------------
;; production = (make-prod non-term (gram-sym vector) int prec)
(define-struct prod (lhs rhs index prec))
;; production = (make-prod non-term (gram-sym vector) int prec syntax-object)
(define-struct prod (lhs rhs index prec action))
)

@ -8,6 +8,14 @@
(provide parse-input)
;; get-args: num * syntax-object -> syntax-object list
(define (get-args x act)
(let loop ((i 1))
(cond
((> i x) null)
(else (cons (datum->syntax-object act (string->symbol (format "$~a" i)))
(loop (add1 i)))))))
;; nullable: production list * int -> non-term set
;; determines which non-terminals can derive epsilon
(define (nullable prods num-nts)
@ -104,7 +112,7 @@
term-syn)))))
;; parse-input: syntax-object^4 * string -> grammar
(define (parse-input start term-defs prec-decls prods)
(define (parse-input start term-defs prec-decls prods runtime)
(let* ((counter 0)
(start-sym (syntax-object->datum start))
@ -261,6 +269,15 @@
"production right-hand-side must have form (symbol ...)"
prod-so)))))
;; parse-action: gram-sym vector * syntax-object -> syntax-object
(parse-action
(lambda (prod act)
(datum->syntax-object
runtime
`(lambda ,(get-args (vector-length prod) act)
,act)
act)))
;; parse-prod+action: non-term * syntax-object -> production
(parse-prod+action
(lambda (nt prod-so)
@ -278,14 +295,16 @@
(if (term? gs)
(term-prec gs)
(loop (sub1 i))))
#f)))
#f))
(parse-action p (syntax action)))
(set! counter (add1 counter)))))
((prod-rhs (prec term) action)
(identifier? (syntax term))
(let ((p (parse-prod (syntax prod-rhs))))
(begin0
(make-prod
nt
(parse-prod (syntax prod-rhs))
p
counter
(term-prec
(hash-table-get
@ -298,6 +317,7 @@
"unrecognized terminal ~a in precedence declaration"
(syntax-object->datum (syntax term)))
(syntax term)))))
(parse-action p (syntax action)))
(set! counter (add1 counter)))))
(_
(raise-syntax-error
@ -329,7 +349,10 @@
(vector (hash-table-get non-term-table
start-sym))
0
#f))
#f
(datum->syntax-object
runtime
`(lambda (x) x))))
(map parse-prods-for-nt (syntax->list prods))))
(nulls (nullable (apply append prods)
(add1 (length non-terms)))))

@ -9,7 +9,7 @@
(provide build-parser)
(define (build-parser start input-terms assocs prods filename runtime src)
(let* ((grammar (parse-input start input-terms assocs prods))
(let* ((grammar (parse-input start input-terms assocs prods runtime))
(table (build-table grammar filename))
(table-code
(cons 'vector
@ -38,9 +38,13 @@
(grammar-terms grammar))
ht)))
(actions-code
`(vector ,@(map prod-action (grammar-prods grammar))))
(parser-code
`(letrec ((term-sym->index ,token-code)
(table ,table-code)
(actions ,actions-code)
(pop-x
(lambda (s n)
(if (> n 0)

Loading…
Cancel
Save