A first stab at unified error handling.

src/bodol/error.clj

@@ -0,0 +1,45 @@
+(ns bodol.error
+  (:require [bodol.types :as t]))
+
+(defn error [scope sexp type msg]
+  (ex-info msg {:scope scope
+                :sexp sexp
+                :pos (t/-pos sexp)
+                :type type}))
+
+(defn sexpless-error [scope pos type msg]
+  (ex-info msg {:scope scope
+                :sexp nil
+                :pos pos
+                :type type}))
+
+(defn raise [scope sexp type msg]
+  (throw (error scope sexp type msg)))
+
+(defn sexpless-raise [scope pos type msg]
+  (throw (sexpless-error scope pos type msg)))
+
+(defn- report-pos [pos]
+  (str
+   (if-let [location (:location pos)]
+     (str "At \"" location "\" line ") "At line ")
+   (:span pos) "\n"))
+
+(defn report [error]
+  (let [{:keys [scope sexp pos type]} (ex-data error)
+        msg (.getMessage error)]
+    (str
+     (report-pos pos)
+     "Error " type "\n" msg "\n")))
+
+(defn error-type [error]
+  (when (instance? clojure.lang.ExceptionInfo error)
+    (:type (ex-data error))))
+
+(defn error? [error]
+  (not (nil? (error-type error))))
+
+(defmacro do-catch [& body]
+  `(try
+     ~@body
+     (catch clojure.lang.ExceptionInfo e# e#)))

src/bodol/eval/lambda.clj

@@ -1,7 +1,8 @@
 (ns bodol.eval.lambda
   (:require [bodol.eval.core :as eval]
             [bodol.lambda :as l]
-            [bodol.types :as t])
+            [bodol.types :as t]
+            [bodol.error :as err])
   (:import [bodol.types LCons]
            [bodol.lambda Lambda]))
 
@@ -20,9 +21,9 @@
           call-arity (count args)]
       (cond
        (> call-arity arity)
-       (throw (ex-info (str "function of arity " arity " invoked with "
-                            call-arity " arguments " (t/pr-value args))
-                       {:args args :func func}))
+       (err/raise scope func :arity-mismatch
+                  (str "function of arity " arity " invoked with "
+                       call-arity " arguments " args))
 
        (< call-arity arity)
        [(l/curry func args) outer-scope]
@@ -36,11 +37,11 @@
                [result final-scope]
                ((eval/eval (:body clause)) scope)]
            [result outer-scope])
-         (throw (ex-info
-                 (str "function call did not match any defined patterns "
-                      "(" (t/pr-value func) " "
-                      (clojure.string/join " " (map t/pr-value args)) ")")
-                 {:args args :scope outer-scope :function func})))))))
+         (err/raise outer-scope func :pattern-match-failure
+                    (str "function call did not match any defined patterns "
+                         "(" (t/pr-value func) " "
+                         (clojure.string/join " " (map t/pr-value args))
+                         ")")))))))
 
 (extend-protocol eval/Eval
   Lambda
@@ -65,5 +66,5 @@
          (let [[result scope] ((invoke func args) scope)]
            [result scope])
 
-         :else (throw (ex-info (str "invoking non-function " func)
-                               {:value this :scope scope})))))))
+         :else (err/raise scope this :noncallable-invocation
+                          (str "invoking non-function " func)))))))

src/bodol/eval/primtypes.clj

@@ -1,7 +1,8 @@
 (ns bodol.eval.primtypes
   (:require [bodol.eval.core :as eval]
             [bodol.types :as t]
-            [bodol.lambda :as l])
+            [bodol.lambda :as l]
+            [bodol.error :as err])
   (:import [bodol.types LNumber LString LSymbol LBoolean]))
 
 (extend-protocol eval/Eval
@@ -22,8 +23,8 @@
     (fn [scope]
       (if (contains? scope (t/-value this))
         [(scope (t/-value this)) scope]
-        (throw (ex-info (str "unbound symbol \"" this "\"")
-                        {:value this :scope scope})))))
+        (err/raise scope this :unbound-symbol
+                   (str "unbound symbol \"" this "\"")))))
 
   nil
   (-eval [this]

src/bodol/lambda.clj

@@ -2,7 +2,8 @@
   (:require [clojure.core.match :refer [match]]
             [clojure.string :as string]
             [bodol.types :as t]
-            [bodol.match :refer [find-match]]))
+            [bodol.match :refer [find-match]]
+            [bodol.error :as err]))
 
 (def ^:private alphabet "abcdefghijklmnopqrstuvwxyz")
 
@@ -55,19 +56,20 @@
 (defn lambda? [val]
   (instance? Lambda val))
 
-(defn- parse-def [clauses]
+(defn- parse-def [pos clauses]
   (let [cs (map (fn [[args body]] {:args args :body body}) clauses)]
     (cond
      (not= 1 (count (set (map (comp count :args) cs))))
-     (throw (ex-info (str "function declarations have different arities " clauses)
-                     {:args clauses}))
+     (err/sexpless-raise nil pos :declaration-arity-mismatch
+                         (str "function declarations have different arities "
+                              clauses))
 
      :else [cs ((comp count :args) (first cs))])))
 
 (defn lambda [pos & clauses]
-  (let [[clauses arity] (parse-def clauses)]
+  (let [[clauses arity] (parse-def pos clauses)]
     (Lambda. pos nil clauses arity nil [])))
 
 (defn defun [pos name & clauses]
-  (let [[clauses arity] (parse-def clauses)]
+  (let [[clauses arity] (parse-def pos clauses)]
     (Lambda. pos (t/-value name) clauses arity nil [])))

src/bodol/primitives/core.clj

@@ -4,7 +4,8 @@
             [bodol.eval.lambda :as lambda]
             [bodol.types :refer [llist car cdr]]
             [bodol.types :as t]
-            [bodol.monad :as m]))
+            [bodol.monad :as m]
+            [bodol.error :as err]))
 
 (defn l-quote [[value]]
   (fn [scope]
@@ -15,15 +16,15 @@
     (let [[value scope] ((eval/eval value) scope)]
       (if (t/lsymbol? name)
         [value (assoc scope (t/-value name) value)]
-        (throw (ex-info "define called with non-symbol"
-                        {:args [name value] :scope scope}))))))
+        (err/raise scope name :non-symbol-define
+                   "define called with non-symbol")))))
 
 ;; TODO: get rid of cond, use pattern matching
 (defn l-cond [clauses]
   (if-not (zero? (rem (count clauses) 2))
-    (throw (ex-info (str "cond takes even number of clause pairs, "
-                         (count clauses) " given")
-                    {:args clauses}))
+    (err/raise nil (first clauses) :uneven-cond
+               (str "cond takes even number of clause pairs, "
+                    (count clauses) " given"))
 
     (let [clauses (partition 2 clauses)]
       (fn [scope]
@@ -41,8 +42,8 @@
   (fn [scope]
     (if-let [func (:function scope)]
       ((lambda/invoke func args) scope)
-      (throw (ex-info "recur called outside lambda"
-                      {:args args :scope scope})))))
+      (err/raise scope (first args) :recur-outside-lambda
+                 "recur called outside lambda"))))
 
 (defn l-asserts [[name & asserts]]
   (fn [scope]
@@ -53,18 +54,20 @@
         (let [form (first asserts)
               [result scope] ((eval/eval form) scope)]
           (when-not (= (t/lboolean true) result)
-            (throw (ex-info (str "Assert in " (t/-value name) " failed:\n"
-                                 "    " form
-                                 " -> " result "\n") {})))
+            (err/raise scope form :assert-failure
+                       (str "Assert in " (t/-value name) " failed:\n"
+                            "    " form
+                            " -> " result "\n")))
           (recur scope (rest asserts)))))))
 
 (defn l-assert [[name & body]]
   (fn [scope]
     (let [[result scope] (m/reduce-state scope (map eval/eval body))]
       (when-not (= (t/lboolean true) result)
-        (throw (ex-info (str "Assert in " (t/-value name) " failed:\n"
-                             "    " (last body)
-                             " -> " result "\n") {}))))
+        (err/raise scope (last body) :assert-failure
+                   (str "Assert in " (t/-value name) " failed:\n"
+                        "    " (last body)
+                        " -> " result "\n"))))
     [(t/lboolean true) scope]))
 
 
@@ -78,7 +81,9 @@
            (catch clojure.lang.ExceptionInfo e#
              (throw (ex-info (.getMessage e#)
                              (assoc (ex-data e#)
-                               {:args args# :scope scope#})))))))))
+                               {:sexp (first args#)
+                                :pos (t/-pos (first args#))
+                                :scope scope#})))))))))
 
 (defprim l-cons [item list]
   (if (t/cons-list? list)

src/bodol/repl.clj

@@ -4,7 +4,8 @@
             [bodol.parser :as parser]
             [bodol.scope :as scope]
             [bodol.monad :as m]
-            [bodol.types :as t]))
+            [bodol.types :as t]
+            [bodol.error :as err]))
 
 (defn eval-ast [scope ast]
   (->> ast
@@ -47,12 +48,7 @@
                    (map eval/eval)
                    (m/reduce-state scope))
               (catch clojure.lang.ExceptionInfo e
-                (let [data (ex-data e)]
-                  [(str "Error: " (.getMessage e) "\n"
-                        (clojure.string/join
-                         "\n"
-                         (map (fn [[k v]] (str k ": " (t/pr-value v)))
-                              (dissoc data :scope))))
-                   scope])))]
-        (println (if (string? result) result (t/pr-value result)))
+                (print (err/report e))))]
+        (when-not (nil? result)
+          (println (if (string? result) result (t/pr-value result))))
         (recur scope)))))

src/bodol/test.clj

@@ -2,7 +2,11 @@
   (:refer-clojure :exclude [test])
   (:require [bodol.repl :as repl]
             [bodol.types :as t]
-            [bodol.parser :as parser]))
+            [bodol.parser :as parser]
+            [bodol.error :as err]))
 
 (defn run []
-  (repl/eval-file "src/bodol/test.bodol"))
+  (try
+    (repl/eval-file "src/bodol/test.bodol")
+    (catch clojure.lang.ExceptionInfo e
+      (err/report e))))

test/bodol/error_reporting_test.clj

@@ -0,0 +1,32 @@
+(ns bodol.error-reporting-test
+  (:require [clojure.test :as test :refer [deftest is]]
+            [bodol.repl :as repl]
+            [bodol.parser :as parser]
+            [bodol.scope :as scope]
+            [bodol.error :refer [do-catch error? error-type]]))
+
+(defmacro run [forms & body]
+  `(let ~(apply vector
+                (mapcat (fn [[binding code]]
+                          [binding `(do-catch (repl/eval ~code))])
+                        (partition 2 forms)))
+     ~@body))
+
+(defmacro deftest-throws [name type code]
+  `(deftest ~name
+     (run [r# ~code]
+       (is (error? r#))
+       (is (= ~type (error-type r#))))))
+
+(deftest report-file-name
+  (let [r (do-catch
+           (repl/eval-ast (scope/scope)
+                          (parser/parse "not-in-scope" "hello.bodol")))]
+    (is (error? r))
+    (is (= "hello.bodol" (:location (:pos (ex-data r)))))))
+
+(deftest-throws report-unbound-symbols
+  :unbound-symbol "variable-not-in-scope")
+
+(deftest-throws report-arity-mismatch
+  :arity-mismatch "((λ i -> i) 1 2)")