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

implement syntax-rules in honu using syntax/parse for now

Browse Source 
svn: r16332
This commit is contained in:
Jon Rafkind 2009-10-15 23:37:20 +00:00
parent 8bd7de80e3
commit 5daa334ab7
1 changed files with 225 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
collects/honu/main.ss
View File

@ -7,6 +7,8 @@
syntax/define
syntax/context
syntax/name
syntax/parse
scheme/pretty
"private/ops.ss"
"private/util.ss"
"private/contexts.ss"
@ -1907,6 +1909,64 @@
(h-return expr))
(stx-cdr after-expr))))))
(define-for-syntax (extract-conventions pattern)
(let loop ([out '()]
[in pattern])
(syntax-case in (:)
[(any : attribute rest ...)
(loop (cons #'(any expr) out)
#'(rest ...))
#;
(loop (cons #'(any attribute) out)
#'(rest ...))]
[(foo rest1 rest ...)
(loop out #'(rest1 rest ...))]
[(foo) out])))
(define-for-syntax (extract-patterns pattern)
(let loop ([out '()]
[in pattern])
(syntax-case in (:)
[(any : attribute rest ...)
(loop (cons #'any out)
#'(rest ...))]
[(foo rest1 rest ...)
(loop (cons #'foo out)
#'(rest1 rest ...))]
[(foo) (reverse (cons #'foo out))])))
(define-honu-syntax honu-macro
(lambda (stx ctx)
(syntax-case stx (#%braces)
[(_ (#%parens honu-literal ...)
(#%braces (#%braces name pattern ...))
(#%braces (#%braces template ...))
. rest)
(with-syntax ([(conventions ...)
(extract-conventions #'(pattern ...))]
[(raw-patterns ...)
(extract-patterns #'(pattern ...))])
(values
#'(begin
(define honu-literal (lambda () (error 'honu-literal "you suck")))
...
(define-honu-syntax name
(lambda (stx ctx)
(define-conventions honu-conventions conventions ...)
#;
(printf "Hello from ~a transformer. Syntax is ~a\n" 'name (syntax->datum stx))
(syntax-parse stx
#:literals (honu-literal ...)
#:conventions (honu-conventions)
[(name raw-patterns ... . rrest)
(values
#'(honu-unparsed-block
#f obj 'obj #f ctx
template ...)
#'rrest)]))))
#'rest))])
))
(define-honu-syntax honu-if
(lambda (stx ctx)
(define (get-block-or-statement kw rest)
@ -2042,8 +2102,10 @@
(define-syntax (#%dynamic-honu-module-begin stx)
;; (printf "honu raw sexp ~a\n" (syntax->datum stx))
#`(#%plain-module-begin
(honu-unparsed-begin #,@(stx-cdr stx))))
(let ([result #`(#%plain-module-begin
(honu-unparsed-begin #,@(stx-cdr stx)))])
;; (pretty-print (syntax->datum (expand result)))
result))
(define-syntax (\; stx) (raise-syntax-error '\; "out of context" stx))
@ -2095,6 +2157,7 @@
(rename-out (set! =)
(honu-return return)
(honu-if if)
(honu-macro macro)
(honu-time time)
(honu-class class)
(honu+ +)