Open mrjbq7 opened 9 years ago
I guess these two should also ideally be the same: [ foo ] dip bar
and swap foo bar
.
Proof of concept, kind of:
USING: accessors arrays effects formatting kernel math namespaces
sequences sequences.rotated stack-checker stack-checker.backend
stack-checker.state stack-checker.values stack-checker.known-words words ;
IN: examples.bugs.bug1234
: foo ( x -- )
"foo: %u\n" printf ;
: bar ( x -- )
"bar: %u\n" printf ;
: foo1 ( x -- y )
3 + ;
: bar1 ( x -- y )
2 * ;
: make-shuffle-effect ( n dir -- effect )
swap 1 + iota swap dupd <rotated> [ >array ] bi@ <effect> ;
: my-dip ( x quot -- x )
swap [ call ] dip ;
: infer-dip-arg ( quot -- effect/f )
dup [ call ] = [
drop
meta-d dup length 2 - swap nth
known dup literal-tuple? [ value>> infer ] [ drop f ] if
] [ infer ] if ;
: my-infer-dip ( -- )
literals get
[ \ my-dip def>> infer-quot-here ] [
pop dup infer-dip-arg [
[ nip in>> length -1 make-shuffle-effect infer-shuffle ]
[ drop infer-quot-here ]
[ nip out>> length 1 make-shuffle-effect infer-shuffle ] 2tri
] [ drop \ my-dip def>> infer-quot-here ] if*
] if-empty ;
\ my-dip [ my-infer-dip ] "special" set-word-prop
\ my-dip t "no-compile" set-word-prop
: my-bi ( x p q -- ) [ over [ call ] my-dip ] dip call ; inline
[ [ foo ] [ bar ] my-bi ] disassemble
00007f4588545a20: 8905daa5f5fe mov [rip-0x10a5a26], eax
00007f4588545a26: 4883ec08 sub rsp, 0x8
00007f4588545a2a: 498b0e mov rcx, [r14]
00007f4588545a2d: 4983c608 add r14, 0x8
00007f4588545a31: 49890e mov [r14], rcx
00007f4588545a34: e8a7e8ffff call 0x7f45885442e0 (foo)
00007f4588545a39: 8905c1a5f5fe mov [rip-0x10a5a3f], eax
00007f4588545a3f: 4883c408 add rsp, 0x8
00007f4588545a43: 488d1d05000000 lea rbx, [rip+0x5]
00007f4588545a4a: e911e7ffff jmp 0x7f4588544160 (bar)
00007f4588545a4f: 0000 add [rax], al
00007f4588545a51: 0000 add [rax], al
00007f4588545a53: 0000 add [rax], al
00007f4588545a55: 0000 add [rax], al
00007f4588545a57: 0000 add [rax], al
00007f4588545a59: 0000 add [rax], al
00007f4588545a5b: 0000 add [rax], al
00007f4588545a5d: 0000 add [rax], al
00007f4588545a5f: 00 invalid
The trick, I think, is to try and figure out of the quotation being dipped has a static stack effect. Then you don't need to touch the retain stack at all.
Seems like they should compile to the same thing, but they don't: