ludus/janet/errors.janet
2024-06-24 22:03:57 -04:00

141 lines
4.5 KiB
Plaintext

(import /src/base :as b)
(defn- get-line [source line]
((string/split "\n" source) (dec line)))
(defn- caret [source line start]
(def lines (string/split "\n" source))
(def the-line (lines (dec line)))
(def prev-lines (slice lines 0 (dec line)))
(def char-counts (map (fn [x] (-> x length inc)) prev-lines))
(def prev-line-chars (sum char-counts))
(def offset (- start prev-line-chars))
(def indent (string/repeat "." (+ 6 offset)))
(string indent "^")
)
(defn scan-error [e]
(def {:line line-num :input input :source source :start start :msg msg} e)
(print "Syntax error: " msg)
(print " on line " line-num " in " input ":")
(def source-line (get-line source line-num))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn parse-error [e]
(def msg (e :msg))
(def {:line line-num :input input :source source :start start} (e :token))
(def source-line (get-line source line-num))
(print "Syntax error: " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn validation-error [e]
(def msg (e :msg))
(def {:line line-num :input input :source source :start start} (get-in e [:node :token]))
(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 " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start)))
(do
(print "Validation error: " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))))
e)
(defn- fn-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print " on line " line-num " in " input ", ")
(def called (e :called))
(print " calling: " (slice (b/show called) 3))
(def value (e :value))
(print " with arguments: " (b/show value))
(print " expected match with one of:")
(def patterns (b/pretty-patterns called))
(def fmt-patt (do
(def lines (string/split "\n" patterns))
(def indented (map (fn [x] (string " " x)) lines))
(string/join indented "\n")
))
(print fmt-patt)
(print " >>> " source-line)
(print (caret source line-num start))
)
(defn- let-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print " on line " line-num " in " input ", ")
(print " matching: " (b/show (e :value)))
(def pattern (get-in e [:node :data 0]))
(print " with pattern: " (b/show-patt pattern))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- match-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(print " on line " line-num " in " input ", ")
(def value (e :value))
(print " matching: " (b/show value))
(print " with patterns:")
(def clauses (get-in e [:node :data 1]))
(def patterns (b/pretty-patterns {:body clauses}))
(def fmt-patt (do
(def lines (string/split "\n" patterns))
(def indented (map (fn [x] (string " " x)) lines))
(string/join indented "\n")
))
(print fmt-patt)
(def source-line (get-line source line-num))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- generic-panic [e]
(def msg (e :msg))
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print "Ludus panicked! " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- unbound-name [e]
(def {:line line-num :source source :lexeme name :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print "Ludus panicked! unbound name " name)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn runtime-error [e]
(when (= :string (type e))
(print (string "Internal Ludus error: " e))
(print "Please file an issue at https://alea.ludus.dev/twc/ludus/issues")
(break e))
(def msg (e :msg))
(case msg
"no match: function call" (fn-no-match e)
"no match: let binding" (let-no-match e)
"no match: match form" (match-no-match e)
"no match: when form" (generic-panic e)
"unbound name" (unbound-name e)
(generic-panic e))
e)