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

[honu] wrap the condition of when expression inside parentheses. instantiate literal sets at the proper phase for honu macros

Browse Source
This commit is contained in:
Jon Rafkind 2012-02-01 14:45:30 -07:00
parent 712951d347
commit b74ad87160
4 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -68,7 +68,7 @@
(lambda (code context)
(syntax-parse code #:literal-sets (cruft)
#:literals (else honu-then)
[(_ condition:honu-expression honu-then true:honu-expression (~optional else) false:honu-expression . rest)
[(_ (#%parens condition:honu-expression) true:honu-expression (~optional else) false:honu-expression . rest)
(values
#'(%racket (if condition.result true.result false.result))
#'rest

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

@ -22,23 +22,25 @@
(define-splicing-syntax-class pattern-type
#:literal-sets (cruft)
[pattern (~seq name colon class)
#:with result #'(~var name class #:attr-name-separator "_")]
[pattern x #:with result #'x])
#:with (result ...) #'((~var name class #:attr-name-separator "_"))]
[pattern (x:pattern-type ...) #:with (result ...) #'((x.result ... ...))]
[pattern x #:with (result ...) #'(x)])
(syntax-parse original-pattern
[(thing:pattern-type ...)
#'(thing.result ...)]))
#'(thing.result ... ...)]))
(define-for-syntax (find-pattern-variables original-pattern)
(define-splicing-syntax-class pattern-type
#:literal-sets (cruft)
[pattern (~seq name colon class)
;; we know the output of syntactic classes will end with _result
#:with result (with-syntax ([name.result (format-id #'name "~a_result" #'name)])
#'(name name.result))]
[pattern x #:with result #f])
#:with (result ...) (with-syntax ([name.result (format-id #'name "~a_result" #'name)])
#'((name name.result)))]
[pattern (x:pattern-type ...) #:with (result ...) #'(x.result ... ...)]
[pattern x #:with (result ...) #'()])
(syntax-parse original-pattern
[(thing:pattern-type ...)
(filter (lambda (x) (syntax-e x)) (syntax->list #'(thing.result ...)))]))
(filter (lambda (x) (syntax-e x)) (syntax->list #'(thing.result ... ...)))]))
(begin-for-syntax
(define-syntax (parse-stuff stx)
@ -63,7 +65,8 @@
(lambda (stx context-name)
(define-literal-set local-literals (literal ...))
(syntax-parse stx
#:literal-sets (cruft local-literals)
#:literal-sets ([cruft #:at name]
[local-literals #:at name])
[(_ syntax-parse-pattern ... . more)
(values
;; if the pattern is x:expression then x_result will

4
collects/honu/private/common.honu
View File

@ -1,8 +1,8 @@
#lang honu/core
provide when;
macro when (then){ condition:expression then body:expression }{
syntax(if condition then body else { void() })
macro when (){ (condition:expression) body:expression }{
syntax(if (condition) body else { })
}
/*

2
collects/tests/honu/check.rkt
View File

@ -104,7 +104,7 @@
(test
"if"
@input{
if 2 > 1 then
if (2 > 1)
1
else
0