Eval.lhs 4.25 KB
Newer Older
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
1
2
3
4
5
6
7
8
9
10
11
12
% $Id: Eval.lhs,v 1.12 2004/02/08 15:35:12 wlux Exp $
%
% Copyright (c) 2001-2004, Wolfgang Lux
% See LICENSE for the full license.
%
\nwfilename{Eval.lhs}
\section{Collecting Evaluation Annotations}
The module \texttt{Eval} computes the evaluation annotation
environment. There is no need to check the annotations because this
happens already while checking the definitions of the module.
\begin{verbatim}

Björn Peemöller 's avatar
Björn Peemöller committed
13
> module Env.Eval (EvalEnv, initEEnv, evalEnv) where
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
14
15
16
17
18
19
20
21
22
23
24
25
26

> import qualified Data.Map as Map

> import Curry.Base.Ident (Ident)
> import Curry.Syntax

> type EvalEnv = Map.Map Ident EvalAnnotation

\end{verbatim}
The function \texttt{evalEnv} collects all evaluation annotations of
the module by traversing the syntax tree.
\begin{verbatim}

27
28
> evalEnv :: Module -> EvalEnv
> evalEnv (Module _ _ _ ds) = foldr collectAnnotsDecl Map.empty ds
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
29

Björn Peemöller 's avatar
Björn Peemöller committed
30
31
32
> initEEnv :: EvalEnv
> initEEnv = Map.empty

Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
33
> collectAnnotsDecl :: Decl -> EvalEnv -> EvalEnv
Björn Peemöller 's avatar
Björn Peemöller committed
34
> collectAnnotsDecl (EvalAnnot    _ fs ev) env = foldr (`Map.insert` ev) env fs
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
35
> collectAnnotsDecl (FunctionDecl _ _ eqs) env = foldr collectAnnotsEqn env eqs
Björn Peemöller 's avatar
Björn Peemöller committed
36
> collectAnnotsDecl (PatternDecl  _ _ rhs) env = collectAnnotsRhs rhs env
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
37
38
39
> collectAnnotsDecl _ env = env

> collectAnnotsEqn :: Equation -> EvalEnv -> EvalEnv
40
> collectAnnotsEqn (Equation _ _ rhs) = collectAnnotsRhs rhs
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
41
42
43
44
45
46
47
48
49
50
51
52

> collectAnnotsRhs :: Rhs -> EvalEnv -> EvalEnv
> collectAnnotsRhs (SimpleRhs _ e ds) env =
>   collectAnnotsExpr e (foldr collectAnnotsDecl env ds)
> collectAnnotsRhs (GuardedRhs es ds) env =
>   foldr collectAnnotsCondExpr (foldr collectAnnotsDecl env ds) es

> collectAnnotsCondExpr :: CondExpr -> EvalEnv -> EvalEnv
> collectAnnotsCondExpr (CondExpr _ g e) env =
>   collectAnnotsExpr g (collectAnnotsExpr e env)

> collectAnnotsExpr :: Expression -> EvalEnv -> EvalEnv
Björn Peemöller 's avatar
Björn Peemöller committed
53
54
55
56
57
58
59
> collectAnnotsExpr (Literal _)        env = env
> collectAnnotsExpr (Variable _)       env = env
> collectAnnotsExpr (Constructor _)    env = env
> collectAnnotsExpr (Paren e)          env = collectAnnotsExpr e env
> collectAnnotsExpr (Typed e _)        env = collectAnnotsExpr e env
> collectAnnotsExpr (Tuple _ es)       env = foldr collectAnnotsExpr env es
> collectAnnotsExpr (List  _ es)       env = foldr collectAnnotsExpr env es
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
60
61
> collectAnnotsExpr (ListCompr _ e qs) env =
>   collectAnnotsExpr e (foldr collectAnnotsStmt env qs)
Björn Peemöller 's avatar
Björn Peemöller committed
62
63
> collectAnnotsExpr (EnumFrom e)              env = collectAnnotsExpr e env
> collectAnnotsExpr (EnumFromThen e1 e2)      env =
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
64
>   collectAnnotsExpr e1 (collectAnnotsExpr e2 env)
Björn Peemöller 's avatar
Björn Peemöller committed
65
> collectAnnotsExpr (EnumFromTo e1 e2)        env =
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
66
67
68
>   collectAnnotsExpr e1 (collectAnnotsExpr e2 env)
> collectAnnotsExpr (EnumFromThenTo e1 e2 e3) env =
>   collectAnnotsExpr e1 (collectAnnotsExpr e2 (collectAnnotsExpr e3 env))
Björn Peemöller 's avatar
Björn Peemöller committed
69
70
> collectAnnotsExpr (UnaryMinus _ e)     env = collectAnnotsExpr e env
> collectAnnotsExpr (Apply e1 e2)        env =
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
71
72
73
>   collectAnnotsExpr e1 (collectAnnotsExpr e2 env)
> collectAnnotsExpr (InfixApply e1 _ e2) env =
>   collectAnnotsExpr e1 (collectAnnotsExpr e2 env)
Björn Peemöller 's avatar
Björn Peemöller committed
74
75
76
77
> collectAnnotsExpr (LeftSection e _)    env = collectAnnotsExpr e env
> collectAnnotsExpr (RightSection _ e)   env = collectAnnotsExpr e env
> collectAnnotsExpr (Lambda _ _ e)       env = collectAnnotsExpr e env
> collectAnnotsExpr (Let ds e)           env =
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
78
>   foldr collectAnnotsDecl (collectAnnotsExpr e env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
79
> collectAnnotsExpr (Do sts e)           env =
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
80
81
82
>   foldr collectAnnotsStmt (collectAnnotsExpr e env) sts
> collectAnnotsExpr (IfThenElse _ e1 e2 e3) env =
>   collectAnnotsExpr e1 (collectAnnotsExpr e2 (collectAnnotsExpr e3 env))
Björn Peemöller 's avatar
Björn Peemöller committed
83
> collectAnnotsExpr (Case _ e alts)         env =
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
84
>   collectAnnotsExpr e (foldr collectAnnotsAlt env alts)
Björn Peemöller 's avatar
Björn Peemöller committed
85
> collectAnnotsExpr (RecordConstr fs)       env =
86
>   foldr (collectAnnotsExpr . fieldTerm) env fs
Björn Peemöller 's avatar
Björn Peemöller committed
87
88
> collectAnnotsExpr (RecordSelection e _)   env = collectAnnotsExpr e env
> collectAnnotsExpr (RecordUpdate fs e)     env =
89
>   foldr (collectAnnotsExpr . fieldTerm) (collectAnnotsExpr e env) fs
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
90
91

> collectAnnotsStmt :: Statement -> EvalEnv -> EvalEnv
92
93
> collectAnnotsStmt (StmtExpr _ e  ) env = collectAnnotsExpr e env
> collectAnnotsStmt (StmtDecl ds   ) env = foldr collectAnnotsDecl env ds
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
94
95
96
> collectAnnotsStmt (StmtBind _ _ e) env = collectAnnotsExpr e env

> collectAnnotsAlt :: Alt -> EvalEnv -> EvalEnv
97
> collectAnnotsAlt (Alt _ _ rhs) = collectAnnotsRhs rhs
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
98
99

\end{verbatim}