[honu] only allow semicolons in expression sequence position

This commit is contained in:
Jon Rafkind 2012-04-12 12:48:59 -06:00
parent fa8377883d
commit c390d96780
2 changed files with 11 additions and 1 deletions

View File

@ -472,9 +472,16 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(debug "expanded ~a unexpanded ~a\n" (debug "expanded ~a unexpanded ~a\n"
(if parsed (syntax->datum parsed) parsed) (if parsed (syntax->datum parsed) parsed)
(syntax->datum unparsed)) (syntax->datum unparsed))
#'(begin
(define-syntax (parse-more stx)
(syntax-case stx ()
[(_ stuff (... ...))
(do-parse-rest #'(stuff (... ...)) #'parse-more)]))
(parse-more forms ...))
;; if parsed is #f then we don't want to expand to anything that will print ;; if parsed is #f then we don't want to expand to anything that will print
;; so use an empty form, begin, `parsed' could be #f becuase there was no expression ;; so use an empty form, begin, `parsed' could be #f becuase there was no expression
;; in the input such as parsing just ";". ;; in the input such as parsing just ";".
#;
(with-syntax ([parsed (if (not parsed) #'(begin) (with-syntax ([parsed (if (not parsed) #'(begin)
(remove-repeats parsed) (remove-repeats parsed)
#; #;

View File

@ -143,7 +143,9 @@
(provide do-parse-rest) (provide do-parse-rest)
(define (do-parse-rest stx parse-more) (define (do-parse-rest stx parse-more)
(syntax-parse stx (syntax-parse stx #:literal-sets (cruft)
[(semicolon semicolon ... rest ...)
(do-parse-rest #'(rest ...) parse-more)]
[(stuff ...) [(stuff ...)
(debug "Parse rest ~a\n" (syntax->datum #'(stuff ...))) (debug "Parse rest ~a\n" (syntax->datum #'(stuff ...)))
(define-values (parsed unparsed) (define-values (parsed unparsed)
@ -431,6 +433,7 @@
(define-splicing-syntax-class no-left (define-splicing-syntax-class no-left
[pattern (~seq) #:when (and (= precedence 0) (not current))]) [pattern (~seq) #:when (and (= precedence 0) (not current))])
(syntax-parse #'(head rest ...) #:literal-sets (cruft) (syntax-parse #'(head rest ...) #:literal-sets (cruft)
#;
[(semicolon . rest) [(semicolon . rest)
(debug "Parsed a semicolon, finishing up with ~a\n" current) (debug "Parsed a semicolon, finishing up with ~a\n" current)
(values (left current) #'rest)] (values (left current) #'rest)]