artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

build: Add make install.

Browse source 
* guile/guix/make.scm (method-cp, install, install-target?): New functions.
* make.scm: Use them.
This commit is contained in:
Jan Nieuwenhuizen 2017-07-19 23:47:23 +02:00
parent a7b7297ee2
commit 2de207076b
5 changed files with 404 additions and 98 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
GNUmakefile
View file

@ -3,7 +3,10 @@ GUILE_FLAGS:=--no-auto-compile -L . -L guile -C . -C guile
include .config.make include .config.make
PHONY_TARGETS:= all all-go check clean clean-go default help list export PREFIX
export VERSION
PHONY_TARGETS:= all all-go check clean clean-go default help install list
.PHONY: $(PHONY_TARGETS) .PHONY: $(PHONY_TARGETS)
$(PHONY_TARGETS): $(PHONY_TARGETS):

76
guile/guix/make.scm
View file

@ -43,8 +43,10 @@
check check
clean clean
group group
install
target-prefix? target-prefix?
check-target? check-target?
install-target?
cpp.mescc cpp.mescc
compile.mescc compile.mescc
@ -59,12 +61,21 @@
add-target add-target
get-target get-target
conjoin
system** system**
target-file-name target-file-name
target target
%targets %targets
%status)) %status
%version
%prefix
%datadir
%docdir
%moduledir
%guiledir
%godir))
(define %status 0) (define %status 0)
(define %targets '()) (define %targets '())
@ -75,9 +86,15 @@
(define (base-name file-name suffix) (define (base-name file-name suffix)
(string-drop-right file-name (string-length suffix))) (string-drop-right file-name (string-length suffix)))
(define (conjoin . predicates)
(lambda (. arguments)
(every (cut apply <> arguments) predicates)))
(define (system** . command) (define (system** . command)
(format %command-log "~a\n" (string-join command " ")) (format %command-log "~a\n" (string-join command " "))
(apply system* command)) (unless (zero? (apply system* command))
(format (current-error-port) "FAILED:~s\n" command)
(exit 1)))
(define (gulp-pipe* . command) (define (gulp-pipe* . command)
(let* ((port (apply open-pipe* (cons OPEN_READ command))) (let* ((port (apply open-pipe* (cons OPEN_READ command)))
@ -130,19 +147,46 @@
(format (current-error-port) " CHECK\t~a" (basename file-name)) (format (current-error-port) " CHECK\t~a" (basename file-name))
(receive (output result) (receive (output result)
;; FIXME: quiet MES tests are not fun ;; FIXME: quiet MES tests are not fun
(if (string-prefix? "tests/" run) (values #f (system** run "arg1" "arg2" "arg3" "arg4" "arg5")) (if (string-prefix? "tests/" run) (values #f (system* run "arg1" "arg2" "arg3" "arg4" "arg5"))
(gulp-pipe* run "arg1" "arg2" "arg3" "arg4" "arg5")) (gulp-pipe* run "arg1" "arg2" "arg3" "arg4" "arg5"))
(if (file-exists? log) (delete-file log)) (if (file-exists? log) (delete-file log))
(if (or baseline (and output (not (string-null? output)))) (with-output-to-file log (lambda _ (display output)))) (if (or baseline (and output (not (string-null? output)))) (with-output-to-file log (lambda _ (display output))))
(if baseline (set! result (system* "diff" "-bu" baseline log))) (if baseline (set! result (system* "diff" "-bu" baseline log)))
(let ((status (if (string? result) 0 (let ((status (if (string? result) 0
(or (status:term-sig result) (status:exit-val result))))) (or (status:term-sig result) (status:exit-val result)))))
(store #:add-file log) (if (file-exists? log) (store #:add-file log))
(format (current-error-port) "\t[~a]\n" (format (current-error-port) "\t[~a]\n"
(if (or (and signal (= status signal)) (if (or (and signal (= status signal))
(and exit (= status exit))) "OK" (and exit (= status exit))) "OK"
(begin (set! %status 1) "FAIL")))))))))) (begin (set! %status 1) "FAIL"))))))))))
(define %version (or (getenv "VERSION") "git"))
(define %prefix (or (getenv "PREFIX") ""))
(define %datadir "share/mes")
(define %docdir "share/doc/mes")
(define %moduledir (string-append %datadir "/module"))
(define %guiledir (string-append "share/guile/site/" (effective-version)))
(define %godir (string-append "lib/guile/" (effective-version) "/site-ccache"))
(define* (method-cp #:key substitutes)
(method (name "INSTALL")
(build (lambda (o t)
(let ((file-name (target-file-name t)))
(mkdir-p (dirname file-name))
(format (current-error-port) " INSTALL\t~a\n" file-name)
(copy-file ((compose target-file-name car target-inputs) t) file-name)
(if substitutes
(begin
(substitute* file-name
(("module/") (string-append %prefix "/" %moduledir "/"))
(("@DATADIR@") (string-append %prefix "/" %datadir "/"))
(("@DOCDIR@") (string-append %prefix "/" %docdir "/"))
(("@GODIR@") (string-append %prefix "/" %godir "/"))
(("@GUILEDIR@") (string-append %prefix "/" %guiledir "/"))
(("@MODULEDIR@") (string-append %prefix "/" %moduledir "/"))
(("@PREFIX@") (string-append %prefix "/"))
(("@VERSION@") %version)))))))))
(define (hash-target o) (define (hash-target o)
(if (find (negate identity) (target-inputs o)) (if (find (negate identity) (target-inputs o))
(format (current-error-port) "invalid inputs[~s]: ~s\n" (target-file-name o) (target-inputs o))) (format (current-error-port) "invalid inputs[~s]: ~s\n" (target-file-name o) (target-inputs o)))
@ -228,6 +272,12 @@
(exit exit) (exit exit)
(signal signal))) (signal signal)))
(define* (install name #:key (dir (dirname name)) (installed-name (basename name)) (prefix %prefix) substitutes (dependencies '()))
(target (file-name (string-append prefix "/" dir "/" installed-name))
(method (method-cp #:substitutes substitutes))
(inputs (cons (or (get-target name)
(store #:add-file name)) dependencies))))
(define* (group name #:key (dependencies '())) (define* (group name #:key (dependencies '()))
(target (file-name name) (target (file-name name)
(inputs (map get-target dependencies)))) (inputs (map get-target dependencies))))
@ -293,9 +343,7 @@
"-o" ,(target-file-name t) "-o" ,(target-file-name t)
,@(filter (cut string-suffix? ".c" <>) input-files)))) ,@(filter (cut string-suffix? ".c" <>) input-files))))
(format (current-error-port) " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t)) (format (current-error-port) " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
(unless (zero? (apply system** command)) (apply system** command))))
(format (current-error-port) "FAILED:~s\n" command)
(exit 1)))))
(inputs (list (store #:add-file "mlibc/libc-gcc.c"))))) ;; FIXME: FLAGS (inputs (list (store #:add-file "mlibc/libc-gcc.c"))))) ;; FIXME: FLAGS
(define* (CPP.mescc #:key (cc %MESCC) (defines '()) (includes '())) (define* (CPP.mescc #:key (cc %MESCC) (defines '()) (includes '()))
@ -325,6 +373,7 @@
(store #:add-file "guile/language/c99/info.go") (store #:add-file "guile/language/c99/info.go")
(store #:add-file "guile/mes/as.go") (store #:add-file "guile/mes/as.go")
(store #:add-file "guile/mes/as-i386.go") (store #:add-file "guile/mes/as-i386.go")
(store #:add-file "guile/mes/bytevectors.go")
(store #:add-file "guile/mes/M1.go"))))) (store #:add-file "guile/mes/M1.go")))))
(define %M1 (or (PATH-search-path "M1" #:default #f) (define %M1 (or (PATH-search-path "M1" #:default #f)
@ -401,9 +450,7 @@
,(target-file-name t) ,(target-file-name t)
,@input-files))) ,@input-files)))
(format #t " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t)) (format #t " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
(unless (zero? (apply system** command)) (apply system** command))))))
(format (current-error-port) "FAILED:~s\n" command)
(exit 1)))))))
(define SNARF "build-aux/mes-snarf.scm") (define SNARF "build-aux/mes-snarf.scm")
(define (SNARF.mes mes?) (define (SNARF.mes mes?)
@ -414,9 +461,7 @@
,@(if mes? '("--mes") '()) ,@(if mes? '("--mes") '())
,@input-files))) ,@input-files)))
(format #t " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t)) (format #t " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
(unless (zero? (apply system** command)) (apply system** command))))))
(format (current-error-port) "FAILED:~s\n" command)
(exit 1)))))))
(define* (cpp.mescc input-file-name #:key (cc %MESCC) (defines '()) (includes '()) (dependencies '())) (define* (cpp.mescc input-file-name #:key (cc %MESCC) (defines '()) (includes '()) (dependencies '()))
(let* ((c-target (target (file-name input-file-name))) (let* ((c-target (target (file-name input-file-name)))
@ -440,7 +485,7 @@
(inputs (cons c-target dependencies)) (inputs (cons c-target dependencies))
(method (CC.gcc #:cc cc #:libc libc #:defines defines #:includes includes))))) (method (CC.gcc #:cc cc #:libc libc #:defines defines #:includes includes)))))
(define* (compile.mescc input-file-name #:key (cc %CC) (libc libc-mes.E) (defines '()) (includes '()) (dependencies '())) (define* (compile.mescc input-file-name #:key (cc %MESCC) (libc libc-mes.E) (defines '()) (includes '()) (dependencies '()))
(let* ((base-name (base-name input-file-name ".c")) (let* ((base-name (base-name input-file-name ".c"))
;;(foo (format (current-error-port) "COMPILE[~s .c] base=~s\n" input-file-name base-name)) ;;(foo (format (current-error-port) "COMPILE[~s .c] base=~s\n" input-file-name base-name))
(suffix (cond ((not libc) ".0-M1") (suffix (cond ((not libc) ".0-M1")
@ -510,6 +555,9 @@
(define (check-target? o) (define (check-target? o)
(and o ((target-prefix? "check-") o))) (and o ((target-prefix? "check-") o)))
(define (install-target? o)
(and o ((target-prefix? (or (getenv "PREFIX") "/")) o)))
(define (add-target o) (define (add-target o)
(and o (set! %targets (append %targets (list o)))) (and o (set! %targets (append %targets (list o))))
o) o)

134
guile/guix/shell-utils.scm
View file

@ -21,11 +21,16 @@
(define-module (guix shell-utils) (define-module (guix shell-utils)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:export (dump-port #:export (dump-port
mkdir-p mkdir-p
with-directory-excursion)) with-directory-excursion
substitute
substitute*))
;;; ;;;
;;; Directories. ;;; Directories.
@ -91,3 +96,130 @@ transferred and the continuation of the transfer as a thunk."
(progress 0 (progress 0
(lambda () (lambda ()
(loop 0 (get-bytevector-n! in buffer 0 buffer-size))))) (loop 0 (get-bytevector-n! in buffer 0 buffer-size)))))
;;;
;;; Text substitution (aka. sed).
;;;
(define (with-atomic-file-replacement file proc)
"Call PROC with two arguments: an input port for FILE, and an output
port for the file that is going to replace FILE. Upon success, FILE is
atomically replaced by what has been written to the output port, and
PROC's result is returned."
(let* ((template (string-append file ".XXXXXX"))
(out (mkstemp! template))
(mode (stat:mode (stat file))))
(with-throw-handler #t
(lambda ()
(call-with-input-file file
(lambda (in)
(let ((result (proc in out)))
(close out)
(chmod template mode)
(rename-file template file)
result))))
(lambda (key . args)
(false-if-exception (delete-file template))))))
(define (substitute file pattern+procs)
"PATTERN+PROCS is a list of regexp/two-argument-procedure pairs. For each
line of FILE, and for each PATTERN that it matches, call the corresponding
PROC as (PROC LINE MATCHES); PROC must return the line that will be written as
a substitution of the original line. Be careful about using '$' to match the
end of a line; by itself it won't match the terminating newline of a line."
(let ((rx+proc (map (match-lambda
(((? regexp? pattern) . proc)
(cons pattern proc))
((pattern . proc)
(cons (make-regexp pattern regexp/extended)
proc)))
pattern+procs)))
(with-atomic-file-replacement file
(lambda (in out)
(let loop ((line (read-line in 'concat)))
(if (eof-object? line)
#t
(let ((line (fold (lambda (r+p line)
(match r+p
((regexp . proc)
(match (list-matches regexp line)
((and m+ (_ _ ...))
(proc line m+))
(_ line)))))
line
rx+proc)))
(display line out)
(loop (read-line in 'concat)))))))))
(define-syntax let-matches
;; Helper macro for `substitute*'.
(syntax-rules (_)
((let-matches index match (_ vars ...) body ...)
(let-matches (+ 1 index) match (vars ...)
body ...))
((let-matches index match (var vars ...) body ...)
(let ((var (match:substring match index)))
(let-matches (+ 1 index) match (vars ...)
body ...)))
((let-matches index match () body ...)
(begin body ...))))
(define-syntax substitute*
(syntax-rules ()
"Substitute REGEXP in FILE by the string returned by BODY. BODY is
evaluated with each MATCH-VAR bound to the corresponding positional regexp
sub-expression. For example:
(substitute* file
((\"hello\")
\"good morning\\n\")
((\"foo([a-z]+)bar(.*)$\" all letters end)
(string-append \"baz\" letter end)))
Here, anytime a line of FILE contains \"hello\", it is replaced by \"good
morning\". Anytime a line of FILE matches the second regexp, ALL is bound to
the complete match, LETTERS is bound to the first sub-expression, and END is
bound to the last one.
When one of the MATCH-VAR is `_', no variable is bound to the corresponding
match substring.
Alternatively, FILE may be a list of file names, in which case they are
all subject to the substitutions.
Be careful about using '$' to match the end of a line; by itself it won't
match the terminating newline of a line."
((substitute* file ((regexp match-var ...) body ...) ...)
(let ()
(define (substitute-one-file file-name)
(substitute
file-name
(list (cons regexp
(lambda (l m+)
;; Iterate over matches M+ and return the
;; modified line based on L.
(let loop ((m* m+) ; matches
(o 0) ; offset in L
(r '())) ; result
(match m*
(()
(let ((r (cons (substring l o) r)))
(string-concatenate-reverse r)))
((m . rest)
(let-matches 0 m (match-var ...)
(loop rest
(match:end m)
(cons*
(begin body ...)
(substring l o (match:start m))
r))))))))
...)))
(match file
((files (... ...))
(for-each substitute-one-file files))
((? string? f)
(substitute-one-file f)))))))

236
make.scm
View file

@ -3,30 +3,33 @@
exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$@"} exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$@"}
!# !#
(use-modules (srfi srfi-26)) (use-modules (srfi srfi-26)
(guix shell-utils))
;; FIXME: .go dependencies ;; FIXME: .go dependencies
;; workaround: always update .go before calculating hashes ;; workaround: always update .go before calculating hashes
;;(use-modules ((mes make) #:select (sytem**))) ;;(use-modules ((mes make) #:select (sytem**)))
(define %go-files '()) (define %scm-files
(let* ((scm-files '("guile/guix/make.scm" '("guix/make.scm"
"guile/guix/records.scm" "guix/records.scm"
"guile/guix/shell-utils.scm" "guix/shell-utils.scm"
"guile/language/c99/compiler.scm" "language/c99/compiler.scm"
"guile/mes/as-i386.scm" "mes/as-i386.scm"
"guile/mes/as.scm" "mes/as.scm"
"guile/mes/elf.scm" "mes/bytevectors.scm"
"guile/mes/M1.scm"))) "mes/elf.scm"
(set! %go-files (map (compose (cut string-append <> ".go") (cut string-drop-right <> 4)) scm-files)) "mes/M1.scm"))
(setenv "srcdir" "guile") (define %go-files (map (compose (cut string-append <> ".go") (cut string-drop-right <> 4)) %scm-files))
(setenv "host" %host-type) (setenv "srcdir" ".")
(setenv "host" %host-type)
(with-directory-excursion "guile"
(apply system* `("guile" (apply system* `("guile"
"--no-auto-compile" "--no-auto-compile"
"-L" "." "-L" "."
"-C" "." "-C" "."
"-s" "-s"
"build-aux/compile-all.scm" "../build-aux/compile-all.scm"
,@scm-files))) ,@%scm-files)))
(use-modules (srfi srfi-1) (use-modules (srfi srfi-1)
(ice-9 curried-definitions) (ice-9 curried-definitions)
@ -36,9 +39,15 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
(add-target (bin.mescc "stage0/exit-42.c" #:libc #f)) (add-target (bin.mescc "stage0/exit-42.c" #:libc #f))
(add-target (check "stage0/exit-42.0-guile" #:signal 11)) ; FIXME: segfault (add-target (check "stage0/exit-42.0-guile" #:signal 11)) ; FIXME: segfault
(add-target (cpp.mescc "mlibc/mini-libc-mes.c"))
(add-target (compile.mescc "mlibc/mini-libc-mes.c"))
(add-target (bin.mescc "stage0/exit-42.c" #:libc mini-libc-mes.E)) (add-target (bin.mescc "stage0/exit-42.c" #:libc mini-libc-mes.E))
(add-target (check "stage0/exit-42.mini-guile" #:exit 42)) (add-target (check "stage0/exit-42.mini-guile" #:exit 42))
(add-target (cpp.mescc "mlibc/libc-mes.c"))
(add-target (compile.mescc "mlibc/libc-mes.c"))
(add-target (bin.mescc "stage0/exit-42.c")) (add-target (bin.mescc "stage0/exit-42.c"))
(add-target (check "stage0/exit-42.guile" #:exit 42)) (add-target (check "stage0/exit-42.guile" #:exit 42))
@ -273,33 +282,28 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
(add-target (snarf "src/reader.c" #:mes? #t)) (add-target (snarf "src/reader.c" #:mes? #t))
(add-target (snarf "src/vector.c" #:mes? #t)))) (add-target (snarf "src/vector.c" #:mes? #t))))
(define VERSION "0.8")
(define PREFIX (or (getenv "PREFIX") "/usr/local"))
(define DATADIR (or (getenv "DATADIR") (string-append PREFIX " /share")))
(define MODULEDIR (or (getenv "MODULEDIR") (string-append DATADIR "/module/")))
(add-target (bin.gcc "src/mes.c" #:dependencies gcc-snarf-targets (add-target (bin.gcc "src/mes.c" #:dependencies gcc-snarf-targets
#:defines `("FIXED_PRIMITIVES=1" #:defines `("FIXED_PRIMITIVES=1"
"MES_FULL=1" "MES_FULL=1"
"POSIX=1" "POSIX=1"
,(string-append "VERSION=\"" VERSION "\"") ,(string-append "VERSION=\"" %version "\"")
,(string-append "MODULEDIR=\"" MODULEDIR "\"") ,(string-append "MODULEDIR=\"" (string-append %moduledir "/") "\"")
,(string-append "PREFIX=\"" PREFIX "\"")))) ,(string-append "PREFIX=\"" %prefix "\""))))
(add-target (bin.gcc "src/mes.c" #:libc #f (add-target (bin.gcc "src/mes.c" #:libc #f
#:dependencies mes-snarf-targets #:dependencies mes-snarf-targets
#:defines `("FIXED_PRIMITIVES=1" #:defines `("FIXED_PRIMITIVES=1"
"MES_FULL=1" "MES_FULL=1"
,(string-append "VERSION=\"" VERSION "\"") ,(string-append "VERSION=\"" %version "\"")
,(string-append "MODULEDIR=\"" MODULEDIR "\"") ,(string-append "MODULEDIR=\"" (string-append %moduledir "/") "\"")
,(string-append "PREFIX=\"" PREFIX "\"")))) ,(string-append "PREFIX=\"" %prefix "\""))))
(add-target (bin.mescc "src/mes.c" #:dependencies mes-snarf-targets (add-target (bin.mescc "src/mes.c" #:dependencies mes-snarf-targets
#:defines `("FIXED_PRIMITIVES=1" #:defines `("FIXED_PRIMITIVES=1"
"MES_FULL=1" "MES_FULL=1"
,(string-append "VERSION=\"" VERSION "\"") ,(string-append "VERSION=\"" %version "\"")
,(string-append "MODULEDIR=\"" MODULEDIR "\"") ,(string-append "MODULEDIR=\"" (string-append %moduledir "/") "\"")
,(string-append "PREFIX=\"" PREFIX "\"")))) ,(string-append "PREFIX=\"" %prefix "\""))))
(define mes-tests (define mes-tests
'("tests/read.test" '("tests/read.test"
@ -345,6 +349,173 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
;; FIXME: run tests/base.test ;; FIXME: run tests/base.test
(setenv "MES" "src/mes.guile") (setenv "MES" "src/mes.guile")
(add-target (install "guile/mescc.scm" #:dir "bin" #:substitutes #t))
(add-target (install "scripts/mescc.mes" #:dir "bin" #:substitutes #t))
(add-target (install "scripts/repl.mes" #:dir "bin" #:substitutes #t))
(define bootstrap? #f)
(if bootstrap?
(add-target (install "src/mes.mes" #:dir "bin" #:installed-name "mes"))
(add-target (install "src/mes.guile" #:dir "bin" #:installed-name "mes")))
(define* ((install-dir #:key dir) name)
(add-target (install name #:dir (string-append dir "/" (dirname name)))))
(add-target (install "module/mes/base-0.mes" #:dir (string-append %moduledir "/mes") #:substitutes #t))
(add-target (install "module/language/c99/compiler.mes" #:dir (string-append %moduledir "/language/c99") #:substitutes #t))
(define %module-dir "share/mes")
(for-each
(lambda (f)
((install-dir #:dir (string-append %module-dir)) f))
'("module/language/c99/compiler.mes"
"module/language/c99/compiler.scm"
"module/language/paren.mes"
"module/mes/M1.mes"
"module/mes/M1.scm"
"module/mes/as-i386.mes"
"module/mes/as-i386.scm"
"module/mes/as.mes"
"module/mes/as.scm"
;;"module/mes/base-0.mes"
"module/mes/base.mes"
"module/mes/bytevectors.mes"
"module/mes/bytevectors.scm"
"module/mes/catch.mes"
"module/mes/display.mes"
"module/mes/elf.mes"
"module/mes/elf.scm"
"module/mes/fluids.mes"
"module/mes/getopt-long.mes"
"module/mes/getopt-long.scm"
"module/mes/guile.mes"
"module/mes/lalr.mes"
"module/mes/lalr.scm"
"module/mes/let.mes"
"module/mes/match.mes"
"module/mes/match.scm"
"module/mes/optargs.mes"
"module/mes/optargs.scm"
"module/mes/peg.mes"
"module/mes/peg/cache.scm"
"module/mes/peg/codegen.scm"
"module/mes/peg/simplify-tree.scm"
"module/mes/peg/string-peg.scm"
"module/mes/peg/using-parsers.scm"
"module/mes/pmatch.mes"
"module/mes/pmatch.scm"
"module/mes/posix.mes"
"module/mes/pretty-print.mes"
"module/mes/pretty-print.scm"
"module/mes/psyntax-0.mes"
"module/mes/psyntax-1.mes"
"module/mes/psyntax.mes"
"module/mes/psyntax.pp"
"module/mes/psyntax.ss"
"module/mes/quasiquote.mes"
"module/mes/quasisyntax.mes"
"module/mes/quasisyntax.scm"
"module/mes/read-0.mes"
"module/mes/record-0.mes"
"module/mes/record.mes"
"module/mes/repl.mes"
"module/mes/scm.mes"
"module/mes/syntax.mes"
"module/mes/syntax.scm"
"module/mes/test.mes"
"module/mes/tiny-0.mes"
"module/mes/type-0.mes"
"module/nyacc/lalr.mes"
"module/nyacc/lang/c99/cpp.mes"
"module/nyacc/lang/c99/parser.mes"
"module/nyacc/lang/calc/parser.mes"
"module/nyacc/lang/util.mes"
"module/nyacc/lex.mes"
"module/nyacc/parse.mes"
"module/nyacc/util.mes"
"module/rnrs/arithmetic/bitwise.mes"
"module/srfi/srfi-0.mes"
"module/srfi/srfi-1.mes"
"module/srfi/srfi-1.scm"
"module/srfi/srfi-13.mes"
"module/srfi/srfi-14.mes"
"module/srfi/srfi-16.mes"
"module/srfi/srfi-16.scm"
"module/srfi/srfi-26.mes"
"module/srfi/srfi-26.scm"
"module/srfi/srfi-43.mes"
"module/srfi/srfi-9-psyntax.mes"
"module/srfi/srfi-9.mes"
"module/srfi/srfi-9.scm"
"module/sxml/xpath.mes"
"module/sxml/xpath.scm"))
(define* ((install-guile-dir #:key dir) name)
(add-target (install (string-append "guile/" name) #:dir (string-append dir "/" (dirname name)))))
(for-each
(lambda (f)
((install-guile-dir #:dir (string-append %guiledir)) f))
%scm-files)
(for-each
(lambda (f)
((install-guile-dir #:dir (string-append %godir)) f))
%go-files)
(add-target (install "mlibc/libc-mes.E" #:dir "lib"))
(add-target (install "mlibc/libc-mes.M1" #:dir "lib"))
(add-target (install "mlibc/mini-libc-mes.E" #:dir "lib"))
(add-target (install "mlibc/mini-libc-mes.M1" #:dir "lib"))
(for-each
(lambda (f)
((install-dir #:dir "share/") f))
'("mlibc/include/alloca.h"
"mlibc/include/assert.h"
"mlibc/include/ctype.h"
"mlibc/include/dlfcn.h"
"mlibc/include/errno.h"
"mlibc/include/fcntl.h"
"mlibc/include/features.h"
"mlibc/include/inttypes.h"
"mlibc/include/libgen.h"
"mlibc/include/limits.h"
"mlibc/include/locale.h"
"mlibc/include/math.h"
"mlibc/include/mlibc.h"
"mlibc/include/setjmp.h"
"mlibc/include/signal.h"
"mlibc/include/stdarg.h"
"mlibc/include/stdbool.h"
"mlibc/include/stdint.h"
"mlibc/include/stdio.h"
"mlibc/include/stdlib.h"
"mlibc/include/stdnoreturn.h"
"mlibc/include/string.h"
"mlibc/include/strings.h"
"mlibc/include/sys/cdefs.h"
"mlibc/include/sys/mman.h"
"mlibc/include/sys/stat.h"
"mlibc/include/sys/time.h"
"mlibc/include/sys/timeb.h"
"mlibc/include/sys/types.h"
"mlibc/include/sys/ucontext.h"
"mlibc/include/sys/wait.h"
"mlibc/include/time.h"
"mlibc/include/unistd.h"))
(for-each
(compose add-target (cut install <> #:dir "share/doc/mes"))
'("AUTHORS"
;;"ChangeLog"
"COPYING"
"HACKING"
"INSTALL"
"NEWS"
"README"))
(add-target (install "doc/fosdem/fosdem.pdf" #:dir "share/doc/mes"))
(define (main args) (define (main args)
(cond ((member "all-go" args) #t) (cond ((member "all-go" args) #t)
((member "clean-go" args) (map delete-file (filter file-exists? %go-files))) ((member "clean-go" args) (map delete-file (filter file-exists? %go-files)))
@ -359,15 +530,18 @@ Targets:
clean clean
clean-go clean-go
help~a help~a
install
list list
" "
;;(string-join (map target-file-name %targets) "\n " 'prefix)
(string-join (filter (negate (cut string-index <> #\/)) (map target-file-name %targets)) "\n " 'prefix))) (string-join (filter (negate (cut string-index <> #\/)) (map target-file-name %targets)) "\n " 'prefix)))
(else (else
(let ((targets (match args (let ((targets (match args
(() (filter (negate check-target?) %targets)) (() (filter (negate check-target?) %targets))
((? (cut member "all" <>)) (filter (negate check-target?) %targets)) ((? (cut member "all" <>)) (filter (conjoin (negate install-target?)
(negate check-target?))
%targets))
((? (cut member "check" <>)) (filter check-target? %targets)) ((? (cut member "check" <>)) (filter check-target? %targets))
((? (cut member "install" <>)) (filter install-target? %targets))
(_ (filter-map (cut get-target <>) args))))) (_ (filter-map (cut get-target <>) args)))))
(for-each build targets) (for-each build targets)
;;((@@ (mes make) store) #:print 0) ;;((@@ (mes make) store) #:print 0)

51
module/nyacc/lang/c99/BUGS
View file

@ -1,51 +0,0 @@
BUGs and TODOs
C99-010 <= next id
C99-009 18 Mar 2017, M.Wette
pprint generates two spaces in declarations e.g.,
int foo(int x);
C99-008 02 Mar 2017, M.Wette
clean up error traps among raw-parser run-parse and parse-c99[x]
C99-007 16 Feb 2017, M.Wette
cpp.scm: does __LINE__ get expanded?
C99-005 26 Jun 2016, M.Wette
in util2.scm, tree->udecl needs to return "struct" and "union"
entries for stuff like
struct foo { int x; };
C99-004 xdef arg to gen-c-lexer may be too simple
it is currently a predicate. Maybe it should return three values
#f => don't expand
#t => expand
string => use string
C99-003 util2.scm/tree->udict should return declarations in order
=== RESOLVED ===================
C99-001 cpp breaks on the following, I think:
#define ABC 123 /* this is a var */
#if ABC > 100
# error "bla"
#endif
13Apr16 works
C99-002 CPP redesign is not working for ifdef and defined:
#define A 1
#ifdef A
...
breaks because it gets expanded as (if "defined(1)")
see cppbody.scm, near line 133:
((read-c-ident ch) =>
(lambda (iden)
25Jun16 fixed
C99-006 06 Aug 2016, M.Wette
code "val = '\0';" gets pprinted to "val = '^@;';"
02Mar17 fixed, V0.76.5+c99dev
--- last line ---