[honu] dont remove syntaxes that end expressions from the stream so macros can consume them. add a simple cond macro

collects/honu/core/main.rkt

@@ -27,6 +27,7 @@
                      [honu-not not] [honu-not !]
                      [honu-structure structure]
                      [honu-structure struct]
+                     [literal:colon :]
                      [literal:honu-= =]
                      [literal:semicolon |;|]
                      [literal:honu-comma |,|]

collects/honu/core/private/literals.rkt

@@ -1,7 +1,8 @@
-#lang racket
+#lang racket/base
 
 (provide (all-defined-out))
-(require syntax/parse)
+(require syntax/parse
+         (for-syntax racket/base))
 
 ;; macro for defining literal tokens that can be used in macros
 (define-syntax-rule (define-literal name ...)
@@ -25,4 +26,4 @@
                 honu-for-syntax
                 honu-for-template)
 
-(define-literal-set cruft (#%parens #%brackets #%braces semicolon honu-= honu-comma))
+(define-literal-set cruft (#%parens #%brackets #%braces semicolon colon honu-= honu-comma))

collects/honu/core/private/parse2.rkt

@@ -97,6 +97,16 @@
        (loop (cons #'name out) #'())]
       [() (reverse out)])))
 
+;; removes syntax that causes expression parsing to stop
+(define (strip-stops code)
+  (define-syntax-class stopper #:literal-sets (cruft)
+    [pattern semicolon]
+    [pattern honu-comma]
+    [pattern colon])
+  (syntax-parse code
+    [(x:stopper rest ...) (strip-stops #'(rest ...))]
+    [else code]))
+
 (define (parse-comma-expression arguments)
   (if (null? (syntax->list arguments))
     '()
@@ -105,10 +115,18 @@
       (if (empty-syntax? rest)
         (reverse used)
         (let-values ([(parsed unparsed)
-                      (parse rest)])
+                      ;; FIXME: don't strip all stops, just comma
+                      (parse (strip-stops rest))])
           (loop (cons parsed used)
                 unparsed))))))
 
+(define (stopper? what)
+  (define-literal-set check (honu-comma semicolon colon))
+  (define is (and (identifier? what)
+                  ((literal-set->predicate check) what)))
+  (debug "Comma? ~a ~a\n" what is)
+  is)
+
 ;; 1 + 1
 ;; ^
 ;;  left: identity
@@ -197,24 +215,9 @@
                       0
                       (lambda (x) x)
                       (left final)))]
-         [(comma? #'head)
+         [(stopper? #'head)
           (values (left final)
-                  #'(rest ...))]
+                  stream)]
-         [(semicolon? #'head)
-          (values (left final)
-                  #'(rest ...))
-          #;
-          (do-parse #'(rest ...) 0
-                    (lambda (stuff)
-                      (with-syntax ([stuff stuff]
-                                    [current (left current)])
-                        #'(begin current stuff)))
-                    #'(void))
-          #;
-          (with-syntax ([so-far (left current)])
-            #'(splicing-let-syntax ([more (lambda (stx)
-                                            (parse #'(rest ...)))])
-                                   so-far (more)))]
          [else
            (syntax-parse #'(head rest ...) #:literal-sets (cruft)
              [(function:identifier (#%parens args ...) (#%braces code ...) . rest)
@@ -294,7 +297,7 @@
   (let loop ([all '()]
              [code code])
     (define-values (parsed unparsed)
-                   (parse code))
+                   (parse (strip-stops code)))
     (debug "Parsed ~a unparsed ~a\n" (syntax->datum parsed)
            (syntax->datum unparsed))
     (if (empty-syntax? unparsed)

collects/honu/main.rkt

@@ -17,4 +17,5 @@
                 ;;"private/common.honu"
                 )
 
-(provide sqr sqrt sin max)
+(provide sqr sqrt sin max
+         (rename-out [honu-cond cond]))

collects/honu/private/common.rkt

@@ -1,4 +1,22 @@
 #lang racket/base
 
+(require honu/core/private/macro2
+         (for-syntax syntax/parse
+                     racket/base
+                     honu/core/private/literals
+                     honu/core/private/parse2))
+
 (provide sqr)
 (define (sqr x) (* x x))
+
+(provide honu-cond)
+(define-honu-syntax honu-cond
+  (lambda (code context)
+    (syntax-parse code #:literal-sets (cruft)
+      [(_ (~seq clause:honu-expression colon body:honu-expression (~optional honu-comma)) ...
+          semicolon . rest)
+       (values
+         #'(cond
+             [clause.result body.result] ...)
+         #'rest
+         #f)])))