Paste: Personal Utilities File
Author: | tylerg |
Mode: | factor |
Date: | Wed, 19 Aug 2009 19:13:32 |
Plain Text |
USING: arrays combinators kernel lists lists.lazy make math quotations sequences parser assocs macros locals fry ;
IN: utils
: i ( -- q ) [ ] ;
: 1q ( x -- q ) 1quotation ;
: throw/m ( obj message -- )
prepend throw ;
:: linrec
( if-quot: ( -- ? )
then-quot: ( -- )
else1-quot: ( -- )
else2-quot: ( -- )
-- )
if-quot call [
then-quot call
] [
else1-quot call
if-quot then-quot else1-quot else2-quot linrec
else2-quot call
] if ; inline recursive
:: unfold ( seed P: ( seed -- ? ) F: ( seed -- o ) G: ( seed -- seed' ) -- array )
[ seed [ dup P call ] [ ] [ dup F call , G call ] [ ] linrec ]
{ } make nip ; inline
: htake ( n seq -- seq ) >list ltake list>array ; inline
: hdrop ( seq n -- seq ) sequence-tail>list list>array ; inline
: nsplit ( seq n -- seq )
[ empty? ] swap [ swap htake ] [ swap hdrop ] bi-curry
unfold
unclip-last append ;
: bi-compose@ ( quot quot quot -- quot quot )
[ compose ] keep swapd compose swap ;
: bi-compose* ( quot quot quot quot -- quot quot ) [ compose ] dup 2bi* ;
SYNTAX: 2{ \ } [ >array 2 nsplit ] parse-literal ;
SYNTAX: 3{ \ } [ >array 3 nsplit ] parse-literal ;
SYNTAX: 4{ \ } [ >array 4 nsplit ] parse-literal ;
New Annotation