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

[honu] function application respects precedence so that dot can bind higher

Browse Source
This commit is contained in:
Jon Rafkind 2011-09-08 15:04:50 -06:00
parent 8ae1a903fa
commit 062a20f7e1
5 changed files with 26 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -13,6 +13,7 @@
(rename-out [#%dynamic-honu-module-begin #%module-begin] (rename-out [#%dynamic-honu-module-begin #%module-begin]
[honu-top-interaction #%top-interaction] [honu-top-interaction #%top-interaction]
[honu-function function] [honu-function function]
[honu-require require]
[honu-macro macro] [honu-macro macro]
[honu-syntax syntax] [honu-syntax syntax]
[honu-var var] [honu-var var]

1
collects/honu/core/private/honu-typed-scheme.rkt
View File

@ -409,6 +409,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
#'(provide x.x ...)) #'(provide x.x ...))
#'rest)]))) #'rest)])))
#;
(honu:define-honu-syntax honu-require (honu:define-honu-syntax honu-require
(lambda (body ctx) (lambda (body ctx)
(define-syntax-class for-syntax-form (define-syntax-class for-syntax-form

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

@ -166,3 +166,13 @@
(syntax-case stx () (syntax-case stx ()
[(_ rest ...) [(_ rest ...)
#'(#%top-interaction . (honu-unparsed-begin rest ...))])) #'(#%top-interaction . (honu-unparsed-begin rest ...))]))
(provide honu-require)
(define-honu-syntax honu-require
(lambda (code context)
(syntax-parse code
[(_ module . rest)
(values
#'(require module)
#'rest
#f)])))

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

@ -264,13 +264,20 @@
;; expression or function application ;; expression or function application
[(#%parens args ...) [(#%parens args ...)
(if current (if current
(let () (if (> precedence 9000)
(debug "function call ~a\n" left) (let ()
(define call (with-syntax ([current current] (define call (with-syntax ([current (left current)]
[(parsed-args ...) [(parsed-args ...)
(parse-comma-expression #'(args ...)) ]) (parse-comma-expression #'(args ...)) ])
#'(current parsed-args ...))) #'(current parsed-args ...)))
(do-parse #'(rest ...) precedence left call)) (do-parse #'(rest ...) 9000 (lambda (x) x) call))
(let ()
(debug "function call ~a\n" left)
(define call (with-syntax ([current current]
[(parsed-args ...)
(parse-comma-expression #'(args ...)) ])
#'(current parsed-args ...)))
(do-parse #'(rest ...) precedence left call)))
(let () (let ()
(debug "inner expression ~a\n" #'(args ...)) (debug "inner expression ~a\n" #'(args ...))
(define-values (inner-expression unparsed) (parse #'(args ...))) (define-values (inner-expression unparsed) (parse #'(args ...)))

4
collects/honu/core/read.rkt
View File

@ -70,11 +70,7 @@
[":" (token-identifier ':)] [":" (token-identifier ':)]
["'" (token-identifier 'quote)] ["'" (token-identifier 'quote)]
["`" (token-identifier 'quasiquote)] ["`" (token-identifier 'quasiquote)]
;; ["=" (token-identifier '=)]
[operator (token-identifier (string->symbol lexeme))] [operator (token-identifier (string->symbol lexeme))]
;; ["*" (token-identifier '*)]
;; ["/" (token-identifier '/)]
;; ["+" (token-identifier '+)]
[";" (token-identifier '|;|)] [";" (token-identifier '|;|)]
;; strip the quotes from the resulting string ;; strip the quotes from the resulting string
;; TODO: find a more optimal way ;; TODO: find a more optimal way