never executed always true always false
1 {-# LANGUAGE QuasiQuotes #-}
2
3 module Conjure.Rules.Vertical.Set.Explicit where
4
5 import Conjure.Rules.Import
6
7
8 rule_Comprehension :: Rule
9 rule_Comprehension = "set-comprehension{Explicit}" `namedRule` theRule where
10 theRule (Comprehension body gensOrConds) = do
11 (gocBefore, (pat, s), gocAfter) <- matchFirst gensOrConds $ \ goc -> case goc of
12 Generator (GenInExpr pat@Single{} s) -> return (pat, matchDefs [opToSet,opToMSet] s)
13 _ -> na "rule_Comprehension"
14 TypeSet{} <- typeOf s
15 Set_Explicit <- representationOf s
16 [m] <- downX1 s
17 DomainMatrix index _ <- domainOf m
18 let upd val old = lambdaToFunction pat old val
19 return
20 ( "Vertical rule for set-comprehension, Explicit representation"
21 , do
22 (jPat, j) <- quantifiedVar
23 let val = [essence| &m[&j] |]
24 return $ Comprehension (upd val body)
25 $ gocBefore
26 ++ [ Generator (GenDomainNoRepr jPat index) ]
27 ++ transformBi (upd val) gocAfter
28 )
29 theRule _ = na "rule_Comprehension"
30
31
32 rule_PowerSet_Comprehension :: Rule
33 rule_PowerSet_Comprehension = "set-powerSet-comprehension{Explicit}" `namedRule` theRule where
34 theRule (Comprehension body gensOrConds) = do
35 (gocBefore, (setPat, setPatNum, expr), gocAfter) <- matchFirst gensOrConds $ \ goc -> case goc of
36 Generator (GenInExpr setPat@(AbsPatSet pats) expr) -> return (setPat, length pats, expr)
37 _ -> na "rule_PowerSet_Comprehension"
38 s <- match opPowerSet expr
39 TypeSet{} <- typeOf s
40 Set_Explicit <- representationOf s
41 [m] <- downX1 s
42 DomainMatrix index _ <- domainOf m
43 let upd val old = lambdaToFunction setPat old val
44 return
45 ( "Vertical rule for set-comprehension, Explicit representation"
46 , do
47 outPats <- replicateM setPatNum quantifiedVar
48 let val = AbstractLiteral $ AbsLitSet [ [essence| &m[&j] |] | (_,j) <- outPats ]
49 return $ Comprehension (upd val body) $ concat
50 [ gocBefore
51 , concat
52 [ [ Generator (GenDomainNoRepr pat index) ]
53 | (pat,_) <- take 1 outPats
54 ]
55 , concat
56 [ [ Generator (GenDomainNoRepr pat index)
57 , Condition [essence| &patX > &beforeX |]
58 ]
59 | ((_, beforeX), (pat, patX)) <- zip outPats (tail outPats)
60 ]
61 , transformBi (upd val) gocAfter
62 ]
63 )
64 theRule _ = na "rule_PowerSet_Comprehension"
65
66
67 rule_Card :: Rule
68 rule_Card = "set-card{Explicit}" `namedRule` theRule where
69 theRule p = do
70 s <- match opTwoBars p
71 TypeSet{} <- typeOf s
72 Set_Explicit <- representationOf s
73 DomainSet _ (SetAttr (SizeAttr_Size n)) _ <- domainOf s
74 return
75 ( "Vertical rule for set cardinality, Explicit representation."
76 , return n
77 )
78
79
80 -- | the first member
81 rule_Min :: Rule
82 rule_Min = "set-min{Explicit}" `namedRule` theRule where
83 theRule p = do
84 s <- match opMin p
85 TypeSet{} <- typeOf s
86 Set_Explicit <- representationOf s
87 [m] <- downX1 s
88 DomainMatrix index _ <- domainOf m
89 minInIndex <-
90 case index of
91 DomainInt _ [RangeBounded lb _] -> return lb
92 _ -> do
93 (jPat, j) <- quantifiedVar
94 return [essence| min([&j | &jPat : &index]) |]
95 return
96 ( "Vertical rule for set min, Explicit representation."
97 , return [essence| &m[&minInIndex] |]
98 )
99
100
101 -- | the last member
102 rule_Max :: Rule
103 rule_Max = "set-max{Explicit}" `namedRule` theRule where
104 theRule p = do
105 s <- match opMax p
106 TypeSet{} <- typeOf s
107 Set_Explicit <- representationOf s
108 [m] <- downX1 s
109 DomainMatrix index _ <- domainOf m
110 maxInIndex <-
111 case index of
112 DomainInt _ [RangeBounded _ ub] -> return ub
113 _ -> do
114 (jPat, j) <- quantifiedVar
115 return [essence| max([&j | &jPat : &index]) |]
116 return
117 ( "Vertical rule for set max, Explicit representation."
118 , return [essence| &m[&maxInIndex] |]
119 )
120
121
122 rule_In :: Rule
123 rule_In = "set-in-table{Explicit}" `namedRule` theRule where
124 theRule [essence| &x in &set |] = do
125 TypeSet{} <- typeOf set
126 Set_Explicit <- representationOf set
127 tableCheck x set
128 xParts <- downX1 x
129 let vars = fromList xParts
130 [matrix] <- downX1 set
131 (index:_) <- indexDomainsOf matrix
132 parts <- downX1 matrix
133 (iPat, i) <- quantifiedVar
134 let oneRow = fromList [ [essence| &p[&i] |] | p <- parts ]
135 let table = [essence| [ &oneRow | &iPat : &index ] |]
136 return
137 ( "set membership to table"
138 , return [essence| table(&vars, &table) |]
139 )
140 theRule _ = na "rule_In"
141
142 tableCheck ::
143 MonadFailDoc m =>
144 (?typeCheckerMode :: TypeCheckerMode) =>
145 Expression -> Expression -> m ()
146 tableCheck x set | categoryOf set < CatDecision = do
147 tyX <- typeOf x
148 case tyX of
149 TypeTuple ts | and [ case t of TypeInt{} -> True ; _ -> False | t <- ts ] -> return ()
150 _ -> na "rule_In"
151 tableCheck _ _ = na "rule_In"