[honu] don't stop parsing the current expression after invoking a macro.

add a file to help test honu.
This commit is contained in:
Jon Rafkind 2011-08-18 16:35:27 -06:00
parent dc1a97cec7
commit 60aabdc8c5
9 changed files with 102 additions and 13 deletions

View File

@ -19,6 +19,7 @@
[honu-^ ^] [honu-^ ^]
[honu-> >] [honu-< <] [honu-> >] [honu-< <]
[honu->= >=] [honu-<= <=] [honu->= >=] [honu-<= <=]
[honu-= =]
[honu-flow \|] [honu-flow \|]
[honu-dot |.|] [honu-dot |.|]
[honu-cons ::] [honu-cons ::]
@ -28,7 +29,6 @@
[honu-structure structure] [honu-structure structure]
[honu-structure struct] [honu-structure struct]
[literal:colon :] [literal:colon :]
[literal:honu-= =]
[literal:semicolon |;|] [literal:semicolon |;|]
[literal:honu-comma |,|] [literal:honu-comma |,|]
[literal:#%brackets #%brackets] [literal:#%brackets #%brackets]

View File

@ -456,7 +456,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
[(_) #'(void)] [(_) #'(void)]
[(_ forms ...) [(_ forms ...)
(define expanded (honu-expand #'(forms ...))) (define expanded (honu-expand #'(forms ...)))
(debug "expanded ~a\n" expanded) (debug "expanded ~a\n" (syntax->datum expanded))
expanded])) expanded]))
(define-syntax (#%dynamic-honu-module-begin stx) (define-syntax (#%dynamic-honu-module-begin stx)

View File

@ -31,6 +31,7 @@
(define-honu-syntax honu-var (define-honu-syntax honu-var
(lambda (code context) (lambda (code context)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
#:literals (honu-=)
[(_ name:id honu-= . rest) [(_ name:id honu-= . rest)
;; parse one expression ;; parse one expression
(define-values (parsed unparsed) (define-values (parsed unparsed)
@ -46,6 +47,7 @@
(define-honu-syntax honu-for (define-honu-syntax honu-for
(lambda (code context) (lambda (code context)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
#:literals (honu-=)
[(_ iterator:id honu-= start:honu-expression honu-to end:honu-expression [(_ iterator:id honu-= start:honu-expression honu-to end:honu-expression
honu-do body:honu-expression . rest) honu-do body:honu-expression . rest)
(values (values
@ -131,6 +133,7 @@
(define-binary-operator honu-<= 0.9 'left <=) (define-binary-operator honu-<= 0.9 'left <=)
(define-binary-operator honu-> 0.9 'left >) (define-binary-operator honu-> 0.9 'left >)
(define-binary-operator honu->= 0.9 'left >=) (define-binary-operator honu->= 0.9 'left >=)
(define-binary-operator honu-= 0.9 'left =)
(define-binary-operator honu-and 0.5 'left and) (define-binary-operator honu-and 0.5 'left and)
(define-binary-operator honu-or 0.5 'left or) (define-binary-operator honu-or 0.5 'left or)
(define-binary-operator honu-cons 0.1 'right cons) (define-binary-operator honu-cons 0.1 'right cons)

View File

@ -26,4 +26,4 @@
honu-for-syntax honu-for-syntax
honu-for-template) honu-for-template)
(define-literal-set cruft (#%parens #%brackets #%braces semicolon colon honu-= honu-comma)) (define-literal-set cruft (#%parens #%brackets #%braces semicolon colon honu-comma))

View File

@ -177,11 +177,10 @@
(values (left #'parsed) (values (left #'parsed)
#'rest) #'rest)
(do-parse #'rest precedence (do-parse #'rest precedence
(lambda (x) x) left
;; (lambda (x) x)
#'parsed
#; #;
(lambda (x)
(with-syntax ([x x])
#'(begin parsed x)))
(left #'parsed))) (left #'parsed)))
#; #;
#'(splicing-let-syntax ([more-parsing (lambda (stx) #'(splicing-let-syntax ([more-parsing (lambda (stx)
@ -199,7 +198,7 @@
(case association (case association
[(left) >] [(left) >]
[(right) >=])) [(right) >=]))
(debug "new precedence ~a\n" new-precedence) (debug "precedence old ~a new ~a higher? ~a\n" precedence new-precedence (higher new-precedence precedence))
(if (higher new-precedence precedence) (if (higher new-precedence precedence)
(do-parse #'(rest ...) new-precedence (do-parse #'(rest ...) new-precedence
(lambda (stuff) (lambda (stuff)

View File

@ -0,0 +1,85 @@
#lang at-exp racket
(define (write-to-file input)
(define file (make-temporary-file))
(with-output-to-file file
#:mode 'text
#:exists 'truncate
(lambda () (printf input)))
file)
(define (execute-racket file)
(match-define [list output input id error-port status]
(process (format "racket ~a" file)))
(status 'wait)
(when (not (= 0 (status 'exit-code)))
(printf "Error: ~a\n" (read-string 1024 error-port))
(error 'run "couldn't run racket. error code ~a" (status 'exit-code)))
(define result (read-string 4096 output))
(close-input-port output)
(close-input-port error-port)
(close-output-port input)
(delete-file file)
result)
(define (run-honu input)
(define file (write-to-file input))
(with-handlers ([exn? (lambda (e)
(when (file-exists? file)
(delete-file file))
(raise e))])
(execute-racket file)))
(define (same? actual expected)
;; (printf "Expected \n'~a'\n\ngot \n'~a'\n\n" expected actual)
(string=? actual expected))
(define (output . stuff)
;; (printf "output '~a'\n" stuff)
(apply string-append "" (append stuff (list "\n"))))
(define (test input output)
(same? (run-honu input) output))
(define (input . stuff)
(apply string-append "#lang honu\n" stuff))
(test
@input{
5
6
}
@output{5
6
})
(test
@input{
1 + 1
}
@output{2
})
(test
@input{
foo(x){
x * 2
}
foo(5);
}
@output{10
})
(test
@input{
var n = 5;
cond
n < 10: 'x1,
n > 10: 'x2;
}
@output{'x1
})

View File

@ -24,7 +24,7 @@
(define-lex-abbrev digit (:/ #\0 #\9)) (define-lex-abbrev digit (:/ #\0 #\9))
(define-lex-abbrev identifier-first-character (:or (:/ #\a #\z) (define-lex-abbrev identifier-first-character (:or (:/ #\a #\z)
(:/ #\A #\Z) (:/ #\A #\Z)
":" "_")) "_" "?"))
(define-lex-abbrev identifier-character (:or identifier-first-character (define-lex-abbrev identifier-character (:or identifier-first-character
digit)) digit))
(define-lex-abbrev identifier (:: identifier-first-character (define-lex-abbrev identifier (:: identifier-first-character
@ -34,7 +34,7 @@
(:~ #\"))) (:~ #\")))
(define-lex-abbrev string (:: #\" (:* string-character) #\")) (define-lex-abbrev string (:: #\" (:* string-character) #\"))
(define-lex-abbrev operator (:or "+" "=" "*" "/" "-" "^" "||" "|" "&&" "<=" (define-lex-abbrev operator (:or "+" "=" "*" "/" "-" "^" "||" "|" "&&" "<="
">=" "<" ">" "!")) ">=" "<" ">" "!" "::"))
(define-lex-abbrev block-comment (:: "/*" (define-lex-abbrev block-comment (:: "/*"
(complement (:: any-string "*/" any-string)) (complement (:: any-string "*/" any-string))
"*/")) "*/"))
@ -67,7 +67,7 @@
["/*" (token-block-comment)] ["/*" (token-block-comment)]
["." (token-identifier '|.|)] ["." (token-identifier '|.|)]
["," (token-identifier '|,|)] ["," (token-identifier '|,|)]
["!" (token-identifier '!)] [":" (token-identifier ':)]
["'" (token-identifier 'quote)] ["'" (token-identifier 'quote)]
["`" (token-identifier 'quasiquote)] ["`" (token-identifier 'quasiquote)]
;; ["=" (token-identifier '=)] ;; ["=" (token-identifier '=)]

View File

@ -17,5 +17,7 @@
;;"private/common.honu" ;;"private/common.honu"
) )
(provide sqr sqrt sin max (provide sqr sqrt sin max else
number? symbol?
null
(rename-out [honu-cond cond])) (rename-out [honu-cond cond]))

View File

@ -19,4 +19,4 @@
#'(cond #'(cond
[clause.result body.result] ...) [clause.result body.result] ...)
#'rest #'rest
#f)]))) #t)])))