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

[honu] return a void expression if there is no current expression waiting to be processed

Browse Source
This commit is contained in:
Jon Rafkind 2011-08-09 14:28:47 -06:00
parent 376a673a0c
commit 4538335b1c
5 changed files with 71 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/honu/core/main.rkt
View File

@ -6,17 +6,17 @@
(provide #%top
#%datum
print printf
print printf true false
(rename-out [#%dynamic-honu-module-begin #%module-begin]
[honu-function function]
[honu-var var]
[honu-val val]
[honu-for for]
[honu-+ +]
[honu-- -]
[honu-* *]
[honu-/ /]
[honu-+ +] [honu-- -]
[honu-* *] [honu-/ /]
[honu-^ ^]
[honu-and and]
[honu-or or]
[literal:honu-= =]
[literal:semicolon |;|]
[literal:honu-comma |,|]

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

@ -70,20 +70,10 @@
[right right])
#'(operator left right))))))
(provide honu-+)
(define-honu-operator/syntax honu-+ 1
(lambda (left right)
(with-syntax ([left left]
[right right])
#'(+ left right))))
(provide honu--)
(define-honu-operator/syntax honu-- 1
(lambda (left right)
(with-syntax ([left left]
[right right])
#'(- left right))))
(define-binary-operator honu-+ 1 +)
(define-binary-operator honu-- 1 -)
(define-binary-operator honu-* 2 *)
(define-binary-operator honu-/ 2 /)
(define-binary-operator honu-^ 2 expt)
(define-binary-operator honu-and 0.5 and)
(define-binary-operator honu-or 0.5 or)

3
collects/honu/core/private/issues Normal file
View File

@ -0,0 +1,3 @@
for x = 1 to 10 do Expression

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

@ -141,8 +141,10 @@
[pattern x:number])
(debug "parse ~a precedence ~a left ~a current ~a\n" stream precedence left current)
(define final (if current current #'(void)))
(syntax-parse stream #:literal-sets (cruft)
[() (values (left current) #'())]
[()
(values (left final) #'())]
[(head rest ...)
(cond
[(honu-macro? #'head)
@ -186,13 +188,13 @@
(do-parse #'(head rest ...)
0
(lambda (x) x)
(left current)))]
(left final)))]
[(comma? #'head)
(values (left current)
(values (left final)
#'(rest ...))]
[(semicolon? #'head)
(values (left current)
#'(rest ...))
[(semicolon? #'head)
(values (left final)
#'(rest ...))
#;
(do-parse #'(rest ...) 0
(lambda (stuff)
@ -205,49 +207,49 @@
#'(splicing-let-syntax ([more (lambda (stx)
(parse #'(rest ...)))])
so-far (more)))]
[else
(syntax-parse #'(head rest ...) #:literal-sets (cruft)
[(function:identifier (#%parens args ...) (#%braces code ...) . rest)
(values (with-syntax ([(parsed-arguments ...)
(parse-arguments #'(args ...))])
#'(define (function parsed-arguments ...)
(let-syntax ([parse-more (lambda (stx)
(parse-all #'(code ...)))])
(parse-more))))
#'rest)]
[else (syntax-parse #'head
#:literal-sets (cruft)
[x:atom
(debug "atom ~a current ~a\n" #'x current)
(if current
(values (left current) stream)
(do-parse #'(rest ...) precedence left #'x))]
[(#%braces stuff ...)
(if current
(values (left current) stream)
(let ()
(define body (parse-all #'(stuff ...)))
(do-parse #'(rest ...) precedence left body)))]
[(#%parens args ...)
(debug "function call ~a\n" left)
(values (left (with-syntax ([current current]
[(parsed-args ...)
(parse-call-arguments #'(args ...)) ])
#'(current parsed-args ...)))
#'(rest ...))
#;
(do-parse #'(rest ...)
0
(lambda (x) x)
(left (with-syntax ([current current]
[(parsed-args ...)
(if (null? (syntax->list #'(args ...)))
'()
(list (parse #'(args ...))))])
#'(current parsed-args ...))))
#;
(error 'parse "function call")]
[else (error 'what "dont know how to parse ~a" #'head)])])])]))
[else
(syntax-parse #'(head rest ...) #:literal-sets (cruft)
[(function:identifier (#%parens args ...) (#%braces code ...) . rest)
(values (with-syntax ([(parsed-arguments ...)
(parse-arguments #'(args ...))])
#'(define (function parsed-arguments ...)
(let-syntax ([parse-more (lambda (stx)
(parse-all #'(code ...)))])
(parse-more))))
#'rest)]
[else (syntax-parse #'head
#:literal-sets (cruft)
[x:atom
(debug "atom ~a current ~a\n" #'x current)
(if current
(values (left current) stream)
(do-parse #'(rest ...) precedence left #'x))]
[(#%braces stuff ...)
(if current
(values (left current) stream)
(let ()
(define body (parse-all #'(stuff ...)))
(do-parse #'(rest ...) precedence left body)))]
[(#%parens args ...)
(debug "function call ~a\n" left)
(values (left (with-syntax ([current current]
[(parsed-args ...)
(parse-call-arguments #'(args ...)) ])
#'(current parsed-args ...)))
#'(rest ...))
#;
(do-parse #'(rest ...)
0
(lambda (x) x)
(left (with-syntax ([current current]
[(parsed-args ...)
(if (null? (syntax->list #'(args ...)))
'()
(list (parse #'(args ...))))])
#'(current parsed-args ...))))
#;
(error 'parse "function call")]
[else (error 'what "dont know how to parse ~a" #'head)])])])]))
(do-parse input 0 (lambda (x) x) #f))

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

@ -28,11 +28,17 @@ test1(){
}
val test2(val x, val y){
print(x);
print(y)
printf("~a\n", x);
printf("~a\n", y);
}
val test3(val what){
printf("~a and true = ~a\n", what, what and true);
printf("~a and false = ~a\n", what, what and false);
}
test1();
test2(5, 9);
test3(true);
// function(z){ print(z) }(12)