{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : Data.Binding.Hobbits.SuperComb
-- Copyright   : (c) 2011 Edwin Westbrook, Nicolas Frisby, and Paul Brauner
--
-- License     : BSD3
--
-- Maintainer  : emw4@rice.edu
-- Stability   : experimental
-- Portability : GHC
--
-- This module uses Template Haskell to distinguish super-combinators, so that
-- the library can trust such functions to not contain any @Name@ values in
-- their closure.

module Data.Binding.Hobbits.SuperComb (
  -- * Abstract types
  SuperComb(),
  -- * Operators involving 'SuperComb'
  superComb, mbToplevel,
) where

import Data.Binding.Hobbits.Internal (Mb(..))

import Language.Haskell.TH as TH

import qualified Data.Generics as SYB
import qualified Language.Haskell.TH.Syntax as TH

------------------------------------------------------------
-- applying top-level functions under binders
------------------------------------------------------------

{-|
  The type @SuperComb a@ represents a super-combinator of type @a@,
  i.e., an expression of type @a@ with no free (Haskell) variables.
  Since this cannot be checked directly in the Haskell type system,
  the @SuperComb@ data type is hidden, and the user can only create
  super-combinators using Template Haskell, through the 'superComb'
  operator.
-}
newtype SuperComb a = SuperComb { unSuperComb :: a }

-- | An quoted expression is a CAF if all of its names are bound globally or
-- within the quotation
isSuperComb :: Exp -> Bool
isSuperComb = SYB.everything (&&) (SYB.mkQ True nameOK) where
  nameOK (TH.Name _ flav) = case flav of
    TH.NameG {} -> True -- bound globally
    TH.NameU {} -> True -- bound within this same quotation
    _ -> False

-- | @superComb@ is used with Template Haskell to create super-combinators;
-- see documentation for 'mbToplevel' to see how it is used.
superComb :: Q Exp -> Q Exp
superComb m = do
  e <- m
  if isSuperComb e then return (TH.AppE (TH.ConE 'SuperComb) e) else fail ("not a super combinator:\n\t" ++ TH.pprint e)

-- | @mbToplevel@ @f@ @b@ applies super-combinator @f@ to the body of
-- multi-binding @b@. For example:
--
-- > mbToplevel $(superComb [| f |]) (nu $ \n -> n)   =   nu f
mbToplevel :: SuperComb (a -> b) -> Mb ctx a -> Mb ctx b
mbToplevel f (MkMb names i) = MkMb names (unSuperComb f i)