A_Opcode.hs

-- I'm trying to symbolically evaluate this function,

   mapOpcodeM (jumpMapper (lookupLabel M.empty)) ADD :: Either TranslateError PositionalOpcode
~> mapOnOther' ADD ADD
~> do res <- mapOnOther (jumpMapper (lookupLabel M.empty)) ADD
      case res of
        Just opb -> return opb
        Nothing  -> return ADD
~> do res <- const (pure Nothing) ADD
      case res of
        Just opb -> return opb
        Nothing  -> return ADD
~> do res <- Right Nothing
      case res of
        Just opb -> return opb
        Nothing  -> return ADD
~> case Nothing of
     Just opb -> return opb
     Nothing  -> return ADD
~> return ADD

-- Yet, when I run it, it doesn't terminate:

> mapOpcodeM (jumpMapper (lookupLabel M.empty)) ADD :: Either TranslateError PositionalOpcode 
Right ...hangs...^CInterrupted.

B_Definitions.hs

mapOpcodeM :: forall m a b. Monad m => OpcodeMapper m a b -> Opcode' a -> m (Opcode' b)
mapOpcodeM mapper opcode = case opcode of
  JUMP a     -> mapOnJump mapper a
  JUMPI a    -> mapOnJumpi mapper a
  JUMPDEST a -> mapOnJumpdest mapper a

  -- 0s: Stop and Arithmetic Operations
  STOP       -> mapOnOther' STOP STOP
  ADD        -> mapOnOther' ADD ADD
  ...
  where
    mapOnOther' :: Opcode' a -> Opcode' b -> m (Opcode' b)
    mapOnOther' opa opbDefault = do
      res <- mapOnOther mapper opa
      case res of
        Just opb -> return opb
        Nothing  -> return opbDefault

jumpMapper :: Applicative f => (a -> f j) -> OpcodeMapper f a j
jumpMapper f = OpcodeMapper
  { mapOnJump = fmap JUMP . f
  , mapOnJumpi = fmap JUMPI . f
  , mapOnJumpdest = fmap JUMPDEST . f
  , mapOnOther = const (pure Nothing)
  }

lookupLabel :: Map Text position -> Text -> Either TranslateError position
lookupLabel labelMap label =
  case Map.lookup label labelMap of
    Just pos -> Right pos
    Nothing -> Left (TranslateError [label] [])