Compare commits

...

2 Commits

Author SHA1 Message Date
Scott Richmond
03128441a6 start standing up a test harness, do not finish it, use judge 2024-06-06 15:43:36 -04:00
Scott Richmond
c7f99d35a6 fix a bear of a bug with accidentally persisting loop contexts 2024-06-06 15:41:33 -04:00
13 changed files with 481 additions and 59 deletions

1
.gitignore vendored
View File

@ -32,3 +32,4 @@ target/repl-port
.repl-buffer
.repl-buffer.janet
.env
janet/jpm_tree

View File

@ -44,8 +44,7 @@
(print "with " (b/show value))
(print "expecting to match one of")
(print (b/pretty-patterns called))
(print source-line)
)
(print source-line))
(defn- let-no-match [e]
(print "Ludus panicked! no match")
@ -63,16 +62,14 @@
(def source-line (get-line source line-num))
(print "Ludus panicked! " msg)
(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 source-line)
)
(print source-line))
(defn runtime-error [e]
(when (= :string (type e)) (print e) (break e))

View File

@ -307,7 +307,7 @@
(def the-set @{:^type :set})
(each member members
(def value (interpret member ctx))
(set (the-set member) true))
(set (the-set value) true))
the-set)
(defn- list [ast ctx]
@ -510,13 +510,13 @@
# (print "looping!")
(def data (ast :data))
(def args (interpret (data 0) ctx))
(when (ast :match) (break ((ast :match) 0 args)))
# this doesn't work: context persists between different interpretations
# we want functions to work this way, but not loops (I think)
# (when (ast :match) (break ((ast :match) 0 args)))
(def clauses (data 1))
(def len (length clauses))
(def loop-ctx @{:^parent ctx})
(var loop-ctx @{:^parent ctx})
(defn match-fn [i args]
# (print "calling inner loop fn")
# (print "for the " i "th time")
(when (= len i)
(error {:node ast :value args :msg "no match: loop"}))
(def clause (clauses i))
@ -647,10 +647,7 @@
# (do
(comment
(set source `
fn call_unary (f, arg) -> f (arg)
fn my_add (x, y) -> add (x, y)
let add5 = my_add (5, _)
call_unary (add5, 10)
`)
(def result (run))
)

1
janet/judge Symbolic link
View File

@ -0,0 +1 @@
./jpm_tree/bin/judge

9
janet/judgy.fish Executable file
View File

@ -0,0 +1,9 @@
#!/opt/homebrew/bin/fish
set FILE $argv[1]
set TESTFILE (string join "" $FILE ".tested")
judge $FILE
if test -e $TESTFILE
cp $TESTFILE $FILE
rm $TESTFILE
end

371
janet/language.test.janet Normal file
View File

@ -0,0 +1,371 @@
# testing Ludus langauge constructs
(try (os/cd "janet") ([_] nil)) # for REPL
(import /scanner :as s)
(import /parser :as p)
(import /validate :as v)
(import /interpreter :as i)
(import /errors :as e)
(import /base :as b)
(use judge)
(defn run [source]
(def ctx @{})
(def scanned (s/scan source :test))
(when (any? (scanned :errors))
(e/scan-error (scanned :errors)) (error "scanning errors"))
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(e/parse-error (parsed :errors)) (error "parsing errors"))
(def valid (v/valid parsed ctx))
(when (any? (valid :errors)) (each err (valid :errors)
(e/validation-error err)) (error "validation errors"))
(i/interpret (parsed :ast) ctx))
(deftest "returns bare values from single-line scripts"
(test (run "true") true)
(test (run "false") false)
(test (run "nil") :^nil)
(test (run "12.34") 12.34)
(test (run "-32") -32)
(test (run "0") 0)
(test (run ":foo") :foo)
(test (run ":bar") :bar)
(test (run `"a string, a text, a language"`) "a string, a text, a language"))
(deftest "returns empty collections from single-line scripts"
(test (run "()") [])
(test (run "#{}") @{})
(test (run "${}") @{:^type :set})
(test (run "[]") @[]))
(deftest "returns populated collections from single-line scripts"
(test (run "(1, 2, 3)") [1 2 3])
(test (run "[:a, :b, :c]") @[:a :b :c])
(test (run "${1, 2, 3, 3}") @{1 true 2 true 3 true :^type :set})
(test (run "#{:a 1, :b 2}") @{:a 1 :b 2}))
(deftest "returns nested collections from single-line scripts"
(test (run "((), (1, 2), [:a, (:b)], #{:foo true, :bar false})")
[[]
[1 2]
@[:a [:b]]
@{:bar false :foo true}])
(test (run `#{:foo #{:bar "thing", :baz (1, :foo, nil)}}`) @{:foo @{:bar "thing" :baz [1 :foo :^nil]}}))
(deftest "binds names in let bindings with various patterns"
(test (run `let foo = :bar; foo`) :bar)
(test (run `let 42 = 42`) 42)
(test (run `let foo = :bar; let quux = 42; (foo, quux)`) [:bar 42])
(test (run `let (:ok, value) = (:ok, 42); value`) 42)
(test (run `let #{:a x, ...} = #{:a 1, :b 2}; x`) 1))
(deftest "executes if/then/else properly"
(test (run `if nil then :foo else :bar`) :bar)
(test (run `if false then :foo else :bar`) :bar)
(test (run `if true then :foo else :bar`) :foo)
(test (run `if 42 then :foo else panic! "oops"`) :foo))
(deftest "panics"
(test-error (run `panic! "oops"`)
{:msg "oops"
:node {:data {:data "oops"
:token {:input :test
:lexeme "\"oops\""
:line 1
:literal "oops"
:source "panic! \"oops\""
:start 7
:type :string}
:type :string}
:token {:input :test
:lexeme "panic!"
:line 1
:literal :none
:source "panic! \"oops\""
:start 0
:type :panic}
:type :panic}})
)
(deftest "no match in let panics"
(test-error (run "let :foo = :bar")
{:msg "no match: let binding"
:node {:data @[{:data :foo
:token {:input :test
:lexeme ":foo"
:line 1
:literal :foo
:source "let :foo = :bar"
:start 4
:type :keyword}
:type :keyword}
{:data :bar
:token {:input :test
:lexeme ":bar"
:line 1
:literal :bar
:source "let :foo = :bar"
:start 11
:type :keyword}
:type :keyword}]
:token {:input :test
:lexeme "let"
:line 1
:literal :none
:source "let :foo = :bar"
:start 0
:type :let}
:type :let}
:value :bar})
)
(deftest "blocks execute code and work"
(test (run `
let bar = 12
let foo = {
let bar = 42
let baz = :quux
:foo
}
(foo, bar)
`)
[:foo 12])
(test (run `
let foo = {
let bar = 12
{
let bar = 15
bar
}
}
`)
15))
(deftest "unbound name panics"
(test-error (run `foo`) "validation errors"))
(deftest "rebinding name panics"
(test-error (run `let foo = 42; let foo = 23`) "validation errors"))
(deftest "when forms work as expected"
(test (run `
when {
false -> :nope
nil -> :nope
12 -> :yes
}
`)
:yes)
(test-error (run `
when {
false -> :nope
nil -> :nope
}
`)
{:msg "no match: when form"
:node {:data @[[{:data false
:token {:input :test
:lexeme "false"
:line 2
:literal false
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 12
:type :false}
:type :bool}
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 2
:literal :nope
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 21
:type :keyword}
:type :keyword}]
[{:token {:input :test
:lexeme "nil"
:line 3
:literal :none
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 30
:type :nil}
:type :nil}
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 3
:literal :nope
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 37
:type :keyword}
:type :keyword}]]
:token {:input :test
:lexeme "when"
:line 1
:literal :none
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 2
:type :when}
:type :when}})
)
(deftest "match forms work as expected"
(test (run `
match :foo with {
:bar -> :nope
:baz -> :nope
x -> x
}
`)
:foo)
(test (run `
let foo = 42
match (:ok, foo) with {
(:err, _) -> :nope
(:ok, :foo) -> :nope
(:ok, _) -> :yes
}
`)
:yes)
(test-error (run `
let foo = "foo"
match foo with {
"bar" -> :nope
"baz" -> :nope
12.34 -> :nope
}
`)
{:msg "no match: match form"
:node @{:data [{:data "foo"
:token {:input :test
:lexeme "foo"
:line 2
:literal :none
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 26
:type :word}
:type :word}
@[[{:data "bar"
:token {:input :test
:lexeme "\"bar\""
:line 3
:literal "bar"
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 40
:type :string}
:type :string}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 3
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 49
:type :keyword}
:type :keyword}]
[{:data "baz"
:token {:input :test
:lexeme "\"baz\""
:line 4
:literal "baz"
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 58
:type :string}
:type :string}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 4
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 67
:type :keyword}
:type :keyword}]
[{:data 12.34
:token {:input :test
:lexeme "12.34"
:line 5
:literal 12.34
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 76
:type :number}
:type :number}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 5
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 85
:type :keyword}
:type :keyword}]]]
:match @match-fn
:token {:input :test
:lexeme "match"
:line 2
:literal :none
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 20
:type :match}
:type :match}
:value "foo"})
)
(deftest "string patterns work as expected"
(test (run `let "I {verb} the {noun}" = "I am the walrus"; (verb, noun)`) ["am" "walrus"])
(test (run `let "a {b} c {d}" = "a because I love you c yourself out the door"; (b, d)`)
["because I love you"
"yourself out the door"])
)
(deftest "lambdas may be defined and called"
(test (run `
let foo = fn () -> :foo
foo ()
`)
:foo)
(test (run `
let pair = fn (x, y) -> (x, y)
pair (:foo, :bar)
`)
[:foo :bar])
(test-error (run `
let foo = fn () -> :foo
foo (:bar)
`)
{:called @{:^type :fn
:body [[{:data @[]
:token {:input :test
:lexeme "("
:line 1
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 15
:type :lparen}
:type :tuple}
nil
{:data :foo
:token {:input :test
:lexeme ":foo"
:line 1
:literal :foo
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 21
:type :keyword}
:type :keyword}]]
:ctx @{}
:match @match-fn}
:msg "no match: function call"
:node {:data "foo"
:token {:input :test
:lexeme "foo"
:line 2
:literal :none
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 28
:type :word}
:type :word}
:value [:bar]})
)

View File

@ -7,17 +7,17 @@
(import /errors :as e)
(def pkg (do
(def prelude-ctx @{:^parent {"base" b/base}})
(def prelude-src (slurp "prelude.ld"))
(def prelude-scanned (s/scan prelude-src :prelude))
(def prelude-parsed (p/parse prelude-scanned))
(def parse-errors (prelude-parsed :errors))
(def pre-ctx @{:^parent {"base" b/base}})
(def pre-src (slurp "prelude.ld"))
(def pre-scanned (s/scan pre-src :prelude))
(def pre-parsed (p/parse pre-scanned))
(def parse-errors (pre-parsed :errors))
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
(def prelude-validated (v/valid prelude-parsed prelude-ctx))
(def validation-errors (prelude-validated :errors))
(def pre-validated (v/valid pre-parsed pre-ctx))
(def validation-errors (pre-validated :errors))
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
(try
(i/interpret (prelude-parsed :ast) prelude-ctx)
(i/interpret (pre-parsed :ast) pre-ctx)
([err] (e/runtime-error err) :error))))
(def ctx (do
@ -28,15 +28,16 @@
(set (ctx "^type") nil)
ctx))
(def post/src (slurp "postlude.ld"))
# (def post/src (slurp "postlude.ld"))
# (def post/ast (do
# (def post-ctx @{:^parent ctx})
# (def post-scanned (s/scan post/src :postlude))
# (def post-parsed (p/parse post-scanned))
# (def parse-errors (post-parsed :errors))
# (when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
# (def post-validated (v/valid post-parsed post-ctx))
# (def validation-errors (post-validated :errors))
# (when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
# post-parsed))
(def post/ast (do
(def post-ctx @{:^parent ctx})
(def post-scanned (s/scan post/src :postlude))
(def post-parsed (p/parse post-scanned))
(def parse-errors (post-parsed :errors))
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
(def post-validated (v/valid prelude-parsed post-ctx))
(def validation-errors (prelude-validated :errors))
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
post-parsed))

View File

@ -21,6 +21,7 @@ This new scene will have to return a JSON POJSO:
)
(defn run [source]
(when (= :error prelude/pkg) (error "could not load prelude"))
(def ctx @{:^parent prelude/ctx})
(def errors @[])
(def draw @[])
@ -40,18 +41,18 @@ This new scene will have to return a JSON POJSO:
(when (any? (validated :errors))
(break (each err (validated :errors)
(e/validation-error err))))
(setdyn :out console)
(print "starting ludus run")
# (setdyn :out console)
(try
(set result (b/show (i/interpret (parsed :ast) ctx)))
([err] (setdyn :out stdout) (e/runtime-error err)))
(setdyn :out stdout)
(set result (i/interpret (parsed :ast) ctx))
([err] (comment setdyn :out stdout) (e/runtime-error err)))
# (setdyn :out stdout)
(set (out :result) result)
result)
(do
(def source `
forward! (100)
p5_calls
`)
(-> source run)
@ -63,3 +64,4 @@ Next up:
* testing turtle graphics
)

View File

@ -188,13 +188,16 @@ fn set? {
fn fold {
"Folds a list."
(f as :fn, xs as :list) -> fold (f, xs, f ())
(f as :fn, xs as :list, root) -> loop (root, first (xs), rest (xs)) with {
(prev, curr, []) -> f (prev, curr)
(prev, curr, remaining) -> recur (
f (prev, curr)
first (remaining)
rest (remaining)
)
(f as :fn, xs as :list, root) -> {
base :print! (("folding ", xs, " with ", f))
loop (root, first (xs), rest (xs)) with {
(prev, curr, []) -> f (prev, curr)
(prev, curr, remaining) -> recur (
f (prev, curr)
first (remaining)
rest (remaining)
)
}
}
}
@ -237,7 +240,7 @@ fn append {
fn concat {
"Combines two lists, strings, or sets."
(x as :string, y as :string) -> base :str (x, y)
(x as :string, y as :string) -> base :concat (x, y)
(xs as :list, ys as :list) -> base :concat (xs, ys)
(xs as :set, ys as :set) -> base :concat (xs, ys)
(xs, ys, ...zs) -> fold (concat, zs, concat (xs, ys))
@ -261,7 +264,9 @@ fn add_msg! {
"Adds a message to the console."
(msg as :string) -> update! (console, append (_, msg))
(msgs as :list) -> {
base :print! (("adding msg", msgs))
let msg = do msgs > map (string, _) > join
base :print! (("msg: ", msg))
update! (console, append (_, msg))
}
}
@ -269,7 +274,7 @@ fn add_msg! {
fn print! {
"Sends a text representation of Ludus values to the console."
(...args) -> {
base :print (args)
base :print! (args)
add_msg! (args)
:ok
}
@ -1048,6 +1053,7 @@ box bgcolor = colors :black
fn add_call! (call) -> update! (p5_calls, append (_, call))
fn add_command! (command) -> {
print! ("adding command", command)
update! (turtle_commands, append (_, command))
let prev = do turtle_states > unbox > last
let curr = apply_command (prev, command)
@ -1070,7 +1076,7 @@ fn render_turtle! () -> {
then {
let (r, g, b, a) = turtle_color
add_call! ((:fill, r, g, b, a))
let #{heading, :position (x, y)} = state
let #{heading, :position (x, y), ...} = state
let first = mult ((0, 1), turtle_radius)
let (x1, y1) = first
let (x2, y2) = rotate (first, turtle_angle)
@ -1224,13 +1230,13 @@ fn apply_command {
(:right, turns) -> update (state, :heading, add (_, turns))
(:left, turns) -> update (state, :heading, sub (_, turns))
(:forward, steps) -> {
let #{heading, position} = state
let #{heading, position, ...} = state
let unit = heading/vector (heading)
let vect = mult (steps, unit)
update (state, :position, add (vect, _))
}
(:back, steps) -> {
let #{heading, position} = state
let #{heading, position, ...} = state
let unit = heading/vector (heading)
let vect = mult (steps, unit)
update (state, :position, sub (_, vect))

34
janet/prelude.test.janet Normal file
View File

@ -0,0 +1,34 @@
# testing the prelude
(try (os/cd "janet") ([_] nil))
(import /scanner :as s)
(import /parser :as p)
(import /validate :as v)
(import /interpreter :as i)
(import /errors :as e)
(import /base :as b)
(import /load-prelude :as pre)
(use judge)
(defn run [source]
(when (= :error pre/pkg) (error "could not load prelude"))
(def ctx @{:^parent pre/ctx})
(def scanned (s/scan source :test))
(when (any? (scanned :errors))
(e/scan-error (scanned :errors)) (error "scanning errors"))
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(e/parse-error (parsed :errors)) (error "parsing errors"))
(def valid (v/valid parsed ctx))
(when (any? (valid :errors)) (each err (valid :errors)
(e/validation-error err)) (error "validation errors"))
(i/interpret (parsed :ast) ctx))
(deftest "debug add_msg"
(test (run `
let msgs = [1, :foo, nil]
let msg = do msgs > map (string, _)
msg
`)
@["1" ":foo" ":^nil"])
# (test (run `print! ("foo", "bar")`) :ok)
)

5
janet/project.janet Normal file
View File

@ -0,0 +1,5 @@
(declare-project
:dependencies [
{:url "https://github.com/ianthehenry/judge.git"
:tag "v2.8.1"}
])

View File

@ -1,7 +0,0 @@
(def myodd? nil)
(defn myeven? [x] (if (= 0 x) true (myodd? (dec x))))
(defn myodd? [x] (if (= 0 x) false (myeven? (dec x))))
(myeven? 2)

5
janet/watchy.fish Executable file
View File

@ -0,0 +1,5 @@
#!/opt/homebrew/bin/fish
set FILE $argv[1]
fd $FILE | entr ./judgy.fish /_