From 60aabdc8c5305ea5a9e61c0c830db71cda7ec621 Mon Sep 17 00:00:00 2001 From: Jon Rafkind Date: Thu, 18 Aug 2011 16:35:27 -0600 Subject: [PATCH] [honu] don't stop parsing the current expression after invoking a macro. add a file to help test honu. --- collects/honu/core/main.rkt | 2 +- .../honu/core/private/honu-typed-scheme.rkt | 2 +- collects/honu/core/private/honu2.rkt | 3 + collects/honu/core/private/literals.rkt | 2 +- collects/honu/core/private/parse2.rkt | 9 +- collects/honu/core/private/test.rkt | 85 +++++++++++++++++++ collects/honu/core/read.rkt | 6 +- collects/honu/main.rkt | 4 +- collects/honu/private/common.rkt | 2 +- 9 files changed, 102 insertions(+), 13 deletions(-) create mode 100644 collects/honu/core/private/test.rkt diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index 36a13c9ab1..ca254836d8 100644 --- a/collects/honu/core/main.rkt +++ b/collects/honu/core/main.rkt @@ -19,6 +19,7 @@ [honu-^ ^] [honu-> >] [honu-< <] [honu->= >=] [honu-<= <=] + [honu-= =] [honu-flow \|] [honu-dot |.|] [honu-cons ::] @@ -28,7 +29,6 @@ [honu-structure structure] [honu-structure struct] [literal:colon :] - [literal:honu-= =] [literal:semicolon |;|] [literal:honu-comma |,|] [literal:#%brackets #%brackets] diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt index e229f81720..563b050e70 100644 --- a/collects/honu/core/private/honu-typed-scheme.rkt +++ b/collects/honu/core/private/honu-typed-scheme.rkt @@ -456,7 +456,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt [(_) #'(void)] [(_ forms ...) (define expanded (honu-expand #'(forms ...))) - (debug "expanded ~a\n" expanded) + (debug "expanded ~a\n" (syntax->datum expanded)) expanded])) (define-syntax (#%dynamic-honu-module-begin stx) diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index dcf94c5ef6..65c05c6981 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/collects/honu/core/private/honu2.rkt @@ -31,6 +31,7 @@ (define-honu-syntax honu-var (lambda (code context) (syntax-parse code #:literal-sets (cruft) + #:literals (honu-=) [(_ name:id honu-= . rest) ;; parse one expression (define-values (parsed unparsed) @@ -46,6 +47,7 @@ (define-honu-syntax honu-for (lambda (code context) (syntax-parse code #:literal-sets (cruft) + #:literals (honu-=) [(_ iterator:id honu-= start:honu-expression honu-to end:honu-expression honu-do body:honu-expression . rest) (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-and 0.5 'left and) (define-binary-operator honu-or 0.5 'left or) (define-binary-operator honu-cons 0.1 'right cons) diff --git a/collects/honu/core/private/literals.rkt b/collects/honu/core/private/literals.rkt index 4722fe5fdb..7ded90726c 100644 --- a/collects/honu/core/private/literals.rkt +++ b/collects/honu/core/private/literals.rkt @@ -26,4 +26,4 @@ honu-for-syntax 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)) diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index dffb794867..bafc04ce4a 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -177,11 +177,10 @@ (values (left #'parsed) #'rest) (do-parse #'rest precedence - (lambda (x) x) + left + ;; (lambda (x) x) + #'parsed #; - (lambda (x) - (with-syntax ([x x]) - #'(begin parsed x))) (left #'parsed))) #; #'(splicing-let-syntax ([more-parsing (lambda (stx) @@ -199,7 +198,7 @@ (case association [(left) >] [(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) (do-parse #'(rest ...) new-precedence (lambda (stuff) diff --git a/collects/honu/core/private/test.rkt b/collects/honu/core/private/test.rkt new file mode 100644 index 0000000000..6ae4433c02 --- /dev/null +++ b/collects/honu/core/private/test.rkt @@ -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 + }) diff --git a/collects/honu/core/read.rkt b/collects/honu/core/read.rkt index 378161642d..8b1056acd4 100644 --- a/collects/honu/core/read.rkt +++ b/collects/honu/core/read.rkt @@ -24,7 +24,7 @@ (define-lex-abbrev digit (:/ #\0 #\9)) (define-lex-abbrev identifier-first-character (:or (:/ #\a #\z) (:/ #\A #\Z) - ":" "_")) + "_" "?")) (define-lex-abbrev identifier-character (:or identifier-first-character digit)) (define-lex-abbrev identifier (:: identifier-first-character @@ -34,7 +34,7 @@ (:~ #\"))) (define-lex-abbrev string (:: #\" (:* string-character) #\")) (define-lex-abbrev operator (:or "+" "=" "*" "/" "-" "^" "||" "|" "&&" "<=" - ">=" "<" ">" "!")) + ">=" "<" ">" "!" "::")) (define-lex-abbrev block-comment (:: "/*" (complement (:: any-string "*/" any-string)) "*/")) @@ -67,7 +67,7 @@ ["/*" (token-block-comment)] ["." (token-identifier '|.|)] ["," (token-identifier '|,|)] - ["!" (token-identifier '!)] + [":" (token-identifier ':)] ["'" (token-identifier 'quote)] ["`" (token-identifier 'quasiquote)] ;; ["=" (token-identifier '=)] diff --git a/collects/honu/main.rkt b/collects/honu/main.rkt index ada6a6f934..ae7ba5fbd5 100644 --- a/collects/honu/main.rkt +++ b/collects/honu/main.rkt @@ -17,5 +17,7 @@ ;;"private/common.honu" ) -(provide sqr sqrt sin max +(provide sqr sqrt sin max else + number? symbol? + null (rename-out [honu-cond cond])) diff --git a/collects/honu/private/common.rkt b/collects/honu/private/common.rkt index 14908bcbbc..4227e31301 100644 --- a/collects/honu/private/common.rkt +++ b/collects/honu/private/common.rkt @@ -19,4 +19,4 @@ #'(cond [clause.result body.result] ...) #'rest - #f)]))) + #t)])))