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

[honu] use honu->racket in more builtin forms

Browse Source
This commit is contained in:
Jon Rafkind 2012-02-14 11:53:50 -07:00
parent 782664316d
commit bb85c06df4
3 changed files with 19 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -61,8 +61,6 @@
#'rest
#f)])))
(provide honu-if)
(define-honu-syntax honu-if
(lambda (code context)
@ -70,7 +68,10 @@
#:literals (else honu-then)
[(_ (#%parens condition:honu-expression) true:honu-expression (~optional else) false:honu-expression . rest)
(values
#'(%racket (if condition.result true.result false.result))
(with-syntax ([condition.result (honu->racket #'condition.result)]
[true.result (honu->racket #'true.result)]
[false.result (honu->racket #'false.result)])
#'(%racket (if condition.result true.result false.result)))
#'rest
#f)])))

17
collects/honu/core/private/operator.rkt
View File

@ -3,6 +3,7 @@
(require (for-syntax racket/base
"transformer.rkt"
"fixture.rkt"
"compile.rkt"
syntax/parse)
(only-in "literals.rkt" %racket))
@ -24,12 +25,12 @@
(define-honu-operator/syntax name precedence associativity
;; binary
(lambda (left right)
(with-syntax ([left left]
[right right])
(with-syntax ([left (honu->racket left)]
[right (honu->racket right)])
#'(%racket (operator left right))))
;; unary
(lambda (argument)
(with-syntax ([argument argument])
(with-syntax ([argument (honu->racket argument)])
#'(%racket (operator argument))))))
(define-syntax-rule (define-unary-operator name precedence associativity operator)
@ -37,20 +38,20 @@
#f
;; unary
(lambda (argument)
(with-syntax ([argument argument])
(with-syntax ([argument (honu->racket argument)])
#'(%racket (operator argument))))))
(define-honu-operator/syntax honu-flow 0.001 'left
(lambda (left right)
(with-syntax ([left left]
[right right])
(with-syntax ([left (honu->racket left)]
[right (honu->racket right)])
#'(%racket (right left)))))
(begin-for-syntax
(define-syntax-rule (mutator change)
(lambda (left right)
(with-syntax ([left left]
[right (change left right)])
(with-syntax ([left (honu->racket left)]
[right (change left (honu->racket right))])
#'(%racket (set! left right))))))
;; Traditional assignment operator

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

@ -373,7 +373,7 @@
#;
(emit-local-step stuff output #:id binary-transformer)
(with-syntax ([out (parse-all output)])
#'(%racket out)))
#'out))
#f)])
(do-parse unparsed precedence left parsed))
@ -441,10 +441,13 @@
colon (~seq variable:id honu-equal list:honu-expression (~optional honu-comma)) ...
(~seq honu-where where:honu-expression (~optional honu-comma)) ...)
(define filter (if (attribute where)
#'((#:when where.result) ...)
(with-syntax ([(where.result ...) (map honu->racket (syntax->list #'(where.result ...)))])
#'((#:when where.result) ...))
#'()))
(define comprehension
(with-syntax ([((filter ...) ...) filter])
(with-syntax ([((filter ...) ...) filter]
[(list.result ...) (map honu->racket (syntax->list #'(list.result ...)))]
[work.result (honu->racket #'work.result)])
#'(for/list ([variable list.result]
...
filter ... ...)