mbutterick
/
brag
1
0
Fork 0
Code Issues 3 Pull Requests 1 Projects Releases Wiki Activity

Fix indentation

Browse Source
remotes/jackfirth/master
Jack Firth 2 years ago
parent bd8fd280f6
commit c588b40a23
1 changed files with 56 additions and 55 deletions
Show Stats Download Patch File Download Diff File

111
parser-tools/private-yacc/input-file-parser.rkt
Unescape Escape View File

@ -26,7 +26,7 @@
[v (in-value (syntax-local-value td))] [v (in-value (syntax-local-value td))]
#:when (e-terminals-def? v) #:when (e-terminals-def? v)
[s (in-list (syntax->list (e-terminals-def-t v)))]) [s (in-list (syntax->list (e-terminals-def-t v)))])
(hash-set! empty-table (syntax->datum s) #t)) (hash-set! empty-table (syntax->datum s) #t))
(define args (define args
(let get-args ([i i][rhs rhs]) (let get-args ([i i][rhs rhs])
(cond (cond
@ -63,16 +63,16 @@
;; Fill the prec table ;; Fill the prec table
(for ([p-decl (in-list precs)]) (for ([p-decl (in-list precs)])
(define assoc (car p-decl)) (define assoc (car p-decl))
(for ([term-sym (in-list (cdr p-decl))]) (for ([term-sym (in-list (cdr p-decl))])
(hash-set! prec-table term-sym (prec counter assoc))) (hash-set! prec-table term-sym (prec counter assoc)))
(set! counter (add1 counter))) (set! counter (add1 counter)))
;; Build the terminal structures ;; Build the terminal structures
(for/list ([term-sym (in-list term-list)]) (for/list ([term-sym (in-list term-list)])
(term term-sym (term term-sym
#f #f
(hash-ref prec-table term-sym (λ () #f))))) (hash-ref prec-table term-sym (λ () #f)))))
;; Retrieves the terminal symbols from a terminals-def (See terminal-syntax.rkt) ;; Retrieves the terminal symbols from a terminals-def (See terminal-syntax.rkt)
;; get-terms-from-def: identifier? -> (listof identifier?) ;; get-terms-from-def: identifier? -> (listof identifier?)
@ -97,13 +97,13 @@
(define list-of-terms (map syntax-e (get-term-list term-defs))) (define list-of-terms (map syntax-e (get-term-list term-defs)))
(define end-terms (define end-terms
(for/list ([end (in-list ends)]) (for/list ([end (in-list ends)])
(unless (memq (syntax-e end) list-of-terms) (unless (memq (syntax-e end) list-of-terms)
(raise-syntax-error (raise-syntax-error
'parser-end-tokens 'parser-end-tokens
(format "End token ~a not defined as a token" (format "End token ~a not defined as a token"
(syntax-e end)) (syntax-e end))
end)) end))
(syntax-e end))) (syntax-e end)))
;; Get the list of terminals out of input-terms ;; Get the list of terminals out of input-terms
(define list-of-non-terms (define list-of-non-terms
(syntax-case prods () (syntax-case prods ()
@ -111,10 +111,10 @@
(begin (begin
(for ([nts (in-list (syntax->list #'(NON-TERM ...)))] (for ([nts (in-list (syntax->list #'(NON-TERM ...)))]
#:when (memq (syntax->datum nts) list-of-terms)) #:when (memq (syntax->datum nts) list-of-terms))
(raise-syntax-error (raise-syntax-error
'parser-non-terminals 'parser-non-terminals
(format "~a used as both token and non-terminal" (syntax->datum nts)) (format "~a used as both token and non-terminal" (syntax->datum nts))
nts)) nts))
(let ([dup (duplicate-list? (syntax->datum #'(NON-TERM ...)))]) (let ([dup (duplicate-list? (syntax->datum #'(NON-TERM ...)))])
(when dup (when dup
(raise-syntax-error (raise-syntax-error
@ -140,16 +140,16 @@
prec-decls))] prec-decls))]
[else (for ([t (in-list (syntax->list #'(TERM ... ...)))] [else (for ([t (in-list (syntax->list #'(TERM ... ...)))]
#:when (not (memq (syntax->datum t) list-of-terms))) #:when (not (memq (syntax->datum t) list-of-terms)))
(raise-syntax-error (raise-syntax-error
'parser-precedences 'parser-precedences
(format "Precedence declared for non-token ~a" (syntax->datum t)) (format "Precedence declared for non-token ~a" (syntax->datum t))
t)) t))
(for ([type (in-list (syntax->list #'(TYPE ...)))] (for ([type (in-list (syntax->list #'(TYPE ...)))]
#:unless (memq (syntax->datum type) `(left right nonassoc))) #:unless (memq (syntax->datum type) `(left right nonassoc)))
(raise-syntax-error (raise-syntax-error
'parser-precedences 'parser-precedences
"Associativity must be left, right or nonassoc" "Associativity must be left, right or nonassoc"
type)) type))
(syntax->datum prec-decls)]))] (syntax->datum prec-decls)]))]
[#f null] [#f null]
[_ (raise-syntax-error [_ (raise-syntax-error
@ -163,10 +163,10 @@
(define non-term-table (make-hasheq)) (define non-term-table (make-hasheq))
(for ([t (in-list terms)]) (for ([t (in-list terms)])
(hash-set! term-table (gram-sym-symbol t) t)) (hash-set! term-table (gram-sym-symbol t) t))
(for ([nt (in-list non-terms)]) (for ([nt (in-list non-terms)])
(hash-set! non-term-table (gram-sym-symbol nt) nt)) (hash-set! non-term-table (gram-sym-symbol nt) nt))
;; parse-prod: syntax-object -> gram-sym vector ;; parse-prod: syntax-object -> gram-sym vector
(define (parse-prod prod-so) (define (parse-prod prod-so)
@ -176,18 +176,18 @@
(begin (begin
(for ([t (in-list (syntax->list prod-so))] (for ([t (in-list (syntax->list prod-so))]
#:when (memq (syntax->datum t) end-terms)) #:when (memq (syntax->datum t) end-terms))
(raise-syntax-error (raise-syntax-error
'parser-production-rhs 'parser-production-rhs
(format "~a is an end token and cannot be used in a production" (syntax->datum t)) (format "~a is an end token and cannot be used in a production" (syntax->datum t))
t)) t))
(for/vector ([s (in-list (syntax->list prod-so))]) (for/vector ([s (in-list (syntax->list prod-so))])
(cond (cond
[(hash-ref term-table (syntax->datum s) #f)] [(hash-ref term-table (syntax->datum s) #f)]
[(hash-ref non-term-table (syntax->datum s) #f)] [(hash-ref non-term-table (syntax->datum s) #f)]
[else (raise-syntax-error [else (raise-syntax-error
'parser-production-rhs 'parser-production-rhs
(format "~a is not declared as a terminal or non-terminal" (syntax->datum s)) (format "~a is not declared as a terminal or non-terminal" (syntax->datum s))
s)])))] s)])))]
[_ (raise-syntax-error [_ (raise-syntax-error
'parser-production-rhs 'parser-production-rhs
"production right-hand-side must have form (symbol ...)" "production right-hand-side must have form (symbol ...)"
@ -262,29 +262,30 @@
(for ([sstx (in-list start)] (for ([sstx (in-list start)]
[ssym (in-list start-syms)] [ssym (in-list start-syms)]
#:unless (memq ssym list-of-non-terms)) #:unless (memq ssym list-of-non-terms))
(raise-syntax-error (raise-syntax-error
'parser-start 'parser-start
(format "Start symbol ~a not defined as a non-terminal" ssym) (format "Start symbol ~a not defined as a non-terminal" ssym)
sstx)) sstx))
(define starts (map (λ (x) (non-term (gensym) #f)) start-syms)) (define starts (map (λ (x) (non-term (gensym) #f)) start-syms))
(define end-non-terms (map (λ (x) (non-term (gensym) #f)) start-syms)) (define end-non-terms (map (λ (x) (non-term (gensym) #f)) start-syms))
(define parsed-prods (map parse-prods-for-nt (syntax->list prods))) (define parsed-prods (map parse-prods-for-nt (syntax->list prods)))
(define start-prods (for/list ([start (in-list starts)] (define start-prods
[end-non-term (in-list end-non-terms)]) (for/list ([start (in-list starts)]
(list (prod start (vector end-non-term) #f #f #'values)))) [end-non-term (in-list end-non-terms)])
(list (prod start (vector end-non-term) #f #f #'values))))
(define new-prods (define new-prods
(append start-prods (append start-prods
(for/list ([end-nt (in-list end-non-terms)] (for/list ([end-nt (in-list end-non-terms)]
[start-sym (in-list start-syms)]) [start-sym (in-list start-syms)])
(for/list ([end (in-list end-terms)]) (for/list ([end (in-list end-terms)])
(prod end-nt (prod end-nt
(vector (vector
(hash-ref non-term-table start-sym) (hash-ref non-term-table start-sym)
(hash-ref term-table end)) (hash-ref term-table end))
#f #f
#f #f
#'values))) #'values)))
parsed-prods)) parsed-prods))
(make-object grammar% (make-object grammar%

Write Preview
Loading…
Cancel
Save