From 918c87e96bdfc8a62f0953493fb4f82f51dbbaab Mon Sep 17 00:00:00 2001 From: Jon Rafkind Date: Thu, 15 Mar 2012 17:06:09 -0600 Subject: [PATCH] [honu] return the current expression when a semicolon is parsed --- collects/honu/core/main.rkt | 1 + .../honu/core/private/honu-typed-scheme.rkt | 1 + collects/honu/core/private/honu2.rkt | 8 +++-- collects/honu/core/private/macro2.rkt | 1 + collects/honu/core/private/parse2.rkt | 29 +++++++++++++++---- collects/honu/core/read.rkt | 9 +++++- collects/tests/honu/check.rkt | 2 +- collects/tests/honu/match.honu | 6 ++++ 8 files changed, 47 insertions(+), 10 deletions(-) diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index 2310ff29eb..e42b2d45da 100644 --- a/collects/honu/core/main.rkt +++ b/collects/honu/core/main.rkt @@ -19,6 +19,7 @@ [parse:honu-identifier identifier] [racket:else else] [racket:void void] + [parse:honu-number number] [honu-function function] [honu-function fun] [honu-var var] diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt index 8cc4522a1f..4c4e9db509 100644 --- a/collects/honu/core/private/honu-typed-scheme.rkt +++ b/collects/honu/core/private/honu-typed-scheme.rkt @@ -481,6 +481,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt (honu->racket parsed))] [(unparsed ...) unparsed]) (debug "Final parsed syntax\n~a\n" (pretty-format (syntax->datum #'parsed))) + (debug "Unparsed syntax ~a\n" #'(unparsed ...)) (if (null? (syntax->datum #'(unparsed ...))) (if (parsed-syntax? #'parsed) #'parsed diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index 61d821ef3c..f64e9b3f31 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/collects/honu/core/private/honu2.rkt @@ -229,10 +229,12 @@ (define-honu-syntax honu-provide (lambda (code context) (syntax-parse code #:literal-sets (cruft) - [(_ name:id ... (~optional semicolon) . rest) - (define out (racket-syntax (provide name ...))) + [(_ name:honu-identifier ... (~optional semicolon) . rest) + (debug "Provide matched names ~a\n" (syntax->datum #'(name.result ...))) + (define out (racket-syntax (provide name.result ...))) (debug "Provide properties ~a\n" (syntax-property-symbol-keys out)) - (values out #'() #'rest)]))) + (debug "Rest ~a\n" #'rest) + (values out #'rest #f)]))) (provide honu-with-input-from-file) (define-honu-syntax honu-with-input-from-file diff --git a/collects/honu/core/private/macro2.rkt b/collects/honu/core/private/macro2.rkt index b218df1653..536191051d 100644 --- a/collects/honu/core/private/macro2.rkt +++ b/collects/honu/core/private/macro2.rkt @@ -181,6 +181,7 @@ ;; instead of x_result. x_result is still there, too (with-syntax ([pattern-variable.name #'pattern-variable.result] ...) + (debug "~a = ~a\n" 'pattern-variable.name #'pattern-variable.name) ... (parse-stuff action ...)) #'more #t)] [else (raise-syntax-error #f "Could not match macro" stx)] diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index c918690f1c..51cec21c59 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -416,6 +416,7 @@ (lambda (x) x) (left final)))] + #; [(stopper? #'head) (debug "Parse a stopper ~a\n" #'head) (values (left final) @@ -424,6 +425,10 @@ (define-splicing-syntax-class no-left [pattern (~seq) #:when (and (= precedence 0) (not current))]) (syntax-parse #'(head rest ...) #:literal-sets (cruft) + [(semicolon . rest) + (debug "Parsed a semicolon, finishing up with ~a\n" current) + (values (left current) #'rest)] + #; [((semicolon more ...) . rest) #; (define-values (parsed unparsed) @@ -589,13 +594,19 @@ #:attributes (result) #:description "expression" (lambda (stx fail) - (debug "honu expression syntax class\n") - (if (stx-null? stx) - (fail) + (define context (gensym)) + (debug "[~a] honu expression syntax class on ~a\n" context stx) + (if (or (stx-null? stx) + #; + (stopper? (stx-car stx))) + (begin + (debug "[~a] failed\n" context) + (fail)) (let () (define-values (parsed unparsed) (parse stx)) - (debug "parsed ~a\n" (if parsed (syntax->datum parsed) parsed)) + (debug "[~a] expression parsed ~a\n" context (if parsed (syntax->datum parsed) parsed)) + (debug "[~a] Parsed things ~a\n" context (parsed-things stx unparsed)) (list (parsed-things stx unparsed) (parsed-syntax parsed) #; @@ -615,7 +626,15 @@ (provide honu-identifier) (define-splicing-syntax-class honu-identifier - [pattern x:id #:with result #'x]) + #:literal-sets (cruft) + [pattern (~and (~not semicolon) + x:id) #:with result #'x]) + +(provide honu-number) +(define-splicing-syntax-class honu-number + #:literal-sets (cruft) + [pattern x:number #:with result #'x]) + (provide identifier-comma-list) (define-splicing-syntax-class identifier-comma-list diff --git a/collects/honu/core/read.rkt b/collects/honu/core/read.rkt index 49e5b3a718..4d9871ca9f 100644 --- a/collects/honu/core/read.rkt +++ b/collects/honu/core/read.rkt @@ -333,7 +333,7 @@ ;; ((%semicolon 3 + 4) (%semicolon 1 + 2)) ;; ;; The entire list will be reversed at the end of parsing. - (define (do-semicolon current tokens table) + (define (do-semicolon2 current tokens table) ;; (debug "Do semicolon on ~a\n" current) (define-values (wrap ok) (let loop ([found '()] @@ -350,10 +350,16 @@ (car tokens) source)) + (do-parse (cons semicolon ok) (cdr tokens) table)) + (define (do-semicolon current tokens table) + (do-parse (cons (make-syntax '%semicolon (car tokens) source) current) + (cdr tokens) + table)) + (define (semicolon? tokens) (is-first-token token-semicolon? tokens)) @@ -423,6 +429,7 @@ (action current tokens table)] [else (loop (cdr use))]))) + (debug 3 "Parsing tokens ~a\n" (map position-token-token tokens)) (if (null? tokens) (datum->syntax #f '() #f) (datum->syntax #f (do-parse '() tokens dispatch-table) diff --git a/collects/tests/honu/check.rkt b/collects/tests/honu/check.rkt index 7ee0fc00fd..6dc3631ff9 100644 --- a/collects/tests/honu/check.rkt +++ b/collects/tests/honu/check.rkt @@ -92,7 +92,7 @@ (test "cond" @input{ - var n = 5; + var n = 5 cond n < 10: 'x1, n > 10: 'x2 diff --git a/collects/tests/honu/match.honu b/collects/tests/honu/match.honu index 415d17ec06..8e1f7689d5 100644 --- a/collects/tests/honu/match.honu +++ b/collects/tests/honu/match.honu @@ -27,3 +27,9 @@ mymatch [1, 2, 3] with | [1, 2, 3] => 8, // mymatch [1] with | [2] => 5 + +mymatch [true, false] with +| [true] => 1, +| [false] => 2, +| [false, true] => 3, +| [true, false] => 4,