From 690034ca8abcd931e2fb6bb8129450deee701179 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 28 Jun 2022 23:46:08 +0200
Subject: Major work on c parser.

---
 module/c/cpp.scm | 60 +++++++++++++++++++++++---------------------------------
 1 file changed, 25 insertions(+), 35 deletions(-)

(limited to 'module/c/cpp.scm')

diff --git a/module/c/cpp.scm b/module/c/cpp.scm
index a2935352..9a8245ad 100644
--- a/module/c/cpp.scm
+++ b/module/c/cpp.scm
@@ -11,7 +11,7 @@
   :use-module (c lex)
   :use-module (c parse)
   :use-module (c operators)
-  :export (do-funcall replace-symbols include#)
+  :export (replace-symbols include#)
   )
 
 
@@ -20,7 +20,7 @@
 ;; 2 macro name  | F
 ;; 3 macro args  | (x, y)
 ;; 4 macro body  | x + y
-(define define-re (make-regexp "^#define ((\\w+)(\\([^)]*\\))?) (.*)"))
+(define define-re (make-regexp "^#define ((\\w+)([(][^)]*[)])?) (.*)"))
 
 (define (tokenize-define-line header-line)
   (aif (regexp-exec define-re header-line)
@@ -32,20 +32,6 @@
                (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)
@@ -77,7 +63,6 @@
       [arg (list arg)]))
 
   (define right (f (cdr pair)))
-  (define alt-right (replace-symbols right symb-map))
   (define dependencies
     (lset-difference
      eq?
@@ -91,12 +76,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 +89,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 +101,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) '()))
+  ;; 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))))
-- 
cgit v1.2.3