3 exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$@"}
6 (use-modules (srfi srfi-26)
9 ;; FIXME: .go dependencies
10 ;; workaround: always update .go before calculating hashes
11 ;;(use-modules ((mes make) #:select (sytem**)))
15 "guix/shell-utils.scm"
16 "language/c99/compiler.scm"
17 "language/c99/info.scm"
24 (define %go-files (map (compose (cut string-append <> ".go") (cut string-drop-right <> 4)) %scm-files))
26 (setenv "host" %host-type)
27 (with-directory-excursion "guile"
28 (apply system* `("guile"
33 "../build-aux/compile-all.scm"
36 (use-modules (srfi srfi-1)
37 (ice-9 curried-definitions)
41 (add-target (bin.mescc "stage0/exit-42.c" #:libc #f))
42 (add-target (check "stage0/exit-42.0-guile" #:signal 11)) ; FIXME: segfault
44 (add-target (cpp.mescc "mlibc/mini-libc-mes.c"))
45 (add-target (compile.mescc "mlibc/mini-libc-mes.c"))
47 (add-target (bin.mescc "stage0/exit-42.c" #:libc mini-libc-mes.E))
48 (add-target (check "stage0/exit-42.mini-guile" #:exit 42))
50 (add-target (cpp.mescc "mlibc/libc-mes.c"))
51 (add-target (compile.mescc "mlibc/libc-mes.c"))
53 (add-target (bin.mescc "stage0/exit-42.c"))
54 (add-target (check "stage0/exit-42.guile" #:exit 42))
56 (define* (add-scaffold-test name #:key (exit 0) (libc libc-mes.E))
57 (add-target (bin.gcc (string-append "scaffold/tests/" name ".c") #:libc #f))
58 (add-target (check (string-append "scaffold/tests/" name ".mlibc-gcc") #:exit exit))
60 (add-target (bin.mescc (string-append "scaffold/tests/" name ".c") #:libc libc))
61 (add-target (check (string-append "scaffold/tests/" name "." (cond ((not libc) "0-")
62 ((eq? libc mini-libc-mes.E) "mini-")
63 (else "")) "guile") #:exit exit)))
65 (add-scaffold-test "t" #:libc mini-libc-mes.E)
66 ;;(add-scaffold-test "t" #:libc libc-mes+tcc.E)
68 ;; tests/00: exit, functions without libc
69 (add-scaffold-test "00-exit-0" #:libc #f)
70 (add-scaffold-test "01-return-0" #:libc #f)
71 (add-scaffold-test "02-return-1" #:libc #f #:exit 1)
72 (add-scaffold-test "03-call" #:libc #f)
73 (add-scaffold-test "04-call-0" #:libc #f)
74 (add-scaffold-test "05-call-1" #:libc #f #:exit 1)
75 (add-scaffold-test "06-call-!1" #:libc #f)
77 (add-target (group "check-scaffold-tests/0" #:dependencies (filter (target-prefix? "check-scaffold/tests/0") %targets)))
79 ;; tests/10: control without libc
81 (cut add-scaffold-test <> #:libc #f)
90 (add-target (group "check-scaffold-tests/1" #:dependencies (filter (target-prefix? "check-scaffold/tests/1") %targets)))
92 ;; tests/20: loop without libc
94 (cut add-scaffold-test <> #:libc #f)
100 (add-target (group "check-scaffold-tests/2" #:dependencies (filter (target-prefix? "check-scaffold/tests/2") %targets)))
102 ;; tests/30: call, compare: mini-libc-mes.c
104 (cut add-scaffold-test <> #:libc mini-libc-mes.E)
111 "36-compare-arithmetic"
115 (add-target (group "check-scaffold-tests/3" #:dependencies (filter (target-prefix? "check-scaffold/tests/3") %targets)))
117 ;; tests/40: control: mini-libc-mes.c
119 (cut add-scaffold-test <> #:libc mini-libc-mes.E)
127 (add-target (group "check-scaffold-tests/4" #:dependencies (filter (target-prefix? "check-scaffold/tests/4") %targets)))
129 ;; tests/50: libc-mes.c
137 (add-target (group "check-scaffold-tests/5" #:dependencies (filter (target-prefix? "check-scaffold/tests/5") %targets)))
139 ;; tests/60: building up to scaffold/m.c, scaffold/micro-mes.c
148 (add-target (group "check-scaffold-tests/6" #:dependencies (filter (target-prefix? "check-scaffold/tests/6") %targets)))
150 ;; tests/70: and beyond src/mes.c -- building up to 8cc.c, pcc.c, tcc.c, libguile/eval.c
155 "72-typedef-struct-def"
157 "74-multi-line-string"
159 "76-pointer-arithmetic"
160 "77-pointer-assign"))
162 (add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
164 (add-target (group "check-scaffold-tests" #:dependencies (filter (target-prefix? "check-scaffold/tests") %targets)))
166 (add-target (cpp.mescc "mlibc/libc-mes+tcc.c"))
167 (add-target (compile.mescc "mlibc/libc-mes+tcc.c"))
169 (define* (add-tcc-test name)
170 (add-target (bin.gcc (string-append "scaffold/tinycc/" name ".c") #:libc #f #:includes '("scaffold/tinycc")))
171 (add-target (check (string-append "scaffold/tinycc/" name ".mlibc-gcc") #:baseline (string-append "scaffold/tinycc/" name ".expect")))
173 (add-target (bin.mescc (string-append "scaffold/tinycc/" name ".c") #:includes '("scaffold/tinycc")))
174 (add-target (check (string-append "scaffold/tinycc/" name ".guile") #:baseline (string-append "scaffold/tinycc/" name ".expect"))))
191 "13_integer_literals"
197 "19_pointer_arithmetic"
199 "20_pointer_comparison"
201 ;;"22_floating_point" ; float
202 ;;"23_type_coercion" ; float
203 ;;"24_math_library" ; float
205 ;;"27_sizeof" ; float
206 ;;"28_strings" ; TODO: strncpy strchr strrchr memset memcpy memcmp
209 ;;"30_hanoi" ; fails with GCC
211 ;;"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"))))))
212 ;;"34_array_assignment" ; fails with GCC
215 ;;"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"))))))))
216 ;; "37_sprintf" ; integer formatting unsupported
217 ;;"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"))))))
218 ;;"39_typedef" ; unsupported: (decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename "MyFunStruct"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "MoreFunThanEver")))))
220 ;;"40_stdio" ; f* functions
222 ;;"42_function_pointer" ; f* functions
224 "44_scoped_declarations"
225 ;; "45_empty_for" ; unsupported
226 ;;"46_grep" ; f* functions
229 ;;"49_bracket_evaluation" ; float
231 "50_logical_second_arg"
232 ;;"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"))))))
233 ;;"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"))))
235 ;;"55_lshift_type" ; unsigned
238 (add-target (group "check-scaffold-tinycc" #:dependencies (filter (target-prefix? "check-scaffold/tinycc") %targets)))
240 ;;(add-target (group "check-scaffold" #:dependencies (filter (target-prefix? "check-scaffold") %targets)))
242 (add-target (bin.gcc "scaffold/hello.c"))
243 (add-target (check "scaffold/hello.gcc" #:exit 42))
245 (add-target (bin.gcc "scaffold/hello.c" #:libc #f))
246 (add-target (check "scaffold/hello.mlibc-gcc" #:exit 42))
248 (add-target (bin.mescc "scaffold/hello.c" #:libc mini-libc-mes.E))
249 (add-target (check "scaffold/hello.mini-guile" #:exit 42))
251 (add-target (bin.mescc "scaffold/hello.c"))
252 (add-target (check "scaffold/hello.guile" #:exit 42))
255 (add-target (bin.gcc "scaffold/m.c"))
256 (add-target (check "scaffold/m.gcc" #:exit 255))
258 (add-target (bin.gcc "scaffold/m.c" #:libc #f))
259 (add-target (check "scaffold/m.mlibc-gcc" #:exit 255))
261 (add-target (bin.mescc "scaffold/m.c"))
262 (add-target (check "scaffold/m.guile" #:exit 255))
264 (add-target (bin.gcc "scaffold/micro-mes.c" #:libc #f))
265 (add-target (check "scaffold/micro-mes.mlibc-gcc" #:exit 6)) ; arg1 arg2 arg3 arg4 arg5
267 (add-target (bin.mescc "scaffold/micro-mes.c"))
268 (add-target (check "scaffold/micro-mes.guile" #:exit 6)) ; arg1 arg2 arg3 arg4 arg5
270 (add-target (group "check-scaffold" #:dependencies (filter (target-prefix? "check-scaffold") %targets)))
273 '("gc" "lib" "math" "mes" "posix" "reader" "vector"))
276 `(,@(map (cut string-append "src/" <> ".c") snarf-bases)
277 ,@(map (cut string-append "src/" <> ".mes.h") snarf-bases)
278 ,@(map (cut string-append "src/" <> ".mes.i") snarf-bases)
279 ,@(map (cut string-append "src/" <> ".mes.environment.i") snarf-bases)))
281 (define gcc-snarf-targets
283 (add-target (snarf "src/gc.c" #:mes? #f))
284 (add-target (snarf "src/lib.c" #:mes? #f))
285 (add-target (snarf "src/math.c" #:mes? #f))
286 (add-target (snarf "src/mes.c" #:mes? #f))
287 (add-target (snarf "src/posix.c" #:mes? #f))
288 (add-target (snarf "src/reader.c" #:mes? #f))
289 (add-target (snarf "src/vector.c" #:mes? #f))))
291 (define mes-snarf-targets
293 (add-target (snarf "src/gc.c"))
294 (add-target (snarf "src/lib.c" #:mes? #t))
295 (add-target (snarf "src/math.c" #:mes? #t))
296 (add-target (snarf "src/mes.c" #:mes? #t))
297 (add-target (snarf "src/posix.c" #:mes? #t))
298 (add-target (snarf "src/reader.c" #:mes? #t))
299 (add-target (snarf "src/vector.c" #:mes? #t))))
301 (add-target (bin.gcc "src/mes.c" #:dependencies gcc-snarf-targets
302 #:defines `("FIXED_PRIMITIVES=1"
305 ,(string-append "VERSION=\"" %version "\"")
306 ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") %moduledir "/") "\"")
307 ,(string-append "PREFIX=\"" %prefix "\""))
308 #:includes '("src")))
310 (add-target (bin.gcc "src/mes.c" #:libc #f
311 #:dependencies mes-snarf-targets
312 #:defines `("FIXED_PRIMITIVES=1"
314 ,(string-append "VERSION=\"" %version "\"")
315 ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") "/" %moduledir "/") "\"")
316 ,(string-append "PREFIX=\"" %prefix "\""))
317 #:includes '("src")))
319 (add-target (bin.mescc "src/mes.c" #:dependencies mes-snarf-targets
320 #:defines `("FIXED_PRIMITIVES=1"
322 ,(string-append "VERSION=\"" %version "\"")
323 ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") %moduledir "/") "\"")
324 ,(string-append "PREFIX=\"" %prefix "\""))
325 #:includes '("src")))
331 "tests/quasiquote.test"
346 "tests/let-syntax.test"
354 (define (add-mes.gcc-test o)
355 (add-target (target (file-name o)))
356 (add-target (check o #:dependencies (list (get-target "src/mes.mlibc-gcc")))))
358 (define (add-mes.guile-test o)
359 (add-target (target (file-name o)))
360 (add-target (check o #:dependencies (list (get-target "src/mes.guile")))))
362 ;; takes long, and should always pass if...
363 ;;(for-each add-mes.gcc-test mes-tests)
365 ;; ...mes.guile passes :-)
366 (for-each add-mes.guile-test mes-tests)
368 ;; FIXME: run tests/base.test
369 (setenv "MES" "src/mes.guile")
371 (add-target (install "guile/mescc.scm" #:dir "bin" #:substitutes #t))
372 (add-target (install "scripts/mescc.mes" #:dir "bin" #:substitutes #t))
373 (add-target (install "scripts/repl.mes" #:dir "bin" #:substitutes #t))
374 (define bootstrap? #f)
376 (add-target (install "src/mes.mes" #:dir "bin" #:installed-name "mes"))
377 (add-target (install "src/mes.guile" #:dir "bin" #:installed-name "mes")))
379 (define* ((install-dir #:key dir) name)
380 (add-target (install name #:dir (string-append dir "/" (dirname name)))))
382 (add-target (install "module/mes/base-0.mes" #:dir (string-append %moduledir "/mes") #:substitutes #t))
383 (add-target (install "module/language/c99/compiler.mes" #:dir (string-append %moduledir "/language/c99") #:substitutes #t))
385 (define %module-dir "share/mes")
388 ((install-dir #:dir (string-append %module-dir)) f))
389 '("module/language/c99/compiler.mes"
390 "module/language/c99/compiler.scm"
391 "module/language/c99/info.mes"
392 "module/language/c99/info.scm"
393 "module/language/paren.mes"
396 "module/mes/as-i386.mes"
397 "module/mes/as-i386.scm"
400 ;;"module/mes/base-0.mes"
401 "module/mes/base.mes"
402 "module/mes/bytevectors.mes"
403 "module/mes/bytevectors.scm"
404 "module/mes/catch.mes"
405 "module/mes/display.mes"
408 "module/mes/fluids.mes"
409 "module/mes/getopt-long.mes"
410 "module/mes/getopt-long.scm"
411 "module/mes/guile.mes"
412 "module/mes/lalr.mes"
413 "module/mes/lalr.scm"
415 "module/mes/match.mes"
416 "module/mes/match.scm"
417 "module/mes/optargs.mes"
418 "module/mes/optargs.scm"
420 "module/mes/peg/cache.scm"
421 "module/mes/peg/codegen.scm"
422 "module/mes/peg/simplify-tree.scm"
423 "module/mes/peg/string-peg.scm"
424 "module/mes/peg/using-parsers.scm"
425 "module/mes/pmatch.mes"
426 "module/mes/pmatch.scm"
427 "module/mes/posix.mes"
428 "module/mes/pretty-print.mes"
429 "module/mes/pretty-print.scm"
430 "module/mes/psyntax-0.mes"
431 "module/mes/psyntax-1.mes"
432 "module/mes/psyntax.mes"
433 "module/mes/psyntax.pp"
434 "module/mes/psyntax.ss"
435 "module/mes/quasiquote.mes"
436 "module/mes/quasisyntax.mes"
437 "module/mes/quasisyntax.scm"
438 "module/mes/read-0.mes"
439 "module/mes/record-0.mes"
440 "module/mes/record.mes"
441 "module/mes/repl.mes"
443 "module/mes/syntax.mes"
444 "module/mes/syntax.scm"
445 "module/mes/test.mes"
446 "module/mes/tiny-0.mes"
447 "module/mes/type-0.mes"
448 "module/nyacc/lalr.mes"
449 "module/nyacc/lang/c99/cpp.mes"
450 "module/nyacc/lang/c99/parser.mes"
451 "module/nyacc/lang/calc/parser.mes"
452 "module/nyacc/lang/util.mes"
453 "module/nyacc/lex.mes"
454 "module/nyacc/parse.mes"
455 "module/nyacc/util.mes"
456 "module/rnrs/arithmetic/bitwise.mes"
457 "module/srfi/srfi-0.mes"
458 "module/srfi/srfi-1.mes"
459 "module/srfi/srfi-1.scm"
460 "module/srfi/srfi-13.mes"
461 "module/srfi/srfi-14.mes"
462 "module/srfi/srfi-16.mes"
463 "module/srfi/srfi-16.scm"
464 "module/srfi/srfi-26.mes"
465 "module/srfi/srfi-26.scm"
466 "module/srfi/srfi-43.mes"
467 "module/srfi/srfi-9-psyntax.mes"
468 "module/srfi/srfi-9.mes"
469 "module/srfi/srfi-9.scm"
470 "module/sxml/xpath.mes"
471 "module/sxml/xpath.scm"))
473 (define* ((install-guile-dir #:key dir) name)
474 (add-target (install (string-append "guile/" name) #:dir (string-append dir "/" (dirname name)))))
478 ((install-guile-dir #:dir (string-append %guiledir)) f))
483 ((install-guile-dir #:dir (string-append %godir)) f))
486 (add-target (install "mlibc/libc-mes.E" #:dir "lib"))
487 (add-target (install "mlibc/libc-mes.M1" #:dir "lib"))
488 (add-target (install "mlibc/libc-mes+tcc.E" #:dir "lib"))
489 (add-target (install "mlibc/libc-mes+tcc.M1" #:dir "lib"))
490 (add-target (install "mlibc/mini-libc-mes.E" #:dir "lib"))
491 (add-target (install "mlibc/mini-libc-mes.M1" #:dir "lib"))
495 ((install-dir #:dir "share/") f))
496 '("mlibc/include/alloca.h"
497 "mlibc/include/assert.h"
498 "mlibc/include/ctype.h"
499 "mlibc/include/dlfcn.h"
500 "mlibc/include/errno.h"
501 "mlibc/include/fcntl.h"
502 "mlibc/include/features.h"
503 "mlibc/include/inttypes.h"
504 "mlibc/include/libgen.h"
505 "mlibc/include/limits.h"
506 "mlibc/include/locale.h"
507 "mlibc/include/math.h"
508 "mlibc/include/mlibc.h"
509 "mlibc/include/setjmp.h"
510 "mlibc/include/signal.h"
511 "mlibc/include/stdarg.h"
512 "mlibc/include/stdbool.h"
513 "mlibc/include/stdint.h"
514 "mlibc/include/stdio.h"
515 "mlibc/include/stdlib.h"
516 "mlibc/include/stdnoreturn.h"
517 "mlibc/include/string.h"
518 "mlibc/include/strings.h"
519 "mlibc/include/sys/cdefs.h"
520 "mlibc/include/sys/mman.h"
521 "mlibc/include/sys/stat.h"
522 "mlibc/include/sys/time.h"
523 "mlibc/include/sys/timeb.h"
524 "mlibc/include/sys/types.h"
525 "mlibc/include/sys/ucontext.h"
526 "mlibc/include/sys/wait.h"
527 "mlibc/include/time.h"
528 "mlibc/include/unistd.h"))
531 (compose add-target (cut install <> #:dir "share/doc/mes"))
541 (add-target (install "doc/fosdem/fosdem.pdf" #:dir "share/doc/mes"))
544 (cond ((member "all-go" args) #t)
545 ((member "clean-go" args) (map delete-file (filter file-exists? %go-files)))
546 ((member "clean" args) (clean))
547 ((member "list" args) (display (string-join (map target-file-name %targets) "\n" 'suffix)))
548 ((member "help" args) (format #t "Usage: ./make.scm [TARGET]...
560 (string-join (filter (negate (cut string-index <> #\/)) (map target-file-name %targets)) "\n " 'prefix)))
562 (let ((targets (match args
563 (() (filter (negate check-target?) %targets))
564 ((? (cut member "all" <>)) (filter (conjoin (negate install-target?)
565 (negate check-target?))
567 ((? (cut member "check" <>)) (filter check-target? %targets))
568 ((? (cut member "install" <>)) (filter install-target? %targets))
569 (_ (filter-map (cut get-target <>) args)))))
570 (for-each build targets)
571 ;;((@@ (mes make) store) #:print 0)
574 (main (cdr (command-line)))