bugfixes and error improvements

prelude.ld

@@ -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?
 }

src/base.janet

@@ -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" -
+  "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" /
-  "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
+  "mod" mod
-  "dec" dec
+  "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
+  "or" ludus/or
-  "rest" rest
-  "last" last
-  "slice" slice
-  "to_list" to_list
-  "count" length
   "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
-  "floor" math/floor
-  "ceil" math/ceil
-  "round" math/round
   "range" range
-  "unbox" unbox
+  "rest" rest
-  "store!" store!
+  "round" math/round
+  "show" show
+  "sin" math/sin
+  "slice" slice
   "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
+  "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 @{}]

src/errors.janet

@@ -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))
+ (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))
- (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)
 
 (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 "  on line " line-num " in " input ":")
-   (print source-line))
+   (print "  >>> " source-line)
+   (print (caret source line-num start)))
   (do
    (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)
 
 (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 "  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]
  (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)))
+ (print "  binding " (b/show (e :value)))
  (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]
  (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 "  on line " line-num " in " input ":")
- (print source-line))
+ (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 "  on line " line-num " in " input ":")
- (print source-line))
+ (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)

src/ludus.janet

@@ -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"))

src/scanner.janet

@@ -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)
+)