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

update terms of fry–locals peace treaty

db4
Joe Groff 2009-11-07 13:03:46 -06:00
parent a4508e9c43
commit 28b09d6d57
2 changed files with 24 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/fry/fry.factor
View File

@ -8,7 +8,7 @@ IN: fry
ERROR: >r/r>-in-fry-error ; ERROR: >r/r>-in-fry-error ;
DEFER: fry GENERIC: fry ( quot -- quot' )
<PRIVATE <PRIVATE
@ -24,8 +24,10 @@ M: callable count-inputs [ count-inputs ] map-sum ;
M: fry-specifier count-inputs drop 1 ; M: fry-specifier count-inputs drop 1 ;
M: object count-inputs drop 0 ; M: object count-inputs drop 0 ;
MIXIN: fried
PREDICATE: fried-callable < callable PREDICATE: fried-callable < callable
count-inputs 0 > ; count-inputs 0 > ;
INSTANCE: fried-callable fried
: convert-curry ( quot -- quot' ) : convert-curry ( quot -- quot' )
[ [ [ ] curry compose ] ] [ [ [ [ ] curry compose ] ] [
@ -43,6 +45,15 @@ PREDICATE: fried-callable < callable
{ _ } split convert-curries { _ } split convert-curries
spread>quot ; spread>quot ;
: [ncurry] ( quot n -- quot )
{
{ 0 [ [ ] ] }
{ 1 [ [ curry ] ] }
{ 2 [ [ 2curry ] ] }
{ 3 [ [ 3curry ] ] }
[ \ curry <repetition> ]
} case curry ;
: [ndip] ( quot n -- quot' ) : [ndip] ( quot n -- quot' )
{ {
{ 0 [ \ call [ ] 2sequence ] } { 0 [ \ call [ ] 2sequence ] }
@ -85,13 +96,13 @@ TUPLE: dredge-fry-state
[ in-quot>> swap tail-slice ] [ quot>> ] bi push-all ; inline recursive [ in-quot>> swap tail-slice ] [ quot>> ] bi push-all ; inline recursive
: dredge-fry ( n dredge-fry -- ) : dredge-fry ( n dredge-fry -- )
2dup in-quot>> [ fried-callable? ] find-from 2dup in-quot>> [ fried? ] find-from
[ (dredge-fry-subquot) ] [ (dredge-fry-subquot) ]
[ drop (dredge-fry-simple) ] if* ; inline recursive [ drop (dredge-fry-simple) ] if* ; inline recursive
PRIVATE> PRIVATE>
: fry ( quot -- quot' ) M: callable fry ( quot -- quot' )
0 swap <dredge-fry> 0 swap <dredge-fry>
[ dredge-fry ] [ [ dredge-fry ] [
[ prequot>> >quotation ] [ prequot>> >quotation ]

17
basis/locals/fry/fry.factor
View File

@ -1,18 +1,21 @@
! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors fry fry.private generalizations kernel USING: accessors fry fry.private generalizations kernel
locals.types make sequences ; locals.types sequences ;
IN: locals.fry IN: locals.fry
! Support for mixing locals with fry ! Support for mixing locals with fry
M: let count-inputs body>> count-inputs ; M: let count-inputs body>> count-inputs ;
M: lambda count-inputs body>> count-inputs ; M: lambda count-inputs body>> count-inputs ;
M: lambda deep-fry M: lambda fry
clone [ shallow-fry swap ] change-body clone [ [ count-inputs ] [ fry ] bi ] change-body
[ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ; [ [ vars>> length ] keep '[ _ _ mnswap _ call ] ]
[ drop [ncurry] [ call ] compose ] 2bi ;
M: let deep-fry M: let fry
clone [ fry '[ @ call ] ] change-body , ; clone [ fry ] change-body ;
INSTANCE: lambda fried
INSTANCE: let fried