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

Get all of contrib/ and examples/ to load

slava 2006-11-13 05:16:22 +00:00
parent d616521fb5
commit c77ce5cbd2
24 changed files with 120 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.FACTOR.txt
View File

@ -1,3 +1,5 @@
- workspace window takes too long to come up
+ 0.87:
- live search: timer delay would be nice
@ -45,6 +47,7 @@
+ compiler/ffi:
- recompile get/set/>n/n>/ndrop if needed
- %allot-bignum-signed-2 is broken on both platforms
- cross-word type inference
- callback scheduling issue

19
contrib/coroutines.factor → contrib/coroutines/coroutines.factor
View File

@ -52,22 +52,3 @@ TUPLE: coroutine resumecc exitcc ;
over set-coroutine-resumecc
coroutine-exitcc continue-with
] callcc1 rot drop ;
USE: prettyprint
USE: sequences
: test1 ( list -- co )
[ swap [ over coyield 2drop ] each f swap coyield ] cocreate ;
: test2 ( -- co )
[ 1 over coyield drop 2 over coyield drop 3 over coyield ] cocreate ;
test2 f swap coresume . f swap coresume . f swap coresume . drop
: test3 ( -- co )
[ [ 1 2 3 ] [ over coyield drop ] each ] cocreate ;
test3 f swap coresume . f swap coresume . f swap coresume . drop
PROVIDE: contrib/coroutines ;

3
contrib/coroutines/load.factor Normal file
View File

@ -0,0 +1,3 @@
PROVIDE: contrib/coroutines
{ +files+ { "coroutines.factor" } }
{ +tests+ { "tests.factor" } } ;

15
contrib/coroutines/tests.factor Normal file
View File

@ -0,0 +1,15 @@
IN: temporary
USING: coroutines kernel sequences prettyprint ;
: test1 ( list -- co )
[ swap [ over coyield 2drop ] each f swap coyield ] cocreate ;
: test2 ( -- co )
[ 1 over coyield drop 2 over coyield drop 3 over coyield ] cocreate ;
test2 f swap coresume . f swap coresume . f swap coresume . drop
: test3 ( -- co )
[ [ 1 2 3 ] [ over coyield drop ] each ] cocreate ;
test3 f swap coresume . f swap coresume . f swap coresume . drop

2
contrib/lazy-lists/lazy.factor
View File

@ -8,7 +8,7 @@ IN: lazy-lists
stack-effect dup [
nip effect-in length
] [
drop infer first
drop infer effect-in length nip
] if ;
: make-lazy-quot ( word quot -- quot )

3
contrib/splay-trees/load.factor Normal file
View File

@ -0,0 +1,3 @@
PROVIDE: contrib/splay-trees
{ +files+ { "splay-trees.factor" } }
{ +tests+ { "tests.factor" } } ;

8
contrib/splay-trees.factor → contrib/splay-trees/splay-trees.factor
View File

@ -107,11 +107,3 @@ DEFER: (splay)
: remove-splay ( key tree -- )
dup splay-tree-r [ (remove-splay) ] [ 2drop ] if ;
USING: namespaces words ;
<splay-tree> "foo" set
all-words [ dup word-name "foo" get set-splay ] each
all-words [ word-name "foo" get get-splay drop ] each
PROVIDE: contrib/splay-trees ;

5
contrib/splay-trees/tests.factor Normal file
View File

@ -0,0 +1,5 @@
USING: splay-trees namespaces sequences kernel namespaces words ;
<splay-tree> "foo" set
all-words [ dup word-name "foo" get set-splay ] each
all-words [ word-name "foo" get get-splay drop ] each

4
examples/factorbot.factor
View File

@ -32,7 +32,7 @@ SYMBOL: receiver
: join ( chan -- )
"JOIN " irc-write irc-print ;
GENERIC: handle-irc
GENERIC: handle-irc ( line -- )
PREDICATE: string privmsg " " split1 nip "PRIVMSG" head? ;
PREDICATE: string ping "PING" head? ;
@ -112,3 +112,5 @@ IN: factorbot-commands
drop speaker get "slava" = [ disconnect ] when ;
PROVIDE: examples/factorbot ;
MAIN: examples/factorbot factorbot ;

4
examples/lcd.factor
View File

@ -13,6 +13,6 @@ USING: sequences kernel math io ;
: lcd ( digit-str -- )
3 [ 2dup lcd-row terpri ] repeat drop ;
"31337" lcd
PROVIDE: examples/lcd ;
MAIN: examples/lcd "31337" lcd ;

12
examples/levenshtein.factor → examples/levenshtein/levenshtein.factor
View File

@ -1,7 +1,6 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays compiler help io kernel math namespaces sequences
test words ;
USING: arrays help io kernel math namespaces sequences words ;
IN: levenshtein
: <matrix> ( m n -- matrix )
@ -44,12 +43,7 @@ SYMBOL: costs
swap [ swap levenshtein-step ] each-with
] each-with
levenshtein-result
] with-scope ; compiled
[ 3 ] [ "sitting" "kitten" levenshtein ] unit-test
[ 3 ] [ "kitten" "sitting" levenshtein ] unit-test
[ 1 ] [ "freshpak" "freshpack" levenshtein ] unit-test
[ 1 ] [ "freshpack" "freshpak" levenshtein ] unit-test
] with-scope ;
: fancy-apropos ( str -- )
all-words
@ -59,5 +53,3 @@ SYMBOL: costs
second [ word-name ] keep [ help ] write-outliner
terpri
] each ;
PROVIDE: examples/levenshtein ;

3
examples/levenshtein/load.factor Normal file
View File

@ -0,0 +1,3 @@
PROVIDE: examples/levenshtein
{ +files+ { "levenshtein.factor" } }
{ +tests+ { "tests.factor" } } ;

9
examples/levenshtein/tests.factor Normal file
View File

@ -0,0 +1,9 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: levenshtein
USING: test ;
[ 3 ] [ "sitting" "kitten" levenshtein ] unit-test
[ 3 ] [ "kitten" "sitting" levenshtein ] unit-test
[ 1 ] [ "freshpak" "freshpack" levenshtein ] unit-test
[ 1 ] [ "freshpack" "freshpak" levenshtein ] unit-test

8
examples/mandel/load.factor Normal file
View File

@ -0,0 +1,8 @@
PROVIDE: examples/mandel
{ +files+ { "mandel.factor" } }
{ +tests+ { "tests.factor" } } ;
USE: mandel
USE: test
MAIN: examples/mandel [ "mandel.pnm" run>file ] time ;

41
examples/mandel.factor → examples/mandel/mandel.factor
View File

@ -11,7 +11,7 @@ strings test ;
: nb-iter 40 ; inline
: center -0.65 ; inline
: f_ ( h s v i -- f ) >r swap rot >r 2dup r> 6 * r> - ;
: f_ >r swap rot >r 2dup r> 6 * r> - ;
: p ( v s x -- v p x ) >r dupd neg 1 + * r> ;
: q ( v s f -- q ) * neg 1 + * ;
: t_ ( v s f -- t_ ) neg 1 + * neg 1 + * ;
@ -24,37 +24,14 @@ strings test ;
: hsv>rgb ( h s v -- r g b )
pick 6 * >fixnum {
[ f_ t_ p swap ( v p t ) ]
[ f_ q p -rot ( q v p ) ]
[ f_ t_ p swapd ( p v t ) ]
[ f_ q p rot ( p q v ) ]
[ f_ t_ p swap rot ( t p v ) ]
[ f_ q p ( v p q ) ]
[ f_ t_ p swap ] ! v p t
[ f_ q p -rot ] ! q v p
[ f_ t_ p swapd ] ! p v t
[ f_ q p rot ] ! p q v
[ f_ t_ p swap rot ] ! t p v
[ f_ q p ] ! v p q
} mod-cond ;
[ 1/2 1/2 1/2 ] [ 0 0 1/2 hsv>rgb ] unit-test
[ 1/2 1/4 1/4 ] [ 0 1/2 1/2 hsv>rgb ] unit-test
[ 1/3 2/9 2/9 ] [ 0 1/3 1/3 hsv>rgb ] unit-test
[ 24/125 1/5 4/25 ] [ 1/5 1/5 1/5 hsv>rgb ] unit-test
[ 29/180 1/6 5/36 ] [ 1/5 1/6 1/6 hsv>rgb ] unit-test
[ 6/25 2/5 38/125 ] [ 2/5 2/5 2/5 hsv>rgb ] unit-test
[ 8/25 4/5 64/125 ] [ 2/5 3/5 4/5 hsv>rgb ] unit-test
[ 6/25 48/125 3/5 ] [ 3/5 3/5 3/5 hsv>rgb ] unit-test
[ 0 0 0 ] [ 3/5 1/5 0 hsv>rgb ] unit-test
[ 84/125 4/25 4/5 ] [ 4/5 4/5 4/5 hsv>rgb ] unit-test
[ 7/15 1/3 1/2 ] [ 4/5 1/3 1/2 hsv>rgb ] unit-test
[ 5/6 5/36 5/6 ] [ 5/6 5/6 5/6 hsv>rgb ] unit-test
[ 1/6 0 1/6 ] [ 5/6 1 1/6 hsv>rgb ] unit-test
[ 1 0 0 ] [ 1 1 1 hsv>rgb ] unit-test
[ 1/6 1/9 1/9 ] [ 1 1/3 1/6 hsv>rgb ] unit-test
: scale 255 * >fixnum ; inline
: scale-rgb ( r g b -- n )
@ -113,7 +90,3 @@ SYMBOL: cols
: run>file ( file -- )
"Generating " write dup write "..." print
<file-writer> [ run write ] with-stream ;
[ "mandel.pnm" run>file ] time
PROVIDE: examples/mandel ;

25
examples/mandel/tests.factor Normal file
View File

@ -0,0 +1,25 @@
IN: mandel
USE: test
[ 1/2 1/2 1/2 ] [ 0 0 1/2 hsv>rgb ] unit-test
[ 1/2 1/4 1/4 ] [ 0 1/2 1/2 hsv>rgb ] unit-test
[ 1/3 2/9 2/9 ] [ 0 1/3 1/3 hsv>rgb ] unit-test
[ 24/125 1/5 4/25 ] [ 1/5 1/5 1/5 hsv>rgb ] unit-test
[ 29/180 1/6 5/36 ] [ 1/5 1/6 1/6 hsv>rgb ] unit-test
[ 6/25 2/5 38/125 ] [ 2/5 2/5 2/5 hsv>rgb ] unit-test
[ 8/25 4/5 64/125 ] [ 2/5 3/5 4/5 hsv>rgb ] unit-test
[ 6/25 48/125 3/5 ] [ 3/5 3/5 3/5 hsv>rgb ] unit-test
[ 0 0 0 ] [ 3/5 1/5 0 hsv>rgb ] unit-test
[ 84/125 4/25 4/5 ] [ 4/5 4/5 4/5 hsv>rgb ] unit-test
[ 7/15 1/3 1/2 ] [ 4/5 1/3 1/2 hsv>rgb ] unit-test
[ 5/6 5/36 5/6 ] [ 5/6 5/6 5/6 hsv>rgb ] unit-test
[ 1/6 0 1/6 ] [ 5/6 1 1/6 hsv>rgb ] unit-test
[ 1 0 0 ] [ 1 1 1 hsv>rgb ] unit-test
[ 1/6 1/9 1/9 ] [ 1 1/3 1/6 hsv>rgb ] unit-test

3
examples/print-dataflow/load.factor Normal file
View File

@ -0,0 +1,3 @@
PROVIDE: examples/print-dataflow
{ +files+ { "print-dataflow.factor" } }
{ +tests+ { "tests.factor" } } ;

10
examples/print-dataflow.factor → examples/print-dataflow/print-dataflow.factor
View File

@ -1,7 +1,7 @@
IN: print-dataflow
USING: generic hashtables inference io kernel kernel-internals
math namespaces prettyprint sequences styles vectors words
test optimizer ;
optimizer ;
! A simple tool for turning dataflow IR into quotations, for
! debugging purposes.
@ -83,11 +83,3 @@ M: object node>quot dup class word-name comment, ;
#! Print dataflow IR for a quotation. Flag indicates if
#! annotations should be printed or not.
>r dataflow optimize r> dataflow>quot . ;
[ ] [ [ 2 ] t dataflow. ] unit-test
[ ] [ [ 3 + ] t dataflow. ] unit-test
[ ] [ [ drop ] t dataflow. ] unit-test
[ ] [ [ [ sq ] [ abs ] if ] t dataflow. ] unit-test
[ ] [ [ { [ sq ] [ abs ] } dispatch ] t dataflow. ] unit-test
[ ] [ \ unify-values word-def t dataflow. ] unit-test
[ ] [ [ 0 0 / ] t dataflow. ] unit-test

9
examples/print-dataflow/tests.factor Normal file
View File

@ -0,0 +1,9 @@
IN: print-dataflow
[ ] [ [ 2 ] t dataflow. ] unit-test
[ ] [ [ 3 + ] t dataflow. ] unit-test
[ ] [ [ drop ] t dataflow. ] unit-test
[ ] [ [ [ sq ] [ abs ] if ] t dataflow. ] unit-test
[ ] [ [ { [ sq ] [ abs ] } dispatch ] t dataflow. ] unit-test
[ ] [ \ unify-values word-def t dataflow. ] unit-test
[ ] [ [ 0 0 / ] t dataflow. ] unit-test

4
examples/raytracer.factor
View File

@ -161,6 +161,6 @@ DEFER: create ( level c r -- scene )
"Generating " write dup write "..." print
<file-writer> [ run write ] with-stream ;
[ "raytracer.pnm" run>file ] time
PROVIDE: examples/raytracer ;
MAIN: examples/raytracer [ "raytracer.pnm" run>file ] time ;

18
examples/turing.factor
View File

@ -1,5 +1,5 @@
IN: turing
USING: arrays hashtables io kernel lists math namespaces
USING: arrays hashtables io kernel math namespaces
prettyprint sequences strings vectors words ;
! A turing machine simulator.
@ -14,12 +14,12 @@ SYMBOL: halt
! This is a simple program that outputs 5 1's
H{
{ [[ 1 0 ]] T{ state f 1 1 2 } }
{ [[ 2 0 ]] T{ state f 1 1 3 } }
{ [[ 3 0 ]] T{ state f 1 -1 1 } }
{ [[ 1 1 ]] T{ state f 1 -1 2 } }
{ [[ 2 1 ]] T{ state f 1 -1 3 } }
{ [[ 3 1 ]] T{ state f 1 -1 halt } }
{ { 1 0 } T{ state f 1 1 2 } }
{ { 2 0 } T{ state f 1 1 3 } }
{ { 3 0 } T{ state f 1 -1 1 } }
{ { 1 1 } T{ state f 1 -1 2 } }
{ { 2 1 } T{ state f 1 -1 3 } }
{ { 3 1 } T{ state f 1 -1 halt } }
} states set
! Current state
@ -50,7 +50,7 @@ SYMBOL: tape
: next-state ( -- state )
#! Look up the next state/symbol/direction triplet.
state get sym cons states get hash ;
state get sym 2array states get hash ;
: turing-step ( -- )
#! Do one step of the turing machine.
@ -63,7 +63,7 @@ SYMBOL: tape
#! Print current turing machine state.
state get .
tape get .
2 position get 2 * + CHAR: \s fill write "^" print ;
2 position get 2 * + CHAR: \s <string> write "^" print ;
: n
#! Do one step and print new state.

2
library/compiler/inference/inference.factor
View File

@ -96,7 +96,7 @@ TUPLE: too-many-r> ;
] when ;
: undo-infer ( -- )
recorded get [ "infer" word-prop not ] subset [
recorded get [ custom-infer? not ] subset [
dup
f "inferred-vars" set-word-prop
f "inferred-effect" set-word-prop

4
library/tools/completion.factor
View File

@ -62,8 +62,8 @@ USING: kernel arrays sequences math namespaces strings io ;
[ swap call dup rot fuzzy score ] keep swap 2array
] if ; inline
: completions ( str candidates quot -- seq )
pick empty? pick length 100 >= and [
: completions ( str quot candidates -- seq )
pick empty? over length 100 >= and [
3drop f
] [
[ >r 2dup r> completion ] map 2nip rank-completions

5
library/words.factor
View File

@ -79,10 +79,13 @@ SYMBOL: crossref
: reset-props ( word seq -- ) [ remove-word-prop ] each-with ;
: custom-infer? ( word -- ? )
dup "infer" word-prop swap "infer-vars" word-prop or ;
: unxref-word* ( word -- )
{
{ [ dup compound? not ] [ drop ] }
{ [ dup "infer" word-prop ] [ drop ] }
{ [ dup custom-infer? ] [ drop ] }
{ [ t ] [
dup changed-word
{