better_panics #15

Merged
scott merged 5 commits from better_panics into main 2023-12-18 05:26:58 +00:00
10 changed files with 89 additions and 62 deletions

1
.gitignore vendored
View File

@ -28,3 +28,4 @@ node_modules/
.shadow-cljs .shadow-cljs
.cljs_node_repl/ .cljs_node_repl/
.helix/ .helix/
target/repl-port

View File

@ -73,12 +73,11 @@
(defn- stringify-args [arglist] (defn- stringify-args [arglist]
(apply str (interpose " " (into [] (map print-show) (rest arglist))))) (apply str (interpose " " (into [] (map print-show) (rest arglist)))))
; (def panic! {:name "panic!"
(def panic! {:name "panic!" ; ::data/type ::data/clj
::data/type ::data/clj ; :body (fn panic-inner
:body (fn panic-inner ; ([] (panic-inner [::data/list]))
([] (panic-inner [::data/list])) ; ([args] (throw (ex-info (stringify-args args) {}))))})
([args] (throw (ex-info (stringify-args args) {}))))})
(def print- {:name "print" (def print- {:name "print"
::data/type ::data/clj ::data/type ::data/clj
@ -410,7 +409,7 @@
:to_vec to_vec :to_vec to_vec
:fold fold :fold fold
:map map :map map
:panic! panic! ; :panic! panic!
:prn prn- :prn prn-
:concat concat- :concat concat-
:str str- :str str-

View File

@ -1,7 +1,7 @@
(ns ludus.error (ns ludus.error
(:require [clojure.string :as string])) (:require [clojure.string :as string]))
(defn get-line [source {:keys [line]}] (defn get-line [source line]
(let [lines (string/split-lines source) (let [lines (string/split-lines source)
the_line (nth lines (dec line))] the_line (nth lines (dec line))]
the_line)) the_line))
@ -21,22 +21,26 @@
(defn scan-error [] :TODO) (defn scan-error [] :TODO)
(defn parse-error [source {:keys [trace token]}] (defn parse-error [{:keys [trace token]}]
(let [line (get-line source token) (let [source (:source token)
input (:input token)
line-num (:line token)
line (get-line source line-num)
line-num (:line token) line-num (:line token)
prefix (str line-num ": ") prefix (str line-num ": ")
underline (get-underline source token (count prefix)) underline (get-underline source token (count prefix))
expected (first trace) expected (first trace)
got (:type token) got (:type token)
message (str "Ludus found a parsing error on line " line-num ".\nExpected: " expected "\nGot: " got "\n") message (str "Ludus found a parsing error on line " line-num " in " input ".\nExpected: " expected "\nGot: " got "\n")
] ]
(str message "\n" prefix line "\n" underline) (str message "\n" prefix line "\n" underline)
) )
) )
(defn run-error [source {:keys [line message]}] (defn run-error [{:keys [message token line]}]
(if line (let [source (:source token) input (:input token)]
(str "Ludus panicked on line " line ":\n" (get-line source {:line line}) "\n" message) (if line
(str "Ludus panicked!\n" message) (str "Ludus panicked!: " message "\nOn line " line " in " input "\n" (get-line source line))
)) (str "Ludus panicked!\n" message)
)))

View File

@ -234,7 +234,9 @@
(defp collection flat choice [;struct-literal (defp collection flat choice [;struct-literal
dict list-literal set-literal tuple]) dict list-literal set-literal tuple])
(defp simple flat choice [literal collection synthetic recur-call lambda]) (defp panic group order-1 [(quiet :panic) expression])
(defp simple flat choice [literal collection synthetic recur-call lambda panic])
(defp compound flat choice [match loop-expr if-expr when-expr do-expr block repeat-expr]) (defp compound flat choice [match loop-expr if-expr when-expr do-expr block repeat-expr])
@ -268,3 +270,4 @@
(defp script order-0 [nls? (defp script order-0 [nls?
(one+ script-line) (one+ script-line)
(quiet :eof)]) (quiet :eof)])

View File

@ -817,11 +817,18 @@
(defn- interpret-literal [ast] (-> ast :data first)) (defn- interpret-literal [ast] (-> ast :data first))
(defn- interpret-panic [ast ctx]
(let [msg-value (interpret-ast (-> ast :data first) ctx)
msg-string (show/show msg-value)]
(throw (ex-info msg-string {:ast ast}))))
(defn interpret-ast [ast ctx] (defn interpret-ast [ast ctx]
(case (:type ast) (case (:type ast)
(:nil :true :false :number :string :keyword) (interpret-literal ast) (:nil :true :false :number :string :keyword) (interpret-literal ast)
:panic (interpret-panic ast ctx)
:let-expr (interpret-let ast ctx) :let-expr (interpret-let ast ctx)
:if-expr (interpret-if ast ctx) :if-expr (interpret-if ast ctx)
@ -886,7 +893,7 @@
; :struct-literal ; :struct-literal
; (interpret-struct ast ctx) ; (interpret-struct ast ctx)
(throw (ex-info (str "Unknown AST node type " (get ast :type :err) " on line " (get-in ast [:token :line])) {:ast ast})))) (throw (ex-info (str "Unknown AST node type " (get ast :type :none) " on line " (get-in ast [:token :line])) {:ast ast}))))
(defn get-line [source line] (defn get-line [source line]
(if line (if line
@ -908,11 +915,11 @@
(into {} (map-keys kw->str) ns)) (into {} (map-keys kw->str) ns))
(def ludus-prelude (def ludus-prelude
(let [scanned (scanner/scan prelude/prelude) (let [scanned (scanner/scan prelude/prelude "prelude")
parsed (p/apply-parser g/script (:tokens scanned)) parsed (p/apply-parser g/script (:tokens scanned))
; _ (println "Parse status: " (:status parsed)) ; _ (println "Parse status: " (:status parsed))
; _ (if (= :err (:status parsed)) ; _ (if (= :err (:status parsed))
; (throw (ex-info (error/parse-error prelude/prelude parsed) {}))) ; (throw (ex-info (error/parse-error parsed) {})))
base-ctx (volatile! {::parent (volatile! {"base" base/base})}) base-ctx (volatile! {::parent (volatile! {"base" base/base})})
interpreted (interpret-ast parsed base-ctx) interpreted (interpret-ast parsed base-ctx)
namespace (dissoc interpreted ::data/type ::data/name ::data/struct) namespace (dissoc interpreted ::data/type ::data/name ::data/struct)
@ -973,10 +980,22 @@
;(pp/pprint (ex-data e)) ;(pp/pprint (ex-data e))
;(throw e) ;(throw e)
{::data/error true {::data/error true
:token (get-in (ex-data e) [:ast :token])
:line (get-in (ex-data e) [:ast :token :line]) :line (get-in (ex-data e) [:ast :token :line])
:message (ex-message e)} :message (ex-message e)}
)))) ))))
; No prelude; helps when there are errors in the prelude
(defn interpret-bare [source parsed ctx]
(let [base-ctx (volatile! {::parent (volatile! ctx)})]
(try
(interpret-ast parsed base-ctx)
(catch #?(:clj Throwable :cljs js/Object) e
{::data/error true
:token (get-in (ex-data e) [:ast :token])
:line (get-in (ex-data e) [:ast :token :line])
:message (ex-message e)}))))
;; repl ;; repl
(comment (comment
@ -984,17 +1003,18 @@
(println "***********") (println "***********")
(def source " (def source "
let times = 1.3 panic! (:oh, :no)
repeat times { print! (:foo) }
") ")
(def tokens (-> source scanner/scan :tokens)) (def tokens (-> source (scanner/scan "test input") :tokens))
(def ast (p/apply-parser g/script tokens)) (def ast (p/apply-parser g/script tokens))
(def result (interpret-safe source ast {})) (def result (interpret-bare source ast {}))
;(-> ast prettify-ast println) (println tokens)
(-> ast prettify-ast println)
(println result) (println result)

View File

@ -31,14 +31,12 @@
#?(:clj value :cljs (clj->js value))) #?(:clj value :cljs (clj->js value)))
(defn run [source] (defn run [source]
(let [user_scanned (s/scan source) (let [user_scanned (s/scan source "user input")
user_tokens (:tokens user_scanned) user_tokens (:tokens user_scanned)
_ (println "Tokens: " user_tokens)
user_parsed (p/apply-parser g/script user_tokens) user_parsed (p/apply-parser g/script user_tokens)
_ (println "Ast: " (i/prettify-ast user_parsed))
user_result (i/interpret-safe source user_parsed {}) user_result (i/interpret-safe source user_parsed {})
result_str (show/show user_result) result_str (show/show user_result)
post_scanned (s/scan pre/postlude) post_scanned (s/scan pre/postlude "postlude")
post_tokens (:tokens post_scanned) post_tokens (:tokens post_scanned)
post_parsed (p/apply-parser g/script post_tokens) post_parsed (p/apply-parser g/script post_tokens)
post_result (i/interpret-safe source post_parsed {}) post_result (i/interpret-safe source post_parsed {})
@ -50,13 +48,24 @@
(clean-out {:errors (:errors user_tokens)}) (clean-out {:errors (:errors user_tokens)})
(= :err (:status user_parsed)) (= :err (:status user_parsed))
(clean-out {:errors [(error/parse-error source user_parsed)]}) (clean-out {:errors [(error/parse-error user_parsed)]})
(::data/error user_result) (::data/error user_result)
(clean-out (assoc (ld->clj post_result) :errors [(error/run-error source user_result)])) (clean-out (assoc (ld->clj post_result) :errors [(error/run-error user_result)]))
:else :else
(clean-out clj_result) (clean-out clj_result)
) )
)) ))
(comment
(def source "
a b c
")
(-> source run :errors println)
)

View File

@ -276,19 +276,6 @@ fn report! {
} }
} }
fn panic! {
"Causes Ludus to panic, outputting any arguments as messages."
() -> {
add_msg! ("Ludus panicked!")
base :panic! ()
}
(...args) -> {
add_msg! ("Ludus panicked!")
add_msg! (args)
base :panic! (args)
}
}
fn doc! { fn doc! {
"Prints the documentation of a function to the console." "Prints the documentation of a function to the console."
(f as :fn) -> do f > base :doc > print! (f as :fn) -> do f > base :doc > print!
@ -396,7 +383,7 @@ fn mult {
fn div { fn div {
"Divides numbers. Panics on division by zero." "Divides numbers. Panics on division by zero."
(x as :number) -> x (x as :number) -> x
(_, 0) -> panic! ("Division by zero.") (_, 0) -> panic! "Division by zero."
(x as :number, y as :number) -> base :div (x, y) (x as :number, y as :number) -> base :div (x, y)
(x, y, ...zs) -> { (x, y, ...zs) -> {
let divisor = fold (mult, zs, y) let divisor = fold (mult, zs, y)
@ -898,8 +885,8 @@ fn err? {
fn unwrap! { fn unwrap! {
"Takes a result tuple. If it's :ok, then returns the value. If it's not :ok, then it panics. If it's not a result tuple, it also panics." "Takes a result tuple. If it's :ok, then returns the value. If it's not :ok, then it panics. If it's not a result tuple, it also panics."
((:ok, value)) -> value ((:ok, value)) -> value
((:err, msg)) -> panic! ("Unwrapped :err", msg) ((:err, msg)) -> panic! string ("Unwrapped :err! ", msg)
(_) -> panic! ("Cannot unwrap something that's not an error tuple.") (_) -> panic! "Cannot unwrap something that's not an error tuple."
} }
fn unwrap_or { fn unwrap_or {
@ -910,10 +897,10 @@ fn unwrap_or {
fn assert! { fn assert! {
"Asserts a condition: returns the value if the value is truthy, panics if the value is falsy. Takes an optional message." "Asserts a condition: returns the value if the value is truthy, panics if the value is falsy. Takes an optional message."
(value) -> if value then value else panic! ("Assert failed", value) (value) -> if value then value else panic! string ("Assert failed:", value)
(value, message) -> if value (msg, value) -> if value
then value then value
else panic! ("Assert failed:", message, value) else panic! string ("Assert failed: ", msg, " with ", value)
} }
&&& Turtle & other graphics &&& Turtle & other graphics
@ -1217,7 +1204,6 @@ ns prelude {
show show
prn! prn!
report! report!
panic!
doc! doc!
concat concat
ref? ref?

View File

@ -20,7 +20,7 @@
"match" :match ;; impl "match" :match ;; impl
"nil" :nil ;; impl -> literal word "nil" :nil ;; impl -> literal word
"ns" :ns ;; impl "ns" :ns ;; impl
;; "panic!" :panic ;; impl (should be a function) "panic!" :panic ;; impl (should _not_ be a function)
"recur" :recur ;; impl "recur" :recur ;; impl
"ref" :ref ;; impl "ref" :ref ;; impl
"then" :then ;; impl "then" :then ;; impl
@ -51,8 +51,9 @@
(defn- new-scanner (defn- new-scanner
"Creates a new scanner." "Creates a new scanner."
[source] [source input]
{:source source {:source source
:input input
:length (count source) :length (count source)
:errors [] :errors []
:start 0 :start 0
@ -135,7 +136,9 @@
(current-lexeme scanner) (current-lexeme scanner)
literal literal
(:line scanner) (:line scanner)
(:start scanner))))) (:start scanner)
(:source scanner)
(:input scanner)))))
;; TODO: errors should also be in the vector of tokens ;; TODO: errors should also be in the vector of tokens
;; The goal is to be able to be able to hand this to an LSP? ;; The goal is to be able to be able to hand this to an LSP?
@ -146,7 +149,9 @@
(current-lexeme scanner) (current-lexeme scanner)
nil nil
(:line scanner) (:line scanner)
(:start scanner)) (:start scanner)
(:source scanner)
(:input scanner))
err-token (assoc token :message msg)] err-token (assoc token :message msg)]
(-> scanner (-> scanner
(update :errors conj err-token) (update :errors conj err-token)
@ -240,7 +245,7 @@
comm (str char)] comm (str char)]
(let [char (current-char scanner)] (let [char (current-char scanner)]
(if (= \newline char) (if (= \newline char)
(update scanner :line inc) scanner
(recur (advance scanner) (str comm char)))))) (recur (advance scanner) (str comm char))))))
(defn- scan-token [scanner] (defn- scan-token [scanner]
@ -322,11 +327,10 @@
(defn- next-token [scanner] (defn- next-token [scanner]
(assoc scanner :start (:current scanner))) (assoc scanner :start (:current scanner)))
(defn scan [source] (defn scan [source input]
(loop [scanner (new-scanner source)] (loop [scanner (new-scanner source input)]
(if (at-end? scanner) (if (at-end? scanner)
(let [scanner (add-token (add-token scanner :break) :eof)] (let [scanner (add-token (add-token scanner :break) :eof)]
{:tokens (:tokens scanner) {:tokens (:tokens scanner)
:errors (:errors scanner)}) :errors (:errors scanner)})
(recur (-> scanner (scan-token) (next-token)))))) (recur (-> scanner (scan-token) (next-token))))))

View File

@ -1,9 +1,11 @@
(ns ludus.token) (ns ludus.token)
(defn token (defn token
[type text literal line start] [type text literal line start source input]
{:type type {:type type
:lexeme text :lexeme text
:literal literal :literal literal
:line line :line line
:source source
:input input
:start start}) :start start})

View File

@ -1 +0,0 @@
51500