diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm index a9abd9b..c799f52 100644 --- a/fmt-c-writer.scm +++ b/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)) diff --git a/sex-reader.scm b/sex-reader.scm index 05f192f..e68c075 100644 --- a/sex-reader.scm +++ b/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))))) diff --git a/sexc.scm b/sexc.scm index f8d0414..745cbfc 100644 --- a/sexc.scm +++ b/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) diff --git a/utils.scm b/utils.scm index c4fb8e8..57f90d3 100644 --- a/utils.scm +++ b/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)