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 #'rest
#f)]))) #f)])))
(provide honu-if) (provide honu-if)
(define-honu-syntax honu-if (define-honu-syntax honu-if
(lambda (code context) (lambda (code context)
@ -70,7 +68,10 @@
#:literals (else honu-then) #:literals (else honu-then)
[(_ (#%parens condition:honu-expression) 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)) (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 #'rest
#f)]))) #f)])))

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

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

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

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