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

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

View File

@ -68,7 +68,7 @@
(lambda (code context) (lambda (code context)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
#:literals (else honu-then) #: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 (values
#'(%racket (if condition.result true.result false.result)) #'(%racket (if condition.result true.result false.result))
#'rest #'rest

View File

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

View File

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

View File

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