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

[honu] make dot a fixture so that assignment can work: v.x := 5

Browse Source
This commit is contained in:
Jon Rafkind 2011-12-09 13:21:43 -07:00
parent c9788909ea
commit 13abcf91fb
2 changed files with 46 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -179,6 +179,31 @@
(values out #'rest #t)])))
(provide honu-dot)
(define-honu-fixture honu-dot
(lambda (left rest)
(syntax-parse rest #:literal-sets (cruft)
#:literals (honu-assignment)
[(_ name:identifier honu-assignment argument:honu-expression . more)
(with-syntax ([left left])
(values #'(%racket
(let ([left* left])
(cond
[(honu-struct? left*)
(honu-struct-set! left* 'name argument.result)]
[(object? left*) (error 'set "implement set for objects")])))
#'more))]
[(_ name:identifier . more)
(with-syntax ([left left])
(values #'(%racket
(let ([left* left])
(cond
[(honu-struct? left*) (let ([use (honu-struct-get left*)])
(use left* 'name))]
[(object? left*) (get-field name left*)]
;; possibly handle other types of data
[else (error 'dot "don't know how to deal with ~a (~a)" 'left left*)])))
#'more))])))
#;
(define-honu-operator/syntax honu-dot 10000 'left
(lambda (left right)
(debug "dot left ~a right ~a\n" left right)

22
collects/honu/core/private/struct.rkt
View File

@ -12,10 +12,21 @@
(define-values (honu-struct honu-struct? honu-struct-get)
(make-struct-type-property 'honu-struct))
(define-values (honu-struct-mutable honu-struct-mutable? honu-struct-mutate)
(make-struct-type-property 'honu-struct-mutable))
(define-for-syntax (make-accessors name fields)
(for/list ([field fields])
(format-unique-id name "~a-~a" name field)))
(define-for-syntax (make-mutators name fields)
(for/list ([field fields])
(format-unique-id name "set-~a-~a!" name field)))
(provide honu-struct-set!)
(define (honu-struct-set! instance name value)
((honu-struct-mutate instance) instance name value))
(provide honu-structure)
(define-honu-syntax honu-structure
(lambda (code context)
@ -23,9 +34,18 @@
[(_ name:id (#%braces fields:identifier-comma-list) . rest)
(define out
(with-syntax ([(fields.name/accessor ...)
(make-accessors #'name (syntax->list #'(fields.name ...)))])
(make-accessors #'name (syntax->list #'(fields.name ...)))]
[(fields.name/mutator ...)
(make-mutators #'name (syntax->list #'(fields.name ...)))])
#'(%racket (struct name (fields.name ...)
#:transparent
#:mutable
#:property honu-struct-mutable
(lambda (instance name value)
(case name
[(fields.name) (fields.name/mutator instance value)]
...
[else (error 'dot "no such field name ~a" name)]))
#:property honu-struct (lambda (instance name)
(case name
[(fields.name) (fields.name/accessor instance)]