diff options
| author | dos-reis <gdr@axiomatics.org> | 2009-09-20 04:30:17 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2009-09-20 04:30:17 +0000 |
| commit | a50eb601b4dc0699cde4084584763798ee8dab02 (patch) | |
| tree | 540011a51f4396a3362cb066445c2fd250659b54 /src/boot/strap/ast.clisp | |
| parent | 0c55ed614187758d4e0a670fc4f031d5f4ad7e4e (diff) | |
| download | open-axiom-a50eb601b4dc0699cde4084584763798ee8dab02.tar.gz | |
* boot/tokens.boot: "has" is not a keyword.
* boot/ast.boot (bfHas): New.
(bfReduce): Use "has" instead "has".
(bfReduceCollect): Likewise.
(bfReName): Likewise.
(bfElt): Likewise.
(bfSetelt): Likewise.
* boot/parser.boot (bpSexpKey): Likewise.
(bpPrefixOperator): Likewise.
(bpInfixOperator): Likewise.
(bpThetaName): Likewise.
(bpIs): Parse "has" expressions.
* boot/pile.boot (shoePileCoagulate): Likewise.
* interp/: Fix unquoted use of "has".
* interp/interop.boot (has): Remove.
Diffstat (limited to 'src/boot/strap/ast.clisp')
| -rw-r--r-- | src/boot/strap/ast.clisp | 32 |
1 files changed, 20 insertions, 12 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 0c52e92b..615c3f0d 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1055,6 +1055,12 @@ (T (|bpSpecificErrorHere| "bad IS code is generated") (|bpTrap|)))))) +(DEFUN |bfHas| (|expr| |prop|) + (COND + ((IDENTP |prop|) (LIST 'GET |expr| (LIST 'QUOTE |prop|))) + (T (|bpSpecificErrorAtToken| + "expected identifier as property name")))) + (DEFUN |bfApplication| (|bfop| |bfarg|) (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|))) @@ -2050,9 +2056,9 @@ (LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|)))))) (DEFCONSTANT |$NativeSimpleDataTypes| - '(|char| |byte| |int| |int8| |uint8| |int16| |uint16| |int32| - |uint32| |int64| |uint64| |float| |float32| |double| - |float64|)) + '(|char| |byte| |int| |pointer| |int8| |uint8| |int16| |uint16| + |int32| |uint32| |int64| |uint64| |float| |float32| + |double| |float64|)) (DEFCONSTANT |$NativeSimpleReturnTypes| (APPEND |$NativeSimpleDataTypes| '(|void| |string|))) @@ -2148,6 +2154,14 @@ (T (|unknownNativeTypeError| |t|)))) ((EQ |t| '|float32|) (|nativeType| '|float|)) ((EQ |t| '|float64|) (|nativeType| '|double|)) + ((EQ |t| '|pointer|) + (COND + ((|%hasFeature| :GCL) '|fixnum|) + ((|%hasFeature| :ECL) :POINTER-VOID) + ((|%hasFeature| :SBCL) + (LIST '* (|bfColonColon| 'SB-ALIEN 'VOID))) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER)) + (T (|unknownNativeTypeError| |t|)))) (T (|unknownNativeTypeError| |t|)))) ((EQ (CAR |t|) '|buffer|) (COND @@ -2156,13 +2170,7 @@ ((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|)))) ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER)) (T (|unknownNativeTypeError| |t|)))) - ((EQ (CAR |t|) '|buffer|) - (COND - ((|%hasFeature| :GCL) '|fixnum|) - ((|%hasFeature| :ECL) :OBJECT) - ((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|)))) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER)) - (T (|unknownNativeTypeError| |t|)))) + ((EQ (CAR |t|) '|pointer|) (|nativeType| '|pointer|)) (T (|unknownNativeTypeError| |t|)))))) (DEFUN |nativeReturnType| (|t|) @@ -2188,7 +2196,7 @@ "missing modifier for argument type for a native function")) ((NOT (MEMBER |c| '(|buffer| |pointer|))) (|coreError| - "expect 'buffer' or 'pointer' type instance")) + "expected 'buffer' or 'pointer' type instance")) ((NOT (MEMBER |t'| |$NativeSimpleDataTypes|)) (|coreError| "expected simple native data type")) (T (|nativeType| (CADR |t|))))))))) @@ -2470,7 +2478,7 @@ ((EQ |y| '|double|) "->vector.self.df") (T (|coreError| "unknown argument to buffer type constructor")))) - ((EQ |c| '|pointer|) '||) + ((EQ |c| '|pointer|) "") (T (|coreError| "unknown type constructor")))))))) (DEFUN |genCLISPnativeTranslation| (|op| |s| |t| |op'|) |