Tried compiling more code; augmented the doc.

* module/language/Makefile.am: New.

* module/language/scheme/Makefile.am: New.

* configure.in: Produce these two new Makefiles.

* doc/guile-vm.texi: Documented `compile-file', `compiled-file-name', and
  `compile-in'.

* module/system/base/compile.scm: Cosmetic changes.

* module/system/base/language.scm: Likewise.

* module/system/il/Makefile.am: Tried (and failed) to compile more
  things.

* module/system/vm/Makefile.am: All source files in here can now be
  compiled without harming further compilation.

* module/system/vm/assemble.scm: Select only specific bindings from
  `(system vm core)'.
  (dump-object!): Show a more meaningful error message.

* module/system/vm/conv.scm: Select only specific bindings from `(system
  vm core)'.

* module/system/vm/debug.scm: Likewise.

* module/system/vm/frame.scm: Changed the header.  Use a renamer for
  `(system vm core)'.

* src/guilec.in: Added options, via `getopt-long'.

git-archimport-id: lcourtes@laas.fr--2005-mobile/guile-vm--mobile--0.6--patch-6

configure.in

@@ -1,12 +1,19 @@
-AC_INIT(src/guile-vm.c)
+# Guile-VM.
-AM_INIT_AUTOMAKE(guile-vm, 0.5)
-AM_CONFIG_HEADER(src/config.h)
 
+AC_PREREQ(2.59)
+AC_INIT(guile-vm, 0.6, ludovic.courtes@laas.fr)
+AM_INIT_AUTOMAKE(guile-vm, 0.6)
+
+AC_CONFIG_SRCDIR(src/guile-vm.c)
+AC_CONFIG_HEADER(src/config.h)
+
+# Guile.
 GUILE_FLAGS
-if test "`guile -c '(display (string>=? (version) "1.4.1"))'`" != "#t"; then
+if test "`guile -c '(display (string>=? (version) "1.7"))'`" != "#t"; then
-  AC_MSG_ERROR([Your Guile is too old.  You need guile-1.4.1 or later.])
+  AC_MSG_ERROR([Your Guile is too old.  You need Guile 1.7.2 or later.])
 fi
 
+# C Compiler.
 AC_PROG_CC
 AC_PROG_LN_S
 AM_PROG_LIBTOOL
@@ -21,7 +28,8 @@ GUILEC="GUILE_LOAD_PATH=\$(top_srcdir)/module \
 AC_SUBST(GUILEC)
 
 AC_OUTPUT(Makefile src/Makefile doc/Makefile module/Makefile
-  module/system/Makefile module/system/base/Makefile
+	  module/system/Makefile module/system/base/Makefile
-  module/system/vm/Makefile module/system/il/Makefile
+	  module/system/vm/Makefile module/system/il/Makefile
-  module/system/repl/Makefile
+	  module/system/repl/Makefile
-  testsuite/Makefile)
+	  module/language/Makefile module/language/scheme/Makefile
+	  testsuite/Makefile)

doc/guile-vm.texi

@@ -766,13 +766,32 @@ The use of two separate intermediate languages eases the
 implementation of front-ends since the gap between high-level
 languages like Scheme and GHIL is relatively small.
 
-@findex compile-file
 @vindex guilec
 From an end-user viewpoint, compiling a Guile program into bytecode
 can be done either by using the @command{guilec} command-line tool, or
 by using the @code{compile-file} procedure exported by the
 @code{(system base compile)} module.
 
+@deffn @scmproc{} compile-file file . opts
+Compile Scheme source code from file @var{file} using compilation
+options @var{opts}.  The resulting file, a Guile object file, will be
+name according the application of the @code{compiled-file-name}
+procedure to @var{file}.  The possible values for @var{opts} are the
+same as for the @code{compile-in} procedure (see below, @pxref{The Language
+Front-Ends}).
+@end deffn
+
+@deffn @scmproc{} compiled-file-name file
+Given source file name @var{file} (a string), return a string that
+denotes the name of the Guile object file corresponding to
+@var{file}.  By default, the file name returned is @var{file} minus
+its extension and plus the @code{.go} file extension.
+@end deffn
+
+@cindex self-hosting
+It is worth noting, as you might have already guessed, that Guile-VM's
+compiler is written in Guile Scheme and is @dfn{self-hosted}: it can
+compile itself.
 
 @node The Language Front-Ends, GHIL, Overview, The Compiler
 @section The Language Front-Ends
@@ -804,6 +823,34 @@ this procedure assumes that language @var{symbol} exists if there
 exist a @code{(language @var{symbol} spec)} module.
 @end deffn
 
+The @code{(system base compile)} module defines a procedure similar to
+@code{compile-file} but that is not limited to the Scheme language:
+
+@deffn @scmproc{} compile-in expr env lang . opts
+Compile expression @var{expr}, which is written in language @var{lang}
+(a @code{<language>} object), using compilation options @var{opts},
+and return bytecode as produced by the assembler (@pxref{The
+Assembler}).
+
+Options @var{opts} may contain the following keywords:
+
+@table @code
+@item :e
+compilation will stop after the code expansion phase.
+@item :t
+compilation will stop after the code translation phase, i.e. after
+code in the source language @var{lang} has been translated into GHIL
+(@pxref{GHIL}).
+@item :c
+compilation will stop after the compilation phase and before the
+assembly phase, i.e. once GHIL has been translated into GLIL
+(@pxref{GLIL}).
+@end table
+
+Additionally, @var{opts} may contain any option understood by the
+GHIL-to-GLIL compiler described in @xref{GLIL}.
+@end deffn
+
 
 @node GHIL, GLIL, The Language Front-Ends, The Compiler
 @section Guile's High-Level Intermediate Language
@@ -874,6 +921,10 @@ instruction sequence.  The option list @var{opts} may be either the
 empty list or a list containing the @code{:O} keyword in which case
 @code{compile} will first go through an optimization stage of
 @var{ghil}.
+
+Note that the @code{:O} option may be passed at a higher-level to the
+@code{compile-file} and @code{compile-in} procedures (@pxref{The
+Language Front-Ends}).
 @end deffn
 
 @deffn @scmproc{} pprint-glil glil . port

module/language/Makefile.am

@@ -0,0 +1 @@
+SUBDIRS = scheme

module/language/scheme/Makefile.am

@@ -0,0 +1,17 @@
+SOURCES =
+## FIXME: There's a bug showing up when compiling `translate.scm'.
+##
+## `spec.scm' cannot be compiled because it uses the `define-language'
+## macro which introduces an unregular object, namely the first-class
+## `<language>' procedure.
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+vmdir = $(guiledir)/language/scheme
+vm_DATA = $(SOURCES) $(GOBJECTS)
+
+CLEANFILES = $(GOBJECTS)
+MAINTAINERCLEANFILES = Makefile.in
+
+SUFFIXES = .scm .go
+%.go: %.scm
+	$(GUILEC) $<

module/system/base/Makefile.am

@@ -1,12 +1,13 @@
-SOURCES = syntax.scm language.scm compile.scm
+SOURCES = compile.scm language.scm module.scm
-OBJECTS = syntax.go  language.go  compile.go
+## syntax.scm
+GOBJECTS = $(SOURCES:%.scm=%.go)
 
 vmdir = $(guiledir)/system/vm
-vm_DATA = $(SOURCES) $(OBJECTS)
+vm_DATA = $(SOURCES) $(GOBJECTS)
 
-DISTCLEANFILES = $(OBJECTS)
+CLEANFILES = $(GOBJECTS)
 MAINTAINERCLEANFILES = Makefile.in
 
 SUFFIXES = .scm .go
-.scm.go:
+%.go: %.scm
 	$(GUILEC) $<

module/system/base/compile.scm

@@ -68,7 +68,7 @@
 		 (if (memq :c opts)
 		   (pprint-glil objcode port)
 		   (uniform-vector-write (objcode->u8vector objcode) port)))))
-	   (format #t "wrote ~A\n" comp))
+	   (format #t "wrote `~A'\n" comp))
       (lambda (key . args)
 	(format #t "ERROR: during compilation of ~A:\n" file)
 	(display "ERROR: ")

module/system/base/language.scm

@@ -42,4 +42,4 @@
   (let ((m (resolve-module `(language ,name spec))))
     (if (module-bound? m name)
 	(module-ref m name)
-	(error "No such language:" name))))
+	(error "no such language" name))))

module/system/il/Makefile.am

@@ -1,12 +1,14 @@
-SOURCES = glil.scm ghil.scm macros.scm compile.scm
+SOURCES = glil.scm macros.scm
-OBJECTS = glil.go  ghil.go  macros.go  compile.go
+## FIXME: There's a bug showing up when compiling `ghil.scm' and
+## `compile.scm'!
+GOBJECTS = $(SOURCES:%.scm=%.go)
 
 vmdir = $(guiledir)/system/il
-vm_DATA = $(SOURCES) $(OBJECTS)
+vm_DATA = $(SOURCES) $(GOBJECTS)
 
-DISTCLEANFILES = $(OBJECTS)
+CLEANFILES = $(GOBJECTS)
 MAINTAINERCLEANFILES = Makefile.in
 
 SUFFIXES = .scm .go
-.scm.go:
+%.go: %.scm
 	$(GUILEC) $<

module/system/repl/Makefile.am

@@ -1,12 +1,13 @@
 SOURCES = repl.scm common.scm command.scm
-OBJECTS = repl.go  common.go  command.go
+##describe.scm
+GOBJECTS = $(SOURCES:%.scm=%.go)
 
 vmdir = $(guiledir)/system/repl
-vm_DATA = $(SOURCES) $(OBJECTS)
+vm_DATA = $(SOURCES) $(GOBJECTS)
 
-DISTCLEANFILES = $(OBJECTS)
+CLEANFILES = $(GOBJECTS)
 MAINTAINERCLEANFILES = Makefile.in
 
 SUFFIXES = .scm .go
-.scm.go:
+%.go: %.scm
 	$(GUILEC) $<

module/system/vm/Makefile.am

@@ -1,12 +1,13 @@
-SOURCES = assemble.scm conv.scm core.scm disasm.scm profile.scm trace.scm
+SOURCES = assemble.scm conv.scm core.scm debug.scm \
-OBJECTS = assemble.go  conv.go  core.go  disasm.go  profile.go  trace.go
+	  disasm.scm frame.scm profile.scm trace.scm
+GOBJECTS = $(SOURCES:%.scm=%.go)
 
 vmdir = $(guiledir)/system/vm
-vm_DATA = $(SOURCES) $(OBJECTS)
+vm_DATA = $(SOURCES) $(GOBJECTS)
 
-DISTCLEANFILES = $(OBJECTS)
+CLEANFILES = $(GOBJECTS)
 MAINTAINERCLEANFILES = Makefile.in
 
 SUFFIXES = .scm .go
-.scm.go:
+%.go: %.scm
 	$(GUILEC) $<

module/system/vm/assemble.scm

@@ -22,7 +22,10 @@
 (define-module (system vm assemble)
   :use-syntax (system base syntax)
   :use-module (system il glil)
-  :use-module (system vm core)
+  :use-module ((system vm core)
+	       :select (instruction? instruction-pops
+		        make-binding
+			bytecode->objcode))
   :use-module (system vm conv)
   :use-module (ice-9 match)
   :use-module (ice-9 regex)
@@ -275,4 +278,4 @@
 	 (for-each dump! (vector->list x))
 	 (push-code! `(vector ,(vector-length x))))
 	(else
-	 (error "Cannot dump:" x)))))))
+	 (error "assemble: unrecognized object" x)))))))

module/system/vm/conv.scm

@@ -20,7 +20,9 @@
 ;;; Code:
 
 (define-module (system vm conv)
-  :use-module (system vm core)
+  :use-module ((system vm core)
+	       :select (instruction? instruction-length
+			instruction->opcode))
   :use-module (ice-9 match)
   :use-module (ice-9 regex)
   :use-module (srfi srfi-4)

module/system/vm/debug.scm

@@ -21,7 +21,8 @@
 
 (define-module (system vm debug)
   :use-syntax (system base syntax)
-  :use-module (system vm core)
+;;  :use-module ((system vm core)
+;;	       :select (vm-last-frame-chain vm-backtrace))
   :use-module (system vm frame)
   :use-module (ice-9 format)
   :export (vm-debugger vm-backtrace))

module/system/vm/frame.scm

@@ -1,26 +1,26 @@
 ;;; Guile VM frame functions
 
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;; Copyright (C) 2001 Free Software Foundation, Inc.
-
+;;; Copyright (C) 2005 Ludovic Courtès  <ludovic.courtes@laas.fr>
-;; This program is free software; you can redistribute it and/or modify
+;;;
-;; it under the terms of the GNU General Public License as published by
+;;; This program is free software; you can redistribute it and/or modify
-;; the Free Software Foundation; either version 2, or (at your option)
+;;; it under the terms of the GNU General Public License as published by
-;; any later version.
+;;; the Free Software Foundation; either version 2 of the License, or
-;; 
+;;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;;;
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; This program is distributed in the hope that it will be useful,
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; GNU General Public License for more details.
+;;; 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 this program; see the file COPYING.  If not, write to
+;;; You should have received a copy of the GNU General Public License
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; along with this program; if not, write to the Free Software
-;; Boston, MA 02111-1307, USA.
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
 
 ;;; Code:
 
 (define-module (system vm frame)
-  :use-module (system vm core))
+  :use-module ((system vm core) :renamer (symbol-prefix-proc 'vm:)))
 
 
 ;;;
@@ -31,19 +31,20 @@
 (define-public frame-address (make-object-property))
 
 (define-public (vm-current-frame-chain vm)
-  (make-frame-chain (vm-this-frame vm) (vm:ip vm)))
+  (make-frame-chain (vm:vm-this-frame vm) (vm:vm:ip vm)))
 
 (define-public (vm-last-frame-chain vm)
-  (make-frame-chain (vm-last-frame vm) (vm:ip vm)))
+  (make-frame-chain (vm:vm-last-frame vm) (vm:vm:ip vm)))
 
 (define (make-frame-chain frame addr)
-  (let* ((link (frame-dynamic-link frame))
+  (let* ((link (vm:frame-dynamic-link frame))
 	 (chain (if (eq? link #t)
 		  '()
-		  (cons frame (make-frame-chain
+		  (cons frame (vm:make-frame-chain
-			       link (frame-return-address frame))))))
+			       link (vm:frame-return-address frame))))))
-    (set! (frame-number frame) (length chain))
+    (set! (vm:frame-number frame) (length chain))
-    (set! (frame-address frame) (- addr (program-base (frame-program frame))))
+    (set! (vm:frame-address frame)
+	  (- addr (program-base (vm:frame-program frame))))
     chain))
 
 
@@ -52,7 +53,7 @@
 ;;;
 
 (define-public (print-frame frame)
-  (format #t "#~A " (frame-number frame))
+  (format #t "#~A " (vm:frame-number frame))
   (print-frame-call frame)
   (newline))
 
@@ -67,12 +68,13 @@
 			 ((1) (vector (abbrev (vector-ref x 0))))
 			 (else (vector (abbrev (vector-ref x 0)) '...))))
 	  (else x)))
-  (write (abbrev (cons (program-name frame) (frame-arguments frame)))))
+  (write (abbrev (cons (program-name frame)
+		       (vm:frame-arguments frame)))))
 
 (define (program-name frame)
-  (let ((prog (frame-program frame))
+  (let ((prog (vm:frame-program frame))
-	(link (frame-dynamic-link frame)))
+	(link (vm:frame-dynamic-link frame)))
     (or (object-property prog 'name)
-	(frame-object-name link (1- (frame-address link)) prog)
+	(vm:frame-object-name link (1- (vm:frame-address link)) prog)
 	(hash-fold (lambda (s v d) (if (eq? prog (variable-ref v)) s d))
 		   prog (module-obarray (current-module))))))

src/guilec.in

@@ -1,5 +1,69 @@
 #!@guile@ -s
+# -*- Scheme -*-
 !#
+;;; guilec -- Command-line Guile Scheme compiler.
+;;;
+;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program 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 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
 
-(use-modules (system base compile))
+(use-modules (system base compile)
-(for-each compile-file (cdr (command-line)))
+	     (ice-9 getopt-long))
+
+(read-set! keywords 'prefix)
+
+(define %guilec-options
+  '((help           (single-char #\h) (value #f))
+    (optimize       (single-char #\O) (value #f))
+    (expand-only    (single-char #\e) (value #f))
+    (translate-only (single-char #\t) (value #f))
+    (compile-only   (single-char #\c) (value #f))))
+
+(let* ((options         (getopt-long (command-line) %guilec-options))
+       (help?           (option-ref options 'help #f))
+       (optimize?       (option-ref options 'optimize #f))
+       (expand-only?    (option-ref options 'expand-only #f))
+       (translate-only? (option-ref options 'translate-only #f))
+       (compile-only?   (option-ref options 'compile-only #f)))
+  (if help?
+      (begin
+	(format #t "Usage: guilec [OPTION] FILE...
+Compile each Guile Scheme source file FILE into a Guile object.
+
+  -h, --help           print this help message
+  -O, --optimize       turn on optimizations
+  -e, --expand-only    only go through the code expansion stage
+  -t, --translate-only stop after the translation to GHIL
+  -c, --compile-only   stop after the compilation to GLIL
+
+Report bugs to <guile-user@gnu.org>.~%")
+	(exit 0)))
+
+  (let ((compile-opts (append (if optimize? '(:O) '())
+			      (if expand-only? '(:e) '())
+			      (if translate-only? '(:t) '())
+			      (if compile-only? '(:c) '()))))
+
+    (catch #t
+      (lambda ()
+	(for-each (lambda (file)
+		    (apply compile-file (cons file compile-opts)))
+		  (option-ref options '() '())))
+      (lambda ()
+	(format (current-error-port) "removing compiled files due to errors~%")
+	(false-if-exception
+	 (for-each unlink (map compiled-file-name files)))
+	(exit 1)))))