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