scm2bin.scm 1.0

[Thien-Thi Nguyen]

since "guile SCRIPT" doesn't work as the SHELL value in a crontab file,
i thought i'd reinvent the wheel and do scm2bin instead (as yet another
form of procrastination ;-).  play session:

$ cat > hello-world.scm
(use-modules (ice-9 rw))
(write-line "hello-world!")
(format #t "(command-line) => ~S\n" (command-line))
^D
$ guile -s scm2bin.scm hello-world.scm
$ ./scm2bin.out how are you
hello-world!
(command-line) => ("./scm2bin.out" "how" "are" "you")
$ guile -s scm2bin.scm -o hi hello-world.scm
$ ./hi how are you
hello-world!
(command-line) => ("./hi" "how" "are" "you")

etc.  this will eventually make it into guile-tools (guile-1.4.1.94).
probably the user interface will be stable enough to get hobbit on board
At Some Point.  note that the implementation relies on "guile-tools
guile-config", which can be grabbed from:

  http://www.glug.org/alt/guile-1.4.1.93.tar.gz

happy hacking,
thi

_____________________________________________________
cd ~/stash/
tar xzOf ttn-do-141.tar.gz ttn-do-141/scm2bin.scm
#!/bin/sh
# -*- scheme -*-
exec guile -s $0 "$@"
!#
;;; ID: scm2bin.scm,v 1.1 2003/07/30 16:15:15 ttn Exp
;;;
;;; Copyright (C) 2003 Thien-Thi Nguyen
;;; This program is part of ttn-do, released under GNU GPL v2 with ABSOLUTELY
;;; NO WARRANTY.  See http://www.gnu.org/copyleft/gpl.txt for details.

;;; Commentary:

;; Usage: scm2bin --help
;;        scm2bin --version
;;        scm2bin [OPTIONS] SCM
;;  where SCM is a scheme (.scm) program, and OPTIONS
;;  (defaults in square brackets) is zero or more of:
;;    --output, -o FILE   -- use FILE for output [scm2bin.out]

;;; Code:

(define *scm2bin-version* "1.0")

(use-modules (ice-9 rw))

(define (usage)
  (for-each write-line
            '("Usage: scm2bin --help"
              "       scm2bin --version"
              "       scm2bin [OPTIONS] SCM"
              " where SCM is a scheme (.scm) program, and OPTIONS"
              " (defaults in square brackets) is zero or more of:"
              "   --output, -o FILE   -- use FILE for output [scm2bin.out]"
;;              "   --main, -m PROC     -- use PROC as main [main]"
              )))

(use-modules (srfi srfi-13))

(define (write-C-string p s)
  (string-for-each
   (lambda (c)
     (case c
       ((#\newline) (display "\\n\"\n  \"" p))
       ((#\\) (display #\\ p) (display #\\ p))
       ((#\") (display #\\ p) (display #\" p))
       (else (display c p))))
   s))

(define *boilerplate-C* "
static int actual_main (int argc, char **argv) {
  SCM port = scm_open_input_string (gh_str02scm (program));
  while (1) {
    SCM form = scm_read (port);
    if (SCM_EOF_OBJECT_P (form)) break;
    scm_eval_x (form);
  }
  return 0;
}

int main (int argc, char **argv) {
  gh_enter (argc, argv, actual_main);
  return 0;
}
")

(use-modules (scripts slurp) (ice-9 getopt-long))

;;; main
(let ((parsed (getopt-long (command-line)
                           '((version)
                             (help (single-char #\h))
                             (output (single-char #\o)
                                     (value #t))
                             (main (single-char #\m)
                                   (value #t))))))
  (cond ((option-ref parsed 'help #f)
         (usage)
         (exit #t))
        ((option-ref parsed 'version #f)
         (format #t "scm2bin ~A\n" *scm2bin-version*)
         (exit #t))
        ((null? (option-ref parsed '() #f))
         (usage)
         (exit #f))
        (else
         (let* ((name (car (option-ref parsed '() #f)))
                (in (if (file-exists? name)
                        (slurp name)
                        (begin
                          (format #t "scm2bin: cannot read: ~A\n"
                                  name)
                          (exit #f))))
                (out (option-ref parsed 'output "scm2bin.out"))
                (tmp (open-output-file "scm2bin.c")))
           (format tmp "#include <libguile.h>\n")
           (format tmp "static char program[] = \"")
           (write-C-string tmp in)
           (format tmp "\";\n\n")
           (format tmp *boilerplate-C*)
           (close tmp)
           (system (format #f "~A -o ~A ~A ~A ~A"
                           "`guile-tools guile-config acsubst CC`"
                           out
                           "`guile-tools guile-config compile`"
                           "scm2bin.c"
                           "`guile-tools guile-config link`")))
         (delete-file "scm2bin.c")
         (exit #t))))

;;; scm2bin.scm ends here

Compilation finished at Wed Jul 30 18:18:12