Merge pull request #600 from conjure-cp/enum-in-partition

Enum in partition
conjure-cp · Nov 5, 2023 · 92457a0 · 92457a0
2 parents 5061e57 + e338495
commit 92457a0
Show file tree

Hide file tree

Showing 16 changed files with 2,008 additions and 8 deletions.
diff --git a/src/Conjure/Language/Domain.hs b/src/Conjure/Language/Domain.hs
@@ -266,9 +266,9 @@ applyReprTree dom@DomainUnnamed{} (Tree Nothing []) = return (defRepr dom)
 applyReprTree (DomainTuple as  ) (Tree Nothing asRepr) =
     DomainTuple <$> zipWithM applyReprTree as asRepr
 applyReprTree (DomainRecord as ) (Tree Nothing asRepr) =
-    (DomainRecord  . zip (map fst as)) <$> zipWithM applyReprTree (map snd as) asRepr
+    DomainRecord  . zip (map fst as) <$> zipWithM applyReprTree (map snd as) asRepr
 applyReprTree (DomainVariant as) (Tree Nothing asRepr) =
-    (DomainVariant . zip (map fst as)) <$> zipWithM applyReprTree (map snd as) asRepr
+    DomainVariant . zip (map fst as) <$> zipWithM applyReprTree (map snd as) asRepr
 applyReprTree (DomainMatrix b a) (Tree Nothing [aRepr]) = DomainMatrix b <$> applyReprTree a aRepr
 applyReprTree (DomainSet       _ attr a  ) (Tree (Just r) [aRepr]) = DomainSet r attr <$> applyReprTree a aRepr
 applyReprTree (DomainMSet      _ attr a  ) (Tree (Just r) [aRepr]) = DomainMSet r attr <$> applyReprTree a aRepr

diff --git a/src/Conjure/Language/Instantiate.hs b/src/Conjure/Language/Instantiate.hs
@@ -255,7 +255,7 @@ instantiateD (DomainEnum nm Nothing _) = do
 instantiateD (DomainEnum nm rs0 _) = do
     let fmap4 = fmap . fmap . fmap . fmap
     let e2c' x = either bug id (e2c x)
-    rs <- transformBiM (\ x -> Constant <$> instantiateE x ) (rs0 :: Maybe [Range Expression])
+    rs <- transformBiM (fmap Constant . instantiateE ) (rs0 :: Maybe [Range Expression])
                 |> fmap4 e2c'
     st <- gets id
     mp <- forM (universeBi rs :: [Name]) $ \ n -> case lookup n st of

diff --git a/src/Conjure/Process/Enums.hs b/src/Conjure/Process/Enums.hs
@@ -67,16 +67,18 @@ removeEnumsFromModel =
                                                 (fromIntWithTag (genericLength names) (TagEnum enameText))
                             case names `intersect` namesBefore of
                                 [] -> modify ( ( [(ename, outDomain)]
-                                             , zip names (zip (cycle [ename]) allNats)
+                                             , zip names (map (ename,) allNats)
                                              ) `mappend` )
                                 repeated -> userErr1 $ vcat
                                     [ "Some members of this enum domain (" <> pretty ename <> ") seem to be defined"
                                     , "as part of other enum domains."
                                     , "Repeated:" <+> prettyList id "," repeated
                                     , "While working on domain:" <+> pretty st
                                     ]
-                            return (Declaration (Letting ename (Domain outDomain)))
-                        _ -> return st
+                            return [ Declaration (Letting (ename `mappend` "_EnumSize") (fromInt $ genericLength names))
+                                   , Declaration (Letting ename (Domain outDomain))
+                                   ]
+                        _ -> return [st]
 
             let nameToIntMapping = M.fromList nameToIntMapping_
 
@@ -100,7 +102,7 @@ removeEnumsFromModel =
                 onD p = return p
 
             statements'' <- (transformBiM onD >=> transformBiM onX) statements'
-            return model { mStatements = statements'' }
+            return model { mStatements = concat statements'' }
 
         removeEnumsFromModel_GivenEnums model = do
             (statements', enumDomainNames) <-

diff --git a/src/test/Conjure/ParsePrint.hs b/src/test/Conjure/ParsePrint.hs
@@ -131,7 +131,6 @@ testSingleDir TestDirFiles{..} = testCaseSteps (map (\ch -> if ch == '/' then '.
                 Nothing -> assertFailure $ "JSON parser error in" ++ stdoutE
                 Just [] -> return ()
                 Just ops -> assertFailure $ renderNormal $ vcat ["Difference in json:" <++> vcat (map (stringToDoc . show) ops)]
-
         do
             step "Checking stdout"
             stdoutG <- fixWindowsPaths <$> readIfExists (tBaseDir </> "stdout")

diff --git a/tests/custom/enum-in-partition/eip.essence b/tests/custom/enum-in-partition/eip.essence
@@ -0,0 +1,64 @@
+letting w be 6000
+letting v be 6000
+letting b be 2
+
+letting groceries be new type enum{
+    "Bread",
+    "Carrots",
+    "Broccoli",
+    "Spinach",
+    "Apples",
+    "Bananas",
+    "Oranges",
+    "Rice",
+    "Cereal",
+    "Soft Drinks",
+    "Ice Cream"
+}
+
+letting weight be function(
+    "Bread" --> 500,
+    "Carrots" --> 500,
+    "Broccoli" --> 600,
+    "Spinach" --> 200,
+    "Apples" --> 1000,
+    "Bananas" --> 700,
+    "Oranges" --> 900,
+    "Rice" --> 1000,
+    "Cereal" --> 500,
+    "Soft Drinks" --> 1000,
+    "Ice Cream" --> 700
+)
+
+letting volume be function(
+    "Bread" --> 1000,
+    "Carrots" --> 1000,
+    "Broccoli" --> 1500,
+    "Spinach" --> 500,
+    "Apples" --> 1500,
+    "Bananas" --> 1000,
+    "Oranges" --> 1600,
+    "Rice" --> 1200,
+    "Cereal" --> 700,
+    "Soft Drinks" --> 2000,
+    "Ice Cream" --> 1000
+)
+
+letting importance be function(
+    "Bread" --> 8,
+    "Carrots" --> 7,
+    "Broccoli" --> 8,
+    "Spinach" --> 8,
+    "Apples" --> 8,
+    "Bananas" --> 7,
+    "Oranges" --> 9,
+    "Rice" --> 10,
+    "Cereal" --> 7,
+    "Soft Drinks" --> 4,
+    "Ice Cream" --> 5
+)
+
+find bags : partition (numParts 2) from groceries
+
+such that forAll bag in bags . (sum item in bag . weight(item)) <= 5000
+
diff --git a/tests/custom/enum-in-partition/run.sh b/tests/custom/enum-in-partition/run.sh
@@ -0,0 +1,4 @@
+rm -rf conjure-output *.solution
+conjure solve eip.essence
+cat *.solution
+rm -rf conjure-output *.solution
diff --git a/tests/custom/enum-in-partition/stdout.expected b/tests/custom/enum-in-partition/stdout.expected
@@ -0,0 +1,16 @@
+Generating models for eip.essence
+Generated models: model000001.eprime
+Saved under: conjure-output
+Savile Row: model000001.eprime
+Running minion for domain filtering.
+Running solver: minion
+Copying solution to: eip.solution
+language Essence 1.3
+
+letting bags be
+        partition({"Bread", "Cereal", "Soft Drinks", "Ice Cream"},
+                  {"Carrots", "Broccoli", "Spinach", "Apples", "Bananas", "Oranges", "Rice"})
+$ Visualisation for bags
+$ "Bread"       "Cereal"      "Soft Drinks" "Ice Cream"  
+$ "Carrots"     "Broccoli"    "Spinach"     "Apples"      "Bananas"     "Oranges"     "Rice"       
+
diff --git a/tests/custom/issues/440/stderr.expected b/tests/custom/issues/440/stderr.expected
@@ -2,4 +2,5 @@ Error:
     No value for: E3
     Bindings in context:
         my_function: function(E3 --> 1)
+        my_enum_EnumSize: 2
         my_enum: `int(1..2)`