diff options
Diffstat (limited to 'src/boot/strap')
| -rw-r--r-- | src/boot/strap/ast.clisp | 32 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 12 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 6 |
3 files changed, 30 insertions, 20 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'|) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 716b86d1..5683aef5 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -700,11 +700,13 @@ (DEFUN |bpIs| () (AND (|bpArith|) - (OR (AND (|bpInfKey| '(IS ISNT)) (OR (|bpPattern|) (|bpTrap|)) - (|bpPush| - (|bfISApplication| (|bpPop2|) (|bpPop2|) - (|bpPop1|)))) - T))) + (COND + ((AND (|bpInfKey| '(IS ISNT)) (OR (|bpPattern|) (|bpTrap|))) + (|bpPush| + (|bfISApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|)))) + ((AND (|bpEqKey| 'HAS) (OR (|bpApplication|) (|bpTrap|))) + (|bpPush| (|bfHas| (|bpPop2|) (|bpPop1|)))) + (T T)))) (DEFUN |bpBracketConstruct| (|f|) (AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|))))) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 9deef054..ce8f5cac 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -8,9 +8,9 @@ (DEFCONSTANT |shoeKeyWords| (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE) (LIST "catch" 'CATCH) (LIST "cross" 'CROSS) - (LIST "else" 'ELSE) (LIST "for" 'FOR) (LIST "if" 'IF) - (LIST "import" 'IMPORT) (LIST "in" 'IN) (LIST "is" 'IS) - (LIST "isnt" 'ISNT) (LIST "module" 'MODULE) + (LIST "else" 'ELSE) (LIST "for" 'FOR) (LIST "has" 'HAS) + (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN) + (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "module" 'MODULE) (LIST "namespace" 'NAMESPACE) (LIST "of" 'OF) (LIST "or" 'OR) (LIST "repeat" 'REPEAT) (LIST "return" 'RETURN) (LIST "structure" 'STRUCTURE) (LIST "then" 'THEN) |