twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

bugfixes and error improvements

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
prelude.ld
View File

@ -40,7 +40,7 @@ fn type {
fn eq? {
"Returns true if all arguments have the same value."
(x) -> true
(x, y) -> base :eq (x, y)
(x, y) -> base :eq? (x, y)
(x, y, ...zs) -> if eq? (x, y)
then loop (y, zs) with {
(a, []) -> eq? (a, x)
@ -362,6 +362,30 @@ fn downcase {
(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.
@ -1213,7 +1237,7 @@ let pw! = penwidth!
fn background! {
"Sets the background color behind the turtle and path. Alias: bg!"
(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))
}
@ -1311,6 +1335,8 @@ fn penwidth {
() -> turtle_state () :pencolor
}
box state = nil
pkg Prelude {
abs
add
@ -1442,6 +1468,7 @@ pkg Prelude {
some?
split
square
state
store!
string
string?
@ -1464,5 +1491,6 @@ pkg Prelude {
update
update!
values
words
zero?
}

96
src/base.janet
View File

@ -127,7 +127,7 @@
(defn pretty-patterns [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]
(def {:name name :doc doc} fnn)
@ -225,66 +225,66 @@
(% x y))
(def ctx {
"print!" print!
"prn" prn
"eq?" deep=
"bool" bool
"and" ludus/and
"or" ludus/or
"add" +
"sub" -
"mult" *
"and" ludus/and
"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" /
"mod" mod
"doc" doc
"downcase" string/ascii-lower
"eq?" deep=
"first" first
"floor" math/floor
"get" ludus/get
"gt" >
"gte" >=
"inc" inc
"last" last
"lt" <
"lte" <=
"inc" inc
"dec" dec
"mod" mod
"mult" *
"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
"first" first
"rest" rest
"last" last
"slice" slice
"to_list" to_list
"count" length
"or" ludus/or
"pi" math/pi
"sin" math/sin
"cos" math/cos
"tan" math/tan
"atan_2" math/atan2
"sqrt" math/sqrt
"print!" print!
"prn" prn
"push" array/push
"random" math/random
"floor" math/floor
"ceil" math/ceil
"round" math/round
"range" range
"unbox" unbox
"store!" store!
"rest" rest
"round" math/round
"show" show
"sin" math/sin
"slice" slice
"split" string/split
"upcase" string/ascii-upper
"downcase" string/ascii-lower
"trim" string/trim
"trimr" string/trimr
"triml" string/triml
"sqrt" math/sqrt
"store!" store!
"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 @{}]

86
src/errors.janet
View File

@ -3,74 +3,108 @@
(defn- get-line [source 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]
(def msg (e :msg))
(def {:line line-num :input input :source source} (e :token))
(print line-num input source)
(def {:line line-num :input input :source source :start start} (e :token))
(def source-line (get-line source line-num))
(print "Parsing error: " msg)
(print "On line " line-num " in " input)
(print source-line)
(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} (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))
(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 " 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)
(print source-line)))
(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} (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))
(print "on line " line-num " in " input)
(print " on line " line-num " in " input ", ")
(def called (e :called))
(print "calling " (b/show called))
(print " calling: " (slice (b/show called) 3))
(def value (e :value))
(print "with " (b/show value))
(print "expecting to match one of")
(print (b/pretty-patterns called))
(print source-line))
(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} (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))
(print "on line " line-num " in " input)
(print " on line " line-num " in " input ", ")
(print " binding " (b/show (e :value)))
(def pattern (get-in e [:node :data 0]))
(print " to " (b/show-patt pattern))
(print source-line))
(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} (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 " on line " line-num " in " input ":")
(print " >>> " source-line))
(defn- unbound-name [e]
(def {:line line-num :source source :lexeme name :input input} (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 " on line " line-num " in " input ":")
(print " >>> " source-line))
(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))
(case msg
"no match: function call" (fn-no-match e)

14
src/ludus.janet
View File

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

7
src/scanner.janet
View File

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