 : define-pop-inverse ( word n quot -- )
     >r dupd "pop-length" set-word-prop r>
     "pop-inverse" set-word-prop ;
-
-DEFER: [undo]
-
-: make-inverse ( word -- quot )
-    word-def [undo] ;
 
 TUPLE: no-inverse word ;
 : no-inverse ( word -- * ) \ no-inverse construct-empty throw ;

math.functions macros ;
IN: inverse

: (repeat) ( from to quot -- )
    pick pick >= [
        3drop
    ] [
        [ swap >r call 1+ r> ] keep (repeat)
    ] if ; inline

: repeat ( n quot -- ) 0 -rot (repeat) ; inline

TUPLE: fail ;
: fail ( -- * ) \ fail construct-empty throw ;
M: fail summary drop "Unification failed" ;


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 ;
