{- |
    Module      :  $Header$
    Description :  Utility functions for Curry's abstract syntax
    Copyright   :  (c) 1999 - 2004 Wolfgang Lux
                       2005        Martin Engelke
                       2011 - 2014 Björn Peemöller
                       2015        Jan Tikovsky
                       2016        Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module provides some utility functions for working with the
    abstract syntax tree of Curry.
-}

module Curry.Syntax.Utils
  ( hasLanguageExtension, knownExtensions
  , isTopDecl, isBlockDecl
  , isTypeSig, infixOp, isTypeDecl, isValueDecl, isInfixDecl
  , isDefaultDecl, isClassDecl, isTypeOrClassDecl, isInstanceDecl
  , isFunctionDecl, isExternalDecl, patchModuleId
  , isVariablePattern
  , isVariableType, isSimpleType
  , typeConstr, typeVariables, varIdent
  , flatLhs, eqnArity, fieldLabel, fieldTerm, field2Tuple, opName
  , funDecl, mkEquation, simpleRhs, patDecl, varDecl, constrPattern, caseAlt
  , mkLet, mkVar
  , apply, unapply
  , constrId, nconstrId
  , nconstrType
  , recordLabels, nrecordLabels
  , methods, impls, imethod, imethodArity
  , shortenModuleAST
  ) where

import Control.Monad.State

import Curry.Base.Ident
import Curry.Base.SpanInfo
import Curry.Files.Filenames (takeBaseName)
import Curry.Syntax.Extension
import Curry.Syntax.Type

-- |Check whether a 'Module' has a specific 'KnownExtension' enabled by a pragma
hasLanguageExtension :: Module a -> KnownExtension -> Bool
hasLanguageExtension :: Module a -> KnownExtension -> Bool
hasLanguageExtension mdl :: Module a
mdl ext :: KnownExtension
ext = KnownExtension
ext KnownExtension -> [KnownExtension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Module a -> [KnownExtension]
forall a. Module a -> [KnownExtension]
knownExtensions Module a
mdl

-- |Extract all known extensions from a 'Module'
knownExtensions :: Module a -> [KnownExtension]
knownExtensions :: Module a -> [KnownExtension]
knownExtensions (Module _ ps :: [ModulePragma]
ps _ _ _ _) =
  [ KnownExtension
e | LanguagePragma _ exts :: [Extension]
exts <- [ModulePragma]
ps, KnownExtension _ e :: KnownExtension
e <- [Extension]
exts]

-- |Replace the generic module name @main@ with the module name derived
-- from the 'FilePath' of the module.
patchModuleId :: FilePath -> Module a -> Module a
patchModuleId :: FilePath -> Module a -> Module a
patchModuleId fn :: FilePath
fn m :: Module a
m@(Module spi :: SpanInfo
spi ps :: [ModulePragma]
ps mid :: ModuleIdent
mid es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl a]
ds)
  | ModuleIdent
mid ModuleIdent -> ModuleIdent -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleIdent
mainMIdent = SpanInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
forall a.
SpanInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi [ModulePragma]
ps ([FilePath] -> ModuleIdent
mkMIdent [FilePath -> FilePath
takeBaseName FilePath
fn]) Maybe ExportSpec
es [ImportDecl]
is [Decl a]
ds
  | Bool
otherwise         = Module a
m

-- |Is the declaration a top declaration?
isTopDecl :: Decl a -> Bool
isTopDecl :: Decl a -> Bool
isTopDecl = Bool -> Bool
not (Bool -> Bool) -> (Decl a -> Bool) -> Decl a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decl a -> Bool
forall a. Decl a -> Bool
isBlockDecl

-- |Is the declaration a block declaration?
isBlockDecl :: Decl a -> Bool
isBlockDecl :: Decl a -> Bool
isBlockDecl = (Bool -> Bool -> Bool -> Bool)
-> (Decl a -> Bool)
-> (Decl a -> Bool)
-> (Decl a -> Bool)
-> Decl a
-> Bool
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 ((Bool -> Bool -> Bool) -> (Bool -> Bool) -> Bool -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> Bool -> Bool
(||) ((Bool -> Bool) -> Bool -> Bool -> Bool)
-> (Bool -> Bool -> Bool) -> Bool -> Bool -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> Bool
(||)) Decl a -> Bool
forall a. Decl a -> Bool
isInfixDecl Decl a -> Bool
forall a. Decl a -> Bool
isTypeSig Decl a -> Bool
forall a. Decl a -> Bool
isValueDecl

-- |Is the declaration an infix declaration?
isInfixDecl :: Decl a -> Bool
isInfixDecl :: Decl a -> Bool
isInfixDecl (InfixDecl _ _ _ _) = Bool
True
isInfixDecl _                   = Bool
False

-- |Is the declaration a type declaration?
isTypeDecl :: Decl a -> Bool
isTypeDecl :: Decl a -> Bool
isTypeDecl (DataDecl     _ _ _ _ _) = Bool
True
isTypeDecl (ExternalDataDecl _ _ _) = Bool
True
isTypeDecl (NewtypeDecl  _ _ _ _ _) = Bool
True
isTypeDecl (TypeDecl       _ _ _ _) = Bool
True
isTypeDecl _                        = Bool
False

-- |Is the declaration a default declaration?
isDefaultDecl :: Decl a -> Bool
isDefaultDecl :: Decl a -> Bool
isDefaultDecl (DefaultDecl _ _) = Bool
True
isDefaultDecl _                 = Bool
False

-- |Is the declaration a class declaration?
isClassDecl :: Decl a -> Bool
isClassDecl :: Decl a -> Bool
isClassDecl (ClassDecl _ _ _ _ _) = Bool
True
isClassDecl _                     = Bool
False

-- |Is the declaration a type or a class declaration?
isTypeOrClassDecl :: Decl a -> Bool
isTypeOrClassDecl :: Decl a -> Bool
isTypeOrClassDecl = (Bool -> Bool -> Bool)
-> (Decl a -> Bool) -> (Decl a -> Bool) -> Decl a -> Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(||) Decl a -> Bool
forall a. Decl a -> Bool
isTypeDecl Decl a -> Bool
forall a. Decl a -> Bool
isClassDecl

-- |Is the declaration an instance declaration?
isInstanceDecl :: Decl a -> Bool
isInstanceDecl :: Decl a -> Bool
isInstanceDecl (InstanceDecl _ _ _ _ _) = Bool
True
isInstanceDecl _                        = Bool
False

-- |Is the declaration a type signature?
isTypeSig :: Decl a -> Bool
isTypeSig :: Decl a -> Bool
isTypeSig (TypeSig           _ _ _) = Bool
True
isTypeSig _                         = Bool
False

-- |Is the declaration a value declaration?
isValueDecl :: Decl a -> Bool
isValueDecl :: Decl a -> Bool
isValueDecl (FunctionDecl    _ _ _ _) = Bool
True
isValueDecl (ExternalDecl        _ _) = Bool
True
isValueDecl (PatternDecl       _ _ _) = Bool
True
isValueDecl (FreeDecl            _ _) = Bool
True
isValueDecl _                         = Bool
False

-- |Is the declaration a function declaration?
isFunctionDecl :: Decl a -> Bool
isFunctionDecl :: Decl a -> Bool
isFunctionDecl (FunctionDecl _ _ _ _) = Bool
True
isFunctionDecl _                      = Bool
False

-- |Is the declaration an external declaration?
isExternalDecl :: Decl a -> Bool
isExternalDecl :: Decl a -> Bool
isExternalDecl (ExternalDecl _ _) = Bool
True
isExternalDecl _                  = Bool
False

-- |Is the pattern semantically equivalent to a variable pattern?
isVariablePattern :: Pattern a -> Bool
isVariablePattern :: Pattern a -> Bool
isVariablePattern (VariablePattern _ _ _) = Bool
True
isVariablePattern (ParenPattern    _   t :: Pattern a
t) = Pattern a -> Bool
forall a. Pattern a -> Bool
isVariablePattern Pattern a
t
isVariablePattern (AsPattern       _ _ t :: Pattern a
t) = Pattern a -> Bool
forall a. Pattern a -> Bool
isVariablePattern Pattern a
t
isVariablePattern (LazyPattern     _   _) = Bool
True
isVariablePattern _                       = Bool
False

-- |Is a type expression a type variable?
isVariableType :: TypeExpr -> Bool
isVariableType :: TypeExpr -> Bool
isVariableType (VariableType _ _) = Bool
True
isVariableType _                  = Bool
False

-- |Is a type expression simple, i.e., is it of the form T u_1 ... u_n,
-- where T is a type constructor and u_1 ... u_n are type variables?
isSimpleType :: TypeExpr -> Bool
isSimpleType :: TypeExpr -> Bool
isSimpleType (ConstructorType _ _) = Bool
True
isSimpleType (ApplyType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = TypeExpr -> Bool
isSimpleType TypeExpr
ty1 Bool -> Bool -> Bool
&& TypeExpr -> Bool
isVariableType TypeExpr
ty2
isSimpleType (VariableType   _  _) = Bool
False
isSimpleType (TupleType    _  tys :: [TypeExpr]
tys) = (TypeExpr -> Bool) -> [TypeExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TypeExpr -> Bool
isVariableType [TypeExpr]
tys
isSimpleType (ListType      _  ty :: TypeExpr
ty) = TypeExpr -> Bool
isVariableType TypeExpr
ty
isSimpleType (ArrowType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = TypeExpr -> Bool
isVariableType TypeExpr
ty1 Bool -> Bool -> Bool
&& TypeExpr -> Bool
isVariableType TypeExpr
ty2
isSimpleType (ParenType     _  ty :: TypeExpr
ty) = TypeExpr -> Bool
isSimpleType TypeExpr
ty
isSimpleType (ForallType    _ _ _) = Bool
False

-- |Return the qualified type constructor of a type expression.
typeConstr :: TypeExpr -> QualIdent
typeConstr :: TypeExpr -> QualIdent
typeConstr (ConstructorType   _ tc :: QualIdent
tc) = QualIdent
tc
typeConstr (ApplyType       _ ty :: TypeExpr
ty _) = TypeExpr -> QualIdent
typeConstr TypeExpr
ty
typeConstr (TupleType        _ tys :: [TypeExpr]
tys) = Int -> QualIdent
qTupleId ([TypeExpr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeExpr]
tys)
typeConstr (ListType           _ _) = QualIdent
qListId
typeConstr (ArrowType        _ _ _) = QualIdent
qArrowId
typeConstr (ParenType         _ ty :: TypeExpr
ty) = TypeExpr -> QualIdent
typeConstr TypeExpr
ty
typeConstr (VariableType       _ _) =
  FilePath -> QualIdent
forall a. HasCallStack => FilePath -> a
error "Curry.Syntax.Utils.typeConstr: variable type"
typeConstr (ForallType       _ _ _) =
  FilePath -> QualIdent
forall a. HasCallStack => FilePath -> a
error "Curry.Syntax.Utils.typeConstr: forall type"

-- |Return the list of variables occuring in a type expression.
typeVariables :: TypeExpr -> [Ident]
typeVariables :: TypeExpr -> [Ident]
typeVariables (ConstructorType       _ _) = []
typeVariables (ApplyType       _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = TypeExpr -> [Ident]
typeVariables TypeExpr
ty1 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Ident]
typeVariables TypeExpr
ty2
typeVariables (VariableType         _ tv :: Ident
tv) = [Ident
tv]
typeVariables (TupleType           _ tys :: [TypeExpr]
tys) = (TypeExpr -> [Ident]) -> [TypeExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypeExpr -> [Ident]
typeVariables [TypeExpr]
tys
typeVariables (ListType             _ ty :: TypeExpr
ty) = TypeExpr -> [Ident]
typeVariables TypeExpr
ty
typeVariables (ArrowType       _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = TypeExpr -> [Ident]
typeVariables TypeExpr
ty1 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Ident]
typeVariables TypeExpr
ty2
typeVariables (ParenType            _ ty :: TypeExpr
ty) = TypeExpr -> [Ident]
typeVariables TypeExpr
ty
typeVariables (ForallType        _ vs :: [Ident]
vs ty :: TypeExpr
ty) = [Ident]
vs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Ident]
typeVariables TypeExpr
ty

-- |Return the identifier of a variable.
varIdent :: Var a -> Ident
varIdent :: Var a -> Ident
varIdent (Var _ v :: Ident
v) = Ident
v

-- |Convert an infix operator into an expression
infixOp :: InfixOp a -> Expression a
infixOp :: InfixOp a -> Expression a
infixOp (InfixOp     a :: a
a op :: QualIdent
op) = SpanInfo -> a -> QualIdent -> Expression a
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo a
a QualIdent
op
infixOp (InfixConstr a :: a
a op :: QualIdent
op) = SpanInfo -> a -> QualIdent -> Expression a
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo a
a QualIdent
op

-- |flatten the left-hand-side to the identifier and all constructor terms
flatLhs :: Lhs a -> (Ident, [Pattern a])
flatLhs :: Lhs a -> (Ident, [Pattern a])
flatLhs lhs :: Lhs a
lhs = Lhs a -> [Pattern a] -> (Ident, [Pattern a])
forall a. Lhs a -> [Pattern a] -> (Ident, [Pattern a])
flat Lhs a
lhs []
  where flat :: Lhs a -> [Pattern a] -> (Ident, [Pattern a])
flat (FunLhs    _ f :: Ident
f ts :: [Pattern a]
ts) ts' :: [Pattern a]
ts' = (Ident
f, [Pattern a]
ts [Pattern a] -> [Pattern a] -> [Pattern a]
forall a. [a] -> [a] -> [a]
++ [Pattern a]
ts')
        flat (OpLhs _ t1 :: Pattern a
t1 op :: Ident
op t2 :: Pattern a
t2) ts' :: [Pattern a]
ts' = (Ident
op, Pattern a
t1 Pattern a -> [Pattern a] -> [Pattern a]
forall a. a -> [a] -> [a]
: Pattern a
t2 Pattern a -> [Pattern a] -> [Pattern a]
forall a. a -> [a] -> [a]
: [Pattern a]
ts')
        flat (ApLhs  _ lhs' :: Lhs a
lhs' ts :: [Pattern a]
ts) ts' :: [Pattern a]
ts' = Lhs a -> [Pattern a] -> (Ident, [Pattern a])
flat Lhs a
lhs' ([Pattern a]
ts [Pattern a] -> [Pattern a] -> [Pattern a]
forall a. [a] -> [a] -> [a]
++ [Pattern a]
ts')

-- |Return the arity of an equation.
eqnArity :: Equation a -> Int
eqnArity :: Equation a -> Int
eqnArity (Equation _ lhs :: Lhs a
lhs _) = [Pattern a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Pattern a] -> Int) -> [Pattern a] -> Int
forall a b. (a -> b) -> a -> b
$ (Ident, [Pattern a]) -> [Pattern a]
forall a b. (a, b) -> b
snd ((Ident, [Pattern a]) -> [Pattern a])
-> (Ident, [Pattern a]) -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ Lhs a -> (Ident, [Pattern a])
forall a. Lhs a -> (Ident, [Pattern a])
flatLhs Lhs a
lhs

-- |Select the label of a field
fieldLabel :: Field a -> QualIdent
fieldLabel :: Field a -> QualIdent
fieldLabel (Field _ l :: QualIdent
l _) = QualIdent
l

-- |Select the term of a field
fieldTerm :: Field a -> a
fieldTerm :: Field a -> a
fieldTerm (Field _ _ t :: a
t) = a
t

-- |Select the label and term of a field
field2Tuple :: Field a -> (QualIdent, a)
field2Tuple :: Field a -> (QualIdent, a)
field2Tuple (Field _ l :: QualIdent
l t :: a
t) = (QualIdent
l, a
t)

-- |Get the operator name of an infix operator
opName :: InfixOp a -> QualIdent
opName :: InfixOp a -> QualIdent
opName (InfixOp     _ op :: QualIdent
op) = QualIdent
op
opName (InfixConstr _ c :: QualIdent
c ) = QualIdent
c

-- | Get the identifier of a constructor declaration
constrId :: ConstrDecl -> Ident
constrId :: ConstrDecl -> Ident
constrId (ConstrDecl  _ c :: Ident
c  _) = Ident
c
constrId (ConOpDecl _ _ op :: Ident
op _) = Ident
op
constrId (RecordDecl  _ c :: Ident
c  _) = Ident
c

-- | Get the identifier of a newtype constructor declaration
nconstrId :: NewConstrDecl -> Ident
nconstrId :: NewConstrDecl -> Ident
nconstrId (NewConstrDecl _ c :: Ident
c _) = Ident
c
nconstrId (NewRecordDecl _ c :: Ident
c _) = Ident
c

-- | Get the type of a newtype constructor declaration
nconstrType :: NewConstrDecl -> TypeExpr
nconstrType :: NewConstrDecl -> TypeExpr
nconstrType (NewConstrDecl      _ _ ty :: TypeExpr
ty) = TypeExpr
ty
nconstrType (NewRecordDecl _ _ (_, ty :: TypeExpr
ty)) = TypeExpr
ty

-- | Get record label identifiers of a constructor declaration
recordLabels :: ConstrDecl -> [Ident]
recordLabels :: ConstrDecl -> [Ident]
recordLabels (ConstrDecl   _ _ _) = []
recordLabels (ConOpDecl _ _ _  _) = []
recordLabels (RecordDecl  _ _ fs :: [FieldDecl]
fs) = [Ident
l | FieldDecl _ ls :: [Ident]
ls _ <- [FieldDecl]
fs, Ident
l <- [Ident]
ls]

-- | Get record label identifier of a newtype constructor declaration
nrecordLabels :: NewConstrDecl -> [Ident]
nrecordLabels :: NewConstrDecl -> [Ident]
nrecordLabels (NewConstrDecl _ _ _     ) = []
nrecordLabels (NewRecordDecl _ _ (l :: Ident
l, _)) = [Ident
l]

-- | Get the declared method identifiers of a type class method declaration
methods :: Decl a -> [Ident]
methods :: Decl a -> [Ident]
methods (TypeSig _ fs :: [Ident]
fs _) = [Ident]
fs
methods _                = []

-- | Get the method identifiers of a type class method implementations
impls :: Decl a -> [Ident]
impls :: Decl a -> [Ident]
impls (FunctionDecl _ _ f :: Ident
f _) = [Ident
f]
impls _                      = []

-- | Get the declared method identifier of an interface method declaration
imethod :: IMethodDecl -> Ident
imethod :: IMethodDecl -> Ident
imethod (IMethodDecl _ f :: Ident
f _ _) = Ident
f

-- | Get the arity of an interface method declaration
imethodArity :: IMethodDecl -> Maybe Int
imethodArity :: IMethodDecl -> Maybe Int
imethodArity (IMethodDecl _ _ a :: Maybe Int
a _) = Maybe Int
a

--------------------------------------------------------
-- constructing elements of the abstract syntax tree
--------------------------------------------------------

funDecl :: SpanInfo -> a -> Ident -> [Pattern a] -> Expression a -> Decl a
funDecl :: SpanInfo -> a -> Ident -> [Pattern a] -> Expression a -> Decl a
funDecl spi :: SpanInfo
spi a :: a
a f :: Ident
f ts :: [Pattern a]
ts e :: Expression a
e = SpanInfo -> a -> Ident -> [Equation a] -> Decl a
forall a. SpanInfo -> a -> Ident -> [Equation a] -> Decl a
FunctionDecl SpanInfo
spi a
a Ident
f [SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
forall a.
SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation SpanInfo
spi Ident
f [Pattern a]
ts Expression a
e]

mkEquation :: SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation :: SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation spi :: SpanInfo
spi f :: Ident
f ts :: [Pattern a]
ts e :: Expression a
e = SpanInfo -> Lhs a -> Rhs a -> Equation a
forall a. SpanInfo -> Lhs a -> Rhs a -> Equation a
Equation SpanInfo
spi (SpanInfo -> Ident -> [Pattern a] -> Lhs a
forall a. SpanInfo -> Ident -> [Pattern a] -> Lhs a
FunLhs SpanInfo
NoSpanInfo Ident
f [Pattern a]
ts) (SpanInfo -> Expression a -> Rhs a
forall a. SpanInfo -> Expression a -> Rhs a
simpleRhs SpanInfo
NoSpanInfo Expression a
e)

simpleRhs :: SpanInfo -> Expression a -> Rhs a
simpleRhs :: SpanInfo -> Expression a -> Rhs a
simpleRhs spi :: SpanInfo
spi e :: Expression a
e = SpanInfo -> Expression a -> [Decl a] -> Rhs a
forall a. SpanInfo -> Expression a -> [Decl a] -> Rhs a
SimpleRhs SpanInfo
spi Expression a
e []

patDecl :: SpanInfo -> Pattern a -> Expression a -> Decl a
patDecl :: SpanInfo -> Pattern a -> Expression a -> Decl a
patDecl spi :: SpanInfo
spi t :: Pattern a
t e :: Expression a
e = SpanInfo -> Pattern a -> Rhs a -> Decl a
forall a. SpanInfo -> Pattern a -> Rhs a -> Decl a
PatternDecl SpanInfo
spi Pattern a
t (SpanInfo -> Expression a -> [Decl a] -> Rhs a
forall a. SpanInfo -> Expression a -> [Decl a] -> Rhs a
SimpleRhs SpanInfo
spi Expression a
e [])

varDecl :: SpanInfo -> a -> Ident -> Expression a -> Decl a
varDecl :: SpanInfo -> a -> Ident -> Expression a -> Decl a
varDecl p :: SpanInfo
p ty :: a
ty = SpanInfo -> Pattern a -> Expression a -> Decl a
forall a. SpanInfo -> Pattern a -> Expression a -> Decl a
patDecl SpanInfo
p (Pattern a -> Expression a -> Decl a)
-> (Ident -> Pattern a) -> Ident -> Expression a -> Decl a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanInfo -> a -> Ident -> Pattern a
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo a
ty

constrPattern :: a -> QualIdent -> [(a, Ident)] -> Pattern a
constrPattern :: a -> QualIdent -> [(a, Ident)] -> Pattern a
constrPattern ty :: a
ty c :: QualIdent
c = SpanInfo -> a -> QualIdent -> [Pattern a] -> Pattern a
forall a. SpanInfo -> a -> QualIdent -> [Pattern a] -> Pattern a
ConstructorPattern SpanInfo
NoSpanInfo a
ty QualIdent
c
                   ([Pattern a] -> Pattern a)
-> ([(a, Ident)] -> [Pattern a]) -> [(a, Ident)] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Ident) -> Pattern a) -> [(a, Ident)] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Ident -> Pattern a) -> (a, Ident) -> Pattern a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> a -> Ident -> Pattern a
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo))

caseAlt :: SpanInfo -> Pattern a -> Expression a -> Alt a
caseAlt :: SpanInfo -> Pattern a -> Expression a -> Alt a
caseAlt spi :: SpanInfo
spi t :: Pattern a
t e :: Expression a
e = SpanInfo -> Pattern a -> Rhs a -> Alt a
forall a. SpanInfo -> Pattern a -> Rhs a -> Alt a
Alt SpanInfo
spi Pattern a
t (SpanInfo -> Expression a -> [Decl a] -> Rhs a
forall a. SpanInfo -> Expression a -> [Decl a] -> Rhs a
SimpleRhs SpanInfo
spi Expression a
e [])

mkLet :: [Decl a] -> Expression a -> Expression a
mkLet :: [Decl a] -> Expression a -> Expression a
mkLet ds :: [Decl a]
ds e :: Expression a
e = if [Decl a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl a]
ds then Expression a
e else SpanInfo -> [Decl a] -> Expression a -> Expression a
forall a. SpanInfo -> [Decl a] -> Expression a -> Expression a
Let SpanInfo
NoSpanInfo [Decl a]
ds Expression a
e

mkVar :: a -> Ident -> Expression a
mkVar :: a -> Ident -> Expression a
mkVar ty :: a
ty = SpanInfo -> a -> QualIdent -> Expression a
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo a
ty (QualIdent -> Expression a)
-> (Ident -> QualIdent) -> Ident -> Expression a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify

apply :: Expression a -> [Expression a] -> Expression a
apply :: Expression a -> [Expression a] -> Expression a
apply = (Expression a -> Expression a -> Expression a)
-> Expression a -> [Expression a] -> Expression a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SpanInfo -> Expression a -> Expression a -> Expression a
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo)

unapply :: Expression a -> [Expression a] -> (Expression a, [Expression a])
unapply :: Expression a -> [Expression a] -> (Expression a, [Expression a])
unapply (Apply _ e1 :: Expression a
e1 e2 :: Expression a
e2) es :: [Expression a]
es = Expression a -> [Expression a] -> (Expression a, [Expression a])
forall a.
Expression a -> [Expression a] -> (Expression a, [Expression a])
unapply Expression a
e1 (Expression a
e2 Expression a -> [Expression a] -> [Expression a]
forall a. a -> [a] -> [a]
: [Expression a]
es)
unapply e :: Expression a
e               es :: [Expression a]
es = (Expression a
e, [Expression a]
es)


--------------------------------------------------------
-- Shorten Module
-- Module Pragmas and Equations will be removed
--------------------------------------------------------

shortenModuleAST :: Module () -> Module ()
shortenModuleAST :: Module () -> Module ()
shortenModuleAST = Module () -> Module ()
forall a. ShortenAST a => a -> a
shortenAST

class ShortenAST a where
  shortenAST :: a -> a

instance ShortenAST (Module a) where
  shortenAST :: Module a -> Module a
shortenAST (Module spi :: SpanInfo
spi _ mid :: ModuleIdent
mid ex :: Maybe ExportSpec
ex im :: [ImportDecl]
im ds :: [Decl a]
ds) =
    SpanInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
forall a.
SpanInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi [] ModuleIdent
mid Maybe ExportSpec
ex [ImportDecl]
im ((Decl a -> Decl a) -> [Decl a] -> [Decl a]
forall a b. (a -> b) -> [a] -> [b]
map Decl a -> Decl a
forall a. ShortenAST a => a -> a
shortenAST [Decl a]
ds)

instance ShortenAST (Decl a) where
  shortenAST :: Decl a -> Decl a
shortenAST (FunctionDecl spi :: SpanInfo
spi a :: a
a idt :: Ident
idt _) =
    SpanInfo -> a -> Ident -> [Equation a] -> Decl a
forall a. SpanInfo -> a -> Ident -> [Equation a] -> Decl a
FunctionDecl SpanInfo
spi a
a Ident
idt []
  shortenAST (ClassDecl spi :: SpanInfo
spi cx :: Context
cx cls :: Ident
cls tyv :: Ident
tyv ds :: [Decl a]
ds) =
    SpanInfo -> Context -> Ident -> Ident -> [Decl a] -> Decl a
forall a.
SpanInfo -> Context -> Ident -> Ident -> [Decl a] -> Decl a
ClassDecl SpanInfo
spi Context
cx Ident
cls Ident
tyv ((Decl a -> Decl a) -> [Decl a] -> [Decl a]
forall a b. (a -> b) -> [a] -> [b]
map Decl a -> Decl a
forall a. ShortenAST a => a -> a
shortenAST [Decl a]
ds)
  shortenAST (InstanceDecl spi :: SpanInfo
spi cx :: Context
cx cls :: QualIdent
cls tyv :: TypeExpr
tyv ds :: [Decl a]
ds) =
    SpanInfo -> Context -> QualIdent -> TypeExpr -> [Decl a] -> Decl a
forall a.
SpanInfo -> Context -> QualIdent -> TypeExpr -> [Decl a] -> Decl a
InstanceDecl SpanInfo
spi Context
cx QualIdent
cls TypeExpr
tyv ((Decl a -> Decl a) -> [Decl a] -> [Decl a]
forall a b. (a -> b) -> [a] -> [b]
map Decl a -> Decl a
forall a. ShortenAST a => a -> a
shortenAST [Decl a]
ds)
  shortenAST d :: Decl a
d = Decl a
d