aboutsummaryrefslogtreecommitdiffstats
path: root/mcgoron/guix/srfi-util.scm
blob: cc54fa35490869d6ef14bb9d2c8ba6d64d623623 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#| Copyright (C) 2025 Peter McGoron
 |
 | This program is free software: you can redistribute it and/or modify it
 | under the terms of the GNU General Public License as published by the
 | Free Software Foundation, either version 3 of the License, or (at your
 | option) any later version.
 |
 | This program is distributed in the hope that it will be useful, but
 | WITHOUT ANY WARRANTY; without even the implied warranty of
 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 | General Public License for more details.
 |
 | You should have received a copy of the GNU General Public License along
 | with this program.  If not, see <https://www.gnu.org/licenses/>.
 |#

(define-module (mcgoron guix srfi-util)
  #:use-module (rnrs))

(define-public (splice-files output version name exports imports . filenames)
  (with-output-to-file output
    (lambda ()
      (case version
        ((6)
         (display "(library ")
         (write name)
         (newline)
         (write (cons 'export exports))
         (newline)
         (write (cons 'import imports))
         (newline))
        ((7)
         (display "(define-library ")
         (write name)
         (newline)
         (write (cons 'import imports))
         (newline)
         (write (cons 'export exports))
         (newline)
         (display "(begin\n"))
        (else (error "unknown version" version)))
      (for-each (lambda (filename)
                  (cond
                    ((string? filename)
                     (do ((file (open-input-file filename))
                          (s "" (get-line file)))
                         ((eof-object? s))
                       (display s) (newline)))
                    ((pair? filename)
                     (write filename)
                     (newline))
                    (else (error "invalid file" filename))))
                filenames)
      (case version
        ((6) (display ")\n"))
        ((7) (display "))\n"))
        (else (error "unknown version" version))))))