factor: fix IN: even more

locals-and-roots
Doug Coleman 2016-06-22 09:53:07 -07:00
parent e9a718324d
commit 95f952c023
107 changed files with 399 additions and 399 deletions

View File

@ -61,7 +61,7 @@ c-type: opaque
[ "
USING: alien.syntax ;
in: alien.c-types.tests
IN: alien.c-types.tests
FUNCTION: opaque return_opaque ( ) ;
" eval( -- ) ] [ no-c-type? ] must-fail-with
@ -79,14 +79,14 @@ DEFER: struct-redefined
"
USING: alien.c-types classes.struct ;
in: alien.c-types.tests
IN: alien.c-types.tests
STRUCT: struct-redefined { x int } ;
" eval( -- )
"
USING: alien.syntax ;
in: alien.c-types.tests
IN: alien.c-types.tests
c-type: struct-redefined
" eval( -- )
@ -95,9 +95,9 @@ DEFER: struct-redefined
] unit-test
[
"in: alien.c-types.tests
use: alien.syntax
use: alien.c-types
"IN: alien.c-types.tests
USE: alien.syntax
USE: alien.c-types
TYPEDEF: int type-redefinition-test ;
TYPEDEF: int type-redefinition-test ;" eval( -- )
]
@ -105,9 +105,9 @@ DEFER: struct-redefined
must-fail-with
[
"in: alien.c-types.tests
use: alien.syntax
use: alien.c-types
"IN: alien.c-types.tests
USE: alien.syntax
USE: alien.c-types
CALLBACK: void cb987 ( ) ;
CALLBACK: void cb987 ( ) ;" eval( -- )
]
@ -115,9 +115,9 @@ must-fail-with
must-fail-with
[
"in: alien.c-types.tests
use: alien.syntax
use: alien.c-types
"IN: alien.c-types.tests
USE: alien.syntax
USE: alien.c-types
FUNCTION: void func987 ( ) ;
FUNCTION: void func987 ( ) ;" eval( -- )
]
@ -125,27 +125,27 @@ must-fail-with
must-fail-with
! generic -> callback
"in: alien.c-types.tests
use: alien.syntax
use: alien.c-types
"IN: alien.c-types.tests
USE: alien.syntax
USE: alien.c-types
GENERIC: foo-func ( x -- ) ;
" eval( -- )
"in: alien.c-types.tests
use: alien.syntax
use: alien.c-types
"IN: alien.c-types.tests
USE: alien.syntax
USE: alien.c-types
CALLBACK: void foo-func ( ) ;
" eval( -- )
! generic -> typedef
"in: alien.c-types.tests
use: alien.syntax
use: alien.c-types
"IN: alien.c-types.tests
USE: alien.syntax
USE: alien.c-types
GENERIC: foo-func ( x -- ) ;
" eval( -- )
"in: alien.c-types.tests
use: alien.syntax
use: alien.c-types
"IN: alien.c-types.tests
USE: alien.syntax
USE: alien.c-types
TYPEDEF: void* foo-func ;
" eval( -- )

View File

@ -24,7 +24,7 @@ ARTICLE: "enums" "Enumerations"
<enum>
}
"Inverting a permutation using enumerations:"
{ $example "in: scratchpad" ": invert ( perm -- perm' )" " <enum> sort-values keys ;" "{ 2 0 4 1 3 } invert ." "{ 1 3 0 4 2 }" } ;
{ $example "IN: scratchpad" ": invert ( perm -- perm' )" " <enum> sort-values keys ;" "{ 2 0 4 1 3 } invert ." "{ 1 3 0 4 2 }" } ;
HELP: enum
{ $class-description "An associative structure which wraps a sequence and maps integers to the corresponding elements of the sequence."

View File

@ -75,7 +75,7 @@ HELP: class
HELP: class-of
{ $values { "object" object } { "class" class } }
{ $description "Outputs an object's canonical class. While an object may be an instance of more than one class, the canonical class is either its built-in class, or if the object is a tuple, its tuple class." }
{ $examples { $example "USING: classes prettyprint ;" "1.0 class-of ." "float" } { $example "USING: classes prettyprint ;" "in: scratchpad" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class-of ." "point" } } ;
{ $examples { $example "USING: classes prettyprint ;" "1.0 class-of ." "float" } { $example "USING: classes prettyprint ;" "IN: scratchpad" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class-of ." "point" } } ;
HELP: classes
{ $values { "seq" "a sequence of class words" } }

View File

@ -10,14 +10,14 @@ ERROR: error-class-test a b c ;
{ "( a b c -- * )" } [ \ error-class-test stack-effect effect>string ] unit-test
{ f } [ \ error-class-test "inline" word-prop ] unit-test
[ "in: classes.error.tests ERROR: error-x ; : error-x 3 ;" eval( -- ) ]
[ "IN: classes.error.tests ERROR: error-x ; : error-x 3 ;" eval( -- ) ]
[ error>> error>> redefine-error? ] must-fail-with
DEFER: error-y
{ } [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test
{ } [ "in: classes.error.tests GENERIC: error-y ( a -- b ) ;" eval( -- ) ] unit-test
{ } [ "IN: classes.error.tests GENERIC: error-y ( a -- b ) ;" eval( -- ) ] unit-test
{ f } [ \ error-y tuple-class? ] unit-test
@ -25,7 +25,7 @@ DEFER: error-y
{ t } [ \ error-y generic? ] unit-test
{ } [ "in: classes.error.tests ERROR: error-y ;" eval( -- ) ] unit-test
{ } [ "IN: classes.error.tests ERROR: error-y ;" eval( -- ) ] unit-test
{ t } [ \ error-y tuple-class? ] unit-test

View File

@ -62,5 +62,5 @@ M: f lol2 drop "lol22" ;
{ "lol22" } [ f lol2 ] unit-test
[ 3 lol2 ] [ no-method? ] must-fail-with
[ "in: classes-tests maybe{ 1 2 3 }" eval( -- ) ]
[ "IN: classes-tests maybe{ 1 2 3 }" eval( -- ) ]
[ error>> not-classoids? ] must-fail-with

View File

@ -40,7 +40,7 @@ INSTANCE: integer mx1 ;
{ f } [ mx1 integer class<= ] unit-test
{ f } [ mx1 number class<= ] unit-test
"in: classes.mixin.tests use: arrays INSTANCE: array mx1 ;" eval( -- )
"IN: classes.mixin.tests USE: arrays INSTANCE: array mx1 ;" eval( -- )
{ t } [ array mx1 class<= ] unit-test
{ f } [ mx1 number class<= ] unit-test
@ -55,8 +55,8 @@ USE: io.streams.string
[ ] [
{
"USING: sequences ;"
"in: classes.mixin.tests"
"mixin: mixin-forget-test"
"IN: classes.mixin.tests"
"MIXIN: mixin-forget-test"
"INSTANCE: sequence mixin-forget-test ;"
"GENERIC: mixin-forget-test-g ( x -- y ) ;"
"M: mixin-forget-test mixin-forget-test-g ;"
@ -70,8 +70,8 @@ USE: io.streams.string
[ ] [
{
"USING: hashtables ;"
"in: classes.mixin.tests"
"mixin: mixin-forget-test"
"IN: classes.mixin.tests"
"MIXIN: mixin-forget-test"
"INSTANCE: hashtable mixin-forget-test ;"
"GENERIC: mixin-forget-test-g ( x -- y ) ;"
"M: mixin-forget-test mixin-forget-test-g ;"
@ -96,11 +96,11 @@ TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2 ;
! Too eager with reset-class
{ } [ "in: classes.mixin.tests mixin: blah singleton: boo INSTANCE: boo blah ;" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
{ } [ "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-word mixin-class? ] unit-test
{ } [ "in: classes.mixin.tests mixin: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
{ } [ "IN: classes.mixin.tests MIXIN: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
{ t } [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
@ -110,11 +110,11 @@ MIXIN: empty-mixin
MIXIN: move-instance-declaration-mixin
{ } [ "in: classes.mixin.tests.a use: strings use: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin ;" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
{ } [ "IN: classes.mixin.tests.a USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin ;" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
{ } [ "in: classes.mixin.tests.b use: strings use: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin ;" <string-reader> "move-mixin-test-2" parse-stream drop ] unit-test
{ } [ "IN: classes.mixin.tests.b USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin ;" <string-reader> "move-mixin-test-2" parse-stream drop ] unit-test
{ } [ "in: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
{ } [ "IN: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
{ { string } } [ move-instance-declaration-mixin class-members ] unit-test
@ -139,7 +139,7 @@ M: metaclass-change-mixin metaclass-change-generic ;
{ T{ metaclass-change } } [ T{ metaclass-change } metaclass-change-generic ] unit-test
{ } [ "in: classes.mixin.tests use: math UNION: metaclass-change integer ;" eval( -- ) ] unit-test
{ } [ "IN: classes.mixin.tests USE: math UNION: metaclass-change integer ;" eval( -- ) ] unit-test
{ 0 } [ 0 metaclass-change-generic ] unit-test

View File

@ -45,20 +45,20 @@ M: tuple-d ptest' drop tuple-d ;
PREDICATE: bad-inheritance-predicate < string ;
[
"in: classes.predicate.tests PREDICATE: bad-inheritance-predicate < bad-inheritance-predicate ;" eval( -- )
"IN: classes.predicate.tests PREDICATE: bad-inheritance-predicate < bad-inheritance-predicate ;" eval( -- )
] [ error>> bad-inheritance? ] must-fail-with
PREDICATE: bad-inheritance-predicate2 < string ;
PREDICATE: bad-inheritance-predicate3 < bad-inheritance-predicate2 ;
[
"in: classes.predicate.tests PREDICATE: bad-inheritance-predicate2 < bad-inheritance-predicate3 ;" eval( -- )
"IN: classes.predicate.tests PREDICATE: bad-inheritance-predicate2 < bad-inheritance-predicate3 ;" eval( -- )
] [ error>> bad-inheritance? ] must-fail-with
! This must not fail
PREDICATE: tup < string ;
UNION: u tup ;
{ } [ "in: classes.predicate.tests PREDICATE: u < tup ;" eval( -- ) ] unit-test
{ } [ "IN: classes.predicate.tests PREDICATE: u < tup ;" eval( -- ) ] unit-test
! Changing the metaclass of the predicate superclass should work
GENERIC: change-meta-test ( a -- b ) ;
@ -74,7 +74,7 @@ M: change-meta-test-predicate change-meta-test length>> ;
[ T{ change-meta-test-class f 0 } change-meta-test ] [ no-method? ] must-fail-with
{ 7 } [ T{ change-meta-test-class f 7 } change-meta-test ] unit-test
{ } [ "in: classes.predicate.tests use: arrays UNION: change-meta-test-class array ;" eval( -- ) ] unit-test
{ } [ "IN: classes.predicate.tests USE: arrays UNION: change-meta-test-class array ;" eval( -- ) ] unit-test
! Should not have changed
{ change-meta-test-class } [ change-meta-test-predicate superclass-of ] unit-test

View File

@ -9,7 +9,7 @@ GENERIC: zammo ( obj -- str ) ;
{ "yes!" } [ bzzt zammo ] unit-test
{ } [ SINGLETON: omg ] unit-test
{ t } [ omg singleton-class? ] unit-test
{ "in: classes.singleton.tests\nsingleton: omg\n" } [ [ omg see ] with-string-writer ] unit-test
{ "IN: classes.singleton.tests\nsingleton: omg\n" } [ [ omg see ] with-string-writer ] unit-test
SINGLETON: word-and-singleton

View File

@ -63,7 +63,7 @@ must-fail-with
must-fail-with
2 [
[ "IN: classes.tuple.parser.tests use: alien TUPLE: foo { slot dll } ;" eval( -- ) ]
[ "IN: classes.tuple.parser.tests USE: alien TUPLE: foo { slot dll } ;" eval( -- ) ]
[ error>> bad-initial-value? ]
must-fail-with
@ -71,14 +71,14 @@ must-fail-with
] times
2 [
[ "IN: classes.tuple.parser.tests use: arrays TUPLE: foo { slot array initial: 5 } ;" eval( -- ) ]
[ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { slot array initial: 5 } ;" eval( -- ) ]
[ error>> bad-initial-value? ]
must-fail-with
[ f ] [ \ foo tuple-class? ] unit-test
] times
[ "IN: classes.tuple.parser.tests use: arrays TUPLE: foo slot { slot array } ;" eval( -- ) ]
[ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo slot { slot array } ;" eval( -- ) ]
[ error>> duplicate-slot-names? ]
must-fail-with
@ -102,7 +102,7 @@ TUPLE: parsing-corner-case x ;
{ T{ parsing-corner-case f 3 } } [
{
"use: classes.tuple.parser.tests"
"USE: classes.tuple.parser.tests"
"T{ parsing-corner-case"
" f"
" 3"
@ -112,7 +112,7 @@ TUPLE: parsing-corner-case x ;
{ T{ parsing-corner-case f 3 } } [
{
"use: classes.tuple.parser.tests"
"USE: classes.tuple.parser.tests"
"T{ parsing-corner-case"
" { x 3 }"
"}"
@ -121,7 +121,7 @@ TUPLE: parsing-corner-case x ;
{ T{ parsing-corner-case f 3 } } [
{
"use: classes.tuple.parser.tests"
"USE: classes.tuple.parser.tests"
"T{ parsing-corner-case {"
" x 3 }"
"}"
@ -131,14 +131,14 @@ TUPLE: parsing-corner-case x ;
[
{
"use: classes.tuple.parser.tests T{ parsing-corner-case"
"USE: classes.tuple.parser.tests T{ parsing-corner-case"
" { x 3 }"
} "\n" join eval( -- tuple )
] [ error>> unexpected-eof? ] must-fail-with
[
{
"use: classes.tuple.parser.tests T{ parsing-corner-case {"
"USE: classes.tuple.parser.tests T{ parsing-corner-case {"
" x 3 }"
} "\n" join eval( -- tuple )
] [ error>> unexpected-eof? ] must-fail-with

View File

@ -350,7 +350,7 @@ about: "tuples"
HELP: tuple-class
{ $class-description "The class of tuple class words." }
{ $examples { $example "USING: classes.tuple prettyprint ;" "in: scratchpad" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ;
{ $examples { $example "USING: classes.tuple prettyprint ;" "IN: scratchpad" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ;
HELP: tuple=
{ $values { "tuple1" tuple } { "tuple2" tuple } { "?" boolean } }
@ -437,7 +437,7 @@ HELP: new
{ $examples
{ $example
"USING: kernel prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
"TUPLE: employee number name department ;"
"employee new ."
"T{ employee }"

View File

@ -27,7 +27,7 @@ C: <redefinition-test> redefinition-test ;
{ t } [ "redefinition-test" get redefinition-test? ] unit-test
"in: classes.tuple.tests TUPLE: redefinition-test ;" eval( -- )
"IN: classes.tuple.tests TUPLE: redefinition-test ;" eval( -- )
{ t } [ "redefinition-test" get redefinition-test? ] unit-test
@ -37,7 +37,7 @@ TUPLE: point x y ;
{ } [ 100 200 point boa "p" set ] unit-test
! Use eval to sequence parsing explicitly
{ } [ "in: classes.tuple.tests TUPLE: point x y z ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: point x y z ;" eval( -- ) ] unit-test
{ 100 } [ "p" get x>> ] unit-test
{ 200 } [ "p" get y>> ] unit-test
@ -49,7 +49,7 @@ TUPLE: point x y ;
{ 300 } [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
{ } [ "in: classes.tuple.tests TUPLE: point z y ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: point z y ;" eval( -- ) ] unit-test
{ 2 } [ "p" get tuple-size ] unit-test
@ -93,7 +93,7 @@ C: <empty> empty ;
[ t length ] [ object>> t eq? ] must-fail-with
{ "<constructor-test>" }
[ "in: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test ;" eval( -- ) last-word name>> ] unit-test
[ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test ;" eval( -- ) last-word name>> ] unit-test
TUPLE: size-test a b c d ;
@ -106,7 +106,7 @@ GENERIC: <yo-momma> ( a -- b ) ;
TUPLE: yo-momma ;
{ } [ "in: classes.tuple.tests C: <yo-momma> yo-momma ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests C: <yo-momma> yo-momma ;" eval( -- ) ] unit-test
{ f } [ \ <yo-momma> generic? ] unit-test
@ -272,7 +272,7 @@ test-server-slot-values
] unit-test
[
"in: classes.tuple.tests TUPLE: invalid-superclass < word ;" eval( -- )
"IN: classes.tuple.tests TUPLE: invalid-superclass < word ;" eval( -- )
] must-fail
! Dynamically changing inheritance hierarchy
@ -282,7 +282,7 @@ TUPLE: electronic-device ;
{ t } [ laptop new computer?' ] unit-test
{ } [ "in: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
{ t } [ laptop new computer?' ] unit-test
@ -300,17 +300,17 @@ TUPLE: electronic-device ;
{ f } [ "server" get laptop? ] unit-test
{ t } [ "server" get server? ] unit-test
{ } [ "in: classes.tuple.tests TUPLE: computer cpu ram ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: computer cpu ram ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
{ f } [ "laptop" get electronic-device? ] unit-test
{ t } [ "laptop" get computer? ] unit-test
{ } [ "in: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
{ } [ "in: classes.tuple.tests TUPLE: electronic-device voltage ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
@ -323,7 +323,7 @@ TUPLE: make-me-some-accessors voltage grounded? ;
{ } [ "laptop" get 220 >>voltage drop ] unit-test
{ } [ "server" get 110 >>voltage drop ] unit-test
{ } [ "in: classes.tuple.tests TUPLE: electronic-device voltage grounded? ; C: <computer> computer ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ; C: <computer> computer ;" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
@ -331,7 +331,7 @@ test-server-slot-values
{ 220 } [ "laptop" get voltage>> ] unit-test
{ 110 } [ "server" get voltage>> ] unit-test
{ } [ "in: classes.tuple.tests TUPLE: electronic-device grounded? voltage ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
@ -340,7 +340,7 @@ test-server-slot-values
{ 110 } [ "server" get voltage>> ] unit-test
! Reshaping superclass and subclass simultaneously
{ } [ "in: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ; C: <computer> computer ; C: <laptop> laptop ; C: <server> server ;" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
@ -359,11 +359,11 @@ TUPLE: test1 a ; TUPLE: test2 < test1 b ;
test-a/b
{ } [ "in: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" eval( -- ) ] unit-test
test-a/b
{ } [ "in: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" eval( -- ) ] unit-test
test-a/b
@ -388,19 +388,19 @@ T{ move-up-2 f "a" "b" "c" } "move-up" set
test-move-up
{ } [ "in: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval( -- ) ] unit-test
test-move-up
{ } [ "in: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval( -- ) ] unit-test
test-move-up
{ } [ "in: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval( -- ) ] unit-test
test-move-up
{ } [ "in: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval( -- ) ] unit-test
! Constructors must be recompiled when changing superclass
TUPLE: constructor-update-1 xxx ;
@ -411,7 +411,7 @@ TUPLE: constructor-update-2 < constructor-update-1 yyy zzz ;
{ 3 1 } [ <constructor-update-2> ] must-infer-as
{ } [ "in: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval( -- ) ] unit-test
{ 3 1 } [ <constructor-update-2> ] must-infer-as
@ -428,7 +428,7 @@ UNION: redefinition-problem' redefinition-problem integer ;
TUPLE: redefinition-problem-2 ;
"in: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" eval( -- )
"IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" eval( -- )
{ t } [ 3 redefinition-problem'? ] unit-test
@ -466,13 +466,13 @@ TUPLE: redefinition-problem-2 ;
] with-compilation-unit
] unit-test
[ "use: words T{ word }" eval( -- ) ]
[ "USE: words T{ word }" eval( -- ) ]
[ error>> T{ no-method f word new } = ]
must-fail-with
! Accessors not being forgotten...
{ [ ] } [
"in: classes.tuple.tests TUPLE: forget-accessors-test x y z ;"
"IN: classes.tuple.tests TUPLE: forget-accessors-test x y z ;"
<string-reader>
"forget-accessors-test" parse-stream
] unit-test
@ -488,7 +488,7 @@ must-fail-with
{ t } [ "z" accessor-exists? ] unit-test
{ [ ] } [
"in: classes.tuple.tests GENERIC: forget-accessors-test ( a -- b ) ;"
"IN: classes.tuple.tests GENERIC: forget-accessors-test ( a -- b ) ;"
<string-reader>
"forget-accessors-test" parse-stream
] unit-test
@ -503,7 +503,7 @@ TUPLE: another-forget-accessors-test ;
{ [ ] } [
"in: classes.tuple.tests GENERIC: another-forget-accessors-test ( a -- b ) ;"
"IN: classes.tuple.tests GENERIC: another-forget-accessors-test ( a -- b ) ;"
<string-reader>
"another-forget-accessors-test" parse-stream
] unit-test
@ -514,13 +514,13 @@ TUPLE: another-forget-accessors-test ;
{ f } [
f parser-quiet? [
[
"in: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" eval( -- )
"IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" eval( -- )
] with-string-writer empty?
] with-variable
] unit-test
! Missing error check
[ "in: classes.tuple.tests use: words TUPLE: wrong-superclass < word ;" eval( -- ) ] must-fail
[ "IN: classes.tuple.tests USE: words TUPLE: wrong-superclass < word ;" eval( -- ) ] must-fail
! Insufficient type checking
[ \ vocab tuple>array drop ] must-fail
@ -603,7 +603,7 @@ must-fail-with
{ } [
"in: classes.tuple.tests TUPLE: forget-subclass-test ; TUPLE: forget-subclass-test' < forget-subclass-test ;"
"IN: classes.tuple.tests TUPLE: forget-subclass-test ; TUPLE: forget-subclass-test' < forget-subclass-test ;"
<string-reader> "forget-subclass-test" parse-stream
drop
] unit-test
@ -611,14 +611,14 @@ must-fail-with
{ } [ "forget-subclass-test'" "classes.tuple.tests" lookup-word new "bad-object" set ] unit-test
{ } [
"in: classes.tuple.tests TUPLE: forget-subclass-test a ;"
"IN: classes.tuple.tests TUPLE: forget-subclass-test a ;"
<string-reader> "forget-subclass-test" parse-stream
drop
] unit-test
{ } [
"in: sequences TUPLE: reversed { seq read-only } ;" eval( -- )
"IN: sequences TUPLE: reversed { seq read-only } ;" eval( -- )
] unit-test
@ -634,7 +634,7 @@ DEFER: change-slot-test
slot: kex
{ } [
"in: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; slot: kex M: change-slot-test kex>> drop 3 ;"
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; slot: kex M: change-slot-test kex>> drop 3 ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
@ -642,7 +642,7 @@ slot: kex
{ t } [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
{ } [
"in: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test kex ;"
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test kex ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
@ -650,7 +650,7 @@ slot: kex
{ t } [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
{ } [
"in: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; slot: kex M: change-slot-test kex>> drop 3 ;"
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; slot: kex M: change-slot-test kex>> drop 3 ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
@ -660,15 +660,15 @@ slot: kex
DEFER: redefine-tuple-twice
{ } [ "in: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
{ t } [ \ redefine-tuple-twice symbol? ] unit-test
{ } [ "in: classes.tuple.tests defer: redefine-tuple-twice" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests defer: redefine-tuple-twice" eval( -- ) ] unit-test
{ t } [ \ redefine-tuple-twice deferred? ] unit-test
{ } [ "in: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
{ t } [ \ redefine-tuple-twice symbol? ] unit-test
@ -678,7 +678,7 @@ TUPLE: reshape-test x ;
T{ reshape-test f "hi" } "tuple" set
{ } [ "in: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" eval( -- ) ] unit-test
{ f } [ \ reshape-test \ x<< ?lookup-method ] unit-test
@ -686,11 +686,11 @@ T{ reshape-test f "hi" } "tuple" set
{ "hi" } [ "tuple" get x>> ] unit-test
{ } [ "in: classes.tuple.tests use: math TUPLE: reshape-test { x integer read-only } ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x integer read-only } ;" eval( -- ) ] unit-test
{ 0 } [ "tuple" get x>> ] unit-test
{ } [ "in: classes.tuple.tests use: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" eval( -- ) ] unit-test
{ 0 } [ "tuple" get x>> ] unit-test
@ -719,7 +719,7 @@ TUPLE: code-heap-ref ;
{ } [ gc ] unit-test
! Reshape!
{ } [ "in: classes.tuple.tests use: math TUPLE: code-heap-ref { x integer initial: 5 } ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests USE: math TUPLE: code-heap-ref { x integer initial: 5 } ;" eval( -- ) ] unit-test
! Code heap reference
{ t } [ code-heap-ref' code-heap-ref? ] unit-test
@ -736,7 +736,7 @@ TUPLE: metaclass-change-subclass < metaclass-change ;
{ metaclass-change } [ metaclass-change-subclass superclass-of ] unit-test
{ } [ "in: classes.tuple.tests mixin: metaclass-change" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests mixIN: metaclass-change" eval( -- ) ] unit-test
{ t } [ metaclass-change-subclass tuple-class? ] unit-test
{ tuple } [ metaclass-change-subclass superclass-of ] unit-test
@ -747,7 +747,7 @@ TUPLE: g < a-g ;
{ } [ g new "g" set ] unit-test
{ } [ "in: classes.tuple.tests mixin: a-g TUPLE: g ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests mixIN: a-g TUPLE: g ;" eval( -- ) ] unit-test
{ t } [ g new layout-of "g" get layout-of eq? ] unit-test
@ -755,14 +755,14 @@ TUPLE: g < a-g ;
DEFER: factor-crashes-anymore
{ } [
"in: classes.tuple.tests
"IN: classes.tuple.tests
TUPLE: unsafe-slot-access ;
CONSTANT: unsafe-slot-access' T{ unsafe-slot-access }" eval( -- )
] unit-test
{ } [
"in: classes.tuple.tests
use: accessors
"IN: classes.tuple.tests
USE: accessors
TUPLE: unsafe-slot-access { x read-only initial: 31337 } ;
: factor-crashes-anymore ( -- x ) unsafe-slot-access' x>> ;" eval( -- )
] unit-test
@ -771,7 +771,7 @@ DEFER: factor-crashes-anymore
TUPLE: tuple-predicate-redefine-test ;
{ } [ "in: classes.tuple.tests TUPLE: tuple-predicate-redefine-test ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: tuple-predicate-redefine-test ;" eval( -- ) ] unit-test
{ t } [ \ tuple-predicate-redefine-test? predicate? ] unit-test
@ -782,23 +782,23 @@ TUPLE: final-subclass < final-superclass ;
{ final-superclass } [ final-subclass superclass-of ] unit-test
! Making the superclass final should change the superclass of the subclass
{ } [ "in: classes.tuple.tests TUPLE: final-superclass ; final" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: final-superclass ; final" eval( -- ) ] unit-test
{ tuple } [ final-subclass superclass-of ] unit-test
{ f } [ \ final-subclass final-class? ] unit-test
! Subclassing a final class should fail
[ "in: classes.tuple.tests TUPLE: final-subclass < final-superclass ;" eval( -- ) ]
[ "IN: classes.tuple.tests TUPLE: final-subclass < final-superclass ;" eval( -- ) ]
[ error>> bad-superclass? ] must-fail-with
! Making a final class non-final should work
{ } [ "in: classes.tuple.tests TUPLE: final-superclass ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: final-superclass ;" eval( -- ) ] unit-test
{ } [ "in: classes.tuple.tests TUPLE: final-subclass < final-superclass ; final" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: final-subclass < final-superclass ; final" eval( -- ) ] unit-test
! Changing a superclass should not change the final status of a subclass
{ } [ "in: classes.tuple.tests TUPLE: final-superclass x ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: final-superclass x ;" eval( -- ) ] unit-test
{ t } [ \ final-subclass final-class? ] unit-test
@ -818,19 +818,19 @@ TUPLE: initial-class ;
DEFER: initial-slot
{ } [ "in: classes.tuple.tests TUPLE: initial-slot { x initial-class } ;" eval( -- ) ] unit-test
{ } [ "IN: classes.tuple.tests TUPLE: initial-slot { x initial-class } ;" eval( -- ) ] unit-test
{ t } [ initial-slot new x>> initial-class? ] unit-test
[ "in: classes.tuple.tests TUPLE: initial-slot { x initial-class initial: f } ;" eval( -- ) ]
[ "IN: classes.tuple.tests TUPLE: initial-slot { x initial-class initial: f } ;" eval( -- ) ]
[ error>> T{ bad-initial-value f "x" f initial-class } = ] must-fail-with
[ "in: classes.tuple.tests TUPLE: initial-slot { x initial-class initial: 3 } ;" eval( -- ) ]
[ "IN: classes.tuple.tests TUPLE: initial-slot { x initial-class initial: 3 } ;" eval( -- ) ]
[ error>> T{ bad-initial-value f "x" 3 initial-class } = ] must-fail-with
[ "in: classes.tuple.tests use: math TUPLE: foo < foo ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with
[ "IN: classes.tuple.tests USE: math TUPLE: foo < foo ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with
[ "in: classes.tuple.tests use: math TUPLE: foo < + ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with
[ "IN: classes.tuple.tests USE: math TUPLE: foo < + ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with
! Test no-slot error and get/set-slot-named
@ -870,5 +870,5 @@ C: <no-slot-tuple0> no-slot-tuple0 ;
} 1&&
] must-fail-with
[ "in: classes.tuple.tests TUPLE: too-many-slots-test a b c d ; T{ too-many-slots-test f 1 2 3 4 5 }" eval( -- x ) ]
[ "IN: classes.tuple.tests TUPLE: too-many-slots-test a b c d ; T{ too-many-slots-test f 1 2 3 4 5 }" eval( -- x ) ]
[ error>> too-many-slots? ] must-fail-with

View File

@ -9,7 +9,7 @@ IN: classes.union.tests
UNION: bah fixnum alien ;
{ bah } [ \ bah? "predicating" word-prop ] unit-test
{ "USING: alien math ;\nin: classes.union.tests\nUNION: bah fixnum alien ;\n" }
{ "USING: alien math ;\nIN: classes.union.tests\nUNION: bah fixnum alien ;\n" }
[ [ \ bah see ] with-string-writer ] unit-test
! Test redefinition of classes
@ -23,13 +23,13 @@ M: union-1 generic-update-test drop "union-1" ;
{ t } [ union-1 number class<= ] unit-test
{ "union-1" } [ 1.0 generic-update-test ] unit-test
"in: classes.union.tests use: math use: arrays UNION: union-1 rational array ;" eval( -- )
"IN: classes.union.tests USE: math USE: arrays UNION: union-1 rational array ;" eval( -- )
{ t } [ bignum union-1 class<= ] unit-test
{ f } [ union-1 number class<= ] unit-test
{ "union-1" } [ { 1.0 } generic-update-test ] unit-test
"in: classes.union.tests use: math PREDICATE: union-1 < integer even? ;" eval( -- )
"IN: classes.union.tests USE: math PREDICATE: union-1 < integer even? ;" eval( -- )
{ f } [ union-1 union-class? ] unit-test
{ t } [ union-1 predicate-class? ] unit-test
@ -57,7 +57,7 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ;
{ t } [ fixnum redefine-bug-2 class<= ] unit-test
{ t } [ quotation redefine-bug-2 class<= ] unit-test
{ } [ "in: classes.union.tests use: math UNION: redefine-bug-1 bignum ;" eval( -- ) ] unit-test
{ } [ "IN: classes.union.tests USE: math UNION: redefine-bug-1 bignum ;" eval( -- ) ] unit-test
{ t } [ bignum redefine-bug-1 class<= ] unit-test
{ f } [ fixnum redefine-bug-2 class<= ] unit-test
@ -65,13 +65,13 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ;
! Too eager with reset-class
{ } [ "in: classes.union.tests singleton: foo UNION: blah foo ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test
{ } [ "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-word union-class? ] 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
{ } [ "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-word union-class? ] unit-test
@ -97,11 +97,11 @@ M: a-union test-generic ;
{ t } [ \ integer? def>> \ fixnum-bitand swap member? ] unit-test
{ } [ "in: classes.union.tests use: math UNION: fast-union-1 fixnum ; UNION: fast-union-2 fast-union-1 bignum ;" eval( -- ) ] unit-test
{ } [ "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-word def>> \ fixnum-bitand swap member? ] unit-test
{ } [ "in: classes.union.tests use: vectors UNION: fast-union-1 vector ;" eval( -- ) ] unit-test
{ } [ "IN: classes.union.tests USE: vectors UNION: fast-union-1 vector ;" eval( -- ) ] unit-test
{ f } [ "fast-union-2?" "classes.union.tests" lookup-word def>> \ fixnum-bitand swap member? ] unit-test
@ -131,12 +131,12 @@ PREDICATE: numba-ova-10 < union{ float integer }
{ f } [ 5.75 numba-ova-10? ] unit-test
! Issue #420 lol
[ "in: issue-420 UNION: omg omg ;" eval( -- ) ]
[ "IN: issue-420 UNION: omg omg ;" eval( -- ) ]
[ error>> cannot-reference-self? ] must-fail-with
IN: issue-420
UNION: a ;
UNION: b a ;
[ "in: issue-420 UNION: a b ;" eval( -- ) ]
[ "IN: issue-420 UNION: a b ;" eval( -- ) ]
[ error>> cannot-reference-self? ] must-fail-with

View File

@ -146,9 +146,9 @@ $nl
"Here is an array containing the " { $link f } " class:"
{ $example "{ postpone\ f } ." "{ postpone\ f }" }
"The " { $link f } " object is an instance of the " { $link f } " class:"
{ $example "use: classes" "f class-of ." "postpone\ f" }
{ $example "USE: classes" "f class-of ." "postpone\ f" }
"The " { $link f } " class is an instance of " { $link word } ":"
{ $example "use: classes" "\\ f class-of ." "word" }
{ $example "USE: classes" "\\ f class-of ." "word" }
"On the other hand, " { $link t } " is just a word, and there is no class which it is a unique instance of."
{ $example "t \\ t eq? ." "t" }
"Many words which search collections confuse the case of no element being present with an element being found equal to " { $link f } ". If this distinction is important, there is usually an alternative word which can be used; for example, compare " { $link at } " with " { $link at* } "." ;
@ -301,7 +301,7 @@ HELP: to-fixed-point
{ $examples
{ $example
"USING: combinators kernel math prettyprint sequences ;"
"in: scratchpad"
"IN: scratchpad"
": flatten ( sequence -- sequence' )"
" \"flatten\" over index"
" [ [ 1 + swap nth ] [ nip dup 2 + ] [ drop ] 2tri replace-slice ] when* ;"
@ -356,7 +356,7 @@ HELP: case
{ $examples
{ $example
"USING: combinators io kernel ;"
"in: scratchpad"
"IN: scratchpad"
"SYMBOLS: yes no maybe ;"
"maybe {"
" { yes [ ] } ! Do nothing"

View File

@ -131,7 +131,7 @@ ARTICLE: "rc-files" "Running code on startup"
$nl
"If you are unsure where the files should be located, evaluate the following code:"
{ $code
"use: command-line"
"USE: command-line"
"\".factor-rc\" rc-path print"
"\".factor-boot-rc\" rc-path print"
}

View File

@ -104,7 +104,7 @@ $nl
"Manually creating a word using the non-optimizing compiler:"
{ $example
"USING: compiler.units io ;"
"in: test symbol: foo"
"IN: test symbol: foo"
"{ { foo [ \"hello!\" write nl ] } } t t modify-code-heap foo"
"hello!"
}

View File

@ -54,7 +54,7 @@ observer add-definition-observer
DEFER: nesting-test
{ } [ "in: compiler.units.tests COMPILE< : nesting-test ( -- ) ; COMPILE>" eval( -- ) ] unit-test
{ } [ "IN: compiler.units.tests COMPILE< : nesting-test ( -- ) ; COMPILE>" eval( -- ) ] unit-test
observer remove-definition-observer

View File

@ -35,11 +35,11 @@ M: hello bing hello-test ;
{ 3 } [ 1 0 <hello> 2 whoa ] unit-test
{ 3 } [ 1 0 <hello> f <goodbye> 2 whoa ] unit-test
{ } [ 3 [ "USING: accessors delegate ; in: delegate.tests CONSULT: baz goodbye these>> ;" eval( -- ) ] times ] unit-test
{ } [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" eval( -- ) ] times ] unit-test
{ H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } } [ baz protocol-consult ] unit-test
{ H{ } } [ bee protocol-consult ] unit-test
{ "USING: delegate ;\nin: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" } [ [ baz see ] with-string-writer ] unit-test
{ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" } [ [ baz see ] with-string-writer ] unit-test
GENERIC: one ( a -- b ) ;
M: integer one ;
@ -63,22 +63,22 @@ CONSULT: beta hey value>> 1 - ;
{ 0 } [ 1 <hey> three ] unit-test
{ { hey } } [ alpha protocol-users ] unit-test
{ { hey } } [ beta protocol-users ] unit-test
{ } [ "use: delegate in: delegate.tests PROTOCOL: alpha one ;" eval( -- ) ] unit-test
{ } [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" eval( -- ) ] unit-test
{ f } [ hey \ two ?lookup-method ] unit-test
{ f } [ hey \ four ?lookup-method ] unit-test
{ } [ "use: delegate in: delegate.tests PROTOCOL: beta two three four ;" eval( -- ) ] unit-test
{ } [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" eval( -- ) ] unit-test
{ { hey } } [ alpha protocol-users ] unit-test
{ { hey } } [ beta protocol-users ] unit-test
{ 2 } [ 1 <hey> one ] unit-test
{ 0 } [ 1 <hey> two ] unit-test
{ 0 } [ 1 <hey> three ] unit-test
{ 0 } [ 1 <hey> four ] unit-test
{ } [ "USING: math accessors delegate ; in: delegate.tests CONSULT: beta hey value>> 2 - ;" eval( -- ) ] unit-test
{ } [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" eval( -- ) ] unit-test
{ 2 } [ 1 <hey> one ] unit-test
{ -1 } [ 1 <hey> two ] unit-test
{ -1 } [ 1 <hey> three ] unit-test
{ -1 } [ 1 <hey> four ] unit-test
{ } [ "in: delegate.tests forget: alpha" eval( -- ) ] unit-test
{ } [ "IN: delegate.tests forget: alpha" eval( -- ) ] unit-test
{ f } [ hey \ one ?lookup-method ] unit-test
TUPLE: slot-protocol-test-1 a b ;
@ -116,8 +116,8 @@ PROTOCOL: silly-protocol do-me ;
! Replacing a method definition with a consultation would cause problems
{ [ ] } [
"in: delegate.tests
use: kernel
"IN: delegate.tests
USE: kernel
M: a-tuple do-me drop ;" <string-reader> "delegate-test" parse-stream
] unit-test
@ -126,9 +126,9 @@ PROTOCOL: silly-protocol do-me ;
! Change method definition to consultation
{ [ ] } [
"in: delegate.tests
use: kernel
use: delegate
"IN: delegate.tests
USE: kernel
USE: delegate
CONSULT: silly-protocol a-tuple drop f ; " <string-reader> "delegate-test" parse-stream
] unit-test
@ -137,7 +137,7 @@ PROTOCOL: silly-protocol do-me ;
! Now try removing the consultation
{ [ ] } [
"in: delegate.tests" <string-reader> "delegate-test" parse-stream
"IN: delegate.tests" <string-reader> "delegate-test" parse-stream
] unit-test
! Method should be gone
@ -150,7 +150,7 @@ slot: y
{ f } [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
{ [ ] } [
"in: delegate.tests
"IN: delegate.tests
USING: accessors delegate ;
TUPLE: slot-protocol-test-3 x ;
CONSULT: y>> slot-protocol-test-3 x>> ;"
@ -160,7 +160,7 @@ CONSULT: y>> slot-protocol-test-3 x>> ;"
{ t } [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
{ [ ] } [
"in: delegate.tests
"IN: delegate.tests
TUPLE: slot-protocol-test-3 x y ;"
<string-reader> "delegate-test-1" parse-stream
] unit-test
@ -171,7 +171,7 @@ TUPLE: slot-protocol-test-3 x y ;"
! We want to be able to override methods after consultation
{ [ ] } [
"in: delegate.tests
"IN: delegate.tests
USING: delegate kernel sequences delegate.protocols accessors ;
TUPLE: override-method-test seq ;
CONSULT: sequence-protocol override-method-test seq>> ;
@ -183,7 +183,7 @@ DEFER: seq-delegate
! See if removing a consultation updates protocol-consult word prop
{ [ ] } [
"in: delegate.tests
"IN: delegate.tests
USING: accessors delegate delegate.protocols ;
TUPLE: seq-delegate seq ;
CONSULT: sequence-protocol seq-delegate seq>> ;"
@ -197,7 +197,7 @@ DEFER: seq-delegate
] unit-test
{ [ ] } [
"in: delegate.tests
"IN: delegate.tests
USING: delegate delegate.protocols ;
TUPLE: seq-delegate seq ;"
<string-reader> "remove-consult-test" parse-stream
@ -218,7 +218,7 @@ BROADCAST: broadcastable broadcaster targets>> ;
M: integer broadcastable 1 + , ;
[ "USING: accessors delegate ; in: delegate.tests BROADCAST: nonbroadcastable broadcaster targets>> ;" eval( -- ) ]
[ "USING: accessors delegate ; IN: delegate.tests BROADCAST: nonbroadcastable broadcaster targets>> ;" eval( -- ) ]
[ error>> broadcast-words-must-have-no-outputs? ] must-fail-with
{ { 2 3 4 } }

View File

@ -188,11 +188,11 @@ M: byte-array small-lo-tag drop "byte-array" ;
{ "double-array" } [ double-array{ 1.0 } small-lo-tag ] unit-test
! Testing recovery from bad method definitions
"in: generic.standard.tests GENERIC: unhappy ( x -- x ) ;" eval( -- )
"IN: generic.standard.tests GENERIC: unhappy ( x -- x ) ;" eval( -- )
[
"in: generic.standard.tests M: dictionary unhappy ;" eval( -- )
"IN: generic.standard.tests M: dictionary unhappy ;" eval( -- )
] must-fail
{ } [ "in: generic.standard.tests GENERIC: unhappy ( x -- x ) ;" eval( -- ) ] unit-test
{ } [ "IN: generic.standard.tests GENERIC: unhappy ( x -- x ) ;" eval( -- ) ] unit-test
GENERIC#: complex-combination 1 ( a b -- c ) ;
M: string complex-combination drop ;
@ -237,7 +237,7 @@ M: f generic-forget-test ;
{ } [ [ "m" get forget ] with-compilation-unit ] unit-test
{ } [ "in: generic.standard.tests M: f generic-forget-test ;" eval( -- ) ] unit-test
{ } [ "IN: generic.standard.tests M: f generic-forget-test ;" eval( -- ) ] unit-test
{ } [ [ "m" get forget ] with-compilation-unit ] unit-test
@ -245,7 +245,7 @@ M: f generic-forget-test ;
! erg's regression
{ } [
"in: generic.standard.tests
"IN: generic.standard.tests
GENERIC: jeah ( a -- b ) ;
TUPLE: boii ;
@ -253,10 +253,10 @@ M: f generic-forget-test ;
GENERIC: jeah* ( a -- b ) ;
M: boii jeah* jeah ;" eval( -- )
"in: generic.standard.tests
"IN: generic.standard.tests
forget: boii" eval( -- )
"in: generic.standard.tests
"IN: generic.standard.tests
TUPLE: boii ;
M: boii jeah ;" eval( -- )
] unit-test
@ -358,38 +358,38 @@ M: c funky* "c" , call-next-method ;
] unit-test
! Changing method combination should not fail
{ } [ "in: generic.standard.tests GENERIC: xyz ( a -- b ) ;" eval( -- ) ] unit-test
{ } [ "in: generic.standard.tests MATH: xyz ( a b -- c ) ;" eval( -- ) ] unit-test
{ } [ "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-word pic-def>> ] unit-test
{ f } [ "xyz" "generic.standard.tests" lookup-word "decision-tree" word-prop ] unit-test
! Corner cases
[ "in: generic.standard.tests GENERIC: broken-generic ( -- ) ;" eval( -- ) ]
[ "IN: generic.standard.tests GENERIC: broken-generic ( -- ) ;" eval( -- ) ]
[ error>> bad-dispatch-position? ]
must-fail-with
[ "in: generic.standard.tests GENERIC#: broken-generic# -1 ( a -- b ) ;" eval( -- ) ]
[ "IN: generic.standard.tests GENERIC#: broken-generic# -1 ( a -- b ) ;" eval( -- ) ]
[ error>> bad-dispatch-position? ]
must-fail-with
[ "in: generic.standard.tests GENERIC#: broken-generic# 1 ( a -- b ) ;" eval( -- ) ]
[ "IN: generic.standard.tests GENERIC#: broken-generic# 1 ( a -- b ) ;" eval( -- ) ]
[ error>> bad-dispatch-position? ]
must-fail-with
[ "in: generic.standard.tests GENERIC#: broken-generic# 2/3 ( a b c -- ) ;" eval( -- ) ]
[ "IN: generic.standard.tests GENERIC#: broken-generic# 2/3 ( a b c -- ) ;" eval( -- ) ]
[ error>> bad-dispatch-position? ]
must-fail-with
! Generic words cannot be inlined
{ } [ "in: generic.standard.tests GENERIC: foo ( x -- x ) ;" eval( -- ) ] unit-test
[ "in: generic.standard.tests GENERIC: foo ( x -- x ) ; inline" eval( -- ) ] must-fail
{ } [ "IN: generic.standard.tests GENERIC: foo ( x -- x ) ;" eval( -- ) ] unit-test
[ "IN: generic.standard.tests GENERIC: foo ( x -- x ) ; inline" eval( -- ) ] must-fail
! Moving a method from one vocab to another didn't always work
GENERIC: move-method-generic ( a -- b ) ;
{ } [ "in: generic.standard.tests.a use: strings use: generic.standard.tests M: string move-method-generic ;" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
{ } [ "IN: generic.standard.tests.a USE: strings USE: generic.standard.tests M: string move-method-generic ;" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
{ } [ "in: generic.standard.tests.b use: strings use: generic.standard.tests M: string move-method-generic ;" <string-reader> "move-method-test-2" parse-stream drop ] unit-test
{ } [ "IN: generic.standard.tests.b USE: strings USE: generic.standard.tests M: string move-method-generic ;" <string-reader> "move-method-test-2" parse-stream drop ] unit-test
{ } [ "in: generic.standard.tests.a" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
{ } [ "IN: generic.standard.tests.a" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
{ { string } } [ \ move-method-generic order ] unit-test
@ -398,7 +398,7 @@ GENERIC: forget-test ( a -- b ) ;
M: integer forget-test 3 + ;
{ } [ "in: generic.standard.tests use: math forget: M\\ integer forget-test" eval( -- ) ] unit-test
{ } [ "IN: generic.standard.tests USE: math forget: M\\ integer forget-test" eval( -- ) ] unit-test
{ { } } [
\ + effect-dependencies-of keys [ method? ] filter

View File

@ -133,7 +133,7 @@ HELP: <clumps>
"Running averages:"
{ $example
"USING: grouping sequences math prettyprint kernel ;"
"in: scratchpad"
"IN: scratchpad"
"CONSTANT: share-price { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 }"
""
"share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."

View File

@ -214,7 +214,7 @@ HELP: execute
{ $values { "word" word } }
{ $description "Executes a word. Words which " { $link execute } " an input parameter must be declared " { $link postpone\ inline } " so that a caller which passes in a literal word can have a static stack effect." }
{ $examples
{ $example "USING: kernel io words ;" "in: scratchpad" ": twice ( word -- ) dup execute execute ; inline\n: hello ( -- ) \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
{ $example "USING: kernel io words ;" "IN: scratchpad" ": twice ( word -- ) dup execute execute ; inline\n: hello ( -- ) \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
} ;
{ execute postpone\ execute( } related-words
@ -632,7 +632,7 @@ $nl
{ $examples
{ $example
"USING: kernel math prettyprint sequences ;"
"in: scratchpad"
"IN: scratchpad"
""
"CONSTANT: american-cities {"
" \"San Francisco\""
@ -660,7 +660,7 @@ $nl
"Notice how in this example, the same value is tested by the conditional, and then used in the true branch; the false branch does not need to drop the value because of how " { $link if* } " works:"
{ $example
"USING: assocs io kernel math.parser ;"
"in: scratchpad"
"IN: scratchpad"
""
": curry-price ( meat -- price )
{

View File

@ -185,7 +185,7 @@ $nl
}
"Inside a lexical scope, literals which do not contain lexical variables still behave in the same way:"
{ $example
"use: locals"
"USE: locals"
"IN: scratchpad"
"TUPLE: person first-name last-name ;"
":: locals-word-test ( -- tuple )"

View File

@ -150,14 +150,14 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
DEFER: xyzzy
{ } [
"in: locals.tests use: math GENERIC: xyzzy ( a -- b ) ; M: integer xyzzy ;"
"IN: locals.tests USE: math GENERIC: xyzzy ( a -- b ) ; M: integer xyzzy ;"
<string-reader> "lambda-generic-test" parse-stream drop
] unit-test
{ 10 } [ 10 xyzzy ] unit-test
{ } [
"in: locals.tests use: math use: locals GENERIC: xyzzy ( a -- b ) ; M:: integer xyzzy ( n -- x ) ; 5"
"IN: locals.tests USE: math USE: locals GENERIC: xyzzy ( a -- b ) ; M:: integer xyzzy ( n -- x ) ; 5"
<string-reader> "lambda-generic-test" parse-stream drop
] unit-test
@ -185,7 +185,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
:: a-word-with-locals ( a b -- ) ;
CONSTANT: new-definition "USING: math ;\nin: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" ;
CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" ;
{ } [ new-definition eval( -- ) ] unit-test
@ -400,8 +400,8 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
{ t } [ 3 funny-macro-test ] unit-test
{ f } [ 2 funny-macro-test ] unit-test
[ "use: locals let[" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
[ "use: locals |[" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
[ "USE: locals let[" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
[ "USE: locals |[" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
{ 25 } [ 5 |[ a | { [ a sq ] } cond ] call ] unit-test
{ 25 } [ 5 |[ | { |[ a | a sq ] } ] call first call ] unit-test
@ -416,13 +416,13 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
{ 3 } [ 3 |[ a | \ a ] call ] unit-test
[ "use: locals |[ | { let[ 0 :> a a ] } ]" eval( -- ) ] must-fail
[ "USE: locals |[ | { let[ 0 :> a a ] } ]" eval( -- ) ] must-fail
[ "use: locals |[ | let[ 0 :> a! { a! } ] ]" eval( -- ) ] must-fail
[ "USE: locals |[ | let[ 0 :> a! { a! } ] ]" eval( -- ) ] must-fail
[ "use: locals |[ | { :> a } ]" eval( -- ) ] must-fail
[ "USE: locals |[ | { :> a } ]" eval( -- ) ] must-fail
[ "use: locals 3 :> a" eval( -- ) ] must-fail
[ "USE: locals 3 :> a" eval( -- ) ] must-fail
{ 3 } [ 3 |[ | :> a a ] call ] unit-test

View File

@ -7,26 +7,26 @@ MACRO: see-test ( a b -- quot ) + ;
{ t } [ \ see-test macro? ] unit-test
{ "USING: macros math ;\nin: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" }
{ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" }
[ [ \ see-test see ] with-string-writer ]
unit-test
{ t } [ \ see-test macro? ] unit-test
{ t } [
"USING: math ;\nin: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval( -- )
"USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval( -- )
[ \ see-test see ] with-string-writer =
] unit-test
{ f } [ \ see-test macro? ] unit-test
{ } [ "USING: macros stack-checker kernel ; in: hanging-macro MACRO: c ( quot -- quot ) infer drop [ ] ;" eval( -- ) ] unit-test
{ } [ "USING: macros kernel ; in: hanging-macro : a ( -- ) [ a ] c ;" eval( -- ) ] unit-test
{ } [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- quot ) infer drop [ ] ;" eval( -- ) ] unit-test
{ } [ "USING: macros kernel ; IN: hanging-macro : a ( -- ) [ a ] c ;" eval( -- ) ] unit-test
{ } [ [ "hanging-macro" forget-vocab ] with-compilation-unit ] unit-test
{ } [ "in: macros.tests use: macros MACRO: foo ( -- x ) [ ] ;" eval( -- ) ] unit-test
[ "in: macros.tests use: macros MACRO: foo ( -- x ) [ ] ; inline" eval( -- ) ] must-fail
{ } [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ;" eval( -- ) ] unit-test
[ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ; inline" eval( -- ) ] must-fail
! The macro expander code should infer
MACRO: bad-macro ( a -- b ) 1 2 3 [ ] ;

View File

@ -4,10 +4,10 @@ IN: math.integers
ARTICLE: "integers" "Integers"
{ $subsections integer }
"Integers come in two varieties -- fixnums and bignums. Fixnums fit in a machine word and are faster to manipulate; if the result of a fixnum operation is too large to fit in a fixnum, the result is upgraded to a bignum. Here is an example where two fixnums are multiplied yielding a bignum:"
{ $example "use: classes" "67108864 class-of ." "fixnum" }
{ $example "use: classes" "128 class-of ." "fixnum" }
{ $example "USE: classes" "67108864 class-of ." "fixnum" }
{ $example "USE: classes" "128 class-of ." "fixnum" }
{ $example "134217728 128 * ." "17179869184" }
{ $example "use: classes" "1 128 shift class-of ." "bignum" }
{ $example "USE: classes" "1 128 shift class-of ." "bignum" }
"Integers can be entered using a different base; see " { $link "syntax-numbers" } "."
$nl
"Integers can be tested for, and real numbers can be converted to integers:"

View File

@ -460,7 +460,7 @@ ARTICLE: "number-protocol" "Number protocol"
"Math operations obey certain numerical upgrade rules. If one of the inputs is a bignum and the other is a fixnum, the latter is first coerced to a bignum; if one of the inputs is a float, the other is coerced to a float."
$nl
"Two examples where you should note the types of the inputs and outputs:"
{ $example "use: classes" "3 >fixnum 6 >bignum * class-of ." "bignum" }
{ $example "USE: classes" "3 >fixnum 6 >bignum * class-of ." "bignum" }
{ $example "1/2 2.0 + ." "2.5" }
"The following usual operations are supported by all numbers."
{ $subsections

View File

@ -23,13 +23,13 @@ MEMO: x ( a b c d e -- f g h i j )
MEMO: see-test ( a -- b ) reverse ;
{ "USING: sequences ;\nin: memoize.tests\nMEMO: see-test ( a -- b ) reverse ;\n" }
{ "USING: sequences ;\nIN: memoize.tests\nMEMO: see-test ( a -- b ) reverse ;\n" }
[ [ \ see-test see ] with-string-writer ]
unit-test
{ } [ "in: memoize.tests : fib ( -- ) ;" eval( -- ) ] unit-test
{ } [ "IN: memoize.tests : fib ( -- ) ;" eval( -- ) ] unit-test
{ "in: memoize.tests\n: fib ( -- ) ;\n" } [ [ \ fib see ] with-string-writer ] unit-test
{ "IN: memoize.tests\n: fib ( -- ) ;\n" } [ [ \ fib see ] with-string-writer ] unit-test
[ sq ] ( a -- b ) memoize-quot "q" set

View File

@ -38,7 +38,7 @@ $nl
"One reason to save a custom image is if you find yourself loading the same libraries in every Factor session; some libraries take a little while to compile, so saving an image with those libraries loaded can save you a lot of time."
$nl
"For example, to save an image with the web framework loaded,"
{ $code "use: furnace" "save" }
{ $code "USE: furnace" "save" }
"New images can be created from scratch:"
{ $subsections "bootstrap.image" }
"The " { $link "tools.deploy" } " tool creates stripped-down images containing just enough code to run a single application."

View File

@ -110,7 +110,7 @@ HELP: +@
{ $description "Adds " { $snippet "n" } " to the value of the variable. A variable value of " { $link f } " is interpreted as being zero." }
{ $side-effects "variable" }
{ $examples
{ $example "USING: namespaces prettyprint ;" "in: scratchpad" "symbol: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
{ $example "USING: namespaces prettyprint ;" "IN: scratchpad" "symbol: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
} ;
HELP: inc
@ -133,7 +133,7 @@ HELP: with-scope
{ $values { "quot" quotation } }
{ $description "Calls the quotation in a new namespace. Any variables set by the quotation are discarded when it returns." }
{ $examples
{ $example "USING: math namespaces prettyprint ;" "in: scratchpad" "symbol: x" "0 x set" "[ x [ 5 + ] change x get . ] with-scope x get ." "5\n0" }
{ $example "USING: math namespaces prettyprint ;" "IN: scratchpad" "symbol: x" "0 x set" "[ x [ 5 + ] change x get . ] with-scope x get ." "5\n0" }
} ;
HELP: with-variable

View File

@ -32,7 +32,7 @@ ARTICLE: "wrappers" "Wrappers"
}
"Wrapper literal syntax is documented in " { $link "syntax-words" } "."
{ $example
"in: scratchpad"
"IN: scratchpad"
"defer: my-word"
"\\ my-word name>> ."
"\"my-word\""

View File

@ -34,7 +34,7 @@ ARTICLE: "inference-combinators" "Combinator stack effects"
"The following word calls a quotation twice; the word is declared " { $link postpone\ inline } ", since it invokes " { $link call } " on the result of " { $link compose } " on an input parameter:"
{ $code ": twice ( value quot -- result ) dup compose call ; inline" }
"The following code now passes the stack checker; it would fail were " { $snippet "twice" } " not declared " { $link postpone\ inline } ":"
{ $unchecked-example "use: math.functions" "[ [ sqrt ] twice ] infer." "( x -- x )" }
{ $unchecked-example "USE: math.functions" "[ [ sqrt ] twice ] infer." "( x -- x )" }
{ $subheading "Defining a combinator for unknown quotations" }
"In the next example, " { $link postpone\ call( } " must be used because the quotation is the result of calling a runtime accessor, and the compiler cannot make any static assumptions about this quotation at all:"
{ $code

View File

@ -437,8 +437,8 @@ HELP: \ ;
"Parsing words can use this word as a generic end delimiter."
} ;
HELP: \ symbol:
{ $syntax "symbol: word" }
HELP: \ SYMBOL:
{ $syntax "SYMBOL: word" }
{ $values { "word" "a new word to define" } }
{ $description "Defines a new symbol word in the current vocabulary. Symbols push themselves on the stack when executed, and are used to identify variables (see " { $link "namespaces" } ") as well as for storing crufties in word properties (see " { $link "word-props" } ")." }
{ $examples { $example "USE: prettyprint" "in: scratchpad" "symbol: foo\nfoo ." "foo" } } ;
@ -451,8 +451,8 @@ HELP: \ SYMBOLS:
{ $description "Creates a new symbol for every token until the " { $snippet ";" } "." }
{ $examples { $example "USING: prettyprint ;" "in: scratchpad" "SYMBOLS: foo bar baz ;\nfoo . bar . baz ." "foo\nbar\nbaz" } } ;
HELP: \ singleton:
{ $syntax "singleton: class" }
HELP: \ SINGLETON:
{ $syntax "SINGLETON: class" }
{ $values
{ "class" "a new singleton to define" }
}
@ -497,14 +497,14 @@ HELP: \ \
{ $description "Reads the next word from the input and appends a wrapper holding the word to the parse tree. When the evaluator encounters a wrapper, it pushes the wrapped word literally on the data stack." }
{ $examples "The following two lines are equivalent:" { $code "0 \\ <vector> execute\n0 <vector>" } "If " { $snippet "foo" } " is a symbol, the following two lines are equivalent:" { $code "foo" "\\ foo" } } ;
HELP: \ defer:
HELP: \ DEFER:
{ $syntax "defer: word" }
{ $values { "word" "a new word to define" } }
{ $description "Create a word in the current vocabulary that simply raises an error when executed. Usually, the word will be replaced with a real definition later." }
{ $notes "Due to the way the parser works, words cannot be referenced before they are defined; that is, source files must order definitions in a strictly bottom-up fashion. Mutually-recursive pairs of words can be implemented by " { $emphasis "deferring" } " one of the words in the pair allowing the second word in the pair to parse, then by defining the first word." }
{ $examples { $code "defer: foe\n: fie ... foe ... ;\n: foe ... fie ... ;" } } ;
HELP: \ forget:
HELP: \ FORGET:
{ $syntax "forget: word" }
{ $values { "word" word } }
{ $description "Removes the word from its vocabulary, or does nothing if no such word exists. Existing definitions that reference forgotten words will continue to work, but new occurrences of the word will not parse." } ;
@ -516,8 +516,8 @@ HELP: \ USE:
{ $notes "If adding the vocabulary introduces ambiguity, referencing the ambiguous names will throw a " { $link ambiguous-use-error } "." }
{ $errors "Throws an error if the vocabulary does not exist or could not be loaded." } ;
HELP: \ unuse:
{ $syntax "unuse: vocabulary" }
HELP: \ UNUSE:
{ $syntax "UNUSE: vocabulary" }
{ $values { "vocabulary" "a vocabulary name" } }
{ $description "Removes a vocabulary from the search path." }
{ $errors "Throws an error if the vocabulary does not exist." } ;

View File

@ -63,7 +63,7 @@ $nl
$nl
"Application vocabularies can define a main entry point, giving the user a convenient way to run the application:"
{ $subsections
postpone\ main:
\ MAIN:
run
runnable-vocab
}
@ -77,7 +77,7 @@ HELP: load-vocab
HELP: vocab-main
{ $values { "vocab-spec" "a vocabulary specifier" } { "main" word } }
{ $description "Outputs the main entry point for a vocabulary. The entry point can be executed with " { $link run } " and set with " { $link postpone\ main: } "." } ;
{ $description "Outputs the main entry point for a vocabulary. The entry point can be executed with " { $link run } " and set with " { $link \ MAIN: } "." } ;
HELP: vocab-roots
{ $var-description "A sequence of pathname strings to search for vocabularies." } ;
@ -120,7 +120,7 @@ HELP: require-when
HELP: run
{ $values { "vocab" "a vocabulary specifier" } }
{ $description "Runs a vocabulary's main entry point. The main entry point is set with the " { $link postpone\ main: } " parsing word." } ;
{ $description "Runs a vocabulary's main entry point. The main entry point is set with the " { $link \ MAIN: } " parsing word." } ;
HELP: vocab-source-path
{ $values { "vocab" "a vocabulary specifier" } { "path/f" { $maybe "a pathname string" } } }

View File

@ -21,7 +21,7 @@ IN: vocabs.loader.test.2
: hello ( -- ) ;
main: hello
MAIN: hello
IN: vocabs.loader.tests
@ -54,7 +54,7 @@ IN: vocabs.loader.tests
{ 2 } [ "count-me" get-global ] unit-test
[
"in: vocabs.loader.test.a v-l-t-a-hello"
"IN: vocabs.loader.test.a v-l-t-a-hello"
<string-reader>
"resource:core/vocabs/loader/test/a/a.factor"
parse-stream
@ -136,7 +136,7 @@ IN: vocabs.loader.tests
forget-junk
{ { } } [
"in: xabbabbja" eval( -- ) "xabbabbja" vocab-files
"IN: xabbabbja" eval( -- ) "xabbabbja" vocab-files
] unit-test
[ "xabbabbja" forget-vocab ] with-compilation-unit

View File

@ -2,10 +2,10 @@ USING: effects eval math tools.test ;
IN: words.alias.tests
ALIAS: foo + ;
{ } [ "in: words.alias.tests CONSTANT: foo 5" eval( -- ) ] unit-test
{ } [ "IN: words.alias.tests CONSTANT: foo 5" eval( -- ) ] unit-test
{ ( -- value ) } [ \ foo stack-effect ] unit-test
ALIAS: \ MY-H{ \ H{ ;
{ H{ { 1 2 } } } [
"in: words.alias.tests MY-H{ { 1 2 } }" eval( -- x )
"IN: words.alias.tests MY-H{ { 1 2 } }" eval( -- x )
] unit-test

View File

@ -51,7 +51,7 @@ SYMBOL: a-symbol
! See if redefining a generic as a colon def clears some
! word props.
GENERIC: testing ( a -- b ) ;
"in: words.tests : testing ( -- ) ;" eval( -- )
"IN: words.tests : testing ( -- ) ;" eval( -- )
{ f } [ \ testing generic? ] unit-test
@ -67,45 +67,45 @@ forget: another-forgotten
DEFER: deferred
[ deferred ] [ T{ undefined-word f deferred } = ] must-fail-with
[ "in: words.tests defer: not-compiled COMPILE< not-compiled COMPILE>" eval( -- ) ]
[ "IN: words.tests defer: not-compiled COMPILE< not-compiled COMPILE>" eval( -- ) ]
[ error>> [ undefined-word? ] [ word>> name>> "not-compiled" = ] bi and ] must-fail-with
{ } [ "in: words.tests forget: not-compiled" eval( -- ) ] unit-test
{ } [ "IN: words.tests forget: not-compiled" eval( -- ) ] unit-test
{ } [ [ "no-loc" "words.tests" create-word drop ] with-compilation-unit ] unit-test
{ f } [ "no-loc" "words.tests" lookup-word where ] unit-test
{ } [ "in: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
{ } [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
{ f } [ "no-loc-2" "words.tests" lookup-word where ] unit-test
{ } [ "in: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
{ } [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
{ "test-last" } [ last-word name>> ] unit-test
"undef-test" "words.tests" lookup-word [
[ forget ] with-compilation-unit
] when*
[ "in: words.tests : undef-test ( -- ) ; COMPILE< undef-test COMPILE>" eval( -- ) ]
[ "IN: words.tests : undef-test ( -- ) ; COMPILE< undef-test COMPILE>" eval( -- ) ]
[ error>> undefined-word? ] must-fail-with
{ } [
"in: words.tests GENERIC: symbol-generic ( x -- x ) ;" eval( -- )
"IN: words.tests GENERIC: symbol-generic ( x -- x ) ;" eval( -- )
] unit-test
{ } [
"in: words.tests symbol: symbol-generic" eval( -- )
"IN: words.tests symbol: symbol-generic" eval( -- )
] 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>
"IN: words.tests GENERIC: symbol-generic ( a -- b ) ;" <string-reader>
"symbol-generic-test" parse-stream drop
] unit-test
{ } [
"in: words.tests TUPLE: symbol-generic ;" <string-reader>
"IN: words.tests TUPLE: symbol-generic ;" <string-reader>
"symbol-generic-test" parse-stream drop
] unit-test
@ -113,14 +113,14 @@ DEFER: deferred
{ f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
! Regressions
{ } [ "in: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
{ } [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
{ t } [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
{ } [ "in: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
{ } [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] 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
{ } [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval( -- ) ] unit-test
{ t } [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
{ } [ "in: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
{ } [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
{ f } [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
{ { } }

View File

@ -68,7 +68,7 @@ CONSTANT: galois-slides
{ $code "GENERIC: area ( shape -- n ) ;" }
"Two methods:"
{ $code
"use: math.constants"
"USE: math.constants"
""
"M: rectangle area"
" [ width>> ] [ height>> ] bi * ;"
@ -132,7 +132,7 @@ CONSTANT: galois-slides
{ $vocab-link "regexp" }
"Pre-compiles regexp at parse time"
"Implemented with library code"
{ $code "use: regexp" }
{ $code "USE: regexp" }
{ $code "\"ababbc\" \"[ab]+c\" <regexp> matches? ." }
{ $code "\"ababbc\" R[[ [ab]+c]] matches? ." }
}

View File

@ -28,7 +28,7 @@ CONSTANT: google-slides
}
{ $slide "Example: factorial"
"Lame example, but..."
{ $code "use: math.ranges" ": factorial ( n -- n! )" " 1 [a,b] product ;" }
{ $code "USE: math.ranges" ": factorial ( n -- n! )" " 1 [a,b] product ;" }
{ $code "100 factorial ." }
}
{ $slide "Example: sending an e-mail"
@ -114,7 +114,7 @@ CONSTANT: google-slides
{ $code "GENERIC: area ( shape -- n ) ;" }
"Two methods:"
{ $code
"use: math.constants"
"USE: math.constants"
""
"M: rectangle area"
" [ width>> ] [ height>> ] bi * ;"
@ -246,12 +246,12 @@ CONSTANT: google-slides
}
{ $slide "Unicode strings"
"Unicode-aware case conversion, char classes, collation, word breaks, and so on..."
{ $code "use: unicode" "\"ß\" >upper ." }
{ $code "USE: unicode" "\"ß\" >upper ." }
}
{ $slide "Unicode strings"
"All external byte I/O is encoded/decoded"
"ASCII, UTF8, UTF16, EBCDIC..."
{ $code "use: io.encodings.utf8" "\"document.txt\" utf8" "[ readln ] with-file-reader" }
{ $code "USE: io.encodings.utf8" "\"document.txt\" utf8" "[ readln ] with-file-reader" }
{ "Binary I/O is supported as well with the " { $link binary } " encoding" }
}
{ $slide "Associative mappings"
@ -349,7 +349,7 @@ CONSTANT: google-slides
}
{ $slide "Example: file system monitors"
{ $code
"use: io.monitors"
"USE: io.monitors"
""
": forever ( quot -- ) '[ @ t ] loop ; inline"
""

View File

@ -80,7 +80,7 @@ CONSTANT: minneapolis-slides
STRIP-TEASE:
$slide "An example"
{ $code
"use: math.constants"
"USE: math.constants"
"GENERIC: area ( shape -- meters^2 ) ;"
"M: square area square-dimension sq ;"
"M: circle area circle-radius sq pi * ;"
@ -117,7 +117,7 @@ CONSTANT: minneapolis-slides
}
{ $slide "Memoization"
{ $code
"use: memoize"
"USE: memoize"
""
"MEMO: fib ( x -- y )"
" dup 1 > ["

View File

@ -64,7 +64,7 @@ CONSTANT: vpri-slides
{ $code "GENERIC: area ( shape -- n ) ;" }
"Two methods:"
{ $code
"use: math.constants"
"USE: math.constants"
""
"M: rectangle area"
" [ width>> ] [ height>> ] bi * ;"

View File

@ -26,7 +26,7 @@ HELP: findall
{ $description "Finds all matches of the given regexp in the string. Matches is sequence of associative array where the key is the name of the capturing group, or f to denote the full match." }
{ $examples
{ $code
"use: pcre"
"USE: pcre"
"\"foobar\" \"(?<ch1>\\\\w)(?<ch2>\\\\w)\" findall ."
"{"
" { { f \"fo\" } { \"ch1\" \"f\" } { \"ch2\" \"o\" } }"

View File

@ -24,7 +24,7 @@ HELP: command-name
{ $examples
{ $example
"USING: io ui.commands ;"
"in: scratchpad"
"IN: scratchpad"
": com-my-command ( -- ) ;"
"\\ com-my-command command-name write"
"My Command"

View File

@ -13,7 +13,7 @@ ARTICLE: "starting-ui-tools" "Starting the UI tools"
{ "On Mac OS X, the tools start if the " { $snippet "Factor.app" } " application bundle is run." }
}
"In all cases, passing the " { $snippet "-run=listener" } " command line switch starts the terminal listener instead. The UI can be started from the terminal by issuing the following command:"
{ $code "use: threads" "[ \"ui.tools\" run ] in-thread" } ;
{ $code "USE: threads" "[ \"ui.tools\" run ] in-thread" } ;
ARTICLE: "ui-shortcuts" "UI tool keyboard shortcuts"
"Every UI tool has its own set of keyboard shortcuts. Mouse-over a toolbar button to see its shortcut, if any, in the status bar, or press " { $snippet "F1" } " to see a list of all shortcuts supported by the tool."

View File

@ -5,7 +5,7 @@ HELP: 24-game
{ $description "Starts the game!" }
{ $examples
{ $unchecked-example
"use: 24-game"
"USE: 24-game"
"24-game"
"{ 8 2 1 2 }\n"
"Commands: { + - * / rot swap q }\n"

View File

@ -9,7 +9,7 @@ HELP: \ BE-PACKED-STRUCT:
{ $unchecked-example
"! When run on a big-endian platform, this struct should prettyprint the same as defined"
"! The output of this example is from a little-endian platform"
"use: alien.endian"
"USE: alien.endian"
"BE-PACKED-STRUCT: s1 { a char[7] } { b int } ;"
"\\ s1 see"
"USING: alien.c-types alien.endian classes.struct ;
@ -22,7 +22,7 @@ HELP: \ BE-STRUCT:
{ $unchecked-example
"! When run on a big-endian platform, this struct should prettyprint the same as defined"
"! The output of this example is from a little-endian platform"
"use: alien.endian"
"USE: alien.endian"
"BE-STRUCT: s1 { a int } { b le32 } ;"
"\\ s1 see"
"USING: alien.c-types alien.endian classes.struct ;
@ -35,7 +35,7 @@ HELP: \ LE-PACKED-STRUCT:
{ $unchecked-example
"! When run on a little-endian platform, this struct should prettyprint the same as defined"
"! The output of this example is from a little-endian platform"
"use: alien.endian"
"USE: alien.endian"
"LE-PACKED-STRUCT: s1 { a char[7] } { b int } ;"
"\\ s1 see"
"USING: alien.c-types alien.endian classes.struct ;
@ -48,7 +48,7 @@ HELP: \ LE-STRUCT:
{ $unchecked-example
"! When run on a little-endian platform, this struct should prettyprint the same as defined"
"! The output of this example is from a little-endian platform"
"use: alien.endian"
"USE: alien.endian"
"LE-STRUCT: s1 { a int } { b be32 } ;"
"\\ s1 see"
"USING: alien.c-types alien.endian classes.struct ;

View File

@ -109,7 +109,7 @@ TYPEDEF: int alien-parser-test-int ; ! reasonably unique name...
{ "OK!" } [
[
"use: specialized-arrays specialized-array: alien-parser-test-int" eval( -- )
"USE: specialized-arrays specialized-array: alien-parser-test-int" eval( -- )
! after restart, we end up here
"OK!"
] [ :1 ] recover

View File

@ -9,7 +9,7 @@ HELP: change:
"Change a tuple slot:"
{ $example
"USING: prettyprint changer kernel math ;"
"in: changer"
"IN: changer"
"TUPLE: nightclub count ;"
"T{ nightclub f 0 } [ 3 + ] change: count ."
"T{ nightclub { count 3 } }"

View File

@ -332,7 +332,7 @@ STRUCT: struct-that's-a-word { x int } ;
! Interactive parsing of struct slot definitions
[
"use: classes.struct IN: classes.struct.tests STRUCT: unexpected-eof-test" <string-reader>
"USE: classes.struct IN: classes.struct.tests STRUCT: unexpected-eof-test" <string-reader>
"struct-class-test-1" parse-stream
] [ error>> error>> unexpected-eof? ] must-fail-with
@ -346,7 +346,7 @@ STRUCT: struct-that's-a-word { x int } ;
! S{ with non-struct type
[
"use: classes.struct IN: classes.struct.tests TUPLE: not-a-struct ; S{ not-a-struct }"
"USE: classes.struct IN: classes.struct.tests TUPLE: not-a-struct ; S{ not-a-struct }"
eval( -- value )
] [ error>> no-method? ] must-fail-with

View File

@ -8,7 +8,7 @@ IN: compiler.tests.redefine0
[ test-2 ] [ not-compiled? ] must-fail-with
[ ] [ "in: compiler.tests.redefine0 : test-1 ( -- ) ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine0 : test-1 ( -- ) ;" eval( -- ) ] unit-test
{ 0 0 } [ test-1 ] must-infer-as
@ -26,7 +26,7 @@ IN: compiler.tests.redefine0
[ ] [ test-4 ] unit-test
[ ] [ "in: compiler.tests.redefine0 use: kernel : test-3 ( a -- ) call ; inline" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine0 USE: kernel : test-3 ( a -- ) call ; inline" eval( -- ) ] unit-test
[ test-4 ] [ not-compiled? ] must-fail-with
@ -42,7 +42,7 @@ IN: compiler.tests.redefine0
[ 31337 ] [ 31337 test-6 ] unit-test
[ ] [ "in: compiler.tests.redefine0 USING: macros kernel ; MACRO: test-5 ( a -- quot ) drop [ ] ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine0 USING: macros kernel ; MACRO: test-5 ( a -- quot ) drop [ ] ;" eval( -- ) ] unit-test
[ 31337 test-6 ] [ not-compiled? ] must-fail-with
@ -62,7 +62,7 @@ M: integer test-7 + ;
[ 1 test-7 ] [ not-compiled? ] must-fail-with
[ 1 test-8 ] [ not-compiled? ] must-fail-with
[ ] [ "in: compiler.tests.redefine0 USING: macros math kernel ; GENERIC: test-7 ( x y -- z ) ; : test-8 ( a b -- c ) 255 bitand test-7 ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine0 USING: macros math kernel ; GENERIC: test-7 ( x y -- z ) ; : test-8 ( a b -- c ) 255 bitand test-7 ;" eval( -- ) ] unit-test
[ 4 ] [ 1 3 test-7 ] unit-test
[ 4 ] [ 1 259 test-8 ] unit-test
@ -83,15 +83,15 @@ MACRO: test-10 ( -- quot ) quot get ; COMPILE>
[ ] [ test-11 ] unit-test
[ ] [ "in: compiler.tests.redefine0 : test-9 ( -- ) 1 ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- ) 1 ;" eval( -- ) ] unit-test
! test-11 should get recompiled now
[ test-11 ] [ not-compiled? ] must-fail-with
[ ] [ "in: compiler.tests.redefine0 : test-9 ( -- a ) 1 ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- a ) 1 ;" eval( -- ) ] unit-test
[ ] [ "in: compiler.tests.redefine0 : test-9 ( -- ) ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- ) ;" eval( -- ) ] unit-test
[ ] [ test-11 ] unit-test

View File

@ -11,7 +11,7 @@ M: integer method-redefine-generic-1 3 + ;
[ 6 ] [ method-redefine-test-1 ] unit-test
[ ] [ "in: compiler.tests.redefine1 use: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine1 USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
[ 7 ] [ method-redefine-test-1 ] unit-test
@ -27,7 +27,7 @@ M: integer method-redefine-generic-2 3 + ;
[ 6 ] [ method-redefine-test-2 ] unit-test
[ ] [ "in: compiler.tests.redefine1 use: kernel use: math M: fixnum method-redefine-generic-2 4 + ; use: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine1 USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
[ 7 ] [ method-redefine-test-2 ] unit-test

View File

@ -15,6 +15,6 @@ M: object g drop t ;
TUPLE: jeah ;
[ ] [ "use: kernel in: compiler.tests.redefine12 M: jeah g drop f ;" eval( -- ) ] unit-test
[ ] [ "USE: kernel in: compiler.tests.redefine12 M: jeah g drop f ;" eval( -- ) ] unit-test
[ f ] [ T{ jeah } h ] unit-test

View File

@ -11,4 +11,4 @@ M: fixnum breakage-caller 2 breakage-macro ;
: breakage ( -- obj ) 2 breakage-caller ;
! [ ] [ "in: compiler.tests.redefine13 : breakage-word ( a b -- c ) ;" eval ] unit-test
! [ ] [ "IN: compiler.tests.redefine13 : breakage-word ( a b -- c ) ;" eval ] unit-test

View File

@ -4,8 +4,8 @@ IN: compiler.tests.redefine16
[ ] [ [ "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
[ ] [ "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-word forget ] with-compilation-unit ] unit-test

View File

@ -7,6 +7,6 @@ IN: compiler.tests.redefine4
[ "" ] [ [ declaration-test ] with-string-writer ] unit-test
[ ] [ "in: compiler.tests.redefine4 use: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine4 USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
[ "X" ] [ [ declaration-test ] with-string-writer ] unit-test

View File

@ -8,7 +8,7 @@ IN: compiler.tests.redefine5
[ ] [
"USING: sorting kernel math.order ;
in: compiler.tests.redefine5
IN: compiler.tests.redefine5
GENERIC: my-generic ( a -- b ) ;
M: object my-generic [ <=> ] sort ;
: my-inline ( a -- b ) my-generic ;"
@ -16,8 +16,8 @@ IN: compiler.tests.redefine5
] unit-test
[ ] [
"use: kernel
in: compiler.tests.redefine5
"USE: kernel
IN: compiler.tests.redefine5
TUPLE: my-tuple ;
M: my-tuple my-generic drop 0 ;" eval( -- )
] unit-test

View File

@ -8,16 +8,16 @@ IN: compiler.tests.redefine7
[ ] [
"USING: kernel math ;
in: compiler.tests.redefine7
mixin: my-mixin
IN: compiler.tests.redefine7
MIXIN: my-mixin
INSTANCE: fixnum my-mixin ;
: my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;"
eval( -- )
] unit-test
[ ] [
"use: math
in: compiler.tests.redefine7
"USE: math
IN: compiler.tests.redefine7
INSTANCE: float my-mixin ;"
eval( -- )
] unit-test

View File

@ -8,8 +8,8 @@ IN: compiler.tests.redefine8
[ ] [
"USING: kernel math math.order sorting ;
in: compiler.tests.redefine8
mixin: my-mixin
IN: compiler.tests.redefine8
MIXIN: my-mixin
INSTANCE: fixnum my-mixin ;
GENERIC: my-generic ( a -- b ) ;
! We add the bogus quotation here to hinder inlining
@ -19,8 +19,8 @@ IN: compiler.tests.redefine8
] unit-test
[ ] [
"use: math
in: compiler.tests.redefine8
"USE: math
IN: compiler.tests.redefine8
INSTANCE: float my-mixin ;"
eval( -- )
] unit-test

View File

@ -8,8 +8,8 @@ IN: compiler.tests.redefine9
[ ] [
"USING: kernel math math.order sorting ;
in: compiler.tests.redefine9
mixin: my-mixin
IN: compiler.tests.redefine9
MIXIN: my-mixin
INSTANCE: fixnum my-mixin ;
GENERIC: my-generic ( a -- b ) ;
! We add the bogus quotation here to hinder inlining
@ -19,8 +19,8 @@ IN: compiler.tests.redefine9
] unit-test
[ ] [
"use: math
in: compiler.tests.redefine9
"USE: math
IN: compiler.tests.redefine9
TUPLE: my-tuple ;
INSTANCE: my-tuple my-mixin ;"
eval( -- )

View File

@ -132,7 +132,7 @@ TUPLE: a-tuple x ;
{ t } [ test-quotatation cached-effect ( a -- b ) effect<= ] unit-test
{ } [ "in: compiler.tree.propagation.call-effect.tests use: math : call(-redefine-test ( a b -- c ) + ;" eval( -- ) ] unit-test
{ } [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a b -- c ) + ;" eval( -- ) ] unit-test
{ t } [ test-quotatation cached-effect ( a b -- c ) effect<= ] unit-test
@ -140,7 +140,7 @@ TUPLE: a-tuple x ;
{ 4 } [ 1 3 test-quotatation inline-cache-invalidation-test ] unit-test
{ } [ "in: compiler.tree.propagation.call-effect.tests use: math : call(-redefine-test ( a -- c ) 1 + ;" eval( -- ) ] unit-test
{ } [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a -- c ) 1 + ;" eval( -- ) ] unit-test
[ 1 3 test-quotatation inline-cache-invalidation-test ] [ T{ wrong-values f [ call(-redefine-test ] ( a b -- c ) } = ] must-fail-with
@ -153,6 +153,6 @@ TUPLE: my-tuple a b c ;
{ T{ my-tuple f 1 2 3 } } [ 1 2 3 my-quot my-word ] unit-test
{ } [ "in: compiler.tree.propagation.call-effect.tests TUPLE: my-tuple a b ;" eval( -- ) ] unit-test
{ } [ "IN: compiler.tree.propagation.call-effect.tests TUPLE: my-tuple a b ;" eval( -- ) ] unit-test
[ 1 2 3 my-quot my-word ] [ wrong-values? ] must-fail-with

View File

@ -68,7 +68,7 @@ COMPILE>
{ 18 } [ "Phil" 11 11 <b-monster> stop>> ] unit-test
[
"use: constructors
"USE: constructors
IN: constructors.tests
TUPLE: foo a b ;
CONSTRUCTOR: <foo> foo ( a a -- obj )" eval( -- )
@ -77,7 +77,7 @@ CONSTRUCTOR: <foo> foo ( a a -- obj )" eval( -- )
] must-fail-with
[
"use: constructors
"USE: constructors
IN: constructors.tests
TUPLE: foo a b ;
CONSTRUCTOR: <foo> foo ( a c -- obj )" eval( -- )

View File

@ -1,6 +1,6 @@
USING: eval tools.test ;
IN: eval.tests
{ 4 } [ "use: math 2 2 +" eval( -- result ) ] unit-test
[ "use: math 2 2 +" eval( -- ) ] must-fail
{ 4 } [ "USE: math 2 2 +" eval( -- result ) ] unit-test
[ "USE: math 2 2 +" eval( -- ) ] must-fail
{ "4\n" } [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-test

View File

@ -105,13 +105,13 @@ COMPILE>
! Does replacing an ordinary word with a functor-generated one work?
[ [ ] ] [
"in: functors.tests
"IN: functors.tests
TUPLE: some-tuple ;
: some-word ( -- ) ;
GENERIC: some-generic ( a -- b ) ;
M: some-tuple some-generic ;
symbol: some-symbol" <string-reader> "functors-test" parse-stream
SYMBOL: some-symbol" <string-reader> "functors-test" parse-stream
] unit-test
: test-redefinition ( -- )
@ -144,7 +144,7 @@ SYMBOL: W-symbol
FUNCTOR>
[ [ ] ] [
"in: functors.tests
"IN: functors.tests
COMPILE< \"some\" redefine-test COMPILE>" <string-reader> "functors-test" parse-stream
] unit-test

View File

@ -36,7 +36,7 @@ HELP: file-system-info
{ $examples
{ $unchecked-example
"USING: io.files.info io.pathnames math prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
""
": gb ( m -- n ) 30 2^ * ;"
""

View File

@ -91,7 +91,7 @@ SYMBOLS: out-path err-path ;
out-path get-global ascii file-lines first
] unit-test
[ "in: scratchpad " ] [
[ "IN: scratchpad " ] [
<process>
console-vm-path "-run=listener" 2array >>command
+closed+ >>stdin
@ -224,14 +224,14 @@ SYMBOLS: out-path err-path ;
out-path get-global utf8 file-contents
] unit-test
[ "in: scratchpad " ] [
[ "IN: scratchpad " ] [
console-vm-path "-run=listener" 2array
ascii [ "use: system 0 exit" print flush lines last ] with-process-stream
ascii [ "USE: system 0 exit" print flush lines last ] with-process-stream
] unit-test
[ ] [
console-vm-path "-run=listener" 2array
ascii [ "use: system 0 exit" print ] with-process-writer
ascii [ "USE: system 0 exit" print ] with-process-writer
] unit-test
[ ] [

View File

@ -111,7 +111,7 @@ $nl
$nl
"An example which watches a directory for changes:"
{ $code
"use: io.monitors"
"USE: io.monitors"
""
": watch-loop ( monitor -- )"
" dup next-change path>> print flush watch-loop ;"

View File

@ -10,7 +10,7 @@ HELP: $
{ $examples
{ $example
"USING: kernel literals prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
""
"CONSTANT: five 5"
"{ $ five } ."
@ -18,7 +18,7 @@ HELP: $
}
{ $example
"USING: kernel literals prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
""
": seven-eleven ( -- a b ) 7 11 ;"
"{ $ seven-eleven } ."
@ -33,7 +33,7 @@ HELP: \ $[
{ $examples
{ $example
"USING: kernel literals math prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
""
"<< CONSTANT: five 5 >>"
"{ $[ five dup 1 + dup 2 + ] } ."
@ -48,7 +48,7 @@ HELP: \ ${
{ $examples
{ $example
"USING: kernel literals math prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
""
"CONSTANT: five 5"
"CONSTANT: six 6"
@ -65,7 +65,7 @@ HELP: \ flags{
{ $examples
{ $example
"USING: literals kernel prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
"CONSTANT: x 0x1"
"flags{ 0x20 x 0b100 } .h"
"0x25"
@ -77,7 +77,7 @@ ARTICLE: "literals" "Interpolating code results into literal values"
"The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values."
{ $example
"USING: kernel literals math prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
""
"<< CONSTANT: five 5 >>"
"{ $ five $[ five dup 1 + dup 2 + ] } ."

View File

@ -9,7 +9,7 @@ HELP: match
}
{ $description "Pattern match " { $snippet "value1" } " against " { $snippet "value2" } ". These values can be any Factor value, including sequences and tuples. The values can contain pattern variables, which are symbols that begin with '?'. The result is a hashtable of the bindings, mapping the pattern variables from one sequence to the equivalent value in the other sequence. The " { $link _ } " symbol can be used to ignore the value at that point in the pattern for the match. " }
{ $examples
{ $unchecked-example "use: match" "MATCH-VARS: ?a ?b ;\n{ ?a { 2 ?b } 5 } { 1 { 2 3 } _ } match ." "H{ { ?a 1 } { ?b 3 } }" }
{ $unchecked-example "USE: match" "MATCH-VARS: ?a ?b ;\n{ ?a { 2 ?b } 5 } { 1 { 2 3 } _ } match ." "H{ { ?a 1 } { ?b 3 } }" }
}
{ $see-also match-cond postpone\ MATCH-VARS: replace-patterns match-replace } ;
@ -19,7 +19,7 @@ HELP: match-cond
{ $errors "Throws a " { $link no-match-cond } " error if none of the test quotations yield a true value." }
{ $examples
{ $code
"use: match" "MATCH-VARS: ?value ;\n{ increment 346126 } {\n { { increment ?value } [ ?value do-something ] }\n { { decrement ?value } [ ?value do-something-else ] }\n { _ [ no-match-found ] }\n} match-cond" }
"USE: match" "MATCH-VARS: ?value ;\n{ increment 346126 } {\n { { increment ?value } [ ?value do-something ] }\n { { decrement ?value } [ ?value do-something-else ] }\n { _ [ no-match-found ] }\n} match-cond" }
}
{ $see-also match postpone\ MATCH-VARS: replace-patterns match-replace } ;
@ -28,7 +28,7 @@ HELP: \ MATCH-VARS:
{ $values { "var" "a match variable name beginning with '?'" } }
{ $description "Creates a symbol that can be used in " { $link match } " and " { $link match-cond } " for binding values in the matched sequence. The symbol name is created as a word that is defined to get the value of the symbol out of the current namespace. This can be used in " { $link match-cond } " to retrive the values in the quotation body." }
{ $examples
{ $code "use: match" "MATCH-VARS: ?value ;\n{ increment 346126 } {\n { { increment ?value } [ ?value do-something ] }\n { { decrement ?value } [ ?value do-something-else ] }\n { _ [ no-match-found ] }\n} match-cond" }
{ $code "USE: match" "MATCH-VARS: ?value ;\n{ increment 346126 } {\n { { increment ?value } [ ?value do-something ] }\n { { decrement ?value } [ ?value do-something-else ] }\n { _ [ no-match-found ] }\n} match-cond" }
}
{ $see-also match match-cond replace-patterns match-replace } ;
@ -43,7 +43,7 @@ HELP: match-replace
{ $examples
{ $example
"USING: match prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
"MATCH-VARS: ?a ?b ;"
"{ 1 2 } { ?a ?b } { ?b ?a } match-replace ."
"{ 2 1 }"

View File

@ -28,7 +28,7 @@ HELP: <mirror>
{ $examples
{ $example
"USING: assocs mirrors prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
"TUPLE: circle center radius ;"
"C: <circle> circle"
"{ 100 50 } 15 <circle> <mirror> >alist ."

View File

@ -56,7 +56,7 @@ TUPLE: color
! Test reshaping with a mirror
1 2 3 color boa <mirror> "mirror" set
{ } [ "in: mirrors.tests use: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval( -- ) ] unit-test
{ } [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval( -- ) ] unit-test
{ 1 } [ "red" "mirror" get at ] unit-test

View File

@ -393,7 +393,7 @@ $nl
{ $example
"USING: prettyprint peg peg.ebnf kernel math.parser strings"
"accessors math arrays ;"
"in: scratchpad"
"IN: scratchpad"
""
"TUPLE: ast-number value ;"
"TUPLE: ast-string value ;"

View File

@ -579,9 +579,9 @@ Tok = Spaces (Number | Special )
"\\" EBNF{{ foo="\\" }}
] unit-test
[ "use: peg.ebnf EBNF{{ }}" eval( -- ) ] must-fail
[ "USE: peg.ebnf EBNF{{ }}" eval( -- ) ] must-fail
[ "use: peg.ebnf EBNF{{
[ "USE: peg.ebnf EBNF{{
lol = a
lol = b
}}" eval( -- )

View File

@ -10,7 +10,7 @@ HELP: tree-write
"Write the object to the standard output stream, unless "
"it is an array, in which case recurse through the array "
"writing each object to the stream." }
{ $example "use: peg.search" "{ 65 \"bc\" { 68 \"ef\" } } tree-write" "AbcDef" } ;
{ $example "USE: peg.search" "{ 65 \"bc\" { 68 \"ef\" } } tree-write" "AbcDef" } ;
HELP: search
{ $values

View File

@ -16,5 +16,5 @@ HELP: \ LAZY:
{ $values { "word" "a new word to define" } { "definition" "a word definition" } }
{ $description "Creates a lazy word in the current vocabulary. When executed the word will return a " { $link promise } " that when forced, executes the word definition. Any values on the stack that are required by the word definition are captured along with the promise." }
{ $examples
{ $example "USING: arrays sequences prettyprint promises ;" "in: scratchpad" "LAZY: zeroes ( -- pair ) 0 zeroes 2array ;" "zeroes force second force first ." "0" }
{ $example "USING: arrays sequences prettyprint promises ;" "IN: scratchpad" "LAZY: zeroes ( -- pair ) 0 zeroes 2array ;" "zeroes force second force first ." "0" }
} ;

View File

@ -16,8 +16,8 @@ HELP: see
{ $contract "Prettyprints a definition." }
{ $examples
"A word:" { $code "\\ append see" }
"A method:" { $code "use: arrays" "M\\ array length see" }
"A help article:" { $code "use: help.topics" "\"help\" >link see" }
"A method:" { $code "USE: arrays" "M\\ array length see" }
"A help article:" { $code "USE: help.topics" "\"help\" >link see" }
} ;
HELP: see-methods
@ -29,12 +29,12 @@ HELP: definer
{ $contract "Outputs the parsing words which delimit the definition." }
{ $examples
{ $example "USING: definitions prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
": foo ( -- ) ; \\ foo definer . ."
";\npostpone\ :"
}
{ $example "USING: definitions prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
"symbol: foo \\ foo definer . ."
"f\npostpone\ symbol:"
}

View File

@ -4,18 +4,18 @@ IN: see.tests
CONSTANT: test-const 10 ;
{ "in: see.tests\nCONSTANT: test-const 10 inline\n" }
{ "IN: see.tests\nCONSTANT: test-const 10 inline\n" }
[ [ \ test-const see ] with-string-writer ] unit-test
{ "in: sequences\nERROR: non-negative-integer-expected n ;\n" }
{ "IN: sequences\nERROR: non-negative-integer-expected n ;\n" }
[ [ \ non-negative-integer-expected see ] with-string-writer ] unit-test
ALIAS: test-alias + ;
{ "USING: math ;\nin: see.tests\nALIAS: test-alias + inline\n" }
{ "USING: math ;\nIN: see.tests\nALIAS: test-alias + inline\n" }
[ [ \ test-alias see ] with-string-writer ] unit-test
{ "in: see.tests ALIAS: test-alias ( x y -- z )" }
{ "IN: see.tests ALIAS: test-alias ( x y -- z )" }
[ \ test-alias summary ] unit-test
{ } [ gensym see ] unit-test

View File

@ -6,7 +6,7 @@ IN: slots.syntax
HELP: \ slots[
{ $description "Outputs several slot values to the stack." }
{ $example "USING: kernel prettyprint slots.syntax ;"
"in: slots.syntax.example"
"IN: slots.syntax.example"
"TUPLE: rectangle width height ;"
"T{ rectangle { width 3 } { height 5 } } slots[ width height ] [ . ] bi@"
"3
@ -16,7 +16,7 @@ HELP: \ slots[
HELP: \ slots{
{ $description "Outputs an array of slot values from a tuple." }
{ $example "USING: prettyprint slots.syntax ;"
"in: slots.syntax.example"
"IN: slots.syntax.example"
"TUPLE: rectangle width height ;"
"T{ rectangle { width 3 } { height 5 } } slots{ width height } ."
"{ 3 5 }"
@ -25,7 +25,7 @@ HELP: \ slots{
HELP: \ set-slots{
{ $description "Sets slot values in a tuple from an array." }
{ $example "USING: prettyprint slots.syntax kernel ;"
"in: slots.syntax.example"
"IN: slots.syntax.example"
"TUPLE: rectangle width height ;"
"rectangle new { 3 5 } set-slots{ width height } ."
"T{ rectangle { width 3 } { height 5 } }"
@ -34,7 +34,7 @@ HELP: \ set-slots{
HELP: \ set-slots[
{ $description "Sets slot values in a tuple from the stack." }
{ $example "USING: prettyprint slots.syntax kernel ;"
"in: slots.syntax.example"
"IN: slots.syntax.example"
"TUPLE: rectangle width height ;"
"rectangle new 3 5 set-slots[ width height ] ."
"T{ rectangle { width 3 } { height 5 } }"
@ -43,7 +43,7 @@ HELP: \ set-slots[
HELP: \ copy-slots{
{ $description "Copy slots from the first object to the second and return the second object." }
{ $example "USING: prettyprint slots.syntax kernel ;"
"in: slots.syntax.example"
"IN: slots.syntax.example"
"TUPLE: thing1 a b ;"
"TUPLE: thing2 a b c ;"
"1 2 thing1 boa 11 22 33 thing2 boa copy-slots{ a b } ."

View File

@ -18,8 +18,8 @@ $nl
{ $subsections postpone\ TUPLE-ARRAY: }
"An example:"
{ $example
"use: tuple-arrays"
"in: scratchpad"
"USE: tuple-arrays"
"IN: scratchpad"
"TUPLE: point x y ; final"
"TUPLE-ARRAY: point"
"{ T{ point f 1 2 } T{ point f 1 3 } T{ point f 2 3 } } >point-array first short."

View File

@ -32,14 +32,14 @@ tuple-array: broken
{ 100 } [ 100 <broken-array> length ] unit-test
! Can't define a tuple array for a non-tuple class
[ "in: tuple-arrays.tests USING: tuple-arrays words ; TUPLE-ARRAY: word" eval( -- ) ]
[ "IN: tuple-arrays.tests USING: tuple-arrays words ; TUPLE-ARRAY: word" eval( -- ) ]
[ error>> not-a-tuple? ]
must-fail-with
! Can't define a tuple array for a non-final class
TUPLE: non-final x ;
[ "in: tuple-arrays.tests use: tuple-arrays TUPLE-ARRAY: non-final" eval( -- ) ]
[ "IN: tuple-arrays.tests USE: tuple-arrays TUPLE-ARRAY: non-final" eval( -- ) ]
[ error>> not-final? ]
must-fail-with
@ -62,7 +62,7 @@ tuple-array: tuple-to-struct
! This shouldn't crash
{ } [
"in: tuple-arrays.tests
"IN: tuple-arrays.tests
USING: alien.c-types classes.struct ;
STRUCT: tuple-to-struct { x int } ;"
eval( -- )

View File

@ -56,7 +56,7 @@ ARTICLE: "concurrency-synchronous-sends" "Synchronous sends"
"An example:"
{ $example
"USING: concurrency.messaging threads ;"
"in: scratchpad"
"IN: scratchpad"
": pong-server ( -- )"
" receive [ \"pong\" ] dip reply-synchronous ;"
"[ pong-server t ] \"pong-server\" spawn-server"

View File

@ -6,7 +6,7 @@ ARTICLE: "editor" "Editor integration"
"Factor development is best done with one of the supported editors; this allows you to quickly jump to definitions from the Factor environment."
{ $subsections edit }
"Depending on the editor you are using, you must load one of the child vocabularies of the " { $vocab-link "editors" } " vocabulary, for example " { $vocab-link "editors.emacs" } ":"
{ $code "use: editors.emacs" }
{ $code "USE: editors.emacs" }
"If you intend to always use the same editor, it helps to have it load during stage 2 bootstrap. Place the code to load and possibly configure it in the " { $link ".factor-boot-rc" } "."
$nl
"Editor integration vocabularies store a class or tuple in a global variable when loaded:"

View File

@ -5,7 +5,7 @@ ARTICLE: "editors.emacs" "Integration with Emacs"
"Basic Emacs integration with Factor requires the use of two executable files -- " { $snippet "emacs" } " and " { $snippet "emacsclient" } ", which act as a client/server pair. To start the server, run the " { $snippet "emacs" } " binary and execute " { $snippet "M-x server-start" } " or start " { $snippet "emacs" } " with the following line in your " { $snippet ".emacs" } " file:"
{ $code "(server-start)" }
"On Windows, if you install Emacs to " { $snippet "Program Files" } " or " { $snippet "Program Files (x86)" } ", Factor will automatically detect the path to " { $snippet "emacsclient.exe" } ". On Unix systems, make sure that " { $snippet "emacsclient" } " is in your path. To set the path manually, use the following snippet:"
{ $code "use: editors.emacs"
{ $code "USE: editors.emacs"
"\"/my/crazy/bin/emacsclient\" emacsclient-path set-global"
}
@ -13,7 +13,7 @@ ARTICLE: "editors.emacs" "Integration with Emacs"
{ $code "(setq server-window 'switch-to-buffer-other-frame)" }
"To quickly scaffold a " { $snippet ".emacs" } " file, run the following code:"
{ $code "use: tools.scaffold"
{ $code "USE: tools.scaffold"
"scaffold-emacs"
}

View File

@ -41,11 +41,11 @@ IN: fjsc.tests
] unit-test
{ T{ ast-expression f V{ T{ ast-use f "foo" } } } } [
"use: foo" statement-parser parse
"USE: foo" statement-parser parse
] unit-test
{ T{ ast-expression f V{ T{ ast-in f "foo" } } } } [
"in: foo" statement-parser parse
"IN: foo" statement-parser parse
] unit-test
{ T{ ast-expression f V{ T{ ast-using f V{ "foo" "bar" } } } } } [

View File

@ -121,13 +121,13 @@ DEFER: expression-parser
: USE-parser ( -- parser )
[
"use:" token sp hide ,
"USE:" token sp hide ,
identifier-parser sp ,
] seq* [ first value>> ast-use boa ] action ;
: IN-parser ( -- parser )
[
"in:" token sp hide ,
"IN:" token sp hide ,
identifier-parser sp ,
] seq* [ first value>> ast-in boa ] action ;

View File

@ -239,8 +239,8 @@ t"
}
{ $subheading "Using variables:" }
{ $example "use: namespaces \"http://localhost:3128\" \"http.proxy\" set ! or set-global" "" }
{ $example "use: namespaces \"http://localhost:3128\" \"http.proxy\" [ ] with-variable" "" }
{ $example "USE: namespaces \"http://localhost:3128\" \"http.proxy\" set ! or set-global" "" }
{ $example "USE: namespaces \"http://localhost:3128\" \"http.proxy\" [ ] with-variable" "" }
{ $subheading "Manually making the request:" }
{ $example "USING: http http.client urls ; URL\" http://localhost:3128\" <request> proxy-url<<" "" }

View File

@ -21,7 +21,7 @@ HELP: <trivial-response>
{ $description "Creates an HTTP error response." }
{ $examples
{ $code
"use: http.server.responses"
"USE: http.server.responses"
"415 \"Unsupported Media Type\" <trivial-response>"
}
} ;

View File

@ -9,14 +9,14 @@ HELP: \ infix[[
{ $examples
{ $example
"USING: infix prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
"infix[[ 8+2*3 ]] ."
"14"
} $nl
{ $link \ infix[[ } " isn't that useful by itself, as it can only access literal numbers and no variables. It is designed to be used together with locals; for example with " { $link postpone\ :: } " :"
{ $example
"USING: infix locals math.functions prettyprint ;"
"in: scratchpad"
"IN: scratchpad"
":: quadratic-equation ( a b c -- z- z+ )"
" infix[[ (-b-sqrt(b*b-4*a*c)) / (2*a) ]]"
" infix[[ (-b+sqrt(b*b-4*a*c)) / (2*a) ]] ;"
@ -42,7 +42,7 @@ ARTICLE: "infix" "Infix notation"
}
"The standard precedence rules apply: Grouping with parentheses before " { $snippet "*" } ", " { $snippet "/" } "and " { $snippet "%" } " before " { $snippet "+" } " and " { $snippet "-" } "."
{ $example
"use: infix"
"USE: infix"
"infix[[ 5-40/10*2 ]] ."
"-3"
}

View File

@ -128,7 +128,7 @@ HELP: symbols>flags
{ $description "Constructs an integer value by mapping the values in the " { $snippet "symbols" } " sequence to integer values using " { $snippet "assoc" } " and " { $link bitor } "ing the values together." }
{ $examples
{ $example "USING: math.bitwise prettyprint ui.gadgets.worlds ;"
"in: scratchpad"
"IN: scratchpad"
"CONSTANT: window-controls>flags H{"
" { close-button 1 }"
" { minimize-button 2 }"

View File

@ -5,8 +5,8 @@ ARTICLE: "math.libm" "C standard library math functions"
"The words in the " { $vocab-link "math.libm" } " vocabulary call C standard library math functions. They are used to implement words in the " { $vocab-link "math.functions" } " vocabulary."
{ $warning
"These functions are unsafe. The compiler special-cases them to operate on floats only. They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
{ $example "use: math.functions" "2.0 acos ." "C{ 0.0 1.316957896924817 }" }
{ $unchecked-example "use: math.libm" "2.0 facos ." "0/0." } }
{ $example "USE: math.functions" "2.0 acos ." "C{ 0.0 1.316957896924817 }" }
{ $unchecked-example "USE: math.libm" "2.0 facos ." "0/0." } }
"Trigonometric functions:"
{ $subsections
fcos

View File

@ -152,7 +152,7 @@ M\\ actor advance optimized."
}
"The " { $vocab-link "compiler.cfg.debugger" } " vocabulary can give a lower-level picture of the generated code, that includes register assignments and other low-level details. To look at low-level optimizer output, call " { $snippet "regs." } " on a word or quotation:"
{ $code
"use: compiler.tree.debugger
"USE: compiler.tree.debugger
M\\ actor advance regs." }
"Example of a high-performance algorithms that use SIMD primitives can be found in the following vocabularies:"

View File

@ -449,7 +449,7 @@ HELP: vshuffle
{ $example
"USING: alien.c-types combinators math.vectors math.vectors.simd"
"namespaces prettyprint prettyprint.config ;"
"in: scratchpad"
"IN: scratchpad"
""
": endian-swap ( size -- vector )"
" {"

View File

@ -35,7 +35,7 @@ ARTICLE: "regexp-intro" "A quick introduction to regular expressions"
"To search a file for all lines that match a given regular expression, you could use code like this:"
{ $code "\"file.txt\" ascii file-lines [ R(( (f|b)oo+)) re-contains? ] filter" }
"To test if a string in its entirety matches a regular expression, the following can be used:"
{ $example "use: regexp \"fooo\" R(( (b|f)oo+)) matches? ." "t" }
{ $example "USE: regexp \"fooo\" R(( (b|f)oo+)) matches? ." "t" }
"Regular expressions can't be used for all parsing tasks. For example, they are not powerful enough to match balancing parentheses." ;
ARTICLE: "regexp-construction" "Constructing regular expressions"

View File

@ -23,7 +23,7 @@ HELP: sort-by
"Sort by slot a, then b descending:"
{ $example
"USING: accessors math.order prettyprint sorting.slots ;"
"in: scratchpad"
"IN: scratchpad"
"TUPLE: sort-me a b ;"
"{"
" T{ sort-me f 2 3 } T{ sort-me f 3 2 }"

View File

@ -141,7 +141,7 @@ $nl
{ $code "\"Hello world\" print" }
"The " { $link print } " word is contained inside the " { $vocab-link "io" } " vocabulary, which is available in the listener but must be explicitly added to the search path in source files:"
{ $code
"use: io"
"USE: io"
"\"Hello world\" print"
}
"Typically a source file will refer to words in multiple vocabularies, and they can all be added to the search path in one go:"
@ -234,7 +234,7 @@ command-line get [
"You can run it like so,"
{ $code "./factor grep.factor '.*hello.*' myfile.txt" }
"You'll notice this script takes a while to start. This is because it is loading and compiling the " { $vocab-link "regexp" } " vocabulary every time. To speed up startup, load the vocabulary into your image, and save the image:"
{ $code "use: regexp" "save" }
{ $code "USE: regexp" "save" }
"Now, the " { $snippet "grep.factor" } " script will start up much faster. See " { $link "images" } " for details."
{ $heading "Executable scripts" }
"It is also possible to make executable scripts. A Factor file can begin with a 'shebang' like the following:"

View File

@ -5,7 +5,7 @@ help.syntax ;
IN: help.crossref.tests
{ } [
"in: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval( -- )
"IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval( -- )
] unit-test
{ $subsection } [
@ -24,32 +24,32 @@ IN: help.crossref.tests
] unit-test
{ } [
"in: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval( -- )
"IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval( -- )
] unit-test
{ } [
"in: ayy use: help.syntax ARTICLE: \"b\" \"B\" ;"
"IN: ayy USE: help.syntax ARTICLE: \"b\" \"B\" ;"
<string-reader> "ayy" parse-stream drop
] unit-test
{ } [
"in: azz use: help.syntax use: help.markup ARTICLE: \"a\" \"A\" { $subsection \"b\" } ;"
"IN: azz USE: help.syntax USE: help.markup ARTICLE: \"a\" \"A\" { $subsection \"b\" } ;"
<string-reader> "ayy" parse-stream drop
] unit-test
{ } [
"in: ayy use: help.syntax ARTICLE: \"c\" \"C\" ;"
"IN: ayy USE: help.syntax ARTICLE: \"c\" \"C\" ;"
<string-reader> "ayy" parse-stream drop
] unit-test
{ } [
"in: azz use: help.syntax use: help.markup ARTICLE: \"a\" \"A\" { $subsection \"c\" } ;"
"IN: azz USE: help.syntax USE: help.markup ARTICLE: \"a\" \"A\" { $subsection \"c\" } ;"
<string-reader> "ayy" parse-stream drop
] unit-test
{ } [
[
"in: azz use: help.syntax use: help.markup ARTICLE: \"yyy\" \"YYY\" ; ARTICLE: \"xxx\" \"XXX\" { $subsection \"yyy\" } ; ARTICLE: \"yyy\" \"YYY\" ;"
"IN: azz USE: help.syntax USE: help.markup ARTICLE: \"yyy\" \"YYY\" ; ARTICLE: \"xxx\" \"XXX\" { $subsection \"yyy\" } ; ARTICLE: \"yyy\" \"YYY\" ;"
<string-reader> "parent-test" parse-stream drop
] [ :1 ] recover
] unit-test

View File

@ -7,7 +7,7 @@ IN: help.definitions.tests
[
[ 4 ] [
"in: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" <string-reader> "foo"
"IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" <string-reader> "foo"
parse-stream drop
"foo" path>source-file definitions>> first cardinality
@ -20,7 +20,7 @@ IN: help.definitions.tests
] unit-test
[ 2 ] [
"in: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; ARTICLE: \"hello\" \"world\" ;" <string-reader> "foo"
"IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; ARTICLE: \"hello\" \"world\" ;" <string-reader> "foo"
parse-stream drop
"foo" path>source-file definitions>> first cardinality
@ -32,7 +32,7 @@ IN: help.definitions.tests
"hello" "help.definitions.tests" lookup-word "help" word-prop
] unit-test
[ ] [ "in: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" eval( -- ) ] unit-test
[ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" eval( -- ) ] unit-test
[ ] [ "xxx" "help.definitions.tests" lookup-word print-topic ] unit-test

View File

@ -186,11 +186,11 @@ ARTICLE: "encodings-introduction" "An introduction to encodings"
"Constructors for streams which deal with bytes usually take an encoding as an explicit parameter. For example, to open a text file for reading whose contents are in UTF-8, use the following"
{ $code "\"file.txt\" utf8 <file-reader>" }
"If there is an error in the encoded stream, a replacement character (0xFFFD) will be inserted. To throw an exception upon error, use a strict encoding as follows"
{ $code "use: io.encodings.strict" "\"file.txt\" utf8 strict <file-reader>" }
{ $code "USE: io.encodings.strict" "\"file.txt\" utf8 strict <file-reader>" }
"In a similar way, encodings can be specified when opening a file for writing."
{ $code "use: io.encodings.ascii" "\"file.txt\" ascii <file-writer>" }
{ $code "USE: io.encodings.ascii" "\"file.txt\" ascii <file-writer>" }
"An encoding is also needed for some words that don't return streams, such as " { $link file-contents } ", for example"
{ $code "use: io.encodings.utf16" "\"file.txt\" utf16 file-contents" }
{ $code "USE: io.encodings.utf16" "\"file.txt\" utf16 file-contents" }
"Encoding descriptors are also used by " { $link "io.streams.byte-array" } " and taken by combinators like " { $link with-file-writer } " and " { $link with-byte-reader } " which deal with streams. It is " { $emphasis "not" } " used with " { $link "io.streams.string" } " because these deal with abstract text."
$nl
"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text." ;

View File

@ -4,12 +4,12 @@ IN: help.syntax.tests
[
[ "foobar" ] [
"in: help.syntax.tests use: help.syntax about: \"foobar\"" eval( -- )
"IN: help.syntax.tests USE: help.syntax about: \"foobar\"" eval( -- )
"help.syntax.tests" lookup-vocab vocab-help
] unit-test
[ { "foobar" } ] [
"in: help.syntax.tests use: help.syntax about: { \"foobar\" }" eval( -- )
"IN: help.syntax.tests USE: help.syntax about: { \"foobar\" }" eval( -- )
"help.syntax.tests" lookup-vocab vocab-help
] unit-test

View File

@ -17,7 +17,7 @@ SYMBOL: foo
{ } [
{
"use: help.syntax"
"USE: help.syntax"
"ARTICLE: { \"test\" 1 } \"Hello\""
"\"abc\""
"\"def\" ;"

View File

@ -7,7 +7,7 @@ ARTICLE: "first-program-start" "Creating a vocabulary for your first program"
"Factor source code is organized into " { $link "vocabularies" } ". Before we can write our first program, we must create a vocabulary for it."
$nl
"Start by loading the scaffold tool:"
{ $code "use: tools.scaffold" }
{ $code "USE: tools.scaffold" }
$nl
"Then, ask the scaffold tool to create a new vocabulary named " { $snippet "palindrome" } ":"
{ $code "\"palindrome\" scaffold-work" }
@ -31,18 +31,18 @@ $nl
"! Copyright (C) 2012 Your name."
"! See http://factorcode.org/license.txt for BSD license."
"USING: ;"
"in: palindrome"
"IN: palindrome"
}
$nl
"Notice that the file ends with an " { $link postpone\ in: } " form telling Factor that all definitions in this source file should go into the " { $snippet "palindrome" } " vocabulary using the " { $link postpone\ in: } " word. We will be adding new definitions after the " { $link postpone\ in: } " form."
"Notice that the file ends with an " { $link \ IN: } " form telling Factor that all definitions in this source file should go into the " { $snippet "palindrome" } " vocabulary using the " { $link \ IN: } " word. We will be adding new definitions after the " { $link \ IN: } " form."
$nl
"In order to be able to call the words defined in the " { $snippet "palindrome" } " vocabulary, you need to issue the following command in the listener:"
{ $code "use: palindrome" }
{ $code "USE: palindrome" }
$nl
"Now, we will be making some additions to the file. Since the file was loaded by the scaffold tool in the previous step, you need to tell Factor to reload it if it changes. Factor has a handy feature for this; pressing " { $command tool "common" refresh-all } " in the listener window will reload any changed source files. You can also force a single vocabulary to reload, in case the refresh feature does not pick up changes from disk:"
{ $code "\"palindrome\" reload" }
$nl
"We will now write our first word using " { $link postpone\ : } ". This word will test if a string is a palindrome; it will take a string as input, and give back a boolean as output. We will call this word " { $snippet "palindrome?" } ", following a naming convention that words returning booleans have names ending with " { $snippet "?" } "."
"We will now write our first word using " { $link \ : } ". This word will test if a string is a palindrome; it will take a string as input, and give back a boolean as output. We will call this word " { $snippet "palindrome?" } ", following a naming convention that words returning booleans have names ending with " { $snippet "?" } "."
$nl
"Recall that a string is a palindrome if it is spelled the same forwards or backwards; that is, if the string is equal to its reverse. We can express this in Factor as follows:"
{ $code ": palindrome? ( string -- ? ) dup reverse = ;" }
@ -72,13 +72,13 @@ ARTICLE: "first-program-test" "Testing your first program"
"! Copyright (C) 2012 Your name."
"! See http://factorcode.org/license.txt for BSD license."
"USING: kernel sequences ;"
"in: palindrome"
"IN: palindrome"
""
": palindrome? ( string -- ? ) dup reverse = ;"
}
$nl
"We will now test our new word in the listener. If you haven't done so already, add the palindrome vocabulary to the listener's vocabulary search path:"
{ $code "use: palindrome" }
{ $code "USE: palindrome" }
$nl
"Next, push a string on the stack (by surrounding text with quotes in the listener and then hitting " { $snippet "ENTER" } "):"
{ $code "\"hello\"" }
@ -101,7 +101,7 @@ $nl
$nl
"Now, open the file named " { $snippet "palindrome-tests.factor" } "; it is located in the same directory as " { $snippet "palindrome.factor" } ", and it was created by the scaffold tool."
$nl
"We will add some unit tests, which are similar to the interactive tests we did above. Unit tests are defined with the " { $link postpone\ unit-test } " word, which takes a sequence of expected outputs, and a piece of code. It runs the code, and asserts that it outputs the expected values."
"We will add some unit tests, which are similar to the interactive tests we did above. Unit tests are defined with the " { $link \ unit-test } " word, which takes a sequence of expected outputs, and a piece of code. It runs the code, and asserts that it outputs the expected values."
$nl
"Add the following two lines to " { $snippet "palindrome-tests.factor" } ":"
{ $code

View File

@ -221,7 +221,7 @@ C: <vocab-author> vocab-author ;
: vocab-is-not-loaded ( vocab -- )
"Not loaded" $heading
"You must first load this vocabulary to browse its documentation and words."
print-element vocab-name "use: " prepend 1array $code ;
print-element vocab-name "USE: " prepend 1array $code ;
: describe-words ( vocab -- )
{

View File

@ -53,7 +53,7 @@ $nl
{ $example "\"Hello, world\" print" "Hello, world" }
"New words can also be defined in the listener:"
{ $example
"use: math.functions"
"USE: math.functions"
": twice ( word -- ) [ execute ] [ execute ] bi ; inline"
"81 \\ sqrt twice ."
"3.0"

Some files were not shown because too many files have changed in this diff Show More