factor/basis/fry/fry.factor

56 lines
1.4 KiB
Factor
Raw Normal View History

2008-03-03 17:44:24 -05:00
! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
2008-07-03 12:25:27 -04:00
USING: kernel sequences combinators parser splitting math
quotations arrays make words locals.backend summary sets ;
2008-03-03 17:44:24 -05:00
IN: fry
2008-09-10 23:11:40 -04:00
: _ ( -- * ) "Only valid inside a fry" throw ;
2008-06-08 16:32:55 -04:00
: @ ( -- * ) "Only valid inside a fry" throw ;
ERROR: >r/r>-in-fry-error ;
<PRIVATE
2008-03-03 17:44:24 -05:00
: [ncurry] ( n -- quot )
{
{ 0 [ [ ] ] }
{ 1 [ [ curry ] ] }
{ 2 [ [ 2curry ] ] }
{ 3 [ [ 3curry ] ] }
[ [ curry ] <repetition> ]
} case ;
M: >r/r>-in-fry-error summary
drop
"Explicit retain stack manipulation is not permitted in fried quotations" ;
: check-fry ( quot -- quot )
dup { >r r> load-locals get-local drop-locals } intersect
empty? [ >r/r>-in-fry-error ] unless ;
: shallow-fry ( quot -- quot' )
check-fry
[ dup \ @ = [ drop [ _ call ] ] [ 1array ] if ] map concat
{ _ } split [ length 1- [ncurry] ] [ spread>quot ] bi prefix ;
2008-03-03 17:44:24 -05:00
2008-09-11 01:36:55 -04:00
PREDICATE: fry-specifier < word { _ @ } memq? ;
2008-03-03 17:44:24 -05:00
GENERIC: count-inputs ( quot -- n )
M: callable count-inputs [ count-inputs ] sigma ;
2008-09-11 01:36:55 -04:00
M: fry-specifier count-inputs drop 1 ;
M: object count-inputs drop 0 ;
PRIVATE>
2008-05-26 01:48:18 -04:00
2008-04-22 17:29:20 -04:00
: fry ( quot -- quot' )
[
[
dup callable? [
2008-09-10 23:11:40 -04:00
[ count-inputs \ _ <repetition> % ] [ fry % ] bi
] [ , ] if
2008-04-22 17:29:20 -04:00
] each
] [ ] make shallow-fry ;
2008-04-22 17:29:20 -04:00
2008-03-03 17:44:24 -05:00
: '[ \ ] parse-until fry over push-all ; parsing