diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 987122f05c..7a12a3cc97 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -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 - -: ,[ \ ] [ >quotation ] parse-literal ; parsing +: comma? ( obj -- ? ) , = ; +: atsym? ( obj -- ? ) @ = ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: splice-quot expr ; +DEFER: [bake-array] -C: splice-quot - -: %[ \ ] [ >quotation ] 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 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 \ No newline at end of file diff --git a/extra/builder/release/release.factor b/extra/builder/release/release.factor index 8f4c0e30f5..28ce3e8b35 100644 --- a/extra/builder/release/release.factor +++ b/extra/builder/release/release.factor @@ -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 diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor index db3b476365..320f0e0448 100644 --- a/extra/builder/util/util.factor +++ b/extra/builder/util/util.factor @@ -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 diff --git a/extra/combinators/conditional/conditional.factor b/extra/combinators/conditional/conditional.factor new file mode 100644 index 0000000000..cb27ef3f55 --- /dev/null +++ b/extra/combinators/conditional/conditional.factor @@ -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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/extra/io/unix/linux/monitors/monitors-tests.factor b/extra/io/unix/linux/monitors/monitors-tests.factor index 923bfaa890..c71b053919 100644 --- a/extra/io/unix/linux/monitors/monitors-tests.factor +++ b/extra/io/unix/linux/monitors/monitors-tests.factor @@ -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 diff --git a/extra/newfx/newfx.factor b/extra/newfx/newfx.factor index 37c738cd6a..b59e204e0c 100644 --- a/extra/newfx/newfx.factor +++ b/extra/newfx/newfx.factor @@ -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 ; \ No newline at end of file +: adjoined-on ( elt set -- ) sets:adjoin ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: start ( seq subseq -- i ) swap sequences:start ; \ No newline at end of file diff --git a/extra/random-weighted/random-weighted.factor b/extra/random-weighted/random-weighted.factor index 59cc15cba6..3f7a5d09b5 100644 --- a/extra/random-weighted/random-weighted.factor +++ b/extra/random-weighted/random-weighted.factor @@ -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 >alist ] bi swap - [ , random-weighted , case ] bake ; + [ keys ] [ values >alist ] bi + '[ , random-weighted , case ] ; diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index d58e242d86..933275e5bf 100755 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -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 diff --git a/extra/rewrite-closures/rewrite-closures.factor b/extra/rewrite-closures/rewrite-closures.factor index ccd3989d1a..0136d5e271 100644 --- a/extra/rewrite-closures/rewrite-closures.factor +++ b/extra/rewrite-closures/rewrite-closures.factor @@ -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 ; diff --git a/extra/size-of/size-of.factor b/extra/size-of/size-of.factor index a2b47fc0aa..8157ba7dcf 100644 --- a/extra/size-of/size-of.factor +++ b/extra/size-of/size-of.factor @@ -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 " include-headers { "main() { printf( \"%i\" , sizeof( " , " ) ) ; }" } } - bake to-strings ; + to-strings ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/springies/models/2x2snake/2x2snake.factor b/extra/springies/models/2x2snake/2x2snake.factor index 7c54e72578..6e794eb744 100644 --- a/extra/springies/models/2x2snake/2x2snake.factor +++ b/extra/springies/models/2x2snake/2x2snake.factor @@ -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 diff --git a/extra/springies/models/3snake/3snake.factor b/extra/springies/models/3snake/3snake.factor index 92d39ac2c2..e65c9c64a6 100644 --- a/extra/springies/models/3snake/3snake.factor +++ b/extra/springies/models/3snake/3snake.factor @@ -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 ; diff --git a/extra/springies/models/belt-tire/belt-tire.factor b/extra/springies/models/belt-tire/belt-tire.factor index 6604f85a3f..e00a93b310 100644 --- a/extra/springies/models/belt-tire/belt-tire.factor +++ b/extra/springies/models/belt-tire/belt-tire.factor @@ -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 diff --git a/extra/springies/models/nifty/nifty.factor b/extra/springies/models/nifty/nifty.factor index db644f2248..2b9a31b234 100644 --- a/extra/springies/models/nifty/nifty.factor +++ b/extra/springies/models/nifty/nifty.factor @@ -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 diff --git a/extra/springies/models/urchin/urchin.factor b/extra/springies/models/urchin/urchin.factor index 734a1c2f6d..8870c714e8 100644 --- a/extra/springies/models/urchin/urchin.factor +++ b/extra/springies/models/urchin/urchin.factor @@ -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 diff --git a/extra/springies/ui/ui.factor b/extra/springies/ui/ui.factor index bebe813925..8aabe6b70b 100644 --- a/extra/springies/ui/ui.factor +++ b/extra/springies/ui/ui.factor @@ -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 ; \ No newline at end of file