80 lines
2.7 KiB
Scheme
80 lines
2.7 KiB
Scheme
#! /bin/sh
|
|
# -*-scheme-*-
|
|
exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes-snarf)' -s "$0" "$@"
|
|
!#
|
|
|
|
;;; GNU Mes --- Maxwell Equations of Software
|
|
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
|
;;;
|
|
;;; This file is part of GNU Mes.
|
|
;;;
|
|
;;; GNU Mes is free software; you can redistribute it and/or modify it
|
|
;;; under the terms of the GNU General Public License as published by
|
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
;;; your option) any later version.
|
|
;;;
|
|
;;; GNU Mes is distributed in the hope that it will be useful, but
|
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;; GNU General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
;; Usage:
|
|
;; GUILE_LOAD_PATH=~/src/nyacc/module MES_ARENA=2000000 MES_MAX_ARENA=$MES_ARENA ./pre-inst-env mes build-aux/gen-cppmach.scm
|
|
|
|
(cond-expand
|
|
(mes
|
|
(mes-use-module (mes misc))
|
|
(warn 'boo)
|
|
(mes-use-module (mes pretty-print))
|
|
(mes-use-module (nyacc lang c99 cppmach)))
|
|
(guile
|
|
(use-modules (mes pretty-print))
|
|
(module-define! (resolve-module '(nyacc lalr)) 'pretty-print pretty-print)
|
|
(use-modules (nyacc lang c99 cppmach))))
|
|
|
|
(define (reverse-string-append lst)
|
|
(apply string-append (reverse lst)))
|
|
|
|
(define (call-with-output-file file-name proc)
|
|
(let ((port (open-output-file file-name)))
|
|
(if (= port -1)
|
|
(error 'cannot-open file-name)
|
|
(proc port))))
|
|
|
|
(define (string-every-pred-start-end pred s start end)
|
|
(cond ((= start end) #t)
|
|
((> start end) (throw 'value-out-of-range "string-every" s start end))
|
|
(else (and (string-every-pred-start-end pred s (1+ start) end)
|
|
(pred (string-ref s start))))))
|
|
|
|
(define (string-every pred s . rest)
|
|
(let ((start (if (null? rest) 0
|
|
(car rest)))
|
|
(end (if (or (null? rest) (null? (cdr rest))) (string-length s)
|
|
(cadr rest)))
|
|
(pred (if (char? pred) (lambda (c) (eq? c pred)) pred)))
|
|
(string-every-pred-start-end pred s start end)))
|
|
|
|
|
|
(define (vector-fold proc init vec1 . rest)
|
|
(if (null? rest)
|
|
(let ((len (vector-length vec1)))
|
|
(let loop ((i 0) (result init))
|
|
(if (= i len) result
|
|
(loop (1+ i) (proc i result (vector-ref vec1 i))))))
|
|
(error "VECTOR-FOLD-2-NOT-SUPPORTED")))
|
|
|
|
(define F_OK 0)
|
|
|
|
(define (rename-file old new)
|
|
(system* "mv" old new)) ;; FIXME: rename is in libc+gnu.
|
|
|
|
(define (move-if-changed src-file dst-file . rest)
|
|
(rename-file src-file dst-file))
|
|
|
|
(gen-cpp-files ".")
|