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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-06-30 16:06:30 -05:00
parent 58159095ee ed243f21a5
commit 6165c86229
16 changed files with 83 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
extra/bake/bake.factor
View File

@ -1,61 +1,59 @@
USING: kernel parser namespaces quotations arrays vectors strings
sequences assocs classes.tuple math combinators ;
USING: kernel parser combinators sequences splitting quotations arrays macros
arrays.lib combinators.cleave combinators.conditional newfx ;
IN: bake
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: insert-quot expr ;
SYMBOL: ,
SYMBOL: @
C: <insert-quot> insert-quot
: ,[ \ ] [ >quotation <insert-quot> ] parse-literal ; parsing
: comma? ( obj -- ? ) , = ;
: atsym? ( obj -- ? ) @ = ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: splice-quot expr ;
DEFER: [bake-array]
C: <splice-quot> splice-quot
: %[ \ ] [ >quotation <splice-quot> ] parse-literal ; parsing
: broil-element ( obj -- quot )
{
{ [ comma? ] [ drop [ >r ] ] }
{ [ array? ] [ [bake-array] [ >r ] append ] }
{ [ drop t ] [ [ >r ] prefix-on ] }
}
1cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: ,u ( seq -- seq ) unclip building get push ;
: [broil] ( array -- quot )
[ reverse [ broil-element ] map concat ]
[ length [ drop [ r> ] ] map concat ]
[ length [ narray ] prefix-on ]
tri append append
>quotation ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: exemplar
: [simmer] ( array -- quot )
: reset-building ( -- ) 1024 <vector> building set ;
{ @ } split reverse
[ [ [bake-array] [ append ] append [ >r ] append ] map concat ]
[ length [ drop [ r> append ] ] map concat ]
bi
: save-exemplar ( seq -- seq ) dup exemplar set ;
>r 2 head* [ >r ] append r> ! remove the last append
: finish-baking ( -- seq ) building get exemplar get like ;
[ { } ] swap append
DEFER: bake
: bake-item ( item -- )
{ { [ dup \ , = ] [ drop , ] }
{ [ dup \ % = ] [ drop % ] }
{ [ dup \ ,u = ] [ drop ,u ] }
{ [ dup insert-quot? ] [ insert-quot-expr call , ] }
{ [ dup splice-quot? ] [ splice-quot-expr call % ] }
{ [ dup integer? ] [ , ] }
{ [ dup string? ] [ , ] }
{ [ dup tuple? ] [ tuple>array bake >tuple , ] }
{ [ dup assoc? ] [ [ >alist bake ] keep assoc-like , ] }
{ [ dup sequence? ] [ bake , ] }
{ [ t ] [ , ] } }
cond ;
: bake-items ( seq -- ) [ bake-item ] each ;
: bake ( seq -- seq )
[ reset-building save-exemplar bake-items finish-baking ] with-scope ;
append ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing
: [bake-array] ( array -- quot ) [ @ member? ] [ [simmer] ] [ [broil] ] 1if ;
MACRO: bake-array ( array -- quot ) [bake-array] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: `{ \ } [ >array ] parse-literal \ bake-array parsed ; parsing

2
extra/builder/release/release.factor
View File

@ -1,7 +1,7 @@
USING: kernel debugger system namespaces sequences splitting combinators
io io.files io.launcher prettyprint bootstrap.image
bake combinators.cleave
combinators.cleave
builder.util
builder.common
builder.release.branch

2
extra/builder/util/util.factor
View File

@ -6,7 +6,7 @@ USING: kernel words namespaces classes parser continuations
combinators sequences splitting quotations arrays strings tools.time
sequences.deep accessors assocs.lib
io.encodings.utf8
combinators.cleave bake calendar calendar.format ;
combinators.cleave calendar calendar.format ;
IN: builder.util

17
extra/combinators/conditional/conditional.factor Normal file
View File

@ -0,0 +1,17 @@
USING: kernel combinators sequences macros fry newfx combinators.cleave ;
IN: combinators.conditional
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: 1cond ( tbl -- )
[ [ 1st [ dup ] prepend ] [ 2nd ] bi {2} ] map
[ cond ] prefix-on ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

2
extra/io/unix/linux/monitors/monitors-tests.factor
View File

@ -15,7 +15,7 @@ threads calendar prettyprint destructors io.timeouts ;
[ t ] [
"m" get next-change drop
[ "." = ] [ "monitor-test-self" temp-file = ] bi or
[ "" = ] [ "monitor-test-self" temp-file = ] bi or
] unit-test
[ ] [ "m" get dispose ] unit-test

6
extra/newfx/newfx.factor
View File

@ -195,4 +195,8 @@ METHOD: as-mutate { object object assoc } set-at ;
: adjoin ( seq elt -- seq ) over sets:adjoin ;
: adjoin-on ( elt seq -- seq ) tuck sets:adjoin ;
: adjoined ( set elt -- ) swap sets:adjoin ;
: adjoined-on ( elt set -- ) sets:adjoin ;
: adjoined-on ( elt set -- ) sets:adjoin ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: start ( seq subseq -- i ) swap sequences:start ;

6
extra/random-weighted/random-weighted.factor
View File

@ -1,6 +1,6 @@
USING: kernel namespaces arrays quotations sequences assocs combinators
mirrors math math.vectors random macros bake ;
mirrors math math.vectors random macros fry ;
IN: random-weighted
@ -16,5 +16,5 @@ probabilities layers [ 1000 * ] map 1000 random [ > ] curry find drop ;
dup [ second ] map swap [ first ] map random-weighted swap nth ;
MACRO: call-random-weighted ( exp -- )
[ keys ] [ values <enum> >alist ] bi swap
[ , random-weighted , case ] bake ;
[ keys ] [ values <enum> >alist ] bi
'[ , random-weighted , case ] ;

3
extra/raptor/raptor.factor
View File

@ -1,5 +1,6 @@
USING: kernel parser namespaces threads arrays sequences unix unix.process bake ;
USING: kernel parser namespaces threads arrays sequences unix unix.process
bake ;
IN: raptor

7
extra/rewrite-closures/rewrite-closures.factor
View File

@ -14,8 +14,11 @@ IN: rewrite-closures
\ set-parameters [ [set-parameters] ] 1 define-transform
: parametric-quot ( parameters quot -- quot )
[ [ swap ] set-parameters [ ] call ] make* ;
! : parametric-quot ( parameters quot -- quot )
! [ [ swap ] set-parameters [ ] call ] make* ;
: parametric-quot ( parameters quot -- quot ) '[ , set-parameters , call ] ;
: scoped-quot ( quot -- quot ) [ with-scope ] curry ;

6
extra/size-of/size-of.factor
View File

@ -12,15 +12,15 @@ IN: size-of
VAR: headers
: include-headers ( -- seq )
headers> [ { "#include <" , ">" } bake to-string ] map ;
headers> [ `{ "#include <" , ">" } to-string ] map ;
: size-of-c-program ( type -- lines )
{
`{
"#include <stdio.h>"
include-headers
{ "main() { printf( \"%i\" , sizeof( " , " ) ) ; }" }
}
bake to-strings ;
to-strings ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

2
extra/springies/models/2x2snake/2x2snake.factor
View File

@ -1,6 +1,6 @@
USING: kernel namespaces arrays sequences threads math math.vectors
ui random bake springies springies.ui ;
ui random springies springies.ui ;
IN: springies.models.2x2snake

8
extra/springies/models/3snake/3snake.factor
View File

@ -1,5 +1,5 @@
USING: kernel namespaces arrays sequences threads math ui random bake
USING: kernel namespaces arrays sequences threads math ui random fry
springies springies.ui ;
IN: springies.models.3snake
@ -158,8 +158,10 @@ times
;
: go* ( quot -- )
[ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
! : go* ( quot -- )
! [ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
: go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;
! : go ( -- ) [ [ springies-window* 1000 sleep model ] with-scope ] with-ui ;

2
extra/springies/models/belt-tire/belt-tire.factor
View File

@ -1,5 +1,5 @@
USING: kernel namespaces arrays sequences threads math ui random bake
USING: kernel namespaces arrays sequences threads math ui random
springies springies.ui ;
IN: springies.models.belt-tire

2
extra/springies/models/nifty/nifty.factor
View File

@ -1,6 +1,6 @@
USING: kernel namespaces arrays sequences threads math math.vectors
ui random bake springies springies.ui ;
ui random springies springies.ui ;
IN: springies.models.nifty

2
extra/springies/models/urchin/urchin.factor
View File

@ -1,6 +1,6 @@
USING: kernel namespaces arrays sequences threads math math.vectors
ui random bake
ui random
springies springies.ui ;
IN: springies.models.urchin

5
extra/springies/ui/ui.factor
View File

@ -1,7 +1,7 @@
USING: kernel namespaces threads sequences math math.vectors
opengl.gl opengl colors ui ui.gadgets ui.gadgets.slate
bake rewrite-closures vars springies ;
fry rewrite-closures vars springies ;
IN: springies.ui
@ -62,5 +62,4 @@ DEFER: maybe-loop
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: go* ( quot -- )
[ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
: go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;