rewrite tree walk with tree module

also add pub support

Readme.org

@@ -14,7 +14,7 @@ By the way, there's a way to make Chicken install eggs non-globally. Refer to
 the documentation for more info:
 https://wiki.call-cc.org/man/5/Extension%20tools#changing-the-repository-location
 
-~chicken-install fmt getopt-long~
+~chicken-install fmt getopt-long brev-separate~
 
 ** Compilation
 ~make~
@@ -38,7 +38,7 @@ The Sex source:
 (define (foo)
   "Hello from Chicken code!\n")
 
-(fn int main ((int argc) (char **argv))
+(pub fn int main ((int argc) (char **argv))
     (puts "Hello from Sex!")
     (var (array char 512) name)
     (puts "What is your name?")

hello-world.sex

@@ -3,7 +3,7 @@
 (define (foo)
   "Hello from Chicken code!\n")
 
-(fn int main ((int argc) (char **argv))
+(pub fn int main ((int argc) (char **argv))
     (puts "Hello from Sex!")
     (var (array char 512) name)
     (puts "What is your name?")

sex-mode.el

@@ -30,6 +30,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
      (list (concat "("
                    (regexp-opt '("include"
                                  "fn"
+                                 "pub"
                                  "struct"
                                  "template"
                                  "var")

sexc.scm

@@ -1,81 +1,77 @@
-(import (chicken pretty-print)
+(import brev-separate
+        (chicken pretty-print)
         (chicken process-context)
         (chicken string)
         fmt
         fmt-c
         getopt-long
-        srfi-1 ; list routines
+        srfi-1                          ; list routines
-        )
+        tree)
 
 (define (unkebabify sym)
   (string->symbol
    (string-translate (symbol->string sym) #\- #\_)))
 
-; Maybe rewrite with tree inversions?
+(define (atom-to-fmt-c atom)
-(define (map-filter-tree map-proc filter-proc tree)
+  (case atom
-  "Walk the tree, checking each element with filter-proc.
+    ((fn) '%fun)
-If filter-proc returns #t:
+    ((var) '%var)
-  - if the element is list, process it recursively,
+    ((begin) '%begin)
-  - if the element is an atom, process it with map-proc.
+    ((pointer) '%pointer)
+    ((array) '%array)
+    (([]) 'vector-ref)
+    ((include) '%include)
+    ((cast) '%cast)
+    (else
+     (if (symbol? atom)
+         (unkebabify atom)
+         atom))))
 
-If filter-proc returns #f, ignore the element.
+(define (tree-finder symbol)
+  (lambda (node)
+    (or (and (tree? node)
+             (eq? (car node) symbol))
+        #f)))
 
-If filter-proc returns something other, use it instead of processing the element."
+(define (walk-generic form)
-  (let ((cont (cut map-filter-tree map-proc filter-proc <>)))
+  (let loop ((tree (tree-map atom-to-fmt-c form)))
-    (if (null? tree) '()
+    (let ((unquote-form (tree-find (tree-finder 'unquote) tree #f)))
-        (let ((filter-res (filter-proc (car tree))))
+      (if unquote-form
-          (case filter-res
+          (let ((inv (invert-tree tree)))
-            ((#t) (cons
+            (loop (tree-replace inv unquote-form (eval (cadr unquote-form)))))
-                   (if (atom? (car tree))
+          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)
+(define (walk-function form static)
-  (map-filter-tree
+  (if static
-   (lambda (elem)
+      (list 'static (walk-generic form))
-     (case elem
+      (walk-generic (cdr form))))
-       ((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 (read-forms collect)
+(define (walk-sex-tree form)
-  (call/cc
+  (case (car form)
-   (lambda (return)
+    ((fn) (walk-function form #t))
-     (read-forms
+    ((pub) (walk-function form #f))
-      (cons
+    ((template) '())                      ; TODO
-       (let ((r (read)))
+    ((struct) (walk-generic form))
-         (when (eof-object? r)
+    (else (walk-generic form))))
-           (return (filter (lambda (e) (not (null? e)))
+
-                           (reverse collect))))
+(define (process-form form)
-         (case (car r)
+  (case (car form)
-           ((define)
+    ((define)
-            (eval r)
+     (eval form) '())
-            '())
+    (else
-           (else
+     (walk-sex-tree form))))
-            (let ((result (walk-tree r)))
+
-              (if result result
+(define (process-raw-forms raw-forms acc)
-                  '())))))
+  (if (null? raw-forms) (filter (fn (not (null? x)))
-       collect)))))
+                                (reverse acc))
+      (process-raw-forms (cdr raw-forms)
+                         (cons (process-form (car raw-forms))
+                               acc))))
+
+(define (read-forms acc)
+  (let ((r (read)))
+    (if (eof-object? r) (reverse acc)
+        (read-forms (cons r acc)))))
 
 (define (emit-c forms)
   (map (lambda (form)
@@ -127,12 +123,12 @@ If filter-proc returns something other, use it instead of processing the element
          (help (help-arg? args))
          (input (get-input-file args)))
     (if help (print-help)
-        (let ((sex-forms
+        (let* ((raw-forms
-               (if (eq? input 'stdin)
+                (if (eq? input 'stdin)
-                   (read-forms (list))
+                    (read-forms (list))
-                   (with-input-from-file input
+                    (with-input-from-file input
-                     (lambda () (read-forms (list)))))))
+                      (lambda () (read-forms (list))))))
-
+               (sex-forms (process-raw-forms raw-forms (list))))
           (if (get-arg args 'macro-expand #f)
               (map pp sex-forms)
               (if (not (eq? output 'stdout))