[honu] delay parsing of function bodies

This commit is contained in:
Jon Rafkind 2011-11-21 14:05:27 -07:00
parent bef2f188b3
commit 973000adbb
3 changed files with 43 additions and 10 deletions

View File

@ -3,7 +3,8 @@
(require syntax/parse
"literals.rkt")
(provide honu->racket)
(provide (all-defined-out))
(define (honu->racket forms)
(define-literal-set literals (%racket))
(syntax-parse forms #:literal-sets (literals)
@ -16,3 +17,12 @@
[x #'x]
[() forms]))
(define (strip-stops code)
(define-syntax-class stopper #:literal-sets (cruft)
#;
[pattern semicolon]
[pattern honu-comma]
[pattern colon])
(syntax-parse code
[(x:stopper rest ...) (strip-stops #'(rest ...))]
[else code]))

View File

@ -113,6 +113,7 @@
[() (reverse out)])))
;; removes syntax that causes expression parsing to stop
#;
(define (strip-stops code)
(define-syntax-class stopper #:literal-sets (cruft)
#;
@ -152,6 +153,16 @@
(debug 2 "Comma? ~a ~a\n" what is)
is)
#;
(define-syntax (parse-more stx)
(syntax-parse stx
[(_ stuff ...)
(define-values (parsed unparsed)
(parse (strip-stops #'(stuff ...))))
(with-syntax ([(parsed-out ...) (honu->racket parsed)]
[(unparsed-out ...) unparsed])
#'(begin parsed-out ... (parse-stuff unparsed-out ...)))]))
(provide honu-function)
(define-splicing-syntax-class honu-function #:literal-sets (cruft)
[pattern (~seq function:identifier (#%parens args ...) (#%braces code ...))
@ -159,6 +170,23 @@
(with-syntax ([(parsed-arguments ...)
(parse-arguments #'(args ...))])
#'(define (function parsed-arguments ...)
(define-syntax (parse-more stx)
(syntax-parse stx
[(_ stuff (... ...))
(define-values (parsed unparsed)
(parse (strip-stops #'(stuff (... ...)))))
(debug "Parse more: ~a unparsed ~a\n" parsed unparsed)
(define output (if parsed
(honu->racket parsed)
#'(begin)))
(debug "Output ~a\n" output)
(with-syntax ([output output]
[(unparsed-out (... ...)) unparsed])
(if (null? (syntax->datum #'(unparsed-out (... ...))))
#'output
#'(begin output (parse-more unparsed-out (... ...)))))]))
(parse-more code ...)
#;
(let-syntax ([parse-more (lambda (stx)
;; this adds an extra mark, you might not
;; want that

View File

@ -1,11 +1,6 @@
#lang honu
/*
provide function;
macro function ()
{ _ name:identifier (args:identifier ...) { body ... } }
{ #sx scheme:syntax #sx(define (name_result args_result ...)
(honu-unparsed-begin body ...)) }
{ _ (args:identifier ...) { body ... }}
{ #sx scheme:syntax #sx(lambda (args_result ...) (honu-unparsed-begin body ...)) }
*/
foo(){
1 + 2
}