 USING: kernel words inspector slots quotations sequences assocs
 math arrays inference effects shuffle continuations debugger
 tuples namespaces vectors bit-arrays byte-arrays strings sbufs
-math.functions macros ;
+math.functions macros combinators.private combinators ;
 IN: inverse
 
 TUPLE: fail ;

: ?word-prop ( word/object name -- value/f )
    over word? [ word-prop ] [ 2drop f ] if ;

GENERIC: inverse ( revquot word -- revquot* quot )

DEFER: [undo]

M: word inverse
    dup "inverse" word-prop [ ]
    [ dup primitive? [ no-inverse ] [ word-def [undo] ] if ] ?if ;

: undo-literal ( object -- quot )
    [ =/fail ] curry ;

M: object inverse undo-literal ;
M: symbol inverse undo-literal ;

PREDICATE: word math-inverse "math-inverse" word-prop ;
M: math-inverse inverse
    "math-inverse" word-prop
    swap next dup \ swap =
    [ drop swap-inverse ] [ pull-inverse ] if ;

PREDICATE: word pop-inverse "pop-length" word-prop ;
M: pop-inverse inverse
    [ "pop-length" word-prop cut-slice swap ] keep
    "pop-inverse" word-prop compose call ;

    [ unclip-slice inverse % (undo) ] if ;

: [undo] ( quot -- undo )
    do-inlining reverse [ (undo) ] [ ] make ;

MACRO: undo ( quot -- ) [undo] ;

