core: display_helper: Display escaped characters.
[mes.git] / make.scm
1 #! /bin/sh
2 # -*- scheme -*-
3 exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$@"}
4 !#
5
6 ;;; Mes --- Maxwell Equations of Software
7 ;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
8 ;;;
9 ;;; This file is part of Mes.
10 ;;;
11 ;;; Mes is free software; you can redistribute it and/or modify it
12 ;;; under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 3 of the License, or (at
14 ;;; your option) any later version.
15 ;;;
16 ;;; Mes is distributed in the hope that it will be useful, but
17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;;; GNU General Public License for more details.
20 ;;;
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
23
24 (use-modules (srfi srfi-26)
25              (guix shell-utils))
26
27 ;; FIXME: .go dependencies
28 ;; workaround: always update .go before calculating hashes
29 ;;(use-modules ((mes make) #:select (sytem**)))
30 (define %scm-files
31   '("guix/make.scm"
32     "guix/records.scm"
33     "guix/shell-utils.scm"
34     "language/c99/compiler.scm"
35     "language/c99/info.scm"
36     "mes/as-i386.scm"
37     "mes/as.scm"
38     "mes/bytevectors.scm"
39     "mes/elf.scm"
40     "mes/guile.scm"
41     "mes/M1.scm"))
42 (define %go-files (map (compose (cut string-append <> ".go") (cut string-drop-right <> 4)) %scm-files))
43 (setenv "srcdir" ".")
44 (setenv "host" %host-type)
45 (with-directory-excursion "guile"
46   (apply system* `("guile"
47                    "--no-auto-compile"
48                    "-L" "."
49                    "-C" "."
50                    "-s"
51                    "../build-aux/compile-all.scm"
52                    ,@%scm-files)))
53
54 (use-modules (srfi srfi-1)
55              (ice-9 curried-definitions)
56              (ice-9 match)
57              (guix make))
58
59 (define crt1.hex2 (m1.as "lib/crt1.c"))
60 (add-target crt1.hex2)
61
62 (add-target crt1.mlibc-o)
63
64 (define %HEX2-FLAGS
65   '("--LittleEndian"
66     "--Architecture=1"
67     "--BaseAddress=0x1000000"))
68 (define %HEX2 (PATH-search-path "hex2"))
69
70 (define* (LINK.hex2 #:key (hex2 %HEX2) (hex2-flags %HEX2-FLAGS) (crt1 crt1.hex2) (libc libc-mes.hex2) debug?)
71   (method (name "LINK.hex2")
72           (build (lambda (o t)
73                    (let* ((input-files (map target-file-name (target-inputs t)))
74                           ;; FIXME: snarf inputs
75                           (input-files (filter (lambda (f) (and (string-suffix? "hex2" f)
76                                                                 (not (member f (cdr input-files)))))
77                                                input-files)))
78                      (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
79                      (with-output-to-file (target-file-name t)
80                        (lambda _
81                          (set-port-encoding! (current-output-port) "ISO-8859-1")
82                          (display
83                           (apply assert-gulp-pipe*
84                                  `(,hex2
85                                    ,@hex2-flags
86                                    "-f"
87                                    ,(if (not debug?) "stage0/elf32-0header.hex2"
88                                         "stage0/elf32-header.hex2")
89                                    ,@(if crt1 `("-f" ,(target-file-name crt1)) '())
90                                    ,@(if libc `("-f" ,(target-file-name libc)) '())
91                                    ,@(append-map (cut list "-f" <>) input-files)
92                                    "-f"
93                                    ,(if (not debug?) "stage0/elf-0footer.hex2"
94                                         "stage0/elf32-footer-single-main.hex2"))))))
95                      (chmod (target-file-name t) #o755))))
96           (inputs `(,(store #:add-file "stage0/elf32-0header.hex2")
97                     ,@(if crt1 (target-inputs crt1) '())
98                     ,@(if libc (target-inputs libc) '())
99                     ,(store #:add-file "stage0/elf-0footer.hex2")))))
100
101 (define* (bin.mescc input-file-name #:key (cc %MESCC) (hex2 %HEX2) (m1 %M1) (crt1 crt1.hex2) (libc libc-mes.hex2) (dependencies '()) (defines '()) (includes '()))
102   (let* ((base-name (base-name input-file-name ".c"))
103          ;;(foo (format (current-error-port) "bin[~s .c] base=~s\n" input-file-name base-name))
104          (suffix (cond ((not libc) ".0-guile")
105                        ((eq? libc libc-mes.hex2) ".guile")
106                        ((eq? libc libc+tcc-mes.hex2) ".tcc-guile")
107                        (else ".mini-guile")))
108          (target-file-name (string-append base-name suffix))
109          (hex2-target (m1.as input-file-name #:m1 m1 #:cc cc #:defines defines #:includes includes #:dependencies dependencies)))
110     (target (file-name target-file-name)
111             (inputs `(,hex2-target
112                       ,@(if crt1 (list crt1) '())
113                       ,@(if libc (list libc) '())))
114             (method (LINK.hex2 #:hex2 hex2 #:crt1 crt1 #:libc libc #:debug? (eq? libc libc-mes.hex2))))))
115
116 ;;(define mini-libc-mes.E (m1.as "lib/mini-libc-mes.c"))
117
118 (define libc-mes.hex2 (m1.as "lib/libc-mes.c"))
119 (add-target libc-mes.hex2)
120
121 (define mini-libc-mes.hex2 (m1.as "lib/mini-libc-mes.c"))
122 (add-target mini-libc-mes.hex2)
123
124 (define libc+tcc-mes.hex2 (m1.as "lib/libc+tcc-mes.c"))
125 (add-target libc+tcc-mes.hex2)
126
127 (add-target (bin.mescc "stage0/exit-42.c" #:libc #f))
128 (add-target (check "stage0/exit-42.0-guile" #:exit 42))
129
130 (add-target (cpp.mescc "lib/mini-libc-mes.c"))
131 (add-target (compile.mescc "lib/mini-libc-mes.c"))
132
133 (add-target (bin.mescc "stage0/exit-42.c" #:libc mini-libc-mes.hex2))
134 (add-target (check "stage0/exit-42.mini-guile" #:exit 42))
135
136 (add-target (cpp.mescc "lib/libc-mes.c"))
137 (add-target (compile.mescc "lib/libc-mes.c"))
138
139 (add-target (bin.mescc "stage0/exit-42.c"))
140 (add-target (check "stage0/exit-42.guile" #:exit 42))
141
142 (define* (add-scaffold-test name #:key (exit 0) (libc libc-mes.hex2) (libc-gcc libc-gcc.mlibc-o) (includes '()))
143   (add-target (bin.gcc (string-append "scaffold/tests/" name ".c") #:libc libc-gcc #:includes includes))
144   (add-target (check (string-append "scaffold/tests/" name ".mlibc-gcc") #:exit exit))
145
146   (add-target (bin.mescc (string-append "scaffold/tests/" name ".c") #:libc libc #:includes includes))
147   (add-target (check (string-append "scaffold/tests/" name "." (cond ((not libc) "0-")
148                                                                      ((eq? libc mini-libc-mes.hex2) "mini-")
149                                                                      ((eq? libc libc+tcc-mes.hex2) "tcc-")
150                                                                      (else "")) "guile") #:exit exit)))
151
152 (add-target (compile.gcc "lib/crt1.c" #:libc #f))
153 (add-target (compile.gcc "lib/libc-gcc.c" #:libc #f))
154 (add-target (compile.gcc "lib/libc+tcc-gcc.c" #:libc #f))
155 ;;(add-target (compile.gcc "lib/libc+tcc-mes.c" #:libc #f))
156
157 ;;(add-scaffold-test "t" #:libc mini-libc-mes.hex2)
158 (add-scaffold-test "t")
159 ;;(add-scaffold-test "t" #:libc libc+tcc-mes.hex2)
160
161 ;; tests/00: exit, functions without libc
162 (add-scaffold-test "00-exit-0" #:libc #f)
163 (add-scaffold-test "01-return-0" #:libc #f)
164 (add-scaffold-test "02-return-1" #:libc #f #:exit 1)
165 (add-scaffold-test "03-call" #:libc #f)
166 (add-scaffold-test "04-call-0" #:libc #f)
167 (add-scaffold-test "05-call-1" #:libc #f #:exit 1)
168 (add-scaffold-test "06-call-!1" #:libc #f)
169 (add-scaffold-test "07-include" #:libc #f #:includes '("scaffold/tests") #:exit 42)
170
171 (add-target (group "check-scaffold-tests/0" #:dependencies (filter (target-prefix? "check-scaffold/tests/0") %targets)))
172
173 ;; tests/10: control without libc
174 (for-each
175  (cut add-scaffold-test <> #:libc #f)
176  '("10-if-0"
177    "11-if-1"
178    "12-if-=="
179    "13-if-!="
180    "14-if-goto"
181    "15-if-!f"
182    "16-if-t"))
183
184 (add-target (group "check-scaffold-tests/1" #:dependencies (filter (target-prefix? "check-scaffold/tests/1") %targets)))
185
186 ;; tests/20: loop without libc
187 (for-each
188  (cut add-scaffold-test <> #:libc #f)
189  '("20-while"
190    "21-char[]"
191    "22-while-char[]"
192    "23-pointer"))
193
194 (add-target (group "check-scaffold-tests/2" #:dependencies (filter (target-prefix? "check-scaffold/tests/2") %targets)))
195
196 ;; tests/30: call, compare: mini-libc-mes.c
197 (for-each
198  (cut add-scaffold-test <> #:libc mini-libc-mes.hex2)
199  '("30-strlen"
200    "31-eputs"
201    "32-compare"
202    "33-and-or"
203    "34-pre-post"
204    "35-compare-char"
205    "36-compare-arithmetic"
206    "37-compare-assign"
207    "38-compare-call"))
208
209 (add-target (group "check-scaffold-tests/3" #:dependencies (filter (target-prefix? "check-scaffold/tests/3") %targets)))
210
211 ;; tests/40: control: mini-libc-mes.c
212 (for-each
213  (cut add-scaffold-test <> #:libc mini-libc-mes.hex2)
214  '("40-if-else"
215    "41-?"
216    "42-goto-label"
217    "43-for-do-while"
218    "44-switch"
219    "45-void-call"))
220
221 (add-target (group "check-scaffold-tests/4" #:dependencies (filter (target-prefix? "check-scaffold/tests/4") %targets)))
222
223 ;; tests/50: libc-mes.c
224 (for-each
225  add-scaffold-test
226  '("50-assert"
227    "51-strcmp"
228    "52-itoa"
229    "54-argv"))
230
231 (add-target (group "check-scaffold-tests/5" #:dependencies (filter (target-prefix? "check-scaffold/tests/5") %targets)))
232
233 ;; tests/60: building up to scaffold/m.c, scaffold/micro-mes.c
234 (for-each
235  add-scaffold-test
236  '("60-math"
237    "61-array"
238    "63-struct-cell"
239    "64-make-cell"
240    "65-read"
241    "66-local-char-array"))
242
243 (add-target (group "check-scaffold-tests/6" #:dependencies (filter (target-prefix? "check-scaffold/tests/6") %targets)))
244
245 ;; tests/70: and beyond src/mes.c -- building up to 8cc.c, pcc.c, tcc.c, libguile/eval.c
246 (for-each
247  add-scaffold-test
248  '("70-printf"
249    "71-struct-array"
250    "72-typedef-struct-def"
251    "73-union"
252    "74-multi-line-string"
253    "75-struct-union"
254    "76-pointer-arithmetic"
255    "77-pointer-assign"
256    "78-union-struct"
257    "79-int-array"
258    "7a-struct-char-array"
259    "7b-struct-int-array"
260    "7c-dynarray"
261    "7d-cast-char"
262    "7e-struct-array-access"
263    "7f-struct-pointer-arithmetic"
264    "7g-struct-byte-word-field"
265    "7h-struct-assign"
266    "7i-struct-struct"
267    "7j-strtoull"
268    "7k-for-each-elem"
269    "7l-struct-any-size-array"
270    "7m-struct-char-array-assign"
271    "7n-struct-struct-array"))
272
273 (add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
274
275 (add-target (group "check-scaffold-tests" #:dependencies (filter (target-prefix? "check-scaffold/tests") %targets)))
276
277 ;; tests/80: and beyond tinycc; building GNU GCC and dependencies
278 (for-each
279  (cut add-scaffold-test <> #:libc libc+tcc-mes.hex2 #:libc-gcc libc+tcc-gcc.mlibc-o)
280  '("80-setjmp"
281    "81-qsort"
282    "82-define"))
283
284 (add-target (group "check-scaffold-tests/8" #:dependencies (filter (target-prefix? "check-scaffold/tests/8") %targets)))
285
286 (add-target (group "check-scaffold-tests" #:dependencies (filter (target-prefix? "check-scaffold/tests") %targets)))
287
288 (add-target (cpp.mescc "lib/libc+tcc-mes.c"))
289 (add-target (compile.mescc "lib/libc+tcc-mes.c"))
290
291 (define* (add-tcc-test name)
292   (add-target (bin.gcc (string-append "scaffold/tinycc/" name ".c") #:libc libc-gcc.mlibc-o #:includes '("scaffold/tinycc")))
293   (add-target (check (string-append "scaffold/tinycc/" name ".mlibc-gcc") #:baseline (string-append "scaffold/tinycc/" name ".expect")))
294
295   (add-target (bin.mescc (string-append "scaffold/tinycc/" name ".c") #:includes '("scaffold/tinycc")))
296   (add-target (check (string-append "scaffold/tinycc/" name ".guile") #:baseline (string-append "scaffold/tinycc/" name ".expect"))))
297 (map
298  add-tcc-test
299  '("00_assignment"
300    "01_comment"
301    "02_printf"
302    "03_struct"
303    "04_for"
304    "05_array"
305    "06_case"
306    "07_function"
307    "08_while"
308    "09_do_while"
309
310    "10_pointer"
311    "11_precedence"
312    "12_hashdefine"
313    "13_integer_literals"
314    "14_if"
315    "15_recursion"
316    "16_nesting"
317    "17_enum"
318    "18_include"
319    "19_pointer_arithmetic"
320
321    "20_pointer_comparison"
322    "21_char_array"
323    ;;"22_floating_point"       ; float
324    ;;"23_type_coercion"        ; float
325    ;;"24_math_library"         ; float
326    "25_quicksort"
327    ;;"27_sizeof"               ; float
328    ;;"28_strings"              ; TODO: strncpy strchr strrchr memset memcpy memcmp
329    "29_array_address"
330
331    ;;"30_hanoi"                ; fails with GCC
332    "31_args"
333    ;;"32_led"                  ; unsupported: (decl (decl-spec-list (stor-spec (static)) (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (ident "d") (p-expr (fixed "32"))))))
334    ;;"34_array_assignment"     ; fails with GCC
335    "33_ternary_op"
336    "35_sizeof"
337    ;;"36_array_initialisers"   ; unspported: (decl (decl-spec-list (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (ident "Array") (p-expr (fixed "10"))) (initzer (initzer-list (initzer (p-expr (fixed "12"))) (initzer (p-expr (fixed "34"))) (initzer (p-expr (fixed "56"))) (initzer (p-expr (fixed "78"))) (initzer (p-expr (fixed "90"))) (initzer (p-expr (fixed "123"))) (initzer (p-expr (fixed "456"))) (initzer (p-expr (fixed "789"))) (initzer (p-expr (fixed "8642"))) (initzer (p-expr (fixed "9753"))))))))
338    ;; "37_sprintf"             ; integer formatting unsupported
339    ;;"38_multiple_array_index" ; unspported: (decl (decl-spec-list (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (array-of (ident "a") (p-expr (fixed "4"))) (p-expr (fixed "4"))))))
340    ;;"39_typedef"              ; unsupported: (decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename "MyFunStruct"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "MoreFunThanEver")))))
341
342    ;;"40_stdio"                ; f* functions
343    "41_hashif"
344    ;;"42_function_pointer"     ; f* functions
345    "43_void_param"
346    "44_scoped_declarations"
347    "45_empty_for"           ; unsupported
348    ;;"46_grep"                 ; f* functions
349    "47_switch_return"
350    "48_nested_break"
351    ;;"49_bracket_evaluation"   ; float
352
353    "50_logical_second_arg"
354    ;;"51_static"               ; unsupported: (decl (decl-spec-list (stor-spec (static)) (type-spec (fixed-type "int"))) (init-declr-list (init-declr (ident "fred") (initzer (p-expr (fixed "1234"))))))
355    ;;"52_unnamed_enum"         ; unsupported: (decl (decl-spec-list (stor-spec (typedef)) (type-spec (enum-def (enum-def-list (enum-defn (ident "e")) (enum-defn (ident "f")) (enum-defn (ident "g")))))) (init-declr-list (init-declr (ident "h"))))
356    "54_goto"
357    ;;"55_lshift_type"          ; unsigned
358    ))
359
360 (add-target (group "check-scaffold-tinycc" #:dependencies (filter (target-prefix? "check-scaffold/tinycc") %targets)))
361
362 ;;(add-target (group "check-scaffold" #:dependencies (filter (target-prefix? "check-scaffold") %targets)))
363
364 (add-target (bin.gcc "scaffold/main.c"))
365 (add-target (check "scaffold/main.gcc" #:exit 42))
366
367 (add-target (bin.gcc "scaffold/main.c" #:libc #f))
368 (add-target (check "scaffold/main.mlibc-gcc" #:exit 42))
369
370 (add-target (bin.mescc "scaffold/main.c" #:libc mini-libc-mes.hex2))
371 (add-target (check "scaffold/main.mini-guile" #:exit 42))
372
373 (add-target (bin.mescc "scaffold/main.c"))
374 (add-target (check "scaffold/main.guile" #:exit 42))
375
376
377 (add-target (bin.gcc "scaffold/hello.c"))
378 (add-target (check "scaffold/hello.gcc" #:exit 42))
379
380 (add-target (bin.gcc "scaffold/hello.c" #:libc libc-gcc.mlibc-o))
381 (add-target (check "scaffold/hello.mlibc-gcc" #:exit 42))
382
383 (add-target (bin.mescc "scaffold/hello.c" #:libc mini-libc-mes.hex2))
384 (add-target (check "scaffold/hello.mini-guile" #:exit 42))
385
386 (add-target (bin.mescc "scaffold/hello.c"))
387 (add-target (check "scaffold/hello.guile" #:exit 42))
388
389
390 (add-target (bin.gcc "scaffold/m.c"))
391 (add-target (check "scaffold/m.gcc" #:exit 255))
392
393 (add-target (bin.gcc "scaffold/m.c" #:libc libc-gcc.mlibc-o))
394 (add-target (check "scaffold/m.mlibc-gcc" #:exit 255))
395
396 (add-target (bin.mescc "scaffold/m.c"))
397 (add-target (check "scaffold/m.guile" #:exit 255))
398
399 (add-target (bin.gcc "scaffold/micro-mes.c" #:libc libc-gcc.mlibc-o))
400 (add-target (check "scaffold/micro-mes.mlibc-gcc" #:exit 6)) ; arg1 arg2 arg3 arg4 arg5
401
402 (add-target (bin.mescc "scaffold/micro-mes.c"))
403 (add-target (check "scaffold/micro-mes.guile" #:exit 6)) ; arg1 arg2 arg3 arg4 arg5
404
405 (add-target (group "check-scaffold" #:dependencies (filter (target-prefix? "check-scaffold") %targets)))
406
407 (define snarf-bases
408   '("gc" "lib" "math" "mes" "posix" "reader" "vector"))
409
410 (define bla
411   `(,@(map (cut string-append "src/" <> ".c") snarf-bases)
412     ,@(map (cut string-append "src/" <> ".mes.h") snarf-bases)
413     ,@(map (cut string-append "src/" <> ".mes.i") snarf-bases)
414     ,@(map (cut string-append "src/" <> ".mes.environment.i") snarf-bases)))
415
416 (define gcc-snarf-targets
417   (list
418    (add-target (snarf "src/gc.c" #:mes? #f))
419    (add-target (snarf "src/lib.c" #:mes? #f))
420    (add-target (snarf "src/math.c" #:mes? #f))
421    (add-target (snarf "src/mes.c" #:mes? #f))
422    (add-target (snarf "src/posix.c" #:mes? #f))
423    (add-target (snarf "src/reader.c" #:mes? #f))
424    (add-target (snarf "src/vector.c" #:mes? #f))))
425
426 (define mes-snarf-targets
427   (list
428    (add-target (snarf "src/gc.c"))
429    (add-target (snarf "src/lib.c" #:mes? #t))
430    (add-target (snarf "src/math.c" #:mes? #t))
431    (add-target (snarf "src/mes.c" #:mes? #t))
432    (add-target (snarf "src/posix.c" #:mes? #t))
433    (add-target (snarf "src/reader.c" #:mes? #t))
434    (add-target (snarf "src/vector.c" #:mes? #t))))
435
436 (add-target (bin.gcc "src/mes.c" #:dependencies gcc-snarf-targets
437                      #:defines `("POSIX=1"
438                                  ,(string-append "VERSION=\"" %version "\"")
439                                  ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") %moduledir "/") "\"")
440                                  ,(string-append "PREFIX=\"" %prefix "\""))
441                      #:includes '("src")))
442
443 (add-target (bin.gcc "src/mes.c" #:libc libc-gcc.mlibc-o
444                      #:dependencies mes-snarf-targets
445                      #:defines `(,(string-append "VERSION=\"" %version "\"")
446                                  ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") %moduledir "/") "\"")
447                                  ,(string-append "PREFIX=\"" %prefix "\""))
448                      #:includes '("src")))
449
450 (add-target (bin.mescc "src/mes.c" #:dependencies mes-snarf-targets
451                        #:defines `(,(string-append "VERSION=\"" %version "\"")
452                                    ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") %moduledir "/") "\"")
453                                    ,(string-append "PREFIX=\"" %prefix "\""))
454                        #:includes '("src")))
455
456 (define mes-tests
457   '("tests/boot.test"
458     "tests/read.test"
459     "tests/base.test"
460     "tests/quasiquote.test"
461     "tests/let.test"
462     "tests/closure.test"
463     "tests/scm.test"
464     "tests/display.test"
465     "tests/cwv.test"
466     "tests/math.test"
467     "tests/vector.test"
468     "tests/srfi-1.test"
469     "tests/srfi-13.test"
470     "tests/srfi-14.test"
471     "tests/srfi-16.test"
472     "tests/srfi-43.test"
473     "tests/optargs.test"
474     "tests/fluids.test"
475     "tests/catch.test"
476     "tests/record.test"
477     "tests/getopt-long.test"
478     "tests/guile.test"
479     "tests/syntax.test"
480     "tests/let-syntax.test"
481     "tests/pmatch.test"
482     "tests/match.test"
483     "tests/psyntax.test"
484     ;;sloooowwww/broken?
485     ;;"tests/peg.test"
486     ))
487
488 (define (add-guile-test o)
489   (add-target (target (file-name o)))
490   (add-target (check o)))
491
492 (define (add-mes.gcc-test o)
493   (add-target (target (file-name o)))
494   (add-target (check o #:dependencies (list (get-target "src/mes.mlibc-gcc")))))
495
496 (define (add-mes.guile-test o)
497   (add-target (target (file-name o)))
498   (add-target (check o #:dependencies (list (get-target "src/mes.guile")))))
499
500 (for-each add-guile-test (map (cut string-append <> "-guile") mes-tests))
501
502 ;; takes long, and should always pass if...
503 ;;(for-each add-mes.gcc-test mes-tests)
504
505 ;; ...mes.guile passes :-)
506 (for-each add-mes.guile-test mes-tests)
507
508 (add-target (group "check-tests" #:dependencies (filter (target-prefix? "check-tests/") %targets)))
509
510 ;; FIXME: run tests/base.test
511 (setenv "MES" "src/mes.guile")
512
513 (add-target (install "guile/mescc.scm" #:dir "bin" #:substitutes #t))
514 (add-target (install "scripts/mescc.mes" #:dir "bin" #:substitutes #t))
515 (add-target (install "scripts/repl.mes" #:dir "bin" #:substitutes #t))
516 (define bootstrap? #f)
517 (if bootstrap?
518     (add-target (install "src/mes.mes" #:dir "bin" #:installed-name "mes"))
519     (add-target (install "src/mes.guile" #:dir "bin" #:installed-name "mes")))
520
521 (define* ((install-dir #:key dir) name)
522   (add-target (install name  #:dir (string-append dir "/" (dirname name)))))
523
524 (add-target (install "module/mes/boot-0.scm" #:dir (string-append %moduledir "/mes") #:substitutes #t))
525 (add-target (install "module/language/c99/compiler.mes" #:dir (string-append %moduledir "/language/c99") #:substitutes #t))
526
527 (define %module-dir "share/mes")
528 (for-each
529  (lambda (f)
530    ((install-dir #:dir (string-append %module-dir)) f))
531  '(;;"module/language/c99/compiler.mes"
532    "module/language/c99/compiler.scm"
533    "module/language/c99/info.mes"
534    "module/language/c99/info.scm"
535    "module/language/paren.mes"
536    "module/mes/M1.mes"
537    "module/mes/M1.scm"
538    "module/mes/as-i386.mes"
539    "module/mes/as-i386.scm"
540    "module/mes/as.mes"
541    "module/mes/as.scm"
542    "module/mes/base.mes"
543    "module/mes/boot-0.scm"
544    "module/mes/boot-00.scm"
545    "module/mes/boot-01.scm"
546    "module/mes/boot-02.scm"
547    "module/mes/bytevectors.mes"
548    "module/mes/bytevectors.scm"
549    "module/mes/catch.mes"
550    "module/mes/display.mes"
551    "module/mes/elf.mes"
552    "module/mes/elf.scm"
553    "module/mes/fluids.mes"
554    "module/mes/getopt-long.mes"
555    "module/mes/getopt-long.scm"
556    "module/mes/guile.mes"
557    "module/mes/guile.scm"
558    "module/mes/lalr.mes"
559    "module/mes/lalr.scm"
560    "module/mes/let.mes"
561    "module/mes/match.mes"
562    "module/mes/match.scm"
563    "module/mes/module.mes"
564    "module/mes/optargs.mes"
565    "module/mes/optargs.scm"
566    "module/mes/peg.mes"
567    "module/mes/peg/cache.scm"
568    "module/mes/peg/codegen.scm"
569    "module/mes/peg/simplify-tree.scm"
570    "module/mes/peg/string-peg.scm"
571    "module/mes/peg/using-parsers.scm"
572    "module/mes/pmatch.mes"
573    "module/mes/pmatch.scm"
574    "module/mes/posix.mes"
575    "module/mes/pretty-print.mes"
576    "module/mes/pretty-print.scm"
577    "module/mes/psyntax-0.mes"
578    "module/mes/psyntax-1.mes"
579    "module/mes/psyntax.mes"
580    "module/mes/psyntax.pp"
581    "module/mes/psyntax.ss"
582    "module/mes/quasiquote.mes"
583    "module/mes/quasisyntax.mes"
584    "module/mes/quasisyntax.scm"
585    "module/mes/repl.mes"
586    "module/mes/scm.mes"
587    "module/mes/syntax.mes"
588    "module/mes/syntax.scm"
589    "module/mes/test.mes"
590    "module/mes/tiny-0.mes"
591    "module/mes/type-0.mes"
592    "module/nyacc/lalr.mes"
593    "module/nyacc/lang/c99/cpp.mes"
594    "module/nyacc/lang/c99/parser.mes"
595    "module/nyacc/lang/c99/pprint.mes"
596    "module/nyacc/lang/calc/parser.mes"
597    "module/nyacc/lang/util.mes"
598    "module/nyacc/lex.mes"
599    "module/nyacc/parse.mes"
600    "module/nyacc/util.mes"
601    "module/rnrs/arithmetic/bitwise.mes"
602    "module/srfi/srfi-0.mes"
603    "module/srfi/srfi-1.mes"
604    "module/srfi/srfi-1.scm"
605    "module/srfi/srfi-13.mes"
606    "module/srfi/srfi-14.mes"
607    "module/srfi/srfi-16.mes"
608    "module/srfi/srfi-16.scm"
609    "module/srfi/srfi-26.mes"
610    "module/srfi/srfi-26.scm"
611    "module/srfi/srfi-43.mes"
612    "module/srfi/srfi-9.mes"
613    "module/sxml/xpath.mes"
614    "module/sxml/xpath.scm"))
615
616 (define* ((install-guile-dir #:key dir) name)
617   (add-target (install (string-append "guile/" name) #:dir (string-append dir "/" (dirname name)))))
618
619 (for-each
620  (lambda (f)
621    ((install-guile-dir #:dir (string-append %guiledir)) f))
622  %scm-files)
623
624 (for-each
625  (lambda (f)
626    ((install-guile-dir #:dir (string-append %godir)) f))
627  %go-files)
628
629 (add-target (install "lib/crt1.hex2" #:dir "lib"))
630 (add-target (install "lib/libc-mes.M1" #:dir "lib"))
631 (add-target (install "lib/libc-mes.hex2" #:dir "lib"))
632 (add-target (install "lib/libc+tcc-mes.M1" #:dir "lib"))
633 (add-target (install "lib/libc+tcc-mes.hex2" #:dir "lib"))
634 (add-target (install "lib/mini-libc-mes.M1" #:dir "lib"))
635 (add-target (install "lib/mini-libc-mes.hex2" #:dir "lib"))
636
637 (add-target (install "lib/crt1.mlibc-o" #:dir "lib"))
638 (add-target (install "lib/libc-gcc.mlibc-o" #:dir "lib"))
639 (add-target (install "lib/libc+tcc-gcc.mlibc-o" #:dir "lib"))
640
641 (for-each
642  (lambda (f)
643    ((install-dir #:dir "share/") f))
644  '("include/alloca.h"
645    "include/assert.h"
646    "include/ctype.h"
647    "include/dlfcn.h"
648    "include/errno.h"
649    "include/fcntl.h"
650    "include/features.h"
651    "include/inttypes.h"
652    "include/libgen.h"
653    "include/limits.h"
654    "include/locale.h"
655    "include/math.h"
656    "include/mlibc.h"
657    "include/setjmp.h"
658    "include/signal.h"
659    "include/stdarg.h"
660    "include/stdbool.h"
661    "include/stdint.h"
662    "include/stdio.h"
663    "include/stdlib.h"
664    "include/stdnoreturn.h"
665    "include/string.h"
666    "include/strings.h"
667    "include/sys/cdefs.h"
668    "include/sys/mman.h"
669    "include/sys/stat.h"
670    "include/sys/time.h"
671    "include/sys/timeb.h"
672    "include/sys/types.h"
673    "include/sys/ucontext.h"
674    "include/sys/wait.h"
675    "include/time.h"
676    "include/unistd.h"))
677
678 (for-each
679  (compose add-target (cut install <> #:dir "share/doc/mes"))
680  '("AUTHORS"
681    ;;"ChangeLog"
682    "BOOTSTRAP"
683    "COPYING"
684    "HACKING"
685    "INSTALL"
686    "NEWS"
687    "README"
688    "doc/ANNOUNCE-0.11"))
689
690 (add-target (install "doc/fosdem/fosdem.pdf" #:dir "share/doc/mes"))
691
692 (define (main args)
693   (cond ((member "all-go" args) #t)
694         ((member "clean-go" args) (map delete-file (filter file-exists? %go-files)))
695         ((member "clean" args) (clean))
696         ((member "list" args) (display (string-join (map target-file-name %targets) "\n" 'suffix)))
697         ((member "help" args) (format #t "Usage: ./make.scm [TARGET]...
698
699 Targets:
700     all
701     all-go
702     check
703     clean
704     clean-go
705     help~a
706     install
707     list
708 "
709                                       (string-join (filter (negate (cut string-index <> #\/)) (map target-file-name %targets)) "\n    " 'prefix)))
710         (else
711          (let ((targets (match args
712                           (() (filter (conjoin (negate install-target?)
713                                                (negate check-target?))
714                                       %targets))
715                           ((? (cut member "all" <>)) (filter (conjoin (negate install-target?)
716                                                                       (negate check-target?))
717                                                              %targets))
718                           ((? (cut member "check" <>)) (filter check-target? %targets))
719                           ((? (cut member "install" <>)) (filter install-target? %targets))
720                           (_ (filter-map (cut get-target <>) args)))))
721            ;;((@@ (guix make) store) #:print 0)
722            (for-each build targets)
723            (exit %status)))))
724
725 (main (cdr (command-line)))