Require a means to distinguish between definitions

The following code used to be allowed:

```
module main (rms)

import types (List, Real)
import math (sqrt, mean, mul)
import cppbase (map)

source cpp from "rms.h"
 ( "rms1" as rms
 , "rms2" as rms
 )

square x = mul x x
rms xs = sqrt (mean (map square xs))

rms :: [Real] -> Real
```

Here two functions, `rms1` and `rms2`, are both sourced from R and bound
to the `morloc` name `rms`. In the past, one of these two would be
arbitrarily chosen.

However, `morloc` had no means to discriminate between them. Now I raise
an error rather than make a baseless choice. In the future, I will
develop stronger methods to make these choices.

library/Morloc/CodeGenerator/Generate.hs

@@ -263,15 +263,26 @@ realize s0 = do
 
   -- Select one implementation for the given term
   collapseExpr l1 (VarS v (Many xs), Idx i _) = do
-    let mayX = minBy (\(AnnoS _ (Idx _ ss) _) -> minimumMay [cost l1 l2 s | (l2, s) <- ss]) xs
-    (x, lang) <- case mayX of
-      Nothing -> MM.throwError . GeneratorError . render $
-                 "No implementation found for" <+> squotes (pretty v)
-      (Just x@(AnnoS _ (Idx _ ss) _)) -> do
+    let minXs = minsBy (\(AnnoS _ (Idx _ ss) _) -> minimumMay [cost l1 l2 s | (l2, s) <- ss]) xs
+    (x, lang) <- case minXs of
+      [] -> MM.throwError . GeneratorError . render $
+             "No implementation found for" <+> squotes (pretty v)
+      [x] -> handleOne x
+      choices@(x:_) -> case x of
+        (AnnoS _ _ (CallS _)) ->
+          MM.throwError . InseperableDefinitions . render
+            $ "no rule to separate the following sourced functions:\n"
+            <> indent 2 (vsep (map (\y -> "* " <> pretty y) choices))
+        _ -> handleOne x
+    return (VarS v (One x), Idx i lang)
+    where
+      handleOne
+        :: AnnoS (Indexed Type) Many (Indexed [(Lang, Int)])
+        -> MorlocMonad (AnnoS (Indexed Type) One (Indexed (Maybe Lang)), Maybe Lang)
+      handleOne x@(AnnoS _ (Idx _ ss) _) = do
         let newLang = fmap fst (minBy (biasedCost l1) ss)
         x' <- collapseAnnoS newLang x
         return (x', newLang)
-    return (VarS v (One x), Idx i lang)
 
   -- Propagate downwards
   collapseExpr l1 (AccS k x, Idx i ss) = do
@@ -321,6 +332,18 @@ realize s0 = do
     Nothing -> Just x1
     (Just x2) -> if f x1 <= f x2 then Just x1 else Just x2
 
+  minsBy :: Ord b => (a -> b) -> [a] -> [a]
+  minsBy _ [] = []
+  minsBy f (x:xs) = snd $ minsBy' (f x, [x]) xs where
+    minsBy' (best, grp) [] = (best, grp)
+    minsBy' (best, grp) (y:ys) = minsBy' (newSet (f y)) ys
+      where
+        newSet newScore
+          | newScore == best = (best, y:grp)
+          | newScore < best = (newScore, [y])
+          | otherwise = (best, grp)
+
+
   -- find the lowest cost function for each key
   -- the groupSort function will never yield an empty value for vs, so `minimum` is safe
   minPairs :: (Ord a, Ord b) => [(a, b)] -> [(a, b)]

library/Morloc/Namespace.hs

@@ -1218,15 +1218,15 @@ instance Pretty (ExprS g f c) where
   pretty (BndS v) = pretty v
   pretty (VarS v _) = pretty v
   pretty (AccS k e) = parens (pretty e) <> "[" <> pretty k <> "]"
-  pretty (AppS e es) = pretty e <> vsep (map pretty es)
+  pretty (AppS e es) = "App" <+> pretty e <> vsep (map pretty es)
   pretty (LamS vs e) = parens ("\\" <+> hsep (map pretty vs) <+> "->" <+> pretty e)
   pretty (LstS es) = list (map pretty es)
   pretty (TupS es) = tupled (map pretty es)
   pretty (NamS rs) = encloseSep "{" "}" "," [pretty k <+> "=" <+> pretty v | (k,v) <- rs]
   pretty (RealS x) = viaShow x
   pretty (IntS x) = pretty x
   pretty (LogS x) = pretty x
-  pretty (StrS x) = pretty x
+  pretty (StrS x) = dquotes (pretty x)
   pretty (CallS src) = pretty src
 
 instance (Pretty k, Pretty a) => Pretty (IndexedGeneral k a) where

test-suite/Main.hs

@@ -188,9 +188,12 @@ main = do
 
       -- import two instances in one languages for a function
       -- this is also a test of a function that is defind in a local file
-      , golden "multiple-instances-1-c" "multiple-instances-1-c"
-      , golden "multiple-instances-1-py" "multiple-instances-1-py"
-      , golden "multiple-instances-1-r" "multiple-instances-1-r"
+      -- -- With the new stricter implementation, these tests no longer pass
+      -- -- They can be reinstated when the morloc compiler learns to
+      -- -- distinguish the functions reasonably
+      -- , golden "multiple-instances-1-c" "multiple-instances-1-c"
+      -- , golden "multiple-instances-1-py" "multiple-instances-1-py"
+      -- , golden "multiple-instances-1-r" "multiple-instances-1-r"
       -- multiple sources and a declaration
       , golden "multiple-instances-2-c" "multiple-instances-2-c"
       , golden "multiple-instances-2-py" "multiple-instances-2-py"

test-suite/golden-tests/multiple-instances-1-c/foo.loc

@@ -1,3 +1,5 @@
+-- NOTE: currently not used, the compiler cannot yet distinguish between sourced functions
+
 module main (rms)
 
 import types (List, Real)

test-suite/golden-tests/multiple-instances-1-py/foo.loc

@@ -1,3 +1,5 @@
+-- NOTE: currently not used, the compiler cannot yet distinguish between sourced functions
+
 module main (rms)
 
 import types (List, Real)

test-suite/golden-tests/multiple-instances-1-r/foo.loc

@@ -1,3 +1,5 @@
+-- NOTE: currently not used, the compiler cannot yet distinguish between sourced functions
+
 module main (rms)
 
 import types (List, Real)

test-suite/golden-tests/multiple-instances-2-c/foo.loc

@@ -6,7 +6,7 @@ import cppbase (map)
 
 source cpp from "rms.h"
  ( "rms1" as rms
- , "rms2" as rms
+ -- , "rms2" as rms
  )
 
 square x = mul x x

test-suite/golden-tests/multiple-instances-2-py/foo.loc

@@ -6,7 +6,7 @@ import cppbase (map)
 
 source py from "rms.py"
   ( "rms1" as rms
-  , "rms2" as rms
+  -- , "rms2" as rms
   )
 
 square x = mul x x

test-suite/golden-tests/multiple-instances-2-r/foo.loc

@@ -6,7 +6,7 @@ import cppbase (map)
 
 source r from "rms.R"
   ( "rms1" as rms
-  , "rms2" as rms
+  -- , "rms2" as rms
   )
 
 square x = mul x x

test-suite/golden-tests/selection-3/foo.loc

@@ -3,7 +3,9 @@ module main (foo)
 type R => Real = "numeric"
 type R => List a = "list" a
 
-source R from "rms.R" ("rms1" as rms, "rms2" as rms, "add") 
+-- NOTE: previously I also included the rms2 function, however, the compiler
+-- does not yet have a way to choose which to use.
+source R from "rms.R" ("rms1" as rms, "add") 
 rms :: [Real] -> Real
 add :: Real -> Real -> Real