Rename lookup to lookup-word.
parent
cb84fefc37
commit
c731dc6edb
|
@ -108,13 +108,13 @@ gc
|
|||
"." write flush
|
||||
|
||||
os windows? [
|
||||
"GetLastError" "windows.kernel32" lookup
|
||||
"FormatMessageW" "windows.kernel32" lookup
|
||||
"GetLastError" "windows.kernel32" lookup-word
|
||||
"FormatMessageW" "windows.kernel32" lookup-word
|
||||
2array compile-unoptimized
|
||||
] when
|
||||
|
||||
os unix? [
|
||||
"(dlerror)" "alien.libraries.unix" lookup
|
||||
"(dlerror)" "alien.libraries.unix" lookup-word
|
||||
1array compile-unoptimized
|
||||
] when
|
||||
|
||||
|
|
|
@ -458,7 +458,7 @@ M: tuple ' emit-tuple ;
|
|||
|
||||
M: tombstone '
|
||||
state>> "((tombstone))" "((empty))" ?
|
||||
"hashtables.private" lookup def>> first
|
||||
"hashtables.private" lookup-word def>> first
|
||||
[ emit-tuple ] cache-eql-object ;
|
||||
|
||||
! Arrays
|
||||
|
|
|
@ -15,7 +15,7 @@ TUPLE: insn-slot-spec type name rep ;
|
|||
{
|
||||
{ [ dup not ] [ ] }
|
||||
{ [ dup "scalar-rep" = ] [ drop scalar-rep ] }
|
||||
[ "cpu.architecture" lookup ]
|
||||
[ "cpu.architecture" lookup-word ]
|
||||
} cond ;
|
||||
|
||||
: parse-insn-slot-spec ( type string -- spec )
|
||||
|
@ -48,19 +48,19 @@ TUPLE: insn-slot-spec type name rep ;
|
|||
! We cannot reference words in compiler.cfg.instructions directly
|
||||
! since that would create circularity.
|
||||
: insn-classes-word ( -- word )
|
||||
"insn-classes" "compiler.cfg.instructions" lookup ;
|
||||
"insn-classes" "compiler.cfg.instructions" lookup-word ;
|
||||
|
||||
: insn-word ( -- word )
|
||||
"insn" "compiler.cfg.instructions" lookup ;
|
||||
"insn" "compiler.cfg.instructions" lookup-word ;
|
||||
|
||||
: vreg-insn-word ( -- word )
|
||||
"vreg-insn" "compiler.cfg.instructions" lookup ;
|
||||
"vreg-insn" "compiler.cfg.instructions" lookup-word ;
|
||||
|
||||
: flushable-insn-word ( -- word )
|
||||
"flushable-insn" "compiler.cfg.instructions" lookup ;
|
||||
"flushable-insn" "compiler.cfg.instructions" lookup-word ;
|
||||
|
||||
: foldable-insn-word ( -- word )
|
||||
"foldable-insn" "compiler.cfg.instructions" lookup ;
|
||||
"foldable-insn" "compiler.cfg.instructions" lookup-word ;
|
||||
|
||||
: insn-effect ( word -- effect )
|
||||
boa-effect in>> but-last { } <effect> ;
|
||||
|
|
|
@ -22,7 +22,7 @@ IN: compiler.tests.folding
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"fold-test" "compiler.tests.folding" lookup execute
|
||||
"fold-test" "compiler.tests.folding" lookup execute
|
||||
"fold-test" "compiler.tests.folding" lookup-word execute
|
||||
"fold-test" "compiler.tests.folding" lookup-word execute
|
||||
eq?
|
||||
] unit-test
|
||||
|
|
|
@ -21,11 +21,11 @@ IN: compiler.tests.redefine11
|
|||
|
||||
[ ] [
|
||||
[
|
||||
array "my-mixin" "compiler.tests.redefine11" lookup
|
||||
array "my-mixin" "compiler.tests.redefine11" lookup-word
|
||||
remove-mixin-instance
|
||||
] with-compilation-unit
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [
|
||||
"my-inline" "compiler.tests.redefine11" lookup execute
|
||||
"my-inline" "compiler.tests.redefine11" lookup-word execute
|
||||
] unit-test
|
||||
|
|
|
@ -2,10 +2,10 @@ USING: eval tools.test definitions words compiler.units
|
|||
quotations stack-checker ;
|
||||
IN: compiler.tests.redefine16
|
||||
|
||||
[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test
|
||||
[ ] [ [ "blah" "compiler.tests.redefine16" lookup-word forget ] with-compilation-unit ] unit-test
|
||||
|
||||
[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- )" eval( -- ) ] unit-test
|
||||
[ ] [ "IN: compiler.tests.redefine16 USING: strings math arrays prettyprint ; M: string blah 1 + 3array . ;" eval( -- ) ] unit-test
|
||||
[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- x )" eval( -- ) ] unit-test
|
||||
|
||||
[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test
|
||||
[ ] [ [ "blah" "compiler.tests.redefine16" lookup-word forget ] with-compilation-unit ] unit-test
|
||||
|
|
|
@ -20,6 +20,6 @@ M: d g2 drop d ;
|
|||
|
||||
[ ] [ "IN: compiler.tests.redefine18 SINGLETON: b INSTANCE: b d" eval( -- ) ] unit-test
|
||||
|
||||
[ d ] [ "b" "compiler.tests.redefine18" lookup g1 ] unit-test
|
||||
[ d ] [ "b" "compiler.tests.redefine18" lookup-word g1 ] unit-test
|
||||
|
||||
[ ] [ "IN: compiler.tests.redefine18 FORGET: b" eval( -- ) ] unit-test
|
||||
|
|
|
@ -23,6 +23,6 @@ IN: compiler.tests.redefine5
|
|||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
"my-tuple" "compiler.tests.redefine5" lookup boa
|
||||
"my-inline" "compiler.tests.redefine5" lookup execute
|
||||
"my-tuple" "compiler.tests.redefine5" lookup-word boa
|
||||
"my-inline" "compiler.tests.redefine5" lookup-word execute
|
||||
] unit-test
|
||||
|
|
|
@ -26,6 +26,6 @@ IN: compiler.tests.redefine6
|
|||
] unit-test
|
||||
|
||||
[ 1 ] [
|
||||
"my-tuple" "compiler.tests.redefine6" lookup boa
|
||||
"my-inline" "compiler.tests.redefine6" lookup execute
|
||||
"my-tuple" "compiler.tests.redefine6" lookup-word boa
|
||||
"my-inline" "compiler.tests.redefine6" lookup-word execute
|
||||
] unit-test
|
||||
|
|
|
@ -23,5 +23,5 @@ IN: compiler.tests.redefine7
|
|||
] unit-test
|
||||
|
||||
[ 2.0 ] [
|
||||
1.0 "my-inline" "compiler.tests.redefine7" lookup execute
|
||||
1.0 "my-inline" "compiler.tests.redefine7" lookup-word execute
|
||||
] unit-test
|
||||
|
|
|
@ -26,5 +26,5 @@ IN: compiler.tests.redefine8
|
|||
] unit-test
|
||||
|
||||
[ 2.0 ] [
|
||||
1.0 "my-generic" "compiler.tests.redefine8" lookup execute
|
||||
1.0 "my-generic" "compiler.tests.redefine8" lookup-word execute
|
||||
] unit-test
|
||||
|
|
|
@ -27,7 +27,7 @@ IN: compiler.tests.redefine9
|
|||
] unit-test
|
||||
|
||||
[
|
||||
"my-tuple" "compiler.tests.redefine9" lookup boa
|
||||
"my-generic" "compiler.tests.redefine9" lookup
|
||||
"my-tuple" "compiler.tests.redefine9" lookup-word boa
|
||||
"my-generic" "compiler.tests.redefine9" lookup-word
|
||||
execute
|
||||
] [ no-math-method? ] must-fail-with
|
||||
|
|
|
@ -115,14 +115,14 @@ M: integer W 1 + ;
|
|||
] unit-test
|
||||
|
||||
: test-redefinition ( -- )
|
||||
[ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "some-generic" "functors.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "some-word" "functors.tests" lookup-word >boolean ] unit-test
|
||||
[ t ] [ "some-tuple" "functors.tests" lookup-word >boolean ] unit-test
|
||||
[ t ] [ "some-generic" "functors.tests" lookup-word >boolean ] unit-test
|
||||
[ t ] [
|
||||
"some-tuple" "functors.tests" lookup
|
||||
"some-generic" "functors.tests" lookup lookup-method >boolean
|
||||
"some-tuple" "functors.tests" lookup-word
|
||||
"some-generic" "functors.tests" lookup-word lookup-method >boolean
|
||||
] unit-test ;
|
||||
[ t ] [ "some-symbol" "functors.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "some-symbol" "functors.tests" lookup-word >boolean ] unit-test
|
||||
|
||||
test-redefinition
|
||||
|
||||
|
|
|
@ -15,7 +15,7 @@ IN: furnace.utilities
|
|||
ERROR: no-such-word name vocab ;
|
||||
|
||||
: string>word ( string -- word )
|
||||
":" split1 swap 2dup lookup dup
|
||||
":" split1 swap 2dup lookup-word dup
|
||||
[ 2nip ] [ drop no-such-word ] if ;
|
||||
|
||||
: strings>words ( seq -- seq' )
|
||||
|
|
|
@ -14,13 +14,13 @@ IN: help.crossref.tests
|
|||
|
||||
[ t ] [
|
||||
"foo" article-children
|
||||
"foo" "help.crossref.tests" lookup >link 1array sequence=
|
||||
"foo" "help.crossref.tests" lookup-word >link 1array sequence=
|
||||
] unit-test
|
||||
|
||||
[ "foo" ] [ "foo" "help.crossref.tests" lookup article-parent ] unit-test
|
||||
[ "foo" ] [ "foo" "help.crossref.tests" lookup-word article-parent ] unit-test
|
||||
|
||||
[ ] [
|
||||
[ "foo" "help.crossref.tests" lookup forget ] with-compilation-unit
|
||||
[ "foo" "help.crossref.tests" lookup-word forget ] with-compilation-unit
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
|
@ -16,7 +16,7 @@ IN: help.definitions.tests
|
|||
[ t ] [ "hello" articles get key? ] unit-test
|
||||
[ t ] [ "hello2" articles get key? ] unit-test
|
||||
[ t ] [
|
||||
"hello" "help.definitions.tests" lookup "help" word-prop >boolean
|
||||
"hello" "help.definitions.tests" lookup-word "help" word-prop >boolean
|
||||
] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
|
@ -29,12 +29,12 @@ IN: help.definitions.tests
|
|||
[ t ] [ "hello" articles get key? ] unit-test
|
||||
[ f ] [ "hello2" articles get key? ] unit-test
|
||||
[ f ] [
|
||||
"hello" "help.definitions.tests" lookup "help" word-prop
|
||||
"hello" "help.definitions.tests" lookup-word "help" word-prop
|
||||
] unit-test
|
||||
|
||||
[ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" eval( -- ) ] unit-test
|
||||
|
||||
[ ] [ "xxx" "help.definitions.tests" lookup print-topic ] unit-test
|
||||
[ ] [ "xxx" "help.definitions.tests" lookup-word print-topic ] unit-test
|
||||
|
||||
[ ] [ "xxx" "help.definitions.tests" lookup >link synopsis print ] unit-test
|
||||
[ ] [ "xxx" "help.definitions.tests" lookup-word >link synopsis print ] unit-test
|
||||
] with-file-vocabs
|
||||
|
|
|
@ -70,7 +70,7 @@ CHLOE: validation-errors
|
|||
drop [ render-validation-errors ] [code] ;
|
||||
|
||||
: attr>word ( value -- word/f )
|
||||
":" split1 swap lookup ;
|
||||
":" split1 swap lookup-word ;
|
||||
|
||||
: if>quot ( tag -- quot )
|
||||
[
|
||||
|
|
|
@ -119,10 +119,10 @@ CONSTANT: vector-words
|
|||
: vector-word-inputs ( schema -- seq ) { -> } split first ;
|
||||
|
||||
: with-ctors ( -- seq )
|
||||
simd-classes [ [ name>> "-with" append ] [ vocabulary>> ] bi lookup ] map ;
|
||||
simd-classes [ [ name>> "-with" append ] [ vocabulary>> ] bi lookup-word ] map ;
|
||||
|
||||
: boa-ctors ( -- seq )
|
||||
simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup ] map ;
|
||||
simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup-word ] map ;
|
||||
|
||||
: check-optimizer ( seq test-quot eq-quot -- failures )
|
||||
#! Use test-quot to generate a bunch of test cases from the
|
||||
|
|
|
@ -103,7 +103,7 @@ unit-test
|
|||
[
|
||||
[ parse-fresh drop ] with-compilation-unit
|
||||
[
|
||||
"prettyprint.tests" lookup see
|
||||
"prettyprint.tests" lookup-word see
|
||||
] with-string-writer "\n" split but-last
|
||||
] keep =
|
||||
] with-interactive-vocabs ;
|
||||
|
@ -261,7 +261,7 @@ M: class-see-layout class-see-layout ;
|
|||
[ t ] [
|
||||
"IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
|
||||
dup eval( -- )
|
||||
"generic-decl-test" "prettyprint.tests" lookup
|
||||
"generic-decl-test" "prettyprint.tests" lookup-word
|
||||
[ see ] with-string-writer =
|
||||
] unit-test
|
||||
|
||||
|
|
|
@ -194,7 +194,7 @@ SYMBOL: deserialized
|
|||
(deserialize-string) dup intern-object ;
|
||||
|
||||
: deserialize-word ( -- word )
|
||||
(deserialize) (deserialize) 2dup [ require ] keep lookup
|
||||
(deserialize) (deserialize) 2dup [ require ] keep lookup-word
|
||||
dup [ 2nip ] [
|
||||
drop
|
||||
2array unparse "Unknown word: " prepend throw
|
||||
|
|
|
@ -156,7 +156,7 @@ SPECIALIZED-ARRAY: __does_not_exist__
|
|||
|
||||
[ f ] [
|
||||
"__does_not_exist__-array{"
|
||||
__does_not_exist__ specialized-array-vocab lookup
|
||||
__does_not_exist__ specialized-array-vocab lookup-word
|
||||
deferred?
|
||||
] unit-test
|
||||
|
||||
|
|
|
@ -140,35 +140,35 @@ ERROR: specialized-array-vocab-not-loaded c-type ;
|
|||
|
||||
M: c-type-word c-array-constructor
|
||||
underlying-type
|
||||
dup [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
|
||||
dup [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup-word
|
||||
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
|
||||
|
||||
M: pointer c-array-constructor drop void* c-array-constructor ;
|
||||
|
||||
M: c-type-word c-(array)-constructor
|
||||
underlying-type
|
||||
dup [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
|
||||
dup [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup-word
|
||||
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
|
||||
|
||||
M: pointer c-(array)-constructor drop void* c-(array)-constructor ;
|
||||
|
||||
M: c-type-word c-direct-array-constructor
|
||||
underlying-type
|
||||
dup [ name>> "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
|
||||
dup [ name>> "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup-word
|
||||
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
|
||||
|
||||
M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ;
|
||||
|
||||
M: c-type-word c-array-type
|
||||
underlying-type
|
||||
dup [ name>> "-array" append ] [ specialized-array-vocab ] bi lookup
|
||||
dup [ name>> "-array" append ] [ specialized-array-vocab ] bi lookup-word
|
||||
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
|
||||
|
||||
M: pointer c-array-type drop void* c-array-type ;
|
||||
|
||||
M: c-type-word c-array-type?
|
||||
underlying-type
|
||||
dup [ name>> "-array?" append ] [ specialized-array-vocab ] bi lookup
|
||||
dup [ name>> "-array?" append ] [ specialized-array-vocab ] bi lookup-word
|
||||
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
|
||||
|
||||
M: pointer c-array-type? drop void* c-array-type? ;
|
||||
|
|
|
@ -299,11 +299,11 @@ IN: tools.deploy.shaker
|
|||
|
||||
: strip-vocab-globals ( except names -- words )
|
||||
[ child-vocabs [ words ] map concat ] map concat
|
||||
swap [ first2 lookup ] map sift diff ;
|
||||
swap [ first2 lookup-word ] map sift diff ;
|
||||
|
||||
: stripped-globals ( -- seq )
|
||||
[
|
||||
"inspector-hook" "inspector" lookup ,
|
||||
"inspector-hook" "inspector" lookup-word ,
|
||||
|
||||
{
|
||||
continuations:error
|
||||
|
@ -320,14 +320,14 @@ IN: tools.deploy.shaker
|
|||
current-directory
|
||||
} %
|
||||
|
||||
"io-thread" "io.thread" lookup ,
|
||||
"io-thread" "io.thread" lookup-word ,
|
||||
|
||||
"disposables" "destructors" lookup ,
|
||||
"disposables" "destructors" lookup-word ,
|
||||
|
||||
"functor-words" "functors.backend" lookup ,
|
||||
"functor-words" "functors.backend" lookup-word ,
|
||||
|
||||
deploy-threads? [
|
||||
"initial-thread" "threads" lookup ,
|
||||
"initial-thread" "threads" lookup-word ,
|
||||
] unless
|
||||
|
||||
strip-io? [ io-backend , ] when
|
||||
|
@ -343,7 +343,7 @@ IN: tools.deploy.shaker
|
|||
} strip-vocab-globals %
|
||||
|
||||
strip-dictionary? [
|
||||
"libraries" "alien" lookup ,
|
||||
"libraries" "alien" lookup-word ,
|
||||
|
||||
{ { "yield-hook" "compiler.utilities" } }
|
||||
{ "cpu" "compiler" } strip-vocab-globals %
|
||||
|
@ -395,7 +395,7 @@ IN: tools.deploy.shaker
|
|||
\ compiler.errors:compiler-errors ,
|
||||
] when
|
||||
|
||||
"windows-messages" "windows.messages" lookup [ , ] when*
|
||||
"windows-messages" "windows.messages" lookup-word [ , ] when*
|
||||
] { } make ;
|
||||
|
||||
: strip-globals ( stripped-globals -- )
|
||||
|
@ -451,9 +451,9 @@ IN: tools.deploy.shaker
|
|||
|
||||
SYMBOL: deploy-vocab
|
||||
|
||||
: [:c] ( -- word ) ":c" "debugger" lookup ;
|
||||
: [:c] ( -- word ) ":c" "debugger" lookup-word ;
|
||||
|
||||
: [print-error] ( -- word ) "print-error" "debugger" lookup ;
|
||||
: [print-error] ( -- word ) "print-error" "debugger" lookup-word ;
|
||||
|
||||
: deploy-startup-quot ( word -- )
|
||||
[
|
||||
|
@ -532,9 +532,9 @@ SYMBOL: deploy-vocab
|
|||
] each
|
||||
|
||||
[
|
||||
"deploy-libraries" "alien.libraries" lookup forget
|
||||
"deploy-library" "alien.libraries" lookup forget
|
||||
">deployed-library-path" "alien.libraries.private" lookup forget
|
||||
"deploy-libraries" "alien.libraries" lookup-word forget
|
||||
"deploy-library" "alien.libraries" lookup-word forget
|
||||
">deployed-library-path" "alien.libraries.private" lookup-word forget
|
||||
] with-compilation-unit ;
|
||||
|
||||
: strip ( vocab-manifest-out -- )
|
||||
|
|
|
@ -94,7 +94,7 @@ ERROR: bad-platform name ;
|
|||
|
||||
: vocab-platforms ( vocab -- platforms )
|
||||
dup vocab-platforms-path vocab-file-contents
|
||||
[ dup "system" lookup [ ] [ bad-platform ] ?if ] map ;
|
||||
[ dup "system" lookup-word [ ] [ bad-platform ] ?if ] map ;
|
||||
|
||||
: set-vocab-platforms ( platforms vocab -- )
|
||||
[ [ name>> ] map ] dip
|
||||
|
|
|
@ -140,7 +140,7 @@ call( -- )
|
|||
"bignum" "math" create register-builtin
|
||||
"tuple" "kernel" create register-builtin
|
||||
"float" "math" create register-builtin
|
||||
"f" "syntax" lookup register-builtin
|
||||
"f" "syntax" lookup-word register-builtin
|
||||
"array" "arrays" create register-builtin
|
||||
"wrapper" "kernel" create register-builtin
|
||||
"callstack" "kernel" create register-builtin
|
||||
|
@ -152,23 +152,23 @@ call( -- )
|
|||
"byte-array" "byte-arrays" create register-builtin
|
||||
|
||||
! We need this before defining c-ptr below
|
||||
"f" "syntax" lookup { } define-builtin
|
||||
"f" "syntax" lookup-word { } define-builtin
|
||||
|
||||
"f" "syntax" create [ not ] "predicate" set-word-prop
|
||||
"f?" "syntax" vocab-words delete-at
|
||||
|
||||
"t" "syntax" lookup define-singleton-class
|
||||
"t" "syntax" lookup-word define-singleton-class
|
||||
|
||||
! Some unions
|
||||
"c-ptr" "alien" create [
|
||||
"alien" "alien" lookup ,
|
||||
"f" "syntax" lookup ,
|
||||
"byte-array" "byte-arrays" lookup ,
|
||||
"alien" "alien" lookup-word ,
|
||||
"f" "syntax" lookup-word ,
|
||||
"byte-array" "byte-arrays" lookup-word ,
|
||||
] { } make define-union-class
|
||||
|
||||
! A predicate class used for declarations
|
||||
"array-capacity" "sequences.private" create
|
||||
"fixnum" "math" lookup
|
||||
"fixnum" "math" lookup-word
|
||||
[
|
||||
[ dup 0 fixnum>= ] %
|
||||
bootstrap-max-array-capacity <fake-bignum> [ fixnum<= ] curry ,
|
||||
|
@ -176,7 +176,7 @@ call( -- )
|
|||
] [ ] make
|
||||
define-predicate-class
|
||||
|
||||
"array-capacity" "sequences.private" lookup
|
||||
"array-capacity" "sequences.private" lookup-word
|
||||
[ >fixnum ] bootstrap-max-array-capacity <fake-bignum> [ fixnum-bitand ] curry append
|
||||
"coercer" set-word-prop
|
||||
|
||||
|
@ -262,11 +262,11 @@ tuple
|
|||
{ "state" } define-tuple-class
|
||||
|
||||
"((empty))" "hashtables.private" create
|
||||
"tombstone" "hashtables.private" lookup f
|
||||
"tombstone" "hashtables.private" lookup-word f
|
||||
2array >tuple 1quotation ( -- value ) define-inline
|
||||
|
||||
"((tombstone))" "hashtables.private" create
|
||||
"tombstone" "hashtables.private" lookup t
|
||||
"tombstone" "hashtables.private" lookup-word t
|
||||
2array >tuple 1quotation ( -- value ) define-inline
|
||||
|
||||
! Some tuple classes
|
||||
|
@ -277,7 +277,7 @@ tuple
|
|||
{ "quot" read-only }
|
||||
} prepare-slots define-tuple-class
|
||||
|
||||
"curry" "kernel" lookup
|
||||
"curry" "kernel" lookup-word
|
||||
{
|
||||
[ f "inline" set-word-prop ]
|
||||
[ make-flushable ]
|
||||
|
@ -299,7 +299,7 @@ tuple
|
|||
{ "second" read-only }
|
||||
} prepare-slots define-tuple-class
|
||||
|
||||
"compose" "kernel" lookup
|
||||
"compose" "kernel" lookup-word
|
||||
{
|
||||
[ f "inline" set-word-prop ]
|
||||
[ make-flushable ]
|
||||
|
|
|
@ -97,5 +97,5 @@ IN: bootstrap.syntax
|
|||
">>>>>>>"
|
||||
} [ "syntax" create drop ] each
|
||||
|
||||
"t" "syntax" lookup define-symbol
|
||||
"t" "syntax" lookup-word define-symbol
|
||||
] with-compilation-unit
|
||||
|
|
|
@ -65,8 +65,8 @@ USE: io.streams.string
|
|||
parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ { } ] [ { } "mixin-forget-test-g" "classes.mixin.tests" lookup execute ] unit-test
|
||||
[ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup execute ] must-fail
|
||||
[ { } ] [ { } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] unit-test
|
||||
[ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] must-fail
|
||||
|
||||
[ ] [
|
||||
{
|
||||
|
@ -80,8 +80,8 @@ USE: io.streams.string
|
|||
parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ { } "mixin-forget-test-g" "classes.mixin.tests" lookup execute ] must-fail
|
||||
[ H{ } ] [ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup execute ] unit-test
|
||||
[ { } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] must-fail
|
||||
[ H{ } ] [ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] unit-test
|
||||
] times
|
||||
|
||||
! Method flattening interfered with mixin update
|
||||
|
@ -99,11 +99,11 @@ TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
|
|||
|
||||
[ ] [ "IN: classes.mixin.tests MIXIN: blah SINGLETON: boo INSTANCE: boo blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
|
||||
|
||||
[ t ] [ "blah" "classes.mixin.tests" lookup mixin-class? ] unit-test
|
||||
[ t ] [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
|
||||
|
||||
[ ] [ "IN: classes.mixin.tests MIXIN: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
|
||||
|
||||
[ t ] [ "blah" "classes.mixin.tests" lookup mixin-class? ] unit-test
|
||||
[ t ] [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
|
||||
|
||||
MIXIN: empty-mixin
|
||||
|
||||
|
|
|
@ -42,13 +42,13 @@ TUPLE: point x y ;
|
|||
|
||||
[ 100 ] [ "p" get x>> ] unit-test
|
||||
[ 200 ] [ "p" get y>> ] unit-test
|
||||
[ f ] [ "p" get "z>>" "accessors" lookup execute ] unit-test
|
||||
[ f ] [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
|
||||
|
||||
[ ] [ "p" get 300 ">>z" "accessors" lookup execute drop ] unit-test
|
||||
[ ] [ "p" get 300 ">>z" "accessors" lookup-word execute drop ] unit-test
|
||||
|
||||
[ 3 ] [ "p" get tuple-size ] unit-test
|
||||
|
||||
[ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test
|
||||
[ 300 ] [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
|
||||
|
||||
[ ] [ "IN: classes.tuple.tests TUPLE: point z y ;" eval( -- ) ] unit-test
|
||||
|
||||
|
@ -56,7 +56,7 @@ TUPLE: point x y ;
|
|||
|
||||
[ "p" get x>> ] must-fail
|
||||
[ 200 ] [ "p" get y>> ] unit-test
|
||||
[ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test
|
||||
[ 300 ] [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
|
||||
|
||||
TUPLE: predicate-test ;
|
||||
|
||||
|
@ -472,11 +472,11 @@ must-fail-with
|
|||
"forget-accessors-test" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "forget-accessors-test" "classes.tuple.tests" lookup class? ] unit-test
|
||||
[ t ] [ "forget-accessors-test" "classes.tuple.tests" lookup-word class? ] unit-test
|
||||
|
||||
: accessor-exists? ( name -- ? )
|
||||
[ "forget-accessors-test" "classes.tuple.tests" lookup ] dip
|
||||
">>" append "accessors" lookup ?lookup-method >boolean ;
|
||||
[ "forget-accessors-test" "classes.tuple.tests" lookup-word ] dip
|
||||
">>" append "accessors" lookup-word ?lookup-method >boolean ;
|
||||
|
||||
[ t ] [ "x" accessor-exists? ] unit-test
|
||||
[ t ] [ "y" accessor-exists? ] unit-test
|
||||
|
@ -488,7 +488,7 @@ must-fail-with
|
|||
"forget-accessors-test" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ f ] [ "forget-accessors-test" "classes.tuple.tests" lookup class? ] unit-test
|
||||
[ f ] [ "forget-accessors-test" "classes.tuple.tests" lookup-word class? ] unit-test
|
||||
|
||||
[ f ] [ "x" accessor-exists? ] unit-test
|
||||
[ f ] [ "y" accessor-exists? ] unit-test
|
||||
|
@ -649,7 +649,7 @@ DEFER: error-y
|
|||
drop
|
||||
] unit-test
|
||||
|
||||
[ ] [ "forget-subclass-test'" "classes.tuple.tests" lookup new "bad-object" set ] unit-test
|
||||
[ ] [ "forget-subclass-test'" "classes.tuple.tests" lookup-word new "bad-object" set ] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: classes.tuple.tests TUPLE: forget-subclass-test a ;"
|
||||
|
|
|
@ -70,15 +70,15 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ;
|
|||
|
||||
[ ] [ "IN: classes.union.tests SINGLETON: foo UNION: blah foo ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test
|
||||
|
||||
[ t ] [ "blah" "classes.union.tests" lookup union-class? ] unit-test
|
||||
[ t ] [ "blah" "classes.union.tests" lookup-word union-class? ] unit-test
|
||||
|
||||
[ t ] [ "foo?" "classes.union.tests" lookup predicate? ] unit-test
|
||||
[ t ] [ "foo?" "classes.union.tests" lookup-word predicate? ] unit-test
|
||||
|
||||
[ ] [ "IN: classes.union.tests USE: math UNION: blah integer ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test
|
||||
|
||||
[ t ] [ "blah" "classes.union.tests" lookup union-class? ] unit-test
|
||||
[ t ] [ "blah" "classes.union.tests" lookup-word union-class? ] unit-test
|
||||
|
||||
[ f ] [ "foo?" "classes.union.tests" lookup predicate? ] unit-test
|
||||
[ f ] [ "foo?" "classes.union.tests" lookup-word predicate? ] unit-test
|
||||
|
||||
GENERIC: test-generic ( x -- y )
|
||||
|
||||
|
@ -102,8 +102,8 @@ M: a-union test-generic ;
|
|||
|
||||
[ ] [ "IN: classes.union.tests USE: math UNION: fast-union-1 fixnum ; UNION: fast-union-2 fast-union-1 bignum ;" eval( -- ) ] unit-test
|
||||
|
||||
[ t ] [ "fast-union-2?" "classes.union.tests" lookup def>> \ fixnum-bitand swap member? ] unit-test
|
||||
[ t ] [ "fast-union-2?" "classes.union.tests" lookup-word def>> \ fixnum-bitand swap member? ] unit-test
|
||||
|
||||
[ ] [ "IN: classes.union.tests USE: vectors UNION: fast-union-1 vector ;" eval( -- ) ] unit-test
|
||||
|
||||
[ f ] [ "fast-union-2?" "classes.union.tests" lookup def>> \ fixnum-bitand swap member? ] unit-test
|
||||
[ f ] [ "fast-union-2?" "classes.union.tests" lookup-word def>> \ fixnum-bitand swap member? ] unit-test
|
||||
|
|
|
@ -364,8 +364,8 @@ M: c funky* "c" , call-next-method ;
|
|||
[ ] [ "IN: generic.standard.tests GENERIC: xyz ( a -- b )" eval( -- ) ] unit-test
|
||||
[ ] [ "IN: generic.standard.tests MATH: xyz ( a b -- c )" eval( -- ) ] unit-test
|
||||
|
||||
[ f ] [ "xyz" "generic.standard.tests" lookup pic-def>> ] unit-test
|
||||
[ f ] [ "xyz" "generic.standard.tests" lookup "decision-tree" word-prop ] unit-test
|
||||
[ f ] [ "xyz" "generic.standard.tests" lookup-word pic-def>> ] unit-test
|
||||
[ f ] [ "xyz" "generic.standard.tests" lookup-word "decision-tree" word-prop ] unit-test
|
||||
|
||||
! Corner case
|
||||
[ "IN: generic.standard.tests GENERIC# broken-generic# -1 ( a -- b )" eval( -- ) ]
|
||||
|
|
|
@ -4,7 +4,7 @@ IN: io.tests
|
|||
|
||||
{ f } [
|
||||
"vocab:io/test/no-trailing-eol.factor" run-file
|
||||
"foo" "io.tests" lookup
|
||||
"foo" "io.tests" lookup-word
|
||||
] unit-test
|
||||
|
||||
! Make sure we use correct to_c_string form when writing
|
||||
|
|
|
@ -53,7 +53,7 @@ unit-test
|
|||
: effect-parsing-test ( a b -- c ) + ;
|
||||
|
||||
[ t ] [
|
||||
"effect-parsing-test" "parser.tests" lookup
|
||||
"effect-parsing-test" "parser.tests" lookup-word
|
||||
\ effect-parsing-test eq?
|
||||
] unit-test
|
||||
|
||||
|
@ -69,7 +69,7 @@ unit-test
|
|||
[ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
|
||||
|
||||
[ t ] [
|
||||
"effect-parsing-test" "parser.tests" lookup
|
||||
"effect-parsing-test" "parser.tests" lookup-word
|
||||
\ effect-parsing-test eq?
|
||||
] unit-test
|
||||
|
||||
|
@ -96,7 +96,7 @@ DEFER: foo
|
|||
|
||||
[ t ] [
|
||||
"USE: parser.tests \\ foo" eval( -- word )
|
||||
"foo" "parser.tests" lookup eq?
|
||||
"foo" "parser.tests" lookup-word eq?
|
||||
] unit-test
|
||||
|
||||
! parse-tokens should do the right thing on EOF
|
||||
|
@ -112,15 +112,15 @@ DEFER: foo
|
|||
"foo" source-file definitions>> first assoc-size
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo"
|
||||
parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "smudge-me-more" "parser.tests" lookup >boolean ] unit-test
|
||||
[ f ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "smudge-me-more" "parser.tests" lookup-word >boolean ] unit-test
|
||||
[ f ] [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
|
||||
|
||||
[ 3 ] [
|
||||
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
|
||||
|
@ -144,15 +144,15 @@ DEFER: foo
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
array "smudge-me" "parser.tests" lookup order member-eq?
|
||||
array "smudge-me" "parser.tests" lookup-word order member-eq?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
integer "smudge-me" "parser.tests" lookup order member-eq?
|
||||
integer "smudge-me" "parser.tests" lookup-word order member-eq?
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
string "smudge-me" "parser.tests" lookup order member-eq?
|
||||
string "smudge-me" "parser.tests" lookup-word order member-eq?
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
@ -189,14 +189,14 @@ DEFER: foo
|
|||
] [ source-file-error? ] must-fail-with
|
||||
|
||||
[ t ] [
|
||||
"y" "parser.tests" lookup >boolean
|
||||
"y" "parser.tests" lookup-word >boolean
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"IN: parser.tests : x ( -- ) ;"
|
||||
<string-reader> "a" parse-stream drop
|
||||
|
||||
"y" "parser.tests" lookup
|
||||
"y" "parser.tests" lookup-word
|
||||
] unit-test
|
||||
|
||||
! Test new forward definition logic
|
||||
|
@ -216,7 +216,7 @@ DEFER: foo
|
|||
<string-reader> "axx" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "bxx" "axx" lookup >boolean ] unit-test
|
||||
[ t ] [ "bxx" "axx" lookup-word >boolean ] unit-test
|
||||
|
||||
! And reload the file that uses it...
|
||||
[ ] [
|
||||
|
@ -280,7 +280,7 @@ DEFER: foo
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"killer?" "parser.tests" lookup >boolean
|
||||
"killer?" "parser.tests" lookup-word >boolean
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
@ -341,7 +341,7 @@ DEFER: foo
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"foo" "parser.tests" lookup word eq?
|
||||
"foo" "parser.tests" lookup-word word eq?
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
@ -363,28 +363,28 @@ DEFER: foo
|
|||
<string-reader> "redefining-a-class-6" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
||||
[ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )"
|
||||
<string-reader> "redefining-a-class-5" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
||||
[ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )"
|
||||
<string-reader> "redefining-a-class-7" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
||||
[ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: parser.tests TUPLE: foo ;"
|
||||
<string-reader> "redefining-a-class-7" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
|
||||
[ t ] [ "foo" "parser.tests" lookup-word symbol? ] unit-test
|
||||
] times
|
||||
|
||||
[ "vocab:parser/test/assert-depth.factor" run-file ] must-fail
|
||||
|
@ -440,7 +440,7 @@ DEFER: foo
|
|||
] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
"change-combination" "parser.tests" lookup
|
||||
"change-combination" "parser.tests" lookup-word
|
||||
"methods" word-prop assoc-size
|
||||
] unit-test
|
||||
|
||||
|
@ -456,18 +456,18 @@ DEFER: foo
|
|||
<string-reader> "staging-problem-test" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
|
||||
|
||||
[ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
"IN: parser.tests << : staging-problem-test-1 ( -- a ) 1 ; >> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
|
||||
<string-reader> "staging-problem-test" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
|
||||
|
||||
[ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
|
||||
|
||||
[ "DEFER: blahy" eval( -- ) ] [ error>> error>> no-current-vocab? ] must-fail-with
|
||||
|
||||
|
@ -540,14 +540,14 @@ EXCLUDE: qualified.tests.bar => x ;
|
|||
<string-reader> "was-once-a-word-test" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "was-once-a-word-bug" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
"IN: parser.tests USE: words << \"was-once-a-word-bug\" \"parser.tests\" create [ ] ( -- ) define-declared >>"
|
||||
<string-reader> "was-once-a-word-test" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "was-once-a-word-bug" "parser.tests" lookup >boolean ] unit-test */
|
||||
[ t ] [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test */
|
||||
|
||||
! Replace : def with DEFER:
|
||||
[ [ ] ] [
|
||||
|
@ -555,16 +555,16 @@ EXCLUDE: qualified.tests.bar => x ;
|
|||
<string-reader> "is-not-deferred" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "is-not-deferred" "parser.tests" lookup >boolean ] unit-test
|
||||
[ f ] [ "is-not-deferred" "parser.tests" lookup deferred? ] unit-test
|
||||
[ t ] [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
|
||||
[ f ] [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
"IN: parser.tests DEFER: is-not-deferred"
|
||||
<string-reader> "is-not-deferred" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "is-not-deferred" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "is-not-deferred" "parser.tests" lookup deferred? ] unit-test
|
||||
[ t ] [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
|
||||
[ t ] [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
|
||||
|
||||
! Forward-reference resolution case iterated using list in the wrong direction
|
||||
[ [ ] ] [
|
||||
|
@ -583,7 +583,7 @@ EXCLUDE: qualified.tests.bar => x ;
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
|
||||
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
|
||||
] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
|
@ -592,7 +592,7 @@ EXCLUDE: qualified.tests.bar => x ;
|
|||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
|
||||
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
|
||||
] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
|
@ -601,7 +601,7 @@ EXCLUDE: qualified.tests.bar => x ;
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
|
||||
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
|
||||
] unit-test
|
||||
|
||||
[ [ dup ] ] [
|
||||
|
|
|
@ -20,10 +20,10 @@ IN: bootstrap.syntax
|
|||
! in stage2.
|
||||
|
||||
: define-delimiter ( name -- )
|
||||
"syntax" lookup t "delimiter" set-word-prop ;
|
||||
"syntax" lookup-word t "delimiter" set-word-prop ;
|
||||
|
||||
: define-core-syntax ( name quot -- )
|
||||
[ dup "syntax" lookup [ ] [ no-word-error ] ?if ] dip
|
||||
[ dup "syntax" lookup-word [ ] [ no-word-error ] ?if ] dip
|
||||
define-syntax ;
|
||||
|
||||
[
|
||||
|
@ -249,9 +249,9 @@ IN: bootstrap.syntax
|
|||
] if*
|
||||
] define-core-syntax
|
||||
|
||||
"initial:" "syntax" lookup define-symbol
|
||||
"initial:" "syntax" lookup-word define-symbol
|
||||
|
||||
"read-only" "syntax" lookup define-symbol
|
||||
"read-only" "syntax" lookup-word define-symbol
|
||||
|
||||
"call(" [ \ call-effect parse-call( ] define-core-syntax
|
||||
|
||||
|
|
|
@ -47,7 +47,7 @@ IN: vocabs.loader.tests
|
|||
[ t ] [
|
||||
"resource:core/vocabs/loader/test/a/a.factor"
|
||||
source-file definitions>> dup USE: prettyprint .
|
||||
"v-l-t-a-hello" "vocabs.loader.test.a" lookup dup .
|
||||
"v-l-t-a-hello" "vocabs.loader.test.a" lookup-word dup .
|
||||
swap first key?
|
||||
] unit-test
|
||||
] times
|
||||
|
@ -92,7 +92,7 @@ IN: vocabs.loader.tests
|
|||
|
||||
[ 2 ] [ "count-me" get-global ] unit-test
|
||||
|
||||
[ f ] [ "fred" "vocabs.loader.test.b" lookup undefined? ] unit-test
|
||||
[ f ] [ "fred" "vocabs.loader.test.b" lookup-word undefined? ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
|
|
|
@ -26,7 +26,7 @@ must-fail-with
|
|||
|
||||
[ ] [ [ \ aaa forget ] with-compilation-unit ] unit-test
|
||||
|
||||
[ ] [ [ "bbb" "vocabs.parser.tests" lookup forget ] with-compilation-unit ] unit-test
|
||||
[ ] [ [ "bbb" "vocabs.parser.tests" lookup-word forget ] with-compilation-unit ] unit-test
|
||||
|
||||
[ f ] [ "uutt" search ] unit-test
|
||||
|
||||
|
|
|
@ -12,7 +12,7 @@ $nl
|
|||
{ $subsections
|
||||
create
|
||||
create-in
|
||||
lookup
|
||||
lookup-word
|
||||
} ;
|
||||
|
||||
ARTICLE: "uninterned-words" "Uninterned words"
|
||||
|
@ -279,7 +279,7 @@ HELP: set-word
|
|||
{ $values { "word" word } }
|
||||
{ $description "Sets the recently defined word." } ;
|
||||
|
||||
HELP: lookup
|
||||
HELP: lookup-word
|
||||
{ $values { "name" string } { "vocab" string } { "word" { $maybe word } } }
|
||||
{ $description "Looks up a word in the dictionary. If the vocabulary or the word is not defined, outputs " { $link f } "." } ;
|
||||
|
||||
|
|
|
@ -8,7 +8,7 @@ IN: words.tests
|
|||
[
|
||||
"poo" "words.tests" create [ 2 2 + ] ( -- n ) define-declared
|
||||
] with-compilation-unit
|
||||
"poo" "words.tests" lookup execute
|
||||
"poo" "words.tests" lookup-word execute
|
||||
] unit-test
|
||||
|
||||
[ t ] [ t vocabs [ words [ word? and ] each ] each ] unit-test
|
||||
|
@ -28,17 +28,17 @@ DEFER: plist-test
|
|||
[ ] [ [ "create-test" "scratchpad" create { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
|
||||
|
||||
[ { 1 2 } ] [
|
||||
"create-test" "scratchpad" lookup "testing" word-prop
|
||||
"create-test" "scratchpad" lookup-word "testing" word-prop
|
||||
] unit-test
|
||||
|
||||
[
|
||||
[ t ] [ \ array? "array?" "arrays" lookup = ] unit-test
|
||||
[ t ] [ \ array? "array?" "arrays" lookup-word = ] unit-test
|
||||
|
||||
[ ] [ [ "test-scope" "scratchpad" create drop ] with-compilation-unit ] unit-test
|
||||
] with-scope
|
||||
|
||||
[ "test-scope" ] [
|
||||
"test-scope" "scratchpad" lookup name>>
|
||||
"test-scope" "scratchpad" lookup-word name>>
|
||||
] unit-test
|
||||
|
||||
[ t ] [ vocabs array? ] unit-test
|
||||
|
@ -74,15 +74,15 @@ DEFER: deferred
|
|||
[ ] [ "IN: words.tests FORGET: not-compiled" eval( -- ) ] unit-test
|
||||
|
||||
[ ] [ [ "no-loc" "words.tests" create drop ] with-compilation-unit ] unit-test
|
||||
[ f ] [ "no-loc" "words.tests" lookup where ] unit-test
|
||||
[ f ] [ "no-loc" "words.tests" lookup-word where ] unit-test
|
||||
|
||||
[ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
|
||||
[ f ] [ "no-loc-2" "words.tests" lookup where ] unit-test
|
||||
[ f ] [ "no-loc-2" "words.tests" lookup-word where ] unit-test
|
||||
|
||||
[ ] [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
|
||||
[ "test-last" ] [ word name>> ] unit-test
|
||||
|
||||
"undef-test" "words.tests" lookup [
|
||||
"undef-test" "words.tests" lookup-word [
|
||||
[ forget ] with-compilation-unit
|
||||
] when*
|
||||
|
||||
|
@ -97,8 +97,8 @@ DEFER: deferred
|
|||
"IN: words.tests SYMBOL: symbol-generic" eval( -- )
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
|
||||
[ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
|
||||
[ t ] [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
|
||||
[ f ] [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: words.tests GENERIC: symbol-generic ( a -- b )" <string-reader>
|
||||
|
@ -110,19 +110,19 @@ DEFER: deferred
|
|||
"symbol-generic-test" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
|
||||
[ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
|
||||
[ t ] [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
|
||||
[ f ] [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
|
||||
|
||||
! Regressions
|
||||
[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
|
||||
[ t ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
|
||||
[ t ] [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
|
||||
[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
|
||||
[ f ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
|
||||
[ f ] [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
|
||||
|
||||
[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval( -- ) ] unit-test
|
||||
[ t ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
|
||||
[ t ] [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
|
||||
[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
|
||||
[ f ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
|
||||
[ f ] [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
|
||||
|
||||
[ { } ]
|
||||
[
|
||||
|
|
|
@ -59,10 +59,10 @@ PREDICATE: primitive < word "primitive" word-prop ;
|
|||
M: primitive definer drop \ PRIMITIVE: f ;
|
||||
M: primitive definition drop f ;
|
||||
|
||||
: lookup ( name vocab -- word ) vocab-words at ;
|
||||
: lookup-word ( name vocab -- word ) vocab-words at ;
|
||||
|
||||
: target-word ( word -- target )
|
||||
[ name>> ] [ vocabulary>> ] bi lookup ;
|
||||
[ name>> ] [ vocabulary>> ] bi lookup-word ;
|
||||
|
||||
SYMBOL: bootstrapping?
|
||||
|
||||
|
@ -193,7 +193,7 @@ ERROR: bad-create name vocab ;
|
|||
[ bad-create ] unless ;
|
||||
|
||||
: create ( name vocab -- word )
|
||||
check-create 2dup lookup
|
||||
check-create 2dup lookup-word
|
||||
dup [ 2nip ] [
|
||||
drop
|
||||
vocab-name <word>
|
||||
|
|
|
@ -4,9 +4,9 @@ words combinators.smart tools.crossref ;
|
|||
IN: annotations
|
||||
|
||||
<PRIVATE
|
||||
: comment-word ( base -- word ) "!" prepend "annotations" lookup ;
|
||||
: comment-usage-word ( base -- word ) "s" append "annotations" lookup ;
|
||||
: comment-usage.-word ( base -- word ) "s." append "annotations" lookup ;
|
||||
: comment-word ( base -- word ) "!" prepend "annotations" lookup-word ;
|
||||
: comment-usage-word ( base -- word ) "s" append "annotations" lookup-word ;
|
||||
: comment-usage.-word ( base -- word ) "s." append "annotations" lookup-word ;
|
||||
PRIVATE>
|
||||
|
||||
: $annotation ( element -- )
|
||||
|
|
|
@ -7,11 +7,11 @@ IN: classes.struct.vectored
|
|||
<PRIVATE
|
||||
|
||||
: array-class-of ( type -- array-type )
|
||||
[ define-array-vocab ] [ name>> "-array" append swap lookup ] bi ;
|
||||
[ define-array-vocab ] [ name>> "-array" append swap lookup-word ] bi ;
|
||||
: <array-class>-of ( type -- array-type )
|
||||
[ define-array-vocab ] [ name>> "<" "-array>" surround swap lookup ] bi ;
|
||||
[ define-array-vocab ] [ name>> "<" "-array>" surround swap lookup-word ] bi ;
|
||||
: (array-class)-of ( type -- array-type )
|
||||
[ define-array-vocab ] [ name>> "(" "-array)" surround swap lookup ] bi ;
|
||||
[ define-array-vocab ] [ name>> "(" "-array)" surround swap lookup-word ] bi ;
|
||||
|
||||
: >vectored-slot ( struct-slot offset -- tuple-slot )
|
||||
{
|
||||
|
|
|
@ -20,7 +20,7 @@ IN: graphviz.notation
|
|||
! present >>attr ;
|
||||
|
||||
: =attr-generic ( name -- generic )
|
||||
"=" prepend "graphviz.notation" 2dup lookup
|
||||
"=" prepend "graphviz.notation" 2dup lookup-word
|
||||
[ 2nip ] [
|
||||
create dup
|
||||
1 <standard-combination>
|
||||
|
|
|
@ -218,8 +218,8 @@ WhiteNumberSpace = WhiteSpace Number:n WhiteSpace => [[ n ]]
|
|||
WhiteZeroSpace = WhiteSpace (Zero | Number):n WhiteSpace => [[ n ]]
|
||||
|
||||
Integer = "i" Number:n => [[ n <integer> ]]
|
||||
FloatingPoint = ( "float" | "double" | "x86_fp80" | "fp128" | "ppc_fp128" ) => [[ "llvm.types" vocab lookup ]]
|
||||
LabelVoidMetadata = ( "label" | "void" | "metadata" | "opaque" ) => [[ "llvm.types" vocab lookup ]]
|
||||
FloatingPoint = ( "float" | "double" | "x86_fp80" | "fp128" | "ppc_fp128" ) => [[ "llvm.types" vocab lookup-word ]]
|
||||
LabelVoidMetadata = ( "label" | "void" | "metadata" | "opaque" ) => [[ "llvm.types" vocab lookup-word ]]
|
||||
Primitive = LabelVoidMetadata | FloatingPoint
|
||||
Pointer = T:t WhiteSpace "*" => [[ t <pointer> ]]
|
||||
Vector = "<" WhiteNumberSpace:n "x" Type:t ">" => [[ n t <vector> ]]
|
||||
|
|
|
@ -16,7 +16,7 @@ DEFER: assoc>tuple
|
|||
<PRIVATE
|
||||
|
||||
: mdbinfo>tuple-class ( tuple-info -- class )
|
||||
[ first ] keep second lookup ; inline
|
||||
[ first ] keep second lookup-word ; inline
|
||||
|
||||
: tuple-instance ( tuple-info -- instance )
|
||||
mdbinfo>tuple-class new ; inline
|
||||
|
|
|
@ -13,10 +13,10 @@ SYNTAX: slots{
|
|||
'[ [ _ cleave ] output>array ] append! ;
|
||||
|
||||
: >>writer-word ( name -- word )
|
||||
">>" prepend "accessors" lookup ;
|
||||
">>" prepend "accessors" lookup-word ;
|
||||
|
||||
: writer-word<< ( name -- word )
|
||||
">>" prepend "accessors" lookup ;
|
||||
">>" prepend "accessors" lookup-word ;
|
||||
|
||||
SYNTAX: set-slots[
|
||||
"]" [ >>writer-word 1quotation ] map-tokens
|
||||
|
|
|
@ -149,7 +149,7 @@ ERROR: no-word name ;
|
|||
|
||||
M: ast-foreign compile-ast
|
||||
nip
|
||||
[ class>> dup ":" split1 lookup [ ] [ no-word ] ?if ]
|
||||
[ class>> dup ":" split1 lookup-word [ ] [ no-word ] ?if ]
|
||||
[ name>> ] bi define-foreign
|
||||
[ nil ] ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue