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

[honu] actually check for separator for the separate ids class. parse constructor arguments with comma separated ids

Browse Source
This commit is contained in:
Jon Rafkind 2011-11-15 12:19:03 -07:00
parent 815c3887fb
commit 219a39575a
3 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,7 +2,7 @@
(require "macro2.rkt" (require "macro2.rkt"
"literals.rkt" "literals.rkt"
(only-in "honu2.rkt" honu-declaration honu-equal) (only-in "honu2.rkt" honu-declaration honu-equal separate-ids)
(for-syntax racket/base (for-syntax racket/base
"literals.rkt" "literals.rkt"
"parse2.rkt" "parse2.rkt"
@ -25,11 +25,12 @@
(define-honu-syntax honu-class (define-honu-syntax honu-class
(lambda (code context) (lambda (code context)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ name (#%parens constructor-argument ...) (#%braces method:honu-class-thing ...) . rest) [(_ name (#%parens (~var constructor-argument (separate-ids #'honu-comma #'dont-care)))
(#%braces method:honu-class-thing ...) . rest)
(define class (define class
#'(%racket (define name (class* object% () #'(%racket (define name (class* object% ()
(super-new) (super-new)
(init-field constructor-argument ...) (init-field constructor-argument.id ...)
method.result ...)))) method.result ...))))
(values class #'rest #t)]))) (values class #'rest #t)])))

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

@ -260,15 +260,18 @@
#'more))]))) #'more))])))
(begin-for-syntax (begin-for-syntax
(define-splicing-syntax-class (id-must-be what)
[pattern x:id #:when (free-identifier=? #'x what)])
(define-splicing-syntax-class (id-except ignores) (define-splicing-syntax-class (id-except ignores)
[pattern x:id #:when (not (for/fold ([ok #t]) [pattern x:id #:when (not (for/fold ([ok #f])
([ignore ignores]) ([ignore ignores])
(and ok (free-identifier=? #'x ignore))))]) (or ok (free-identifier=? #'x ignore))))])
(provide separate-ids)
(define-splicing-syntax-class (separate-ids separator end) (define-splicing-syntax-class (separate-ids separator end)
[pattern (~seq (~var first (id-except (list separator end))) [pattern (~seq (~var first (id-except (list separator end)))
(~seq (~var between (id-except (list separator end))) (~seq (~var between (id-must-be separator))
(~var next (id-except (list separator end)))) ...) (~var next (id-except (list separator end)))) ...)
#:with (ids ...) #'(first.x next.x ...)])) #:with (id ...) #'(first.x next.x ...)]))
(begin-for-syntax (begin-for-syntax
(provide honu-declaration) (provide honu-declaration)
@ -285,7 +288,7 @@
#:literals (honu-equal honu-var) #:literals (honu-equal honu-var)
[pattern (~seq honu-var (~var variables (separate-ids #'honu-comma #'honu-equal)) [pattern (~seq honu-var (~var variables (separate-ids #'honu-comma #'honu-equal))
honu-equal one:honu-expression) honu-equal one:honu-expression)
#:with (name ...) #'(variables.ids ...) #:with (name ...) #'(variables.id ...)
#:with expression #'one.result])) #:with expression #'one.result]))
(provide honu-var) (provide honu-var)

6
collects/tests/honu/class.honu
View File

@ -1,11 +1,11 @@
#lang honu #lang honu
class What(x){ class What(x, y){
var q = 2 var q = 2
foobar(z){ foobar(z){
z + x z + x + y
} }
}; };
var instance = new What(5); var instance = new What(5, 8);
printf("got ~a\n", instance->foobar(10)) printf("got ~a\n", instance->foobar(10))