[#44] report line and column in case of error

src/sci/impl/interpreter.cljc

@@ -7,9 +7,11 @@
    [sci.impl.functions :as f]
    [sci.impl.macros :as macros]
    [sci.impl.max-or-throw :refer [max-or-throw]]
-   [sci.impl.parser :as p]))
+   [sci.impl.parser :as p]
+   [sci.impl.utils :as utils :refer [throw-error-with-location]]))
 
 (declare interpret)
+#?(:clj (set! *warn-on-reflection* true))
 
 ;;;; Evaluation
 
@@ -50,12 +52,14 @@
 (defn eval-do
   [ctx expr]
   (loop [exprs (rest expr)]
-    (when-let [e (first exprs)]
-      (let [e (macros/macroexpand ctx e)
-            e (interpret ctx e)]
+    (when-let [expr (first exprs)]
+      (let [expr (macros/macroexpand ctx expr)
+            ret (try (interpret ctx expr)
+                     (catch #?(:clj Exception :cljs js/Error) e
+                       (utils/re-throw-with-location-of-node e expr)))]
         (if-let [n (next exprs)]
           (recur n)
-          e)))))
+          ret)))))
 
 (defn eval-if
   [ctx expr]
@@ -110,9 +114,10 @@
       (if (str/starts-with? n "'")
         (let [v (symbol (subs n 1))]
           [v v])
-        (throw (new #?(:clj Exception
-                       :cljs js/Error)
-                    (str "Could not resolve symbol: " (str expr)))))))))
+        ;; TODO: can this ever happen now that we resolve symbols at macro-expansion time?
+        (throw-error-with-location
+         (str "Could not resolve symbol: " (str expr))
+         expr))))))
 
 (defn apply-fn [ctx f args]
   ;; (prn "apply fn" f)
@@ -182,11 +187,8 @@
               :allow (when allow (set allow))
               :realize-max realize-max
               :start-expression s}
-         edn (p/parse-string s)
-         ;; _ (def e edn)
-         expr (macros/macroexpand ctx edn)]
-     ;; (prn "expanded:" expr)
-     (interpret ctx expr))))
+         edn-vals (p/parse-string-all s)]
+     (eval-do ctx (cons 'do edn-vals)))))
 
 ;;;; Scratch
 

src/sci/impl/macros.cljc

@@ -1,20 +1,21 @@
 (ns sci.impl.macros
   {:no-doc true}
   (:refer-clojure :exclude [destructure macroexpand macroexpand-all macroexpand-1])
-  (:require [clojure.walk :refer [postwalk]]
-            [sci.impl.destructure :refer [destructure]]
-            [sci.impl.functions :as f]
-            [sci.impl.utils :refer [gensym* mark-resolve-sym mark-eval mark-eval-call constant?]]
-            [clojure.string :as str]))
+  (:require
+   [sci.impl.destructure :refer [destructure]]
+   [sci.impl.functions :as f]
+   [sci.impl.utils :refer
+    [gensym* mark-resolve-sym mark-eval mark-eval-call constant? throw-error-with-location
+     merge-meta]]
+   [clojure.string :as str]))
 
 (def macros '#{do if when and or -> ->> as-> quote quote* let fn fn* def defn})
 
 (defn allow?! [{:keys [:allow]} sym]
   (let [allowed? (if allow (contains? allow sym)
                      true)]
     (when-not allowed?
-      (throw (new #?(:clj Exception :cljs js/Error)
-                  (str sym " is not allowed!"))))))
+      (throw-error-with-location (str sym " is not allowed!") sym))))
 
 (defn lookup [{:keys [:env :bindings] :as ctx} sym]
   (let [res (or (when-let [v (get macros sym)]
@@ -49,10 +50,9 @@
                 (if (str/starts-with? n "'")
                   (let [v (symbol (subs n 1))]
                     [v v])
-                  (throw (new #?(:clj Exception
-                                 :cljs js/Error)
-                              (str "Could not resolve symbol: " (str expr)
-                                   (keys (:bindings expr)))))))))]
+                  (throw-error-with-location
+                   (str "Could not resolve symbol: " (str expr))
+                   expr)))))]
     ;; (prn 'resolve expr '-> res)
     res))
 
@@ -165,8 +165,9 @@
           (if forms
             (let [form (first forms)
                   threaded (if (seq? form)
-                             (with-meta (concat (cons (first form) (next form))
-                                                (list x))
+                             (with-meta
+                               (concat (cons (first form) (next form))
+                                       (list x))
                                (meta form))
                              (list form x))]
               (recur threaded (next forms))) x))]
@@ -213,7 +214,7 @@
           (do (allow?! ctx f)
               (case f
                 do (mark-eval-call expr) ;; do will call macroexpand on every
-                                         ;; subsequent expression
+                ;; subsequent expression
                 let (expand-let ctx expr)
                 (fn fn*) (expand-fn ctx expr)
                 def (expand-def ctx expr)
@@ -230,23 +231,25 @@
 
 (defn macroexpand
   [ctx expr]
-  (cond
-    (constant? expr) expr
-    ;; already expanded by reader
-    (:sci/fn expr) (expand-fn-literal-body ctx expr)
-    (symbol? expr) (let [v (resolve-symbol ctx expr)]
-                     (when-not (#?(:clj identical? :cljs keyword-identical?)
-                                :sci/var.unbound v)
-                       v))
-    (map? expr)
-    (-> (zipmap (map #(macroexpand ctx %) (keys expr))
-                (map #(macroexpand ctx %) (vals expr)))
-        mark-eval)
-    (or (vector? expr) (set? expr))
-    (-> (into (empty expr) (map #(macroexpand ctx %) expr))
-        mark-eval)
-    (seq? expr) (macroexpand-call ctx expr)
-    :else expr))
+  (merge-meta
+   (cond
+     (constant? expr) expr
+     ;; already expanded by reader
+     (:sci/fn expr) (expand-fn-literal-body ctx expr)
+     (symbol? expr) (let [v (resolve-symbol ctx expr)]
+                      (when-not (#?(:clj identical? :cljs keyword-identical?)
+                                 :sci/var.unbound v)
+                        v))
+     (map? expr)
+     (-> (zipmap (map #(macroexpand ctx %) (keys expr))
+                 (map #(macroexpand ctx %) (vals expr)))
+         mark-eval)
+     (or (vector? expr) (set? expr))
+     (-> (into (empty expr) (map #(macroexpand ctx %) expr))
+         mark-eval)
+     (seq? expr) (macroexpand-call ctx expr)
+     :else expr)
+   (meta expr)))
 
 ;;;; Scratch
 

src/sci/impl/parser.cljc

@@ -24,18 +24,6 @@
   {:row (r/get-line-number reader)
    :col (r/get-column-number reader)})
 
-(defn- parse-to-delimiter
-  ([ctx #?(:cljs ^not-native reader :default reader) delimiter]
-   (parse-to-delimiter ctx reader delimiter []))
-  ([ctx #?(:cljs ^not-native reader :default reader) delimiter into]
-   (r/read-char reader) ;; ignore delimiter
-   (let [ctx (assoc ctx :expected-delimiter delimiter)]
-     (loop [vals (transient into)]
-       (let [next-val (parse-next ctx reader)]
-         (if (#?(:clj identical? :cljs keyword-identical?) ::expected-delimiter next-val)
-           (persistent! vals)
-           (recur (conj! vals next-val))))))))
-
 (defn parse-whitespace
   [_ctx #?(:cljs ^not-native reader :default reader)]
   (loop []
@@ -60,6 +48,21 @@
   (r/read-char reader) ;; ignore leading @
   (list 'deref (parse-next ctx reader)))
 
+(defn parse-to-delimiter
+  ([ctx #?(:cljs ^not-native reader :default reader) delimiter]
+   (parse-to-delimiter ctx reader delimiter []))
+  ([ctx #?(:cljs ^not-native reader :default reader) delimiter into]
+   (r/read-char reader) ;; ignore delimiter
+   (let [ctx (assoc ctx :expected-delimiter delimiter)]
+     (loop [vals (transient into)]
+       (let [next-val (parse-next ctx reader)]
+         (if (#?(:clj identical? :cljs keyword-identical?) ::expected-delimiter next-val)
+           (persistent! vals)
+           (recur (conj! vals next-val))))))))
+
+(defn parse-list [ctx #?(:cljs ^not-native reader :default reader)]
+  (apply list (parse-to-delimiter ctx reader \))))
+
 (defn throw-reader
   "Throw reader exception, including line line/column."
   ([#?(:cljs ^:not-native reader :default reader) msg]
@@ -70,12 +73,8 @@
      (throw
       (ex-info
        (str msg
-            " [at line " l ", column " c "]") (merge {:row l
-                                                      :col c}
-                                                     data))))))
-
-(defn parse-list [ctx #?(:cljs ^not-native reader :default reader)]
-  (apply list (parse-to-delimiter ctx reader \))))
+            " [at line " l ", column " c "]")
+       (merge {:row l, :col c} data))))))
 
 (defn parse-sharp
   [ctx #?(:cljs ^not-native reader :default reader)]
@@ -98,15 +97,15 @@
   [ctx #?(:cljs ^not-native reader :default reader) c]
   (case c
     nil ::eof
-    (\" \:) (edn/read reader)
     \( (parse-list ctx reader)
     \[ (parse-to-delimiter ctx reader \])
     \{ (apply hash-map (parse-to-delimiter ctx reader \}))
     \' (parse-quoted reader)
     (\} \] \)) (let [expected (:expected-delimiter ctx)]
                  (if (not= expected c)
                    (throw-reader reader
-                                 (str "Unmatched delimiter: " c ", " ctx))
+                                 (str "Unmatched delimiter: " c)
+                                 ctx)
                    (do
                      (r/read-char reader) ;; read delimiter
                      ::expected-delimiter)))
@@ -139,7 +138,17 @@
         ctx {:expected-delimiter nil}]
     (parse-next ctx r)))
 
+(defn parse-string-all [s]
+  (let [^Closeable r (string-reader s)
+        ctx {:expected-delimiter nil}]
+    (loop [ret (transient [])]
+      (let [next-val (parse-next ctx r)]
+        (if (#?(:clj identical? :cljs keyword-identical?) ::eof next-val)
+          (persistent! ret)
+          (recur (conj! ret next-val)))))))
+
 ;;;; Scratch
 
 (comment
+  (parse-string "{:a 1} {:a 2}")
   )

src/sci/impl/utils.cljc

@@ -1,5 +1,11 @@
 (ns sci.impl.utils
-  {:no-doc true})
+  {:no-doc true}
+  (:require [clojure.string :as str]))
+
+(derive :sci.error/realized-beyond-max :sci/error)
+
+(defn sci-error? [e]
+  (isa? (:type e) :sci/error))
 
 (defn constant? [x]
   (or (fn? x) (number? x) (string? x) (keyword? x)))
@@ -32,3 +38,37 @@
    expr
    (fn [m]
      (assoc m :sci.impl/eval true))))
+
+(defn throw-error-with-location
+  ([msg iobj] (throw-error-with-location msg iobj {}))
+  ([msg iobj data]
+   (let [{:keys [:row :col]} (meta iobj)
+         msg (str msg
+                  " [at line " row ", column " col "]") ]
+     (throw (ex-info msg (merge {:type :sci/error
+                                 :row row
+                                 :col col} data))))))
+
+(defn re-throw-with-location-of-node [^Exception e node]
+  (let [m #?(:clj (.getMessage e)
+             :cljs (.-message e))]
+    (if (str/includes? m "[at line")
+      (throw e)
+      (let [{:keys [:row :col]} (meta node)]
+        (if (and row col)
+          (let [m (str m " [at line " row ", column " col "]")
+                new-exception (if-let [d (ex-data e)]
+                                (ex-info m (merge {:type :sci/error
+                                                   :row row
+                                                   :col col} d))
+                                #?(:clj (Exception. m e)
+                                   :cljs (do (set! (.-message e) m) e)))]
+            (throw new-exception))
+          (throw e))))))
+
+(defn merge-meta [obj d]
+  (if d
+    (if-let [m (meta obj)]
+      (with-meta obj (merge m d))
+      obj)
+    obj))

test/sci/core_test.cljc

@@ -1,5 +1,6 @@
 (ns sci.core-test
   (:require
+   [clojure.string :as str]
    [clojure.test :as test :refer [deftest is testing]]
    [sci.test-utils :as tu]))
 
@@ -172,17 +173,18 @@
          (eval* "(defn foo [] (as-> y x (inc y)))")))
     (is (thrown-with-msg?
          #?(:clj Exception :cljs js/Error) #"y"
-         (eval* "(defn foo [] (as-> 10 x (inc y))))")))))
+         (eval* "(defn foo [] (as-> 10 x (inc y)))")))))
 
 (deftest do-test
   (testing "expressions with do are evaluated in order and have side effects,
   even when one of the following expressions have an unresolved symbol"
     (when-not tu/native?
       (is
-       (= "hello\n"
+       (str/includes?
           (with-out-str (try (tu/eval* "(do (defn foo []) (foo) (println \"hello\") (defn bar [] x))"
                                        {:bindings {'println println}})
-                             (catch #?(:clj Exception :cljs js/Error) _ nil))))))))
+                             (catch #?(:clj Exception :cljs js/Error) _ nil)))
+          "hello")))))
 
 (deftest macroexpand-test
   (is (= [6] (eval* "[(-> 3 inc inc inc)]")))
@@ -224,15 +226,24 @@
   (is (= (range 10) (tu/eval* "(range 10)" {:realize-max 100}))))
 
 (deftest idempotent-eval-test
-  ;; TODO: we might eventually switch to rewrite-clj to parse the raw code, then
-  ;; we can also differentiate between what has been evaled and what has not
   (is (= '(foo/f1 foo/f2)
          (eval* "(map #(let [[ns v] %] (symbol (str ns) (str v))) '[[foo f1] [foo f2]])")))
   (is (= '(foo/f1)
          (eval* "(map #(let [[ns v] %] (symbol (str ns) (str v)))
                    (vector (vector (symbol \"foo\") (symbol \"f1\"))))")))
   (is (= '[["foo"] ["bar"]] (eval* "(map (fn [x] x) (list (list \"foo\") (list \"bar\")))"))))
 
+(deftest error-location-test
+  (is (thrown-with-msg? #?(:clj Exception :cljs js/Error)
+                        #"\[at line 1, column 11\]"
+                        (with-out-str (eval* nil "(+ 1 2 3) (conj 1 0)"))))
+  (is (thrown-with-msg? #?(:clj Exception :cljs js/Error)
+                        #"\[at line 1, column 13\]"
+                        (tu/eval* "(+ 1 2 3 4) (vec (range))" {:realize-max 100})))
+  (is (thrown-with-msg? #?(:clj Exception :cljs js/Error)
+                        #"\[at line 1, column 19\]"
+                        (tu/eval* "(+ 1 2 3 4 5) (do x)" {}))))
+
 ;;;; Scratch
 
 (comment

test/sci/impl/parser_test.cljc

@@ -25,3 +25,8 @@
   (is (re-find (p/parse-string "#\"foo\"") "foo"))
   (is (= '(do (+ 1 2 3)) (p/parse-string "(do (+ 1 2 3)\n)"))))
 
+;;;; Scratch
+
+(comment
+  (t/run-tests)
+  )

test/sci/performance.clj

@@ -8,7 +8,7 @@
 (when-not (= "false" (System/getenv "SCI_TEST_PERFORMANCE"))
   (deftest reusable-fn-test
     (println "Testing reusable function result.")
-    (doseq [[example args] [["#(assoc (hash-map :a 1 :b 2) %1 %2))" [:b 3]]]]
+    (doseq [[example args] [["#(assoc (hash-map :a 1 :b 2) %1 %2)" [:b 3]]]]
       (let [f (sci/eval-string example)]
         (cc/quick-bench (apply f args))))
     (println))