141 lines
4.5 KiB
Plaintext
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)
|