diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index d0c3ea5a0f..cc004a47e2 100644 --- a/collects/honu/core/main.rkt +++ b/collects/honu/core/main.rkt @@ -17,6 +17,7 @@ [honu-^ ^] [literal:honu-= =] [literal:semicolon |;|] + [literal:honu-comma |,|] [literal:#%braces #%braces] [literal:#%parens #%parens]) ) diff --git a/collects/honu/core/private/honu-plan b/collects/honu/core/private/honu-plan new file mode 100644 index 0000000000..fac062c090 --- /dev/null +++ b/collects/honu/core/private/honu-plan @@ -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 diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt index a61b4d6c0e..2bef134970 100644 --- a/collects/honu/core/private/honu-typed-scheme.rkt +++ b/collects/honu/core/private/honu-typed-scheme.rkt @@ -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 ...)))])) diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index 501b6c1d54..349b05ce50 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/collects/honu/core/private/honu2.rkt @@ -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 diff --git a/collects/honu/core/private/macro2.rkt b/collects/honu/core/private/macro2.rkt index d65e4aeefe..72d3edf7c6 100644 --- a/collects/honu/core/private/macro2.rkt +++ b/collects/honu/core/private/macro2.rkt @@ -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)]))) diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index f0265822da..4a6a0738f3 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -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) diff --git a/collects/tests/honu/test.honu b/collects/tests/honu/test.honu index d7b729319d..fc402b5009 100644 --- a/collects/tests/honu/test.honu +++ b/collects/tests/honu/test.honu @@ -26,4 +26,9 @@ function test1(){ print(x ^ 2) } -test1() +function test2(x){ + print(x) +} + +test1(); +test2(5); diff --git a/collects/tests/honu/test.rkt b/collects/tests/honu/test.rkt index 3dc83ee0b8..0cbce73a9e 100644 --- a/collects/tests/honu/test.rkt +++ b/collects/tests/honu/test.rkt @@ -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))) +|#