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

[honu] add dot as an operator. parse parenthesized expressions

Browse Source
This commit is contained in:
Jon Rafkind 2011-08-10 12:45:16 -06:00
parent c8695ddf2e
commit 17f1ac53be
3 changed files with 28 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/honu/core/main.rkt
View File

@ -17,6 +17,7 @@
[honu-+ +] [honu-- -]
[honu-* *] [honu-/ /]
[honu-^ ^]
[honu-dot |.|]
[honu-cons ::]
[honu-and and]
[honu-or or]

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

@ -86,6 +86,18 @@
[right right])
#'(operator left right))))))
(provide honu-dot)
(define-honu-operator/syntax honu-dot 10000 'left
(lambda (left right)
(with-syntax ([left left]
[right right])
#'(let ([left* left]
[right* right])
(cond
[(list? left*)
(list-ref left* right*)]
[else (error 'dot "don't know how to deal with ~a and ~a" left* right*)])))))
(define-binary-operator honu-+ 1 'left +)
(define-binary-operator honu-- 1 'left -)
(define-binary-operator honu-* 2 'left *)

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

@ -238,12 +238,21 @@
(define body (parse-all #'(stuff ...)))
(do-parse #'(rest ...) precedence left body)))]
[(#%parens args ...)
(debug "function call ~a\n" left)
(values (left (with-syntax ([current current]
[(parsed-args ...)
(parse-comma-expression #'(args ...)) ])
#'(current parsed-args ...)))
#'(rest ...))
(if current
(let ()
(debug "function call ~a\n" left)
(values (left (with-syntax ([current current]
[(parsed-args ...)
(parse-comma-expression #'(args ...)) ])
#'(current parsed-args ...)))
#'(rest ...)))
(let ()
(debug "inner expression ~a\n" #'(args ...))
(define-values (inner-expression unparsed) (parse #'(args ...)))
(when (not (empty-syntax? unparsed))
(error 'parse "expression had unparsed elements ~a" unparsed))
(do-parse #'(rest ...) precedence left inner-expression)))
#;
(do-parse #'(rest ...)
0