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

[honu] refactor dot into syntax classes

Browse Source
This commit is contained in:
Jon Rafkind 2011-12-09 16:03:45 -07:00
parent 13abcf91fb
commit ec02c2f83a
1 changed files with 32 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -181,28 +181,38 @@
(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))])))
;; v.x = 5
(define-syntax-class assign #:literal-sets (cruft)
#:literals (honu-assignment)
[pattern (_ name:identifier honu-assignment argument:honu-expression . more)
#:with result (with-syntax ([left left])
#'(%racket
(let ([left* left])
(cond
[(honu-struct? left*)
(honu-struct-set! left* 'name argument.result)]
[(object? left*) (error 'set "implement set for objects")]))))
#:with rest #'more])
;; v.x
(define-syntax-class plain #:literal-sets (cruft)
#:literals (honu-assignment)
[pattern (_ name:identifier . more)
#:with result (with-syntax ([left left])
#'(%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*)]))))
#:with rest #'more])
(syntax-parse rest
[stuff:assign (values #'stuff.result #'stuff.rest)]
[stuff:plain (values #'stuff.result #'stuff.rest)])))
#;
(define-honu-operator/syntax honu-dot 10000 'left
(lambda (left right)