fix compilation of glil to assembly

* libguile/vm-i-scheme.c (VM_VALIDATE_STRUCT): Fix the error message if
  the value was not a struct.

* module/system/base/compile.scm (find-language-joint): Default to
  joining at the target language.
  (default-language-joiner): Allow sequences of one compiled expression
  to pass through.  Otherwise error as before.
  (read-and-parse): New helper; actually parses.
  (read-and-compile): Use read-and-parse, and fall back to
  default-language-joiner.

Thanks to Nala Ginrut for the report.

diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 5191b8e..b85d980 100644 (file)
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -499,7 +499,7 @@ VM_DEFINE_INSTRUCTION (165, make_array, "make-array", 3, -1, 1)
  * Structs
  */
 #define VM_VALIDATE_STRUCT(obj, proc)           \
-  VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj))
+  VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_struct (proc, obj))
 
 VM_DEFINE_FUNCTION (166, struct_p, "struct?", 1)
 {

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 1c3320a..0e44f36 100644 (file)
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -181,12 +181,26 @@
   (let lp ((in (reverse (or (lookup-compilation-order from to)
                             (error "no way to compile" from "to" to))))
            (lang to))
-    (cond ((null? in)
-           (error "don't know how to join expressions" from to))
+    (cond ((null? in) to)
           ((language-joiner lang) lang)
           (else
            (lp (cdr in) (caar in))))))
 
+(define (default-language-joiner lang)
+  (lambda (exps env)
+    (if (and (pair? exps) (null? (cdr exps)))
+        (car exps)
+        (error
+         "Multiple expressions read and compiled, but language has no joiner"
+         lang))))
+
+(define (read-and-parse lang port cenv)
+  (let ((exp ((language-reader lang) port cenv)))
+    (cond
+     ((eof-object? exp) exp)
+     ((language-parser lang) => (lambda (parse) (parse exp)))
+     (else exp))))
+
 (define* (read-and-compile port #:key
                            (from (current-language))
                            (to 'objcode)
@@ -197,11 +211,14 @@
     (let ((joint (find-language-joint from to)))
       (with-fluids ((*current-language* from))
         (let lp ((exps '()) (env #f) (cenv env))
-          (let ((x ((language-reader (current-language)) port cenv)))
+          (let ((x (read-and-parse (current-language) port cenv)))
             (cond
              ((eof-object? x)
               (close-port port)
-              (compile ((language-joiner joint) (reverse exps) env)
+              (compile ((or (language-joiner joint)
+                            (default-language-joiner joint))
+                        (reverse exps)
+                        env)
                        #:from joint #:to to
                        ;; env can be false if no expressions were read.
                        #:env (or env (default-environment joint))