Show position info in error messages

5 files changed, 107 insertions, 82 deletions

diff --git a/src/Builtins.hs b/src/Builtins.hs
index f8d1567..ebaad42 100644
--- a/src/Builtins.hs
+++ b/src/Builtins.hs
@@ -37,13 +37,16 @@ builtinEnv = M.fromList [
     ]
 
 argError1 :: String -> AST -> String
-argError1 fn arg = pos arg ++ ": invalid argument to " ++ fn ++ ": " ++ show arg
+argError1 fn arg1 =
+    "invalid argument to " ++ fn ++ ": " ++ show arg1
 
-argError2 :: (Show a1, Show a2) => String -> a1 -> a2 -> String
-argError2 fn arg1 arg2 = "invalid arguments to " ++ fn ++ ": " ++ show arg1 ++ ", " ++ show arg2
+argError2 :: String -> AST -> AST -> String
+argError2 fn arg1 arg2 =
+    "invalid arguments to " ++ fn ++ ": " ++ show arg1 ++ ", " ++ show arg2
 
-argError3 :: (Show a1, Show a2, Show a3) => String -> a1 -> a2 -> a3 -> String
-argError3 fn arg1 arg2 arg3 = "invalid arguments to " ++ fn ++ ": " ++ show arg1 ++ ", " ++ show arg2 ++ ", " ++ show arg3
+argError3 :: String -> AST -> AST -> AST -> String
+argError3 fn arg1 arg2 arg3 =
+    "invalid arguments to " ++ fn ++ ": " ++ show arg1 ++ ", " ++ show arg2 ++ ", " ++ show arg3
 
 -- BUILTINS
 
@@ -54,13 +57,13 @@ builtinAdd2 = (name, makeNonsenseAST $ ASTFunction fn1) where
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
             fn2 _ AST { astNode = ASTInteger b } =
                 return $ makeNonsenseAST $ ASTInteger $ a + b
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
     fn1 _ ast1@AST { astNode = ASTDouble a } =
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
             fn2 _ AST { astNode = ASTDouble b } =
                 return $ makeNonsenseAST $ ASTDouble $ a + b
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
-    fn1 _ ast1 = throwL $ argError1 name ast1
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinSubtract2 :: (String, AST)
 builtinSubtract2 = (name, makeNonsenseAST $ ASTFunction fn1) where
@@ -69,13 +72,13 @@ builtinSubtract2 = (name, makeNonsenseAST $ ASTFunction fn1) where
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
             fn2 _ AST { astNode = ASTInteger b } =
                 return $ makeNonsenseAST $ ASTInteger $ a - b
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
     fn1 _ ast1@AST { astNode = ASTDouble a } =
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
             fn2 _ AST { astNode = ASTDouble b } =
                 return $ makeNonsenseAST $ ASTDouble $ a - b
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
-    fn1 _ ast1 = throwL $ argError1 name ast1
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinMultiply2 :: (String, AST)
 builtinMultiply2 = (name, makeNonsenseAST $ ASTFunction fn1) where
@@ -84,30 +87,30 @@ builtinMultiply2 = (name, makeNonsenseAST $ ASTFunction fn1) where
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
             fn2 _ AST { astNode = ASTInteger b } =
                 return $ makeNonsenseAST $ ASTInteger $ a * b
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
     fn1 _ ast1@AST { astNode = ASTDouble a } =
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
             fn2 _ AST { astNode = ASTDouble b } =
                 return $ makeNonsenseAST $ ASTDouble $ a * b
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
-    fn1 _ ast1 = throwL $ argError1 name ast1
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinDivide2 :: (String, AST)
 builtinDivide2 = (name, makeNonsenseAST $ ASTFunction fn1) where
     name = "/"
     fn1 _ ast1@AST { astNode = ASTInteger a } =
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
-            fn2 _ AST { astNode = ASTInteger b } =
-             do when (b == 0) $ throwL $ "division by zero"
+            fn2 _ ast2@AST { astNode = ASTInteger b } =
+             do when (b == 0) $ throwL (astPos ast2) $ "division by zero"
                 return $ makeNonsenseAST $ ASTInteger $ a `div` b
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
     fn1 _ ast1@AST { astNode = ASTDouble a } =
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
-            fn2 _ AST { astNode = ASTDouble b } =
-             do when (b == 0) $ throwL $ "division by zero"
+            fn2 _ ast2@AST { astNode = ASTDouble b } =
+             do when (b == 0) $ throwL (astPos ast2) $ "division by zero"
                 return $ makeNonsenseAST $ ASTDouble $ a / b
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
-    fn1 _ ast1 = throwL $ argError1 name ast1
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinEq2 :: (String, AST)
 builtinEq2 = (name, makeNonsenseAST $ ASTFunction fn1) where
@@ -127,13 +130,13 @@ builtinFloor :: (String, AST)
 builtinFloor = (name, makeNonsenseAST $ ASTFunction fn1) where
     name = "floor"
     fn1 _ AST { astNode = ASTDouble dbl } = return $ makeNonsenseAST $ ASTInteger $ floor dbl
-    fn1 _ ast = throwL $ argError1 name ast
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinToDouble :: (String, AST)
 builtinToDouble = (name, makeNonsenseAST $ ASTFunction fn1) where
     name = "to-double"
     fn1 _ AST { astNode = ASTInteger int } = return $ makeNonsenseAST $ ASTDouble $ fromIntegral int
-    fn1 _ ast = throwL $ argError1 name ast
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinFmt :: (String, AST)
 builtinFmt = (name, makeNonsenseAST $ ASTFunction fn1) where
@@ -143,8 +146,8 @@ builtinFmt = (name, makeNonsenseAST $ ASTFunction fn1) where
             fn2 _ AST { astNode = ASTVector replacements } =
                 return $ makeNonsenseAST $ ASTString $
                     T.unpack $ replaceAll (0 :: Int) replacements (T.pack str)
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
-    fn1 _ ast1 = throwL $ argError1 name ast1
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
     replaceAll _ [] text = text
     replaceAll n (x:xs) text =
         let text' = T.replace (T.pack $ "{" ++ show n ++ "}") (T.pack $ show x) text
@@ -153,18 +156,18 @@ builtinFmt = (name, makeNonsenseAST $ ASTFunction fn1) where
 builtinHead :: (String, AST)
 builtinHead = (name, makeNonsenseAST $ ASTFunction fn1) where
     name = "head"
-    fn1 _ AST { astNode = ASTVector vec } =
-     do when (length vec == 0) $ throwL $ name ++ " of empty vector"
+    fn1 _ ast1@AST { astNode = ASTVector vec } =
+     do when (length vec == 0) $ throwL (astPos ast1) $ name ++ " of empty vector"
         return $ head vec
-    fn1 _ ast = throwL $ argError1 name ast
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinTail :: (String, AST)
 builtinTail = (name, makeNonsenseAST $ ASTFunction fn1) where
     name = "tail"
-    fn1 _ AST { astNode = ASTVector vec } =
-     do when (length vec == 0) $ throwL $ name ++ " of empty vector"
+    fn1 _ ast1@AST { astNode = ASTVector vec } =
+     do when (length vec == 0) $ throwL (astPos ast1) $ name ++ " of empty vector"
         return $ makeNonsenseAST $ ASTVector $ tail vec
-    fn1 _ ast = throwL $ argError1 name ast
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinSubstr :: (String, AST)
 builtinSubstr = (name, makeNonsenseAST $ ASTFunction fn1) where
@@ -175,9 +178,9 @@ builtinSubstr = (name, makeNonsenseAST $ ASTFunction fn1) where
                 return $ makeNonsenseAST $ ASTFunction $ fn3 where
                     fn3 _ AST { astNode = ASTString str } =
                         return $ makeNonsenseAST $ ASTString $ drop at .> take len $ str
-                    fn3 _ ast3 = throwL $ argError3 name ast1 ast2 ast3
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
-    fn1 _ ast1 = throwL $ argError1 name ast1
+                    fn3 _ ast3 = throwL (astPos ast3) $ argError3 name ast1 ast2 ast3
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinPrepend :: (String, AST)
 builtinPrepend = (name, makeNonsenseAST $ ASTFunction fn1) where
@@ -186,7 +189,7 @@ builtinPrepend = (name, makeNonsenseAST $ ASTFunction fn1) where
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
             fn2 _ AST { astNode = ASTVector vec } =
                 return $ makeNonsenseAST $ ASTVector $ ast1 : vec
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
 
 builtinPrint :: (String, AST)
 builtinPrint = (name, makeNonsenseAST $ ASTFunction fn1) where
@@ -194,7 +197,7 @@ builtinPrint = (name, makeNonsenseAST $ ASTFunction fn1) where
     fn1 _ AST { astNode = ASTString str } =
      do liftIO $ putStr $ str
         return $ makeNonsenseAST ASTUnit
-    fn1 _ ast = throwL $ argError1 name ast
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinConcat :: (String, AST)
 builtinConcat = (name, makeNonsenseAST $ ASTFunction fn1) where
@@ -203,13 +206,13 @@ builtinConcat = (name, makeNonsenseAST $ ASTFunction fn1) where
         return $ makeNonsenseAST $ ASTFunction $ fn2 where
             fn2 _ AST { astNode = ASTString str2 } =
                 return $ makeNonsenseAST $ ASTString $ str1 ++ str2
-            fn2 _ ast2 = throwL $ argError2 name ast1 ast2
-    fn1 _ ast1 = throwL $ argError1 name ast1
+            fn2 _ ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+    fn1 _ ast1 = throwL (astPos ast1) $ argError1 name ast1
 
 builtinFatal :: (String, AST)
 builtinFatal = (name, makeNonsenseAST $ ASTFunction fn1) where
     name = "fatal"
-    fn1 _ AST { astNode = ASTString str } =
-        throwL $ str
-    fn1 _ ast =
-        throwL $ argError1 name ast
+    fn1 _ ast1@AST { astNode = ASTString str } =
+        throwL (astPos ast1) $ str
+    fn1 _ ast1 =
+        throwL (astPos ast1) $ argError1 name ast1
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
index 754c0b1..4f40706 100644
--- a/src/Evaluator.hs
+++ b/src/Evaluator.hs
@@ -18,7 +18,7 @@ _curryCall env (arg:rest) f = do
     g <- _curryCall env rest f
     case astNode g of
         ASTFunction f' -> f' env arg
-        other -> throwL $ "cannot call value " ++ show other ++ " as a function"
+        other -> throwL (astPos g) $ "cannot call value " ++ show other ++ " as a function"
 
 curryCall :: Env -> [AST] -> LFunction -> LContext AST
 curryCall env [] f = f env (makeNonsenseAST ASTUnit)
@@ -55,7 +55,7 @@ letArgsToSymValPairs env args =
             return (symbol', evaledValue)
         [AST { astNode = ASTSymbol "lazy" }, AST { astNode = ASTSymbol symbol' }, value'] -> do
             return (symbol', value')
-        other -> throwL $ "let called with invalid args " ++ show other
+        other -> throwL (astPos $ head other) $ "let called with invalid args " ++ show other
 
 defineUserFunction :: AST -> [AST] -> LContext LFunction
 defineUserFunction AST { astNode = ASTSymbol param } exprs = return fn where
@@ -65,7 +65,7 @@ defineUserFunction AST { astNode = ASTSymbol param } exprs = return fn where
         let letExprs = take (length exprs - 1) replacedExprs
         letSymValPairs <- letExprs
                 $> mapM (\case AST { astNode = ASTFunctionCall v } -> return $ drop 1 v
-                               _ -> throwL $ "unreachable: map letExprs")
+                               ast -> throwL (astPos ast) $ "unreachable: map letExprs, ast: " ++ show ast)
                 .> fmap (mapM $ letArgsToSymValPairs env) .> join
         let body = head $ drop (length exprs - 1) replacedExprs
         let newBody = traverseAndReplace param arg body
@@ -73,7 +73,8 @@ defineUserFunction AST { astNode = ASTSymbol param } exprs = return fn where
         (_, ret) <- evaluate env newBody
         return ret
 
-defineUserFunction param exprs = throwL $ "unreachable: defineUserFunction, param: " ++ show param ++ ", exprs: " ++ show exprs
+defineUserFunction param exprs = throwL (astPos param)
+    $ "unreachable: defineUserFunction, param: " ++ show param ++ ", exprs: " ++ show exprs
 
 defineUserFunctionWithLetExprs :: [AST] -> [AST] -> LContext LFunction
 defineUserFunctionWithLetExprs [] exprs =
@@ -89,7 +90,8 @@ defineUserFunctionWithLetExprs (AST { astNode = ASTSymbol param }:rest) exprs =
         -- the returned AST will not have the correct position info, but that's fine
         -- because the info is overridden in evaluateFunctionDef anyway
         return $ makeNonsenseAST $ ASTFunction $ ret
-defineUserFunctionWithLetExprs _ _ = throwL $ "unreachable: defineUserFunctionWithLetExprs"
+defineUserFunctionWithLetExprs (param:_) _ = throwL (astPos $ param)
+    $ "unreachable: defineUserFunctionWithLetExprs, param: " ++ show param
 
 evaluateFunctionDef :: Env -> [AST] -> LContext (Env, AST)
 evaluateFunctionDef env asts = do
@@ -98,29 +100,35 @@ evaluateFunctionDef env asts = do
     (params'', exprs) <- case args of
         args'
             | length args' < 2 ->
-                throwL $ "\\ called with " ++ show (length args) ++ " arguments"
+                throwL (astPos defAst) $ "\\ called with " ++ show (length args) ++ " arguments"
             | otherwise -> return $ (head args', tail args')
     AST { astNode = ASTVector params' } <- assertIsASTVector params''
     params <- mapM assertIsASTSymbol params'
 
     let letExprs = take (length exprs - 1) exprs
-    unless (all (\case ASTFunctionCall (AST { astNode = ASTSymbol "let" }:_) -> True; _ -> False) (map astNode letExprs))
-        $ throwL "non-let expression in function definition before body"
+    let nonLetExprM = L.find isLetAST letExprs
+    case nonLetExprM of
+        Just nonLetExpr -> throwL (astPos nonLetExpr)
+            $ "non-let expression in function definition before body: " ++ show nonLetExpr
+        Nothing -> return ()
 
     fn <- defineUserFunctionWithLetExprs params exprs
     return $ (env, defAst { astNode = ASTFunction fn })
+    where
+        isLetAST AST { astNode = ASTFunctionCall (AST { astNode = ASTSymbol "let" }:_) } = True
+        isLetAST _ = False
 
 evaluateMatch :: Env -> [AST] -> LContext (Env, AST)
 evaluateMatch env asts = do
     let matchAst = head asts
         args = tail asts
     (actualExpr, rest) <- case args of
-        [] -> throwL $ "match called with no arguments"
-        (_:[]) -> throwL $ "empty match cases"
+        [] -> throwL (astPos matchAst) $ "match called with no arguments"
+        (_:[]) -> throwL (astPos matchAst) "empty match cases"
         (a:b) -> return (a, b)
 
     pairs <- (asPairsM rest) `catchError`
-                (\_ -> throwL $ "invalid number of arguments passed to match\n"
+                (\_ -> throwL (astPos matchAst) $ "invalid number of arguments passed to match\n"
                                 ++ "- matching on expr: " ++ show actualExpr ++ "\n"
                                 ++ "- arguments: " ++ show rest)
 
@@ -129,7 +137,7 @@ evaluateMatch env asts = do
     return (env, matchAst { astNode = astNode ret })
     where
         matchPairs :: (AST, AST) -> [(AST, AST)] -> LContext AST
-        matchPairs (actualExpr, evaledActual) [] = throwL $ "matching case not found when matching on expression: " ++ show actualExpr
+        matchPairs (actualExpr, evaledActual) [] = throwL (astPos actualExpr) $ "matching case not found when matching on expression: " ++ show actualExpr
                     ++ " (actual value: " ++ show evaledActual ++ ")"
         matchPairs (actualExpr, evaledActual) ((matcher, branch):restPairs) = do
             (_, evaledMatcher) <- evaluate env matcher
@@ -144,7 +152,7 @@ evaluateLet env asts = do
     let letAst = head asts
         args = tail asts
     (symbol, value) <- letArgsToSymValPairs env args
-    when (M.member symbol env) $ throwL $ "symbol already defined: " ++ symbol
+    when (M.member symbol env) $ throwL (astPos letAst) $ "symbol already defined: " ++ symbol
     let newEnv = M.insert symbol value env
     return $ (newEnv, letAst { astNode = ASTUnit })
 
@@ -172,12 +180,13 @@ evaluateUserFunction env children = do
     -- maybe remove double eval here? can't remember why it was added
     return (env, fnAst { astNode = astNode result })
 
-evaluateSymbol :: Env -> String -> LContext (Env, AST)
-evaluateSymbol env sym = do
+evaluateSymbol :: Env -> AST -> LContext (Env, AST)
+evaluateSymbol env ast@AST { astNode = ASTSymbol sym }  = do
     let val = M.lookup sym env
     case val of
-        Just ast -> return (env, ast)
-        Nothing -> throwL $ "symbol " ++ sym ++ " not defined in environment"
+        Just ast' -> return (env, ast')
+        Nothing -> throwL (astPos ast) $ "symbol " ++ sym ++ " not defined in environment"
+evaluateSymbol _ ast = throwL (astPos ast) $ "unreachable: evaluateSymbol, ast: " ++ show ast
 
 evaluate :: Env -> AST -> LContext (Env, AST)
 evaluate env AST { astNode = fnc@(ASTFunctionCall args@(x:_)) } =
@@ -194,8 +203,8 @@ evaluate env AST { astNode = fnc@(ASTFunctionCall args@(x:_)) } =
                 evaluateEnv env args
             _ ->
                 evaluateUserFunction env args
-evaluate env AST { astNode = (ASTSymbol sym) } =
-    evaluateSymbol env sym
+evaluate env ast@AST { astNode = (ASTSymbol _) } =
+    evaluateSymbol env ast
 evaluate env ast@AST { astNode = (ASTVector vec) } =
      do rets <- mapM (evaluate env) vec
         let vec' = map snd rets
diff --git a/src/Parser.hs b/src/Parser.hs
index b60fdc9..e46d80c 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -11,15 +11,17 @@ import Utils
 
 validateBalance :: [String] -> [AST] -> LContext [AST]
 validateBalance allowed asts = do
-    when (ASTSymbol "(" `elem` astNodes && "(" `notElem` allowed)
-        $ throwL "unbalanced function call"
-    when (ASTSymbol "[" `elem` astNodes && "[" `notElem` allowed)
-        $ throwL "unbalanced vector"
-    when (ASTSymbol "{" `elem` astNodes && "{" `notElem` allowed)
-        $ throwL "unbalanced hash map"
+    when (MB.isJust parenM && "(" `notElem` allowed)
+        $ throwL (astPos $ MB.fromJust parenM) "unbalanced function call"
+    when (MB.isJust bracketM && "[" `notElem` allowed)
+        $ throwL (astPos $ MB.fromJust bracketM) "unbalanced vector"
+    when (MB.isJust curlyM && "{" `notElem` allowed)
+        $ throwL (astPos $ MB.fromJust curlyM) "unbalanced hash map"
     return asts
     where
-        astNodes = map astNode asts
+        parenM = L.find ((== ASTSymbol "(") . astNode) asts
+        bracketM = L.find ((== ASTSymbol "[") . astNode) asts
+        curlyM = L.find ((== ASTSymbol "{") . astNode) asts
 
 parseToken :: Token -> AST
 parseToken (Token token tr tc tf)
@@ -62,8 +64,9 @@ _parse acc (Token { tokenContent = "]" }:rest) = do
 _parse acc (Token { tokenContent = "}" }:rest) = do
     let children' = takeWhile (astNode .> (/= ASTSymbol "{")) acc
     children <- validateBalance ["{"] children'
-    pairs <- asPairsM $ reverse children
     let openCurly = MB.fromJust $ L.find (astNode .> (== ASTSymbol "{")) acc
+    pairs <- asPairsM (reverse children) `catchError`
+        \(LException _ e) -> throwL (astPos openCurly) e
     let hmap = openCurly { astNode = ASTHashMap (M.fromList pairs) }
     let newAcc = hmap : drop (length children + 1) acc
     _parse newAcc rest
diff --git a/src/Tokenizer.hs b/src/Tokenizer.hs
index 64ba638..565caa5 100644
--- a/src/Tokenizer.hs
+++ b/src/Tokenizer.hs
@@ -12,6 +12,9 @@ data TChar = TChar {
     tColumn :: Int
 }
 
+posTChar :: String -> TChar -> String
+posTChar fileName TChar { tRow = r, tColumn = c } = fileName ++ ":" ++ show r ++ ":" ++ show c
+
 _tokenize :: String -> [Token] -> [TChar] -> [TChar] -> LContext [Token]
 _tokenize fileName acc current [] =
     let cur = reverse current
@@ -51,7 +54,7 @@ _tokenize fileName acc current (x:xs)
                 tokenColumn = tColumn $ x,
                 tokenFileName = fileName }
         in do
-            when (stringLength == -1) $ throwL "unbalanced string literal"
+            when (stringLength == -1) $ throwL (posTChar fileName x) $ "unbalanced string literal"
             _tokenize fileName (token : acc) [] stringDropped
     | tChar x `elem` [' ', '\n', '\t', '\r'] =
         let cur = reverse current
diff --git a/src/Utils.hs b/src/Utils.hs
index ba459e8..2a2f607 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -9,7 +9,10 @@ import qualified Data.Char as C
 
 -- TYPES
 
-newtype LException = LException String
+type PositionString = String
+type ErrorString = String
+data LException = LException (Maybe PositionString) ErrorString
+
 data Config = Config {
     configScriptFileName :: Maybe String,
     configVerboseMode :: Bool,
@@ -115,32 +118,32 @@ instance (Ord ASTNode) where
 assertIsASTFunction :: AST -> LContext AST
 assertIsASTFunction ast@(AST { astNode = node }) = case node of
     (ASTFunction _) -> return ast
-    _ -> throwL $ show node ++ " is not a function"
+    _ -> throwL (astPos ast) $ show node ++ " is not a function"
 
 assertIsASTInteger :: AST -> LContext AST
 assertIsASTInteger ast@(AST { astNode = node }) = case node of
     (ASTInteger _) -> return ast
-    _ -> throwL $ show node ++ " is not an integer"
+    _ -> throwL (astPos ast) $ show node ++ " is not an integer"
 
 assertIsASTSymbol :: AST -> LContext AST
 assertIsASTSymbol ast@(AST { astNode = node }) = case node of
     (ASTSymbol _) -> return ast
-    _ -> throwL $ show node ++ " is not a symbol"
+    _ -> throwL (astPos ast) $ show node ++ " is not a symbol"
 
 assertIsASTVector :: AST -> LContext AST
 assertIsASTVector ast@(AST { astNode = node }) = case node of
     (ASTVector _) -> return ast
-    _ -> throwL $ show node ++ " is not a vector"
+    _ -> throwL (astPos ast) $ show node ++ " is not a vector"
 
 assertIsASTString :: AST -> LContext AST
 assertIsASTString ast@(AST { astNode = node }) = case node of
     (ASTString _) -> return ast
-    _ -> throwL $ show node ++ " is not a string"
+    _ -> throwL (astPos ast) $ show node ++ " is not a string"
 
 assertIsASTFunctionCall :: AST -> LContext AST
 assertIsASTFunctionCall ast@(AST { astNode = node }) = case node of
     (ASTFunctionCall _) -> return ast
-    _ -> throwL $ show node ++ " is not a function call or body"
+    _ -> throwL (astPos ast) $ show node ++ " is not a function call or body"
 
 -- UTILS
 
@@ -159,15 +162,16 @@ evenElems :: [a] -> [a]
 evenElems [] = []
 evenElems (_:xs) = oddElems xs
 
-throwL :: String -> LContext a
-throwL s = throwError $ LException s
+throwL :: String -> String -> LContext a
+throwL p s = throwError $ LException mp s
+    where mp = if p == "" then Nothing else Just p
 
 asPairsM :: [a] -> LContext [(a, a)]
 asPairsM [] = return []
 asPairsM (a:b:rest) = do
     restPaired <- asPairsM rest
     return $ (a, b) : restPaired
-asPairsM _ = throwL "odd number of elements to pair up"
+asPairsM _ = throwL "" "odd number of elements to pair up"
 
 asPairs :: [a] -> [(a, a)]
 asPairs [] = []
@@ -184,5 +188,8 @@ makeNonsenseAST :: ASTNode -> AST
 makeNonsenseAST node =
     AST { astNode = node, astRow = -1, astColumn = -1, astFileName = "nonsense"}
 
-pos :: AST -> String
-pos AST { astRow = r, astColumn = c, astFileName = f } = f ++ ":" ++ show r ++ ":" ++ show c
+astPos :: AST -> String
+astPos AST { astRow = r, astColumn = c, astFileName = f } = f ++ ":" ++ show r ++ ":" ++ show c
+
+tokenPos :: Token -> String
+tokenPos Token { tokenRow = r, tokenColumn = c, tokenFileName = f } = f ++ ":" ++ show r ++ ":" ++ show c