HaRe-0.6: refactorer/PwPf/Pointfree.hs
-----------------------------------------------------------------------------
-- |
-- Module : Pointfree
-- Copyright : (c) Jose Proenca 2005
-- License : GPL
--
-- Maintainer : jproenca@di.uminho.pt
-- Stability : experimental
-- Portability : portable
--
-- A syntax of a general pointfree language.
--
-----------------------------------------------------------------------------
module Pointfree (
-- * Data Type
{-| Represents a pointfree language where:
(1) products and sums are treated
(2) base types are obtained and decomposed by the use of the /IN/ and
/OUT/ constructors
(3) recursion can be expressed by the point-fix function or by a paramorphism
(4) free variables are called macros and represent known pointfree expressions
-}
PFTerm (..),
-- * Conversion of a "PFTerm" to an haskell expression
pf2Exp
) where
import RefacUtils
data PFTerm = BANG -- ^Constant function that returns Unit
| ID -- ^Identity
| APP -- ^Apply
| Curry PFTerm -- ^Curry
| PFTerm :.: PFTerm -- ^Composition
| PFTerm :\/: PFTerm -- ^Either
| PFTerm :/\: PFTerm -- ^Split
| FST -- ^Point-free first
| SND -- ^Point-free second
| INL -- ^Point-free left injection
| INR -- ^Point-free right injection
| IN HsExpP -- ^Injection on a specified type
| OUT HsExpP -- ^Gets the functor
| PARA HsExpP PFTerm -- ^Paramorphism
| FIX -- ^Fixed point function
| Macro String -- ^Macros of frequently used pointfree terms
deriving Show
-- Implementation of a pointfree term on a HsExp
{- | Applies a tranformation from a 'PFTerm' to an expression of programatica's
abstract tree. Note that the type information inside the /IN/, /OUT/ and /PARA/
terms is represented as a programatica's expression @L::type@, where the @type@
is the real type information.
-}
pf2Exp :: PFTerm -> HsExpI PNT
pf2Exp BANG = nameToExp "bang"
pf2Exp ID = prelVar "id"
pf2Exp APP = nameToExp "app"
pf2Exp (Curry t1) = Exp $ HsApp (nameToExp "curry") (mbParen$ pf2Exp t1)
pf2Exp (t1 :.: t2) = Exp (HsInfixApp (mbParen$ pf2Exp t1)
(prelOp ".") (mbParen$ pf2Exp t2))
pf2Exp (t1 :\/: t2) = Exp (HsInfixApp (mbParen$ pf2Exp t1)
(nameToOp "\\/") (mbParen$ pf2Exp t2))
pf2Exp (t1 :/\: t2) = Exp (HsInfixApp (mbParen$ pf2Exp t1)
(nameToOp "/\\") (mbParen$ pf2Exp t2))
pf2Exp FST = nameToExp "fst"
pf2Exp SND = nameToExp "snd"
pf2Exp INL = prelCon "Left"
pf2Exp INR = prelCon "Right"
pf2Exp (IN typ) = -- inN (_L::str)
Exp (HsApp (nameToExp "inN") typ)--(Exp $ HsParen $ typedExp "_L" str))
pf2Exp (OUT typ) = -- ouT (_L::str)
Exp (HsApp (nameToExp "ouT") typ)--(Exp $ HsParen $ typedExp "_L" str))
pf2Exp (PARA typ t) = -- para (_L::str) t
Exp (HsApp (Exp $ HsApp (nameToExp "para") typ)--(Exp $ HsParen $ typedExp "_L" str))
(mbParen$ pf2Exp t))
pf2Exp FIX = nameToExp "fix"
pf2Exp (Macro str) = nameToExp str
---------------------------
--- auxiliary functions ---
---------------------------
-- nameToExp is imported from RefacUtils.hs
-- nameToExp str = Exp (HsId (HsVar (PNT (PN (UnQual str) (S loc0)) Value (N (Just loc0)))))
prelVar str = Exp (HsId (HsVar (PNT (PN (UnQual str) (G (PlainModule "Prelude") str (N (Just loc0)))) Value (N (Just loc0)))))
conToExp str = Exp (HsId (HsCon (PNT (PN (UnQual str) (S loc0)) Value (N (Just loc0)))))
prelCon str = Exp (HsId (HsCon (PNT (PN (UnQual str) (G (PlainModule "Prelude") str (N (Just loc0)))) Value (N (Just loc0)))))
-- | places parentisis in an expression only if it is necessary
--mbParen :: EI -> HsExp
mbParen e@(Exp (HsApp _ _)) = Exp $ HsParen e
mbParen e@(Exp (HsInfixApp _ _ _)) = Exp $ HsParen e
mbParen e@(Exp (HsCase _ _)) = Exp $ HsParen e
mbParen e@(Exp (HsLambda _ _)) = Exp $ HsParen e
mbParen x = x
prelOp str = (HsVar (PNT (PN (UnQual str) (G (PlainModule "Prelude") str (N (Just loc0)))) Value (N (Just loc0))))
nameToOp str = (HsVar (PNT (PN (UnQual str) (S loc0)) Value (N (Just loc0))))
typedExp strVar strType = Exp (HsExpTypeSig loc0 (nameToExp strVar) [] (Typ $ HsTyVar (PNT (PN (UnQual strType) (S loc0)) (Type (TypeInfo {defType = Nothing, constructors = [], fields = []})) (N (Just loc0)))))