add #line directive to generated C code to support source debugging

fmt-c-writer.scm

@@ -6,14 +6,15 @@
                utils))
 
 (import (chicken string)
+        (chicken syntax)
         brev-separate
         fmt
         matchable
         regex
         srfi-1                          ; lists
         srfi-13                         ; strings
-        tree
+        srfi-39                         ; parameters
-        )
+        tree)
 
 (define (unkebabify sym)
   (case sym
@@ -260,7 +261,23 @@
     (('define name . rest) `(%define ,(atom-to-fmt-c name) ,@rest))
     (else (walk-expr form))))
 
+(define (get-line-num form)
+  (let ((num (get-line-number form)))
+    (if (string? num)
+        (last (string-split num ":"))
+        #f)))
+
+(define sex-fmt-current-file (make-parameter "/dev/null"))
+(define sex-fmt-line-num (make-parameter 0))
+
+(define (line-directive-string)
+  (fmt #f #\# "line " (sex-fmt-line-num) " " #\" (sex-fmt-current-file) #\"))
+
 (define (emit-c sex-forms)
   (for-each (lambda (form)
+              (let ((start-line (get-line-num form)))
+                (when start-line
+                  (sex-fmt-line-num start-line)
+                  (fmt #t (line-directive-string) nl)))
               (fmt #t (c-expr (process-toplevel-form form)) nl))
             sex-forms))

sex-reader.scm

@@ -9,11 +9,12 @@
   (chicken port)
   (chicken read-syntax)
   (chicken string)
+  (chicken syntax)
   brev-separate
   fmt)
 
 (define (read-forms acc)
-  (let ((r (read)))
+  (let ((r (read-with-source-info (current-input-port))))
     (if (eof-object? r) (reverse acc)
         (read-forms (cons r acc)))))
 

sexc.scm

@@ -1,6 +1,7 @@
 (declare (unit sexc)
          (uses fmt-c-writer
                sex-reader
+               utils
                semen))
 
 (include "utils.macros.scm")
@@ -154,6 +155,7 @@
          (return #f))
        (load-persistent-module-paths)
 
+       (sex-fmt-current-file (to-absolute-pathname input))
        (let* ((raw-forms (append prelude (read-raw-forms input)))
               (sex-forms (semantic-process-forms raw-forms input)))
          (if (or (get-arg args 'macro-expand #f)

utils.scm

@@ -19,6 +19,13 @@
          (current-directory)
          (pathname-directory file))))))
 
+(define (to-absolute-pathname pathname)
+  (if (absolute-pathname? pathname)
+      pathname
+      (make-absolute-pathname
+       (current-directory)
+       pathname)))
+
 (define (list-split src-list split-elt)
   ;; split '(1 2 / 3 4 / 5 6) by '/ -> '((1 2) (3 4) (5 6))
   (fold (lambda (elt acc)