Expr.hs 7.54 KB
 Björn Peemöller committed Jun 24, 2011 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 {- |Free and bound variables The compiler needs to compute the sets of free and bound variables for various different entities. We will devote three type classes to that purpose. The \texttt{QualExpr} class is expected to take into account that it is possible to use a qualified name to refer to a function defined in the current module and therefore \emph{M.x} and $x$, where $M$ is the current module name, should be considered the same name. However note that this is correct only after renaming all local definitions as \emph{M.x} always denotes an entity defined at the top-level. -} module Base.Expr (Expr (..), QualExpr (..), QuantExpr (..)) where import qualified Data.Set as Set (fromList, notMember) import Curry.Base.Ident import Curry.Syntax import qualified IL class Expr e where fv :: e -> [Ident] class QualExpr e where qfv :: ModuleIdent -> e -> [Ident] class QuantExpr e where 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 -- The \texttt{Decl} instance of \texttt{QualExpr} returns all free -- 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 qfv m (PatternDecl _ _ rhs) = qfv m rhs qfv _ _ = [] instance QuantExpr Decl where bv (TypeSig _ vs _) = vs bv (EvalAnnot _ fs _) = fs bv (FunctionDecl _ f _) = [f] bv (ExternalDecl _ _ _ f _) = [f] bv (FlatExternalDecl _ fs) = fs bv (PatternDecl _ t _) = bv t bv (ExtraVariables _ vs) = vs bv _ = [] instance QualExpr Equation where qfv m (Equation _ lhs rhs) = filterBv lhs (qfv m lhs ++ qfv m rhs) instance QuantExpr Lhs where bv = bv . snd . flatLhs instance QualExpr Lhs where qfv m lhs = qfv m (snd (flatLhs lhs)) instance QualExpr Rhs where 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) instance QualExpr CondExpr where qfv m (CondExpr _ g e) = qfv m g ++ qfv m e instance QualExpr Expression where 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 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 qfv m (EnumFromThenTo e1 e2 e3) = qfv m e1 ++ qfv m e2 ++ qfv m e3 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 qfv m (Case _ e alts) = qfv m e ++ qfv m alts qfv m (RecordConstr fs) = qfv m fs qfv m (RecordSelection e _) = qfv m e qfv m (RecordUpdate fs e) = qfv m e ++ qfv m fs qfvStmt :: ModuleIdent -> Statement -> [Ident] -> [Ident] qfvStmt m st fvs = qfv m st ++ filterBv st fvs instance QualExpr Statement where qfv m (StmtExpr _ e) = qfv m e qfv m (StmtDecl ds) = filterBv ds (qfv m ds) qfv m (StmtBind _ _ e) = qfv m e instance QualExpr Alt where qfv m (Alt _ t rhs) = filterBv t (qfv m rhs) 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 bv (StmtExpr _ _) = [] bv (StmtBind _ t _) = bv t bv (StmtDecl ds) = bv ds instance QualExpr InfixOp where qfv m (InfixOp op) = qfv m (Variable op) qfv _ (InfixConstr _) = [] instance QuantExpr ConstrTerm where 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 bv (TuplePattern _ ts) = bv ts bv (ListPattern _ ts) = bv ts bv (AsPattern v t) = v : bv t bv (LazyPattern _ t) = bv t bv (FunctionPattern f ts) = bvFuncPatt (FunctionPattern f ts) bv (InfixFuncPattern t1 op t2) = bvFuncPatt (InfixFuncPattern t1 op t2) bv (RecordPattern fs r) = maybe [] bv r ++ bv fs instance QualExpr ConstrTerm where 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 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) = maybe [] return (localIdent m f) ++ qfv m ts qfv m (InfixFuncPattern t1 op t2) = maybe [] return (localIdent m op) ++ qfv m [t1, t2] qfv m (RecordPattern fs r) = maybe [] (qfv m) r ++ qfv m fs instance Expr TypeExpr where fv (ConstructorType _ tys) = fv tys fv (VariableType tv) | tv == anonId = [] | otherwise = [tv] fv (TupleType tys) = fv tys fv (ListType ty) = fv ty fv (ArrowType ty1 ty2) = fv ty1 ++ fv ty2 fv (RecordType fs rty) = maybe [] fv rty ++ fv (map snd fs) filterBv :: QuantExpr e => e -> [Ident] -> [Ident] filterBv e = filter (Set.notMember Set.fromList (bv e)) -- Since multiple variable occurrences are allowed in function patterns, -- it is necessary to compute the list of bound variables in a different way: -- Each variable occuring in the function pattern will be unique in the result -- list. bvFuncPatt :: ConstrTerm -> [Ident] bvFuncPatt = bvfp [] where bvfp bvs (LiteralPattern _) = bvs bvfp bvs (NegativePattern _ _) = bvs bvfp bvs (VariablePattern v) | v elem bvs = bvs | otherwise = v : bvs bvfp bvs (ConstructorPattern _ ts) = foldl bvfp bvs ts bvfp bvs (InfixPattern t1 _ t2) = foldl bvfp bvs [t1, t2] bvfp bvs (ParenPattern t) = bvfp bvs t bvfp bvs (TuplePattern _ ts) = foldl bvfp bvs ts bvfp bvs (ListPattern _ ts) = foldl bvfp bvs ts bvfp bvs (AsPattern v t) | v elem bvs = bvfp bvs t | otherwise = bvfp (v : bvs) t bvfp bvs (LazyPattern _ t) = bvfp bvs t bvfp bvs (FunctionPattern _ ts) = foldl bvfp bvs ts bvfp bvs (InfixFuncPattern t1 _ t2) = foldl bvfp bvs [t1, t2] bvfp bvs (RecordPattern fs r) = foldl bvfp (maybe bvs (bvfp bvs) r) (map fieldTerm fs) -- intermediate language instance Expr IL.Expression where fv (IL.Variable v) = [v] fv (IL.Apply e1 e2) = fv e1 ++ fv e2 fv (IL.Case _ _ e alts) = fv e ++ fv alts fv (IL.Or e1 e2) = fv e1 ++ fv e2 fv (IL.Exist v e) = filter (/= v) (fv e) fv (IL.Let (IL.Binding v e1) e2) = fv e1 ++ filter (/= v) (fv e2) fv (IL.Letrec bds e) = filter (notElem vs) (fv es ++ fv e) where (vs,es) = unzip [(v,e') | IL.Binding v e' <- bds] fv _ = [] instance Expr IL.Alt where fv (IL.Alt (IL.ConstructorPattern _ vs) e) = filter (notElem vs) (fv e) fv (IL.Alt (IL.VariablePattern v) e) = filter (v /=) (fv e) fv (IL.Alt _ e) = fv e