bugfixes and error improvements

This commit is contained in:
Scott Richmond 2024-06-14 14:53:23 -04:00
parent f2f557d045
commit e428fccc86
5 changed files with 153 additions and 86 deletions

View File

@ -40,7 +40,7 @@ fn type {
fn eq? { fn eq? {
"Returns true if all arguments have the same value." "Returns true if all arguments have the same value."
(x) -> true (x) -> true
(x, y) -> base :eq (x, y) (x, y) -> base :eq? (x, y)
(x, y, ...zs) -> if eq? (x, y) (x, y, ...zs) -> if eq? (x, y)
then loop (y, zs) with { then loop (y, zs) with {
(a, []) -> eq? (a, x) (a, []) -> eq? (a, x)
@ -362,6 +362,30 @@ fn downcase {
(str as :string) -> base :downcase (str) (str as :string) -> base :downcase (str)
} }
fn ws? {
"Tells if a string is a whitespace character."
(" ") -> true
("\n") -> true
("\t") -> true
(_) -> false
}
fn words {
"Takes a string and returns a list of the words in the string. Strips all whitespace."
(str as :string) -> {
let raw_strs = split (str, " ")
fn joiner (list, str) -> if eq? (str, "")
then list
else append (list, str)
fold (joiner, raw_strs, [])
}
}
fn sentence {
"Takes a list of words and turns it into a sentence."
(strs as :list) -> join (strs, " ")
}
& in another prelude, with a better actual base language than Java (thanks, Rich), counting strings would be reasonable but complex: count/bytes, count/points, count/glyphs. Java's UTF16 strings make this unweildy. & in another prelude, with a better actual base language than Java (thanks, Rich), counting strings would be reasonable but complex: count/bytes, count/points, count/glyphs. Java's UTF16 strings make this unweildy.
@ -1213,7 +1237,7 @@ let pw! = penwidth!
fn background! { fn background! {
"Sets the background color behind the turtle and path. Alias: bg!" "Sets the background color behind the turtle and path. Alias: bg!"
(gray as :number) -> store! (bgcolor, (gray, gray, gray, 255)) (gray as :number) -> store! (bgcolor, (gray, gray, gray, 255))
((r as :number, g as :number, b as :number)) -> store! (bgcolor, (r, b, g, 255)) ((r as :number, g as :number, b as :number)) -> store! (bgcolor, (r, g, b, 255))
((r as :number, g as :number, b as :number, a as :number)) -> store! (bgcolor, (r, g, b, a)) ((r as :number, g as :number, b as :number, a as :number)) -> store! (bgcolor, (r, g, b, a))
} }
@ -1311,6 +1335,8 @@ fn penwidth {
() -> turtle_state () :pencolor () -> turtle_state () :pencolor
} }
box state = nil
pkg Prelude { pkg Prelude {
abs abs
add add
@ -1442,6 +1468,7 @@ pkg Prelude {
some? some?
split split
square square
state
store! store!
string string
string? string?
@ -1464,5 +1491,6 @@ pkg Prelude {
update update
update! update!
values values
words
zero? zero?
} }

View File

@ -127,7 +127,7 @@
(defn pretty-patterns [fnn] (defn pretty-patterns [fnn]
(def {:body clauses} fnn) (def {:body clauses} fnn)
(string/join (map (fn [x] (-> x first show-patt)) clauses) " ")) (string/join (map (fn [x] (-> x first show-patt)) clauses) "\n"))
(defn doc [fnn] (defn doc [fnn]
(def {:name name :doc doc} fnn) (def {:name name :doc doc} fnn)
@ -225,66 +225,66 @@
(% x y)) (% x y))
(def ctx { (def ctx {
"print!" print!
"prn" prn
"eq?" deep=
"bool" bool
"and" ludus/and
"or" ludus/or
"add" + "add" +
"sub" - "and" ludus/and
"mult" * "assoc!" assoc!
"assoc" assoc
"atan_2" math/atan2
"bool" bool
"ceil" math/ceil
"concat" concat
"conj!" conj!
"conj" conj
"cos" math/cos
"count" length
"dec" dec
"disj!" disj!
"disj" disj
"dissoc!" dissoc!
"dissoc" dissoc
"div" / "div" /
"mod" mod "doc" doc
"downcase" string/ascii-lower
"eq?" deep=
"first" first
"floor" math/floor
"get" ludus/get
"gt" > "gt" >
"gte" >= "gte" >=
"inc" inc
"last" last
"lt" < "lt" <
"lte" <= "lte" <=
"inc" inc "mod" mod
"dec" dec "mult" *
"not" not "not" not
"type" ludus/type
"stringify" stringify
"show" show
"doc" doc
"concat" concat
"conj" conj
"conj!" conj!
"disj" disj
"disj!" disj!
"push" array/push
"assoc" assoc
"assoc!" assoc!
"dissoc" dissoc
"dissoc!" dissoc!
"get" ludus/get
"nth" ludus/get "nth" ludus/get
"first" first "or" ludus/or
"rest" rest
"last" last
"slice" slice
"to_list" to_list
"count" length
"pi" math/pi "pi" math/pi
"sin" math/sin "print!" print!
"cos" math/cos "prn" prn
"tan" math/tan "push" array/push
"atan_2" math/atan2
"sqrt" math/sqrt
"random" math/random "random" math/random
"floor" math/floor
"ceil" math/ceil
"round" math/round
"range" range "range" range
"unbox" unbox "rest" rest
"store!" store! "round" math/round
"show" show
"sin" math/sin
"slice" slice
"split" string/split "split" string/split
"upcase" string/ascii-upper "sqrt" math/sqrt
"downcase" string/ascii-lower "store!" store!
"trim" string/trim
"trimr" string/trimr
"triml" string/triml
"str_slice" string/slice "str_slice" string/slice
"stringify" stringify
"sub" -
"tan" math/tan
"to_list" to_list
"trim" string/trim
"triml" string/triml
"trimr" string/trimr
"type" ludus/type
"unbox" unbox
"upcase" string/ascii-upper
}) })
(def base (let [b @{}] (def base (let [b @{}]

View File

@ -3,74 +3,108 @@
(defn- get-line [source line] (defn- get-line [source line]
((string/split "\n" source) (dec line))) ((string/split "\n" source) (dec line)))
(defn scan-error [e] (pp e) e) (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] (defn parse-error [e]
(def msg (e :msg)) (def msg (e :msg))
(def {:line line-num :input input :source source} (e :token)) (def {:line line-num :input input :source source :start start} (e :token))
(print line-num input source)
(def source-line (get-line source line-num)) (def source-line (get-line source line-num))
(print "Parsing error: " msg) (print "Syntax error: " msg)
(print "On line " line-num " in " input) (print " on line " line-num " in " input ":")
(print source-line) (print " >>> " source-line)
(print (caret source line-num start))
e) e)
(defn validation-error [e] (defn validation-error [e]
(def msg (e :msg)) (def msg (e :msg))
(def {:line line-num :input input :source source} (get-in e [:node :token])) (def {:line line-num :input input :source source :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num)) (def source-line (get-line source line-num))
(case msg (case msg
"unbound name" "unbound name"
(do (do
(print "Validation error: " msg " " (get-in e [:node :data])) (print "Validation error: " msg " " (get-in e [:node :data]))
(print "on line " line-num " in " input) (print " on line " line-num " in " input ":")
(print source-line)) (print " >>> " source-line)
(print (caret source line-num start)))
(do (do
(print "Validation error: " msg) (print "Validation error: " msg)
(print "on line " line-num) (print " on line " line-num " in " input ":")
(print source-line))) (print " >>> " source-line)
(print (caret source line-num start))))
e) e)
(defn- fn-no-match [e] (defn- fn-no-match [e]
(print "Ludus panicked! no match") (print "Ludus panicked! no match")
(def {:line line-num :source source :input input} (get-in e [:node :token])) (def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num)) (def source-line (get-line source line-num))
(print "on line " line-num " in " input) (print " on line " line-num " in " input ", ")
(def called (e :called)) (def called (e :called))
(print "calling " (b/show called)) (print " calling: " (slice (b/show called) 3))
(def value (e :value)) (def value (e :value))
(print "with " (b/show value)) (print " with arguments: " (b/show value))
(print "expecting to match one of") (print " expected match with one of:")
(print (b/pretty-patterns called)) (def patterns (b/pretty-patterns called))
(print source-line)) (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] (defn- let-no-match [e]
(print "Ludus panicked! no match") (print "Ludus panicked! no match")
(def {:line line-num :source source :input input} (get-in e [:node :token])) (def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num)) (def source-line (get-line source line-num))
(print "on line " line-num " in " input) (print " on line " line-num " in " input ", ")
(print " binding " (b/show (e :value))) (print " binding " (b/show (e :value)))
(def pattern (get-in e [:node :data 0])) (def pattern (get-in e [:node :data 0]))
(print " to " (b/show-patt pattern)) (print " to " (b/show-patt pattern))
(print source-line)) (print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- generic-panic [e] (defn- generic-panic [e]
(def msg (e :msg)) (def msg (e :msg))
(def {:line line-num :source source :input input} (get-in e [:node :token])) (def {:line line-num :source source :input input} (get-in e [:node :token]))
(def source-line (get-line source line-num)) (def source-line (get-line source line-num))
(print "Ludus panicked! " msg) (print "Ludus panicked! " msg)
(print "on line " line-num " in " input) (print " on line " line-num " in " input ":")
(print source-line)) (print " >>> " source-line))
(defn- unbound-name [e] (defn- unbound-name [e]
(def {:line line-num :source source :lexeme name :input input} (get-in e [:node :token])) (def {:line line-num :source source :lexeme name :input input} (get-in e [:node :token]))
(def source-line (get-line source line-num)) (def source-line (get-line source line-num))
(print "Ludus panicked! unbound name " name) (print "Ludus panicked! unbound name " name)
(print "on line " line-num " in " input) (print " on line " line-num " in " input ":")
(print source-line)) (print " >>> " source-line))
(defn runtime-error [e] (defn runtime-error [e]
(when (= :string (type e)) (print (string "Internal Ludus error: " e)) (break 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)) (def msg (e :msg))
(case msg (case msg
"no match: function call" (fn-no-match e) "no match: function call" (fn-no-match e)

View File

@ -18,31 +18,27 @@
(def draw @[]) (def draw @[])
(var result @"") (var result @"")
(def console @"") (def console @"")
(setdyn :out console)
(def out @{:errors errors :draw draw :result result :console console}) (def out @{:errors errors :draw draw :result result :console console})
(def scanned (s/scan source)) (def scanned (s/scan source))
(when (any? (scanned :errors)) (when (any? (scanned :errors))
# (set (out :errors) (scanned :errors))
(each err (scanned :errors) (each err (scanned :errors)
(e/scan-error err)) (e/scan-error err))
(break (-> out j/encode string))) (break (-> out j/encode string)))
(def parsed (p/parse scanned)) (def parsed (p/parse scanned))
(when (any? (parsed :errors)) (when (any? (parsed :errors))
# (set (out :errors) (parsed :errors))
(each err (parsed :errors) (each err (parsed :errors)
(e/parse-error err)) (e/parse-error err))
(break (-> out j/encode string))) (break (-> out j/encode string)))
(def validated (v/valid parsed ctx)) (def validated (v/valid parsed ctx))
(when (any? (validated :errors)) (when (any? (validated :errors))
# (set (out :errors) (validated :errors))
(each err (validated :errors) (each err (validated :errors)
(e/validation-error err)) (e/validation-error err))
(break (-> out j/encode string))) (break (-> out j/encode string)))
(setdyn :out console)
(try (try
(set result (i/interpret (parsed :ast) ctx)) (set result (i/interpret (parsed :ast) ctx))
([err] ([err]
(e/runtime-error err) (e/runtime-error err)
# (set (out :errors) [err])
(break (-> out j/encode string)))) (break (-> out j/encode string))))
(setdyn :out stdout) (setdyn :out stdout)
(set (out :result) (b/show result)) (set (out :result) (b/show result))
@ -55,10 +51,14 @@
# (comment # (comment
(do (do
(def source (slurp "sandbox.ld")) (def source `
words ("foo bar")
`)
(def out (-> source (def out (-> source
ludus ludus
j/decode)) j/decode
))
(setdyn :out stdout)
(def console (out "console")) (def console (out "console"))
(print console) (print console)
(def result (out "result")) (def result (out "result"))

View File

@ -154,7 +154,7 @@
:start (get scanner :start) :start (get scanner :start)
:source (get scanner :source) :source (get scanner :source)
:input (get scanner :input) :input (get scanner :input)
:message msg}] :msg msg}]
(-> scanner (-> scanner
(update :errors array/push token) (update :errors array/push token)
(update :tokens array/push token)))) (update :tokens array/push token))))
@ -341,3 +341,8 @@
(recur (-> scanner (scan-token) (next-token))))) (recur (-> scanner (scan-token) (next-token)))))
(recur (new-scanner source input))) (recur (new-scanner source input)))
# (comment
(do
(def source "/iii")
(scan source)
)