[honu] return the current expression when a semicolon is parsed

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]

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

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)
+      [(_ name:honu-identifier ... (~optional semicolon) . rest)
-       (define out (racket-syntax (provide name ...)))
+       (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

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)]

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")
+    (define context (gensym))
-    (if (stx-null? stx)
+    (debug "[~a] honu expression syntax class on ~a\n" context stx)
-      (fail)
+    (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

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)

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

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,