Pictured partial application and composition
parent
7eee8e7017
commit
69da074d20
|
@ -0,0 +1,2 @@
|
||||||
|
Slava Pestov
|
||||||
|
Eduardo Cavazos
|
|
@ -0,0 +1,42 @@
|
||||||
|
IN: temporary
|
||||||
|
USING: fry tools.test math prettyprint kernel io arrays
|
||||||
|
sequences ;
|
||||||
|
|
||||||
|
[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test
|
||||||
|
|
||||||
|
[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test
|
||||||
|
|
||||||
|
[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test
|
||||||
|
|
||||||
|
[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test
|
||||||
|
|
||||||
|
[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
|
||||||
|
|
||||||
|
[ [ "a" write "b" print ] ]
|
||||||
|
[ "a" "b" '[ , write , print ] ] unit-test
|
||||||
|
|
||||||
|
[ [ 1 2 + 3 4 - ] ]
|
||||||
|
[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
|
||||||
|
|
||||||
|
[ 1/2 ] [
|
||||||
|
1 '[ , _ / ] 2 swap call
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
|
||||||
|
1 '[ , _ _ 3array ]
|
||||||
|
{ "a" "b" "c" } { "A" "B" "C" } rot 2map
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
|
||||||
|
'[ 1 _ 2array ]
|
||||||
|
{ "a" "b" "c" } swap map
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
|
||||||
|
1 2 '[ , _ , 3array ]
|
||||||
|
{ "a" "b" "c" } swap map
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
: funny-dip '[ @ _ ] call ; inline
|
||||||
|
|
||||||
|
[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
|
|
@ -0,0 +1,39 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: kernel sequences combinators parser splitting
|
||||||
|
quotations ;
|
||||||
|
IN: fry
|
||||||
|
|
||||||
|
: , "Only valid inside a fry" throw ;
|
||||||
|
: @ "Only valid inside a fry" throw ;
|
||||||
|
: _ "Only valid inside a fry" throw ;
|
||||||
|
|
||||||
|
DEFER: (fry)
|
||||||
|
|
||||||
|
: ((fry)) ( accum quot adder -- result )
|
||||||
|
>r [ ] swap (fry) r>
|
||||||
|
append swap dup empty? [ drop ] [
|
||||||
|
[ swap compose ] curry append
|
||||||
|
] if ; inline
|
||||||
|
|
||||||
|
: (fry) ( accum quot -- result )
|
||||||
|
dup empty? [
|
||||||
|
drop 1quotation
|
||||||
|
] [
|
||||||
|
unclip {
|
||||||
|
{ , [ [ curry ] ((fry)) ] }
|
||||||
|
{ @ [ [ compose ] ((fry)) ] }
|
||||||
|
[ swap >r add r> (fry) ]
|
||||||
|
} case
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: trivial-fry ( quot -- quot' ) [ ] swap (fry) ;
|
||||||
|
|
||||||
|
: fry ( quot -- quot' )
|
||||||
|
{ _ } last-split1 [
|
||||||
|
>r fry [ [ dip ] curry ] r> trivial-fry [ compose ] compose 3compose
|
||||||
|
] [
|
||||||
|
trivial-fry
|
||||||
|
] if* ;
|
||||||
|
|
||||||
|
: '[ \ ] parse-until fry over push-all ; parsing
|
|
@ -0,0 +1 @@
|
||||||
|
Syntax for pictured partial application and composition
|
|
@ -0,0 +1 @@
|
||||||
|
extensions
|
Loading…
Reference in New Issue