From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Thien-Thi Nguyen Newsgroups: gmane.lisp.guile.user,gmane.lisp.guile.sources Subject: program: scm2bin.scm 1.1 Date: Sun, 03 Aug 2003 21:25:34 +0200 Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Message-ID: Reply-To: ttn@glug.org NNTP-Posting-Host: deer.gmane.org X-Trace: main.gmane.org 1059938794 8654 80.91.224.253 (3 Aug 2003 19:26:34 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 3 Aug 2003 19:26:34 +0000 (UTC) Cc: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sun Aug 03 21:26:50 2003 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 19jOVF-0000hi-00 for ; Sun, 03 Aug 2003 21:26:50 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.20) id 19jOSX-0003qp-B2 for guile-user@m.gmane.org; Sun, 03 Aug 2003 15:24:01 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.20) id 19jOR9-0003oN-7i for guile-user@gnu.org; Sun, 03 Aug 2003 15:22:35 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.20) id 19jOQZ-0003XP-Li for guile-user@gnu.org; Sun, 03 Aug 2003 15:22:30 -0400 Original-Received: from [212.141.71.1] (helo=surf.glug.org) by monty-python.gnu.org with esmtp (Exim 4.20) id 19jOPn-0003If-Kn; Sun, 03 Aug 2003 15:21:13 -0400 Original-Received: from ttn by surf.glug.org with local (Exim 3.35 #1 (Debian)) id 19jOU2-00046e-00; Sun, 03 Aug 2003 21:25:34 +0200 Original-To: guile-sources@gnu.org X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.user:2135 gmane.lisp.guile.sources:41 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.user:2135 well, that's enough dabbling in lame "compilation" techniques for now. but at least you can do stuff like: $ guile -s scm2bin.scm -o $HOME/bin/scm2bin -s scm2bin.scm $ PATH=$HOME/bin:$PATH $ d=`guile-tools --help | sed '/Default/!d;s/.* //'` $ mkdir -p /tmp/bin $ for prog in `guile-tools` ; do scm2bin -o /tmp/bin/$prog -s -x $d/$prog || echo oops: $prog ; done $ for prog in /tmp/bin/* ; do $prog --help ; done and other time-for-space-for-time-for-space wranglings... note that even w/o "-s", 1.1 produces a smaller result than 1.0, due to super-sekret punify technology (which you will never see in your spambox for some reason ;-). thi ___________________________________________________________ #!/bin/sh # -*- scheme -*- exec guile -s $0 "$@" !# ;;; ID: scm2bin.scm,v 1.2 2003/08/02 20:41:16 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: ;; -o, --output FILE -- use FILE for output [scm2bin.out] ;; -s, --scheme-static -- also bundle upstream scheme files ;; -x, --executable-module -- use executable module calling convention ;; ;; scm2bin creates a "binary executable file" named scm2bin.out that ;; encapsulates the code from SCM, the filename of a Scheme program. ;; This file can be run from the shell like so: ./scm2bin.out ARGS... ;; Option `--output FILE' specifies an alternative output filename. ;; ;; Option `--scheme-static' means perform a module-fan-in analysis and ;; additionally encapsulate those Scheme modules that would be loaded via ;; "use-modules". This increases the size and reduces the startup time of ;; the executable, rendering it opaque to upgrades to upstream modules. ;; This is similar in spirit to "gcc -static" wrt shared object libraries. ;; Note, however, that the binary executable file is not "static" in that ;; sense, but only in the Scheme code sense. ;; ;; Option `--executable-module' means use the executable module calling ;; convention instead of the default "guile -s" simulation. ;;; Code: (define *scm2bin-version* "1.1") (cond ((getenv "ttn_do_bin") => (lambda (do-dir) (or (member do-dir %load-path) (set! %load-path (cons do-dir %load-path)))))) (use-modules (module-fan-in)) (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:" " -o, --output FILE -- use FILE for output [scm2bin.out]" " -s, --scheme-static -- also bundle upstream scheme files" " -x, --executable-module -- use executable module calling convention" ))) (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; } ") (define *options* '((version) (help (single-char #\h)) (output (single-char #\o) (value #t)) (verbose (single-char #\v)) (scheme-static (single-char #\s)) (executable-module (single-char #\x)) ;; Add more options here. )) (use-modules (scripts read-scheme-source)) (define (display-executable-module-blurb filename) (let loop ((forms (read-scheme-source-silently filename))) (if (null? forms) (error "could not find define-module in" filename) (if (eq? (caar forms) 'define-module) (display `(apply (module-ref (resolve-module (quote ,(cadar forms))) (quote main)) (cdr (command-line)))) (loop (cdr forms)))))) (use-modules (scripts punify) (ice-9 getopt-long)) (use-modules ((srfi srfi-1) :select (filter-map))) ;;; main (let ((parsed (getopt-long (command-line) *options*))) (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) (with-output-to-string (lambda () (if (option-ref parsed 'scheme-static #f) (apply punify (filter-map (lambda (module) (object-property module 'filename)) (module-fan-in (list name)))) (punify name)) (and (option-ref parsed 'executable-module #f) (display-executable-module-blurb name)))) (begin (format #t "scm2bin: cannot read: ~A\n" name) (exit #f)))) (out (format #f "-o ~A" (option-ref parsed 'output "scm2bin.out"))) (tmp (open-output-file "scm2bin.c"))) (format tmp "#include \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~A ~A ~A ~A ~A" (or (and (option-ref parsed 'verbose #f) "set -x ; ") "") "`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 _______________________________________________ Guile-user mailing list Guile-user@gnu.org http://mail.gnu.org/mailman/listinfo/guile-user