implement comma in Sex sources

sexc.scm

@@ -1,33 +1,71 @@
-(import brev-separate fmt fmt-c tree (chicken string))
+(import fmt fmt-c (chicken string))
 
 (define (unkebabify sym)
   (string->symbol
    (string-translate (symbol->string sym) #\- #\_)))
 
+(define (map-filter-tree map-proc filter-proc tree)
+  "Walk the tree, checking each element with filter-proc.
+If filter-proc returns #t:
+  - if the element is list, process it recursively,
+  - if the element is an atom, process it with map-proc.
+
+If filter-proc returns #f, ignore the element.
+
+If filter-proc returns something other, use it instead of processing the element."
+  (let ((cont (cut map-filter-tree map-proc filter-proc <>)))
+    (if (null? tree) '()
+        (let ((filter-res (filter-proc (car tree))))
+          ;(fmt #t "Filter res for " tree " is " filter-res "\n")
+          (case filter-res
+            ((#t) (cons
+                   (if (atom? (car tree))
+                       (map-proc (car tree))
+                       (cont (car tree)))
+                   (cont (cdr tree))))
+            ((#f) (cont (cdr tree)))
+            (else (cons filter-res (cont (cdr tree)))))))))
+
+(define (walk-tree tree)
+  (map-filter-tree
+   (lambda (elem)
+     (case elem
+       ((fn) '%fun)
+       ((var) '%var)
+       ((begin) '%begin)
+       ((pointer) '%pointer)
+       ((array) '%array)
+       (([]) 'vector-ref)
+       ((include) '%include)
+       ((cast) '%cast)
+       (else
+        (if (symbol? elem)
+            (unkebabify elem)
+            elem))))
+   (lambda (subtree)
+     (if (list? subtree)
+         (case (car subtree)
+           ((unquote)
+            (eval (cadr subtree)))
+           (else #t))
+         #t))
+   tree))
+
 (define (loop)
-  (let ((r (read)))
-    (unless (eof-object? r)
-      (cond ((eqv? (car r) 'define) (eval r))
-            (#t
-             (fmt #t
-                  (c-expr
-                   (tree-map
-                    (fn
-	             (case x
-                       ((fn) '%fun)
-                       ((var) '%var)
-                       ((begin) '%begin)
-	               ((pointer) '%pointer)
-                       ((array) '%array)
-                       (([]) 'vector-ref)
-                       ((include) '%include)
-	               ((cast) '%cast)
-                       (else
-                        (if (symbol? x)
-                            (unkebabify x)
-                            x))))
-                    r)))
-             (fmt #t "\n")))
-      (loop))))
+  (call/cc
+   (lambda (return)
+     (let ((r (read)))
+       (when (eof-object? r)
+         (return '()))
+       (case (car r)
+         ((define)
+          (eval r)
+          (fmt #t "\n"))
+         (else
+          (let ((result (walk-tree r)))
+            (when result
+              (fmt #t (c-expr
+                       result))))))
+       (loop)))))
 
 (loop)