force = do
  st <- get
  case psStack st of
    (W w : _) -> doWord w
#ifdef DEBUG
      >> traceStack
#endif
    (S s : _) -> (popStack >> addConstraint ([S s], [])) `mplus` do
                   v <- newVar
                   s' <- newSVar
                   popStack
                   pushStack s'
                   pushStack v
                   addConstraint ([v, s'], [S s])
    _ -> return ()
force = do
  st <- get
  case psStack st of
    (W w : _) -> doWord w
#ifdef DEBUG
      >> traceStack
#endif
    (S s : _) -> (popStack >> addConstraint ([S s], [])) `mplus` do
                   v <- newVar
                   s' <- newSVar
                   popStack
                   pushStack s'
                   pushStack v
                   addConstraint ([v, s'], [S s])
    _ -> return ()
force = do
  st <- get
  case psStack st of
    (W w : _) -> doWord w
#ifdef DEBUG
      >> traceStack
#endif
    (S s : _) -> (popStack >> addConstraint ([S s], [])) `mplus` do
                   v <- newVar
                   s' <- newSVar
                   popStack
                   pushStack s'
                   pushStack v
                   addConstraint ([v, s'], [S s])
    _ -> return ()