ludus/janet/errors.janet

(import spork/json :as j)
(try (os/cd "janet") ([_] nil))
(import /base :as b)

(defn- get-line [source line]
 ((string/split "\n" source) (dec line)))

(defn scan-error [e] (pp e) e)

(defn parse-error [e] 
 (def msg (e :msg))
 (def line-num (get-in e [:token :line]))
 (def source (get-in e [:token :source]))
 (def source-line (get-line source line-num))
 (print "Parsing error: " msg)
 (print "On line " line-num ":")
 (print source-line)
 e)


(defn validation-error [e]
 (def msg (e :msg))
 (def line-num (get-in e [:node :token :line]))
 (def source (get-in e [:node :token :source]))
 (def source-line (get-line source line-num))
 (case msg
  "unbound name"
  (do
   (print "Validation error: " msg " " (get-in e [:node :data]))
   (print "on line " line-num)
   (print source-line))
  (do
   (print "Validation error: " msg)
   (print "on line " line-num)
   (print source-line)))
 e)

(defn- fn-no-match [e]
 (print "Ludus panicked! no match")
 (def line-num (get-in e [:node :token :line]))
 (def source (get-in e [:node :token :source]))
 (def source-line (get-line source line-num))
 (print "on line " line-num)
 (def called (e :called))
 (print "calling " (b/show called))
 (def value (e :value))
 (print "with " (b/show value))
 (print "expecting to match one of")
 (print (b/pretty-patterns called))
 (print source-line)
)

(defn- let-no-match [e]
 (print "Ludus panicked! no match")
 (def line-num (get-in e [:node :token :line]))
 (def source (get-in e [:node :token :source]))
 (def source-line (get-line source line-num))
 (print "on line " line-num)
 (print "binding " (b/show (e :value)))
 (def pattern (get-in e [:node :data 0]))
 (print "to " (b/show-patt pattern))
 (print source-line))

(defn- generic-panic [e]
 (def msg (e :msg))
 (def line-num (get-in e [:node :token :line]))
 (def source (get-in e [:node :token :source]))
 (def source-line (get-line source line-num))
 (print "Ludus panicked! " msg)
 (print "on line " line-num)
 (print source-line)
)

(defn- unbound-name [e]
 (def {:line line-num :source source :lexeme name} (get-in e [:node :token]))
 (def source-line (get-line source line-num))
 (print "Ludus panicked! unbound name " name)
 (print "on line " line-num)
 (print source-line)
)

(defn runtime-error [e]
 (when (= :string (type e)) (print e) (break e))
 (def msg (e :msg))
 (case msg
  "no match: function call" (fn-no-match e)
  "no match: let binding" (let-no-match e)
  "unbound name" (unbound-name e)
  (generic-panic e))
 e)