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

[honu] check for definitions before continuing to parse. completely parse the left hand side of an operator

Browse Source
This commit is contained in:
Jon Rafkind 2012-04-16 16:48:49 -06:00
parent 6dc3fbb72c
commit bb57412242
2 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/honu/core/private/macro2.rkt
View File

@ -181,7 +181,7 @@
;; instead of x_result. x_result is still there, too
(with-syntax ([pattern-variable.name #'pattern-variable.result]
...)
(debug "~a = ~a\n" 'pattern-variable.name #'pattern-variable.name) ...
(debug "~a = ~a\n" 'pattern-variable.name (syntax->datum #'pattern-variable.name)) ...
(parse-stuff action ...))
#'more #t)]
[else (raise-syntax-error #f "Could not match macro" stx)]

15
collects/honu/core/private/parse2.rkt
View File

@ -26,6 +26,7 @@
racket/splicing
(only-in "literals.rkt" %racket)
"compile.rkt"
"syntax.rkt"
"extra.rkt"))
(provide parse parse-all)
@ -227,7 +228,13 @@
body.result)))])
(define (definition? code)
#f)
(define (contains-define? code)
(syntax-parse code #:literals (define define-honu-syntax)
[(define x ...) #t]
[(define-honu-syntax x ...) #t]
[else #f]))
(and (parsed-syntax? code)
(contains-define? code)))
;; E = macro
;; | E operator E
@ -310,7 +317,7 @@
(debug "Reparsed output ~a\n" (pretty-format (syntax->datum re-parse)))
(define terminate (definition? re-parse))
(debug "Terminate? ~a\n" terminate)
(if terminate?
(if terminate
(values (left re-parse)
#'rest)
(do-parse #'rest precedence
@ -391,7 +398,7 @@
(define output
(if current
(if binary-transformer
(binary-transformer current right)
(binary-transformer (parse-all current) right)
(error 'binary "cannot be used as a binary operator in ~a" #'head))
(if unary-transformer
(unary-transformer right)
@ -622,7 +629,7 @@
(debug 2 "[~a] Parsed things ~a\n" context (parsed-things stx unparsed))
(if (parsed-syntax? parsed)
(list (parsed-things stx unparsed)
(parsed-syntax parsed))
parsed)
(list (parsed-things stx unparsed)
(parse-all parsed)))))))