factor / factor

Factor programming language
https://factorcode.org/
BSD 2-Clause "Simplified" License
1.63k stars 205 forks source link

"dup foo bar" vs "[ foo ] [ bar ] bi" #1234

Open mrjbq7 opened 9 years ago

mrjbq7 commented 9 years ago

Seems like they should compile to the same thing, but they don't:

IN: scratchpad : foo ( x -- ) drop ;
IN: scratchpad : bar ( x -- ) drop ;

IN: scratchpad [ dup foo bar ] disassemble
000000010e8ec960: 89059a6621ff    mov [rip-0xde9966], eax
000000010e8ec966: 4883ec08        sub rsp, 0x8
000000010e8ec96a: 4983c608        add r14, 0x8
000000010e8ec96e: 498b4ef8        mov rcx, [r14-0x8]
000000010e8ec972: 49890e          mov [r14], rcx
000000010e8ec975: e8762e0000      call 0x10e8ef7f0 (foo)
000000010e8ec97a: 8905806621ff    mov [rip-0xde9980], eax
000000010e8ec980: 4883c408        add rsp, 0x8
000000010e8ec984: 488d1d05000000  lea rbx, [rip+0x5]
000000010e8ec98b: e9e02d0000      jmp 0x10e8ef770 (bar)
000000010e8ec990: 0000            add [rax], al
000000010e8ec992: 0000            add [rax], al
000000010e8ec994: 0000            add [rax], al
000000010e8ec996: 0000            add [rax], al
000000010e8ec998: 0000            add [rax], al
000000010e8ec99a: 0000            add [rax], al
000000010e8ec99c: 0000            add [rax], al
000000010e8ec99e: 0000            add [rax], al

IN: scratchpad [ [ foo ] [ bar ] bi ] disassemble
000000010e8b5590: 89056ada24ff    mov [rip-0xdb2596], eax
000000010e8b5596: 4883ec08        sub rsp, 0x8
000000010e8b559a: 4983c708        add r15, 0x8
000000010e8b559e: 498b0e          mov rcx, [r14]
000000010e8b55a1: 49890f          mov [r15], rcx
000000010e8b55a4: e847a20300      call 0x10e8ef7f0 (foo)
000000010e8b55a9: 4983ef08        sub r15, 0x8
000000010e8b55ad: 4983c608        add r14, 0x8
000000010e8b55b1: 498b4f08        mov rcx, [r15+0x8]
000000010e8b55b5: 49890e          mov [r14], rcx
000000010e8b55b8: 890542da24ff    mov [rip-0xdb25be], eax
000000010e8b55be: 4883c408        add rsp, 0x8
000000010e8b55c2: 488d1d05000000  lea rbx, [rip+0x5]
000000010e8b55c9: e9a2a10300      jmp 0x10e8ef770 (bar)
000000010e8b55ce: 0000            add [rax], al
000000010e8b55d0: 0000            add [rax], al
000000010e8b55d2: 0000            add [rax], al
000000010e8b55d4: 0000            add [rax], r8b
000000010e8b55d6: 0000            add [rax], r8b
000000010e8b55d8: 0000            add [rax], al
000000010e8b55da: 0000            add [rax], al
000000010e8b55dc: 0000            add [rax], r8b
000000010e8b55de: 0000            add [rax], r8b
bjourne commented 9 years ago

I guess these two should also ideally be the same: [ foo ] dip bar and swap foo bar.

bjourne commented 9 years ago

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.