Compare commits

..

21 Commits
to_zig ... main

Author SHA1 Message Date
Scott Richmond
df85be3c1e ref->box everywhere 2024-07-21 16:31:20 -04:00
Scott Richmond
60106d10f0 consider turtle-reported vs. expected-calculated state 2024-07-21 16:26:56 -04:00
Scott Richmond
e068059362 update turtle graphics protocol doc 2024-07-20 16:54:37 -04:00
Scott Richmond
dd3867968e add description of turtle graphics protocol 2024-07-20 16:34:12 -04:00
Scott Richmond
98421a9215 allow shadowing of prelude 2024-07-20 13:51:11 -04:00
Scott Richmond
7467bc8867 disallow shadowing, remove all shadowing from Prelude. 2024-07-19 16:48:11 -04:00
Scott Richmond
2ec95c8f33 add loop & recur back into the language: we do actually need it!--just not *pedagogically* 2024-07-19 16:25:18 -04:00
Scott Richmond
7afc32d9d1 remove loop & recur from the language 2024-07-19 16:11:30 -04:00
Scott Richmond
d4adc1d912 clean up 2024-07-19 16:09:31 -04:00
Scott Richmond
4a069278b8 finally fix script, block, tuple, list, dict, etc. off by one errors for last term 2024-07-19 16:00:17 -04:00
Scott Richmond
e9fee4c0e1 make some additional comments re: off-by-one error errors 2024-07-16 20:16:28 -04:00
Scott Richmond
2027490614 improve some things 2024-07-16 20:12:21 -04:00
Scott Richmond
cb7098ac4e start fixing off-by-one errors: script, block, tuple, args, tup-patt 2024-07-16 19:40:40 -04:00
Scott Richmond
d416511b48 remove repl cruft 2024-07-14 14:42:31 -04:00
Scott Richmond
a6c899a85f Pretty-patterns shows words at ends of splatterns 2024-07-14 14:41:53 -04:00
Scott Richmond
9ddb43a30f called keywords work in pipelines 2024-07-14 14:28:09 -04:00
Scott Richmond
9e50f0cbdf Fix typo 2024-07-14 14:18:10 -04:00
Scott Richmond
2f03bbb12f mismatched arity -> wrong number of arguments 2024-07-14 13:53:32 -04:00
Scott Richmond
8cf84e63d3 add char functions to doc 2024-07-14 13:49:49 -04:00
Scott Richmond
5c32d32f24 add chars to prelude 2024-07-14 13:48:47 -04:00
Scott Richmond
32b42e0242 ignore .zig-cache 2024-07-13 18:30:45 -04:00
14 changed files with 291 additions and 115 deletions

1
.gitignore vendored
View File

@ -33,3 +33,4 @@ target/repl-port
.repl-buffer.janet .repl-buffer.janet
.env .env
src/jpm_tree src/jpm_tree
.zig-cache

View File

@ -50,8 +50,8 @@ fn ordered? {
fn assoc? { fn assoc? {
"Returns true if a value is an associative collection: a dict or a pkg." "Returns true if a value is an associative collection: a dict or a pkg."
(assoc as :dict) -> true (d as :dict) -> true
(assoc as :pkg) -> true (p as :pkg) -> true
(_) -> false (_) -> false
} }
@ -293,8 +293,8 @@ fn set? {
fn contains? { fn contains? {
"Returns true if a set or list contains a value." "Returns true if a set or list contains a value."
(value, set as :set) -> bool (base :get (set, value)) (value, s as :set) -> bool (base :get (s, value))
(value, list as :list) -> contains? (value, set (list)) (value, l as :list) -> contains? (value, set (list))
} }
fn omit { fn omit {
@ -345,8 +345,8 @@ fn string {
(x as :string) -> x (x as :string) -> x
(x) -> show (x) (x) -> show (x)
(x, ...xs) -> loop (x, xs) with { (x, ...xs) -> loop (x, xs) with {
(out, [x]) -> concat (out, show (x)) (out, [y]) -> concat (out, show (y))
(out, [x, ...xs]) -> recur (concat (out, show (x)), xs) (out, [y, ...ys]) -> recur (concat (out, show (y)), ys)
} }
} }
@ -386,6 +386,19 @@ fn downcase {
(str as :string) -> base :downcase (str) (str as :string) -> base :downcase (str)
} }
fn chars {
"Takes a string and returns its characters as a list. Works only for strings with only ascii characters. Panics on any non-ascii characters."
(str as :string) -> match base :chars (str) with {
(:ok, chrs) -> chrs
(:err, msg) -> panic! msg
}
}
fn chars/safe {
"Takes a string and returns its characters as a list, wrapped in a result tuple. Works only for strings with only ascii characters. Returns an error tuple on any non-ascii characters."
(str as :string) -> base :chars (str)
}
fn ws? { fn ws? {
"Tells if a string is a whitespace character." "Tells if a string is a whitespace character."
(" ") -> true (" ") -> true
@ -410,9 +423,9 @@ fn words {
(str as :string) -> { (str as :string) -> {
let no_punct = strip (str) let no_punct = strip (str)
let strs = split (no_punct, " ") let strs = split (no_punct, " ")
fn worder (list, str) -> if empty? (str) fn worder (l, s) -> if empty? (s)
then list then l
else append (list, str) else append (l, s)
fold (worder, strs, []) fold (worder, strs, [])
} }
} }
@ -731,31 +744,31 @@ fn or {
fn assoc { fn assoc {
"Takes a dict, key, and value, and returns a new dict with the key set to value." "Takes a dict, key, and value, and returns a new dict with the key set to value."
() -> #{} () -> #{}
(dict as :dict) -> dict (d as :dict) -> d
(dict as :dict, key as :keyword, value) -> base :assoc (dict, key, value) (d as :dict, k as :keyword, val) -> base :assoc (d, k, val)
(dict as :dict, (key as :keyword, value)) -> base :assoc (dict, key, value) (d as :dict, (k as :keyword, val)) -> base :assoc (d, k, val)
} }
fn dissoc { fn dissoc {
"Takes a dict and a key, and returns a new dict with the key and associated value omitted." "Takes a dict and a key, and returns a new dict with the key and associated value omitted."
(dict as :dict) -> dict (d as :dict) -> d
(dict as :dict, key as :keyword) -> base :dissoc (dict, key) (d as :dict, k as :keyword) -> base :dissoc (d, k)
} }
fn update { fn update {
"Takes a dict, key, and function, and returns a new dict with the key set to the result of applying the function to original value held at the key." "Takes a dict, key, and function, and returns a new dict with the key set to the result of applying the function to original value held at the key."
(dict as :dict) -> dict (d as :dict) -> d
(dict as :dict, key as :keyword, updater as :fn) -> base :assoc (dict, key, updater (get (key, dict))) (d as :dict, k as :keyword, updater as :fn) -> base :assoc (d, k, updater (get (k, d)))
} }
fn keys { fn keys {
"Takes a dict and returns a list of keys in that dict." "Takes a dict and returns a list of keys in that dict."
(dict as :dict) -> do dict > list > map (first, _) (d as :dict) -> do d > list > map (first, _)
} }
fn values { fn values {
"Takes a dict and returns a list of values in that dict." "Takes a dict and returns a list of values in that dict."
(dict) -> do dict > list > map (second, _) (d as :dict) -> do d > list > map (second, _)
} }
fn diff { fn diff {
@ -788,28 +801,28 @@ fn diff {
& TODO: consider merging `get` and `at` & TODO: consider merging `get` and `at`
fn get { fn get {
"Takes a key, dict, and optional default value; returns the value at key. If the value is not found, returns nil or the default value." "Takes a key, dict, and optional default value; returns the value at key. If the value is not found, returns nil or the default value."
(key as :keyword) -> get (key, _) (k as :keyword) -> get (k, _)
(key as :keyword, dict as :dict) -> get (key, dict, nil) (k as :keyword, d as :dict) -> get (k, d, nil)
(key as :keyword, dict as :dict, default) -> base :get (key, dict, default) (k as :keyword, d as :dict, default) -> base :get (k, d, default)
} }
& TODO: add sets to this? & TODO: add sets to this?
fn has? { fn has? {
"Takes a key and a dict, and returns true if there is a non-`nil` value stored at the key." "Takes a key and a dict, and returns true if there is a non-`nil` value stored at the key."
(key as :keyword) -> has? (key, _) (k as :keyword) -> has? (k, _)
(key as :keyword, dict as :dict) -> do dict > key > nil? (k as :keyword, d as :dict) -> do d> k > nil?
} }
fn dict { fn dict {
"Takes a list or tuple of (key, value) tuples and returns it as a dict. Returns dicts unharmed." "Takes a list or tuple of (key, value) tuples and returns it as a dict. Returns dicts unharmed."
(dict as :dict) -> dict (d as :dict) -> d
(list as :list) -> fold (assoc, list) (l as :list) -> fold (assoc, l)
(tup as :tuple) -> do tup > list > dict (t as :tuple) -> do t > list > dict
} }
fn dict? { fn dict? {
"Returns true if a value is a dict." "Returns true if a value is a dict."
(dict as :dict) -> true (d as :dict) -> true
(_) -> false (_) -> false
} }
@ -856,10 +869,10 @@ fn tan {
fn rotate { fn rotate {
"Rotates a vector by an angle. Default angle measure is turns. An optional keyword argument specifies the units of the angle passed in." "Rotates a vector by an angle. Default angle measure is turns. An optional keyword argument specifies the units of the angle passed in."
((x, y), angle) -> rotate ((x, y), angle, :turns) ((x, y), a) -> rotate ((x, y), a, :turns)
((x, y), angle, units as :keyword) -> ( ((x, y), a, units as :keyword) -> (
sub (mult (x, cos (angle, units)), mult (y, sin (angle, units))) sub (mult (x, cos (a, units)), mult (y, sin (a, units)))
add (mult (x, sin (angle, units)), mult (y, cos (angle, units))) add (mult (x, sin (a, units)), mult (y, cos (a, units)))
) )
} }
@ -904,21 +917,21 @@ fn atan/2 {
} }
fn mod { fn mod {
"Returns the modulus of num and div. Truncates towards negative infinity. Panics if div is 0." "Returns the modulus of x and y. Truncates towards negative infinity. Panics if y is 0."
(num as :number, 0) -> panic! "Division by zero." (x as :number, 0) -> panic! "Division by zero."
(num as :number, div as :number) -> base :mod (num, div) (x as :number, y as :number) -> base :mod (x, y)
} }
fn mod/0 { fn mod/0 {
"Returns the modulus of num and div. Truncates towards negative infinity. Returns 0 if div is 0." "Returns the modulus of x and y. Truncates towards negative infinity. Returns 0 if y is 0."
(num as :number, 0) -> 0 (x as :number, 0) -> 0
(num as :number, div as :number) -> base :mod (num, div) (x as :number, y as :number) -> base :mod (x, y)
} }
fn mod/safe { fn mod/safe {
"Returns the modulus of num and div in a result tuple, or an error if div is 0. Truncates towards negative infinity." "Returns the modulus of x and y in a result tuple, or an error if y is 0. Truncates towards negative infinity."
(num as :number, 0) -> (:err, "Division by zero.") (x as :number, 0) -> (:err, "Division by zero.")
(num as :number, div as :number) -> (:ok, base :mod (num, div)) (x as :number, y as :number) -> (:ok, base :mod (x, y))
} }
fn square { fn square {
@ -1130,10 +1143,10 @@ fn render_turtle! () -> {
:position (x, y) :position (x, y)
pendown? pendown?
...} = state ...} = state
let first = mult ((0, 1), turtle_radius) let origin = mult ((0, 1), turtle_radius)
let (x1, y1) = first let (x1, y1) = origin
let (x2, y2) = rotate (first, turtle_angle) let (x2, y2) = rotate (origin, turtle_angle)
let (x3, y3) = rotate (first, neg (turtle_angle)) let (x3, y3) = rotate (origin, neg (turtle_angle))
add_call! ((:push)) add_call! ((:push))
add_call! ((:translate, x, y)) add_call! ((:translate, x, y))
add_call! ((:rotate, turn/rad (heading))) add_call! ((:rotate, turn/rad (heading)))
@ -1282,8 +1295,8 @@ fn heading/vector {
"Takes a turtle heading, and returns a unit vector of that heading." "Takes a turtle heading, and returns a unit vector of that heading."
(heading) -> { (heading) -> {
& 0 is 90º/0.25T, 0.25 is 180º/0.5T, 0.5 is 270º/0.75T, 0.75 is 0º/0T & 0 is 90º/0.25T, 0.25 is 180º/0.5T, 0.5 is 270º/0.75T, 0.75 is 0º/0T
let angle = add (heading, 0.25) let a = add (heading, 0.25)
(cos (angle), sin (angle)) (cos (a), sin (a))
} }
} }
@ -1386,6 +1399,7 @@ pkg Prelude {
box? & boxes box? & boxes
butlast & lists strings tuples butlast & lists strings tuples
ceil & math ceil & math
chars & strings
clear! & turtles clear! & turtles
coll? & dicts lists sets tuples coll? & dicts lists sets tuples
colors & turtles colors & turtles

View File

@ -129,7 +129,7 @@
:typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0]))) :typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
:interpolated (get-in x [:token :lexeme]) :interpolated (get-in x [:token :lexeme])
:string (get-in x [:token :lexeme]) :string (get-in x [:token :lexeme])
:splat (string "..." (when (x :splatted) (show-patt (x :splatted)))) :splat (string "..." (when (x :data) (show-patt (x :data))))
(error (string "cannot show pattern of unknown type " (x :type))))) (error (string "cannot show pattern of unknown type " (x :type)))))
(defn pretty-patterns [fnn] (defn pretty-patterns [fnn]
@ -235,6 +235,19 @@
(defn mod [x y] (defn mod [x y]
(% x y)) (% x y))
(defn- byte->ascii [c i]
(if (< c 128)
(string/from-bytes c)
(error (string "non-ASCII character at index" i))))
(defn chars [str]
(def out @[])
(try
(for i 0 (length str)
(array/push out (byte->ascii (str i) i)))
([e] (break [:err e])))
[:ok out])
(def ctx { (def ctx {
"add" + "add" +
"and" ludus/and "and" ludus/and
@ -243,6 +256,7 @@
"atan_2" math/atan2 "atan_2" math/atan2
"bool" bool "bool" bool
"ceil" math/ceil "ceil" math/ceil
"chars" chars
"concat" concat "concat" concat
"conj!" conj! "conj!" conj!
"conj" conj "conj" conj
@ -298,10 +312,9 @@
"upcase" string/ascii-upper "upcase" string/ascii-upper
}) })
(def base (let [b @{}] (def base (let [b @{:^type :dict}]
(each [k v] (pairs ctx) (each [k v] (pairs ctx)
(set (b (keyword k)) v)) (set (b (keyword k)) v))
b)) b))
(set (base :^type) :dict)

View File

@ -28,7 +28,7 @@
"lists" ["any?" "append" "at" "butlast" "coll?" "concat" "count" "each!" "empty?" "filter" "first" "fold" "join" "keep" "last" "list" "list?" "map" "ordered?" "random" "range" "rest" "second" "sentence" "slice"] "lists" ["any?" "append" "at" "butlast" "coll?" "concat" "count" "each!" "empty?" "filter" "first" "fold" "join" "keep" "last" "list" "list?" "map" "ordered?" "random" "range" "rest" "second" "sentence" "slice"]
"sets" ["any?" "append" "coll?" "concat" "contains?" "count" "empty?" "omit" "random" "set" "set?"] "sets" ["any?" "append" "coll?" "concat" "contains?" "count" "empty?" "omit" "random" "set" "set?"]
"tuples" ["any?" "at" "coll?" "count" "empty?" "first" "last" "ordered?" "rest" "second" "tuple?"] "tuples" ["any?" "at" "coll?" "count" "empty?" "first" "last" "ordered?" "rest" "second" "tuple?"]
"strings" ["any?" "concat" "count" "downcase" "empty?" "join" "sentence" "show" "slice" "split" "string" "string?" "strip" "trim" "upcase" "words"] "strings" ["any?" "chars" "chars/safe" "concat" "count" "downcase" "empty?" "join" "sentence" "show" "slice" "split" "string" "string?" "strip" "trim" "upcase" "words"]
"types and values" ["assoc?" "bool?" "box?" "coll?" "dict?" "eq?" "fn?" "keyword?" "list?" "neq?" "nil?" "number?" "ordered?" "set?" "show" "some" "some?" "string?" "tuple?" "type"] "types and values" ["assoc?" "bool?" "box?" "coll?" "dict?" "eq?" "fn?" "keyword?" "list?" "neq?" "nil?" "number?" "ordered?" "set?" "show" "some" "some?" "string?" "tuple?" "type"]
"boxes and state" ["box?" "unbox" "store!" "update!"] "boxes and state" ["box?" "unbox" "store!" "update!"]
"results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"] "results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"]

View File

@ -345,7 +345,7 @@
(set (the-dict key) value)))) (set (the-dict key) value))))
the-dict) the-dict)
(defn- ref [ast ctx] (defn- box [ast ctx]
(def {:data value-ast :name name} ast) (def {:data value-ast :name name} ast)
(def value (interpret value-ast ctx)) (def value (interpret value-ast ctx))
(def box @{:^type :box :^value value :name name}) (def box @{:^type :box :^value value :name name})
@ -460,6 +460,7 @@
[:function :tuple] (call-fn root-ast prev curr) [:function :tuple] (call-fn root-ast prev curr)
# [:applied :tuple] (call-partial root-ast prev curr) # [:applied :tuple] (call-partial root-ast prev curr)
[:keyword :args] (get (first curr) prev :^nil) [:keyword :args] (get (first curr) prev :^nil)
[:keyword :tuple] (get (first curr) prev :^nil)
[:dict :keyword] (get prev curr :^nil) [:dict :keyword] (get prev curr :^nil)
[:nil :keyword] :^nil [:nil :keyword] :^nil
[:pkg :keyword] (get prev curr :^nil) [:pkg :keyword] (get prev curr :^nil)
@ -489,9 +490,9 @@
(def last-term (last terms)) (def last-term (last terms))
(for i 1 (-> terms length dec) (for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx)) (def curr (interpret (terms i) ctx))
(set prev (call-fn (first terms) curr [prev]))) (set prev (apply-synth-term (first terms) curr [prev])))
(def last-fn (interpret last-term ctx)) (def last-fn (interpret last-term ctx))
(call-fn (first terms) last-fn [prev])) (apply-synth-term (first terms) last-fn [prev]))
(defn- pkg [ast ctx] (defn- pkg [ast ctx]
(def members (ast :data)) (def members (ast :data))
@ -594,7 +595,7 @@
# named/naming forms # named/naming forms
:word (word ast ctx) :word (word ast ctx)
:interpolated (interpolated ast ctx) :interpolated (interpolated ast ctx)
:ref (ref ast ctx) :box (box ast ctx)
:pkg (pkg ast ctx) :pkg (pkg ast ctx)
:pkg-name (word ast ctx) :pkg-name (word ast ctx)

View File

@ -53,21 +53,23 @@
(comment (comment
# (do # (do
(def start (os/clock)) # (def start (os/clock))
(def source ` (def source `
at ("aéc", 3) box foo = :bar
store! (foo, :baz)
unbox (foo)
`) `)
(def out (-> source (def out (-> source
ludus ludus
j/decode j/decode
)) ))
(def end (os/clock)) # (def end (os/clock))
(setdyn :out stdout) (setdyn :out stdout)
(pp out) (pp out)
(def console (out "console")) (def console (out "console"))
(print console) (print console)
(def result (out "result")) (def result (out "result"))
(print result) (print result)
(print (- end start)) # (print (- end start))
) )

View File

@ -3,6 +3,9 @@
### We still need to scan some things ### We still need to scan some things
(import /src/scanner :as s) (import /src/scanner :as s)
# stash janet type
(def janet-type type)
(defmacro declare (defmacro declare
"Forward-declares a function name, so that it can be called in a mutually recursive manner." "Forward-declares a function name, so that it can be called in a mutually recursive manner."
[& names] [& names]
@ -18,6 +21,26 @@
(if-not (dyn name) (error "recursive functions must be declared before they are defined")) (if-not (dyn name) (error "recursive functions must be declared before they are defined"))
~(set ,name (defn- ,name ,;forms))) ~(set ,name (defn- ,name ,;forms)))
### Some more human-readable formatting
(defn- pp-tok [token]
(if (not token) (break "nil"))
(def {:line line :lexeme lex :type type :start start} token)
(string "<" line "[" start "]" ": " type ": " lex ">"))
(defn- pp-ast [ast &opt indent]
(default indent 0)
(def {:token token :data data :type type} ast)
(def pretty-tok (pp-tok token))
(def data-rep (if (= :array (janet-type data))
(string "[\n"
(string/join (map (fn [x] (pp-ast x (inc indent))) data)
(string (string/repeat " " indent) "\n"))
"\n" (string/repeat " " indent) "]")
data
))
(string (string/repeat " " indent) type ": " pretty-tok " " data-rep)
)
### Next: a data structure for a parser ### Next: a data structure for a parser
(defn- new-parser (defn- new-parser
"Creates a new parser data structure to pass around" "Creates a new parser data structure to pass around"
@ -75,7 +98,9 @@
(has-value? terminators ttype)) (has-value? terminators ttype))
# breakers are what terminate panics # breakers are what terminate panics
(def breaking [:break :newline :semicolon :comma :eof :then :else]) (def breaking [:break :newline :semicolon :comma :eof
# :then :else :arrow
])
(defn- breaks? (defn- breaks?
"Returns true if the current token in the parser should break a panic" "Returns true if the current token in the parser should break a panic"
@ -89,12 +114,12 @@
[parser message] [parser message]
# (print "Panic in the parser: " message) # (print "Panic in the parser: " message)
(def origin (current parser)) (def origin (current parser))
(advance parser) (def skipped @[])
(def skipped @[origin])
(while (not (breaks? parser)) (while (not (breaks? parser))
(array/push skipped (current parser)) (array/push skipped (current parser))
(advance parser)) (advance parser))
(array/push skipped (current parser)) (array/push skipped (current parser))
# (advance parser)
(def err {:type :error :data skipped :token origin :msg message}) (def err {:type :error :data skipped :token origin :msg message})
(update parser :errors array/push err) (update parser :errors array/push err)
(error err)) (error err))
@ -279,8 +304,10 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) # consume the :lparen (advance parser) # consume the :lparen
(def ast @{:type :args :data @[] :token origin :partial false}) (def ast @{:type :args :data @[] :token origin :partial false})
(while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen)) (while (not (check parser :rparen))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"}) (def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -299,8 +326,7 @@
{:type :placeholder :token origin})) {:type :placeholder :token origin}))
(capture nonbinding parser))) (capture nonbinding parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -333,20 +359,26 @@
{:type :synthetic :data [;terms] :token origin}) {:type :synthetic :data [;terms] :token origin})
# collections # collections
### XXX: the current panic/capture structure in this, script, etc. is blowing up when the LAST element (line, tuple member, etc.) has an error
# it does, however, work perfectly well when there isn't one
# there's something about advancing past the breaking token, or not
# aslo, I removed the captures here around nonbinding and separators, and we got into a loop with a panic
# oy
(defn- tup [parser] (defn- tup [parser]
(def origin (current parser)) (def origin (current parser))
(advance parser) # consume the :lparen (advance parser) # consume the :lparen
(def ast {:type :tuple :data @[] :token origin}) (def ast {:type :tuple :data @[] :token origin})
(while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen)) (while (not (check parser :rparen))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"}) (def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
(error err)) (error err))
(def term (capture nonbinding parser)) (def term (capture nonbinding parser))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -354,8 +386,10 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :list :data @[] :token origin}) (def ast {:type :list :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbracket)) (while (not (check parser :rbracket))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed bracket"}) (def err {:type :error :token origin :msg "unclosed bracket"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -369,8 +403,7 @@
) )
(capture nonbinding parser))) (capture nonbinding parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -378,8 +411,10 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :set :data @[] :token origin}) (def ast {:type :set :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"}) (def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -393,8 +428,7 @@
) )
(capture nonbinding parser))) (capture nonbinding parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -402,8 +436,10 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :dict :data @[] :token origin}) (def ast {:type :dict :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"}) (def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -423,7 +459,7 @@
(try (panic parser (string "expected dict term, got " (type origin))) ([e] e)) (try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
)) ))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) ([e] (array/push (ast :data) e)))) (capture separators parser))
(advance parser) (advance parser)
ast) ast)
@ -452,8 +488,10 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) # consume the :lparen (advance parser) # consume the :lparen
(def ast {:type :tuple :data @[] :token origin}) (def ast {:type :tuple :data @[] :token origin})
(while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen)) (while (not (check parser :rparen))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"}) (def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -466,8 +504,7 @@
{:type :splat :data splatted :token origin}) {:type :splat :data splatted :token origin})
(capture pattern parser))) (capture pattern parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -475,8 +512,10 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :list :data @[] :token origin}) (def ast {:type :list :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbracket)) (while (not (check parser :rbracket))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed bracket"}) (def err {:type :error :token origin :msg "unclosed bracket"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -489,8 +528,7 @@
{:type :splat :data splatted :token origin}) {:type :splat :data splatted :token origin})
(capture pattern parser))) (capture pattern parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -498,8 +536,10 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :dict :data @[] :token origin}) (def ast {:type :dict :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"}) (def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -519,7 +559,7 @@
(try (panic parser (string "expected dict term, got " (type origin))) ([e] e)) (try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
)) ))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) ([e] (array/push (ast :data) e)))) (capture separators parser))
(advance parser) (advance parser)
ast) ast)
@ -560,22 +600,25 @@
(defn- iff [parser] (defn- iff [parser]
(def ast {:type :if :data @[] :token (current parser)}) (def ast {:type :if :data @[] :token (current parser)})
(advance parser) #consume the if (advance parser) #consume the if
(array/push (ast :data) (capture simple parser)) (array/push (ast :data) (simple parser))
(accept-many parser :newline) (accept-many parser :newline)
(if-let [err (expect-ret parser :then)] (if-let [err (expect-ret parser :then)]
(array/push (ast :data) err) (array/push (ast :data) err)
(advance parser)) (advance parser))
(array/push (ast :data) (capture nonbinding parser)) (array/push (ast :data) (nonbinding parser))
(accept-many parser :newline) (accept-many parser :newline)
(if-let [err (expect-ret parser :else)] (if-let [err (expect-ret parser :else)]
(array/push (ast :data) err) (array/push (ast :data) err)
(advance parser)) (advance parser))
(array/push (ast :data) (capture nonbinding parser)) (array/push (ast :data) (nonbinding parser))
ast) ast)
(defn- literal-terminator? [token]
(def tok-type (token :type))
(or (= :newline tok-type) (= :semicolon tok-type)))
(defn- terminator [parser] (defn- terminator [parser]
(if-not (terminates? parser) (if-not (terminates? parser)
# this line panics, captures the panic, advances the parser, and re-throws the error; solves an off-by-one error
(panic parser "expected terminator")) (panic parser "expected terminator"))
(advance parser) (advance parser)
(while (terminates? parser) (advance parser))) (while (terminates? parser) (advance parser)))
@ -798,13 +841,15 @@
(defn- block [parser] (defn- block [parser]
(def origin (current parser)) (def origin (current parser))
(expect parser :lbrace) (advance parser) (expect parser :lbrace) (advance parser)
(accept-many parser ;terminators)
(def data @[]) (def data @[])
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(accept-many parser :newline :semicolon)
(when (= :break ((current parser) :type))
(break (advance parser)))
(if (check parser :eof) (if (check parser :eof)
(error {:type :error :token origin :data data :msg "unclosed brace"})) (error {:type :error :token origin :data data :msg "unclosed brace"}))
(array/push data (capture expr parser)) (array/push data (capture expr parser))
(terminator parser)) (capture terminator parser))
(advance parser) (advance parser)
{:type :block :data data :token origin}) {:type :block :data data :token origin})
@ -826,16 +871,16 @@
(array/push data (capture simple parser))) (array/push data (capture simple parser)))
{:type :do :data data :token origin}) {:type :do :data data :token origin})
### refs, pkgs, nses, etc. ### boxs, pkgs, nses, etc.
(defn- ref [parser] (defn- box [parser]
(def origin (current parser)) (def origin (current parser))
(expect parser :ref) (advance parser) (expect parser :box) (advance parser)
(try (try
(do (do
(def name (-> parser word-only (get :data))) (def name (-> parser word-only (get :data)))
(expect parser :equals) (advance parser) (expect parser :equals) (advance parser)
(def value (nonbinding parser)) (def value (nonbinding parser))
{:type :ref :data value :name name :token origin}) {:type :box :data value :name name :token origin})
([err] err))) ([err] err)))
(defn- pkg-name [parser] (defn- pkg-name [parser]
@ -966,7 +1011,7 @@
### expressions ### expressions
# four levels of expression complexity: # four levels of expression complexity:
# simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks) # simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks)
# nonbinding (excludes let, ref, named fn: what is allowed inside collections) # nonbinding (excludes let, box, named fn: what is allowed inside collections)
# plain old exprs (anything but toplevel) # plain old exprs (anything but toplevel)
# toplevel (exprs + ns, pkg, test, import, use) # toplevel (exprs + ns, pkg, test, import, use)
@ -1054,7 +1099,7 @@
# binding forms # binding forms
:let (lett parser) :let (lett parser)
:fn (fnn parser) :fn (fnn parser)
:ref (ref parser) :box (box parser)
# nonbinding forms # nonbinding forms
:nil (nill parser) :nil (nill parser)
@ -1103,8 +1148,12 @@
(def origin (current parser)) (def origin (current parser))
(def lines @[]) (def lines @[])
(while (not (check parser :eof)) (while (not (check parser :eof))
(accept-many parser :newline) # (print "starting script loop with " (pp-tok origin))
(array/push lines (capture toplevel parser)) (accept-many parser :newline :semicolon)
(when (= :break ((current parser) :type))
(break (advance parser)))
(def term (capture toplevel parser))
(array/push lines term)
(capture terminator parser)) (capture terminator parser))
{:type :script :data lines :token origin}) {:type :script :data lines :token origin})
@ -1117,10 +1166,16 @@
# (do # (do
(comment (comment
(def source ` (def source `
let foo = :bar {
foo bar
quux frobulate
baz
12 23 42
}
`) `)
(def scanned (s/scan source)) (def scanned (s/scan source))
# (print "\n***NEW PARSE***\n") # (print "\n***NEW PARSE***\n")
(def a-parser (new-parser scanned)) (def parsed (parse scanned))
(def parsed (lett a-parser)) (pp (map (fn [err] (err :msg)) (parsed :errors)))
(print (pp-ast (parsed :ast)))
) )

View File

@ -1,8 +1,9 @@
(def reserved-words (def reserved-words
"List of Ludus reserved words." "List of Ludus reserved words."
## see ludus-spec repo for more info ## see ludus-spec repo for more info
{"as" :as ## impl {
"box" :ref "as" :as ## impl
"box" :box
"do" :do ## impl "do" :do ## impl
"else" :else ## impl "else" :else ## impl
"false" :false ## impl -> literal word "false" :false ## impl -> literal word
@ -17,13 +18,13 @@
"panic!" :panic ## impl (should _not_ be a function) "panic!" :panic ## impl (should _not_ be a function)
"pkg" :pkg "pkg" :pkg
"recur" :recur ## impl "recur" :recur ## impl
"repeat" :repeat ## impl
"test" :test
"then" :then ## impl "then" :then ## impl
"true" :true ## impl -> literal word "true" :true ## impl -> literal word
"use" :use ## wip "use" :use ## wip
"with" :with ## impl
"when" :when ## impl, replaces cond "when" :when ## impl, replaces cond
"repeat" :repeat ## syntax sugar over "loop": still unclear what this syntax could be "with" :with ## impl
"test" :test
}) })
(def literal-words {"true" true (def literal-words {"true" true

View File

@ -102,6 +102,11 @@ Deferred until a later iteration of Ludus:
(def node (get ctx name)) (def node (get ctx name))
(if node node (resolve-name (get ctx :^parent) name))) (if node node (resolve-name (get ctx :^parent) name)))
(defn- resolve-name-in-script [ctx name]
(when (ctx :^toplevel) (break nil))
(def node (ctx name))
(if node node (resolve-name-in-script (ctx :^parent) name)))
(defn- word [validator] (defn- word [validator]
(def ast (validator :ast)) (def ast (validator :ast))
(def name (ast :data)) (def name (ast :data))
@ -157,10 +162,12 @@ Deferred until a later iteration of Ludus:
(def ast (validator :ast)) (def ast (validator :ast))
(def name (ast :data)) (def name (ast :data))
(def ctx (validator :ctx)) (def ctx (validator :ctx))
(when (has-key? ctx name) ### XXX TODO: this resolution should ONLY be for userspace, NOT prelude
(def {:line line :input input} (get-in ctx [name :token])) (def resolved (resolve-name-in-script ctx name))
(when resolved
(def {:line line :input input} resolved)
(array/push (validator :errors) (array/push (validator :errors)
{:node ast :msg (string "name is already bound on line " {:node ast :msg (string "name " name " is already bound on line "
line " of " input)})) line " of " input)}))
(set (ctx name) ast) (set (ctx name) ast)
# (pp ctx) # (pp ctx)
@ -336,7 +343,7 @@ Deferred until a later iteration of Ludus:
(set (ast :arities) arities) (set (ast :arities) arities)
validator) validator)
(defn- ref [validator] (defn- box [validator]
(def ast (validator :ast)) (def ast (validator :ast))
(def ctx (validator :ctx)) (def ctx (validator :ctx))
(def expr (ast :data)) (def expr (ast :data))
@ -435,12 +442,12 @@ Deferred until a later iteration of Ludus:
(def rest-arities (keys (arities :rest))) (def rest-arities (keys (arities :rest)))
(when (empty? rest-arities) (when (empty? rest-arities)
(array/push (validator :errors) (array/push (validator :errors)
{:node ast :msg "mismatched arity"}) {:node ast :msg "wrong number of arguments"})
(break validator)) (break validator))
(def rest-min (min ;rest-arities)) (def rest-min (min ;rest-arities))
(when (< num-args rest-min) (when (< num-args rest-min)
(array/push (validator :errors) (array/push (validator :errors)
{:node ast :msg "mismatched arity"})) {:node ast :msg "wrong number of arguments"}))
validator) validator)
(defn- kw-root [validator] (defn- kw-root [validator]
@ -750,7 +757,7 @@ Deferred until a later iteration of Ludus:
:use (usee validator) :use (usee validator)
:loop (loopp validator) :loop (loopp validator)
:recur (recur validator) :recur (recur validator)
:ref (ref validator) :box (box validator)
(error (string "unknown node type " type))))) (error (string "unknown node type " type)))))
(set validate validate*) (set validate validate*)
@ -764,6 +771,7 @@ Deferred until a later iteration of Ludus:
(defn valid [ast &opt ctx] (defn valid [ast &opt ctx]
(default ctx @{}) (default ctx @{})
(set (ctx :^toplevel) true)
(def validator (new-validator ast)) (def validator (new-validator ast))
(def base-ctx @{:^parent ctx}) (def base-ctx @{:^parent ctx})
(set (validator :ctx) base-ctx) (set (validator :ctx) base-ctx)

81
turtle-graphics.md Normal file
View File

@ -0,0 +1,81 @@
# Turtle Graphics protocol
name: "turtle-graphics"
version: 0.1.0
### Description
Turtle graphics describe the movements and drawing behaviours of screen, robot, and print "turtles."
* `proto`: `["turtle-graphics", "{version number}"]`
* `data`: an array of arrays; each array represents a turtle command; the first element of a command array is the verb; any subsequent items are the arguments to the verbs.
* Valid arguments are numbers, strings, and booleans.
* Depending on what we end up doing, we may add arrays of these, representing tuples or lists, and/or objects with string keys whose text are well-formed keywords in Ludus. For now, however, arguments must be atomic values.
* E.g., `["forward", 100]`
* Each turtle has its own stream.
* At current, this protocol describes the behaviour of turtle-like objects, all of which "live" in the same "world"; there is not yet a provision for multiple canvases/worlds. That said, an additional field for "world" in at the top level may well be added in the future to allow for multiple worlds to unfold at the same time.
### Verbs and arguments
* `forward`, steps: number
- Moves the turtle forward by the number of steps/pixels.
* `back`, steps: number
- Moves the turtle backwards by the number of steps/pixels.
* `right`, turns: number
- Turns the turtle right by the number of turns. (1 turn = 360 degrees.)
* `left`, turns: number
- Turns the turtle to the left by the number of turns. (1 turn = 360 degrees.)
* `penup`, no arguments
- "Lifts" the turtle's pen, keeping it from drawing.
* `pendown`, no arguments
- "Lowers" the turtle's pen, starting it drawing a path.
* `pencolor`, red: number, green: number, blue: number, alpha: number, OR: color: string
- Sets the turtle's pen's color to the specified RGBA color.
* `penwidth`, width: number
- Sets the width of the turtle's pen, in pixels (or some other metric).
* `home`, no arguments
- Sends the turtle back to its starting point, with a heading of 0.
* `goto`, x: number, y: number
- Sends the turtle to the specified Cartesian coordinates, where the origin is the turtle's starting position.
* `setheading`, heading: number
- Sets the turtle's heading. 0 is the turtle's starting heading, with increasing numbers turning to the right.
* `show`, no arguments
- Shows the turtle.
* `hide`, no arguments
- Hides the turtle.
* `loadstate`, x: number, y: number, heading: number, pendown: boolean, width: number, color: string OR r: number, g: number, b: number, a: number
- Loads a turtle state.
* `clear`, no arguments
- Erases any paths drawn and sets the background color to the default.
* `background`, red: number, green: number, blue: number, alpha: number
- Sets the background color to the specified RGBA color, OR: color: string
These last two feel a little weird to me, since the background color is more the property of the **world** the turtle is in, not the turtle itself. Worlds with multiple turtles will be set up so that _any_ turtle will be able to change the background, and erase all paths.
That said, since we don't yet have a world abstraction/entity, then there's no other place to put them. This will likely be shifted around in later versions of the protocol.
### Other considerations
**Not all turtles will know how to do all these things.**
The idea is that this single abstraction will talk to all the turtle-like things we eventually use.
That means that some turtles won't be able to do all the things; that's fine!
They just won't do things they can't do; but warnings should go to `stderr`.
**Errors are not passed back to Ludus.**
These are fire-off commands.
Errors should be _reported_ to `stderr` or equivalent.
But Ludus sending things to its output streams should only cause Ludus panics when there's an issue in Ludus.
**Colors aren't always RGBA.**
For pen-and-paper turtles, we don't have RGBA colors.
Colors should also be specifiable with strings corresponding to CSS basic colors: black, silver, gray, white, maroon, red, purple, fuchsia, green, lime, olive, yellow, navy, blue, teal, and aqua.
**Turtles should communicate states.**
Ludus should have access to turtle states.
This is important for push/pop situations that we use for L-systems.
There are two ways to do this: Ludus does its own bookkeeping for turtle states, or it has a way to get the state from a turtle.
The latter has the value of being instantaneous, and gives us an _expected_ state of the turtle after the commands are all processed.
In particular, this will be necessary for the recursive L-systems that require pushing and popping turtle state.
The latter has the drawback of potentially allowing the turtle state and expected turtle state to fall out of synch.
The former has the value of always giving us the correct, actual state of the turtle.
It has the drawback of requiring such state reporting to be asynchronous, and perhaps wildly asynchronous, as things like moving robots and plotters will take quite some time to actually draw what Ludus tells it to.
(Being able to wait until `eq? (expected, actual)` to do anything else may well be extremely useful.)
That suggests, then, that both forms of turtle state are desirable and necessary.
Thus: turtles should communicate states (and thus there ought to be a protocol for communicating state back to Ludus) and Ludus should always do the bookkeeping of calculating the expected state.