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

use #%module-begin for honu modules so top level expressions get printed

Browse Source 
macros return whether they terminate parsing
This commit is contained in:
Jon Rafkind 2011-07-19 10:59:33 -06:00
parent 255549c8c8
commit a7768a13a3
8 changed files with 119 additions and 20 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-^ ^]
[literal:honu-= =]
[literal:semicolon |;|]
[literal:honu-comma |,|]
[literal:#%braces #%braces]
[literal:#%parens #%parens])
)

36
collects/honu/core/private/honu-plan Normal file
View File

@ -0,0 +1,36 @@
honu forms -> expanded, parsed into racket code
to expand honu forms we have to parse the code again
1. start with raw honu code
2. wrap it with (honu-unparsed-begin ...)
3. run macro processor, eventually spit out s-expressions
honu macros will only produce honu syntax, but primitive
forms can produce s-expressions
so what should parsing 'expression' as a syntax class produce?
eventually 1 + 1 should be converted into (+ 1 1) but what should be the
representation of this as an expression within a macro?
x:expression
maybe just the unparsed form
x == 1 + 1
with possibly some accessors to tell stuff about the expression
so if a macro appears when an expression wants to parse then the macro
will be parsed and the result will be passed along
foo x:expression
foo some_macro 1 + 1
where some_macro is
some_macro x:expression => "ok"
then foo will get
x => "ok"
as opposed to
x => some_macro 1 + 1
when should honu syntax be converted to racket?
at the top level. if we know what context we are expanding then we can compile
top-level things
Parsing:
macro invocation starts parsing process. parse one expression, get back a top level form and unparsed syntax. the top level form has to be local-expanded to eventually produce some low-level racket syntax (like define).
(honu-parse stuff ...)
(define-syntax (honu-parse stx) ...)
Should call parse on stx and return

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

@ -443,7 +443,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
#'rest)])))
(define-for-syntax (honu-expand forms)
(parse forms))
(parse-all forms))
(define-for-syntax (honu-compile forms)
#'(void))
@ -452,10 +452,15 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(honu:define-honu-syntax honu-var
(lambda (code context)
(syntax-parse code #:literal-sets (cruft)
[(_ name:id honu-= anything . rest)
[(_ name:id honu-= . rest)
(define-values (parsed unparsed)
(parse #'rest))
(values
#'(define name anything)
#'rest)])))
(with-syntax ([parsed parsed])
#'(define name parsed))
(with-syntax ([unparsed unparsed])
#'unparsed)
#t)])))
(define-syntax (honu-unparsed-begin stx)
(emit-remark "Honu unparsed begin!" stx)
@ -469,4 +474,4 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
[(_ forms ...)
(begin
(debug "Module begin ~a\n" (syntax->datum #'(forms ...)))
#'(#%plain-module-begin (honu-unparsed-begin forms ...)))]))
#'(#%module-begin (honu-unparsed-begin forms ...)))]))

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

@ -2,6 +2,8 @@
(require "macro2.rkt"
"operator.rkt"
(only-in "literals.rkt"
semicolon)
(for-syntax syntax/parse
"literals.rkt"
"parse2.rkt"
@ -18,9 +20,10 @@
(values
#'(define (name arg ...)
(let-syntax ([do-parse (lambda (stx)
(parse #'(code ...)))])
(parse-all #'(code ...)))])
(do-parse)))
#'rest)])))
#'rest
#t)])))
(define-syntax-rule (define-binary-operator name precedence operator)
(begin

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

@ -37,7 +37,7 @@
(syntax-parse stx
[(_ syntax-parse-pattern . more)
(values #'(let-syntax ([do-parse (lambda (stx)
(parse stx))])
(parse-all stx))])
(do-parse action ...))
#'more)]))))
#'rest)])))

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

@ -17,7 +17,7 @@
(require (for-template racket/base
racket/splicing))
(provide parse)
(provide parse parse-all)
#;
(define-literal-set literals
@ -65,8 +65,10 @@
(define (semicolon? what)
(define-literal-set check (semicolon))
(and (identifier? what)
((literal-set->predicate check) what)))
(define is (and (identifier? what)
((literal-set->predicate check) what)))
(debug "Semicolon? ~a ~a\n" what is)
is)
;; 1 + 1
;; ^
@ -91,24 +93,32 @@
;; left: (lambda (x) (left (* 1 x)))
;; current: 2
;; parse one form
;; return the parsed stuff and the unparsed stuff
(define (parse input)
(define (do-parse stream precedence left current)
(debug "parse ~a precedence ~a left ~a current ~a\n" stream precedence left current)
(syntax-parse stream
[() (left current)]
[() (values (left current) #'())]
[(head rest ...)
(cond
[(honu-macro? #'head)
(begin
(debug "Honu macro ~a\n" #'head)
(let-values ([(parsed unparsed)
(let-values ([(parsed unparsed terminate?)
((syntax-local-value #'head) #'(head rest ...) #f)])
(with-syntax ([parsed parsed]
[rest unparsed])
(do-parse #'rest precedence (lambda (x)
(with-syntax ([x x])
#'(begin parsed x)))
(left current))
(if terminate?
(values (left #'parsed)
#'rest)
(do-parse #'rest precedence
(lambda (x) x)
#;
(lambda (x)
(with-syntax ([x x])
#'(begin parsed x)))
(left #'parsed)))
#;
#'(splicing-let-syntax ([more-parsing (lambda (stx)
(do-parse (stx-cdr stx)
@ -135,6 +145,9 @@
(lambda (x) x)
(left current)))]
[(semicolon? #'head)
(values (left current)
#'(rest ...))
#;
(do-parse #'(rest ...) 0
(lambda (stuff)
(with-syntax ([stuff stuff]
@ -151,9 +164,18 @@
[else (syntax-parse #'head
#:literal-sets (cruft)
[x:number (do-parse #'(rest ...)
precedence left #'x)]
precedence
left #'x)]
[(#%parens args ...)
(debug "function call ~a\n" left)
(values (left (with-syntax ([current current]
[(parsed-args ...)
(if (null? (syntax->list #'(args ...)))
'()
(list (parse-all #'(args ...))))])
#'(current parsed-args ...)))
#'(rest ...))
#;
(do-parse #'(rest ...)
0
(lambda (x) x)
@ -171,6 +193,24 @@
(do-parse input 0 (lambda (x) x) #'(void)))
(define (empty-syntax? what)
(syntax-parse what
[() #t]
[else #f]))
(define (parse-all code)
(let loop ([all '()]
[code code])
(define-values (parsed unparsed)
(parse code))
(debug "Parsed ~a unparsed ~a\n" (syntax->datum parsed)
(syntax->datum unparsed))
(if (empty-syntax? unparsed)
(with-syntax ([(use ...) (reverse (cons parsed all))])
#'(begin use ...))
(loop (cons parsed all)
unparsed))))
(define (parse2 forms)
(debug "parse forms ~a\n" forms)
(when (stx-pair? forms)

7
collects/tests/honu/test.honu
View File

@ -26,4 +26,9 @@ function test1(){
print(x ^ 2)
}
test1()
function test2(x){
print(x)
}
test1();
test2(5);

11
collects/tests/honu/test.rkt
View File

@ -6,6 +6,7 @@
[honu-function honu_function]
[honu-+ honu_plus]
[honu-* honu_times]
[honu-/ honu_division]
[honu-- honu_minus])
(rename-in honu/core/private/literals
[honu-= =]
@ -24,7 +25,7 @@
(syntax-case stx ()
[(_ stuff)
(let ()
(define output (parse:parse (stx-cdr #'stuff)))
(define output (parse:parse-all (stx-cdr #'stuff)))
(printf "Output: ~a\n" (syntax->datum output))
output)]))
@ -36,9 +37,16 @@
}
foo 5))
#;
(fake-module-begin #hx(2))
(fake-module-begin #hx(1;2))
(fake-module-begin #hx(var x = 2;
print(x)))
#|
(let ()
(fake-module-begin #hx(honu_function test(x){
print(x)
@ -61,3 +69,4 @@
(let ()
(fake-module-begin #hx(1 honu_plus 1 honu_minus 4 honu_times 8)))
|#