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

[honu] convert function bodies from honu to racket

Browse Source
This commit is contained in:
Jon Rafkind 2011-11-11 10:34:50 -07:00
parent a4123ce536
commit dfe33f8919
5 changed files with 27 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/honu/core/private/class.rkt
View File

@ -34,7 +34,7 @@
(lambda (code context)
(syntax-parse code #:literal-sets (cruft)
[(_ name (#%parens arg:honu-expression ...) . rest)
(define new #'(make-object name arg.result ...))
(define new #'(%racket (make-object name arg.result ...)))
(values
new
#'rest

18
collects/honu/core/private/compile.rkt Normal file
View File

@ -0,0 +1,18 @@
#lang racket/base
(require syntax/parse
"literals.rkt"
(for-template racket/base))
(provide honu->racket)
(define (honu->racket forms)
(define-literal-set literals (%racket))
;; (debug "honu to racket ~a\n" (pretty-format (syntax->datum forms)))
(syntax-parse forms #:literal-sets (literals)
[(%racket x) (honu->racket #'x)]
[(form ...)
(with-syntax ([(form* ...) (map honu->racket (syntax->list #'(form ...)))])
#'(form* ...))]
[x #'x]
[() forms]))

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

@ -10,6 +10,7 @@
scheme/splicing
macro-debugger/emit
racket/pretty
"compile.rkt"
"debug.rkt"
"contexts.rkt"
"util.rkt"
@ -457,17 +458,6 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(define-for-syntax (honu-compile forms)
#'(void))
(define-for-syntax (honu->racket forms)
(define-literal-set literals (%racket))
;; (debug "honu to racket ~a\n" (pretty-format (syntax->datum forms)))
(syntax-parse forms #:literal-sets (literals)
[(%racket x) (honu->racket #'x)]
[(form ...)
(with-syntax ([(form* ...) (map honu->racket (syntax->list #'(form ...)))])
#'(form* ...))]
[x #'x]
[() forms]))
(provide honu-unparsed-begin)
(define-syntax (honu-unparsed-begin stx)
(emit-remark "Honu unparsed begin!" stx)

1
collects/honu/core/private/macro2.rkt
View File

@ -36,6 +36,7 @@
(define-splicing-syntax-class pattern-type
#:literal-sets (cruft)
[pattern (~seq name colon class)
;; we know the output of syntactic classes will end with _result
#:with result (with-syntax ([name.result (format-id #'name "~a_result" #'name)])
#'(name name.result))]
[pattern x #:with result #f])

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

@ -7,6 +7,7 @@
(require ;; "macro2.rkt"
"literals.rkt"
"debug.rkt"
"compile.rkt"
(prefix-in transformer: "transformer.rkt")
racket/pretty
syntax/stx
@ -147,7 +148,7 @@
(parse-arguments #'(args ...))])
#'(define (function parsed-arguments ...)
(let-syntax ([parse-more (lambda (stx)
(parse-all #'(code ...)))])
(honu->racket (parse-all #'(code ...))))])
(parse-more))))])
;; E = macro
@ -322,13 +323,9 @@
(syntax-parse #'(stuff ...) #:literal-sets (cruft)
[(work:honu-expression colon (~seq variable:id honu-<- list:honu-expression (~optional honu-comma)) ...)
(define comprehension
(with-syntax ([(list-parsed ...) (map (lambda (list)
(parse-all list))
(syntax->list #'(list.result ...)))]
[work-parsed (parse-all #'work.result)])
#'(for/list ([variable list-parsed]
#'(for/list ([variable list.result]
...)
work-parsed)))
work.result))
(if current
(error 'parse "a list comprehension cannot follow an expression")
(do-parse #'(rest ...) precedence left comprehension))]
@ -409,7 +406,8 @@
[code code])
(define-values (parsed unparsed)
(parse (strip-stops code)))
(debug "Parsed ~a unparsed ~a\n" (if parsed (syntax->datum parsed) parsed)
(debug "Parsed ~a unparsed ~a\n"
(if parsed (syntax->datum parsed) parsed)
(if unparsed (syntax->datum unparsed) unparsed))
(if (empty-syntax? unparsed)
(with-syntax ([(use ...) (reverse (if parsed