Improve error reporting

9 files changed, 152 insertions, 135 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 1617dd5..37844c9 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -36,10 +36,8 @@ repl' lineNo ls = do
         Just input -> do
             result <- lift $ runL ls $ runInlineScript' lineNo "<repl>" input
             case result of
-                Left (LException mp ex) -> do
-                    outputStrLn $ case mp of
-                        Just p -> p ++ " error: " ++ ex
-                        Nothing -> "error: " ++ ex
+                Left ex -> do
+                    outputStrLn $ foldStackMessage ex
                     repl' (lineNo + 1) ls
                 Right (_, LState { stateEnv = newEnv }) -> do
                     repl' (lineNo + 1) ls { stateEnv = newEnv }
@@ -86,9 +84,8 @@ main = do
             Just scriptFileName -> do
                 result <- runL ls (runScriptFile scriptFileName)
                 case result of
-                    Left (LException mp ex) -> case mp of
-                        Just p -> putStrLn $ p ++ " error: " ++ ex
-                        Nothing -> putStrLn $ "error: " ++ ex
+                    Left ex -> do
+                        putStrLn $ foldStackMessage ex
                     Right (_, LState { stateEnv = evaledEnv }) -> do
                         when (configUseREPL config) $
                             runInputT defaultSettings $ repl ls { stateEnv = evaledEnv }
diff --git a/examples/records-concept.milch b/examples/records-concept.milch
index dcb4a49..ebbf740 100644
--- a/examples/records-concept.milch
+++ b/examples/records-concept.milch
@@ -22,6 +22,6 @@
 (Ns/User/set-phone-number unit user)
     ; => (Ns/User name:"Rick" phone-number:<unit>)
 
-; The builtin function `kind` returns the identifier as a string for any record value
+; The builtin function `kind` returns the identifier as a tag for any record value
 
-(kind user) ; => "Ns/User"
+(kind user) ; => :Ns/User
diff --git a/src/Builtins.hs b/src/Builtins.hs
index 751be12..292e344 100644
--- a/src/Builtins.hs
+++ b/src/Builtins.hs
@@ -68,7 +68,7 @@ argError3 fn arg1 arg2 arg3 =
 
 reservedKeyword :: String -> (String, AST)
 reservedKeyword name = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
-    fn1 ast1 = throwL (astPos ast1) $ "unreachable: " ++ name ++ " is a reserved word"
+    fn1 ast1 = throwL (astPos ast1, "unreachable: " ++ name ++ " is a reserved word")
 
 -- BUILTINS
 
@@ -79,13 +79,13 @@ builtinAdd2 = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 AST { an = ASTInteger b } =
                 return $ makeNonsenseAST $ ASTInteger $ a + b
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
     fn1 ast1@AST { an = ASTDouble a } =
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 AST { an = ASTDouble b } =
                 return $ makeNonsenseAST $ ASTDouble $ a + b
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
-    fn1 ast1 = throwL (astPos ast1) $ 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 Pure fn1) where
@@ -94,13 +94,13 @@ builtinSubtract2 = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 AST { an = ASTInteger b } =
                 return $ makeNonsenseAST $ ASTInteger $ a - b
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
     fn1 ast1@AST { an = ASTDouble a } =
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 AST { an = ASTDouble b } =
                 return $ makeNonsenseAST $ ASTDouble $ a - b
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
-    fn1 ast1 = throwL (astPos ast1) $ 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 Pure fn1) where
@@ -109,13 +109,13 @@ builtinMultiply2 = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 AST { an = ASTInteger b } =
                 return $ makeNonsenseAST $ ASTInteger $ a * b
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
     fn1 ast1@AST { an = ASTDouble a } =
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 AST { an = ASTDouble b } =
                 return $ makeNonsenseAST $ ASTDouble $ a * b
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
-    fn1 ast1 = throwL (astPos ast1) $ 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 Pure fn1) where
@@ -123,16 +123,16 @@ builtinDivide2 = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
     fn1 ast1@AST { an = ASTInteger a } =
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 ast2@AST { an = ASTInteger b } =
-             do when (b == 0) $ throwL (astPos ast2) $ "division by zero"
+             do when (b == 0) $ throwL (astPos ast2, "division by zero")
                 return $ makeNonsenseAST $ ASTInteger $ a `div` b
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
     fn1 ast1@AST { an = ASTDouble a } =
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 ast2@AST { an = ASTDouble b } =
-             do when (b == 0) $ throwL (astPos ast2) $ "division by zero"
+             do when (b == 0) $ throwL (astPos ast2, "division by zero")
                 return $ makeNonsenseAST $ ASTDouble $ a / b
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
-    fn1 ast1 = throwL (astPos ast1) $ 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 Pure fn1) where
@@ -152,7 +152,7 @@ builtinFloor :: (String, AST)
 builtinFloor = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
     name = "floor"
     fn1 AST { an = ASTDouble dbl } = return $ makeNonsenseAST $ ASTInteger $ floor dbl
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinParseInt :: (String, AST)
 builtinParseInt = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
@@ -160,14 +160,14 @@ builtinParseInt = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
     fn1 ast1@AST { an = ASTString str } =
         case (TR.readMaybe str) of
             Just val -> return $ makeNonsenseAST $ ASTInteger $ val
-            Nothing -> throwL (astPos ast1) $ argError1 name ast1
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+            Nothing -> throwL (astPos ast1, argError1 name ast1)
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinToDouble :: (String, AST)
 builtinToDouble = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
     name = "to-double"
     fn1 AST { an = ASTInteger int } = return $ makeNonsenseAST $ ASTDouble $ fromIntegral int
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinFmt :: (String, AST)
 builtinFmt = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
@@ -177,8 +177,8 @@ builtinFmt = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
             fn2 AST { an = ASTVector replacements } =
                 return $ makeNonsenseAST $ ASTString $
                     T.unpack $ replaceAll (0 :: Int) replacements (T.pack str)
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
     replaceAll :: Int -> [AST] -> T.Text -> T.Text
     replaceAll _ [] text = text
     replaceAll n (x:xs) text =
@@ -192,17 +192,17 @@ builtinHead :: (String, AST)
 builtinHead = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
     name = "head"
     fn1 ast1@AST { an = ASTVector vec } =
-     do when (length vec == 0) $ throwL (astPos ast1) $ name ++ " of empty vector"
+     do when (length vec == 0) $ throwL (astPos ast1, name ++ " of empty vector")
         return $ head vec
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinTail :: (String, AST)
 builtinTail = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
     name = "tail"
     fn1 ast1@AST { an = ASTVector vec } =
-     do when (length vec == 0) $ throwL (astPos ast1) $ name ++ " of empty vector"
+     do when (length vec == 0) $ throwL (astPos ast1, name ++ " of empty vector")
         return $ makeNonsenseAST $ ASTVector $ tail vec
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinSubstr :: (String, AST)
 builtinSubstr = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
@@ -215,9 +215,9 @@ builtinSubstr = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
                     at = fromIntegral atInteger :: Int
                     fn3 AST { an = ASTString str } =
                         return $ makeNonsenseAST $ ASTString $ drop at .> take len $ str
-                    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
+                    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)
 
 builtinStrToVec :: (String, AST)
 builtinStrToVec = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
@@ -227,7 +227,7 @@ builtinStrToVec = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
             .> map (makeNonsenseAST . ASTString)
             .> (makeNonsenseAST . ASTVector)
             .> return
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinPrepend :: (String, AST)
 builtinPrepend = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
@@ -236,7 +236,7 @@ builtinPrepend = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 AST { an = ASTVector vec } =
                 return $ makeNonsenseAST $ ASTVector $ ast1 : vec
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
 
 builtinPrint :: (String, AST)
 builtinPrint = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
@@ -244,7 +244,7 @@ builtinPrint = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
     fn1 AST { an = ASTString str } =
      do liftIO $ putStr $ str
         return $ makeNonsenseAST ASTUnit
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinConcat :: (String, AST)
 builtinConcat = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
@@ -253,30 +253,30 @@ builtinConcat = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
         return $ makeNonsenseAST $ ASTFunction Pure $ fn2 where
             fn2 AST { an = ASTString str2 } =
                 return $ makeNonsenseAST $ ASTString $ str1 ++ str2
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinLen :: (String, AST)
 builtinLen = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
     name = "len"
     fn1 AST { an = ASTString str } =
         return $ makeNonsenseAST $ ASTInteger $ fromIntegral $ length str
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinFatal :: (String, AST)
 builtinFatal = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
     name = "fatal!"
     fn1 ast1@AST { an = ASTString str } =
-        throwL (astPos ast1) $ str
+        throwL (astPos ast1, str)
     fn1 ast1 =
-        throwL (astPos ast1) $ argError1 name ast1
+        throwL (astPos ast1, argError1 name ast1)
 
 builtinKind :: (String, AST)
 builtinKind = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
     name = "kind"
     fn1 AST { an = ASTRecord tagHash identifier _} =
         return $ makeNonsenseAST $ ASTTag tagHash identifier
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinReadFile :: (String, AST)
 builtinReadFile = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
@@ -285,8 +285,8 @@ builtinReadFile = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
         contentsM <- liftIO $ safeReadFile filePath
         case contentsM of
             Just contents -> return $ makeNonsenseAST $ ASTString contents
-            Nothing -> throwL (astPos ast1) $ "failed to read file: " ++ filePath
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+            Nothing -> throwL (astPos ast1, "failed to read file: " ++ filePath)
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinWriteFile :: (String, AST)
 builtinWriteFile = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
@@ -297,9 +297,9 @@ builtinWriteFile = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
                 resultM <- liftIO $ safeWriteFile filePath content
                 case resultM of
                     Just () -> return $ makeNonsenseAST $ ASTUnit
-                    Nothing -> throwL (astPos ast1) $ "failed to write file: " ++ filePath
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+                    Nothing -> throwL (astPos ast1, "failed to write file: " ++ filePath)
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinAppendFile :: (String, AST)
 builtinAppendFile = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
@@ -310,9 +310,9 @@ builtinAppendFile = (name, makeNonsenseAST $ ASTFunction Impure fn1) where
                 resultM <- liftIO $ safeAppendFile filePath content
                 case resultM of
                     Just () -> return $ makeNonsenseAST $ ASTUnit
-                    Nothing -> throwL (astPos ast1) $ "failed to append to file: " ++ filePath
-            fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+                    Nothing -> throwL (astPos ast1, "failed to append to file: " ++ filePath)
+            fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2)
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
 
 builtinSortByFirst :: (String, AST)
 builtinSortByFirst = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
@@ -325,9 +325,9 @@ builtinSortByFirst = (name, makeNonsenseAST $ ASTFunction Pure fn1) where
         return $ makeNonsenseAST $ ASTVector sortedASTS where
             itemsToPair [AST { an = ASTInteger k }, v] =
                 return $ (k, v)
-            itemsToPair items = throwL (astPos ast1) $
-                "invalid element in vector supplied to sort-by-first: " ++ show items
+            itemsToPair items = throwL (astPos ast1,
+                "invalid element in vector supplied to sort-by-first: " ++ show items)
             elemToPair AST { an = ASTVector items } =
                 itemsToPair items
-            elemToPair ast2 = throwL (astPos ast2) $ argError1 name ast1
-    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+            elemToPair ast2 = throwL (astPos ast2, argError1 name ast1)
+    fn1 ast1 = throwL (astPos ast1, argError1 name ast1)
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 2c04e4f..b34d2ef 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -30,7 +30,7 @@ curryCall (arg:rest) f = do
         ASTFunction fIsPure f' -> do
             checkPurity fIsPure
             f' arg
-        other -> throwL (astPos g) $ "cannot call value " ++ show other ++ " as a function"
+        other -> throwL (astPos g, "cannot call value " ++ show other ++ " as a function")
 
 traverseAndReplace :: String -> AST -> AST -> AST
 traverseAndReplace param arg ast@AST { an = ASTSymbol sym }
@@ -59,14 +59,14 @@ processLetExpr scope letExpr = do
     (sym, val) <- case letExpr of
             AST { an = ASTFunctionCall [AST { an = ASTSymbol "let" }, AST { an = ASTSymbol symbol' }, value'] } ->
                 return (symbol', value')
-            other -> throwL (astPos other) $ "invalid let call in function body: " ++ show other
+            other -> throwL (astPos other, "invalid let call in function body: " ++ show other)
 
     return $ (sym, val) : scope
 
 foldUserFunctionLetExprs :: Scope -> AST -> [AST] -> LContext LFunction
 foldUserFunctionLetExprs scope paramAst@AST { an = ASTSymbol param } exprs = return fn where
     fn :: LFunction
-    fn arg = ret `catchError` appendError ("in a function definition at " ++ astPos paramAst) where
+    fn arg = ret `catchError` appendError (astPos paramAst, "in a function definition") where
         ret = do
             let letExprs = init exprs
 
@@ -77,8 +77,8 @@ foldUserFunctionLetExprs scope paramAst@AST { an = ASTSymbol param } exprs = ret
             let newBody = foldScope localScope body
             evaluate newBody
 
-foldUserFunctionLetExprs _ param exprs = throwL (astPos param)
-    $ "unreachable: foldUserFunctionLetExprs, param: " ++ show param ++ ", exprs: " ++ show exprs
+foldUserFunctionLetExprs _ param exprs = throwL (astPos param,
+    "unreachable: foldUserFunctionLetExprs, param: " ++ show param ++ ", exprs: " ++ show exprs)
 
 foldUserFunctionParams :: Scope -> [AST] -> [AST] -> LContext LFunction
 foldUserFunctionParams scope [] exprs =
@@ -94,8 +94,8 @@ foldUserFunctionParams scope (AST { an = ASTSymbol param }:rest) exprs = return
         -- The returned function AST will not have the correct position info or purity, but that's fine
         -- because the info is overridden in evaluateFunctionDef anyway.
         return $ makeNonsenseAST $ ASTFunction Pure ret
-foldUserFunctionParams _ (param:_) _ = throwL (astPos $ param)
-    $ "unreachable: foldUserFunctionParams, param: " ++ show param
+foldUserFunctionParams _ (param:_) _ = throwL (astPos $ param,
+    "unreachable: foldUserFunctionParams, param: " ++ show param)
 
 defineUserFunction :: [AST] -> [AST] -> LContext LFunction
 defineUserFunction = foldUserFunctionParams []
@@ -107,7 +107,7 @@ evaluateFunctionDef isPure asts = do
     (params'', exprs) <- case args of
         args'
             | length args' < 2 ->
-                throwL (astPos defAst) $ "\\ or \\! called with " ++ show (length args) ++ " arguments"
+                throwL (astPos defAst, "\\ or \\! called with " ++ show (length args) ++ " arguments")
             | otherwise -> return $ (head args', tail args')
 
     AST { an = ASTVector params' } <- assertIsASTVector params''
@@ -118,15 +118,15 @@ evaluateFunctionDef isPure asts = do
 
     let shadowingParamM = L.find (asSymbol .> isParamNameShadowing) params
     case shadowingParamM of
-        Just shadowingParam -> throwL (astPos shadowingParam)
-            $ "parameter is shadowing already defined symbol " ++ show (an shadowingParam)
+        Just shadowingParam -> throwL (astPos shadowingParam,
+            "parameter is shadowing already defined symbol " ++ show (an shadowingParam))
         Nothing -> return ()
 
     let letExprs = init exprs
     let nonLetExprM = L.find (not . isLetAST) letExprs
     case nonLetExprM of
-        Just nonLetExpr -> throwL (astPos nonLetExpr)
-            $ "non-let expression in function definition before body: " ++ show nonLetExpr
+        Just nonLetExpr -> throwL (astPos nonLetExpr,
+            "non-let expression in function definition before body: " ++ show nonLetExpr)
         Nothing -> return ()
 
     fn <- defineUserFunction params exprs
@@ -143,12 +143,12 @@ evaluateMatch asts = do
         args = tail asts
 
     (actualExpr, rest) <- case args of
-        [] -> throwL (astPos matchAst) $ "match called with no arguments"
-        (_:[]) -> throwL (astPos matchAst) "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 (astPos matchAst) $ "invalid number of arguments passed to match\n"
+                appendError (astPos matchAst, "invalid number of arguments passed to match\n"
                                 ++ "- matching on expr: " ++ show actualExpr ++ "\n"
                                 ++ "- arguments: " ++ show rest)
 
@@ -157,9 +157,9 @@ evaluateMatch asts = do
     return $ matchAst { an = an ret }
     where
         matchPairs :: (AST, AST) -> [(AST, AST)] -> LContext AST
-        matchPairs (actualExpr, evaledActual) [] = throwL (astPos actualExpr)
-            $ "matching case not found when matching on expression: " ++ show actualExpr
-            ++ " (evaled value: " ++ show evaledActual ++ ")"
+        matchPairs (actualExpr, evaledActual) [] = throwL (astPos actualExpr,
+            "matching case not found when matching on expression: " ++ show actualExpr
+            ++ " (evaled value: " ++ show evaledActual ++ ")")
         matchPairs (actualExpr, evaledActual) ((matcher, branch):restPairs) = do
             evaledMatcher <- evaluate matcher
             if evaledActual == evaledMatcher
@@ -172,26 +172,26 @@ evaluateLet asts = do
         args = tail asts
 
     d <- getDepth
-    when (d > 1) $ throwL (astPos letAst) $ "let can only be called on the top level or in a function definition, current depth: " ++ show d
+    when (d > 1) $ throwL (astPos letAst, "let can only be called on the top level or in a function definition, current depth: " ++ show d)
 
     case args of
         [AST { an = ASTSymbol "lazy" }, AST { an = ASTSymbol sym }, val] -> do
             env <- getEnv
-            when (MB.isJust $ resolveSymbol sym env) $ throwL (astPos letAst) $ "symbol already defined: " ++ sym
+            when (MB.isJust $ resolveSymbol sym env) $ throwL (astPos letAst, "symbol already defined: " ++ sym)
             insertEnv sym $ Regular val
             return $ letAst { an = ASTUnit }
         [AST { an = ASTSymbol "memo" }, AST { an = ASTSymbol sym }, val] -> do
             env <- getEnv
-            when (MB.isJust $ resolveSymbol sym env) $ throwL (astPos letAst) $ "symbol already defined: " ++ sym
+            when (MB.isJust $ resolveSymbol sym env) $ throwL (astPos letAst, "symbol already defined: " ++ sym)
             insertEnv sym $ Memoized M.empty val
             return $ letAst { an = ASTUnit }
         [AST { an = ASTSymbol sym }, value'] -> do
             evaledValue <- evaluate value'
             env <- getEnv
-            when (MB.isJust $ resolveSymbol sym env) $ throwL (astPos letAst) $ "symbol already defined: " ++ sym
+            when (MB.isJust $ resolveSymbol sym env) $ throwL (astPos letAst, "symbol already defined: " ++ sym)
             insertEnv sym $ Regular evaledValue
             return $ letAst { an = ASTUnit }
-        other -> throwL (astPos $ head other) $ "let called with invalid args " ++ show other
+        other -> throwL (astPos $ head other, "let called with invalid args " ++ show other)
 
 evaluateDebugEnv :: [AST] -> LContext AST
 evaluateDebugEnv asts = do
@@ -211,8 +211,7 @@ evaluateImport asts = do
         args = tail asts
 
     d <- getDepth
-    when (d > 1) $ throwL (astPos importAst) $
-        "import can only be called on the top level, current depth: " ++ show d
+    when (d > 1) $ throwL (astPos importAst, "import can only be called on the top level, current depth: " ++ show d)
 
     config <- getConfig
     let initialState = LState {
@@ -233,7 +232,7 @@ evaluateImport asts = do
             putEnv $ M.union importedEnv env
             return $ importAst { an = ASTUnit }
 
-        _ -> throwL (astPos importAst) $ "invalid arguments passed to import: " ++ show args
+        _ -> throwL (astPos importAst, "invalid arguments passed to import: " ++ show args)
 
 evaluateRecord :: [AST] -> LContext AST
 evaluateRecord asts = do
@@ -241,14 +240,13 @@ evaluateRecord asts = do
         args = tail asts
 
     d <- getDepth
-    when (d > 1) $ throwL (astPos recordAst) $ "record can only be called on the top level, current depth: " ++ show d
+    when (d > 1) $ throwL (astPos recordAst, "record can only be called on the top level, current depth: " ++ show d)
 
     case args of
         (AST { an = ASTSymbol ns }:rest) -> do
             let nonSymFields = L.find (not . isSymbolAST) rest
             case nonSymFields of
-                Just invalid -> throwL (astPos invalid)
-                    $ "non-symbol field in record definition: " ++ show invalid
+                Just invalid -> throwL (astPos invalid, "non-symbol field in record definition: " ++ show invalid)
                 Nothing -> return ()
 
             let fields = extractRows rest
@@ -291,7 +289,7 @@ evaluateRecord asts = do
 
             return $ recordAst { an = ASTUnit }
 
-        _ -> throwL (astPos recordAst) $ "invalid arguments passed to import: " ++ show args
+        _ -> throwL (astPos recordAst, "invalid arguments passed to import: " ++ show args)
 
     where
         isSymbolAST AST { an = ASTSymbol _ } = True
@@ -300,23 +298,23 @@ evaluateRecord asts = do
         extractRows _ = []
         getFn fnName ast@AST { an = ASTRecord _ identifier record } = do
             when (not $ identifier `L.isPrefixOf` fnName) $
-                throwL (astPos ast) $ "invalid argument: " ++ fnName ++ " cannot operate on record " ++ identifier
+                throwL (astPos ast, "invalid argument: " ++ fnName ++ " cannot operate on record " ++ identifier)
             let (_, fnId) = separateNsIdPart fnName
             let fieldId = drop 4 fnId
             case (M.lookup fieldId record) of
                 Just value -> return $ value
                 Nothing -> error $ "unreachable: getFn " ++ fnName
-        getFn fnName ast = throwL (astPos ast) $ "invalid argument passed to " ++ fnName ++ ": " ++ (show ast)
+        getFn fnName ast = throwL (astPos ast, "invalid argument passed to " ++ fnName ++ ": " ++ (show ast))
         setFn fnName ast1 = do
             return $ makeNonsenseAST $ ASTFunction Pure $ fn where
                 fn ast2@AST { an = ASTRecord tagHash identifier record } = do
                     when (not $ identifier `L.isPrefixOf` fnName) $
-                        throwL (astPos ast2) $ "invalid argument: " ++ fnName ++ " cannot operate on record " ++ identifier
+                        throwL (astPos ast2, "invalid argument: " ++ fnName ++ " cannot operate on record " ++ identifier)
                     let (_, fnId) = separateNsIdPart fnName
                     let fieldId = drop 4 fnId
                     let newRecord = M.insert fieldId ast1 record
                     return $ makeNonsenseAST $ ASTRecord tagHash identifier newRecord
-                fn ast2 = throwL (astPos ast2) $ "invalid argument passed to " ++ fnName ++ ": " ++ (show ast2)
+                fn ast2 = throwL (astPos ast2, "invalid argument passed to " ++ fnName ++ ": " ++ (show ast2))
 
 data ReifyResult
     = ReifyRegularFunction AST
@@ -331,7 +329,7 @@ reifyFunctionReference ref = case ref of
             Just binding -> case binding of
                 Regular bound -> return $ ReifyRegularFunction $ bound
                 Memoized _memoMap bound -> return $ ReifyMemoizedFunction sym $ bound
-            Nothing -> throwL (astPos ref) $ "symbol " ++ sym ++ " not defined in environment"
+            Nothing -> throwL (astPos ref, "symbol " ++ sym ++ " not defined in environment")
     other -> do
         ret <- evaluate other
         return $ ReifyRegularFunction ret
@@ -395,8 +393,8 @@ evaluateSymbol ast@AST { an = ASTSymbol sym } = do
         Just binding -> return $ case binding of
             Regular v -> v
             Memoized _ v -> v
-        Nothing -> throwL (astPos ast) $ "symbol " ++ sym ++ " not defined in environment"
-evaluateSymbol ast = throwL (astPos ast) $ "unreachable: evaluateSymbol, ast: " ++ show ast
+        Nothing -> throwL (astPos ast, "symbol " ++ sym ++ " not defined in environment")
+evaluateSymbol ast = throwL (astPos ast, "unreachable: evaluateSymbol, ast: " ++ show ast)
 
 evaluate :: AST -> LContext AST
 evaluate ast@AST { an = fnc@(ASTFunctionCall args@(x:_)) } =
@@ -426,7 +424,7 @@ evaluate ast@AST { an = fnc@(ASTFunctionCall args@(x:_)) } =
                     evaluateFunctionCall args
 
         ret <- task `catchError`
-            appendError ("when calling function " ++ show x ++ " at " ++ astPos ast)
+            appendError (astPos ast, "when calling function " ++ show x)
 
         decrementDepth
         updatePurity currentPurity
@@ -437,7 +435,7 @@ evaluate ast@AST { an = (ASTSymbol _) } =
 evaluate ast@AST { an = (ASTVector vec) } =
      do incrementDepth
         rets <- mapM evaluate vec `catchError`
-                    appendError ("when evaluating elements of vector " ++ show vec ++ " at " ++ astPos ast)
+                    appendError (astPos ast, "when evaluating elements of vector")
         decrementDepth
         return $ ast { an = ASTVector rets }
 evaluate other =
@@ -455,7 +453,7 @@ runScriptFile fileName = do
     srcM' <- liftIO srcM
     src <- case srcM' of
         Right s -> return s
-        Left _ -> throwL "" $ "Failed to open file: \"" ++ fileName ++ "\""
+        Left _ -> throwL ("", "Failed to open file: \"" ++ fileName ++ "\"")
     runInlineScript fileName src
 
 runInlineScript :: String -> String -> LContext [AST]
diff --git a/src/Parser.hs b/src/Parser.hs
index e7c0701..be75ab3 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -13,11 +13,11 @@ import Utils
 validateBalance :: [String] -> [AST] -> LContext [AST]
 validateBalance allowed asts = do
     when (MB.isJust parenM && "(" `notElem` allowed)
-        $ throwL (astPos $ MB.fromJust parenM) "unbalanced function call"
+        $ throwL (astPos $ MB.fromJust parenM, "unbalanced function call")
     when (MB.isJust bracketM && "[" `notElem` allowed)
-        $ throwL (astPos $ MB.fromJust bracketM) "unbalanced vector"
+        $ throwL (astPos $ MB.fromJust bracketM, "unbalanced vector")
     when (MB.isJust curlyM && "{" `notElem` allowed)
-        $ throwL (astPos $ MB.fromJust curlyM) "unbalanced hash map"
+        $ throwL (astPos $ MB.fromJust curlyM, "unbalanced hash map")
     return asts
     where
         parenM = L.find ((== ASTSymbol "(") . an) asts
@@ -69,8 +69,7 @@ _parse acc (Token { tokenContent = "}" }:rest) = do
     let children' = takeWhile (an .> (/= ASTSymbol "{")) acc
     children <- validateBalance ["{"] children'
     let openCurly = MB.fromJust $ L.find (an .> (== ASTSymbol "{")) acc
-    pairs <- asPairsM (reverse children) `catchError`
-        \(LException _ e) -> throwL (astPos openCurly) e
+    pairs <- asPairsM (reverse children) `catchError` appendError (astPos openCurly, "when parsing a hash map")
     let hmap = openCurly { an = 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 96a1c5a..e36a68e 100644
--- a/src/Tokenizer.hs
+++ b/src/Tokenizer.hs
@@ -55,7 +55,7 @@ _tokenize fileName acc current (x:xs)
                 tokenColumn = tColumn $ x,
                 tokenFileName = fileName }
         in do
-            when (stringLength == -1) $ throwL (posTChar fileName x) $ "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 c4866ac..d39a677 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -16,7 +16,9 @@ import Data.Word as W
 
 type PositionString = String
 type ErrorString = String
-data LException = LException (Maybe PositionString) ErrorString
+type StackRow = (PositionString, ErrorString)
+
+data LException = LException [StackRow]
 
 data PrintEvaled
     = PrintEvaledOff
@@ -106,7 +108,7 @@ updatePurity purity = do
 checkPurity :: Purity -> LContext ()
 checkPurity purity = do
     purityOk <- isAllowedPurity purity
-    when (not purityOk) $ throwL "" $ "cannot call impure function in pure context"
+    when (not purityOk) $ throwL ("", "cannot call impure function in pure context")
 
 data Token = Token {
     tokenContent :: String,
@@ -219,32 +221,32 @@ computeTagN s =
 assertIsASTFunction :: AST -> LContext AST
 assertIsASTFunction ast@(AST { an = node }) = case node of
     (ASTFunction _ _) -> return ast
-    _ -> throwL (astPos ast) $ show node ++ " is not a function"
+    _ -> throwL (astPos ast, show node ++ " is not a function")
 
 assertIsASTInteger :: AST -> LContext AST
 assertIsASTInteger ast@(AST { an = node }) = case node of
     (ASTInteger _) -> return ast
-    _ -> throwL (astPos ast) $ show node ++ " is not an integer"
+    _ -> throwL (astPos ast, show node ++ " is not an integer")
 
 assertIsASTSymbol :: AST -> LContext AST
 assertIsASTSymbol ast@(AST { an = node }) = case node of
     (ASTSymbol _) -> return ast
-    _ -> throwL (astPos ast) $ show node ++ " is not a symbol"
+    _ -> throwL (astPos ast, show node ++ " is not a symbol")
 
 assertIsASTVector :: AST -> LContext AST
 assertIsASTVector ast@(AST { an = node }) = case node of
     (ASTVector _) -> return ast
-    _ -> throwL (astPos ast) $ show node ++ " is not a vector"
+    _ -> throwL (astPos ast, show node ++ " is not a vector")
 
 assertIsASTString :: AST -> LContext AST
 assertIsASTString ast@(AST { an = node }) = case node of
     (ASTString _) -> return ast
-    _ -> throwL (astPos ast) $ show node ++ " is not a string"
+    _ -> throwL (astPos ast, show node ++ " is not a string")
 
 assertIsASTFunctionCall :: AST -> LContext AST
 assertIsASTFunctionCall ast@(AST { an = node }) = case node of
     (ASTFunctionCall _) -> return ast
-    _ -> throwL (astPos ast) $ show node ++ " is not a function call or body"
+    _ -> throwL (astPos ast, show node ++ " is not a function call or body")
 
 -- UTILS
 
@@ -263,20 +265,19 @@ evenElems :: [a] -> [a]
 evenElems [] = []
 evenElems (_:xs) = oddElems xs
 
-throwL :: String -> String -> LContext a
-throwL p s = throwError $ LException mp s
-    where mp = if p == "" then Nothing else Just p
+throwL :: StackRow -> LContext a
+throwL sr = throwError $ LException [sr]
 
-appendError :: String -> LException -> LContext a
-appendError as (LException psM es) =
-    throwError $ LException psM $ es ++ "\n  " ++ as
+appendError :: StackRow -> LException -> LContext a
+appendError as (LException stack) =
+    throwError $ LException $ as : stack
 
 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 [] = []
@@ -308,19 +309,29 @@ separateNsIdPart identifier =
      in (T.unpack nsPartText, T.unpack idPartText)
 
 safeReadFile :: FilePath -> IO (Maybe String)
-safeReadFile p = (Just <$> readFile p) `catch` handler
-   where
-   handler :: IOException -> IO (Maybe String)
-   handler _ = pure Nothing
+safeReadFile p = (Just <$> readFile p) `catch` handler where
+    handler :: IOException -> IO (Maybe String)
+    handler _ = pure Nothing
 
 safeWriteFile :: FilePath -> String -> IO (Maybe ())
-safeWriteFile p content = (Just <$> writeFile p content) `catch` handler
-   where
-   handler :: IOException -> IO (Maybe ())
-   handler _ = pure Nothing
+safeWriteFile p content = (Just <$> writeFile p content) `catch` handler where
+    handler :: IOException -> IO (Maybe ())
+    handler _ = pure Nothing
 
 safeAppendFile :: FilePath -> String -> IO (Maybe ())
-safeAppendFile p content = (Just <$> appendFile p content) `catch` handler
-   where
-   handler :: IOException -> IO (Maybe ())
-   handler _ = pure Nothing
+safeAppendFile p content = (Just <$> appendFile p content) `catch` handler where
+    handler :: IOException -> IO (Maybe ())
+    handler _ = pure Nothing
+
+foldStackMessage :: LException -> String
+foldStackMessage (LException st) = case st of
+    [] -> ""
+    [(tp, ts)] -> "error: " ++ ts ++ (fmtPos tp)
+    _ -> let revStack = reverse st
+             (tp, ts) = head revStack
+             restStack = tail revStack
+             folded = L.foldr (\(p, s) acc -> acc ++ s ++ (fmtPos p) ++ ",\n") "" $ restStack
+          in folded ++ "\n" ++ "error: " ++ ts ++ (fmtPos tp)
+    where
+        fmtPos p = if useless p then "" else (" at " ++ p)
+        useless p = "nonsense" `L.isPrefixOf` p || length p == 0
diff --git a/test/Spec.hs b/test/Spec.hs
index a17f344..d4d5bf9 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -23,7 +23,7 @@ parseTests = testGroup "parse" [
         assertEqual "" expected got,
 
      do got <- expectErrorL M.empty $ parse (map makeNonsenseToken ["(", "+", "1", "2"])
-        let expected = "unbalanced function call"
+        let expected = "error: unbalanced function call"
         assertEqual "" expected got,
 
      do (got, _) <- expectSuccessL M.empty $ parse (map makeNonsenseToken ["\"1000\n2000\n3000\""])
diff --git a/test/TestUtils.hs b/test/TestUtils.hs
index 1f0d386..f023bb7 100644
--- a/test/TestUtils.hs
+++ b/test/TestUtils.hs
@@ -27,29 +27,41 @@ expectSuccessL :: Env -> LContext a -> IO (a, LState)
 expectSuccessL env lc =
      do res <- testRunL env lc
         case res of
-            Left (LException _ err) -> error $ "unexpected error: " ++ err
+            Left ex -> error $ "unexpected error: " ++ (foldStackMessage ex)
             Right val -> return val
 
 expectErrorL :: Show a => Env -> LContext a -> IO String
 expectErrorL env lc =
      do res <- testRunL env lc
         case res of
-            Left (LException _ err) -> return err
+            Left ex -> return $ foldStackMessage ex
             Right (val, _) -> error $ "unexpected success: " ++ show val
 
 makeEnv :: [(String, AST)] -> Env
 makeEnv = M.fromList . map (B.second Regular)
 
 ast :: ASTNode -> AST
-ast node = AST { an = node }
+ast node = makeNonsenseAST node
 
+astInteger :: Integer -> AST
 astInteger a = ast $ ASTInteger a
+astDouble :: Double -> AST
 astDouble a = ast $ ASTDouble a
+astSymbol :: String -> AST
 astSymbol a = ast $ ASTSymbol a
+astBoolean :: Bool -> AST
 astBoolean a = ast $ ASTBoolean a
+astString :: String -> AST
 astString a = ast $ ASTString a
+astTag :: String -> AST
+astTag a = ast $ ASTTag (computeTagN a) a
+astVector :: [AST] -> AST
 astVector a = ast $ ASTVector a
+astFunctionCall :: [AST] -> AST
 astFunctionCall a = ast $ ASTFunctionCall a
+astHashMap :: M.Map AST AST -> AST
 astHashMap a = ast $ ASTHashMap a
+astUnit :: AST
 astUnit = ast $ ASTUnit
+astHole :: AST
 astHole = ast $ ASTHole