diff options
| author | dos-reis <gdr@axiomatics.org> | 2008-09-22 14:37:26 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2008-09-22 14:37:26 +0000 |
| commit | 581024db9368e3ab437a59887ea074b704f23b7c (patch) | |
| tree | eafb9d9553c3c1c06cd2507afa9d06fa00be59c2 /src/boot/strap/ast.clisp | |
| parent | ce18c80b41c0dc210d9bab1d0bfeadaf9845d853 (diff) | |
| download | open-axiom-581024db9368e3ab437a59887ea074b704f23b7c.tar.gz | |
* boot/parser.boot (bpReturn): Allow assignment.
Diffstat (limited to 'src/boot/strap/ast.clisp')
| -rw-r--r-- | src/boot/strap/ast.clisp | 31 |
1 files changed, 23 insertions, 8 deletions
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|)))))) |