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

[honu] remove unused embedding of racket code inside a honu expression via %racket

Browse Source
This commit is contained in:
Jon Rafkind 2012-10-03 17:21:10 -06:00
parent 8210acc696
commit c758069a09
4 changed files with 6 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/honu/core/private/compile.rkt
View File

@ -11,24 +11,6 @@
(provide (all-defined-out)) (provide (all-defined-out))
(define (honu->racket forms)
(define-literal-set literals (%racket))
forms
#;
(syntax-parse forms #:literal-sets (literals)
#:literals ([literal-syntax syntax])
[(%racket x) #'x
#;
(honu->racket #'x)]
[(literal-syntax form) #'#'form]
[(form ...)
(datum->syntax forms
(map honu->racket (syntax->list #'(form ...)))
forms
forms)]
[x #'x]
[() forms]))
(define (strip-stops code) (define (strip-stops code)
(define-syntax-class stopper #:literal-sets (cruft) (define-syntax-class stopper #:literal-sets (cruft)
#; #;

4
collects/honu/core/private/literals.rkt
View File

@ -34,8 +34,7 @@
honu-$ honu-$
;; FIXME: in-lines should probably not be here ;; FIXME: in-lines should probably not be here
honu-in-lines honu-in-lines
postfix postfix)
%racket)
(define-syntax-rule (define-literal+set set literal ...) (define-syntax-rule (define-literal+set set literal ...)
(begin (begin
@ -44,5 +43,4 @@
(define-literal-set set (literal ...))))) (define-literal-set set (literal ...)))))
(define-literal-set cruft (#%parens #%brackets #%braces (define-literal-set cruft (#%parens #%brackets #%braces
%racket
semicolon colon honu-comma)) semicolon colon honu-comma))

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

@ -49,7 +49,7 @@
#f #f
;; unary ;; unary
(lambda (argument) (lambda (argument)
(with-syntax ([argument (honu->racket argument)]) (with-syntax ([argument argument])
(racket-syntax (operator argument)))) (racket-syntax (operator argument))))
postfix?)) postfix?))
@ -62,8 +62,8 @@
(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 (honu->racket left)] (with-syntax ([left left]
[right (change left (honu->racket right))]) [right (change left right)])
(racket-syntax (set! left right)))))) (racket-syntax (set! left right))))))
;; Traditional assignment operator ;; Traditional assignment operator

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

@ -25,7 +25,6 @@
;; phase -1 ;; phase -1
(require (for-template racket/base (require (for-template racket/base
racket/splicing racket/splicing
(only-in "literals.rkt" %racket)
"compile.rkt" "compile.rkt"
"syntax.rkt" "syntax.rkt"
"extra.rkt")) "extra.rkt"))
@ -507,13 +506,10 @@
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)
(with-syntax ([(where.result ...) (map honu->racket (syntax->list #'(where.result ...)))]) #'((#:when 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)])
(racket-syntax (for/list ([variable list.result] (racket-syntax (for/list ([variable list.result]
... ...
filter ... ...) filter ... ...)