make some predicates return t/f instead of something/f.
parent
f1e232c981
commit
934b307ba2
|
@ -45,7 +45,7 @@ M: no-c-type summary drop "Not a C type" ;
|
||||||
GENERIC: lookup-c-type ( name -- c-type ) foldable
|
GENERIC: lookup-c-type ( name -- c-type ) foldable
|
||||||
|
|
||||||
PREDICATE: c-type-word < word
|
PREDICATE: c-type-word < word
|
||||||
"c-type" word-prop ;
|
"c-type" word-prop >boolean ;
|
||||||
|
|
||||||
TUPLE: pointer { to initial: void read-only } ;
|
TUPLE: pointer { to initial: void read-only } ;
|
||||||
C: <pointer> pointer
|
C: <pointer> pointer
|
||||||
|
|
|
@ -171,7 +171,7 @@ PREDICATE: alien-function-word < alien-function-alias-word
|
||||||
[ def>> third ] [ name>> ] bi = ;
|
[ def>> third ] [ name>> ] bi = ;
|
||||||
|
|
||||||
PREDICATE: alien-callback-type-word < typedef-word
|
PREDICATE: alien-callback-type-word < typedef-word
|
||||||
"callback-effect" word-prop ;
|
"callback-effect" word-prop >boolean ;
|
||||||
|
|
||||||
: global-quot ( type word -- quot )
|
: global-quot ( type word -- quot )
|
||||||
swap [ name>> current-library get ] dip
|
swap [ name>> current-library get ] dip
|
||||||
|
|
|
@ -54,7 +54,8 @@ TUPLE: broadcast < consultation ;
|
||||||
[ class>> swap first create-method dup fake-definition ] keep
|
[ class>> swap first create-method dup fake-definition ] keep
|
||||||
[ drop ] [ "consultation" set-word-prop ] 2bi ;
|
[ drop ] [ "consultation" set-word-prop ] 2bi ;
|
||||||
|
|
||||||
PREDICATE: consult-method < method "consultation" word-prop ;
|
PREDICATE: consult-method < method
|
||||||
|
"consultation" word-prop >boolean ;
|
||||||
|
|
||||||
M: consult-method reset-word
|
M: consult-method reset-word
|
||||||
[ call-next-method ] [ f "consultation" set-word-prop ] bi ;
|
[ call-next-method ] [ f "consultation" set-word-prop ] bi ;
|
||||||
|
|
|
@ -61,9 +61,9 @@ ERROR: bad-math-inverse ;
|
||||||
|
|
||||||
: undo-literal ( object -- quot ) [ =/fail ] curry ;
|
: undo-literal ( object -- quot ) [ =/fail ] curry ;
|
||||||
|
|
||||||
PREDICATE: normal-inverse < word "inverse" word-prop ;
|
PREDICATE: normal-inverse < word "inverse" word-prop >boolean ;
|
||||||
PREDICATE: math-inverse < word "math-inverse" word-prop ;
|
PREDICATE: math-inverse < word "math-inverse" word-prop >boolean ;
|
||||||
PREDICATE: pop-inverse < word "pop-length" word-prop ;
|
PREDICATE: pop-inverse < word "pop-length" word-prop >boolean ;
|
||||||
UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
|
UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
|
||||||
|
|
||||||
: enough? ( stack word -- ? )
|
: enough? ( stack word -- ? )
|
||||||
|
|
|
@ -72,7 +72,7 @@ SYNTAX: MEMO: (:) define-memoized ;
|
||||||
|
|
||||||
SYNTAX: IDENTITY-MEMO: (:) define-identity-memoized ;
|
SYNTAX: IDENTITY-MEMO: (:) define-identity-memoized ;
|
||||||
|
|
||||||
PREDICATE: memoized < word "memoize" word-prop ;
|
PREDICATE: memoized < word "memoize" word-prop >boolean ;
|
||||||
|
|
||||||
M: memoized definer drop \ MEMO: \ ; ;
|
M: memoized definer drop \ MEMO: \ ; ;
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,8 @@ USING: definitions kernel locals.definitions see see.private typed
|
||||||
words summary make accessors classes prettyprint ;
|
words summary make accessors classes prettyprint ;
|
||||||
IN: typed.prettyprint
|
IN: typed.prettyprint
|
||||||
|
|
||||||
PREDICATE: typed-lambda-word < lambda-word "typed-word" word-prop ;
|
PREDICATE: typed-lambda-word < lambda-word
|
||||||
|
"typed-word" word-prop >boolean ;
|
||||||
|
|
||||||
M: typed-word definer drop \ TYPED: \ ; ;
|
M: typed-word definer drop \ TYPED: \ ; ;
|
||||||
M: typed-lambda-word definer drop \ TYPED:: \ ; ;
|
M: typed-lambda-word definer drop \ TYPED:: \ ; ;
|
||||||
|
|
|
@ -38,7 +38,7 @@ PRIVATE>
|
||||||
SYNTAX: DESCRIPTIVE: (:) define-descriptive ;
|
SYNTAX: DESCRIPTIVE: (:) define-descriptive ;
|
||||||
|
|
||||||
PREDICATE: descriptive < word
|
PREDICATE: descriptive < word
|
||||||
"descriptive-definition" word-prop ;
|
"descriptive-definition" word-prop >boolean ;
|
||||||
|
|
||||||
M: descriptive definer drop \ DESCRIPTIVE: \ ; ;
|
M: descriptive definer drop \ DESCRIPTIVE: \ ; ;
|
||||||
|
|
||||||
|
|
|
@ -7,7 +7,7 @@ FROM: help.markup.private => link-effect? ;
|
||||||
IN: variables
|
IN: variables
|
||||||
|
|
||||||
PREDICATE: variable < word
|
PREDICATE: variable < word
|
||||||
"variable-setter" word-prop ;
|
"variable-setter" word-prop >boolean ;
|
||||||
|
|
||||||
GENERIC: variable-setter ( word -- word' )
|
GENERIC: variable-setter ( word -- word' )
|
||||||
|
|
||||||
|
@ -35,7 +35,7 @@ SYNTAX: set:
|
||||||
dup [ [variable-getter] ] [ [variable-setter] ] bi (define-variable) ;
|
dup [ [variable-getter] ] [ [variable-setter] ] bi (define-variable) ;
|
||||||
|
|
||||||
SYNTAX: VAR:
|
SYNTAX: VAR:
|
||||||
scan-new-word define-variable ;
|
scan-new-word define-variable ;
|
||||||
|
|
||||||
M: variable definer drop \ VAR: f ;
|
M: variable definer drop \ VAR: f ;
|
||||||
M: variable definition drop f ;
|
M: variable definition drop f ;
|
||||||
|
@ -43,7 +43,7 @@ M: variable link-effect? drop f ;
|
||||||
M: variable print-stack-effect? drop f ;
|
M: variable print-stack-effect? drop f ;
|
||||||
|
|
||||||
PREDICATE: typed-variable < variable
|
PREDICATE: typed-variable < variable
|
||||||
"variable-type" word-prop ;
|
"variable-type" word-prop >boolean ;
|
||||||
|
|
||||||
: [typed-getter] ( quot type -- quot )
|
: [typed-getter] ( quot type -- quot )
|
||||||
1array '[ @ _ declare ] ;
|
1array '[ @ _ declare ] ;
|
||||||
|
|
|
@ -5,7 +5,7 @@ classes.union combinators inverse kernel lexer macros make
|
||||||
parser quotations sequences slots splitting words ;
|
parser quotations sequences slots splitting words ;
|
||||||
IN: variants
|
IN: variants
|
||||||
|
|
||||||
PREDICATE: variant-class < mixin-class "variant" word-prop ;
|
PREDICATE: variant-class < mixin-class "variant?" word-prop ;
|
||||||
|
|
||||||
M: variant-class initial-value*
|
M: variant-class initial-value*
|
||||||
dup members [ drop f f ]
|
dup members [ drop f f ]
|
||||||
|
@ -19,7 +19,7 @@ M: variant-class initial-value*
|
||||||
dup array? [ first3 pick [ define-tuple-class-and-boa-word ] dip ] [ dup define-singleton-class ] if ;
|
dup array? [ first3 pick [ define-tuple-class-and-boa-word ] dip ] [ dup define-singleton-class ] if ;
|
||||||
|
|
||||||
: define-variant-class ( class -- )
|
: define-variant-class ( class -- )
|
||||||
[ define-mixin-class ] [ t "variant" set-word-prop ] bi ;
|
[ define-mixin-class ] [ t "variant?" set-word-prop ] bi ;
|
||||||
|
|
||||||
: define-variant-class-member ( class member -- )
|
: define-variant-class-member ( class member -- )
|
||||||
define-variant-member swap add-mixin-instance ;
|
define-variant-member swap add-mixin-instance ;
|
||||||
|
|
Loading…
Reference in New Issue