diff --git a/prelude.ld b/prelude.ld index d4f746a..c70f607 100644 --- a/prelude.ld +++ b/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? } diff --git a/src/base.janet b/src/base.janet index 428d867..12602e7 100644 --- a/src/base.janet +++ b/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" - - "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 @{}] diff --git a/src/errors.janet b/src/errors.janet index 5223274..898c3f0 100644 --- a/src/errors.janet +++ 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)) - (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 "binding " (b/show (e :value))) + (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 " to " (b/show-patt pattern)) + (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) diff --git a/src/ludus.janet b/src/ludus.janet index 85cccb1..fe10e2f 100644 --- a/src/ludus.janet +++ b/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")) diff --git a/src/scanner.janet b/src/scanner.janet index b7371cd..5997b17 100644 --- a/src/scanner.janet +++ b/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) +)