|
|
@ -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%
|
|
|
|