(define-module (c cpp)
  :use-module (hnh util)
  :use-module (srfi srfi-1)
  :use-module (ice-9 popen)
  :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 (replace-symbols include#)
  )


;; input "#define F(x, y) x + y"
;; 1 full define | F(x,y)
;; 2 macro name  | F
;; 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)
          (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 (replace-symbols tree dict)
  (if (not (list? tree))
      (or (assoc-ref dict tree) tree)
      (map (lambda (node) (replace-symbols node dict))
           tree)))

;; Direct values. Lisp also has quoted symbols in this group.
(define (immediate? x)
  (or (number? 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 `(
            ;; 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
            )))



;; (symbol . value) -> (list (dependencies . symbol . value)
(define (parse-cpp-define pair)
  (define f (compose parse-lexeme-tree lex))
  (define left (f (car pair)))
  (define proc-args
    (match (and (pair? left)
                (eq? 'funcall (car left))
                (caddr left))
      [#f '()]
      [(_ args ...) args]
      [arg (list arg)]))

  (define right (f (cdr pair)))
  (define dependencies
    (lset-difference
     eq?
     (remove primitive?
             (remove immediate?
                     (flatten (if (list? right)
                                  right (list right)))))
     proc-args))

  (cons
   dependencies
   (match left
     [('funcall name ('#{,}# args ...))
      (cons name `(lambda ,args ,right))]

     [('funcall name arg)
      (cons name `(lambda (,arg) ,right))]

     [name (cons name right)])))


(define (parse-cpp-file lines)
  (map (lambda (line)
         (catch #t
           (lambda () (parse-cpp-define line))
           (lambda (err caller fmt args data)
             (format #t "~a in ~a: ~?~%"
                     err caller fmt args)
             (format #t "~s~%" line)
             #f)))
       lines))

(define (private-c-symbol? string)
  (char=? #\_ (string-ref string 0)))

(define (tokenize-header-file header-file)
  (map tokenize-define-line
       (call-with-port
        (open-pipe* OPEN_READ "cpp" "-dM" header-file)
        read-lines)))

(define (load-cpp-file header-file)

  (define lines (tokenize-header-file header-file))
  (define forms (parse-cpp-file lines))

  (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 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)))
            (include% header-file))))