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
|
---------------------------------------------------------------------------
--- Set functions are intended to exist for every top-level function.
--- The operation `checkSetUse` detects unintended uses of set funtions.
--- Furthermore, the operation `checkBlacklistUse` checks whether
--- internal operations like `Prelude.=:<=` or `Prelude.prim_` are used
--- in a Curry program.
---
--- See example program `Examples/UsageErrors.curry` for some examples.
---
--- @author Michael Hanus
--- @version February 2015
---------------------------------------------------------------------------
module UsageCheck(checkSetUse, checkBlacklistUse) where
import qualified AbstractCurry.Types as AC
import AbstractCurryMatch
import Char(isDigit)
import FlatCurry.Types
import FlatCurryMatch
import Read(readNat)
import SetFunctions
---------------------------------------------------------------------
--- Returns messages about unintended uses of set functions in a
--- FlatCurry program.
checkSetUse :: Prog -> IO [(QName,String)]
checkSetUse (Prog _ _ _ fdecls _) = do
seterrors <- values2list (set1 setUse fdecls)
return (map showSetError seterrors)
where
showSetError (qf,sar) =
(qf, "wrong use of set function `set" ++ sar ++ "'!")
--- Returns some unintended use of a set function occurring in a list
--- of function declarations. The name of the function together with
--- the arity of the set function used is returned.
--- Set functions are intended to be used only on top-level functions
--- with the right arity.
---
--- To provide a simple implementation, we exploit functional patterns
--- with the function `funWithinExp`.
setUse :: [FuncDecl] -> (QName, String)
--setUse (_ ++ [funWithExp qf (Comb ct ("SetFunctions","set"++n) args)] ++ _)
setUse (_++ [funWithinExp qf _ _ (Comb ct ("SetFunctions","set"++n) args)] ++_)
| not (validSetFunCall ct n args) = (qf,n)
--- Checks whether an application of a set function is as intended.
validSetFunCall :: CombType -> String -> [Expr] -> Bool
validSetFunCall ct n args
| ct==FuncCall && all isDigit n && not (null args)
= if arity==0 then isFuncCall (head args)
else isFuncPartCall arity (head args)
where
arity = readNat n
isFuncCall :: Expr -> Bool
isFuncCall e = case e of
Comb FuncCall qf [] -> isID qf
_ -> False
isFuncPartCall :: Int -> Expr -> Bool
isFuncPartCall n e = case e of
Comb (FuncPartCall p) qf _ -> p==n && isID qf
_ -> False
isID :: QName -> Bool
isID (_,n) = all (`elem` infixIDs) n || '.' `notElem` n
where
infixIDs :: String
infixIDs = "~!@#$%^&*+-=<>?./|\\:"
---------------------------------------------------------------------
--- Returns messages about uses of black-listed operations occurring
--- in an AbstractCurry program.
checkBlacklistUse :: AC.CurryProg -> IO [(QName,String)]
checkBlacklistUse (AC.CurryProg _ _ _ cfdecls _) = do
blerrors <- values2list (set1 blacklistUsage cfdecls)
return (map showBlacklistError blerrors)
where
showBlacklistError (qf,(q,f)) =
(qf, "direct use of `" ++ q++"."++f ++ "' not allowed!")
--- Returns some use of a black-listed operation occurring in a list
--- of function declarations. The name of the defined function together with
--- the black-listed operation is returned.
---
--- To provide a simple implementation, we exploit functional patterns
--- with the function `cfunWithExp`.
---
--- TODO: check also occurrences in functional patterns
blacklistUsage :: [AC.CFuncDecl] -> (AC.QName, AC.QName)
blacklistUsage (_ ++ [cfunWithExp qf (AC.CSymbol qop)] ++ _)
| isBlacklistedOperation qop
= (qf,qop)
isBlacklistedOperation :: AC.QName -> Bool
isBlacklistedOperation (q,f) =
q == AC.preludeName &&
(take 5 f == "prim_" --no direct call to primitive ops
|| f `elem` ["=:<=", "=:<<="])
---------------------------------------------------------------------
|
