 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 ;

: define-inverse ( word quot -- ) "inverse" set-word-prop ;

: define-math-inverse ( word quot1 quot2 -- )
    pick 1quotation 3array "math-inverse" set-word-prop ;

: define-pop-inverse ( word n quot -- )
    >r dupd "pop-length" set-word-prop r>
