diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index cc004a47e2..a51cfb6ae4 100644 --- a/collects/honu/core/main.rkt +++ b/collects/honu/core/main.rkt @@ -10,6 +10,7 @@ (rename-out [#%dynamic-honu-module-begin #%module-begin] [honu-function function] [honu-var var] + [honu-val val] [honu-+ +] [honu-- -] [honu-* *] diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt index 2bef134970..5ac7605041 100644 --- a/collects/honu/core/private/honu-typed-scheme.rkt +++ b/collects/honu/core/private/honu-typed-scheme.rkt @@ -448,19 +448,6 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt (define-for-syntax (honu-compile forms) #'(void)) -(provide honu-var) -(honu:define-honu-syntax honu-var - (lambda (code context) - (syntax-parse code #:literal-sets (cruft) - [(_ name:id honu-= . rest) - (define-values (parsed unparsed) - (parse #'rest)) - (values - (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) diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index ce2ffc600d..20f7016edf 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/collects/honu/core/private/honu2.rkt @@ -25,6 +25,30 @@ #'rest #f)]))) +(provide honu-var) +(define-honu-syntax honu-var + (lambda (code context) + (syntax-parse code #:literal-sets (cruft) + [(_ name:id honu-= . rest) + ;; parse one expression + (define-values (parsed unparsed) + (parse #'rest)) + (values + (with-syntax ([parsed parsed]) + #'(define name parsed)) + (with-syntax ([unparsed unparsed]) + #'unparsed) + #t)]))) + +(provide honu-val) +(define-honu-syntax honu-val + (lambda (code context) + (syntax-parse code + [(_ rest ...) + (define-values (parsed unparsed) + (parse #'(rest ...))) + (values parsed unparsed #t)]))) + (define-syntax-rule (define-binary-operator name precedence operator) (begin (provide name) diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index 9ff0bcd0a3..3feca0d076 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -70,6 +70,24 @@ (debug "Semicolon? ~a ~a\n" what is) is) +(define-literal-set argument-stuff [honu-comma]) + +(define (parse-arguments arguments) + (define-syntax-class val + [pattern x:identifier #:when (equal? 'val (syntax-e #'x))]) + (let loop ([out '()] + [arguments arguments]) + (syntax-parse arguments #:literal-sets (argument-stuff) + [(x:val name:identifier honu-comma more ...) + (loop (cons #'name out) #'(more ...))] + [(name:identifier honu-comma more ...) + (loop (cons #'name out) #'(more ...))] + [(x:val name:identifier) + (loop (cons #'name out) #'())] + [(name:identifier) + (loop (cons #'name out) #'())] + [() (reverse out)]))) + ;; 1 + 1 ;; ^ ;; left: identity @@ -162,10 +180,12 @@ [else (syntax-parse #'(head rest ...) [(function:identifier (#%parens args ...) (#%braces code ...) . rest) - (values #'(define (function args ...) + (values (with-syntax ([(parsed-arguments ...) + (parse-arguments #'(args ...))]) + #'(define (function parsed-arguments ...) (let-syntax ([parse-more (lambda (stx) (parse-all #'(code ...)))]) - (parse-more))) + (parse-more)))) #'rest)] [else (syntax-parse #'head #:literal-sets (cruft) diff --git a/collects/tests/honu/test.honu b/collects/tests/honu/test.honu index b4eda8b7bc..3c9c5c306f 100644 --- a/collects/tests/honu/test.honu +++ b/collects/tests/honu/test.honu @@ -26,11 +26,11 @@ test1(){ print(x ^ 2) } -test2(x){ +val test2(val x){ print(x) } // test1(); -// test2(5); +test2(5); function(z){ print(z) }(12)