Added import loop error

3 files changed, 39 insertions, 35 deletions

diff --git a/src/Eval.hs b/src/Eval.hs
index 0e4f1f3..e4f2676 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -36,15 +36,15 @@ split a@(_ : _) b@(c : _)
   where rest = split a $ tail b
 
 -- TODO: Force naming convention for namespaces/files
-loadFile :: String -> IO EnvState
-loadFile path = do
+loadFile :: String -> EvalConf -> IO EnvState
+loadFile path conf = do
   f <- try $ readFile path :: IO (Either IOError String)
   case f of
     Left exception ->
       print (exception :: IOError) >> pure (EnvState $ Environment [])
     Right f' -> eval (filter (not . null) $ split "\n\n" f')
                        (EnvState $ Environment [])
-                       False
+                       (EvalConf { isRepl = False, evalPaths = (path : (evalPaths conf)) })
 
 evalVar :: String -> Environment -> Program (Failable Expression)
 evalVar var (Environment sub) = state $ \env@(Environment e) ->
@@ -91,41 +91,42 @@ evalTest e1 e2 sub =
           Right e1' -> fmap (Test e1') <$> evalExp e2 sub
         )
 
-evalSubEnv :: [Instruction] -> EnvState -> Bool -> IO EnvState
+evalSubEnv :: [Instruction] -> EnvState -> EvalConf -> IO EnvState
 evalSubEnv [] s _ = return s
-evalSubEnv (instr : is) s isRepl =
+evalSubEnv (instr : is) s conf =
   handleInterrupt (putStrLn "<aborted>" >> return s)
-    $ evalInstruction instr s (evalSubEnv is) isRepl
+    $ evalInstruction instr s (evalSubEnv is) conf
 
 evalInstruction
   :: Instruction
   -> EnvState
-  -> (EnvState -> Bool -> IO EnvState)
-  -> Bool
+  -> (EnvState -> EvalConf -> IO EnvState)
+  -> EvalConf
   -> IO EnvState
-evalInstruction instr s@(EnvState env) rec isRepl = case instr of
+evalInstruction instr s@(EnvState env) rec conf = case instr of
   Define name e sub inp -> do
-    EnvState subEnv <- evalSubEnv sub s isRepl
+    EnvState subEnv <- evalSubEnv sub s conf
     let
       (res, env') = evalDefine name e subEnv `runState` env
      in  case res of
           Left  err -> print (ContextualError err inp) >> pure s -- don't continue
-          Right _   -> if isRepl
+          Right _   -> if isRepl conf
             then (putStrLn $ name <> " = " <> show e)
               >> return (EnvState env')
-            else rec (EnvState env') isRepl
-  -- TODO: Import loop detection
+            else rec (EnvState env') conf
   -- TODO: Don't import subimports into main env
   Import path namespace -> do
     lib           <- getDataFileName path -- TODO: Use actual lib directory
     exists        <- doesFileExist lib
-    EnvState env' <- loadFile $ if exists then lib else path
-    let prefix | null namespace   = takeBaseName path ++ "."
-               | namespace == "." = ""
-               | otherwise        = namespace ++ "."
-    env'' <- pure $ Environment $ map (\((n, e), o) -> ((prefix ++ n, e), o))
-                                     ((\(Environment e) -> e) env') -- TODO: Improve
-    rec (EnvState $ env'' <> env) False -- import => isRepl = False
+    actual        <- pure $ if exists then lib else path
+    if (actual `elem` evalPaths conf) then (print (ImportError path) >> pure s) else do
+      EnvState env' <- loadFile actual conf
+      let prefix | null namespace   = takeBaseName path ++ "."
+                 | namespace == "." = ""
+                 | otherwise        = namespace ++ "."
+      env'' <- pure $ Environment $ map (\((n, e), o) -> ((prefix ++ n, e), o))
+                                       ((\(Environment e) -> e) env') -- TODO: Improve
+      rec (EnvState $ env'' <> env) (conf { isRepl = False, evalPaths = evalPaths conf }) -- import => isRepl = False
   Evaluate e ->
     let (res, _) = evalExp e (Environment []) `runState` env
     in  putStrLn
@@ -142,7 +143,7 @@ evalInstruction instr s@(EnvState env) rec isRepl = case instr of
                      )
                 where reduced = reduce e'
             )
-          >> rec s isRepl
+          >> rec s conf
   Test e1 e2 ->
     let (res, _) = evalTest e1 e2 (Environment []) `runState` env
     in  case res of
@@ -151,22 +152,22 @@ evalInstruction instr s@(EnvState env) rec isRepl = case instr of
             when
                 (lhs /= rhs)
                 (print $ FailedTest e1 e2 lhs rhs)
-              >> rec s isRepl
+              >> rec s conf
             where
               lhs = reduce e1'
               rhs = reduce e2'
-          _ -> rec s isRepl
-  _ -> rec s isRepl
+          _ -> rec s conf
+  _ -> rec s conf
 
-eval :: [String] -> EnvState -> Bool -> IO EnvState
+eval :: [String] -> EnvState -> EvalConf -> IO EnvState
 eval []   s _ = return s
 eval [""] s _ = return s
-eval (block : bs) s isRepl =
+eval (block : bs) s conf =
   handleInterrupt (putStrLn "<aborted>" >> return s)
     $ case parse blockParser "" block of
-        Left  err   -> print (SyntaxError $ errorBundlePretty err) >> eval bs s isRepl
-        Right instr -> evalInstruction instr s (eval bs) isRepl
-  where blockParser = if isRepl then parseReplLine else parseBlock 0
+        Left  err   -> print (SyntaxError $ errorBundlePretty err) >> eval bs s conf
+        Right instr -> evalInstruction instr s (eval bs) conf
+  where blockParser = if isRepl conf then parseReplLine else parseBlock 0
 
 evalMainFunc :: Environment -> Expression -> Maybe Expression
 evalMainFunc (Environment env) arg = do
@@ -175,7 +176,7 @@ evalMainFunc (Environment env) arg = do
 
 evalFile :: String -> (a -> IO ()) -> (Expression -> a) -> IO ()
 evalFile path wr conv = do
-  EnvState env <- loadFile path
+  EnvState env <- loadFile path (EvalConf { isRepl = False, evalPaths = [] })
   arg          <- encodeStdin
   case evalMainFunc env arg of
     Nothing  -> print $ ContextualError (UndeclaredFunction "main") path
@@ -196,7 +197,7 @@ repl s =
     >>= (\case -- TODO: Add non-parser error support for REPL
           Nothing   -> return ()
           Just line -> do
-            s' <- (liftIO $ eval [line] s True)
+            s' <- (liftIO $ eval [line] s (EvalConf { isRepl = True, evalPaths = [] }))
             lift (StrictState.put s')
             repl s'
         )
diff --git a/src/Helper.hs b/src/Helper.hs
index 6c1509d..821e68c 100644
--- a/src/Helper.hs
+++ b/src/Helper.hs
@@ -18,7 +18,7 @@ printContext str = p $ lines str
 
 errPrefix :: String
 errPrefix = "\ESC[41mERROR\ESC[0m "
-data Error = SyntaxError String | UndeclaredFunction String | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error String
+data Error = SyntaxError String | UndeclaredFunction String | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error String | ImportError String
 instance Show Error where
   show (ContextualError err ctx) = show err <> "\n" <> (printContext ctx)
   show (SyntaxError err        ) = errPrefix <> "invalid syntax\nnear " <> err
@@ -35,6 +35,7 @@ instance Show Error where
       <> show red1
       <> " = "
       <> show red2
+  show (ImportError path) = errPrefix <> "invalid import " <> show path
 type Failable = Either Error
 
 data Expression = Bruijn Int | Variable String | Abstraction Expression | Application Expression Expression
@@ -49,6 +50,11 @@ instance Show Expression where
     "\ESC[33m(\ESC[0m" <> show exp1 <> " " <> show exp2 <> "\ESC[33m)\ESC[0m"
 
 type EnvDef = (String, Expression)
+-- TODO: Add EvalConf to EnvState?
+data EvalConf = EvalConf
+  { isRepl    :: Bool
+  , evalPaths :: [String]
+  }
 data Environment = Environment [(EnvDef, Environment)]
 type Program = State Environment
 
diff --git a/std/List.bruijn b/std/List.bruijn
index 5bc49e1..eba39bb 100644
--- a/std/List.bruijn
+++ b/std/List.bruijn
@@ -78,9 +78,6 @@ filter Z [[[empty? 0 [empty] [2 (head 1) (cons (head 1)) I (3 2 (tail 1))] I]]]
 
 :test filter N.zero? (cons +1 (cons +0 (cons +3 empty))) = cons +0 empty
 
-# checks whether an element is part of a list
-elem [[foldr [or (N.eq? 1 0)] F 2]]
-
 # returns the last element of a list
 last Z [[empty? 0 [empty] [empty? (tail 1) (head 1) (2 (tail 1))] I]]