add optional val before functions and arguments

This commit is contained in:
Jon Rafkind 2011-07-20 19:00:49 -06:00
parent 292512221e
commit 1b914ead61
5 changed files with 49 additions and 17 deletions

View File

@ -10,6 +10,7 @@
(rename-out [#%dynamic-honu-module-begin #%module-begin]
[honu-function function]
[honu-var var]
[honu-val val]
[honu-+ +]
[honu-- -]
[honu-* *]

View File

@ -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)

View File

@ -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)

View File

@ -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)

View File

@ -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)