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 ;

! no need for reduce1 -- its just "each"

: throw/m ( obj message -- )
    prepend throw ;

! if there aren't enough to take, just take the rest

:: 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

! could use a better conditional
: hdrop ( seq n -- seq ) sequence-tail>list list>array ; inline

! this could be cleaned up
! splits a seq into n subseqs
: nsplit ( seq n -- seq )
    [ empty? ] swap [ swap htake ] [ swap hdrop ]  bi-curry
    unfold
    unclip-last append ;
    

! need to work on this one
! : nsplit-as ( seq n exemplar -- seq )
!    [ nsplit ] dip [ >convert ] exemplar map-as ;

: bi-compose@ ( quot quot quot -- quot quot )
    [ compose ] keep swapd compose swap ;

: bi-compose* ( quot quot quot quot -- quot quot ) [ compose ] dup 2bi* ;

! I find these invaluable
SYNTAX: 2{ \ } [ >array 2 nsplit ] parse-literal ;
SYNTAX: 3{ \ } [ >array 3 nsplit ] parse-literal ;
SYNTAX: 4{ \ } [ >array 4 nsplit ] parse-literal ;
           

New Annotation

Summary:
Author:
Mode:
Body: