mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
original commit: 8d5d988ce3fa041013d10351e44003908781c5f6
tokens
Scott Owens 23 years ago
parent edc6b1891e
commit 584ff1ccfb
3 changed files with 55 additions and 31 deletions
Show Stats Download Patch File Download Diff File

13
collects/parser-tools/private-yacc/grammar.ss
Unescape Escape View File

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

67
collects/parser-tools/private-yacc/input-file-parser.ss
Unescape Escape View File

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

6
collects/parser-tools/private-yacc/parser-builder.ss
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save