suzanne.soy/cur
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

More quasisyntax/loc for better error messages

Browse Source
This commit is contained in:
William J. Bowman 2016-01-21 16:07:16 -05:00
parent cc502671a6
commit 14960fd038
No known key found for this signature in database
GPG Key ID: DDD48D26958F0D1A
1 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
cur-lib/cur/olly.rkt
View File

@ -289,7 +289,8 @@
#:attr sym (syntax->datum #'x) #:attr sym (syntax->datum #'x)
#:fail-when (dict-has-key? (mv-map) (attribute sym)) #f #:fail-when (dict-has-key? (mv-map) (attribute sym)) #f
#:attr constructor-name #:attr constructor-name
(format-id #'x "~a-~a" (lang-name) #'x))) (quasisyntax/loc #'x
#,(format-id #'x "~a-~a" (lang-name) #'x))))
;; A terminal-args can appear as the argument to a terminal in ;; A terminal-args can appear as the argument to a terminal in
;; an expression, or as a sub-expression in a terminal-args. ;; an expression, or as a sub-expression in a terminal-args.
@ -350,9 +351,9 @@
(pattern (pattern
e:meta-variable e:meta-variable
#:attr constructor-name #:attr constructor-name
(format-id #'e "~a->~a" #'e.type non-terminal-type) (quasisyntax/loc #'e #,(format-id #'e "~a->~a" #'e.type non-terminal-type))
#:attr constr-decl #:attr constr-decl
#`(constructor-name : (-> e.type #,non-terminal-type)) (quasisyntax/loc #'e (constructor-name : (-> e.type #,non-terminal-type)))
#:attr latex #:attr latex
(format "~a" (syntax-e #'e))) (format "~a" (syntax-e #'e)))
@ -360,7 +361,7 @@
(pattern (pattern
x:terminal x:terminal
#:attr constr-decl #:attr constr-decl
#`(x.constructor-name : #,non-terminal-type) (quasisyntax/loc #'x (x.constructor-name : #,non-terminal-type))
#:attr latex #:attr latex
(format "~a" (syntax-e #'x))) (format "~a" (syntax-e #'x)))
@ -368,7 +369,7 @@
(pattern (pattern
(x:terminal . (~var c (terminal-args non-terminal-type))) (x:terminal . (~var c (terminal-args non-terminal-type)))
#:attr constr-decl #:attr constr-decl
#`(x.constructor-name : (-> #,@(attribute c.args) #,non-terminal-type)) (quasisyntax/loc #'x (x.constructor-name : (-> #,@(attribute c.args) #,non-terminal-type)))
#:attr latex #:attr latex
(format "(~a ~a)" (syntax-e #'x) (attribute c.latex)))) (format "(~a ~a)" (syntax-e #'x) (attribute c.latex))))
@ -379,7 +380,7 @@
(~optional (~datum ::=)) (~optional (~datum ::=))
;; Create a name for the type of this non-terminal, from the ;; Create a name for the type of this non-terminal, from the
;; language name and the non-terminal name. ;; language name and the non-terminal name.
(~bind [nt-type (format-id #'name "~a-~a" (lang-name) #'name)]) (~bind [nt-type (quasisyntax/loc #'name #,(format-id #'name "~a-~a" (lang-name) #'name))])
;; Imperatively update the map from meta-variables to the ;; Imperatively update the map from meta-variables to the
;; nt-type, to be used when generating the types of the constructors ;; nt-type, to be used when generating the types of the constructors
;; for this and later non-terminal. ;; for this and later non-terminal.
@ -388,7 +389,7 @@
(~var c (expression (attribute nt-type))) ...) (~var c (expression (attribute nt-type))) ...)
;; Generates the inductive data type for this non-terminal definition. ;; Generates the inductive data type for this non-terminal definition.
#:attr def #:attr def
#`(data nt-type : Type c.constr-decl ...) (quasisyntax/loc #'name (data nt-type : Type c.constr-decl ...))
#:attr latex #:attr latex
(format (format
"\\mbox{\\textit{~a}} & ~a & \\bnfdef & ~a\\\\~n" "\\mbox{\\textit{~a}} & ~a & \\bnfdef & ~a\\\\~n"
@ -436,7 +437,7 @@
(dict-set! (mv-map) (syntax-e x) #'Nat)))]) (dict-set! (mv-map) (syntax-e x) #'Nat)))])
(syntax-parse #'non-terminal-defs (syntax-parse #'non-terminal-defs
[(def:non-terminal-def ...) [(def:non-terminal-def ...)
(let ([output #`(begin def.def ...)]) (let ([output (quasisyntax/loc #'name (begin def.def ...))])
(when (attribute latex-file) (when (attribute latex-file)
(with-output-to-file (syntax-e #'latex-file) (with-output-to-file (syntax-e #'latex-file)
(thunk (typeset-bnf (attribute def.latex))) (thunk (typeset-bnf (attribute def.latex)))