ycextra-0.1: Yhc/Core/Selector.hs

module Yhc.Core.Selector (
  coreSelectorIndex) where

import Data.List
import Data.Maybe
import Yhc.Core

-- |Given an expr (normally a CoreApp)
--  tell if it is an application of a selector function
--  to a data object. Selector functions consist of a single
--  CoreCase statement with the only alternative. Application
--  must be exactly to one argument. The case alternative must
--  be a constructor application to field selectors, and 
--  the return value must be one of the selectors.
--  If the analysis condition is satisfied, constructor name and
--  a field index are returned. Otherwise empty string and -1 are returned.
--  The index returned is zero-based.

coreSelectorIndex :: Core -> CoreFuncName -> (CoreCtorName, Int)

coreSelectorIndex core fn = x
  where
    nosel = ("", -1)
    unpos (CorePos _ e) = unpos e
    unpos e = e
    x = case coreFuncMaybe core fn of
      (Just func@CoreFunc {coreFuncArgs = (a:[])}) -> 
        case unpos (coreFuncBody func) of
          CoreCase _ [(PatCon con sels, (CoreVar ce))] ->
            case fromMaybe (-1) (elemIndex ce sels) of 
              (-1) -> nosel
              n    -> (con, n)
          _ -> nosel
      _ -> nosel