Expr.hs 6.66 KB
Newer Older
Björn Peemöller 's avatar
Björn Peemöller committed
1 2 3
{- |
    Module      :  $Header$
    Description :  Extraction of free and bound variables
Björn Peemöller 's avatar
Björn Peemöller committed
4
    Copyright   :  (c)             Wolfgang Lux
5
                       2011 - 2015 Björn Peemöller
6
                       2015        Jan Tikovsky
Björn Peemöller 's avatar
Björn Peemöller committed
7 8 9 10 11 12 13
    License     :  OtherLicense

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

    The compiler needs to compute the lists of free and bound variables for
14
    various different entities. We will devote three type classes to that
15
    purpose. The 'QualExpr' class is expected to take into account
16
    that it is possible to use a qualified name to refer to a function
17 18
    defined in the current module and therefore @M.x@ and @x@, where
    @M@ is the current module name, should be considered the same name.
Björn Peemöller 's avatar
Björn Peemöller committed
19
    However, note that this is correct only after renaming all local
20
    definitions as @M.x@ always denotes an entity defined at the
21 22 23 24
    top-level.
-}
module Base.Expr (Expr (..), QualExpr (..), QuantExpr (..)) where

25 26
import           Data.List        (nub)
import qualified Data.Set  as Set (fromList, notMember)
27 28 29 30 31

import Curry.Base.Ident
import Curry.Syntax

class Expr e where
Björn Peemöller 's avatar
Björn Peemöller committed
32
  -- |Free variables in an 'Expr'
33 34 35
  fv :: e -> [Ident]

class QualExpr e where
Björn Peemöller 's avatar
Björn Peemöller committed
36
  -- |Free qualified variables in an 'Expr'
37 38 39
  qfv :: ModuleIdent -> e -> [Ident]

class QuantExpr e where
40
  -- |Bounded variables in an 'Expr'
41 42 43 44 45 46 47 48 49 50 51
  bv :: e -> [Ident]

instance Expr e => Expr [e] where
  fv = concatMap fv

instance QualExpr e => QualExpr [e] where
  qfv m = concatMap (qfv m)

instance QuantExpr e => QuantExpr [e] where
  bv = concatMap bv

52
-- The 'Decl' instance of 'QualExpr' returns all free
53 54 55 56 57 58 59 60 61 62
-- variables on the right hand side, regardless of whether they are bound
-- on the left hand side. This is more convenient as declarations are
-- usually processed in a declaration group where the set of free
-- variables cannot be computed independently for each declaration. Also
-- note that the operator in a unary minus expression is not a free
-- variable. This operator always refers to a global function from the
-- prelude.

instance QualExpr Decl where
  qfv m (FunctionDecl _ _ eqs) = qfv m eqs
Björn Peemöller 's avatar
Björn Peemöller committed
63 64
  qfv m (PatternDecl  _ _ rhs) = qfv m rhs
  qfv _ _                      = []
65 66

instance QuantExpr Decl where
67 68 69 70 71 72 73
  bv (TypeSig        _ vs _) = vs
  bv (FunctionDecl    _ f _) = [f]
  bv (ForeignDecl _ _ _ f _) = [f]
  bv (ExternalDecl     _ fs) = fs
  bv (PatternDecl     _ t _) = bv t
  bv (FreeDecl         _ vs) = vs
  bv _                       = []
74 75

instance QualExpr Equation where
Björn Peemöller 's avatar
Björn Peemöller committed
76
  qfv m (Equation _ lhs rhs) = filterBv lhs $ qfv m lhs ++ qfv m rhs
77 78 79 80 81

instance QuantExpr Lhs where
  bv = bv . snd . flatLhs

instance QualExpr Lhs where
Björn Peemöller 's avatar
Björn Peemöller committed
82
  qfv m lhs = qfv m $ snd $ flatLhs lhs
83 84

instance QualExpr Rhs where
Björn Peemöller 's avatar
Björn Peemöller committed
85 86
  qfv m (SimpleRhs _ e ds) = filterBv ds $ qfv m e  ++ qfv m ds
  qfv m (GuardedRhs es ds) = filterBv ds $ qfv m es ++ qfv m ds
87 88 89 90 91

instance QualExpr CondExpr where
  qfv m (CondExpr _ g e) = qfv m g ++ qfv m e

instance QualExpr Expression where
Björn Peemöller 's avatar
Björn Peemöller committed
92 93 94 95 96
  qfv _ (Literal               _) = []
  qfv m (Variable              v) = maybe [] return $ localIdent m v
  qfv _ (Constructor           _) = []
  qfv m (Paren                 e) = qfv m e
  qfv m (Typed               e _) = qfv m e
97 98
  qfv m (Record             _ fs) = qfv m fs
  qfv m (RecordUpdate       e fs) = qfv m e ++ qfv m fs
Björn Peemöller 's avatar
Björn Peemöller committed
99 100 101 102 103 104
  qfv m (Tuple              _ es) = qfv m es
  qfv m (List               _ es) = qfv m es
  qfv m (ListCompr        _ e qs) = foldr (qfvStmt m) (qfv m e) qs
  qfv m (EnumFrom              e) = qfv m e
  qfv m (EnumFromThen      e1 e2) = qfv m e1 ++ qfv m e2
  qfv m (EnumFromTo        e1 e2) = qfv m e1 ++ qfv m e2
105
  qfv m (EnumFromThenTo e1 e2 e3) = qfv m e1 ++ qfv m e2 ++ qfv m e3
Björn Peemöller 's avatar
Björn Peemöller committed
106 107 108 109 110 111 112 113 114
  qfv m (UnaryMinus          _ e) = qfv m e
  qfv m (Apply             e1 e2) = qfv m e1 ++ qfv m e2
  qfv m (InfixApply     e1 op e2) = qfv m op ++ qfv m e1 ++ qfv m e2
  qfv m (LeftSection        e op) = qfv m op ++ qfv m e
  qfv m (RightSection       op e) = qfv m op ++ qfv m e
  qfv m (Lambda           _ ts e) = filterBv ts $ qfv m e
  qfv m (Let                ds e) = filterBv ds $ qfv m ds ++ qfv m e
  qfv m (Do                sts e) = foldr (qfvStmt m) (qfv m e) sts
  qfv m (IfThenElse   _ e1 e2 e3) = qfv m e1 ++ qfv m e2 ++ qfv m e3
115
  qfv m (Case         _ _ e alts) = qfv m e ++ qfv m alts
116 117 118 119 120

qfvStmt :: ModuleIdent -> Statement -> [Ident] -> [Ident]
qfvStmt m st fvs = qfv m st ++ filterBv st fvs

instance QualExpr Statement where
Björn Peemöller 's avatar
Björn Peemöller committed
121 122
  qfv m (StmtExpr   _ e) = qfv m e
  qfv m (StmtDecl    ds) = filterBv ds $ qfv m ds
123 124 125
  qfv m (StmtBind _ _ e) = qfv m e

instance QualExpr Alt where
Björn Peemöller 's avatar
Björn Peemöller committed
126
  qfv m (Alt _ t rhs) = filterBv t $ qfv m rhs
127 128 129 130 131 132 133 134

instance QuantExpr a => QuantExpr (Field a) where
  bv (Field _ _ t) = bv t

instance QualExpr a => QualExpr (Field a) where
  qfv m (Field _ _ t) = qfv m t

instance QuantExpr Statement where
Björn Peemöller 's avatar
Björn Peemöller committed
135
  bv (StmtExpr   _ _) = []
136
  bv (StmtBind _ t _) = bv t
Björn Peemöller 's avatar
Björn Peemöller committed
137
  bv (StmtDecl    ds) = bv ds
138 139

instance QualExpr InfixOp where
Björn Peemöller 's avatar
Björn Peemöller committed
140
  qfv m (InfixOp    op) = qfv m $ Variable op
141 142
  qfv _ (InfixConstr _) = []

143
instance QuantExpr Pattern where
144 145 146 147 148 149
  bv (LiteralPattern         _) = []
  bv (NegativePattern      _ _) = []
  bv (VariablePattern        v) = [v]
  bv (ConstructorPattern  _ ts) = bv ts
  bv (InfixPattern     t1 _ t2) = bv t1 ++ bv t2
  bv (ParenPattern           t) = bv t
150
  bv (RecordPattern       _ fs) = bv fs
151 152 153 154 155 156
  bv (TuplePattern        _ ts) = bv ts
  bv (ListPattern         _ ts) = bv ts
  bv (AsPattern            v t) = v : bv t
  bv (LazyPattern          _ t) = bv t
  bv (FunctionPattern     _ ts) = nub $ bv ts
  bv (InfixFuncPattern t1 _ t2) = nub $ bv t1 ++ bv t2
157

158
instance QualExpr Pattern where
Björn Peemöller 's avatar
Björn Peemöller committed
159 160 161 162 163 164
  qfv _ (LiteralPattern          _) = []
  qfv _ (NegativePattern       _ _) = []
  qfv _ (VariablePattern         _) = []
  qfv m (ConstructorPattern   _ ts) = qfv m ts
  qfv m (InfixPattern      t1 _ t2) = qfv m [t1, t2]
  qfv m (ParenPattern            t) = qfv m t
165
  qfv m (RecordPattern        _ fs) = qfv m fs
Björn Peemöller 's avatar
Björn Peemöller committed
166 167 168 169 170
  qfv m (TuplePattern         _ ts) = qfv m ts
  qfv m (ListPattern          _ ts) = qfv m ts
  qfv m (AsPattern            _ ts) = qfv m ts
  qfv m (LazyPattern           _ t) = qfv m t
  qfv m (FunctionPattern      f ts)
171 172 173 174 175 176
    = maybe [] return (localIdent m f) ++ qfv m ts
  qfv m (InfixFuncPattern t1 op t2)
    = maybe [] return (localIdent m op) ++ qfv m [t1, t2]

instance Expr TypeExpr where
  fv (ConstructorType _ tys) = fv tys
Björn Peemöller 's avatar
Björn Peemöller committed
177
  fv (VariableType       tv)
178
    | isAnonId tv            = []
Björn Peemöller 's avatar
Björn Peemöller committed
179 180 181 182
    | otherwise              = [tv]
  fv (TupleType         tys) = fv tys
  fv (ListType           ty) = fv ty
  fv (ArrowType     ty1 ty2) = fv ty1 ++ fv ty2
183
  fv (ParenType          ty) = fv ty
184 185 186

filterBv :: QuantExpr e => e -> [Ident] -> [Ident]
filterBv e = filter (`Set.notMember` Set.fromList (bv e))