mescc: Tinycc support: memset.
[mes.git] / guile / guix / make.scm
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; This file is part of Mes.
7 ;;;
8 ;;; Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
12 ;;;
13 ;;; Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; make
24
25 ;;; Code:
26
27 (define-module (guix make)
28   #:use-module (ice-9 curried-definitions)
29   #:use-module (ice-9 format)
30   #:use-module (ice-9 optargs)
31   #:use-module (ice-9 popen)
32   #:use-module (ice-9 pretty-print)
33   #:use-module (ice-9 rdelim)
34   #:use-module (ice-9 receive)
35
36   #:use-module (srfi srfi-1)
37   #:use-module (srfi srfi-26)
38
39   #:use-module (guix records)
40   #:use-module (guix shell-utils)
41
42   #:export (build
43             check
44             clean
45             group
46             install
47             target-prefix?
48             check-target?
49             install-target?
50
51             cpp.mescc
52             compile.mescc
53             ld
54
55             bin.mescc
56             bin.gcc
57             snarf
58
59             libc-mes.E
60             mini-libc-mes.E
61             add-target
62             get-target
63
64             conjoin
65             system**
66             target-file-name
67
68             target
69             %targets
70             %status
71
72             %version
73             %prefix
74             %datadir
75             %docdir
76             %moduledir
77             %guiledir
78             %godir))
79
80 (define %status 0)
81 (define %targets '())
82 (define %store-dir ".store")
83 (mkdir-p %store-dir)
84 (define %command-log (open-output-file "script"))
85
86 (define (base-name file-name suffix)
87   (string-drop-right file-name (string-length suffix)))
88
89 (define (conjoin . predicates)
90   (lambda (. arguments)
91     (every (cut apply <> arguments) predicates)))
92
93 (define (system** . command)
94   (format %command-log "~a\n" (string-join command " "))
95   (unless (zero? (apply system* command))
96     (format (current-error-port) "FAILED:~s\n" command)
97     (exit 1)))
98
99 (define (gulp-pipe* . command)
100   (let* ((port (apply open-pipe* (cons OPEN_READ command)))
101          (foo (set-port-encoding! port "ISO-8859-1"))
102          (output (read-string port))
103          (status (close-pipe port)))
104     (format %command-log "~a\n" (string-join command " "))
105     (values output status)))
106
107 (define (assert-gulp-pipe* . command)
108   (receive (output status)
109       (apply gulp-pipe* command)
110     (if (zero? status) (string-trim-right output #\newline)
111         (error (format #f "pipe failed: ~d ~s"
112                        (or (status:exit-val status)
113                            (status:term-sig status)) command)))))
114
115 (define-record-type* <method>
116   method make-method
117   method?
118   (name       method-name)
119   (build      method-build (default (lambda _ #t)))
120   (inputs     method-inputs (default (list))))
121
122 (define-record-type* <target>
123   target make-target
124   target?
125   (file-name  target-file-name (default #f))       ; string
126   (file-names target-file-names (default '()))     ; (string)
127   (hash       target-hash (default #f))            ; string
128   (method     target-method (default method-file)) ; <method>
129   (inputs     target-inputs (default (list)))      ; list
130
131                                                    ; For check targets
132   (baseline   target-baseline (default #f))        ; string: file-name
133   (exit       target-exit (default #f))            ; number
134   (signal     target-signal (default #f)))         ; number
135
136 (define method-file (method (name "FILE")))
137 (define method-check
138   (method (name "CHECK")
139           (build (lambda (o t)
140                    (let* ((inputs (target-inputs t))
141                           (file-name (target-file-name (build (car inputs))))
142                           (run file-name)
143                           (baseline (target-baseline t))
144                           (exit (target-exit t))
145                           (signal (target-signal t))
146                           (log (string-append file-name "-check.log")))
147                      (format (current-error-port) "  CHECK\t~a" (basename file-name))
148                      (receive (output result)
149                          ;; FIXME: quiet MES tests are not fun
150                          (if (string-prefix? "tests/" run) (values #f (system* run "arg1" "arg2" "arg3" "arg4" "arg5"))
151                              (gulp-pipe* run "arg1" "arg2" "arg3" "arg4" "arg5"))
152                        (if (file-exists? log) (delete-file log))
153                        (if (or baseline (and output (not (string-null? output)))) (with-output-to-file log (lambda _ (display output))))
154                        (if baseline (set! result (system* "diff" "-bu" baseline log)))
155                        (let ((status (if (string? result) 0
156                                          (or (status:term-sig result) (status:exit-val result)))))
157                          (if (file-exists? log) (store #:add-file log))
158                          (format (current-error-port) "\t[~a]\n"
159                                  (if (or (and signal (= status signal))
160                                          (and exit (= status exit))) "OK"
161                                          (begin (set! %status 1) "FAIL"))))))))))
162
163 (define %version (or (getenv "VERSION") "git"))
164 (define %prefix (or (getenv "PREFIX") ""))
165 (define %datadir "share/mes")
166 (define %docdir "share/doc/mes")
167 (define %moduledir (string-append %datadir "/module"))
168 (define %guiledir (string-append "share/guile/site/" (effective-version)))
169 (define %godir (string-append "lib/guile/" (effective-version) "/site-ccache"))
170
171 (define* (method-cp #:key substitutes)
172   (method (name "INSTALL")
173           (build (lambda (o t)
174                    (let ((file-name (target-file-name t)))
175                      (mkdir-p (dirname file-name))
176                      (format (current-error-port) "  INSTALL\t~a\n" file-name)
177                      (copy-file ((compose target-file-name car target-inputs) t) file-name)
178                      (if substitutes
179                          (begin
180                            (substitute* file-name
181                              (("module/") (string-append %prefix "/" %moduledir "/"))
182                              (("@DATADIR@") (string-append %prefix "/" %datadir "/"))
183                              (("@DOCDIR@") (string-append %prefix "/" %docdir "/"))
184                              (("@GODIR@") (string-append %prefix "/" %godir "/"))
185                              (("@GUILEDIR@") (string-append %prefix "/" %guiledir "/"))
186                              (("@MODULEDIR@") (string-append %prefix "/" %moduledir "/"))
187                              (("@PREFIX@") (string-append %prefix "/"))
188                              (("@VERSION@") %version)))))))))
189
190 (define (hash-target o)
191   (if (find (negate identity) (target-inputs o))
192       (format (current-error-port) "invalid inputs[~s]: ~s\n" (target-file-name o) (target-inputs o)))
193   (let ((inputs (target-inputs o)))
194     (if (null? inputs) (or (target-hash o) (target-hash (store #:add o)))
195         (let ((input-shas (map hash-target inputs)))
196           (and (every identity input-shas)
197                (let ((method (target-method o)))
198                  (string-hash (format #f "~s" (cons* (target-file-name o)
199                                                      (method-build method)
200                                                      (map target-hash (method-inputs method))
201                                                      input-shas)))))))))
202
203 (define (string-hash o)
204   (number->string (hash o (expt 2 31))))
205
206 (define (file-hash o)
207   (string-hash (with-input-from-file o read-string)))
208
209 (define (store-file-name o)
210   (string-append %store-dir "/" (if (string? o) o
211                                     (target-hash o))))
212
213 (define (link-or-cp existing-file new-file)
214   (catch #t
215     (lambda _ (link existing-file new-file))
216     (lambda _ (copy-file existing-file new-file))))
217
218 (define (assert-link existing-file new-file)
219   (if (not (file-exists? new-file)) (link-or-cp existing-file new-file)))
220
221 (define store
222   (let ((*store* '()))
223     (define (prune? o)
224       (let ((t (cdr o)))
225         (pair? (target-inputs t))))
226     (define ((file-name? file-name) o)
227       (let ((t (cdr o)))
228         (equal? (target-file-name t) (target-file-name file-name))))
229     (lambda* (#:key add add-file delete get key print prune)
230       (cond ((and add key) (let ((value (target (inherit add) (hash key))))
231                              (set! *store* (assoc-set! (filter (negate (file-name? add)) *store*) key value))
232                              (let ((file-name (target-file-name value)))
233                                (if (and file-name (file-exists? file-name))
234                                    (assert-link file-name (store-file-name value))))
235                              value))
236             (add (let ((key (if (null? (target-inputs add)) (file-hash (target-file-name add))
237                                 (hash-target add))))
238                    (if (not key) (error "store: no hash for:" add))
239                    (store #:add add #:key key)))
240             (add-file
241              (or (and=> (find (lambda (t) (equal? (target-file-name t) add-file)) (map cdr *store*))
242                         (compose (cut store #:get <>) target-hash))
243                  (and (file-exists? add-file)
244                       (store #:add (target (file-name add-file))))
245                  (error (format #f "store add-file: no such file: ~s\n" add-file))))
246             ((and get key)
247              (or (assoc-ref *store* key)
248                  (let ((store-file (store-file-name key))
249                        (file-name (target-file-name get)))
250                    (and (file-exists? store-file)
251                         (if (file-exists? file-name) (delete-file file-name))
252                         (link-or-cp store-file file-name)
253                         (store #:add get #:key key)))))
254             (get (assoc-ref *store* get))
255             (delete (and (assoc-ref *store* delete)
256                          (set! *store* (filter (lambda (e) (not (equal? (car e) delete))) *store*))))
257             (print (pretty-print (map (lambda (e) (cons (target-file-name (cdr e)) (car e))) *store*)))
258             ((eq? prune 'file-system)
259              (set! *store* (filter prune? *store*)))
260             (else (error "store: dunno"))))))
261
262 (define (build o)
263   (let ((hash (hash-target o)))
264     (or (and hash (store #:get o #:key hash))
265         (begin
266           ;;(format (current-error-port) "must rebuild hash=~s\n" hash)
267           (for-each build (target-inputs o))
268           (let ((method (target-method o)))
269             ((method-build method) method o))
270           (store #:add o #:key hash)))))
271
272 (define* (check name #:key baseline (exit 0) (signal #f) (dependencies '()))
273   (target (file-name (string-append "check-" name))
274           (method method-check)
275           (inputs (cons (get-target name) dependencies))
276           (baseline baseline)
277           (exit exit)
278           (signal signal)))
279
280 (define* (install name #:key (dir (dirname name)) (installed-name (basename name)) (prefix %prefix) substitutes (dependencies '()))
281   (target (file-name (string-append prefix "/" dir "/" installed-name))
282           (method (method-cp #:substitutes substitutes))
283           (inputs (cons (or (get-target name)
284                             (store #:add-file name)) dependencies))))
285
286 (define* (group name #:key (dependencies '()))
287   (target (file-name name)
288           (inputs (map get-target dependencies))))
289
290 (define (target->input-files o)
291   (let ((inputs (target-inputs o)))
292     (if (null? inputs) '()
293         (append (cons (target-file-name o) (target-file-names o)) (append-map target->input-files inputs)))))
294
295 (define* (clean #:optional targets)
296   (for-each
297    delete-file
298    (filter file-exists? (delete-duplicates (append-map (cut target->input-files <>) (or targets %targets))))))
299
300 (define (tree o)
301   (let ((inputs (target-inputs o)))
302     (if (null? inputs) o
303         (cons o (append (map tree inputs) (map tree (method-inputs (target-method o))))))))
304
305
306 (define (verbose fmt . o)
307   ;;(apply format (cons* (current-error-port) fmt o))
308   #t
309   )
310
311 (define* (PATH-search-path name #:key (default name))
312   (or (search-path (string-split (getenv "PATH") #\:) name)
313       (and (format (current-error-port) "warning: not found: ~a\n" name)
314            default)))
315
316 (define %CC (PATH-search-path "gcc"))
317 (define %CC32 (or (PATH-search-path "i686-unknown-linux-gnu-gcc" #:default #f)
318                   (not (format (current-error-port) "warning: CC32 not found, skipping mlibc-gcc targets\n"))))
319 (define %C-FLAGS
320   '("--std=gnu99"
321     "-O0"
322     "-g"
323     "-D"
324     "POSIX=1"
325     "-I" "src"
326     "-I" "mlibc/include"
327     "--include=mlibc/libc-gcc.c"
328     ))
329 (define %C32-FLAGS
330   '("--std=gnu99"
331     "-O0"
332     "-g"
333     "-I" "src"
334     "-I" "mlibc/include"
335     "--include=mlibc/libc-gcc.c"
336     ))
337
338 (define* (CC.gcc #:key (libc #t) (cc (if libc %CC %CC32)) (c-flags (if libc %C-FLAGS %C32-FLAGS)) (defines '()) (includes '()))
339   (method (name "CC.gcc")
340           (build (lambda (o t)
341                    (let* ((input-files (map target-file-name (target-inputs t)))
342                           (command `(,cc
343                                      "-c"
344                                      ,@(append-map (cut list "-D" <>) defines)
345                                      ,@(append-map (cut list "-I" <>) includes)
346                                      ,@(if libc '() '("-nostdinc" "-fno-builtin"))
347                                      ,@c-flags
348                                      "-o" ,(target-file-name t)
349                                      ,@(filter (cut string-suffix? ".c" <>) input-files))))
350                      (format (current-error-port) "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
351                      (apply system** command))))
352           (inputs (list (store #:add-file "mlibc/libc-gcc.c"))))) ;; FIXME: FLAGS
353
354 (define* (CPP.mescc #:key (cc %MESCC) (defines '()) (includes '()))
355   (method (name "CPP.mescc")
356           (build (lambda (o t)
357                    (let ((input-files (map target-file-name (target-inputs t))))
358                      (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
359                      (apply system**
360                             `(,cc
361                               "-E"
362                               ,@(append-map (cut list "-D" <>) defines)
363                               ,@(append-map (cut list "-I" <>) includes)
364                               "-o" ,(target-file-name t)
365                               ,@input-files)))))))
366
367 (define %MESCC "guile/mescc.scm")
368 (define* (CC.mescc #:key (cc %MESCC))
369   (method (name "CC.mescc")
370           (build (lambda (o t)
371                    (let ((input-files (map target-file-name (target-inputs t))))
372                      (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
373                      (apply system**
374                             `("guile/mescc.scm" "-c"
375                               "-o" ,(target-file-name t)
376                               ,@input-files)))))
377           (inputs (list (store #:add-file "guile/language/c99/compiler.go")
378                         (store #:add-file "guile/language/c99/info.go")
379                         (store #:add-file "guile/mes/as.go")
380                         (store #:add-file "guile/mes/as-i386.go")
381                         (store #:add-file "guile/mes/bytevectors.go")
382                         (store #:add-file "guile/mes/M1.go")))))
383
384 (define %M1 (or (PATH-search-path "M1" #:default #f)
385                 (PATH-search-path "M0" #:default #f) ; M1 is in unreleased mescc-tools 0.2
386                 (and (format (current-error-port) "error: no macro assembler found, please install mescc-tools\n")
387                      (exit 1))))
388 (define %M0-FLAGS
389   '("--LittleEndian"))
390 (define %M1-FLAGS
391   '("--LittleEndian"
392     "--Architecture=1"))
393 (if (equal? (basename %M1) "M0")
394     (set! %M1-FLAGS %M0-FLAGS))
395
396 (define* (M1.asm #:key (m1 %M1) (m1-flags %M1-FLAGS))
397   (method (name "M1")
398           (build (lambda (o t)
399                    (let* ((input-files (map target-file-name (target-inputs t)))
400                           (input-files (filter (lambda (f) (string-suffix? "M1" f))
401                                                input-files)))
402                      (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
403                      (with-output-to-file (target-file-name t)
404                        (lambda _
405                          (display
406                           (apply assert-gulp-pipe*
407                                  `(,m1
408                                    "-f"
409                                    "stage0/x86.M1"
410                                    ,@(append-map (cut list "-f" <>) input-files)
411                                    ,@m1-flags)))
412                          (newline))))))
413           (inputs (list (store #:add-file "stage0/x86.M1")))))
414
415 (define %HEX2-FLAGS
416   '("--LittleEndian"
417     "--Architecture=1"
418     "--BaseAddress=0x1000000"))
419 (define %HEX2 (PATH-search-path "hex2"))
420
421 (define* (LINK.hex2 #:key (hex2 %HEX2) (hex2-flags %HEX2-FLAGS) debug?)
422   (method (name "LINK.hex2")
423           (build (lambda (o t)
424                    (let* ((input-files (map target-file-name (target-inputs t)))
425                           ;; FIXME: snarf inputs
426                           (input-files (filter (lambda (f) (string-suffix? "hex2" f))
427                                                input-files)))
428                      (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
429                      (with-output-to-file (target-file-name t)
430                        (lambda _
431                          (set-port-encoding! (current-output-port) "ISO-8859-1")
432                          (display
433                           (apply assert-gulp-pipe*
434                                  `(,hex2
435                                    ,@hex2-flags
436                                    "-f"
437                                    ,(if (not debug?) "stage0/elf32-0header.hex2"
438                                         "stage0/elf32-header.hex2")
439                                    ,@(append-map (cut list "-f" <>) input-files)
440                                    "-f"
441                                    ,(if (not debug?) "stage0/elf-0footer.hex2"
442                                         "stage0/elf32-footer-single-main.hex2"))))))
443                      (chmod (target-file-name t) #o755))))
444           (inputs (list (store #:add-file "stage0/elf32-0header.hex2")
445                         (store #:add-file "stage0/elf-0footer.hex2")))))
446
447 (define* (LINK.gcc #:key (cc %CC) (c-flags %C-FLAGS) (libc #t))
448   (method (name "LINK.gcc")
449           (build (lambda (o t)
450                    (let* ((input-files (map target-file-name (target-inputs t)))
451                           (command `(,cc
452                                      ,@c-flags
453                                      ,@(if libc '() '("-nostdlib"))
454                                      "-o"
455                                      ,(target-file-name t)
456                                      ,@input-files)))
457                      (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
458                      (apply system** command))))))
459
460 (define SNARF "build-aux/mes-snarf.scm")
461 (define (SNARF.mes mes?)
462   (method (name "SNARF.mes")
463           (build (lambda (o t)
464                    (let* ((input-files (map target-file-name (target-inputs t)))
465                           (command `(,SNARF
466                                      ,@(if mes? '("--mes") '())
467                                      ,@input-files)))
468                      (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
469                      (apply system** command))))))
470
471 (define* (cpp.mescc input-file-name #:key (cc %MESCC) (defines '()) (includes '()) (dependencies '()))
472   (let* ((c-target (target (file-name input-file-name)))
473          (base-name (base-name input-file-name ".c"))
474          (suffix ".E")
475          (target-file-name (string-append base-name suffix)))
476     (target (file-name target-file-name)
477             (inputs (cons c-target dependencies))
478             (method (CPP.mescc #:cc cc #:defines defines #:includes includes)))))
479
480 (define mini-libc-mes.E (cpp.mescc "mlibc/mini-libc-mes.c"))
481 (define libc-mes.E (cpp.mescc "mlibc/libc-mes.c"))
482
483 (define* (compile.gcc input-file-name #:key (libc #t) (cc (if libc %CC %CC32)) (defines '()) (includes '()) (dependencies '()))
484   (let* ((base-name (base-name input-file-name ".c"))
485          (cross (if libc "" "mlibc-"))
486          (suffix (string-append "." cross "o"))
487          (target-file-name (string-append base-name suffix))
488          (c-target (target (file-name input-file-name))))
489     (target (file-name target-file-name)
490             (inputs (cons c-target dependencies))
491             (method (CC.gcc #:cc cc #:libc libc #:defines defines #:includes includes)))))
492
493 (define* (compile.mescc input-file-name #:key (cc %MESCC) (libc libc-mes.E) (defines '()) (includes '()) (dependencies '()))
494   (let* ((base-name (base-name input-file-name ".c"))
495          ;;(foo (format (current-error-port) "COMPILE[~s .c] base=~s\n" input-file-name base-name))
496          (suffix (cond ((not libc) ".0-M1")
497                        ((eq? libc libc-mes.E) ".M1")
498                        (else ".mini-M1")))
499          (target-file-name (string-append base-name suffix))
500          (E-target (cpp.mescc input-file-name #:cc cc #:defines defines #:includes includes #:dependencies dependencies)))
501     (target (file-name target-file-name)
502             (inputs `(,@(if libc (list libc) '()) ,E-target))
503             (method (CC.mescc #:cc cc)))))
504
505 (define* (m1-asm input-file-name #:key (cc %MESCC) (m1 %M1) (libc libc-mes.E) (defines '()) (includes '()) (dependencies '()))
506   (let* ((base-name (base-name input-file-name ".c"))
507          ;;(foo (format (current-error-port) "m1-asm[~s .m1] base=~s\n" input-file-name base-name))
508          (suffix (cond ((not libc) ".0-hex2")
509                        ((eq? libc libc-mes.E) ".hex2")
510                        (else ".mini-hex2")))
511          (target-file-name (string-append base-name suffix))
512          (m1-target (compile.mescc input-file-name #:cc cc #:libc libc #:defines defines #:includes includes #:dependencies dependencies))
513          (libc.m1 (cond ((eq? libc libc-mes.E)
514                          (compile.mescc "mlibc/libc-mes.c" #:libc #f #:defines defines #:includes includes))
515                         ((eq? libc mini-libc-mes.E)
516                          (compile.mescc "mlibc/mini-libc-mes.c" #:libc #f #:defines defines #:includes includes))
517                         (else #f))))
518     (target (file-name target-file-name)
519             ;;(inputs `(,@(if libc (list libc.m1) '()) ,m1-target))
520             (inputs `(,m1-target))
521             (method (M1.asm #:m1 m1)))))
522
523 (define* (bin.mescc input-file-name #:key (cc %MESCC) (hex2 %HEX2) (m1 %M1) (libc libc-mes.E) (dependencies '()) (defines '()) (includes '()))
524   (let* ((base-name (base-name input-file-name ".c"))
525          ;;(foo (format (current-error-port) "bin[~s .c] base=~s\n" input-file-name base-name))
526          (suffix (cond ((not libc) ".0-guile")
527                        ((eq? libc libc-mes.E) ".guile")
528                        (else ".mini-guile")))
529          (target-file-name (string-append base-name suffix))
530          (hex2-target (m1-asm input-file-name #:m1 m1 #:cc cc #:libc libc #:defines defines #:includes includes #:dependencies dependencies)))
531     (target (file-name target-file-name)
532             (inputs (list hex2-target))
533             (method (LINK.hex2 #:hex2 hex2 #:debug? (eq? libc libc-mes.E))))))
534
535 (define* (bin.gcc input-file-name #:key (libc #t) (cc (if libc %CC %CC32)) (dependencies '()) (defines '()) (includes '()))
536   (and cc
537        (let* ((base-name (base-name input-file-name ".c"))
538           (suffix (if libc ".gcc" ".mlibc-gcc"))
539           (target-file-name (string-append base-name suffix))
540           (o-target (compile.gcc input-file-name #:cc cc #:libc libc #:defines defines #:includes includes #:dependencies dependencies)))
541      (target (file-name target-file-name)
542              (inputs (list o-target))
543              (method (LINK.gcc #:cc cc #:libc libc))))))
544
545 (define* (snarf input-file-name #:key (dependencies '()) (mes? #t))
546   (let* ((base-name (base-name input-file-name ".c"))
547          (suffixes '(".h" ".i" ".environment.i" ".symbol-names.i" ".symbols.i"  ".symbols.h"))
548          (suffixes (if mes? (map (cut string-append ".mes" <>) suffixes) suffixes))
549          (target-file-names (map (cut string-append base-name <>) suffixes))
550          (snarf-target (target (file-name input-file-name))))
551     (target (file-name (car target-file-names))
552             (file-names (cdr target-file-names))
553             (inputs (cons snarf-target dependencies))
554             ;;(inputs (list snarf-target))
555             (method (SNARF.mes mes?)))))
556
557 (define ((target-prefix? prefix) o)
558   (string-prefix? prefix (target-file-name o)))
559
560 (define (check-target? o)
561   (and o ((target-prefix? "check-") o)))
562
563 (define (install-target? o)
564   (and o ((target-prefix? (or (getenv "PREFIX") "/")) o)))
565
566 (define (add-target o)
567   (and o (set! %targets (append %targets (list o))))
568   o)
569 (define (get-target o)
570   (if (target? o) o
571       (find (lambda (t) (equal? (target-file-name t) o)) %targets)))