Caller-relative imports; smart deduping in imports

src/Eval.hs

@@ -141,18 +141,23 @@ reorderDefs env defs
 
 buildDepGraph :: [TricuAST] -> Map.Map String (Set.Set String)
 buildDepGraph topDefs
-  | not (null duplicateNames) =
+  | not (null conflictingDefs) =
       errorWithoutStackTrace $
-        "Duplicate definitions detected: " ++ show duplicateNames
+        "Conflicting definitions detected: " ++ show conflictingDefs
   | otherwise =
       Map.fromList
         [ (name, depends topDefs (SDef name [] body))
         | SDef name _ body <- topDefs]
   where
-    names = [name | SDef name _ _ <- topDefs]
-    duplicateNames =
-      [ name | (name, count) <- Map.toList (countOccurrences names) , count > 1]
-    countOccurrences = foldr (\x -> Map.insertWith (+) x 1) Map.empty
+    defsMap = Map.fromListWith (++)
+      [(name, [(name, body)]) | SDef name _ body <- topDefs]
+
+    conflictingDefs =
+      [ name
+      | (name, defs) <- Map.toList defsMap
+      , let bodies = map snd defs
+      , not $ all (== head bodies) (tail bodies)
+      ]
 
 sortDeps :: Map.Map String (Set.Set String) -> [String]
 sortDeps graph = go [] Set.empty (Map.keys graph)

src/FileEval.hs

@@ -8,6 +8,7 @@ import Research
 import Data.List       (partition)
 import Control.Monad   (foldM)
 import System.IO
+import System.FilePath (takeDirectory, normalise, (</>))
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -46,38 +47,45 @@ evaluateFileWithContext env filePath = do
       pure $ evalTricu env ast
 
 preprocessFile :: FilePath -> IO [TricuAST]
-preprocessFile = preprocessFile' Set.empty
+preprocessFile p = preprocessFile' Set.empty p p
 
-preprocessFile' :: Set.Set FilePath -> FilePath -> IO [TricuAST]
-preprocessFile' inProgress filePath
-  | filePath `Set.member` inProgress = 
-      errorWithoutStackTrace $ "Encountered cyclic import: " ++ filePath
+preprocessFile' :: Set.Set FilePath -> FilePath -> FilePath -> IO [TricuAST]
+preprocessFile' s b p
+  | p `Set.member` s =
+      errorWithoutStackTrace $ "Encountered cyclic import: " ++ p
   | otherwise = do
-      contents <- readFile filePath
-      let tokens = lexTricu contents
-      case parseProgram tokens of
-        Left err -> errorWithoutStackTrace (handleParseError err)
-        Right asts -> do
-          let (imports, nonImports) = partition isImport asts
-          let newInProgress = Set.insert filePath inProgress
-          importedASTs <- concat <$> 
-            mapM (processImport newInProgress "") imports
-          pure $ importedASTs ++ nonImports
+      c <- readFile p
+      let t = lexTricu c
+      case parseProgram t of
+        Left e -> errorWithoutStackTrace (handleParseError e)
+        Right a -> do
+          let (i, n) = partition isImp a
+          let s' = Set.insert p s
+          r <- concat <$>
+            mapM (procImp s' "" p) i
+          pure $ r ++ n
   where
-    isImport :: TricuAST -> Bool
-    isImport (SImport _ _) = True
-    isImport _             = False
+    isImp :: TricuAST -> Bool
+    isImp (SImport _ _) = True
+    isImp _             = False
 
-    processImport :: Set.Set FilePath -> String -> TricuAST -> IO [TricuAST]
-    processImport prog currentModule (SImport path "!Local") = do
-      ast <- preprocessFile' prog path
-      let defs = filter (not . isImport) ast
-      pure $ map (nsDefinition currentModule) defs
-    processImport prog _ (SImport path name) = do
-      ast <- preprocessFile' prog path
-      let defs = filter (not . isImport) ast
-      pure $ map (nsDefinition name) defs
-    processImport _ _ _ = error "Unexpected non-import in processImport"
+    procImp :: Set.Set FilePath -> String -> FilePath -> TricuAST -> IO [TricuAST]
+    procImp s m f (SImport p "!Local") = do
+      let ip = makeRelativeTo f p
+      a <- preprocessFile' s b ip
+      let d = filter (not . isImp) a
+      pure $ map (nsDefinition m) d
+    procImp s _ f (SImport p n) = do
+      let ip = makeRelativeTo f p
+      a <- preprocessFile' s b ip
+      let d = filter (not . isImp) a
+      pure $ map (nsDefinition n) d
+    procImp _ _ _ _ = error "Unexpected non-import in processImport"
+
+makeRelativeTo :: FilePath -> FilePath -> FilePath
+makeRelativeTo f i =
+    let d = takeDirectory f
+    in normalise $ d </> i
 
 nsDefinitions :: String -> [TricuAST] -> [TricuAST]
 nsDefinitions moduleName = map (nsDefinition moduleName)