diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index f699b2167d..686b7f25af 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -19,6 +19,7 @@ syntax/parse) ;; phase 1 (require-syntax racket/base + "compile.rkt" "debug.rkt") ;; phase -1 @@ -145,6 +146,8 @@ (provide do-parse-rest) (define (do-parse-rest stx parse-more) (syntax-parse stx #:literal-sets (cruft) + + #; [(semicolon semicolon ... rest ...) (do-parse-rest #'(rest ...) parse-more)] [(stuff ...) @@ -152,11 +155,7 @@ (define-values (parsed unparsed) (parse (strip-stops #'(stuff ...)))) (debug "Parse more: ~a unparsed ~a\n" parsed unparsed) - (define output (if parsed - parsed - #; - (honu->racket parsed) - #'(void))) + (define output (if parsed parsed #'(void))) (debug "Output ~a unparsed ~a\n" (syntax->datum output) (syntax->datum unparsed)) @@ -212,6 +211,14 @@ (do-parse-rest #'(stuff ...) #'do-parse-rest-macro)])) |# +(define-syntax-rule (parse-delayed code ...) + (let () + (define-syntax (parse-more stx) + (syntax-case stx () + [(_ stuff (... ...)) + (racket-syntax (do-parse-rest #'(stuff (... ...)) #'parse-more))])) + (parse-more code ...))) + (provide honu-body) (define-syntax-class honu-body #:literal-sets (cruft) @@ -347,40 +354,26 @@ (debug "parse ~a precedence ~a left ~a current ~a properties ~a\n" (syntax->datum stream) precedence left current (syntax-property-symbol-keys stream)) - (define final (if current current #'(void))) + (define final (if current current (racket-syntax (void)))) (if (parsed-syntax? stream) (values (left stream) #'()) (syntax-parse stream #:literal-sets (cruft) #; [x:id (values #'x #'())] + [((semicolon inner ...) rest ...) + ;; nothing on the left side should interact with a semicolon + (if current + (values (left current) + stream) + (begin + (with-syntax ( + #; + [inner* (parse-all #'(inner ...))]) + (values (left (parse-delayed inner ...)) + #'(rest ...)))))] [() (debug "Empty input out: left ~a ~a\n" left (left final)) (values (left final) #'())] - ;; dont reparse pure racket code - [(%racket racket) - (debug "Native racket expression ~a\n" #'racket) - (if current - (values (left current) stream) - (values (left #'racket) #'())) - #; - (if current - (values (left current) stream) - (values (left #'racket) #'(rest ...)))] - ;; for expressions that can keep parsing - #; - [((%racket-expression racket) rest ...) - (if current - (values (left current) stream) - (do-parse #'(rest ...) - precedence left - #'racket))] - #; - [(%racket-expression racket rest ...) - (if current - (values (left current) stream) - (do-parse #'(rest ...) - precedence left - #'racket))] [(head rest ...) (debug 2 "Not a special expression..\n") (cond @@ -486,12 +479,6 @@ (debug "Parse a single thing ~a\n" (syntax->datum #'head)) (syntax-parse #'head #:literal-sets (cruft) - #; - [(%racket x) - (debug 2 "Native racket expression ~a\n" #'x) - (if current - (values (left current) stream) - (do-parse #'(rest ...) precedence left #'head))] [x:atom (debug 2 "atom ~a current ~a\n" #'x current) (if current @@ -582,9 +569,9 @@ (error 'parse "function call")] #; [else (if (not current) - (error 'what "dont know how to parse ~a" #'head) + (error 'what "don't know how to parse ~a" #'head) (values (left current) stream))] - [else (error 'what "dont know how to parse ~a" #'head)])])])]))) + [else (error 'what "don't know how to parse ~a" #'head)])])])]))) (define-values (parsed unparsed) (do-parse input 0 (lambda (x) x) #f)) diff --git a/collects/honu/core/read.rkt b/collects/honu/core/read.rkt index 596fd61779..1b9eafbe89 100644 --- a/collects/honu/core/read.rkt +++ b/collects/honu/core/read.rkt @@ -334,7 +334,7 @@ ;; ((%semicolon 3 + 4) (%semicolon 1 + 2)) ;; ;; The entire list will be reversed at the end of parsing. - (define (do-semicolon2 current tokens table) + (define (do-semicolon current tokens table) ;; (debug "Do semicolon on ~a\n" current) (define-values (wrap ok) (let loop ([found '()] @@ -356,7 +356,7 @@ (cdr tokens) table)) - (define (do-semicolon current tokens table) + (define (do-semicolon2 current tokens table) (do-parse (cons (make-syntax '%semicolon (car tokens) source) current) (cdr tokens) table)) diff --git a/collects/tests/honu/test.honu b/collects/tests/honu/test.honu index be5e436daa..5df481f9cd 100644 --- a/collects/tests/honu/test.honu +++ b/collects/tests/honu/test.honu @@ -15,7 +15,7 @@ function test(t, a, b){ } */ -test1(){ +function test1(){ var x = 3; /* const y = 2; @@ -27,12 +27,12 @@ test1(){ // print(x ^ 2) } -val test2(val x, val y){ +function test2(x, y){ printf("~a\n", x); printf("~a\n", y); } -val test3(val what){ +function test3(what){ printf("~a and true = ~a\n", what, what and true); printf("~a and false = ~a\n", what, what and false); }