1 files changed, 52 insertions, 43 deletions
diff --git a/module/c/cpp.scm b/module/c/cpp.scm
index a2935352..aed496f2 100644
--- a/module/c/cpp.scm
+++ b/module/c/cpp.scm
@@ -5,47 +5,37 @@
   :use-module (ice-9 match)
   :use-module (ice-9 regex)
   :use-module ((rnrs io ports) :select (call-with-port))
+  :use-module ((rnrs bytevectors) :select (bytevector?))
   :use-module (ice-9 format)
   :use-module ((hnh util io) :select (read-lines))
   :use-module (hnh util graph)
   :use-module (c lex)
   :use-module (c parse)
   :use-module (c operators)
-  :export (do-funcall replace-symbols include#)
+  :export (replace-symbols include#)
   )
 
 
 ;; input "#define F(x, y) x + y"
-;; 1 full define | F(x, y)
+;; 1 full define | F(x,y)
 ;; 2 macro name  | F
-;; 3 macro args  | (x, y)
-;; 4 macro body  | x + y
-(define define-re (make-regexp "^#define ((\\w+)(\\([^)]*\\))?) (.*)"))
+;; 3 macro args  | (x,y)
+;; 5 macro body  | x + y or #f
+(define define-re (make-regexp "^#define ((\\w+)([(][^)]*[)])?)( (.*))?"))
 
 (define (tokenize-define-line header-line)
   (aif (regexp-exec define-re header-line)
     (cons (match:substring it 1)
-          (match:substring it 4))
+          (let ((body (match:substring it 5)))
+            (if (or (eqv? body #f)
+                    (string-null? body))
+                "1" body)))
     (scm-error 'c-parse-error
                "tokenize-define-line"
                "Line dosen't match: ~s"
                (list header-line) #f)))
 
 
-(define (do-funcall function arguments)
-  (if (list? arguments)
-      (apply function arguments)
-      (function arguments)))
-
-(define symb-map
-  `((,(symbol #\|) . logior)
-    (funcall . (@ (c cpp) do-funcall))
-    (&& . and)
-    (& . logand)
-    (== . =)
-    (!= . (negate =))
-    ))
-
 (define (replace-symbols tree dict)
   (if (not (list? tree))
       (or (assoc-ref dict tree) tree)
@@ -55,12 +45,27 @@
 ;; Direct values. Lisp also has quoted symbols in this group.
 (define (immediate? x)
   (or (number? x)
-      (char? x)
-      (string? x)))
+      (bytevector? x)))
 
+;; TODO replace this with something sensible
+;; like a correct list extracted from (c eval)
+;; and not thinging that types are variables
 ;; built in symbols. Should never be marked as dependencies
 (define (primitive? x)
-  (memv x (cons 'funcall binary-operators)))
+  (memv x `(
+            ;; language primitives
+            sizeof
+
+            ;; special forms introduced by parser
+            funcall ternary struct-type as-type
+
+            ;; unary operatons which aren't also binary operators
+            ++ -- ! ~
+            not compl dereference pointer
+            pre-increment pre-decrement
+            post-increment post-decrement
+            ,@binary-operators
+            )))
 
 
 
@@ -77,7 +82,6 @@
       [arg (list arg)]))
 
   (define right (f (cdr pair)))
-  (define alt-right (replace-symbols right symb-map))
   (define dependencies
     (lset-difference
      eq?
@@ -91,12 +95,12 @@
    dependencies
    (match left
      [('funcall name ('#{,}# args ...))
-      (cons name `(lambda ,args ,alt-right))]
+      (cons name `(lambda ,args ,right))]
 
      [('funcall name arg)
-      (cons name `(lambda (,arg) ,alt-right))]
+      (cons name `(lambda (,arg) ,right))]
 
-     [name (cons name alt-right)])))
+     [name (cons name right)])))
 
 
 (define (parse-cpp-file lines)
@@ -104,7 +108,9 @@
          (catch #t
            (lambda () (parse-cpp-define line))
            (lambda (err caller fmt args data)
-             (format #t "~a ~?~%" fmt args)
+             (format #t "~a in ~a: ~?~%"
+                     err caller fmt args)
+             (format #t "~s~%" line)
              #f)))
        lines))
 
@@ -114,29 +120,32 @@
 (define (tokenize-header-file header-file)
   (map tokenize-define-line
        (call-with-port
-        (open-input-pipe
-         (string-append "cpp -dM " header-file))
+        (open-pipe* OPEN_READ "cpp" "-dM" header-file)
         read-lines)))
 
-(define-macro (include# header-file . args)
-
-  (define define-form (if (null? args) 'define (car args)))
-
-  (define lines (remove (compose private-c-symbol? car)
-                        (tokenize-header-file header-file)))
+(define (load-cpp-file header-file)
 
+  (define lines (tokenize-header-file header-file))
   (define forms (parse-cpp-file lines))
 
-  (define graph*
-    (fold (lambda (node graph)
-            (add-node graph (cdr node) (car node)))
-          (make-graph car)
-          (filter identity forms)))
+  (fold (lambda (node graph)
+          (add-node graph (cdr node) (car node)))
+        (make-graph car)
+        (filter identity forms)))
 
+(define (include% header-file)
+  (define graph* (load-cpp-file header-file))
   ;; Hack for termios since this symbol isn't defined.
   ;; (including in the above removed private c symbols)
-  (define graph (add-node graph* (cons '_POSIX_VDISABLE #f) '()))
+  (define graph (add-node graph* (cons '_POSIX_VDISABLE 0) '()))
+  ;; TODO expand bodies
+  ;; (remove (compose private-c-symbol? car))
+  (resolve-dependency-graph graph))
+
+(define-macro (include# header-file . args)
+
+  (define define-form (if (null? args) 'define (car args)))
 
   `(begin
      ,@(map (lambda (pair) `(,define-form ,(car pair) ,(cdr pair)))
-            (resolve-dependency-graph graph))))
+            (include% header-file))))