* boot/parser.boot (bpReturn): Allow assignment.

6 files changed, 40 insertions, 19 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index e6587ace..0be9f737 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,7 @@
+2008-09-22  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/parser.boot (bpReturn): Allow assignment.
+
 2008-09-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* algebra/syntax.spad.pamphlet: Tie the recursive knots between
diff --git a/src/algebra/syntax.spad.pamphlet b/src/algebra/syntax.spad.pamphlet
index c6fb305e..963e841b 100644
--- a/src/algebra/syntax.spad.pamphlet
+++ b/src/algebra/syntax.spad.pamphlet
@@ -135,7 +135,9 @@ Syntax(): Public == Private where
       symbol? rep s
 
     coerce(x: %): OutputForm ==
-      rep(x)::OutputForm
+      x' := rep x
+      string? x' => outputForm(x' : String)
+      x'::OutputForm
 
     convert(x: %): SExpression ==
       rep x
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 8bf5086d..2ad0bac5 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -740,8 +740,10 @@ bpCatchItem() ==
   (bpException() or bpTrap()) and 
     bpPush %Catch bpPop1()
 
+++ Return:
+++   RETURN Assign
 bpReturn()==
-  (bpEqKey "RETURN" and  (bpAnd() or bpTrap()) and
+  (bpEqKey "RETURN" and  (bpAssign() or bpTrap()) and
 	 bpPush bfReturnNoName bpPop1()) 
     or bpThrow()
       or bpAnd()
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index f5536c0c..c07edd27 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -2200,20 +2200,35 @@
 
 (DEFUN |bootSymbol| (|s|) (INTERN (SYMBOL-NAME |s|)))
 
+(DEFUN |unknownNativeTypeError| (|t|)
+  (|fatalError| (CONCAT "unsupported native type: " (SYMBOL-NAME |t|))))
+
 (DEFUN |nativeType| (|t|)
   (PROG (|t'|)
     (DECLARE (SPECIAL |$NativeTypeTable|))
     (RETURN
       (COND
         ((NULL |t|) |t|)
+        ((OR (EQ |t| '|buffer|) (EQ |t| '|pointer|))
+         (COND
+           ((|%hasFeature| :GCL) 'FIXNUM)
+           ((|%hasFeature| :ECL) :POINTER-VOID)
+           ((|%hasFeature| :SBCL) (LIST '* T))
+           ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER))
+           (#0='T (|unknownNativeTypeError| |t|))))
         ((SETQ |t'|
                (CDR (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|)))
-         (COND
-           ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL))
-            (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE
-                  'BASE-CHAR))
-           (#0='T |t'|)))
-        (#0#
-         (|fatalError|
-             (CONCAT "unsupported native type: " (SYMBOL-NAME |t|))))))))
+         (PROGN
+           (SETQ |t'|
+                 (COND
+                   ((|%hasFeature| :SBCL)
+                    (|bfColonColon| 'SB-ALIEN |t'|))
+                   ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI |t'|))
+                   (#0# |t'|)))
+           (COND
+             ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL))
+              (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE
+                    'BASE-CHAR))
+             (#0# |t'|))))
+        (#0# (|unknownNativeTypeError| |t|))))))
 
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index baea8792..c6270474 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -783,7 +783,7 @@
        (|bpPush| (|%Catch| (|bpPop1|)))))
 
 (DEFUN |bpReturn| ()
-  (OR (AND (|bpEqKey| 'RETURN) (OR (|bpAnd|) (|bpTrap|))
+  (OR (AND (|bpEqKey| 'RETURN) (OR (|bpAssign|) (|bpTrap|))
            (|bpPush| (|bfReturnNoName| (|bpPop1|))))
       (|bpThrow|) (|bpAnd|)))
 
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index c58a80a2..1556ea0a 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -96,7 +96,7 @@
   (PROGN
     (SETQ *LOAD-VERBOSE* NIL)
     (COND
-      ((OR (|%hasFeature| :GCL) (|%hasFeature| :ECL))
+      ((|%hasFeature| :GCL)
        (SETF (SYMBOL-VALUE
                  (|bfColonColon| 'COMPILER '*COMPILE-VERBOSE*))
              NIL)
@@ -755,16 +755,14 @@
                                            (SETQ |bfVar#25|
                                             (CONS
                                              (LIST |a|
-                                              (|bfColonColon| 'FFI
-                                               (|nativeType| |x|)))
+                                              (|nativeType| |x|))
                                              |bfVar#25|))))
                                         (SETQ |bfVar#23|
                                          (CDR |bfVar#23|))
                                         (SETQ |bfVar#24|
                                          (CDR |bfVar#24|)))))
                                    (LIST :RETURN-TYPE
-                                    (|bfColonColon| 'FFI
-                                     (|nativeType| |t|)))
+                                    (|nativeType| |t|))
                                    (LIST :LANGUAGE :STDC))))
                      (SETQ |forwardingFun|
                            (LIST 'DEFUN |op| |args|
@@ -1718,9 +1716,9 @@
       (PROGN
         (SETQ |out| (NAMESTRING (|getOutputPathname| |options|)))
         (COND
-          (|out| (CONCAT (|shoeRemoveStringIfNec| |$effectiveFaslType|
-                             |out|)
-                         "clisp"))
+          (|out| (CONCAT (|shoeRemoveStringIfNec|
+                             (CONCAT "." |$effectiveFaslType|) |out|)
+                         ".clisp"))
           ('T (|defaultBootToLispFile| |file|)))))))
 
 (DEFUN |translateBootFile| (|progname| |options| |file|)