bugfixes and error improvements
This commit is contained in:
parent
f2f557d045
commit
e428fccc86
32
prelude.ld
32
prelude.ld
|
@ -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?
|
||||||
}
|
}
|
||||||
|
|
|
@ -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 @{}]
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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"))
|
||||||
|
|
|
@ -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)
|
||||||
|
)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user