Rename lookup to lookup-word.

db4
Doug Coleman 2011-11-06 15:57:24 -08:00
parent cb84fefc37
commit c731dc6edb
45 changed files with 176 additions and 176 deletions

View File

@ -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

View File

@ -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

View File

@ -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> ;

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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' )

View File

@ -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
[ ] [

View File

@ -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

View File

@ -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 )
[

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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? ;

View File

@ -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 -- )

View File

@ -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

View File

@ -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 ]

View File

@ -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

View File

@ -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

View File

@ -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 ;"

View File

@ -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

View File

@ -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( -- ) ]

View File

@ -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

View File

@ -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 ] ] [

View File

@ -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

View File

@ -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
[ ] [
[

View File

@ -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

View File

@ -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 } "." } ;

View File

@ -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
[ { } ]
[

View File

@ -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>

View File

@ -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 -- )

View File

@ -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 )
{

View File

@ -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>

View File

@ -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> ]]

View File

@ -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

View File

@ -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

View File

@ -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 ] ;