;; Filter/preprocess an input file with Scheme.
;;
;; Call with
;;
;;    ./beastie0 scheme-macro-filter foo.c.in
;;
;; This file is part of Beastie <https://purl.org/nxg/dist/beastie>
;; SPDX-FileCopyrightText: 2023 Norman Gray <https://nxg.me.uk>
;; SPDX-License-Identifier: BSD-2-Clause

;; copy characters from port 'in' to current-output-port, except where
;; we encounter #(...).  That form should evaluate to a list of
;; lists-or-strings, which are sent to the output.
(define (filter/port in)
  (define (display-sexp x)
    (cond ((pair? x) (for-each display-sexp x))
          ((or (not x) (null? x)))      ;do nothing
          (else (display x))))
  (let loop ((at-next-newline #f))
    (let ((c (read-char in)))
      (cond ((eof-object? c))           ;do nothing
            ((and (char=? c #\#)
                  (char=? (peek-char in) #\())
             (display-sexp (eval (read in)))
             (loop (format #f "#line ~a \"~a\"~%"
                           (+ (port-line-number in) 1)
                           (port-filename in))))
            (else
             (write-char c)
             (if (and (char=? c #\newline)
                      at-next-newline)
                 (begin
                   (display at-next-newline)
                   (loop #f))
                 (loop at-next-newline)))))))

;; Given a file foo.scm, expand to
;;
;;    const char foo_scm[] = {...};
;;    const size_t foo_scm_len = N;
;;
;; where foo_scm is an array of N bytes.
;;
;; Note: this routine is OK with encoding a program with Unicode in it,
;; since (string->list s) turns s into a UTF-8 sequence of bytes (this isn't documented).
(define* (file->strings fn (name #f) (static? #f))
  (let ((dotidx (- (string-length fn) 4)))
    (if (string=? (substring fn dotidx) ".scm")
        (let ((fn-root (or name
                           (string-append (substring fn 0 dotidx) "_scm")))
              (prog           ;the program, as a list of write strings
               (let-temporarily (((*s7* 'print-length) (*s7* 'most-positive-fixnum)))
                 (call-with-input-file fn
                   (lambda (in)
                     (let loop ((e (read in))
                                (lines '()))
                       (cond ((eof-object? e)
                              (reverse! lines))
                             ((or (unspecified? e)
                                  (null? e)) ;ignore this
                              (loop (read in) lines))
                             (else
                              (loop (read in)
                                    (cons (object->string e :write)
                                          lines))))))))))
          (dependency-add! fn)
          (list (format #f "~%~%/* contents of ~s */" fn)
                (prog->strings prog fn-root static?)))
        (format (current-error-port)
                "file->strings: file ~a ignored -- must be foo.scm~%" fn))))

(define* (prog->strings/strings prog name (static? #f) (comment-length 40))
  ;; Given a program as a list of strings, write this in a way which
  ;; can be loaded with
  ;;
  ;;     s7_load_c_string(S7, <name>, <name>_len);
  ;;
  ;; The prog argument should be a list of strings, each of which is one
  ;; scheme expression.
  ;;
  ;; The return value is also a list of strings, which can be written
  ;; in sequence to the output port.
  (list (format #f "~%    ~aconst char* const ~a ="
                (if static? "static " "") name)
        (map (lambda (line)
               (with-output-to-string
                 (lambda ()
                   (newline)
                   (write line))))
             prog)
        (format #f ";~%    ~aconst size_t ~a_len = ~a;"
                (if static? "static " "")
                name
                (apply + (map string-length prog)))))

;; The following is a variant of the above, which produces the output
;; as a C _byte array_ rather than strings.  This is cute, but isn't
;; going to be any faster, and ends up being less conveniently readable.
(define* (prog->strings/bytes prog name (static? #f) (comment-length 40))
  ;; Given a program as a list of strings, write this in a way which
  ;; can be loaded with
  ;;
  ;;     s7_load_c_string(S7, <name>, <name>_len);
  ;;
  ;; The prog argument should be a list of strings, each of which is one
  ;; scheme expression.
  (list (format #f "~%    ~aconst char ~a[] = {"
                (if static? "static " "") name)
        (map (lambda (line)
               (list (if (< (string-length line) comment-length)
                         (format #f "~%        /* ~a */" line)
                         (format #f "~%        /* ~a ... */" (substring line 0 comment-length)))
                     (with-output-to-string
                       (lambda ()
                         (let next-char ((l (string->list line))
                                         (bytes/line 0))
                           (unless (null? l)
                             (when (= bytes/line 0)
                               (format #t "~%        "))
                             (format #t "0x~x, " (char->integer (car l)))
                             (next-char (cdr l)
                                        (if (= bytes/line 0) 9 (- bytes/line 1)))))))))
             prog)
        (format #f "0 };~%    ~aconst size_t ~a_len = ~a;"
                (if static? "static " "")
                name
                (apply + (map string-length prog)))))
(define prog->strings prog->strings/strings)

(varlet (curlet)
  (let ((*deps* '()))
    (define (add! fn)
      (set! *deps* (cons fn *deps*))
      #<unspecified>)
    (define (get-line target)
      (apply string-append
             `(,target ":"
                       . ,(map (lambda (f)
                                 (format #f " ~a" f))
                               *deps*))))
    (inlet 'dependency-add! add!
           'dependencies-line get-line)))

(let ((input-file  (and (> (length *command-line*) 1)
                        (list-ref *command-line* 1)))
      (output-file (and (> (length *command-line*) 2)
                        (list-ref *command-line* 2))))
  (define (process-input)
    ;; Include a #line number in the generated output.
    ;; This goes wrong after #(...) are expanded, but that turns out
    ;; to be hard to fix.
    (if input-file
        (begin
          (dependency-add! input-file)
          (format #t "// GENERATED~%// from ~a~%~%#line 1 \"~a\"~%"
                  input-file input-file)
          (call-with-input-file input-file
            filter/port))
        (begin
          (format #t "// GENERATED~%~%")
          (filter/port (current-input-port)))))

  (if output-file
      (begin
        (with-output-to-file output-file process-input)
        (call-with-output-file (string-append output-file ".d")
          (lambda (p)
            (format p "~a~%" (dependencies-line output-file)))))
      (process-input)))