You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
72 lines
2.3 KiB
Racket
72 lines
2.3 KiB
Racket
3 years ago
|
#lang racket/base
|
||
|
|
(require (prefix-in rl: racket/list)
|
||
|
3 years ago
|
yaragg-parser-tools/private-lex/token-syntax)
|
||
|
3 years ago
|
|
||
|
|
;; General helper routines
|
||
|
|
(provide duplicate-list? remove-duplicates overlap? vector-andmap display-yacc)
|
||
|
|
|
||
|
|
(define (vector-andmap pred vec)
|
||
|
|
(for/and ([item (in-vector vec)])
|
||
|
|
(pred vec)))
|
||
|
|
|
||
|
|
;; duplicate-list?: symbol list -> #f | symbol
|
||
|
|
;; returns a symbol that exists twice in l, or false if no such symbol
|
||
|
|
;; exists
|
||
|
|
(define (duplicate-list? syms)
|
||
|
|
(rl:check-duplicates syms eq?))
|
||
|
|
|
||
|
|
;; remove-duplicates: syntax-object list -> syntax-object list
|
||
|
|
;; removes the duplicates from the lists
|
||
|
|
(define (remove-duplicates syms)
|
||
|
|
(rl:remove-duplicates syms equal? #:key syntax->datum))
|
||
|
|
|
||
|
|
;; overlap?: symbol list * symbol list -> #f | symbol
|
||
|
|
;; Returns an symbol in l1 intersect l2, or #f is no such symbol exists
|
||
|
|
(define (overlap? syms1 syms2)
|
||
|
|
(for/first ([sym1 (in-list syms1)]
|
||
|
|
#:when (memq sym1 syms2))
|
||
|
|
sym1))
|
||
|
|
|
||
|
|
|
||
|
|
(define (display-yacc grammar tokens start precs port)
|
||
|
|
(let-syntax ([p (syntax-rules ()
|
||
|
|
((_ args ...) (fprintf port args ...)))])
|
||
|
|
(let* ([tokens (map syntax-local-value tokens)]
|
||
|
|
[eterms (filter e-terminals-def? tokens)]
|
||
|
|
[terms (filter terminals-def? tokens)]
|
||
|
|
[term-table (make-hasheq)]
|
||
|
|
[display-rhs
|
||
|
|
(λ (rhs)
|
||
|
|
(for ([sym (in-list (car rhs))])
|
||
|
|
(p "~a " (hash-ref term-table sym (λ () sym))))
|
||
|
|
(when (= 3 (length rhs))
|
||
|
|
(p "%prec ~a" (cadadr rhs)))
|
||
|
|
(p "\n"))])
|
||
|
|
(for* ([t (in-list eterms)]
|
||
|
|
[t (in-list (syntax->datum (e-terminals-def-t t)))])
|
||
|
|
(hash-set! term-table t (format "'~a'" t)))
|
||
|
|
(for* ([t (in-list terms)]
|
||
|
|
[t (in-list (syntax->datum (terminals-def-t t)))])
|
||
|
|
(p "%token ~a\n" t)
|
||
|
|
(hash-set! term-table t (format "~a" t)))
|
||
|
|
(when precs
|
||
|
|
(for ([prec (in-list precs)])
|
||
|
|
(p "%~a " (car prec))
|
||
|
|
(for ([tok (in-list (cdr prec))])
|
||
|
|
(p " ~a" (hash-ref term-table tok)))
|
||
|
|
(p "\n")))
|
||
|
|
(p "%start ~a\n" start)
|
||
|
|
(p "%%\n")
|
||
|
|
(for ([prod (in-list grammar)])
|
||
|
|
(define nt (car prod))
|
||
|
|
(p "~a: " nt)
|
||
|
|
(display-rhs (cadr prod))
|
||
|
|
(for ([rhs (in-list (cddr prod))])
|
||
|
|
(p "| ")
|
||
|
|
(display-rhs rhs))
|
||
|
|
(p ";\n"))
|
||
|
|
(p "%%\n"))))
|
||
|
|
|
||
|
|
|
||
|
|
|