Import module collisions

gibbon-compiler/.gitignore

@@ -32,3 +32,4 @@ demo/*.c
 demo/*.exe
 gibbon-compiler/examples/parallel/data/*.txt
 *.log.hs
+*.log

gibbon-compiler/examples/add1.hs

@@ -1,9 +1,10 @@
+module Add where
 data Tree = Leaf Int | Node Tree Tree
 
 add1 :: Tree -> Tree
 add1 t = case t of
            Leaf x     -> Leaf (x + 1)
-           Node x1 x2 -> Node (add1 x1) (add1 x2)
+           Node x1 x2 -> Node (Add.add1 x1) (Add.add1 x2)
 
-main :: Tree
-main = add1 (Node (Leaf 1) (Leaf 2))
+gibbon_main :: Tree
+gibbon_main = Add.add1 (Node (Leaf 1) (Leaf 2))

gibbon-compiler/examples/imports/AddTree.hs

@@ -0,0 +1,8 @@
+module AddTree where
+    data Tree = Node Tree Tree | Leaf Int
+
+    sum :: Tree -> Int
+    sum t =
+        case t of
+            Leaf v -> v
+            Node l r -> (sum l) + (sum r)

gibbon-compiler/examples/imports/Addone.hs

@@ -0,0 +1,15 @@
+module Addone where 
+    import AddTree
+
+    add :: Tree -> Tree
+    add t = case t of
+            Leaf x     -> Leaf (x + 1)
+            Node x1 x2 -> Node (add x1) (add x2)
+
+    sub :: Tree -> Tree
+    sub t = case t of
+            Leaf x     -> Leaf (x - 1)
+            Node x1 x2 -> Node (sub x1) (sub x2)
+
+    gibbon_main :: Tree
+    gibbon_main = add (Node (Leaf 1) (Leaf 2))

gibbon-compiler/examples/imports/Addtwo.hs

@@ -0,0 +1,15 @@
+module Addtwo where 
+    import AddTree
+
+    add :: Tree -> Tree
+    add t = case t of
+            Leaf x     -> Leaf (x + 2)
+            Node x1 x2 -> Node (add x1) (add x2)
+
+    sub :: Tree -> Tree
+    sub t = case t of
+            Leaf x     -> Leaf (x - 2)
+            Node x1 x2 -> Node (sub x1) (sub x2)
+
+    gibbon_main :: Tree
+    gibbon_main = add (Node (Leaf 1) (Leaf 2))

gibbon-compiler/examples/imports/AllThreeImportModifications.ans

@@ -0,0 +1 @@
+9

gibbon-compiler/examples/imports/AllThreeImportModifications.hs

@@ -0,0 +1,6 @@
+module AllThreeImportModifications where
+    import qualified Addtwo as T (add)
+    import qualified Addone as O (add)
+    import AddTree as Tree (sum, Node, Leaf)
+
+    gibbon_main = sum (T.add (O.add (Tree.Node (Tree.Leaf 1) (Tree.Leaf 2))))

gibbon-compiler/examples/imports/ImportAliased.ans

@@ -0,0 +1 @@
+9

gibbon-compiler/examples/imports/ImportAliased.hs

@@ -0,0 +1,6 @@
+module ImportAliased where
+    import qualified Addtwo as T
+    import qualified Addone as O
+    import AddTree as Tree
+
+    gibbon_main = sum (T.add (O.add (Tree.Node (Tree.Leaf 1) (Tree.Leaf 2))))

gibbon-compiler/examples/imports/ImportQualified.ans

@@ -0,0 +1 @@
+9

gibbon-compiler/examples/imports/ImportQualified.hs

@@ -0,0 +1,6 @@
+module ImportQualified where
+    import qualified Addtwo
+    import qualified Addone
+    import AddTree
+
+    gibbon_main = sum (Addtwo.add (Addone.add (Node (Leaf 1) (Leaf 2))))

gibbon-compiler/examples/imports/ImportQualifiedAndSpecified.ans

@@ -0,0 +1 @@
+5

gibbon-compiler/examples/imports/ImportQualifiedAndSpecified.hs

@@ -0,0 +1,6 @@
+module ImportQualifiedAndSpecified where
+    import qualified Addtwo (add)
+    import qualified Addone (sub)
+    import AddTree
+
+    gibbon_main = sum (Addtwo.add (Addone.sub (Node (Leaf 1) (Leaf 2))))

gibbon-compiler/examples/imports/ImportSpecified.ans

@@ -0,0 +1 @@
+5

gibbon-compiler/examples/imports/ImportSpecified.hs

@@ -0,0 +1,6 @@
+module ImportSpecified where
+    import Addtwo (add)
+    import Addone (sub)
+    import AddTree
+
+    gibbon_main = sum (add (sub (Node (Leaf 1) (Leaf 2))))

gibbon-compiler/examples/imports/failing.md

@@ -0,0 +1,61 @@
+# Poly
+### `/poly/Poly1.hs`
+
+Problem seems to be with the type names, numbers and Nothing, Cons, Nil, Right all match
+
+```
+< '#(10 #t 11 #f 2 4 (Poly1_Nothing_77_v_323) (Poly1_Right_76_v_342 20) (Poly1_Right_76_v_334 1) 12 #f 0 3 (Poly1_Cons_74_v_329 1 (Poly1_Cons_74_v_329 2 (Poly1_Nil_73_v_329))) (Poly1_Cons_74_v_329 1 (Poly1_Cons_74_v_329 2 (Poly1_Nil_73_v_329))) (Poly1_Right_76_v_334 1) (Poly1_Cons_74_v_329 11 (Poly1_Cons_74_v_329 12 (Poly1_Nil_73_v_329))))
+---
+> '#(10 #t 11 #f 2 4 (Nothing_v_295 ) (Right_v_315 20) (Right_v_306 1) 12 #f 0 3 (Cons_v_301 1(Cons_v_301 2(Nil_v_301 ))) (Cons_v_301 1(Cons_v_301 2(Nil_v_301 ))) (Right_v_306 1) (Cons_v_301 11(Cons_v_301 12(Nil_v_301 ))))
+\ No newline at end of file
+```
+
+# Eval l/r
+### `eval_l.hs`
+
+### `eval_r.hs`
+
+these are failing to properly import a module in interp mode this seems to stem from the fact the the imported file does not have a module declaration,,, so internally it renames with "Main" but the true Main module expects "Eval" b/c that's the name in the import statement.
+
+solving this by having the Main module tell each imported module how to name themselves ... this I think could get convoluted b/c a module decalred internally as A could be imported as B ... perhaps a subjective design decision but this seems to work
+
+# ArrowTy
+### `layout1ContentSearch.hs`
+```
+Couldn't match type 'ArrowTy [VectorTy (MetaTv $839)]
+                                     IntTy' with 'IntTy'
+        Expected type: IntTy
+        Actual type: ArrowTy [VectorTy (MetaTv $839)] IntTy
+        In the expression: 
+          VarE "Gibbon_Vector_length_132" in Var "GenerateLayout1_mkBlogs_layout1_107"
+```
+
+This all seems to come from a similair pattern but it looks like the bug doesn't have anything to do with the error. The issue is scope: `Gibbon_Vector_length_132` is some global name but there is a `length` that is one of the function arguements. The rename pass matches length to the global function, causing the error. My solution was to force the global name to be qualified within the scope where `length` exists. So the global `Gibbon.Vector.length` can be accessed if qualified, but simple reference to `length` will use the function arguement `length` 
+
+### `layout1ContentSearchRunPipeline.hs`
+
+### `layout1FilterBlogs.hs`
+
+### `layout1TagSearch.hs`
+
+### `layout2ContentSearch.hs`
+
+### `layout2FilterBlogs.hs`
+
+### `layout2TagSearch.hs`
+
+### `layout3ContentSearch.hs`
+
+### `layout3FilterBlogs.hs`
+
+### `layout3TagSearch.hs`
+
+### `layout4ContentSearch.hs`
+
+### `layout4FilterBlogs.hs`
+
+### `layout4TagSearch.hs`
+
+### `layout5ContentSearch.hs`
+
+### `layout5FilterBlogs.hs`

gibbon-compiler/examples/imports/import_tests.md

@@ -0,0 +1,9 @@
+# Import Features
+- no modifiers
+- qualified
+- specified
+- aliased
+- qualified & specified
+- qualified & aliased
+- specified & aliased
+- qualified & specified & aliased

gibbon-compiler/examples/poly/Poly1.ans

@@ -1 +1 @@
-'#(10 #t 11 #f 2 4 (Nothing_v_406) (Right_v_426 20) (Right_v_417 1) 12 #f 0 3 (Cons_v_412 1 (Cons_v_412 2 (Nil_v_412))) (Cons_v_412 1 (Cons_v_412 2 (Nil_v_412))) (Right_v_417 1) (Cons_v_412 11 (Cons_v_412 12 (Nil_v_412))))
+'#(10 #t 11 #f 2 4 (Nothing99_v434) (Right98_v453 20) (Right98_v445 1) 12 #f 0 3 (Cons96_v440 1 (Cons96_v440 2 (Nil95_v440))) (Cons96_v440 1 (Cons96_v440 2 (Nil95_v440))) (Right98_v445 1) (Cons96_v440 11 (Cons96_v440 12 (Nil95_v440))))

gibbon-compiler/examples/test_153.ans

@@ -1 +1 @@
-'#('#(2 3) (B_v_13 4 5))
+'#('#(2 3) (B5_v17 4 5))

gibbon-compiler/examples/test_164.ans

@@ -1 +1 @@
-(Cons_v_64 3 (Cons_v_64 5 (Cons_v_64 7 (Nil_v_64))))
+(Cons19_v68 3 (Cons19_v68 5 (Cons19_v68 7 (Nil18_v68))))

gibbon-compiler/examples/test_166.ans

@@ -1 +1 @@
-(Node_v_79 10 10 10 10 10 10 10 10 (Cell_v_79 5 5 5 5 5 5 5 5) (Cell_v_79 2 2 2 2 2 2 2 2))
+(Node16_v86 10 10 10 10 10 10 10 10 (Cell15_v86 5 5 5 5 5 5 5 5) (Cell15_v86 2 2 2 2 2 2 2 2))

gibbon-compiler/examples/test_191.ans

@@ -1 +1 @@
-(Cons 12  ->i (I 2) (Cons 12  ->i (I 1) (Nil)))'#()
+(Cons26 12  ->i (I28 2) (Cons26 12  ->i (I28 1) (Nil27)))'#()

gibbon-compiler/examples/test_printpacked.ans

@@ -1,4 +1,4 @@
-(Node (Node (Leaf 1)(Leaf 1))(Node (Leaf 1)(Leaf 1)))
- ->i (Node (Node (Leaf 1)(Leaf 1))(Node (Leaf 1)(Leaf 1)))
+(Node32 (Node32 (Leaf31 1)(Leaf31 1))(Node32 (Leaf31 1)(Leaf31 1)))
+ ->i (Node32 (Node32 (Leaf31 1)(Leaf31 1))(Node32 (Leaf31 1)(Leaf31 1)))
 1
 '#()

gibbon-compiler/gibbon.cabal

@@ -28,6 +28,7 @@ flag LLVM_ENABLED
 library
   exposed-modules:     Gibbon.Common
                        Gibbon.Compiler
+                       Gibbon.Bundler
                        Gibbon.DynFlags
                        Gibbon.Pretty
                        Gibbon.SExpFrontend
@@ -60,6 +61,7 @@ library
                        Gibbon.NewL2.FromOldL2
 
                        -- compiler passes, roughly in the order they're run
+                       Gibbon.Passes.FreshBundle
                        Gibbon.Passes.Freshen
                        Gibbon.Passes.Flatten
                        Gibbon.Passes.InlineTriv

gibbon-compiler/src/Gibbon/Bundler.hs

@@ -0,0 +1,54 @@
+-- | Union all the modules in a program bundle in to a single program
+module Gibbon.Bundler (bundleModules) where
+import qualified Data.Foldable                   as F
+import qualified Data.Set                        as S
+import           Gibbon.L0.Syntax                as L0
+import           Gibbon.Common
+import           Data.Map                        as M
+
+
+
+-- | Main bundler, runs all imported modules through a union that combines
+-- their function defintions and data definitions with main's
+-- Names should be globally unique at this point
+bundleModules :: ProgBundle0 -> PassM Prog0
+bundleModules bundle = do
+    let (ProgBundle modules main) = bundle
+    let (ProgModule _ (Prog main_defs main_funs main_exp) _) = main
+    let (defs, funs) = F.foldr _bundleModule (main_defs, main_funs) modules
+    return $ Prog defs funs main_exp
+
+-- | Bundle fold function
+-- builds the full program by folding definitons and functions into the main
+_bundleModule :: ProgModule0 -> (DDefs0, FunDefs0) -> (DDefs0, FunDefs0)
+_bundleModule (ProgModule mod_name (Prog {ddefs, fundefs}) _) (defs1, funs1) = 
+    -- conflict checking,,, extract definition and function names
+    let ddef_names1 = M.keysSet defs1
+        ddef_names2 = M.keysSet ddefs
+        fn_names1 = M.keysSet funs1
+        fn_names2 = M.keysSet fundefs
+        em1 = S.intersection ddef_names1 ddef_names2
+        em2 = S.intersection fn_names1 fn_names2
+        conflicts1 = F.foldr (\d acc ->
+                    if (ddefs M.! d) /= (defs1 M.! d)
+                        then d : acc
+                        else acc)
+                    [] em1
+        conflicts2 = F.foldr (\f acc ->
+                    if (fundefs M.! f) /= (funs1 M.! f)
+                        then dbgTraceIt
+                                (sdoc ((fundefs M.! f), (funs1 M.! f)))
+                                (f : acc)
+                        else acc)
+                    [] em2
+    in case (conflicts1, conflicts2) of
+        ([], []) ->
+            (M.union ddefs defs1, M.union fundefs funs1)
+        (_x:_xs, _) ->
+            error $
+            "Conflicting definitions of " ++
+            show conflicts1 ++ " found in " ++ mod_name
+        (_, _x:_xs) ->
+            error $
+            "Conflicting definitions of " ++
+            show (S.toList em2) ++ " found in " ++ mod_name

gibbon-compiler/src/Gibbon/Common.hs

@@ -148,7 +148,7 @@ newUniq = state (\x -> (x, x+1))
 
 -- | Generate a unique symbol by attaching a numeric suffix.
 gensym :: MonadState Int m => Var -> m Var
-gensym v = state (\n -> (cleanFunName v `varAppend` "_" `varAppend` toVar (show n), n + 1))
+gensym v = state (\n -> (cleanFunName v `varAppend` toVar (show n), n + 1))
 
 gensym_tag :: MonadState Int m => Var -> String -> m Var
 gensym_tag v str = state (\n -> (cleanFunName v `varAppend` toVar (show n ++ str) , n + 1))
@@ -356,10 +356,11 @@ abbrv n x =
        then str
        else L.take (n-3) str ++ "..."
 
-lookup3 :: (Eq k, Show k, Show a, Show b) => k -> [(k,a,b)] -> (k,a,b)
+lookup3 :: HasCallStack => (Eq k, Show k, Show a, Show b) => k -> [(k,a,b)] -> (k,a,b)
 lookup3 k ls = go ls
   where
-   go [] = error$ "lookup3: key "++show k++" not found in list:\n  "++L.take 80 (show ls)
+   --go [] = error$ "lookup3: key "++show k++" not found in list:\n  "++L.take 80 (show ls)
+   go [] = error$ "lookup3: key "++show k++" not found in list:\n  "++ (show ls)
    go ((k1,a1,b1):r)
       | k1 == k   = (k1,a1,b1)
       | otherwise = go r