steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

use array literals instead of vector literals

cvs
Slava Pestov 2005-10-29 20:53:47 +00:00
parent 624cd442ef
commit 867ccbe0b4
49 changed files with 473 additions and 525 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
TODO.FACTOR.txt
View File

@ -2,14 +2,8 @@
- swap @{ and { syntax
- get stuff in examples dir running in the ui
- [ ... is annoying
perhaps on the last line of output, if a block doesn't fit, print
it anyway?
- deallocate textures and display lists
- pixelColor replacement
- fix presentations
- gadget-children on f error with outliners
X
+ ui:
- make-pane: if no input, just return pane-output
@ -46,7 +40,6 @@
+ ffi:
- C structs, enums, unions: use new-style string mode parsing
- alien/c-types.factor is ugly
- smarter out parameter handling
- clarify powerpc passing of value struct parameters
- ffi unicode strings: null char security hole

12
contrib/httpd/html.factor
View File

@ -20,7 +20,7 @@ presentation sequences strings styles words ;
] "" make ;
: hex-color, ( triplet -- )
[ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] each ;
3 swap head [ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] each ;
: fg-css, ( color -- )
"color: #" % hex-color, "; " % ;
@ -40,6 +40,16 @@ presentation sequences strings styles words ;
: font-css, ( font -- )
"font-family: " % % "; " % ;
: assoc-apply ( value-alist quot-alist -- )
#! Looks up the key of each pair in the first list in the
#! second list to produce a quotation. The quotation is
#! applied to the value of the pair. If there is no
#! corresponding quotation, the value is popped off the
#! stack.
swap [
unswons rot assoc* dup [ cdr call ] [ 2drop ] if
] each-with ;
: css-style ( style -- )
[
[

2
contrib/math/test.factor
View File

@ -223,3 +223,5 @@ unit-test
[ 0 ] [ { 1 } var ] unit-test
[ 0 ] [ { 1 } std ] unit-test
[ 3 ] [ 5 7 mod-inv ] unit-test
[ 78572682077 ] [ 234829342 342389423843 mod-inv ] unit-test

46
library/alien/c-types.factor
View File

@ -23,7 +23,13 @@ SYMBOL: c-types
] ?if ;
: c-size ( name -- size )
c-type [ "width" get ] bind ;
"width" swap c-type hash ;
: c-getter ( name -- quot )
"getter" swap c-type hash ;
: c-setter ( name -- quot )
"setter" swap c-type hash ;
: define-c-type ( quot name -- )
>r <c-type> [ swap bind ] keep r> c-types get set-hash ;
@ -31,50 +37,44 @@ SYMBOL: c-types
: <c-object> ( size -- c-ptr ) cell / ceiling <byte-array> ;
: <c-array> ( n size -- c-ptr ) * <c-object> ;
: define-pointer ( type -- )
"void*" c-type swap "*" append c-types get set-hash ;
: define-deref ( name vocab -- )
>r dup "*" swap append r> create
"getter" rot c-type hash 0 swons define-compound ;
swap c-getter 0 swons define-compound ;
: (c-constructor) ( name vocab type quot -- )
>r >r constructor-word r> c-size r> cons define-compound ;
: c-constructor ( name vocab -- )
#! Make a word <foo> where foo is the structure name that
#! allocates a Factor heap-local instance of this structure.
#! Used for C functions that expect you to pass in a struct.
dupd constructor-word
swap c-size [ <c-object> ] cons
define-compound ;
over [ <c-object> ] (c-constructor) ;
: array-constructor ( name vocab -- )
#! Make a word <foo-array> ( n -- byte-array ).
>r dup "-array" append r> constructor-word
swap c-size [ <c-array> ] cons
define-compound ;
over >r >r "-array" append r> r>
[ * <c-object> ] (c-constructor) ;
: (define-nth) ( word type quot -- )
>r c-size [ rot * ] cons r> append define-compound ;
: define-nth ( name vocab -- )
#! Make a word foo-nth ( n alien -- dsplaced-alien ).
#! Make a word foo-nth ( n alien -- displaced-alien ).
>r dup "-nth" append r> create
swap dup c-size [ rot * ] cons "getter" rot c-type hash
append define-compound ;
swap dup c-getter (define-nth) ;
: define-set-nth ( name vocab -- )
#! Make a word foo-nth ( n alien -- dsplaced-alien ).
#! Make a word foo-nth ( n alien -- displaced-alien ).
>r "set-" over "-nth" append3 r> create
swap dup c-size [ rot * ] cons "setter" rot c-type hash
append define-compound ;
swap dup c-setter (define-nth) ;
: define-out ( name vocab -- )
#! Out parameter constructor for integral types.
dupd constructor-word
swap c-type [
[
"width" get , \ <c-object> , \ tuck , 0 ,
"setter" get %
] [ ] make
] bind define-compound ;
over [ <c-object> tuck 0 ] over c-setter append
(c-constructor) ;
: init-c-type ( name vocab -- )
over define-pointer

6
library/alien/compiler.factor
View File

@ -70,7 +70,7 @@ C: alien-node make-node ;
: c-aligned c-size cell align ;
: stack-space ( parameters -- n )
0 swap [ c-aligned + ] each ;
0 [ c-aligned + ] reduce ;
: unbox-parameter ( n parameter -- node )
c-type [ "unboxer" get "reg-class" get ] bind %unbox ;
@ -134,7 +134,7 @@ M: alien-node linearize* ( node -- )
: unpair ( seq -- odds evens )
2 swap group flip dup empty?
[ drop { } { } ] [ first2 ] if ;
[ drop @{ }@ @{ }@ ] [ first2 ] if ;
: parse-arglist ( lst -- types stack effect )
unpair [
@ -169,6 +169,6 @@ M: compound (uncrossref)
over "infer" word-prop or [
drop
] [
dup { "infer-effect" "base-case" "no-effect" "terminates" }
dup @{ "infer-effect" "base-case" "no-effect" "terminates" }@
reset-props update-xt
] if ;

18
library/alien/structs.factor
View File

@ -10,24 +10,25 @@ words ;
: define-getter ( offset type name -- )
#! Define a word with stack effect ( alien -- obj ) in the
#! current 'in' vocabulary.
create-in >r
[ "getter" get ] bind cons r> swap define-compound ;
create-in >r c-getter cons r> swap define-compound ;
: define-setter ( offset type name -- )
#! Define a word with stack effect ( obj alien -- ) in the
#! current 'in' vocabulary.
"set-" swap append create-in >r
[ "setter" get ] bind cons r> swap define-compound ;
"set-" swap append create-in >r c-setter cons r>
swap define-compound ;
: c-align c-type [ "align" get ] bind ;
: define-field ( offset type name -- offset )
>r c-type dup >r [ "align" get ] bind align r> r>
>r dup >r c-align align r> r>
"struct-name" get swap "-" swap append3
( offset type name -- )
3dup define-getter 3dup define-setter
drop [ "width" get ] bind + ;
drop c-size + ;
: define-member ( max type -- max )
c-type [ "width" get ] bind max ;
c-size max ;
: define-struct-type ( width -- )
#! Define inline and pointer type for the struct. Pointer
@ -36,6 +37,5 @@ words ;
"width" set
cell "align" set
[ swap <displaced-alien> ] "getter" set
]
"struct-name" get define-c-type
] "struct-name" get define-c-type
"struct-name" get "in" get init-c-type ;

4
library/bootstrap/boot-stage1.factor
View File

@ -17,7 +17,7 @@ sequences io vectors words ;
boot
] %
{
@{
"/version.factor"
"/library/generic/early-generic.factor"
@ -150,7 +150,7 @@ sequences io vectors words ;
"/library/cli.factor"
"/library/bootstrap/init.factor"
} [ dup print parse-resource % ] each
}@ [ dup print parse-resource % ] each
[ "/library/bootstrap/boot-stage2.factor" run-resource ] %
] [ ] make

13
library/bootstrap/boot-stage2.factor
View File

@ -41,12 +41,12 @@ parse-command-line
compile? [
"Compiling base..." print
{
@{
uncons 1+ 1- + <= > >= mod length
nth-unsafe set-nth-unsafe
= string>number number>string scan solve-recursion
kill-set kill-node (generate)
} [ compile ] each
}@ [ compile ] each
] when
compile? [
@ -80,10 +80,13 @@ compile? [
0 exit
] set-boot
0 [ compiled? [ 1+ ] when ] each-word
number>string write " words compiled" print
all-words [ compiled? ] subset length
number>string write " compiled words" print
0 [ drop 1+ ] each-word
all-words [ symbol? ] subset length
number>string write " symbol words" print
all-words length
number>string write " words total" print
"Total bootstrap GC time: " write gc-time

4
library/bootstrap/image.factor
View File

@ -123,7 +123,7 @@ M: fixnum ' ( n -- tagged ) fixnum-tag immediate ;
: bignum>seq ( n -- seq )
#! n is positive or zero.
[ (bignum>seq) ] { } make ;
[ (bignum>seq) ] @{ }@ make ;
: emit-bignum ( n -- )
[ 0 < 1 0 ? ] keep abs bignum>seq
@ -285,7 +285,7 @@ M: hashtable ' ( hashtable -- pointer )
: global, ( -- )
[
{ vocabularies typemap builtins } [ [ ] change ] each
@{ vocabularies typemap builtins }@ [ [ ] change ] each
] make-hash '
global-offset fixup ;

504
library/bootstrap/primitives.factor
View File

@ -12,7 +12,7 @@ words ;
! These symbols need the same hashcode in the target as in the
! host.
{ vocabularies typemap builtins }
@{ vocabularies typemap builtins }@
! Bring up a bare cross-compiling vocabulary.
"syntax" vocab
@ -22,224 +22,224 @@ f crossref set
vocabularies get [ "syntax" set [ reveal ] each ] bind
: make-primitive ( { vocab word } n -- )
: make-primitive ( @{ vocab word }@ n -- )
>r first2 create r> f define ;
{
{ "execute" "words" }
{ "call" "kernel" }
{ "if" "kernel" }
{ "dispatch" "kernel-internals" }
{ "cons" "lists" }
{ "<vector>" "vectors" }
{ "rehash-string" "strings" }
{ "<sbuf>" "strings" }
{ "sbuf>string" "strings" }
{ ">fixnum" "math" }
{ ">bignum" "math" }
{ ">float" "math" }
{ "(fraction>)" "math-internals" }
{ "string>float" "math-internals" }
{ "float>string" "math-internals" }
{ "float>bits" "math" }
{ "double>bits" "math" }
{ "bits>float" "math" }
{ "bits>double" "math" }
{ "<complex>" "math-internals" }
{ "fixnum+" "math-internals" }
{ "fixnum-" "math-internals" }
{ "fixnum*" "math-internals" }
{ "fixnum/i" "math-internals" }
{ "fixnum/f" "math-internals" }
{ "fixnum-mod" "math-internals" }
{ "fixnum/mod" "math-internals" }
{ "fixnum-bitand" "math-internals" }
{ "fixnum-bitor" "math-internals" }
{ "fixnum-bitxor" "math-internals" }
{ "fixnum-bitnot" "math-internals" }
{ "fixnum-shift" "math-internals" }
{ "fixnum<" "math-internals" }
{ "fixnum<=" "math-internals" }
{ "fixnum>" "math-internals" }
{ "fixnum>=" "math-internals" }
{ "bignum=" "math-internals" }
{ "bignum+" "math-internals" }
{ "bignum-" "math-internals" }
{ "bignum*" "math-internals" }
{ "bignum/i" "math-internals" }
{ "bignum/f" "math-internals" }
{ "bignum-mod" "math-internals" }
{ "bignum/mod" "math-internals" }
{ "bignum-bitand" "math-internals" }
{ "bignum-bitor" "math-internals" }
{ "bignum-bitxor" "math-internals" }
{ "bignum-bitnot" "math-internals" }
{ "bignum-shift" "math-internals" }
{ "bignum<" "math-internals" }
{ "bignum<=" "math-internals" }
{ "bignum>" "math-internals" }
{ "bignum>=" "math-internals" }
{ "float=" "math-internals" }
{ "float+" "math-internals" }
{ "float-" "math-internals" }
{ "float*" "math-internals" }
{ "float/f" "math-internals" }
{ "float<" "math-internals" }
{ "float<=" "math-internals" }
{ "float>" "math-internals" }
{ "float>=" "math-internals" }
{ "facos" "math-internals" }
{ "fasin" "math-internals" }
{ "fatan" "math-internals" }
{ "fatan2" "math-internals" }
{ "fcos" "math-internals" }
{ "fexp" "math-internals" }
{ "fcosh" "math-internals" }
{ "flog" "math-internals" }
{ "fpow" "math-internals" }
{ "fsin" "math-internals" }
{ "fsinh" "math-internals" }
{ "fsqrt" "math-internals" }
{ "<word>" "words" }
{ "update-xt" "words" }
{ "compiled?" "words" }
{ "drop" "kernel" }
{ "2drop" "kernel" }
{ "3drop" "kernel" }
{ "dup" "kernel" }
{ "2dup" "kernel" }
{ "3dup" "kernel" }
{ "rot" "kernel" }
{ "-rot" "kernel" }
{ "dupd" "kernel" }
{ "swapd" "kernel" }
{ "nip" "kernel" }
{ "2nip" "kernel" }
{ "tuck" "kernel" }
{ "over" "kernel" }
{ "pick" "kernel" }
{ "swap" "kernel" }
{ ">r" "kernel" }
{ "r>" "kernel" }
{ "eq?" "kernel" }
{ "getenv" "kernel-internals" }
{ "setenv" "kernel-internals" }
{ "stat" "io" }
{ "(directory)" "io" }
{ "gc" "memory" }
{ "gc-time" "memory" }
{ "save-image" "memory" }
{ "datastack" "kernel" }
{ "callstack" "kernel" }
{ "set-datastack" "kernel" }
{ "set-callstack" "kernel" }
{ "exit" "kernel" }
{ "room" "memory" }
{ "os-env" "kernel" }
{ "millis" "kernel" }
{ "type" "kernel" }
{ "tag" "kernel-internals" }
{ "cwd" "io" }
{ "cd" "io" }
{ "compiled-offset" "assembler" }
{ "set-compiled-offset" "assembler" }
{ "literal-top" "assembler" }
{ "set-literal-top" "assembler" }
{ "address" "memory" }
{ "dlopen" "alien" }
{ "dlsym" "alien" }
{ "dlclose" "alien" }
{ "<alien>" "alien" }
{ "<byte-array>" "arrays" }
{ "<displaced-alien>" "alien" }
{ "alien-signed-cell" "alien" }
{ "set-alien-signed-cell" "alien" }
{ "alien-unsigned-cell" "alien" }
{ "set-alien-unsigned-cell" "alien" }
{ "alien-signed-8" "alien" }
{ "set-alien-signed-8" "alien" }
{ "alien-unsigned-8" "alien" }
{ "set-alien-unsigned-8" "alien" }
{ "alien-signed-4" "alien" }
{ "set-alien-signed-4" "alien" }
{ "alien-unsigned-4" "alien" }
{ "set-alien-unsigned-4" "alien" }
{ "alien-signed-2" "alien" }
{ "set-alien-signed-2" "alien" }
{ "alien-unsigned-2" "alien" }
{ "set-alien-unsigned-2" "alien" }
{ "alien-signed-1" "alien" }
{ "set-alien-signed-1" "alien" }
{ "alien-unsigned-1" "alien" }
{ "set-alien-unsigned-1" "alien" }
{ "alien-float" "alien" }
{ "set-alien-float" "alien" }
{ "alien-double" "alien" }
{ "set-alien-double" "alien" }
{ "alien-c-string" "alien" }
{ "set-alien-c-string" "alien" }
{ "throw" "errors" }
{ "string>memory" "kernel-internals" }
{ "memory>string" "kernel-internals" }
{ "alien-address" "alien" }
{ "slot" "kernel-internals" }
{ "set-slot" "kernel-internals" }
{ "integer-slot" "kernel-internals" }
{ "set-integer-slot" "kernel-internals" }
{ "char-slot" "kernel-internals" }
{ "set-char-slot" "kernel-internals" }
{ "resize-array" "arrays" }
{ "resize-string" "strings" }
{ "<hashtable>" "hashtables" }
{ "<array>" "arrays" }
{ "<tuple>" "kernel-internals" }
{ "begin-scan" "memory" }
{ "next-object" "memory" }
{ "end-scan" "memory" }
{ "size" "memory" }
{ "die" "kernel" }
{ "flush-icache" "assembler" }
{ "fopen" "io-internals" }
{ "fgetc" "io-internals" }
{ "fwrite" "io-internals" }
{ "fflush" "io-internals" }
{ "fclose" "io-internals" }
{ "expired?" "alien" }
{ "<wrapper>" "kernel" }
{ "(clone)" "kernel-internals" }
{ "(array>tuple)" "kernel-internals" }
{ "tuple>array" "generic" }
{ "array>vector" "vectors" }
} dup length 3 swap [ + ] map-with [ make-primitive ] 2each
@{
@{ "execute" "words" }@
@{ "call" "kernel" }@
@{ "if" "kernel" }@
@{ "dispatch" "kernel-internals" }@
@{ "cons" "lists" }@
@{ "<vector>" "vectors" }@
@{ "rehash-string" "strings" }@
@{ "<sbuf>" "strings" }@
@{ "sbuf>string" "strings" }@
@{ ">fixnum" "math" }@
@{ ">bignum" "math" }@
@{ ">float" "math" }@
@{ "(fraction>)" "math-internals" }@
@{ "string>float" "math-internals" }@
@{ "float>string" "math-internals" }@
@{ "float>bits" "math" }@
@{ "double>bits" "math" }@
@{ "bits>float" "math" }@
@{ "bits>double" "math" }@
@{ "<complex>" "math-internals" }@
@{ "fixnum+" "math-internals" }@
@{ "fixnum-" "math-internals" }@
@{ "fixnum*" "math-internals" }@
@{ "fixnum/i" "math-internals" }@
@{ "fixnum/f" "math-internals" }@
@{ "fixnum-mod" "math-internals" }@
@{ "fixnum/mod" "math-internals" }@
@{ "fixnum-bitand" "math-internals" }@
@{ "fixnum-bitor" "math-internals" }@
@{ "fixnum-bitxor" "math-internals" }@
@{ "fixnum-bitnot" "math-internals" }@
@{ "fixnum-shift" "math-internals" }@
@{ "fixnum<" "math-internals" }@
@{ "fixnum<=" "math-internals" }@
@{ "fixnum>" "math-internals" }@
@{ "fixnum>=" "math-internals" }@
@{ "bignum=" "math-internals" }@
@{ "bignum+" "math-internals" }@
@{ "bignum-" "math-internals" }@
@{ "bignum*" "math-internals" }@
@{ "bignum/i" "math-internals" }@
@{ "bignum/f" "math-internals" }@
@{ "bignum-mod" "math-internals" }@
@{ "bignum/mod" "math-internals" }@
@{ "bignum-bitand" "math-internals" }@
@{ "bignum-bitor" "math-internals" }@
@{ "bignum-bitxor" "math-internals" }@
@{ "bignum-bitnot" "math-internals" }@
@{ "bignum-shift" "math-internals" }@
@{ "bignum<" "math-internals" }@
@{ "bignum<=" "math-internals" }@
@{ "bignum>" "math-internals" }@
@{ "bignum>=" "math-internals" }@
@{ "float=" "math-internals" }@
@{ "float+" "math-internals" }@
@{ "float-" "math-internals" }@
@{ "float*" "math-internals" }@
@{ "float/f" "math-internals" }@
@{ "float<" "math-internals" }@
@{ "float<=" "math-internals" }@
@{ "float>" "math-internals" }@
@{ "float>=" "math-internals" }@
@{ "facos" "math-internals" }@
@{ "fasin" "math-internals" }@
@{ "fatan" "math-internals" }@
@{ "fatan2" "math-internals" }@
@{ "fcos" "math-internals" }@
@{ "fexp" "math-internals" }@
@{ "fcosh" "math-internals" }@
@{ "flog" "math-internals" }@
@{ "fpow" "math-internals" }@
@{ "fsin" "math-internals" }@
@{ "fsinh" "math-internals" }@
@{ "fsqrt" "math-internals" }@
@{ "<word>" "words" }@
@{ "update-xt" "words" }@
@{ "compiled?" "words" }@
@{ "drop" "kernel" }@
@{ "2drop" "kernel" }@
@{ "3drop" "kernel" }@
@{ "dup" "kernel" }@
@{ "2dup" "kernel" }@
@{ "3dup" "kernel" }@
@{ "rot" "kernel" }@
@{ "-rot" "kernel" }@
@{ "dupd" "kernel" }@
@{ "swapd" "kernel" }@
@{ "nip" "kernel" }@
@{ "2nip" "kernel" }@
@{ "tuck" "kernel" }@
@{ "over" "kernel" }@
@{ "pick" "kernel" }@
@{ "swap" "kernel" }@
@{ ">r" "kernel" }@
@{ "r>" "kernel" }@
@{ "eq?" "kernel" }@
@{ "getenv" "kernel-internals" }@
@{ "setenv" "kernel-internals" }@
@{ "stat" "io" }@
@{ "(directory)" "io" }@
@{ "gc" "memory" }@
@{ "gc-time" "memory" }@
@{ "save-image" "memory" }@
@{ "datastack" "kernel" }@
@{ "callstack" "kernel" }@
@{ "set-datastack" "kernel" }@
@{ "set-callstack" "kernel" }@
@{ "exit" "kernel" }@
@{ "room" "memory" }@
@{ "os-env" "kernel" }@
@{ "millis" "kernel" }@
@{ "type" "kernel" }@
@{ "tag" "kernel-internals" }@
@{ "cwd" "io" }@
@{ "cd" "io" }@
@{ "compiled-offset" "assembler" }@
@{ "set-compiled-offset" "assembler" }@
@{ "literal-top" "assembler" }@
@{ "set-literal-top" "assembler" }@
@{ "address" "memory" }@
@{ "dlopen" "alien" }@
@{ "dlsym" "alien" }@
@{ "dlclose" "alien" }@
@{ "<alien>" "alien" }@
@{ "<byte-array>" "arrays" }@
@{ "<displaced-alien>" "alien" }@
@{ "alien-signed-cell" "alien" }@
@{ "set-alien-signed-cell" "alien" }@
@{ "alien-unsigned-cell" "alien" }@
@{ "set-alien-unsigned-cell" "alien" }@
@{ "alien-signed-8" "alien" }@
@{ "set-alien-signed-8" "alien" }@
@{ "alien-unsigned-8" "alien" }@
@{ "set-alien-unsigned-8" "alien" }@
@{ "alien-signed-4" "alien" }@
@{ "set-alien-signed-4" "alien" }@
@{ "alien-unsigned-4" "alien" }@
@{ "set-alien-unsigned-4" "alien" }@
@{ "alien-signed-2" "alien" }@
@{ "set-alien-signed-2" "alien" }@
@{ "alien-unsigned-2" "alien" }@
@{ "set-alien-unsigned-2" "alien" }@
@{ "alien-signed-1" "alien" }@
@{ "set-alien-signed-1" "alien" }@
@{ "alien-unsigned-1" "alien" }@
@{ "set-alien-unsigned-1" "alien" }@
@{ "alien-float" "alien" }@
@{ "set-alien-float" "alien" }@
@{ "alien-double" "alien" }@
@{ "set-alien-double" "alien" }@
@{ "alien-c-string" "alien" }@
@{ "set-alien-c-string" "alien" }@
@{ "throw" "errors" }@
@{ "string>memory" "kernel-internals" }@
@{ "memory>string" "kernel-internals" }@
@{ "alien-address" "alien" }@
@{ "slot" "kernel-internals" }@
@{ "set-slot" "kernel-internals" }@
@{ "integer-slot" "kernel-internals" }@
@{ "set-integer-slot" "kernel-internals" }@
@{ "char-slot" "kernel-internals" }@
@{ "set-char-slot" "kernel-internals" }@
@{ "resize-array" "arrays" }@
@{ "resize-string" "strings" }@
@{ "<hashtable>" "hashtables" }@
@{ "<array>" "arrays" }@
@{ "<tuple>" "kernel-internals" }@
@{ "begin-scan" "memory" }@
@{ "next-object" "memory" }@
@{ "end-scan" "memory" }@
@{ "size" "memory" }@
@{ "die" "kernel" }@
@{ "flush-icache" "assembler" }@
@{ "fopen" "io-internals" }@
@{ "fgetc" "io-internals" }@
@{ "fwrite" "io-internals" }@
@{ "fflush" "io-internals" }@
@{ "fclose" "io-internals" }@
@{ "expired?" "alien" }@
@{ "<wrapper>" "kernel" }@
@{ "(clone)" "kernel-internals" }@
@{ "(array>tuple)" "kernel-internals" }@
@{ "tuple>array" "generic" }@
@{ "array>vector" "vectors" }@
}@ dup length 3 swap [ + ] map-with [ make-primitive ] 2each
: set-stack-effect ( { vocab word effect } -- )
: set-stack-effect ( @{ vocab word effect }@ -- )
first3 >r lookup r> "stack-effect" set-word-prop ;
{
{ "drop" "kernel" " x -- " }
{ "2drop" "kernel" " x y -- " }
{ "3drop" "kernel" " x y z -- " }
{ "dup" "kernel" " x -- x x " }
{ "2dup" "kernel" " x y -- x y x y " }
{ "3dup" "kernel" " x y z -- x y z x y z " }
{ "rot" "kernel" " x y z -- y z x " }
{ "-rot" "kernel" " x y z -- z x y " }
{ "dupd" "kernel" " x y -- x x y " }
{ "swapd" "kernel" " x y z -- y x z " }
{ "nip" "kernel" " x y -- y " }
{ "2nip" "kernel" " x y z -- z " }
{ "tuck" "kernel" " x y -- y x y " }
{ "over" "kernel" " x y -- x y x " }
{ "pick" "kernel" " x y z -- x y z x " }
{ "swap" "kernel" " x y -- y x " }
{ ">r" "kernel" " x -- r: x " }
{ "r>" "kernel" " r: x -- x " }
{ "datastack" "kernel" " -- ds " }
{ "callstack" "kernel" " -- cs " }
{ "set-datastack" "kernel" " ds -- " }
{ "set-callstack" "kernel" " cs -- " }
{ "flush-icache" "assembler" " -- " }
} [
@{
@{ "drop" "kernel" " x -- " }@
@{ "2drop" "kernel" " x y -- " }@
@{ "3drop" "kernel" " x y z -- " }@
@{ "dup" "kernel" " x -- x x " }@
@{ "2dup" "kernel" " x y -- x y x y " }@
@{ "3dup" "kernel" " x y z -- x y z x y z " }@
@{ "rot" "kernel" " x y z -- y z x " }@
@{ "-rot" "kernel" " x y z -- z x y " }@
@{ "dupd" "kernel" " x y -- x x y " }@
@{ "swapd" "kernel" " x y z -- y x z " }@
@{ "nip" "kernel" " x y -- y " }@
@{ "2nip" "kernel" " x y z -- z " }@
@{ "tuck" "kernel" " x y -- y x y " }@
@{ "over" "kernel" " x y -- x y x " }@
@{ "pick" "kernel" " x y z -- x y z x " }@
@{ "swap" "kernel" " x y -- y x " }@
@{ ">r" "kernel" " x -- r: x " }@
@{ "r>" "kernel" " r: x -- x " }@
@{ "datastack" "kernel" " -- ds " }@
@{ "callstack" "kernel" " -- cs " }@
@{ "set-datastack" "kernel" " ds -- " }@
@{ "set-callstack" "kernel" " cs -- " }@
@{ "flush-icache" "assembler" " -- " }@
}@ [
set-stack-effect
] each
@ -275,101 +275,101 @@ num-types <array> builtins set
"null" "generic" create drop
"fixnum?" "math" create t "inline" set-word-prop
"fixnum" "math" create 0 "fixnum?" "math" create { } define-builtin
"fixnum" "math" create 0 "fixnum?" "math" create @{ }@ define-builtin
"fixnum" "math" create 0 "math-priority" set-word-prop
"fixnum" "math" create ">fixnum" [ "math" ] search unit "coercer" set-word-prop
"bignum?" "math" create t "inline" set-word-prop
"bignum" "math" create 1 "bignum?" "math" create { } define-builtin
"bignum" "math" create 1 "bignum?" "math" create @{ }@ define-builtin
"bignum" "math" create 1 "math-priority" set-word-prop
"bignum" "math" create ">bignum" [ "math" ] search unit "coercer" set-word-prop
"cons?" "lists" create t "inline" set-word-prop
"cons" "lists" create 2 "cons?" "lists" create
{ { 0 { "car" "lists" } f } { 1 { "cdr" "lists" } f } } define-builtin
@{ @{ 0 @{ "car" "lists" }@ f }@ @{ 1 @{ "cdr" "lists" }@ f }@ }@ define-builtin
"ratio?" "math" create t "inline" set-word-prop
"ratio" "math" create 4 "ratio?" "math" create
{ { 0 { "numerator" "math" } f } { 1 { "denominator" "math" } f } } define-builtin
@{ @{ 0 @{ "numerator" "math" }@ f }@ @{ 1 @{ "denominator" "math" }@ f }@ }@ define-builtin
"ratio" "math" create 2 "math-priority" set-word-prop
"float?" "math" create t "inline" set-word-prop
"float" "math" create 5 "float?" "math" create { } define-builtin
"float" "math" create 5 "float?" "math" create @{ }@ define-builtin
"float" "math" create 3 "math-priority" set-word-prop
"float" "math" create ">float" [ "math" ] search unit "coercer" set-word-prop
"complex?" "math" create t "inline" set-word-prop
"complex" "math" create 6 "complex?" "math" create
{ { 0 { "real" "math" } f } { 1 { "imaginary" "math" } f } } define-builtin
@{ @{ 0 @{ "real" "math" }@ f }@ @{ 1 @{ "imaginary" "math" }@ f }@ }@ define-builtin
"complex" "math" create 4 "math-priority" set-word-prop
"displaced-alien" "alien" create 7 "displaced-alien?" "alien" create { } define-builtin
"displaced-alien" "alien" create 7 "displaced-alien?" "alien" create @{ }@ define-builtin
"array?" "arrays" create t "inline" set-word-prop
"array" "arrays" create 8 "array?" "arrays" create
{ } define-builtin
@{ }@ define-builtin
"f" "!syntax" create 9 "not" "kernel" create
{ } define-builtin
@{ }@ define-builtin
"hashtable?" "hashtables" create t "inline" set-word-prop
"hashtable" "hashtables" create 10 "hashtable?" "hashtables" create
{
{ 1 { "hash-size" "hashtables" } { "set-hash-size" "kernel-internals" } }
{ 2 { "underlying" "sequences-internals" } { "set-underlying" "sequences-internals" } }
} define-builtin
@{
@{ 1 @{ "hash-size" "hashtables" }@ @{ "set-hash-size" "kernel-internals" }@ }@
@{ 2 @{ "underlying" "sequences-internals" }@ @{ "set-underlying" "sequences-internals" }@ }@
}@ define-builtin
"vector?" "vectors" create t "inline" set-word-prop
"vector" "vectors" create 11 "vector?" "vectors" create
{
{ 1 { "length" "sequences" } { "set-fill" "sequences-internals" } }
{ 2 { "underlying" "sequences-internals" } { "set-underlying" "sequences-internals" } }
} define-builtin
@{
@{ 1 @{ "length" "sequences" }@ @{ "set-fill" "sequences-internals" }@ }@
@{ 2 @{ "underlying" "sequences-internals" }@ @{ "set-underlying" "sequences-internals" }@ }@
}@ define-builtin
"string?" "strings" create t "inline" set-word-prop
"string" "strings" create 12 "string?" "strings" create
{
{ 1 { "length" "sequences" } f }
{ 2 { "hashcode" "kernel" } f }
} define-builtin
@{
@{ 1 @{ "length" "sequences" }@ f }@
@{ 2 @{ "hashcode" "kernel" }@ f }@
}@ define-builtin
"sbuf?" "strings" create t "inline" set-word-prop
"sbuf" "strings" create 13 "sbuf?" "strings" create
{
{ 1 { "length" "sequences" } { "set-fill" "sequences-internals" } }
{ 2 { "underlying" "sequences-internals" } { "set-underlying" "sequences-internals" } }
} define-builtin
@{
@{ 1 @{ "length" "sequences" }@ @{ "set-fill" "sequences-internals" }@ }@
@{ 2 @{ "underlying" "sequences-internals" }@ @{ "set-underlying" "sequences-internals" }@ }@
}@ define-builtin
"wrapper?" "kernel" create t "inline" set-word-prop
"wrapper" "kernel" create 14 "wrapper?" "kernel" create
{ { 1 { "wrapped" "kernel" } f } } define-builtin
@{ @{ 1 @{ "wrapped" "kernel" }@ f }@ }@ define-builtin
"dll?" "alien" create t "inline" set-word-prop
"dll" "alien" create 15 "dll?" "alien" create
{ { 1 { "dll-path" "alien" } f } } define-builtin
@{ @{ 1 @{ "dll-path" "alien" }@ f }@ }@ define-builtin
"alien?" "alien" create t "inline" set-word-prop
"alien" "alien" create 16 "alien?" "alien" create { } define-builtin
"alien" "alien" create 16 "alien?" "alien" create @{ }@ define-builtin
"word?" "words" create t "inline" set-word-prop
"word" "words" create 17 "word?" "words" create
{
{ 1 { "hashcode" "kernel" } f }
{ 2 { "word-name" "words" } f }
{ 3 { "word-vocabulary" "words" } { "set-word-vocabulary" "words" } }
{ 4 { "word-primitive" "words" } { "set-word-primitive" "words" } }
{ 5 { "word-def" "words" } { "set-word-def" "words" } }
{ 6 { "word-props" "words" } { "set-word-props" "words" } }
} define-builtin
@{
@{ 1 @{ "hashcode" "kernel" }@ f }@
@{ 2 @{ "word-name" "words" }@ f }@
@{ 3 @{ "word-vocabulary" "words" }@ @{ "set-word-vocabulary" "words" }@ }@
@{ 4 @{ "word-primitive" "words" }@ @{ "set-word-primitive" "words" }@ }@
@{ 5 @{ "word-def" "words" }@ @{ "set-word-def" "words" }@ }@
@{ 6 @{ "word-props" "words" }@ @{ "set-word-props" "words" }@ }@
}@ define-builtin
"tuple?" "kernel" create t "inline" set-word-prop
"tuple" "kernel" create 18 "tuple?" "kernel" create
{ } define-builtin
@{ }@ define-builtin
"byte-array?" "arrays" create t "inline" set-word-prop
"byte-array" "arrays" create 19
"byte-array?" "arrays" create
{ } define-builtin
@{ }@ define-builtin
! Define general-t type, which is any object that is not f.
"general-t" "kernel" create dup define-symbol

2
library/collections/arrays.factor
View File

@ -33,7 +33,7 @@ M: byte-array clone (clone) ;
M: byte-array length array-capacity ;
M: byte-array resize resize-array ;
: 1array ( x -- { x } )
: 1array ( x -- @{ x }@ )
1 <array> [ 0 swap set-array-nth ] keep ; flushable
: 2array ( x y -- @{ x y }@ )

10
library/collections/assoc.factor
View File

@ -21,13 +21,3 @@ IN: lists USING: kernel sequences ;
: set-assoc ( value key alist -- alist )
#! Adds the key/value pair to the alist.
dupd remove-assoc acons ;
: assoc-apply ( value-alist quot-alist -- )
#! Looks up the key of each pair in the first list in the
#! second list to produce a quotation. The quotation is
#! applied to the value of the pair. If there is no
#! corresponding quotation, the value is popped off the
#! stack.
swap [
unswons rot assoc* dup [ cdr call ] [ 2drop ] if
] each-with ;

4
library/collections/sequence-combinators.factor
View File

@ -149,8 +149,8 @@ M: object find ( seq quot -- i elt )
swap [ with rot ] subset 2nip ; inline
: monotonic? ( seq quot -- ? | quot: elt elt -- ? )
#! Eg, { 1 2 3 4 } [ < ] monotonic? ==> t
#! { 1 3 2 4 } [ < ] monotonic? ==> f
#! Eg, @{ 1 2 3 4 }@ [ < ] monotonic? ==> t
#! @{ 1 3 2 4 }@ [ < ] monotonic? ==> f
#! Don't use with lists.
swap dup length 1- [
pick pick >r >r (monotonic) r> r> rot

10
library/collections/sequences-epilogue.factor
View File

@ -17,13 +17,13 @@ sequences strings vectors words ;
IN: sequences
: first2 ( { x y } -- x y )
: first2 ( @{ x y }@ -- x y )
1 swap bounds-check nip first2-unsafe ; inline
: first3 ( { x y z } -- x y z )
: first3 ( @{ x y z }@ -- x y z )
2 swap bounds-check nip first3-unsafe ; inline
: first4 ( { x y z w } -- x y z w )
: first4 ( @{ x y z w }@ -- x y z w )
3 swap bounds-check nip first4-unsafe ; inline
M: object like drop ;
@ -161,7 +161,7 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
: flip ( seq -- seq )
#! An example illustrates this word best:
#! { { 1 2 3 } { 4 5 6 } } ==> { { 1 4 } { 2 5 } { 3 6 } }
#! @{ @{ 1 2 3 }@ @{ 4 5 6 }@ }@ ==> @{ @{ 1 4 }@ @{ 2 5 }@ @{ 3 6 }@ }@
dup empty? [
dup first [ length ] keep like
[ swap [ nth ] map-with ] map-with
@ -177,7 +177,7 @@ IN: kernel
: cond ( conditions -- )
#! Conditions is a sequence of quotation pairs.
#! { { [ X ] [ Y ] } { [ Z ] [ T ] } }
#! @{ @{ [ X ] [ Y ] }@ @{ [ Z ] [ T ] }@ }@
#! => X [ Y ] [ Z [ T ] [ ] if ] if
#! The last condition should be a catch-all 't'.
[ first call ] find nip dup

2
library/collections/slicing.factor
View File

@ -57,7 +57,7 @@ M: object tail ( index seq -- seq ) [ tail-slice ] keep like ;
2dup head , dupd tail-slice (group)
] if ;
: group ( n seq -- seq ) [ (group) ] { } make ; flushable
: group ( n seq -- seq ) [ (group) ] @{ }@ make ; flushable
: start-step ( subseq seq n -- subseq slice )
pick length dupd + rot <slice> ;

4
library/compiler/basic-blocks.factor
View File

@ -13,7 +13,7 @@ USING: arrays hashtables kernel lists math namespaces sequences ;
] if ;
: split-blocks ( linear -- blocks )
[ 0 swap (split-blocks) ] { } make ;
[ 0 swap (split-blocks) ] @{ }@ make ;
SYMBOL: d-height
SYMBOL: r-height
@ -145,7 +145,7 @@ M: %indirect trim-dead* ( tail vop -- ) ?dead-literal ;
dup simplify-stack
d-height get %inc-d r-height get %inc-r 2array append
trim-dead
] { } make ;
] @{ }@ make ;
: keep-simplifying ( block -- block )
dup length >r simplify-block dup length r> =

19
library/compiler/compiler.factor
View File

@ -39,22 +39,3 @@ words ;
] [
call
] if ;
\ dataflow profile
\ linearize profile
\ split-blocks profile
\ simplify profile
\ keep-optimizing profile
\ literals profile
\ kill-set profile
\ kill-node profile
\ infer-classes profile
\ solve-recursion profile
\ post-inline profile
\ compose-shuffle-nodes profile
\ static-branch profile
\ optimize-hooks profile
\ partial-eval? profile
\ partial-eval profile
\ flip-branches profile
\ apply-identities profile

32
library/compiler/intrinsics.factor
View File

@ -119,13 +119,13 @@ namespaces sequences words ;
over binary-op-imm?
[ binary-op-imm ] [ binary-op-reg ] if ;
{
{ fixnum+ %fixnum+ }
{ fixnum- %fixnum- }
{ fixnum-bitand %fixnum-bitand }
{ fixnum-bitor %fixnum-bitor }
{ fixnum-bitxor %fixnum-bitxor }
} [
@{
@{ fixnum+ %fixnum+ }@
@{ fixnum- %fixnum- }@
@{ fixnum-bitand %fixnum-bitand }@
@{ fixnum-bitor %fixnum-bitor }@
@{ fixnum-bitxor %fixnum-bitxor }@
}@ [
first2 [ binary-op ] curry "intrinsic" set-word-prop
] each
@ -139,13 +139,13 @@ namespaces sequences words ;
pick binary-op-imm?
[ binary-jump-imm ] [ binary-jump-reg ] if ;
{
{ fixnum<= %jump-fixnum<= }
{ fixnum< %jump-fixnum< }
{ fixnum>= %jump-fixnum>= }
{ fixnum> %jump-fixnum> }
{ eq? %jump-eq? }
} [
@{
@{ fixnum<= %jump-fixnum<= }@
@{ fixnum< %jump-fixnum< }@
@{ fixnum>= %jump-fixnum>= }@
@{ fixnum> %jump-fixnum> }@
@{ eq? %jump-eq? }@
}@ [
first2 [ binary-jump ] curry "if-intrinsic" set-word-prop
] each
@ -168,8 +168,8 @@ namespaces sequences words ;
! See the remark on fixnum-mod for vreg usage
drop
in-2
{ << vreg f 1 >> << vreg f 0 >> }
{ << vreg f 2 >> << vreg f 0 >> }
@{ << vreg f 1 >> << vreg f 0 >> }@
@{ << vreg f 2 >> << vreg f 0 >> }@
%fixnum/mod ,
<< vreg f 2 >> 0 %replace-d ,
<< vreg f 0 >> 1 %replace-d ,

2
library/compiler/linearizer.factor
View File

@ -10,7 +10,7 @@ GENERIC: linearize* ( node -- )
#! Transform dataflow IR into linear IR. This strips out
#! stack flow information, and flattens conditionals into
#! jumps and labels.
[ %prologue , linearize* ] { } make ;
[ %prologue , linearize* ] @{ }@ make ;
: linearize-next node-successor linearize* ;

2
library/compiler/x86/architecture.factor
View File

@ -18,7 +18,7 @@ USING: assembler compiler-backend kernel sequences ;
#! Number of vregs
3 ; inline
M: vreg v>operand vreg-n { EAX ECX EDX } nth ;
M: vreg v>operand vreg-n @{ EAX ECX EDX }@ nth ;
! On x86, parameters are never passed in registers.
M: int-regs fastcall-regs drop 0 ;

18
library/freetype/freetype-gl.factor
View File

@ -19,15 +19,9 @@ SYMBOL: open-fonts
{{ }} clone open-fonts set
] bind ;
: free-dlists ( seq -- )
drop ;
: free-textures ( seq -- )
drop ;
: free-sprites ( glyphs -- )
dup [ sprite-dlist ] map free-dlists
[ sprite-texture ] map free-textures ;
: free-sprite ( sprite -- )
dup sprite-dlist 1 glDeleteLists
sprite-texture <uint> 1 swap glDeleteTextures ;
! A font object from FreeType.
! the handle is an FT_Face.
@ -38,7 +32,7 @@ M: font = eq? ;
: flush-font ( font -- )
#! Only do this after re-creating a GL context!
dup font-sprites [ ] subset free-sprites
dup font-sprites [ [ free-sprite ] when* ] each
{ } clone swap set-font-sprites ;
: close-font ( font -- )
@ -106,12 +100,12 @@ M: font = eq? ;
C: font ( handle -- font )
[ set-font-handle ] keep dup flush-font dup init-font ;
: open-font ( { font style ptsize } -- font )
: open-font ( @{ font style ptsize }@ -- font )
#! Open a font and set the point size of the font.
first3 >r open-face dup 0 r> 6 shift
dpi dpi FT_Set_Char_Size freetype-error <font> ;
: lookup-font ( { font style ptsize } -- font )
: lookup-font ( @{ font style ptsize }@ -- font )
#! Cache open fonts.
open-fonts get [ open-font ] cache ;

2
library/generic/slots.factor
View File

@ -29,7 +29,7 @@ parser sequences strings words ;
: define-slot ( class slot reader writer -- )
>r >r 2dup r> define-reader r> define-writer ;
: ?create ( { name vocab }/f -- word )
: ?create ( @{ name vocab }@ -- word )
dup [ first2 create ] when ;
: intern-slots ( spec -- spec )

63
library/help/tutorial.factor
View File

@ -42,8 +42,8 @@ M: general-list tutorial-line
dup page-theme <border> ;
: tutorial-pages
{
{
@{
@{
"* Factor: a dynamic language"
"--"
"This series of slides presents a quick overview of Factor."
@ -59,7 +59,7 @@ M: general-list tutorial-line
"You can then press ENTER to execute the code, or edit it first."
""
"http://factor.sourceforge.net"
} {
}@ @{
"* The view from 10,000 feet"
"--"
"- Everything is an object"
@ -68,7 +68,7 @@ M: general-list tutorial-line
"- Words pass parameters on the stack"
"- Code blocks can be passed as parameters to words"
"- Word definitions are very short with very high code reuse"
} {
}@ @{
"* Basic syntax"
"--"
"Factor code is made up of whitespace-speparated tokens."
@ -79,7 +79,7 @@ M: general-list tutorial-line
"The first token (\"hello world\") is a string."
"The second token (print) is a word."
"The string is pushed on the stack, and the print word prints it."
} {
}@ @{
"* The stack"
"--"
"- The stack is like a pile of papers."
@ -91,7 +91,7 @@ M: general-list tutorial-line
[ "2 3 + ." ]
""
"Try running it in the listener now."
} {
}@ @{
"* Postfix arithmetic"
"--"
"What happened when you ran it?"
@ -103,7 +103,7 @@ M: general-list tutorial-line
"This is called postfix arithmetic."
"Traditional arithmetic is called infix: 3 + (6 * 2)"
"Lets translate this into postfix: 3 6 2 * + ."
} {
}@ @{
"* Colon definitions"
"--"
"We can define new words in terms of existing words."
@ -118,7 +118,7 @@ M: general-list tutorial-line
"The result is the same as if you wrote:"
""
[ "3 2 * 2 * ." ]
} {
}@ @{
"* Stack effects"
"--"
"When we look at the definition of the ``twice'' word,"
@ -133,7 +133,7 @@ M: general-list tutorial-line
"The stack effect of twice is ( x -- 2*x )."
"The stack effect of + is ( x y -- x+y )."
"The stack effect of . is ( object -- )."
} {
}@ @{
"* Reading user input"
"--"
"User input is read using the readln ( -- string ) word."
@ -143,7 +143,7 @@ M: general-list tutorial-line
""
[ "\"What is your name?\" print" ]
[ "readln \"Hello, \" write print" ]
} {
}@ @{
"* Shuffle words"
"--"
"The word ``twice'' we defined is useless."
@ -156,7 +156,7 @@ M: general-list tutorial-line
"However, we can use the word ``dup''. It has stack effect"
"( object -- object object ), and it does exactly what we"
"need. The ``dup'' word is known as a shuffle word."
} {
}@ @{
"* The squared word"
"--"
"Try entering the following word definition:"
@ -171,7 +171,7 @@ M: general-list tutorial-line
"drop ( object -- )"
"swap ( obj1 obj2 -- obj2 obj1 )"
"over ( obj1 obj2 -- obj1 obj2 obj1 )"
} {
}@ @{
"* Another shuffle example"
"--"
"Now let us write a word that negates a number."
@ -186,7 +186,7 @@ M: general-list tutorial-line
"So indeed, we can factor out the definition ``0 swap -'':"
""
[ ": negate ( n -- -n ) 0 swap - ;" ]
} {
}@ @{
"* Seeing words"
"--"
"If you have entered every definition in this tutorial,"
@ -203,7 +203,7 @@ M: general-list tutorial-line
""
"Prefixing a word with \\ pushes it on the stack, instead of"
"executing it. So the see word has stack effect ( word -- )."
} {
}@ @{
"* Branches"
"--"
"Now suppose we want to write a word that computes the"
@ -219,7 +219,7 @@ M: general-list tutorial-line
"In Factor, any object can be used as a truth value."
"- The f object is false."
"- Anything else is true."
} {
}@ @{
"* More branches"
"--"
"On the previous slide, you saw the 'when' conditional:"
@ -233,7 +233,7 @@ M: general-list tutorial-line
"The 'if' conditional takes action on both branches:"
""
[ " ... condition ... [ ... ] [ ... ] if" ]
} {
}@ @{
"* Combinators"
"--"
"if, when, unless are words that take lists of code as input."
@ -247,7 +247,7 @@ M: general-list tutorial-line
"Try this:"
""
[ "10 [ \"Hello combinators\" print ] times" ]
} {
}@ @{
"* Sequences"
"--"
"You have already seen strings, very briefly:"
@ -257,13 +257,13 @@ M: general-list tutorial-line
"Strings are part of a class of objects called sequences."
"Two other types of sequences you will use a lot are:"
""
" Lists: { 1 3 \"hi\" 10 2 }"
" Lists: [ 1 3 \"hi\" 10 2 ]"
" Vectors: { \"the\" { \"quick\" \"brown\" } \"fox\" }"
""
"As you can see in the second example, lists and vectors"
"can contain any type of object, including other lists"
"and vectors."
} {
}@ @{
"* Sequences and combinators"
"--"
"A very useful combinator is each ( seq quot -- )."
@ -282,7 +282,7 @@ M: general-list tutorial-line
""
[ "{ 10 20 30 } [ 3 + ] map ." ]
"==> { 13 23 33 }"
} {
}@ @{
"* Numbers - integers and ratios"
"--"
"Factor's supports arbitrary-precision integers and ratios."
@ -296,18 +296,7 @@ M: general-list tutorial-line
""
"Rational numbers are added, multiplied and reduced to"
"lowest terms in the same way you learned in grade school."
} {
"* Numbers - higher math"
"--"
[ "2 sqrt ." ]
""
[ "-1 sqrt ." ]
""
[ "{ { 10 3 } { 7 5 } { -2 0 } }" ]
[ "{ { 11 2 } { 4 8 } } m." ]
""
"... and there is much more for the math geeks."
} {
}@ @{
"* Object oriented programming"
"--"
"Each object belongs to a class."
@ -322,7 +311,7 @@ M: general-list tutorial-line
"Method definitions may appear in independent source files."
""
"integer, string, object are built-in classes."
} {
}@ @{
"* Defining new classes"
"--"
"New classes can be defined:"
@ -337,7 +326,7 @@ M: general-list tutorial-line
""
"Tuples support custom constructors, delegation..."
"see the developer's handbook for details."
} {
}@ @{
"* The library"
"--"
"Offers a good selection of highly-reusable words:"
@ -352,7 +341,7 @@ M: general-list tutorial-line
[ "\"sequences\" words ." ]
"- To show a word definition:"
[ "\\ reverse see" ]
} {
}@ @{
"* Learning more"
"--"
"Hopefully this tutorial has sparked your interest in Factor."
@ -363,8 +352,8 @@ M: general-list tutorial-line
""
"Also, point your IRC client to irc.freenode.net and hop in the"
"#concatenative channel to chat with other Factor geeks."
}
} ;
}@
}@ ;
: <tutorial> ( pages -- browser )
tutorial-pages [ <page> ] map <book> <book-browser> ;

2
library/inference/branches.factor
View File

@ -33,7 +33,7 @@ namespaces parser prettyprint sequences strings vectors words ;
0 [ [ max ] when* ] reduce ;
: unbalanced-branches ( in out -- )
{ "Unbalanced branches:" } -rot [
@{ "Unbalanced branches:" }@ -rot [
swap number>string " " rot length number>string
append3
] 2map append "\n" join inference-error ;

14
library/inference/call-optimizers.factor
View File

@ -13,7 +13,7 @@ math math-internals sequences words ;
dup optimizer-hooks cond ;
: define-optimizers ( word optimizers -- )
{ [ t ] [ drop t ] } add "optimizer-hooks" set-word-prop ;
@{ [ t ] [ drop t ] }@ add "optimizer-hooks" set-word-prop ;
: partial-eval? ( #call -- ? )
dup node-param "foldable" word-prop [
@ -49,18 +49,18 @@ math math-internals sequences words ;
dup flip-subst node-successor dup
dup node-children first2 swap 2array swap set-node-children ;
\ not {
{ [ dup node-successor #if? ] [ flip-branches ] }
} define-optimizers
\ not @{
@{ [ dup node-successor #if? ] [ flip-branches ] }@
}@ define-optimizers
: disjoint-eq? ( node -- ? )
dup node-classes swap node-in-d
[ swap ?hash ] map-with
first2 2dup and [ classes-intersect? not ] [ 2drop f ] if ;
\ eq? {
{ [ dup disjoint-eq? ] [ [ f ] inline-literals ] }
} define-optimizers
\ eq? @{
@{ [ dup disjoint-eq? ] [ [ f ] inline-literals ] }@
}@ define-optimizers
! Arithmetic identities
SYMBOL: @

10
library/inference/dataflow.factor
View File

@ -48,10 +48,10 @@ M: node = eq? ;
: set-node-out-d node-shuffle set-shuffle-out-d ;
: set-node-out-r node-shuffle set-shuffle-out-r ;
: empty-node f { } { } { } { } ;
: param-node ( label) { } { } { } { } ;
: in-node ( inputs) >r f r> { } { } { } ;
: out-node ( outputs) >r f { } r> { } { } ;
: empty-node f @{ }@ @{ }@ @{ }@ @{ }@ ;
: param-node ( label) @{ }@ @{ }@ @{ }@ @{ }@ ;
: in-node ( inputs) >r f r> @{ }@ @{ }@ @{ }@ ;
: out-node ( outputs) >r f @{ }@ r> @{ }@ @{ }@ ;
: d-tail ( n -- list ) meta-d get tail* ;
: r-tail ( n -- list ) meta-r get tail* ;
@ -146,7 +146,7 @@ SYMBOL: current-node
[
dup node-in-d % dup node-out-d %
dup node-in-r % node-out-r %
] { } make ;
] @{ }@ make ;
: uses-value? ( value node -- ? ) node-values memq? ;

4
library/inference/inference.factor
View File

@ -25,12 +25,12 @@ M: inference-error error. ( error -- )
inference-error-rstate describe ;
M: value literal-value ( value -- )
{
@{
"A literal value was expected where a computed value was found.\n"
"This means the word you are inferring applies 'call' or 'execute'\n"
"to a value that is not known at compile time.\n"
"See the handbook for details."
} concat inference-error ;
}@ concat inference-error ;
! Word properties that affect inference:
! - infer-effect -- must be set. controls number of inputs

2
library/inference/known-words.factor
View File

@ -35,7 +35,7 @@ prettyprint ;
dup "infer-effect" word-prop consume/produce
[ [ t ] [ f ] if ] infer-quot ;
{ fixnum<= fixnum< fixnum>= fixnum> eq? } [
@{ fixnum<= fixnum< fixnum>= fixnum> eq? }@ [
dup dup literalize [ manual-branch ] cons
"infer" set-word-prop
] each

2
library/inference/shuffle.factor
View File

@ -3,7 +3,7 @@ USING: hashtables kernel math namespaces sequences ;
TUPLE: shuffle in-d in-r out-d out-r ;
: empty-shuffle { } { } { } { } <shuffle> ;
: empty-shuffle @{ }@ @{ }@ @{ }@ @{ }@ <shuffle> ;
: cut* ( seq1 seq2 -- seq seq ) [ head* ] 2keep tail* ;

40
library/inference/stack.factor
View File

@ -29,23 +29,23 @@ sequences words ;
[ shuffle>effect "infer-effect" set-word-prop ] 2keep
[ , \ infer-shuffle , ] [ ] make "infer" set-word-prop ;
{
{ drop << shuffle f 1 0 { } { } >> }
{ 2drop << shuffle f 2 0 { } { } >> }
{ 3drop << shuffle f 3 0 { } { } >> }
{ dup << shuffle f 1 0 { 0 0 } { } >> }
{ 2dup << shuffle f 2 0 { 0 1 0 1 } { } >> }
{ 3dup << shuffle f 3 0 { 0 1 2 0 1 2 } { } >> }
{ rot << shuffle f 3 0 { 1 2 0 } { } >> }
{ -rot << shuffle f 3 0 { 2 0 1 } { } >> }
{ dupd << shuffle f 2 0 { 0 0 1 } { } >> }
{ swapd << shuffle f 3 0 { 1 0 2 } { } >> }
{ nip << shuffle f 2 0 { 1 } { } >> }
{ 2nip << shuffle f 3 0 { 2 } { } >> }
{ tuck << shuffle f 2 0 { 1 0 1 } { } >> }
{ over << shuffle f 2 0 { 0 1 0 } { } >> }
{ pick << shuffle f 3 0 { 0 1 2 0 } { } >> }
{ swap << shuffle f 2 0 { 1 0 } { } >> }
{ >r << shuffle f 1 0 { } { 0 } >> }
{ r> << shuffle f 0 1 { 0 } { } >> }
} [ first2 define-shuffle ] each
@{
@{ drop << shuffle f 1 0 @{ }@ @{ }@ >> }@
@{ 2drop << shuffle f 2 0 @{ }@ @{ }@ >> }@
@{ 3drop << shuffle f 3 0 @{ }@ @{ }@ >> }@
@{ dup << shuffle f 1 0 @{ 0 0 }@ @{ }@ >> }@
@{ 2dup << shuffle f 2 0 @{ 0 1 0 1 }@ @{ }@ >> }@
@{ 3dup << shuffle f 3 0 @{ 0 1 2 0 1 2 }@ @{ }@ >> }@
@{ rot << shuffle f 3 0 @{ 1 2 0 }@ @{ }@ >> }@
@{ -rot << shuffle f 3 0 @{ 2 0 1 }@ @{ }@ >> }@
@{ dupd << shuffle f 2 0 @{ 0 0 1 }@ @{ }@ >> }@
@{ swapd << shuffle f 3 0 @{ 1 0 2 }@ @{ }@ >> }@
@{ nip << shuffle f 2 0 @{ 1 }@ @{ }@ >> }@
@{ 2nip << shuffle f 3 0 @{ 2 }@ @{ }@ >> }@
@{ tuck << shuffle f 2 0 @{ 1 0 1 }@ @{ }@ >> }@
@{ over << shuffle f 2 0 @{ 0 1 0 }@ @{ }@ >> }@
@{ pick << shuffle f 3 0 @{ 0 1 2 0 }@ @{ }@ >> }@
@{ swap << shuffle f 2 0 @{ 1 0 }@ @{ }@ >> }@
@{ >r << shuffle f 1 0 @{ }@ @{ 0 }@ >> }@
@{ r> << shuffle f 0 1 @{ 0 }@ @{ }@ >> }@
}@ [ first2 define-shuffle ] each

4
library/inference/words.factor
View File

@ -105,11 +105,11 @@ M: symbol apply-object ( word -- )
[ inferring-base-case off ] cleanup ;
: no-base-case ( word -- )
{
@{
"The base case of a recursive word could not be inferred.\n"
"This means the word calls itself in every control flow path.\n"
"See the handbook for details."
} concat inference-error ;
}@ concat inference-error ;
: notify-base-case ( -- )
base-case-continuation get

8
library/opengl/opengl-utils.factor
View File

@ -3,7 +3,7 @@
IN: opengl
USING: alien errors kernel math namespaces opengl sdl sequences ;
: gl-color ( { r g b a } -- ) first4 glColor4d ; inline
: gl-color ( @{ r g b a }@ -- ) first4 glColor4d ; inline
: init-gl ( -- )
0.0 0.0 0.0 0.0 glClearColor
@ -62,7 +62,7 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
: four-sides ( dim -- )
dup top-left dup top-right dup bottom-right bottom-left ;
: gl-line ( from to { r g b } -- )
: gl-line ( from to color -- )
gl-color [ gl-vertex ] 2apply ;
: gl-fill-rect ( dim -- )
@ -82,7 +82,7 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
#! Draw a filled polygon.
dup length 2 > GL_POLYGON GL_LINES ? (gl-poly) ;
: gl-poly ( points { r g b } -- )
: gl-poly ( points color -- )
#! Draw a polygon.
GL_LINE_LOOP (gl-poly) ;
@ -149,7 +149,7 @@ C: sprite ( loc dim dim2 -- )
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameterf
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameterf ;
: gl-translate ( { x y z } -- ) first3 glTranslatef ;
: gl-translate ( @{ x y z }@ -- ) first3 glTranslatef ;
: make-sprite-dlist ( sprite -- id )
GL_MODELVIEW [

4
library/sdl/sdl-keysym.factor
View File

@ -6,12 +6,12 @@ IN: sdl USING: namespaces ;
! Later, something better needs to be done.
: modifiers
{
@{
[[ "SHIFT" HEX: 0003 ]]
[[ "CTRL" HEX: 00c0 ]]
[[ "ALT" HEX: 0300 ]]
[[ "META" HEX: 0c00 ]]
} ;
}@ ;
: keysyms
{{

52
library/syntax/prettyprint.factor
View File

@ -27,7 +27,7 @@ global [
0 column set
0 indent set
0 last-newline set
0 line-count set
1 line-count set
string-limit off
] bind
@ -43,13 +43,6 @@ C: section ( length -- section )
[ set-section-start ] keep
0 over set-section-indent ;
: section-fits? ( section -- ? )
margin get dup 0 = [
2drop t
] [
>r section-end last-newline get - indent get + r> <=
] if ;
: line-limit? ( -- ? )
line-limit get dup [ line-count get <= ] when ;
@ -61,8 +54,8 @@ C: section ( length -- section )
drop
] [
last-newline set
line-count inc
line-limit? [ "..." write end-printing get continue ] when
line-count inc
"\n" write do-indent
] if ;
@ -109,6 +102,17 @@ C: block ( -- block )
dup section-nl-after?
[ section-end fresh-line ] [ drop ] if ;
: section-fits? ( section -- ? )
margin get dup 0 = [
2drop t
] [
line-limit? pick block? and [
2drop t
] [
>r section-end last-newline get - indent get + r> <=
] if
] if ;
: pprint-section ( section -- )
dup section-fits?
[ pprint-section* ] [ inset-section ] if ;
@ -171,13 +175,13 @@ GENERIC: pprint* ( obj -- )
: vocab-style ( vocab -- style )
{{
[[ "syntax" [ [[ foreground [ 128 128 128 ] ]] ] ]]
[[ "kernel" [ [[ foreground [ 0 0 128 ] ]] ] ]]
[[ "sequences" [ [[ foreground [ 128 0 0 ] ]] ] ]]
[[ "math" [ [[ foreground [ 0 128 0 ] ]] ] ]]
[[ "math-internals" [ [[ foreground [ 192 0 0 ] ]] ] ]]
[[ "kernel-internals" [ [[ foreground [ 192 0 0 ] ]] ] ]]
[[ "io-internals" [ [[ foreground [ 192 0 0 ] ]] ] ]]
[[ "syntax" [ [[ foreground @{ 0.5 0.5 0.5 1.0 }@ ]] ] ]]
[[ "kernel" [ [[ foreground @{ 0.0 0.0 0.5 1.0 }@ ]] ] ]]
[[ "sequences" [ [[ foreground @{ 0.5 0.0 0.0 1.0 }@ ]] ] ]]
[[ "math" [ [[ foreground @{ 0.0 0.5 0.0 1.0 }@ ]] ] ]]
[[ "math-internals" [ [[ foreground @{ 0.75 0.0 0.0 1.0 }@ ]] ] ]]
[[ "kernel-internals" [ [[ foreground @{ 0.75 0.0 0.0 1.0 }@ ]] ] ]]
[[ "io-internals" [ [[ foreground @{ 0.75 0.0 0.0 1.0 }@ ]] ] ]]
}} hash ;
: word-style ( word -- style )
@ -352,11 +356,11 @@ M: wrapper pprint* ( wrapper -- )
#! Examples are ] } }} ]] >> and so on.
t "pprint-close" set-word-prop ;
{
{ POSTPONE: [ POSTPONE: ] }
{ POSTPONE: { POSTPONE: } }
{ POSTPONE: @{ POSTPONE: }@ }
{ POSTPONE: {{ POSTPONE: }} }
{ POSTPONE: [[ POSTPONE: ]] }
{ POSTPONE: [[ POSTPONE: ]] }
} [ first2 define-close define-open ] each
@{
@{ POSTPONE: [ POSTPONE: ] }@
@{ POSTPONE: { POSTPONE: } }@
@{ POSTPONE: @{ POSTPONE: }@ }@
@{ POSTPONE: {{ POSTPONE: }} }@
@{ POSTPONE: [[ POSTPONE: ]] }@
@{ POSTPONE: [[ POSTPONE: ]] }@
}@ [ first2 define-close define-open ] each

2
library/test/collections/strings.factor
View File

@ -73,7 +73,7 @@ unit-test
[ f ] [ [ 0 10 "hello" subseq ] catch not ] unit-test
[ { "hell" "o wo" "rld" } ] [ 4 "hello world" group ] unit-test
[ @{ "hell" "o wo" "rld" }@ ] [ 4 "hello world" group ] unit-test
[ 4 ] [
0 "There are Four Upper Case characters"

3
library/test/files.factor
View File

@ -1,11 +1,8 @@
IN: temporary
USE: io
USE: httpd
USE: lists
USE: test
[ "txt" ] [ "foo.txt" file-extension ] unit-test
[ f ] [ "foobar" file-extension ] unit-test
[ "txt" ] [ "foo.bar.txt" file-extension ] unit-test
[ "text/plain" ] [ "foo.bar.txt" mime-type ] unit-test
[ "text/html" ] [ "index.html" mime-type ] unit-test

8
library/test/gadgets/rectangles.factor
View File

@ -4,28 +4,28 @@ USING: gadgets kernel namespaces test ;
[
<< rect f @{ 10 10 0 }@ @{ 50 50 0 }@ >>
<< rect f @{ -10 -10 0 }@ @{ 40 40 0 }@ >>
intersect-rect
rect-intersect
] unit-test
[ << rect f @{ 200 200 0 }@ @{ 0 0 0 }@ >> ]
[
<< rect f @{ 100 100 0 }@ @{ 50 50 0 }@ >>
<< rect f @{ 200 200 0 }@ @{ 40 40 0 }@ >>
intersect-rect
rect-intersect
] unit-test
[ << rect f @{ -10 -10 0 }@ @{ 70 70 0 }@ >> ]
[
<< rect f @{ 10 10 0 }@ @{ 50 50 0 }@ >>
<< rect f @{ -10 -10 0 }@ @{ 40 40 0 }@ >>
union-rect
rect-union
] unit-test
[ << rect f @{ 100 100 0 }@ @{ 140 140 0 }@ >> ]
[
<< rect f @{ 100 100 0 }@ @{ 50 50 0 }@ >>
<< rect f @{ 200 200 0 }@ @{ 40 40 0 }@ >>
union-rect
rect-union
] unit-test
[ f ] [

13
library/test/lists/assoc.factor
View File

@ -28,16 +28,3 @@ USE: test
[[ "two" 2 ]]
[[ "four" 4 ]]
] "value-alist" set
[
[ "one" + ]
[ "three" - ]
[ "four" * ]
] "quot-alist" set
[ 8 ] [ 1 "value-alist" get "quot-alist" get assoc-apply ] unit-test
[ 1 ] [ 1 "value-alist" get f assoc-apply ] unit-test
[ [ [ "one" + ] [ "four" * ] ] ] [
"three" "quot-alist" get remove-assoc
] unit-test

2
library/test/math/integer.factor
View File

@ -60,8 +60,6 @@ USING: kernel math prettyprint test ;
[ t ] [ 123 124 verify-gcd ] unit-test
[ t ] [ 50 120 verify-gcd ] unit-test
[ 3 ] [ 5 7 mod-inv ] unit-test
[ 78572682077 ] [ 234829342 342389423843 mod-inv ] unit-test
[ -1 ] [ -1 >bignum >fixnum ] unit-test

12
library/test/test.factor
View File

@ -73,7 +73,7 @@ SYMBOL: failures
prepare-tests [ test ] subset terpri passed. failed. ;
: tests
{
@{
"lists/cons" "lists/lists" "lists/assoc"
"lists/namespaces"
"combinators"
@ -94,24 +94,24 @@ SYMBOL: failures
"gadgets/frames" "memory"
"redefine" "annotate" "binary" "inspector"
"kernel"
} run-tests ;
}@ run-tests ;
: benchmarks
{
@{
"benchmark/empty-loop" "benchmark/fac"
"benchmark/fib" "benchmark/sort"
"benchmark/continuations" "benchmark/ack"
"benchmark/hashtables" "benchmark/strings"
"benchmark/vectors" "benchmark/prettyprint"
"benchmark/image"
} run-tests ;
}@ run-tests ;
: compiler-tests
{
@{
"io/buffer" "compiler/optimizer"
"compiler/simple"
"compiler/stack" "compiler/ifte"
"compiler/generic" "compiler/bail-out"
"compiler/linearizer" "compiler/intrinsics"
"compiler/identities"
} run-tests ;
}@ run-tests ;

2
library/tools/describe.factor
View File

@ -18,7 +18,7 @@ M: real summary
M: complex summary
"a complex number in the "
swap quadrant { "first" "second" "fourth" "third" } nth
swap quadrant @{ "first" "second" "fourth" "third" }@ nth
" quadrant" append3 ;
GENERIC: sheet ( obj -- sheet )

2
library/tools/memory.factor
View File

@ -88,7 +88,7 @@ M: object each-slot ( obj quot -- )
num-types zero-array num-types zero-array
[ >r 2dup r> heap-stat-step ] each-object ;
: heap-stat. ( { instances bytes type } -- )
: heap-stat. ( @{ instances bytes type }@ -- )
dup first 0 = [
dup third type>class pprint ": " write
dup second pprint " bytes, " write

2
library/tools/walker.factor
View File

@ -15,7 +15,7 @@ prettyprint sequences io strings vectors words ;
: meta-r*
#! Stepper call stack, as well as the currently
#! executing quotation.
[ meta-r get % meta-executing get , meta-cf get , ] { } make ;
[ meta-r get % meta-executing get , meta-cf get , ] @{ }@ make ;
: &r
#! Print stepper call stack, as well as the currently

2
library/ui/books.factor
View File

@ -44,7 +44,7 @@ TUPLE: book-browser book ;
arrow-left [ prev-page ] <book-button> ,
arrow-right [ next-page ] <book-button> ,
arrow-right| [ last-page ] <book-button> ,
] { } make make-shelf ;
] @{ }@ make make-shelf ;
C: book-browser ( book -- gadget )
dup delegate>frame

2
library/ui/presentations.factor
View File

@ -47,7 +47,7 @@ M: command-button gadget-help ( button -- string )
font-size swap assoc [ 12 ] unless* 3array ;
: <styled-label> ( style text -- label )
<label> foreground pick assoc over set-label-text
<label> foreground pick assoc [ over set-label-color ] when*
swap style-font over set-label-font ;
: <presentation> ( style text -- presentation )

2
library/ui/scrolling.factor
View File

@ -11,7 +11,7 @@ TUPLE: viewport ;
! The follows slot is set by scroll-to.
TUPLE: scroller viewport x y follows ;
: scroller-origin ( scroller -- { x y 0 } )
: scroller-origin ( scroller -- @{ x y 0 }@ )
dup scroller-x slider-value
swap scroller-y slider-value
0 3array ;

4
library/ui/splitters.factor
View File

@ -46,12 +46,12 @@ C: splitter ( first second split vector -- splitter )
dup splitter-split swap rect-dim
n*v [ >fixnum ] map divider-size 1/2 v*n v- ;
: splitter-layout ( splitter -- { a b c } )
: splitter-layout ( splitter -- @{ a b c }@ )
[
dup splitter-part ,
divider-size ,
dup rect-dim divider-size v- swap splitter-part v- ,
] { } make ;
] @{ }@ make ;
M: splitter layout* ( splitter -- )
dup splitter-layout packed-layout ;

4
library/ui/theme.factor
View File

@ -43,7 +43,7 @@ USING: arrays gadgets kernel sequences styles ;
}@ >> ;
: faint-boundary
<< solid f @{ 0.62 0.62 0.62 1.0 }@ >> swap set-gadget-boundary ;
<< solid f @{ 0.62 0.62 0.62 0.8 }@ >> swap set-gadget-boundary ;
: bevel-button-theme ( gadget -- )
plain-gradient rollover-gradient pressed-gradient
@ -55,7 +55,7 @@ USING: arrays gadgets kernel sequences styles ;
: roll-button-theme ( button -- )
f solid-black solid-black <button-paint> over set-gadget-boundary
f f << solid f @{ 0.92 0.9 0.9 1.0 }@ >> <button-paint> swap set-gadget-interior ;
f f pressed-gradient <button-paint> swap set-gadget-interior ;
: caret-theme ( caret -- )
<< solid f @{ 1.0 0.0 0.0 1.0 }@ >> swap set-gadget-interior ;

8
library/words.factor
View File

@ -50,7 +50,7 @@ SYMBOL: crossref
: usages ( word -- deps )
#! List all usages of a word. This is a transitive closure,
#! so indirect usages are reported.
crossref get dup [ closure ] [ 2drop { } ] if ;
crossref get dup [ closure ] [ 2drop @{ }@ ] if ;
: usage ( word -- list )
#! List all direct usages of a word.
@ -109,13 +109,13 @@ M: compound definer drop \ : ;
[ f swap set-word-prop ] each-with ;
: reset-word ( word -- )
{
@{
"parsing" "inline" "foldable" "flushable" "predicating"
"documentation" "stack-effect"
} reset-props ;
}@ reset-props ;
: reset-generic ( word -- )
dup reset-word { "methods" "combination" } reset-props ;
dup reset-word @{ "methods" "combination" }@ reset-props ;
M: word literalize <wrapper> ;