clean up files

janet/base.janet

@@ -0,0 +1,338 @@
+# A base library for Ludus
+# Only loaded in the prelude
+
+(import /src/scanner :as s)
+
+(defn bool [x] (if (= :^nil x) nil x))
+
+(defn ludus/and [& args] (every? (map bool args)))
+
+(defn ludus/or [& args] (some bool args))
+
+(defn ludus/type [value]
+  (when (= :^nil value) (break :nil))
+  (def typed? (when (dictionary? value) (value :^type)))
+  (def the-type (if typed? typed? (type value)))
+  (case the-type
+    :buffer :string
+    :boolean :bool
+    :array :list
+    :table :dict
+    :cfunction :function
+    the-type))
+
+(var stringify nil)
+
+(defn- dict-str [dict]
+  (string/join 
+    (map 
+      (fn [[k v]] (string (stringify k) " " (stringify v))) 
+      (pairs dict))
+    ", "))
+
+(defn- stringish? [x] (or (string? x) (buffer? x)))
+
+(defn- stringify* [value]
+  (when (stringish? value) (break value))
+  (def type (ludus/type value))
+  (case type
+    :nil ""
+    :number (string value)
+    :bool (string value)
+    :keyword (string ":" value)
+    :tuple 
+      (string/join (map stringify value) ", ")
+    :list
+      (string/join (map stringify value) ", ")
+    :dict (dict-str value)
+    :set
+      (string/join (map stringify (keys value)) ", ")
+    :box (stringify (value :^value))
+    :fn (string "fn " (value :name))
+    :function (string "builtin " (string value))
+    :pkg (dict-str value)
+  ))
+
+(set stringify stringify*)
+
+(var show nil)
+
+(defn- show-pkg [x]
+  (def tab (struct/to-table x))
+  (set (tab :^name) nil)
+  (set (tab :^type) nil)
+  (string "pkg " (x :^name) " {" (stringify tab) "}")
+)
+
+(defn- dict-show [dict]
+  (string/join 
+    (map 
+      (fn [[k v]] (string (show k) " " (show v))) 
+      (pairs dict))
+    ", "))
+
+(defn- set-show [sett]
+  (def prepped (merge sett))
+  (set (prepped :^type) nil)
+  (def shown (map show (keys prepped)))
+  (string/join shown ", ")
+)
+
+(defn- show* [x]
+  (case (ludus/type x)
+    :nil "nil"
+    :string (string "\"" x "\"")
+    :tuple (string "(" (string/join (map show x) ", ") ")")
+    :list (string "[" (string/join (map show x) ", ") "]")
+    :dict (string "#{" (dict-show x) "}")
+    :set (string "${" (set-show x) "}")
+    :box (string "box " (x :name) " [ " (show (x :^value)) " ]")
+    :pkg (show-pkg x)
+    (stringify x)))
+
+(set show show*)
+
+# (var json nil)
+
+# (defn- dict-json [dict]
+#   (string/join 
+#     (map 
+#       (fn [[k v]] (string (json k) ": " (json v))) 
+#       (pairs dict))
+#     ", "))
+
+# (defn- json* [x]
+#   (case (ludus/type x)
+#     :nil "\"null\""
+#     :number (string x)
+#     :bool (if true "\"true\"" "\"false\"")
+#     :string (string "\"" x "\"")
+#     :keyword (string "\"" x "\"")
+#     :tuple (string "[" (string/join (map json x) ", ") "]")
+#     :list (string "["  (string/join (map json x) ", ")"]")
+#     :dict (string "{" (dict-json x) "}")
+#     :set (string "["  (string/join (map json (keys x)) ", ") "]")
+#     (show x)))
+
+# (set json json*)
+
+(defn show-patt [x]
+  (case (x :type)
+    :nil "nil"
+    :bool (string (x :data))
+    :number (string (x :data))
+    :keyword (string ":" (x :data))
+    :word (x :data)
+    :placeholder (get-in x [:token :lexeme])
+    :tuple (string "(" (string/join (map show-patt (x :data)) ", ") ")")
+    :list (string "[" (string/join (map show-patt (x :data)) ", ")"]")
+    :dict (string "#{" (string/join (map show-patt (x :data)) ", ") "}")
+    :pair (string (show-patt (get-in x [:data 0])) " " (show-patt (get-in x [:data 1])))
+    :typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
+    :interpolated (get-in x [:token :lexeme])
+    :string (get-in x [:token :lexeme])
+    :splat (string "..." (when (x :data) (show-patt (x :data))))
+    (error (string "cannot show pattern of unknown type " (x :type)))))
+
+(defn pretty-patterns [fnn]
+  (def {:body clauses} fnn)
+  (string/join (map (fn [x] (-> x first show-patt)) clauses) "\n"))
+
+(defn doc [fnn]
+  (when (not= :fn (ludus/type fnn)) (break "No documentation available."))
+  (def {:name name :doc docstring} fnn)
+  (string/join [name 
+                (pretty-patterns fnn) 
+                (if docstring docstring "No docstring available.")] 
+    "\n"))
+
+(defn- conj!-set [sett value]
+  (set (sett value) true)
+  sett)
+
+(defn- conj-set [sett value]
+  (def new (merge sett))
+  (conj!-set new value))
+
+(defn- conj!-list [list value]
+  (array/push list value))
+
+(defn- conj-list [list value]
+  (def new (array/slice list))
+  (conj!-list new value))
+
+(defn conj! [x value]
+  (case (ludus/type x)
+    :list (conj!-list x value)
+    :set (conj!-set x value)))
+
+(defn conj [x value]
+  (case (ludus/type x)
+    :list (conj-list x value)
+    :set (conj-set x value)
+    (error (string "cannot conj onto " (show x)))))
+
+(defn disj! [sett value]
+  (set (sett value) nil)
+  sett)
+
+(defn disj [sett value]
+  (def new (merge sett))
+  (set (new value) nil)
+  new)
+
+(defn assoc! [dict key value]
+  (set (dict key) value)
+  dict)
+
+(defn assoc [dict key value]
+  (merge dict {key value}))
+
+(defn dissoc! [dict key]
+  (set (dict key) nil)
+  dict)
+
+(defn dissoc [dict key]
+  (def new (merge dict))
+  (set (new key) nil)
+  new)
+
+(defn ludus/get [key dict &opt def]
+  (default def :^nil)
+  (get dict key def))
+
+(defn rest [indexed]
+  (array/slice indexed 1))
+
+(defn to_list [x]
+  (case (ludus/type x)
+    :list x
+    :tuple @[;x]
+    :dict (pairs x)
+    :set (-> x (dissoc :^type) keys)
+    @[x]))
+
+(defn showprint [x]
+  (if (= :string (ludus/type x))
+    x
+    (show x)))
+
+(defn print! [args]
+  (print ;(map showprint args)))
+
+(defn prn [x]
+  (pp x)
+  x)
+
+(defn concat [x y & zs]
+  (case (ludus/type x)
+    :string (string x y ;zs)
+    :list (array/concat @[] x y ;zs)
+    :set (merge x y ;zs)))
+
+(defn unbox [b] (get b :^value))
+
+(defn store! [b x] (set (b :^value) x))
+
+(defn mod [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])
+
+(defn to_number [str]
+  (when (string/find "&" str)
+    (break [:err (string "Could not parse `" str "` as a number")]))
+  (def scanned (s/scan (string/trim str)))
+  (when (< 0 (length (scanned :errors)))
+    (break [:err (string "Could not parse `" str "` as a number")]))
+  (def tokens (scanned :tokens))
+  (when (< 3 (length tokens))
+    (break [:err (string "Could not parse `" str "` as a number")]))
+  (def fst (first tokens))
+  (when (not= :number (fst :type))
+    (break [:err (string "Could not parse `" str "` as a number")]))
+  [:ok (fst :literal)])
+
+(def ctx {
+  "add" +
+  "and" ludus/and
+  "assoc!" assoc!
+  "assoc" assoc
+  "atan_2" math/atan2
+  "bool" bool
+  "ceil" math/ceil
+  "chars" chars
+  "concat" concat
+  "conj!" conj!
+  "conj" conj
+  "cos" math/cos
+  "count" length
+  "dec" dec
+  "disj!" disj!
+  "disj" disj
+  "dissoc!" dissoc!
+  "dissoc" dissoc
+  "div" /
+  "doc" doc
+  "downcase" string/ascii-lower
+  "e" math/e
+  "eq?" deep=
+  "first" first
+  "floor" math/floor
+  "get" ludus/get
+  "gt" >
+  "gte" >=
+  "inc" inc
+  "last" last
+  "lt" <
+  "lte" <=
+  "mod" mod
+  "mult" *
+  "not" not
+  "nth" ludus/get
+  "or" ludus/or
+  "pi" math/pi
+  "pow" math/pow
+  "print!" print!
+  "prn" prn
+  "push" array/push
+  "random" math/random
+  "range" range
+  "rest" rest
+  "round" math/round
+  "show" show
+  "sin" math/sin
+  "slice" array/slice
+  "split" string/split
+  "sqrt" math/sqrt
+  "store!" store!
+  "str_slice" string/slice
+  "stringify" stringify
+  "sub" -
+  "tan" math/tan
+  "to_list" to_list
+  "to_number" to_number
+  "trim" string/trim
+  "triml" string/triml
+  "trimr" string/trimr
+  "type" ludus/type
+  "unbox" unbox
+  "upcase" string/ascii-upper
+})
+
+(def base (let [b @{:^type :dict}]
+  (each [k v] (pairs ctx)
+    (set (b (keyword k)) v))
+  b))
+

janet/doc.janet

@@ -0,0 +1,132 @@
+(import /src/base :as base)
+(import /src/prelude :as prelude)
+
+(defn map-values [f dict] 
+ (from-pairs (map (fn [[k v]] [k (f v)]) (pairs dict))))
+
+(def with-docs (map-values base/doc prelude/ctx))
+
+(def sorted-names (-> with-docs keys sort))
+
+(defn escape-underscores [str] (string/replace  "_" "\\_" str))
+
+(defn escape-punctuation [str] (->> str
+ (string/replace "?" "")
+ (string/replace "!" "")
+ (string/replace "/" "")))
+
+(defn toc-entry [name] 
+ (def escaped (escape-underscores name)) 
+ (string "[" escaped "](#" (escape-punctuation escaped) ")"))
+
+(def alphabetical-list
+ (string/join (map toc-entry sorted-names) "    "))
+
+(def topics {
+ "math" ["abs" "add" "angle" "atan/2" "between?" "ceil" "cos" "dec" "deg/rad" "deg/turn" "dist" "div" "div/0" "div/safe" "even?" "floor" "gt?" "gte?" "heading/vector" "inc" "inv" "inv/0" "inv/safe" "lt?" "lte?" "max" "min" "mod" "mod/0" "mod/safe" "mult" "neg" "neg?" "odd?" "pi" "pos?" "rad/deg" "rad/turn" "random" "random_int" "range" "round" "sin" "sqrt" "sqrt/safe" "square" "sub" "sum_of_squares" "tan" "tau" "to_number" "turn/deg" "turn/rad" "zero?"]
+ "boolean" ["and" "bool" "bool?" "false?" "not" "or" "true?"]
+ "dicts" ["any?" "assoc" "assoc?" "coll?" "count" "dict" "dict?" "diff" "dissoc" "empty?" "get" "keys" "random" "update" "values"]
+ "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"]
+ "llists" ["car" "cdr" "cons" "llist"]
+ "sets" ["any?" "append" "coll?" "concat" "contains?" "count" "empty?" "omit" "random" "set" "set?"]
+ "tuples" ["any?" "at" "coll?" "count" "empty?" "first" "last" "ordered?" "rest" "second" "tuple?"]
+ "strings" ["any?" "chars" "chars/safe" "concat" "count" "downcase" "empty?" "join" "sentence" "show" "slice" "split" "string" "string?" "strip" "to_number" "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"]
+ "boxes and state" ["box?" "unbox" "store!" "update!"]
+ "results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"]
+ "errors" ["assert!"]
+ "turtle graphics" ["back!" "background!" "bk!" "clear!" "colors" "fd!" "forward!" "goto!" "heading" "heading/vector" "hideturtle!" "home!" "left!" "loadstate!" "lt!" "pc!" "pd!" "pencolor" "pencolor!" "pendown!" "pendown?" "penup!" "penwidth" "penwidth!" "position" "pu!" "pw!" "render_turtle!" "reset_turtle!" "right!" "rt!" "setheading!" "showturtle!" "turtle_state"]
+ "environment and i/o" ["doc!" "print!" "report!" "state"]
+ })
+
+(defn capitalize [str]
+ (def fst (slice str 0 1))
+ (def rest (slice str 1))
+ (def init_cap (string/ascii-upper fst))
+ (def lower_rest (string/ascii-lower rest))
+ (string init_cap lower_rest))
+
+(defn topic-entry [topic] 
+ (string "### " (capitalize topic) "\n" 
+  (as-> topic _ (topics _) (array/slice _) (sort _) (map toc-entry _) 
+   (string/join _ "    "))
+  "\n"))
+
+(def by-topic (let [the-topics (-> topics keys sort)
+                    topics-entries (map topic-entry the-topics)]
+                (string/join topics-entries "\n")))
+
+(defn compose-entry [name]
+ 	(def header (string "\n### " name "\n"))   	
+ 	(def the-doc (get with-docs name))
+  (when (= "No documentation available." the-doc)
+   (break (string header the-doc "\n")))
+  (def lines (string/split "\n" the-doc))
+	(def description (last lines))
+  (def patterns (string/join (slice lines 1 (-> lines length dec)) "\n"))
+  (def backto "[Back to top.](#ludus-prelude-documentation)\n")
+ 	(string header description "\n```\n" patterns "\n```\n" backto))
+
+(compose-entry "update")
+
+(def entries (string/join (map compose-entry sorted-names) "\n---"))
+
+(def doc-file (string 
+```
+# Ludus prelude documentation
+These functions are available in every Ludus script.
+The documentation for any function can be found within Ludus by passing the function to `doc!`, 
+e.g., running `doc! (add)` will send the documentation for `add` to the console.
+
+For more information on the syntax & semantics of the Ludus language, see [language.md](./language.md).
+
+The prelude itself is just a Ludus file, which you can see at [prelude.ld](./prelude.ld).
+
+## A few notes
+**Naming conventions.** Functions whose name ends with a question mark, e.g., `eq?`, return booleans.
+Functions whose name ends with an exclamation point, e.g., `make!`, change state in some way.
+In other words, they _do things_ rather than _calculating values_. 
+Functions whose name includes a slash either convert from one value to another, e.g. `deg/rad`,
+or they are variations on a function, e.g. `div/0` as a variation on `div`.
+
+**How entries are formatted.** Each entry has a brief (sometimes too brief!) description of what it does.
+It is followed by the patterns for each of its function clauses.
+This should be enough to indicate order of arguments, types, and so on.
+
+**Patterns often, but do not always, indicate types.** Typed patterns are written as `foo as :bar`,
+where the type is indicated by the keyword. 
+Possible ludus types are: `:nil`, `:boolean`, `:number`, `:keyword` (atomic values);
+`:string` (strings are their own beast); `:tuple` and `:list` (ordered collections), `:set`s, and `:dict`ionaries (the other collection types); `:pkg` (packages, which are quasi-collections); `:fn` (functions); and `:box`es.
+
+**Conventional types.** Ludus has two types based on conventions.
+* _Result tuples._ Results are a way of modeling the result of a calculation that might fail.
+The two possible values are `(:ok, value)` and `(:err, msg)`.
+`msg` is usually a string describing what went wrong.
+To work with result tuples, see [`unwrap!`](#unwrap) and [`unwrap_or`](#unwrap_or).
+That said, usually you work with these using pattern matching.
+
+* _Vectors._ Vectors are 2-element tuples of x and y coordinates.
+The origin is `(0, 0)`. 
+Many math functions take vectors as well as numbers, e.g., `add` and `mult`.
+You will see vectors indicated in patterns by an `(x, y)` tuple.
+You can see what this looks like in the last clause of `add`: `((x1, y1), (x2, y2))`.
+
+## Functions by topic
+
+```
+by-topic
+```
+    
+## All functions, alphabetically
+
+```
+alphabetical-list
+```
+
+## Function documentation
+
+```
+entries
+))
+
+(spit "prelude.md" doc-file)

janet/errors.janet

@@ -0,0 +1,140 @@
+(import /src/base :as b)
+
+(defn- get-line [source line]
+ ((string/split "\n" source) (dec line)))
+
+(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 :start start} (e :token))
+ (def source-line (get-line source line-num))
+ (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 :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 (caret source line-num start)))
+  (do
+   (print "Validation error: " msg)
+   (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 :start start} (get-in e [:node :token]))
+ (def source-line (get-line source line-num))
+ (print "  on line " line-num " in " input ", ")
+ (def called (e :called))
+ (print "  calling: " (slice (b/show called) 3))
+ (def value (e :value))
+ (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 :start start} (get-in e [:node :token]))
+ (def source-line (get-line source line-num))
+ (print "  on line " line-num " in " input ", ")
+ (print "  matching: " (b/show (e :value)))
+ (def pattern (get-in e [:node :data 0]))
+ (print "  with pattern: " (b/show-patt pattern))
+ (print "  >>> " source-line)
+ (print (caret source line-num start))
+ e)
+
+(defn- match-no-match [e]
+ (print "Ludus panicked! no match")
+ (def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
+ (print "  on line " line-num " in " input ", ")
+ (def value (e :value))
+ (print "  matching: " (b/show value))
+ (print "  with patterns:")
+ (def clauses (get-in e [:node :data 1]))
+ (def patterns (b/pretty-patterns {:body clauses}))
+ (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)
+ (def source-line (get-line source line-num))
+ (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 :start start} (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 (caret source line-num start))
+ e)
+
+(defn- unbound-name [e]
+ (def {:line line-num :source source :lexeme name :input input :start start} (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 (caret source line-num start))
+ e)
+
+(defn runtime-error [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)
+  "no match: let binding" (let-no-match e)
+  "no match: match form" (match-no-match e)
+  "no match: when form" (generic-panic e)
+  "unbound name" (unbound-name e)
+  (generic-panic e))
+ e)

janet/interpreter.janet

@@ -0,0 +1,657 @@
+# A tree walk interpreter for ludus
+
+(import /src/base :as b)
+
+(var interpret nil)
+(var match-pattern nil)
+
+(defn- todo [msg] (error (string "not yet implemented: " msg)))
+
+(defn- resolve-name [name ctx]
+  # # (print "resolving " name " in:")
+  # # (pp ctx)
+  (when (not ctx) (break :^not-found))
+  (if (has-key? ctx name)
+    (ctx name)
+    (resolve-name name (ctx :^parent))))
+
+(defn- match-word [word value ctx]
+  (def name (word :data))
+  # # (print "matched " (b/show value) " to " name)
+  (set (ctx name) value)
+  {:success true :ctx ctx})
+
+(defn- typed [pattern value ctx]
+  (def [type-ast word] (pattern :data))
+  (def type (type-ast :data))
+  (if (= type (b/ludus/type value))
+    (match-word word value ctx)
+    {:success false :miss [pattern value]}))
+
+(defn- match-tuple [pattern value ctx]
+  (when (not (tuple? value))
+    (break {:success false :miss [pattern value]}))
+  (def val-len (length value))
+  (var members (pattern :data))
+  (when (empty? members)
+    (break (if (empty? value) 
+      {:success true :ctx ctx}
+      {:success false :miss [pattern value]})))
+  (def patt-len (length members))
+  (var splat nil)
+  (def splat? (= :splat ((last members) :type)))
+  (when splat?
+    (when (< val-len patt-len)
+  #     (print "mismatched splatted tuple lengths")
+      (break {:success false :miss [pattern value]}))
+  #   (print "splat!")
+    (set splat (last members))
+    (set members (slice members 0 (dec patt-len))))
+  (when (and (not splat?) (not= val-len patt-len))
+  #   (print "mismatched tuple lengths")
+    (break {:success false :miss [pattern value]}))
+  (var curr-mem :^nothing)
+  (var curr-val :^nothing)
+  (var success true)
+  (for i 0 (length members)
+    (set curr-mem (get members i))
+    (set curr-val (get value i))
+  #   (print "in tuple, matching " curr-val " with ")
+  #   (pp curr-mem)
+    (def match? (match-pattern curr-mem curr-val ctx))
+  #   (pp match?)
+    (when (not (match? :success))
+      (set success false)
+      (break)))
+  (when (and splat? (splat :data))
+    (def rest (array/slice value (length members)))
+    (match-word (splat :data) rest ctx))
+  (if success
+    {:success true :ctx ctx}
+    {:success false :miss [pattern value]}))
+
+(defn- match-list [pattern value ctx]
+  (when (not (array? value))
+    (break {:success false :miss [pattern value]}))
+  (def val-len (length value))
+  (var members (pattern :data))
+  (when (empty? members)
+    (break (if (empty? value) 
+      {:success true :ctx ctx}
+      {:success false :miss [pattern value]})))
+  (def patt-len (length members))
+  (var splat nil)
+  (def splat? (= :splat ((last members) :type)))
+  (when splat?
+    (when (< val-len patt-len)
+  #     (print "mismatched splatted list lengths")
+      (break {:success false :miss [pattern value]}))
+  #   (print "splat!")
+    (set splat (last members))
+    (set members (slice members 0 (dec patt-len))))
+  (when (and (not splat?) (not= val-len patt-len))
+  #   (print "mismatched list lengths")
+    (break {:success false :miss [pattern value]}))
+  (var curr-mem :^nothing)
+  (var curr-val :^nothing)
+  (var success true)
+  (for i 0 (length members)
+    (set curr-mem (get members i))
+    (set curr-val (get value i))
+  #   (print "in list, matching " curr-val " with ")
+  #   (pp curr-mem)
+    (def match? (match-pattern curr-mem curr-val ctx))
+  #   (pp match?)
+    (when (not (match? :success))
+      (set success false)
+      (break)))
+  (when (and splat? (splat :data))
+    (def rest (array/slice value (length members)))
+    (match-word (splat :data) rest ctx))
+  (if success
+    {:success true :ctx ctx}
+    {:success false :miss [pattern value]}))
+
+(defn- match-string [pattern value ctx]
+  (when (not (string? value))
+    (break {:success false :miss [pattern value]}))
+  (def {:compiled compiled :bindings bindings} pattern)
+  # (print "matching " value " with")
+  # (pp (pattern :grammar))
+  (def matches (peg/match compiled value))
+  (when (not matches) 
+    (break {:success false :miss [pattern value]}))
+  (when (not= (length matches) (length bindings))
+    (error "oops: different number of matches and bindings"))
+  (for i 0 (length matches)
+    (set (ctx (bindings i)) (matches i)))
+  {:success true :ctx ctx})
+
+(defn- match-dict [pattern value ctx]
+  (when (not (table? value))
+    (break {:success false :miss [pattern value]}))
+  (def val-size (length value))
+  (var members (pattern :data))
+  (def patt-len (length members))
+  (when (empty? members)
+    (break (if (empty? value)
+      {:success true :ctx ctx}
+      {:success false :miss [pattern value]})))
+  (var splat nil)
+  (def splat? (= :splat ((last members) :type)))
+  (when splat?
+    (when (< val-size patt-len)
+  #     (print "mismatched splatted dict lengths")
+      (break {:success false :miss [pattern value]}))
+  #   (print "splat!")
+    (set splat (last members))
+    (set members (slice members 0 (dec patt-len))))
+  (when (and (not splat?) (not= val-size patt-len))
+  #   (print "mismatched dict lengths")
+    (break {:success false :miss [pattern value]}))
+  (var success true)
+  (def matched-keys @[])
+  (for i 0 (length members)
+    (def curr-pair (get members i))
+    (def [curr-key curr-patt] (curr-pair :data))
+    (def key (interpret curr-key ctx))
+    (def curr-val (value key))
+    (def match? (match-pattern curr-patt curr-val ctx))
+    (array/push matched-keys key)
+    (when (not (match? :success))
+      (set success false)
+      (break)))
+  (when (and splat? (splat :data) success)
+    (def rest (merge value))
+    (each key matched-keys
+      (set (rest key) nil))
+    (match-word (splat :data) rest ctx))
+  (if success
+    {:success true :ctx ctx}
+    {:success false :miss [pattern value]}))
+
+
+(defn- match-pattern* [pattern value &opt ctx]
+  # (print "in match-pattern, matching " value " with:")
+  # (pp pattern)
+  (default ctx @{})
+  (def data (pattern :data))
+  (case (pattern :type)
+    # always match
+    :placeholder {:success true :ctx ctx}
+    :ignored {:success true :ctx ctx}
+    :word (match-word pattern value ctx)
+
+    # match on equality
+    :nil {:success (= :^nil value) :ctx ctx}
+    :bool {:success (= data value) :ctx ctx}
+    :number {:success (= data value) :ctx ctx}
+    :string {:success (= data value) :ctx ctx}
+    :keyword {:success (= data value) :ctx ctx}
+
+    # TODO: lists, dicts
+    :tuple (match-tuple pattern value ctx)
+    :list (match-list pattern value ctx)
+    :dict (match-dict pattern value ctx)
+  
+    :interpolated (match-string pattern value ctx)
+
+    :typed (typed pattern value ctx)
+  ))
+
+(set match-pattern match-pattern*)
+
+(defn- lett [ast ctx]
+  # (print "lett!")
+  # (pp ast)
+  (def [patt expr] (ast :data))
+  (def value (interpret expr ctx))
+  (def match? (match-pattern patt value))
+  (if (match? :success)
+    (do
+      (merge-into ctx (match? :ctx))
+      value)
+    (error {:node ast :value value :msg "no match: let binding"})))
+
+(defn- matchh [ast ctx]
+  (def [to-match clauses] (ast :data))
+  (def value (interpret to-match ctx))
+  (def len (length clauses))
+  (when (ast :match) (break ((ast :match) 0 value ctx)))
+  (defn match-fn [i value ctx]
+    (when (= len i)
+      (error {:node ast :value value :msg "no match: match form"}))
+    (def clause (clauses i))
+    (def [patt guard expr] clause)
+    (def match? (match-pattern patt value @{:^parent ctx}))
+    (when (not (match? :success)) 
+      (break (match-fn (inc i) value ctx)))
+    (def body-ctx (match? :ctx))
+    (def guard? (if guard
+      (b/bool (interpret guard body-ctx)) true))
+    (when (not guard?) 
+      (break (match-fn (inc i) value ctx)))
+    (interpret expr body-ctx))
+  (set (ast :match) match-fn)
+  (match-fn 0 value ctx))
+
+(defn- script [ast ctx]
+  (def lines (ast :data))
+  (def last-line (last lines))
+  (for i 0 (-> lines length dec) 
+    (interpret (lines i) ctx))
+  (interpret last-line ctx))
+
+(defn- block [ast parent]
+  (def lines (ast :data))
+  (def last-line (last lines))
+  (def ctx @{:^parent parent})
+  (for i 0 (-> lines length dec)
+    (interpret (lines i) ctx))
+  (interpret last-line ctx))
+
+(defn- to_string [ctx] (fn [x] 
+  (if (buffer? x) 
+    (string x)
+    (b/stringify (interpret x ctx)))))
+
+(defn- interpolated [ast ctx]
+  (def terms (ast :data))
+  (def interpolations (map (to_string ctx) terms))
+  (string/join interpolations))
+
+(defn- iff [ast ctx]
+  (def [condition then else] (ast :data))
+  (if (b/bool (interpret condition ctx))
+    (interpret then ctx)
+    (interpret else ctx)))
+
+# TODO: use a tail call here
+(defn- whenn [ast ctx]
+  (def clauses (ast :data))
+  (var result :^nothing)
+  (each clause clauses
+    (def [lhs rhs] clause)
+    (when (b/bool (interpret lhs ctx))
+      (set result (interpret rhs ctx))
+      (break)))
+  (when (= result :^nothing)
+    (error {:node ast :msg "no match: when form"}))
+  result)
+
+(defn- word [ast ctx]
+  (def resolved (resolve-name (ast :data) ctx))
+  (if (= :^not-found resolved)
+    (error {:node ast :msg "unbound name"})
+    resolved))
+
+(defn- tup [ast ctx]
+  (def members (ast :data))
+  (def the-tup @[])
+  (each member members
+    (array/push the-tup (interpret member ctx)))
+  [;the-tup])
+
+(defn- args [ast ctx]
+  (def members (ast :data))
+  (def the-args @[])
+  (each member members
+    (array/push the-args (interpret member ctx)))
+  (if (ast :partial)
+    {:^type :partial :args the-args}
+    [;the-args]))
+
+(defn- sett [ast ctx]
+  (def members (ast :data))
+  (def the-set @{:^type :set})
+  (each member members
+    (def value (interpret member ctx))
+    (set (the-set value) true))
+  the-set)
+
+(defn- list [ast ctx]
+  (def members (ast :data))
+  (def the-list @[])
+  (each member members
+    (if (= :splat (member :type))
+      (do
+        (def splatted (interpret (member :data) ctx))
+        (when (not= :array (type splatted))
+          (error {:node member :msg "cannot splat non-list into list"}))
+        (array/concat the-list splatted)) 
+      (array/push the-list (interpret member ctx))))
+  the-list)
+
+(defn- dict [ast ctx]
+  (def members (ast :data))
+  (def the-dict @{})
+  (each member members
+    (if (= :splat (member :type))
+      (do
+        (def splatted (interpret (member :data) ctx))
+        (when (or 
+            (not= :table (type splatted))
+            (:^type splatted))
+          (error {:node member :msg "cannot splat non-dict into dict"}))
+        (merge-into the-dict splatted))
+      (do
+        (def [key-ast value-ast] (member :data))
+  #       (print "dict key")
+  #       (pp key-ast)
+  #       (print "dict value")
+  #       (pp value-ast)
+        (def key (interpret key-ast ctx))
+        (def value (interpret value-ast ctx))
+        (set (the-dict key) value))))
+  the-dict)
+
+(defn- box [ast ctx]
+  (def {:data value-ast :name name} ast)
+  (def value (interpret value-ast ctx))
+  (def box @{:^type :box :^value value :name name})
+  (set (ctx name) box)
+  box)
+
+(defn- repeatt [ast ctx]
+  (def [times-ast body] (ast :data))
+  (def times (interpret times-ast ctx))
+  (when (not (number? times))
+    (error {:node times-ast :msg (string "repeat needs a `number` of times; you gave me a " (type times))}))
+  (repeat times (interpret body ctx)))
+
+(defn- panic [ast ctx]
+  (def info (interpret (ast :data) ctx))
+  (error {:node ast :msg info}))
+
+# TODO: add docstrings & pattern docs to fns
+# Depends on: good string representation of patterns
+# For now, this should be enough to tall the thing
+(defn- fnn [ast ctx]
+  (def {:name name :data clauses :doc doc} ast)
+  # (print "defining fn " name)
+  (def closure (merge ctx))
+  (def the-fn @{:name name :^type :fn :body clauses :ctx closure :doc doc})
+  (when (not= :^not-found (resolve-name name ctx))
+  #   (print "fn "name" was forward declared")
+    (def fwd (resolve-name name ctx))
+    (set (fwd :body) clauses)
+    (set (fwd :ctx) closure)
+    (set (fwd :doc) doc)
+  #   (print "fn " name " has been defined")
+  #   (pp fwd)
+    (break fwd))
+  # (pp the-fn)
+  (set (closure name) the-fn)
+  (set (ctx name) the-fn)
+  the-fn)
+
+(defn- is_placeholder [x] (= x :_))
+
+(var call-fn nil)
+
+(defn- partial [root-ast the-fn partial-args] 
+  (when (the-fn :applied)
+    (error {:msg "cannot partially apply a partially applied function"
+      :node root-ast :called the-fn :args partial-args}))
+  # (print "calling partially applied function")
+  (def args (partial-args :args))
+  # (pp args)
+  (def pos (find-index is_placeholder args))
+  (def name (string (the-fn :name) " *partial*"))
+  (defn partial-fn [root-ast missing]
+  #   (print "calling function with arg " (b/show missing))
+  #   (pp partial-args)
+    (def full-args (array/slice args))
+    (set (full-args pos) missing)
+  #   (print "all args: " (b/show full-args))
+    (call-fn root-ast the-fn [;full-args]))
+  {:^type :fn :applied true :name name :body partial-fn})
+
+(defn- call-fn* [root-ast the-fn args]
+   # (print "on line " (get-in root-ast [:token :line]))
+   # (print "calling " (b/show the-fn))
+   # (print "with args " (b/show args))
+   # (pp args)
+  (when (or 
+    (= :function (type the-fn)) 
+    (= :cfunction (type the-fn))) 
+  #     (print "Janet function")
+      (break (the-fn ;args)))
+  (def clauses (the-fn :body))
+  (when (= :nothing clauses)
+    (error {:node root-ast :called the-fn :value args :msg "cannot call function before it is defined"}))
+  (when (= :function (type clauses))
+    (break (clauses root-ast ;args)))
+  (def len (length clauses))
+  (when (the-fn :match) (break ((the-fn :match) root-ast 0 args)))
+  (defn match-fn [root-ast i args]
+    (when (= len i)
+      (error {:node root-ast :called the-fn :value args :msg "no match: function call"}))
+    (def clause (clauses i))
+    (def [patt guard expr] clause)
+    (def match?
+      (match-pattern patt args @{:^parent (the-fn :ctx)}))
+    (when (not (match? :success)) 
+      (break (match-fn root-ast (inc i) args)))
+  #   (print "matched!")
+    (def body-ctx (match? :ctx))
+    (def guard? (if guard
+      (b/bool (interpret guard body-ctx)) true))
+  #   (print "passed guard")
+    (when (not guard?) 
+      (break (match-fn root-ast (inc i) args)))
+    (interpret expr body-ctx))
+  (set (the-fn :match) match-fn)
+  (match-fn root-ast 0 args))
+
+(set call-fn call-fn*)
+
+(defn- call-partial [root-ast the-fn arg] ((the-fn :body) root-ast ;arg))
+
+(defn- apply-synth-term [root-ast prev curr]
+  # (print "applying " (b/show prev))
+  # (print "to" (b/show curr))
+  (def types [(b/ludus/type prev) (b/ludus/type curr)])
+  # (print "typle:")
+  # (pp types)
+  (match types
+    [:fn :tuple] (call-fn root-ast prev curr)
+    [:fn :partial] (partial root-ast prev curr)
+    [:function :tuple] (call-fn root-ast prev curr)
+    # [:applied :tuple] (call-partial root-ast prev curr)
+    [:keyword :args] (get (first curr) prev :^nil)
+    [:keyword :tuple] (get (first curr) prev :^nil)
+    [:dict :keyword] (get prev curr :^nil)
+    [:nil :keyword] :^nil
+    [:pkg :keyword] (get prev curr :^nil)
+    [:pkg :pkg-kw] (get prev curr :^nil)
+    (error (string "cannot call " (b/ludus/type prev) " `" (b/show prev) "`"))))
+
+(defn- synthetic [ast ctx]
+  (def terms (ast :data))
+  # (print "interpreting synthetic")
+  # (pp ast)
+  # (pp terms)
+  (def first-term (first terms))
+  (def last-term (last terms))
+   (var prev (interpret first-term ctx))
+  # (print "root term: ")
+  # (pp prev)
+  (for i 1 (-> terms length dec)
+    (def curr (interpret (terms i) ctx))
+  #   (print "term " i ": " curr)
+    (set prev (apply-synth-term first-term prev curr)))
+  # (print "done with inner terms, applying last term")
+  (apply-synth-term first-term prev (interpret last-term ctx)))
+
+(defn- doo [ast ctx] 
+  (def terms (ast :data))
+  (var prev (interpret (first terms) ctx))
+  (def last-term (last terms))
+  (for i 1 (-> terms length dec)
+    (def curr (interpret (terms i) ctx))
+    (set prev (apply-synth-term (first terms) curr [prev])))
+  (def last-fn (interpret last-term ctx))
+  (apply-synth-term (first terms) last-fn [prev]))
+
+(defn- pkg [ast ctx] 
+  (def members (ast :data))
+  (def the-pkg @{:^name (ast :name) :^type :pkg})
+  (each member members
+    (def [key-ast value-ast] (member :data))
+    (def key (interpret key-ast ctx))
+    (def value (interpret value-ast ctx))
+    (set (the-pkg key) value))
+  # (pp the-pkg)
+  (def out (table/to-struct the-pkg))
+  (set (ctx (ast :name)) out)
+  out)
+
+(defn- loopp [ast ctx]
+  # (print "looping!")
+  (def data (ast :data))
+  (def args (interpret (data 0) ctx))
+  # 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))
+  (var loop-ctx @{:^parent ctx})
+  (defn match-fn [i args]
+    (when (= len i)
+      (error {:node ast :value args :msg "no match: loop"}))
+    (def clause (clauses i))
+    (def [patt guard expr] clause)
+    (def match?
+      (match-pattern patt args loop-ctx))
+    (when (not (match? :success))
+  #     (print "no match")
+      (break (match-fn (inc i) args)))
+  #   (print "matched!")
+    (def body-ctx (match? :ctx))
+    (def guard? (if guard
+      (b/bool (interpret guard body-ctx)) true))
+  #   (print "passed guard")
+    (when (not guard?) 
+      (break (match-fn (inc i) args)))
+    (interpret expr body-ctx))
+  (set (ast :match) match-fn)
+  (set (loop-ctx :^recur) match-fn)
+  # (print "ATTACHED MATCH-FN")
+  (match-fn 0 args))
+
+(defn- recur [ast ctx]
+  # (print "recurring!")
+  (def passed (ast :data))
+  (def args (interpret passed ctx))
+  (def match-fn (resolve-name :^recur ctx))
+  # (print "match fn in ctx:")
+  # (pp (ctx :^recur))
+  # (pp match-fn)
+  # (pp ctx)
+  (match-fn 0 args))
+
+# TODO for 0.1.0
+(defn- testt [ast ctx] (todo "test"))
+
+(defn- ns [ast ctx] (todo "nses"))
+
+(defn- importt [ast ctx] (todo "imports"))
+
+(defn- withh [ast ctx] (todo "with"))
+
+(defn- usee [ast ctx] (todo "use"))
+
+(defn- interpret* [ast ctx]
+  # (print "interpreting node " (ast :type))
+  (case (ast :type)
+    # literals
+    :nil :^nil
+    :number (ast :data)
+    :bool (ast :data)
+    :string (ast :data)
+    :keyword (ast :data)
+    :placeholder :_
+
+    # collections
+    :tuple (tup ast ctx)
+    :args (args ast ctx)
+    :list (list ast ctx)
+    :set (sett ast ctx)
+    :dict (dict ast ctx)
+
+    # composite forms
+    :if (iff ast ctx)
+    :block (block ast ctx)
+    :when (whenn ast ctx)
+    :script (script ast ctx)
+    :panic (panic ast ctx)
+
+    # looping forms
+    :loop (loopp ast ctx)
+    :recur (recur ast ctx)
+    :repeat (repeatt ast ctx)
+
+    # named/naming forms
+    :word (word ast ctx)
+    :interpolated (interpolated ast ctx)
+    :box (box ast ctx)
+    :pkg (pkg ast ctx)
+    :pkg-name (word ast ctx)
+
+    # patterned forms
+    :let (lett ast ctx)
+    :match (matchh ast ctx)
+
+    # functions
+    :fn (fnn ast ctx)
+
+    # synthetic
+    :synthetic (synthetic ast ctx)
+
+    # do
+    :do (doo ast ctx)
+
+    # deferred until after computer class
+    # :with (withh ast ctx)
+    # :import (importt ast ctx)
+    # :ns (ns ast ctx)
+    # :use (usee ast ctx)
+    # :test (testt ast ctx)
+
+    ))
+
+(set interpret interpret*)
+
+# # repl
+# (import /src/scanner :as s)
+# (import /src/parser :as p)
+# (import /src/validate :as v) 
+
+# (var source nil)
+
+# (defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
+
+# (defn run []
+#   (def scanned (s/scan source))
+#   (when (has-errors? scanned) (break (scanned :errors)))
+#   (def parsed (p/parse scanned))
+#   (when (has-errors? parsed) (break (parsed :errors)))
+#   (def validated (v/valid parsed b/ctx))
+#   # (when (has-errors? validated) (break (validated :errors)))
+#   # (def cleaned (get-in parsed [:ast :data 1]))
+#   # # (pp cleaned)
+#   (interpret (parsed :ast) @{:^parent b/lett})
+#   # (try (interpret (parsed :ast) @{:^parent b/ctx})
+#   #   ([e] (if (struct? e) (error (e :msg)) (error e))))
+#   )
+
+# # (do 
+# (comment
+# (set source `
+# let foo = 42
+# "{foo} bar baz"
+# `)
+# (def result (run))
+# )
+

janet/json.janet

@@ -0,0 +1,131 @@
+# pulled from cfiggers/jayson
+
+(defmacro- letv [bindings & body]
+  ~(do ,;(seq [[k v] :in (partition 2 bindings)] ['var k v]) ,;body))
+
+(defn- read-hex [n] 
+    (scan-number (string "0x" n)))
+
+(defn- check-utf-16 [capture]
+  (let [u (read-hex capture)]
+    (if (and (>= u 0xD800)
+             (<= u 0xDBFF))
+      capture 
+      false)))
+
+(def- utf-8->bytes 
+  (peg/compile
+   ~{:double-u-esc (/ (* "\\u" (cmt (<- 4) ,|(check-utf-16 $)) "\\u" (<- 4))
+                      ,|(+ (blshift (- (read-hex $0) 0xD800) 10)
+                           (- (read-hex $1) 0xDC00) 0x10000))
+     :single-u-esc (/ (* "\\u" (<- 4)) ,|(read-hex $))
+     :unicode-esc  (/ (+ :double-u-esc :single-u-esc)
+                      ,|(string/from-bytes
+                         ;(cond
+                           (<= $ 0x7f) [$]
+                           (<= $ 0x7ff)
+                           [(bor (band (brshift $  6) 0x1F) 0xC0)
+                            (bor (band (brshift $  0) 0x3F) 0x80)]
+                           (<= $ 0xffff)
+                           [(bor (band (brshift $ 12) 0x0F) 0xE0)
+                            (bor (band (brshift $  6) 0x3F) 0x80)
+                            (bor (band (brshift $  0) 0x3F) 0x80)]
+                             # Otherwise
+                           [(bor (band (brshift $ 18) 0x07) 0xF0)
+                            (bor (band (brshift $ 12) 0x3F) 0x80)
+                            (bor (band (brshift $  6) 0x3F) 0x80)
+                            (bor (band (brshift $  0) 0x3F) 0x80)])))
+     :escape       (/ (* "\\" (<- (set "avbnfrt\"\\/")))
+                      ,|(get {"a" "\a" "v" "\v" "b" "\b"
+                              "n" "\n" "f" "\f" "r" "\r"
+                              "t" "\t"} $ $))
+     :main         (+ (some (+ :unicode-esc :escape (<- 1))) -1)}))
+
+(defn decode 
+  ``
+  Returns a janet object after parsing JSON. If `keywords` is truthy,
+  string keys will be converted to keywords. If `nils` is truthy, `null`
+  will become `nil` instead of the keyword `:json/null`.
+  ``
+  [json-source &opt keywords nils] 
+
+  (def json-parser 
+    {:null (if nils
+             ~(/ (<- (+ "null" "Null")) nil)
+             ~(/ (<- (+ "null" "Null")) :json/null))
+     :bool-t ~(/ (<- (+ "true")) true)
+     :bool-f ~(/ (<- (+ "false")) false)
+     :number ~(/ (<- (* (? "-") :d+ (? (* "." :d+)))) ,|(scan-number $))
+     :string ~(/ (* "\"" (<- (to (* (> -1 (not "\\")) "\"")))
+                    (* (> -1 (not "\\")) "\""))
+                 ,|(string/join (peg/match utf-8->bytes $))) 
+     :array ~(/ (* "[" :s* (? (* :value (any (* :s* "," :value)))) "]") ,|(array ;$&))
+     :key-value (if keywords
+                  ~(* :s* (/ :string ,|(keyword $)) :s* ":" :value)
+                  ~(* :s* :string :s* ":" :value))
+     :object ~(/ (* "{" :s* (? (* :key-value (any (* :s* "," :key-value)))) "}")
+                 ,|(from-pairs (partition 2 $&)))
+     :value ~(* :s* (+ :null :bool-t :bool-f :number :string :array :object) :s*)
+     :unmatched ~(/ (<- (to (+ :value -1))) ,|[:unmatched $])
+     :main ~(some (+ :value "\n" :unmatched))})
+  
+  (first (peg/match (peg/compile json-parser) json-source)))
+
+(def- bytes->utf-8
+  (peg/compile
+   ~{:four-byte  (/ (* (<- (range "\xf0\xff")) (<- 1) (<- 1) (<- 1))
+                    ,|(bor (blshift (band (first $0) 0x07) 18)
+                           (blshift (band (first $1) 0x3F) 12)
+                           (blshift (band (first $2) 0x3F) 6)
+                           (blshift (band (first $3) 0x3F) 0)))
+     :three-byte (/ (* (<- (range "\xe0\xef")) (<- 1) (<- 1))
+                    ,|(bor (blshift (band (first $0) 0x0F) 12)
+                           (blshift (band (first $1) 0x3F) 6)
+                           (blshift (band (first $2) 0x3F) 0)))
+     :two-byte   (/ (* (<- (range "\x80\xdf")) (<- 1))
+                    ,|(bor (blshift (band (first $0) 0x1F) 6)
+                           (blshift (band (first $1) 0x3F) 0)))
+     :multi-byte (/ (+ :two-byte :three-byte :four-byte)
+                    ,|(if (< $ 0x10000) 
+                        (string/format "\\u%04X" $)
+                        (string/format "\\u%04X\\u%04X" 
+                                       (+ (brshift (- $ 0x10000) 10) 0xD800) 
+                                       (+ (band (- $ 0x10000) 0x3FF) 0xDC00))))
+     :one-byte   (<- (range "\x20\x7f"))
+     :0to31      (/ (<- (range "\0\x1F"))
+                    ,|(or ({"\a" "\\u0007" "\b" "\\u0008"
+                            "\t" "\\u0009" "\n" "\\u000A"
+                            "\v" "\\u000B" "\f" "\\u000C"
+                            "\r" "\\u000D"} $)
+                          (string/format "\\u%04X" (first $))))
+     :backslash  (/ (<- "\\") "\\\\")
+     :quote      (/ (<- "\"") "\\\"")
+     :main       (+ (some (+ :0to31 :backslash :quote :one-byte :multi-byte)) -1)}))
+
+(defn- encodeone [x depth]
+  (if (> depth 1024) (error "recurred too deeply"))
+  (cond
+    (= x :json/null) "null"
+    (= x nil) "null"
+    (bytes? x) (string "\"" (string/join (peg/match bytes->utf-8 x)) "\"")
+    (indexed? x) (string "[" (string/join (map |(encodeone $ (inc depth)) x) ",") "]")
+    (dictionary? x) (string "{" (string/join
+                                 (seq [[k v] :in (pairs x)]
+                                   (string "\"" (string/join (peg/match bytes->utf-8 k)) "\"" ":" (encodeone v (inc depth)))) ",") "}")
+    (case (type x)
+      :nil "null"
+      :boolean (string x)
+      :number (string x)
+      (error "type not supported"))))
+
+(defn encode 
+  `` 
+  Encodes a janet value in JSON (utf-8). If `buf` is provided, the formated 
+  JSON is append to `buf` instead of a new buffer. Returns the modifed buffer.
+  ``
+  [x &opt buf]
+  
+  (letv [ret (encodeone x 0)]
+        (if (and buf (buffer? buf))
+          (buffer/push ret)
+          (thaw ret))))

janet/ludus.janet

@@ -0,0 +1,110 @@
+# an integrated Ludus interpreter
+# devised in order to run under wasm
+# takes a string, returns a string with a json object
+# (try (os/cd "janet") ([_] nil)) # for REPL
+(import /src/scanner :as s)
+(import /src/parser :as p)
+(import /src/validate :as v)
+(import /src/interpreter :as i)
+(import /src/errors :as e)
+(import /src/base :as b)
+(import /src/prelude :as prelude)
+(import /src/json :as j)
+
+(defn ludus [source]
+ # if we can't load prelude, bail
+ (when (= :error prelude/pkg) (error "could not load prelude"))
+
+ # get us a clean working slate
+ (def ctx @{:^parent prelude/ctx})
+ (def errors @[])
+ (var result @"")
+ (def console @"")
+
+ # capture all `print`s
+ (setdyn :out console)
+
+ # an output table
+ # this will change: the shape of our output
+ # at the moment, there's only one stack of turtle graphics
+ # we will be getting more
+ (def out @{:errors errors :result result 
+  :io @{
+   :stdout @{:proto [:text-stream "0.1.0"] :data console} 
+   :turtle @{:proto [:turtle-graphics "0.1.0"] :data @[]}}})
+
+ ### start the program
+ # first, scanning
+ (def scanned (s/scan source))
+ (when (any? (scanned :errors))
+   (each err (scanned :errors)
+    (e/scan-error err))
+   (break (-> out j/encode string)))
+ # then, parsing
+ (def parsed (p/parse scanned))
+ (when (any? (parsed :errors))
+  (each err (parsed :errors)
+   (e/parse-error err))
+  (break (-> out j/encode string)))
+ # then, validation
+ (def validated (v/valid parsed ctx))
+ (when (any? (validated :errors))
+  (each err (validated :errors)
+   (e/validation-error err))
+  (break (-> out j/encode string)))
+ # and, finally, try interpreting the program
+ (try (do
+  # we need to do this every run or we get the very same sequence of "random" numbers every time we run a program
+  (math/seedrandom (os/cryptorand 8))
+  (set result (i/interpret (parsed :ast) ctx)))
+  ([err] 
+   (e/runtime-error err)
+   (break (-> out j/encode string))))
+
+ # stop capturing output
+ (setdyn :out stdout)
+
+ # update our output table with our output
+ (set (out :result) (b/show result))
+ (set (((out :io) :turtle) :data) (get-in prelude/pkg [:turtle_commands :^value]))
+
+ # run the "postlude": any Ludus code that needs to run after each program
+ # right now this is just resetting the boxes that hold turtle commands and state
+ (try
+  (i/interpret prelude/post/ast ctx)
+  ([err] (e/runtime-error err)))
+
+ # json-encode our output table, and convert it from a buffer to a string (which we require for playing nice with WASM/C)
+ (-> out j/encode string))
+
+#### REPL
+(comment
+# (do
+ (def start (os/clock))
+ (def source `
+ 
+fn fib {
+    (1) -> 1
+    (2) -> 1
+    (n) -> add (
+        fib (sub (n, 1))
+        fib (sub (n, 2))
+    )
+}
+
+fib (30)
+ `)
+ (def out (-> source 
+  ludus
+  j/decode
+  ))
+ (def end (os/clock))
+ (setdyn :out stdout)
+ (pp out)
+ (def console (out "console"))
+ (print console)
+ (def result (out "result"))
+ (print result)
+ (print (- end start))
+)
+

janet/prelude.janet

@@ -0,0 +1,42 @@
+(import /src/base :as b)
+(import /src/scanner :as s)
+(import /src/parser :as p)
+(import /src/validate :as v)
+(import /src/interpreter :as i)
+(import /src/errors :as e)
+
+(def pkg (do 
+  (def pre-ctx @{:^parent {"base" b/base}})
+  (def pre-src (slurp "../assets/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 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 (pre-parsed :ast) pre-ctx)
+   ([err] (e/runtime-error err) :error))))
+
+(def ctx (do
+  (def ctx @{})
+  (each [k v] (pairs pkg)
+    (set (ctx (string k)) v))
+  (set (ctx "^name") nil)
+  (set (ctx "^type") nil)
+  ctx))
+
+(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 :ast)))
+

janet/project.janet

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

janet/scanner.janet

@@ -0,0 +1,355 @@
+(def reserved-words
+  "List of Ludus reserved words."
+  ## see ludus-spec repo for more info
+  {
+   "as" :as ## impl
+   "box" :box
+   "do" :do ## impl
+   "else" :else ## impl
+   "false" :false ## impl -> literal word
+   "fn" :fn ## impl
+   "if" :if ## impl
+   "import" :import ## impl
+   "let" :let ## impl
+   "loop" :loop ## impl
+   "match" :match ## impl
+   "nil" :nil ## impl -> literal word
+   "ns" :ns ## impl
+   "panic!" :panic ## impl (should _not_ be a function)
+   "pkg" :pkg
+   "recur" :recur ## impl   
+   "repeat" :repeat ## impl
+   "test" :test
+   "then" :then ## impl
+   "true" :true ## impl -> literal word
+   "use" :use ## wip
+   "when" :when ## impl, replaces cond
+   "with" :with ## impl  
+  })
+
+(def literal-words {"true" true
+                    "false" false
+                    "nil" nil
+                    })
+
+(defn- new-scanner
+  "Creates a new scanner."
+  [source input]
+  @{:source source
+   :input input
+   :length (length source)
+   :errors @[]
+   :start 0
+   :current 0
+   :line 1
+   :tokens @[]})
+
+(defn- at-end?
+  "Tests if a scanner is at end of input."
+  [scanner]
+  (>= (get scanner :current) (get scanner :length)))
+
+(defn- current-char
+  "Gets the current character of the scanner."
+  [scanner]
+  (let [source (get scanner :source)
+        current (get scanner :current)
+        length (length source)]
+    (if (>= current length)
+      nil
+      (string/from-bytes (get source current)))))
+
+(defn- advance
+  "Advances the scanner by a single character."
+  [scanner]
+  (update scanner :current inc))
+
+(defn- next-char
+  "Gets the next character from the scanner."
+  [scanner]
+  (let [source (get scanner :source)
+    current (get scanner :current)
+    next (inc current)
+    length (length source)]
+    (if (>= next length)
+      nil
+      (string/from-bytes (get source next)))))
+
+(defn- current-lexeme
+  [scanner]
+  (slice (get scanner :source) (get scanner :start) (get scanner :current)))
+
+(defn- char-code [char] (get char 0))
+
+(defn- char-in-range? [start end char]
+  (and char
+    (>= (char-code char) (char-code start))
+    (<= (char-code char) (char-code end))))
+
+(defn- digit? [c]
+  (char-in-range? "0" "9" c))
+
+(defn- nonzero-digit? [c]
+  (char-in-range? "1" "9" c))
+
+## for now, use very basic ASCII charset in words
+## TODO: research the implications of using the whole 
+## (defn- alpha? [c] (boolean (re-find #"\p{L}" (string c))))
+(defn- alpha? [c]
+  (or (char-in-range? "a" "z" c) (char-in-range? "A" "Z" c)))
+
+(defn- lower? [c] (char-in-range? "a" "z" c))
+
+(defn- upper? [c] (char-in-range? "A" "Z" c))
+
+## legal characters in words
+(def word-chars {"_" true "?" true "!" true "*" true "/" true})
+
+(defn- word-char? [c]
+  (or (alpha? c) (digit? c) (get word-chars c)))
+
+(defn- whitespace? [c]
+  (or (= c " ") (= c "\t")))
+
+(def terminators {
+":" true
+";" true
+"\n" true
+"{" true
+"}" true
+"(" true
+")" true
+"[" true
+"]" true
+"$" true
+"#" true
+"-" true
+"=" true
+"&" true
+"," true
+">" true
+"\"" true})
+
+(defn- terminates? [c]
+  (or (nil? c) (whitespace? c) (get terminators c)))
+
+(defn- add-token
+  [scanner token-type &opt literal]
+   (update scanner :tokens array/push
+      {:type token-type
+       :lexeme (current-lexeme scanner)
+       :literal literal
+       :line (get scanner :line)
+       :start (get scanner :start)
+       :source (get scanner :source)
+       :input (get scanner :input)}))
+
+## TODO: errors should also be in the vector of tokens
+## The goal is to be able to be able to hand this to an LSP?
+## Do we need a different structure
+(defn- add-error [scanner msg]
+  (let [token {:type :error
+               :lexeme (current-lexeme scanner)
+               :literal nil
+               :line (get scanner :line)
+               :start (get scanner :start)
+               :source (get scanner :source)
+               :input (get scanner :input)
+               :msg msg}]
+    (-> scanner
+      (update :errors array/push token)
+      (update :tokens array/push token))))
+
+(defn- add-keyword
+  [scanner]
+  (defn recur [scanner key]
+    (let [char (current-char scanner)]
+      (cond
+        (terminates? char) (add-token scanner :keyword (keyword key))
+        (word-char? char) (recur (advance scanner) (string key char))
+        :else (add-error scanner (string "Unexpected " char "after keyword :" key)))))
+	(recur scanner ""))
+
+(defn- add-pkg-kw [scanner]
+  (defn recur [scanner key]
+    (let [char (current-char scanner)]
+      (cond
+        (terminates? char) (add-token scanner :pkg-kw (keyword key))
+        (word-char? char) (recur (advance scanner) (string key char))
+        :else (add-error scanner (string "Unexpected " char " after pkg keyword :" key)))))
+  (recur scanner ""))
+
+(defn- read-literal [lit] (-> lit parse-all first))
+
+### TODO: consider whether Janet's number rules are right for Ludus
+(defn- add-number [char scanner]
+  (defn recur [scanner num float?]
+    (let [curr (current-char scanner)]
+      (cond
+        (= curr "_") (recur (advance scanner) num float?) ## consume underscores unharmed
+        (= curr ".") (if float?
+                      (add-error scanner (string "Unexpected second decimal point after " num "."))
+                      (recur (advance scanner) (buffer/push num curr) true))
+        (terminates? curr) (add-token scanner :number (read-literal num))
+        (digit? curr) (recur (advance scanner) (buffer/push num curr) float?)
+        :else (add-error scanner (string "Unexpected " curr " after number " num ".")))))
+  (recur scanner (buffer char) false))
+
+(def escape {
+  "\"" "\""
+  "n" "\n"
+  "{" "{"
+  "t" "\t"
+  "r" "\r"
+  "\\" "\\"
+})
+
+(defn- add-string
+  [scanner]
+  (defn recur [scanner buff interpolate?]
+    (let [char (current-char scanner)]
+      (case char
+        "{" (recur (advance scanner) (buffer/push buff char) true)
+        # allow multiline strings
+        "\n" (recur (update (advance scanner) :line inc) (buffer/push buff char) interpolate?)
+        "\"" (add-token (advance scanner) (if interpolate? :interpolated :string) (string buff))
+        "\\" (let [next (next-char scanner)]
+                (recur 
+                  (advance (advance scanner)) 
+                  (buffer/push buff (get escape next next))
+                  interpolate?))
+        (if (at-end? scanner)
+          (add-error scanner "Unterminated string.")
+          (recur (advance scanner) (buffer/push buff char) interpolate?)))))
+  (recur scanner @"" false))
+
+(defn- add-word
+  [char scanner]
+  (defn recur [scanner word]
+    (let [curr (current-char scanner)]
+      (cond
+        (terminates? curr) (add-token scanner
+                             (get reserved-words (string word) :word) 
+                             (get literal-words (string word) :none))
+        (word-char? curr) (recur (advance scanner) (buffer/push word curr))
+        :else (add-error scanner (string "Unexpected " curr " after word " word ".")))))
+  (recur scanner (buffer char)))
+
+(defn- add-pkg
+  [char scanner]
+  (defn recur [scanner pkg]
+    (let [curr (current-char scanner)]
+      (cond
+        (terminates? curr) (add-token scanner :pkg-name :none)
+        (word-char? curr) (recur (advance scanner) (buffer/push pkg curr))
+        :else (add-error scanner (string "unexpected " curr " after pkg name " pkg)))))
+  (recur scanner (buffer char)))
+
+(defn- add-ignored
+  [scanner]
+  (defn recur [scanner ignored]
+    (let [char (current-char scanner)]
+      (cond
+        (terminates? char) (add-token scanner :ignored)
+        (word-char? char) (recur (advance scanner) (buffer/push ignored char))
+        :else (add-error scanner (string "Unexpected " char " after word " ignored ".")))))
+  (recur scanner @"_"))
+
+(defn- add-comment [char scanner]
+  (defn recur [scanner comm]
+    (let [char (current-char scanner)]
+      (if (or (= "\n" char) (at-end? scanner))
+        scanner # for now, we don't do anything with comments; can be added later
+        (recur (advance scanner) (buffer/push comm char)))))
+  (recur scanner (buffer char)))
+
+(defn- scan-token [scanner]
+  (let [char (current-char scanner)
+        scanner (advance scanner)
+        next (current-char scanner)]
+    (case char
+      ## one-character tokens
+      ## :break is a special zero-char token before closing braces
+      ## it makes parsing much simpler
+      "(" (add-token scanner :lparen)
+      ")" (add-token (add-token scanner :break) :rparen)
+      "{" (add-token scanner :lbrace)
+      "}" (add-token (add-token scanner :break) :rbrace)
+      "[" (add-token scanner :lbracket)
+      "]" (add-token (add-token scanner :break) :rbracket)
+      ";" (add-token scanner :semicolon)
+      "," (add-token scanner :comma)
+      "\n" (add-token (update scanner :line inc) :newline)
+      "\\" (add-token scanner :backslash)
+      "=" (add-token scanner :equals)
+      ">" (add-token scanner :pipeline)
+
+      ## two-character tokens
+      ## ->
+      "-" (cond
+           (= next ">") (add-token (advance scanner) :arrow)
+           (digit? next) (add-number char scanner)
+           :else (add-error scanner (string "Expected > or negative number after `-`. Got `" char next "`")))
+
+      ## dict #{
+      "#" (if (= next "{")
+           (add-token (advance scanner) :startdict)
+           (add-error scanner (string "Expected beginning of dict: #{. Got " char next)))
+
+      ## set ${
+      "$" (if (= next "{")
+           (add-token (advance scanner) :startset)
+           (add-error scanner (string "Expected beginning of set: ${. Got " char next)))
+
+      ## placeholders
+      ## there's a flat _, and then ignored words
+      "_" (cond
+           (terminates? next) (add-token scanner :placeholder)
+           (alpha? next) (add-ignored scanner)
+           :else (add-error scanner (string "Expected placeholder: _. Got " char next)))
+
+      ## comments
+      ## & starts an inline comment
+      "&" (add-comment char scanner)
+
+      ## keywords
+      # XXX: make sure we want only lower-only keywords
+      ":" (cond
+           (lower? next) (add-keyword scanner)
+           (upper? next) (add-pkg-kw scanner)
+           :else (add-error scanner (string "Expected keyword or pkg keyword. Got " char next)))
+
+      ## splats
+      "." (let [after_next (current-char (advance scanner))]
+           (if (= ".." (string next after_next))
+             (add-token (advance scanner) :splat)
+             (add-error scanner (string "Expected splat: ... . Got " (string "." next after_next)))))
+
+      ## strings
+      "\"" (add-string scanner)
+
+      ## word matches
+      (cond
+        (whitespace? char) scanner ## for now just skip whitespace characters
+        (digit? char) (add-number char scanner)
+        (upper? char) (add-pkg char scanner) 
+        (lower? char) (add-word char scanner)
+        :else (add-error scanner (string "Unexpected character: " char))))))
+
+(defn- next-token [scanner]
+  (put scanner :start (get scanner :current)))
+
+(defn scan [source &opt input]
+  (default input :input)
+  (defn recur [scanner]
+    (if (at-end? scanner)
+      (let [scanner (add-token (add-token scanner :break) :eof)]
+        {:tokens (get scanner :tokens)
+         :errors (get scanner :errors [])})
+      (recur (-> scanner (scan-token) (next-token)))))
+  (recur (new-scanner source input)))
+
+# (comment
+(do
+  (def source "    -123  ")
+  (length ((scan source) :tokens)))

janet/validate.janet

@@ -0,0 +1,793 @@
+### A validator for a Ludus AST
+
+(comment
+
+Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish:
+
+* [x] ensure called keywords are only called w/ one arg
+* [x] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
+ - [x] accept pkg-kws
+* [x] validate dict patterns
+* [x] compile string-patterns
+* [x] `loop` form arity checking
+* [x] arity checking of explicit named function calls
+* [x] flag tail calls
+* [x] no re-bound names
+* [x] no unbound names
+* [x] no unbound names with `use` forms
+* [x] recur in tail position in `loop` forms
+* [x] recur not called outside of `loop` forms
+* [x] splats come at the end of list, tuple, and dict patterns
+
+Deferred until a later iteration of Ludus:
+* [ ] no circular imports DEFERRED
+* [ ] correct imports DEFERRED
+* [ ] validate `with` forms
+)
+
+(def- package-registry @{})
+
+# (try (os/cd "janet") ([_] nil))
+(import ./scanner :as s)
+(import ./parser :as p)
+
+(defn- new-validator [parser]
+ (def ast (parser :ast))
+ @{:ast ast
+ :errors @[]
+ :ctx @{}
+ :status @{}}
+)
+
+(var validate nil)
+
+(def terminals [:number :string :bool :nil :placeholder])
+
+(def simple-colls [:list :tuple :set :args])
+
+(defn- simple-coll [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (each node data 
+  (set (validator :ast) node)
+  (validate validator))
+ validator)
+
+(defn- iff [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (each node data
+  (set (validator :ast) node)
+  (validate validator))
+ validator)
+
+(defn- script [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (def status (validator :status))
+ (set (status :toplevel) true)
+ (each node data
+  (set (validator :ast) node)
+  (validate validator))
+ validator)
+
+(defn- block [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (when (= 0 (length data))
+  (array/push (validator :errors)
+   {:node ast :msg "blocks may not be empty"})
+  (break validator))
+ (def status (validator :status))
+ (set (status :toplevel) nil)
+ (def tail? (status :tail))
+ (set (status :tail) false)
+ (def parent (validator :ctx))
+ (def ctx @{:^parent parent})
+ (set (validator :ctx) ctx)
+ (for i 0 (-> data length dec)
+  (set (validator :ast) (data i))
+  (validate validator))
+ (set (status :tail) tail?)
+ (set (validator :ast) (last data))
+ (validate validator)
+ (set (validator :ctx) parent)
+ validator)
+
+(defn- resolve-local [ctx name]
+ (get ctx name))
+
+(defn- resolve-name [ctx name]
+ (when (nil? ctx) (break nil))
+ (def node (get ctx 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]
+ (def ast (validator :ast))
+ (def name (ast :data))
+ (def ctx (validator :ctx))
+ (def resolved (resolve-name ctx name))
+ (when (not resolved)
+   (array/push (validator :errors)
+    {:node ast :msg "unbound name"}))
+ validator)
+
+
+### patterns
+(var pattern nil)
+
+(defn- lett [validator]
+ (def ast (validator :ast))
+ (def [lhs rhs] (ast :data))
+ # evaluate the expression first
+ # otherwise lhs names will appear bound
+ (set (validator :ast) rhs)
+ (validate validator)
+ (set (validator :ast) lhs)
+ (pattern validator)
+ validator)
+
+(defn- splattern [validator]
+ (def ast (validator :ast))
+ (def status (validator :status))
+ (when (not (status :last))
+  (array/push (validator :errors) 
+   {:node ast :msg "splats may only come last in collection patterns"}))
+ (def data (ast :data))
+ (when data
+  (set (validator :ast) data)
+  (pattern validator))
+ validator)
+
+(defn- simple-coll-pattern [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (when (empty? data) (break validator))
+ (def status (validator :status))
+ (for i 0 (-> data length dec)
+  (set (validator :ast) (get data i))
+  (pattern validator))
+ (set (status :last) true)
+ (set (validator :ast) (last data))
+ (pattern validator)
+ (set (status :last) nil)
+ validator)
+
+(defn- word-pattern [validator]
+ (def ast (validator :ast))
+ (def name (ast :data))
+ (def ctx (validator :ctx))
+ ### XXX TODO: this resolution should ONLY be for userspace, NOT prelude
+ (def resolved (resolve-name-in-script ctx name))
+ (when resolved
+  (def {:line line :input input} resolved)
+  (array/push (validator :errors)
+   {:node ast :msg (string "name " name " is already bound on line "
+    line " of " input)}))
+ (set (ctx name) ast)
+ # (pp ctx)
+ validator)
+
+(def types [
+ :nil
+ :bool
+ :number
+ :keyword
+ :string
+ :set
+ :tuple
+ :dict
+ :list
+ :fn
+ :box
+ :pkg
+])
+
+(defn typed [validator]
+ (def ast (validator :ast))
+ (def [kw-type word] (ast :data))
+ (def type (kw-type :data))
+ (when (not (has-value? types type))
+  (array/push (validator :errors)
+   {:node kw-type :msg "unknown type"}))
+ (set (validator :ast) word)
+ (pattern validator))
+
+(defn- str-pattern [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (def last-term (-> data array/pop string))
+ (def grammar @{})
+ (def bindings @[])
+ (var current 0)
+ (each node data
+  (when (not (buffer? node))
+   (set (validator :ast) node)
+   (pattern validator))
+  (if (buffer? node)
+   (set (grammar (keyword current)) (string node)) 
+   (do
+    (set (grammar (keyword current))
+     ~(<- (to ,(keyword (inc current)))))
+    (array/push bindings (node :data))))
+  (set current (inc current)))
+ (set (grammar (keyword current)) ~(* ,last-term -1))
+ (def rules (map keyword (range (length grammar))))
+ (set (grammar :main) ~(* ,;rules))
+ (set (ast :grammar) grammar)
+ (set (ast :compiled) (peg/compile grammar))
+ (set (ast :bindings) bindings))
+
+(defn- pair [validator]
+ (def ast (validator :ast))
+ (def [_ patt] (ast :data))
+ (set (validator :ast) patt)
+ (pattern validator))
+
+(defn- pattern* [validator]
+ # (print "PATTERN*")
+ (def ast (validator :ast))
+ (def type (ast :type))
+ # (print "validating pattern " type)
+ (cond
+  (has-value? terminals type) validator
+  (case type
+   :word (word-pattern validator)
+   :placeholder validator
+   :ignored validator
+   :word (word-pattern validator)
+   :list (simple-coll-pattern validator)
+   :tuple (simple-coll-pattern validator)
+   :dict (simple-coll-pattern validator)
+   :splat (splattern validator)
+   :typed (typed validator)
+   :interpolated (str-pattern validator)
+   :pair (pair validator)
+   )))
+
+(set pattern pattern*)
+
+# XXX: ensure guard includes only allowable names
+# XXX: what to include here? (cf Elixir)
+(defn- guard [validator])
+
+(defn- match-clauses [validator clauses]
+ # (print "validating clauses in match-clauses")
+ (each clause clauses
+  (def parent (validator :ctx))
+  (def ctx @{:^parent parent})
+  (set (validator :ctx) ctx)
+  (def [lhs guard rhs] clause)
+  (set (validator :ast) lhs)
+  (pattern validator)
+ #  (pp (validator :ctx))
+ #  (pp (validator :ctx))
+  (when guard
+   (set (validator :ast) guard)
+   (validate validator))
+  (set (validator :ast) rhs)
+  (validate validator)
+  (set (validator :ctx) parent)))
+
+(defn- matchh [validator]
+ # (print "validating in matchh")
+ (def ast (validator :ast))
+ (def [to-match clauses] (ast :data))
+ # (print "validating expression:")
+ # (pp to-match)
+ (set (validator :ast) to-match)
+ (validate validator)
+ # (print "validating clauses")
+ (match-clauses validator clauses)
+ validator)
+
+(defn- declare [validator fnn]
+ (def status (validator :status))
+ (def declared (get status :declared @{}))
+ (set (declared fnn) true)
+ (set (status :declared) declared)
+ # (print "declared function " (fnn :name))
+ # (pp declared)
+ validator)
+
+(defn- define [validator fnn]
+ (def status (validator :status))
+ (def declared (get status :declared @{}))
+ (set (declared fnn) nil)
+ (set (status :declared) declared)
+ # (print "defined function " (fnn :name))
+ # (pp declared)
+ validator)
+
+(defn- fnn [validator]
+ (def ast (validator :ast))
+ (def name (ast :name))
+ # (print "function name: " name)
+ (def status (validator :status))
+ (def tail? (status :tail))
+ (set (status :tail) true)
+ (when name 
+  (def ctx (validator :ctx))
+  (def resolved (ctx name))
+  (when (and resolved (not= :nothing (resolved :data)))
+   (def {:line line :input input} (get-in ctx [name :token]))
+   (array/push (validator :errors)
+    {:node ast :msg (string "name is already bound on line " line " of " input)}))
+  (when (and resolved (= :nothing (resolved :data)))
+   (define validator resolved))
+  (set (ctx name) ast))
+ (def data (ast :data))
+ (when (= data :nothing)
+  (break (declare validator ast)))
+ (match-clauses validator data)
+ (set (status :tail) tail?)
+ (def rest-arities @{})
+ (def arities @{:rest rest-arities})
+  (each clause data
+ #  (print "CLAUSE:")
+ #  (pp clause)
+  (def patt (first clause))
+  (def params (patt :data))
+  (def arity (length params))
+ #  (print "checking clause with arity " arity)
+  (def rest-param? (and (> arity 0) (= :splat ((last params) :type))))
+  (if rest-param?
+   (set (rest-arities arity) true)
+   (set (arities arity) true)))
+ # (pp arities)
+ (set (ast :arities) arities)
+ validator)
+
+(defn- box [validator]
+ (def ast (validator :ast))
+ (def ctx (validator :ctx))
+ (def expr (ast :data))
+ (set (validator :ast) expr)
+ (validate validator)
+ (def name (ast :name))
+ (def resolved (ctx name))
+ (when resolved
+  (def {:line line :input input} (get-in ctx [name :token]))
+  (array/push (validator :errors)
+   {:node ast :msg (string "name is already bound on line " line " of " input)}))
+ (set (ctx name) ast)
+ validator)
+
+(defn- interpolated [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (each node data
+  (when (not (buffer? node))
+   (set (validator :ast) node)
+   (validate validator))))
+
+### TODO:
+# * [ ] ensure properties are on pkgs (if *only* pkgs from root)
+
+(defn- pkg-root [validator]
+ # (print "validating pkg-root access")
+ (def ast (validator :ast))
+ (def ctx (validator :ctx))
+ (def terms (ast :data))
+ (def pkg-name ((first terms) :data))
+ (def the-pkg (resolve-name ctx pkg-name))
+ (when (not the-pkg) 
+  (array/push (validator :errors)
+   {:node ast :msg "unbound pkg name"})
+  (break validator))
+ (def member (get terms 1))
+ (def accessed (case (member :type)
+  :keyword (get-in the-pkg [:pkg (member :data)])
+  :pkg-kw (get-in the-pkg [:pkg (member :data)])
+  :args (do
+   (array/push (validator :errors)
+    {:node member :msg "cannot call a pkg"}
+    (break validator)))))
+ (when (not accessed)
+ #  (print "no member " (member :data) " on " pkg-name)
+  (array/push (validator :errors)
+   {:node member :msg "invalid pkg access"})
+   (break validator))
+ # TODO: validate nested pkg access
+ )
+
+# (defn- tail-call [validator]
+#  (def ast (validator :ast))
+#  (when (ast :partial) (break validator))
+#  (def status (validator :status))
+#  (when (not (status :tail)) (break validator))
+#  (def data (ast :data))
+#  (def args (last data))
+#  (set (args :tail-call) true))
+
+(defn- check-arity [validator]
+ # (print "CHECKING ARITY")
+ (def ast (validator :ast))
+ # (when (ast :partial) (break validator))
+ (def ctx (validator :ctx))
+ (def data (ast :data))
+ (def fn-word (first data))
+ # (pp fn-word)
+ (def the-fn (resolve-name ctx (fn-word :data)))
+ # (print "the called function: " the-fn)
+ # (pp the-fn)
+ (when (not the-fn) (break validator))
+ # (print "the function is not nil")
+ # (print "the function type is " (type the-fn))
+ (when (= :function (type the-fn)) (break validator))
+ (when (= :cfunction (type the-fn)) (break validator))
+ # (print "the function is not a janet fn")
+ # (print "fn type: " (the-fn :type))
+ (when (not= :fn (the-fn :type)) (break validator))
+ # (print "fn name: " (the-fn :name))
+ (def arities (the-fn :arities))
+ # when there aren't arities yet, break, since that means we're making a recursive function call
+ # TODO: enahnce this so that we can determine arities *before* all function bodies; this ensures arity-checking for self-recursive calls
+ (when (not arities) (break validator))
+ # (print "arities: ")
+ # (pp arities)
+ (def args (get data 1))
+ (def num-args (length (args :data)))
+ # (print "called with #args " num-args)
+ # (pp (get (validator :ctx) "bar"))
+ (when (has-key? arities num-args) (break validator))
+ # (print "arities: ")
+ # (pp arities)
+ (when (not arities) (break validator))
+ (def rest-arities (keys (arities :rest)))
+ (when (empty? rest-arities)
+  (array/push (validator :errors)
+   {:node ast :msg "wrong number of arguments"})
+  (break validator))
+ (def rest-min (min ;rest-arities))
+ (when (< num-args rest-min)
+  (array/push (validator :errors)
+   {:node ast :msg "wrong number of arguments"}))
+ validator)
+
+(defn- kw-root [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (def [_ args] data)
+ (when (not= :args (args :type))
+  (break (array/push (validator :errors)
+   {:node args :msg "called keyword expects an argument"})))
+ (when (not= 1 (length (args :data)))
+  (array/push (validator :errors)
+   {:node args :msg "called keywords take one argument"})))
+
+(defn- synthetic [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (def status (validator :status))
+ (def ftype ((first data) :type))
+ (def stype ((get data 1) :type))
+ (def ltype ((last data) :type))
+ (set (status :pkg-access?) nil)
+ (when (= ftype :pkg-name)
+  (set (status :pkg-access?) true))
+ (each node data
+  (set (validator :ast) node)
+  (validate validator))
+ (set (validator :ast) ast)
+ # (print "ftype " ftype)
+ # (print "stype " stype)
+ # (print "ltype " ltype)
+ (when (= ftype :pkg-name) (pkg-root validator))
+ (when (= ftype :keyword) (kw-root validator))
+ # (when (= ltype :args) (tail-call validator))
+ (when (and (= ftype :word) (= stype :args))
+  (check-arity validator))
+ validator)
+
+(defn- pair [validator]
+ (def ast (validator :ast))
+ (def [k v] (ast :data))
+ (set (validator :ast) k)
+ (validate validator)
+ (set (validator :ast) v)
+ (validate validator))
+
+(defn- splat [validator]
+ (def ast (validator :ast))
+ (when (get-in validator [:status :pkg])
+  (array/push (validator :errors)
+   {:node ast :msg "splats are not allowed in pkgs"})
+  (break validator))
+ (def data (ast :data))
+ (when data
+  (set (validator :ast) data)
+  (validate validator))
+ validator)
+
+(defn- dict [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (each node data
+  (set (validator :ast) node)
+  (validate validator))
+ validator)
+
+(defn- whenn [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (each node data
+  (def [lhs rhs] node)
+  (set (validator :ast) lhs)
+  (validate validator)
+  (set (validator :ast) rhs)
+  (validate validator))
+ validator)
+
+# XXX: do this!
+(defn- withh [validator])
+
+# XXX: tail calls in last position
+(defn- doo [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (each node data
+  (set (validator :ast) node)
+  (validate validator))
+ validator)
+
+(defn- usee [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (set (validator :ast) data)
+ (validate validator)
+ (def name (data :data))
+ (def ctx (validator :ctx))
+ (def pkg (get-in ctx [name :pkg] @{}))
+ (loop [[k v] :pairs pkg]
+  (set (ctx (string k)) v))
+ validator)
+
+(defn- pkg-entry [validator pkg]
+ (def ast (validator :ast))
+ (def status (validator :status))
+ (when (= :pkg-pair (ast :type))
+  (set (status :pkg-access?) true))
+ (def data (ast :data))
+ (def [key value] (ast :data))
+ # (print "PKG ENTRY***")
+ # (pp key)
+ # (pp value)
+ (set (validator :ast) key)
+ (validate validator)
+ (set (validator :ast) value)
+ (validate validator)
+ (def entry (if (= :pkg-name (value :type))
+  (resolve-name (validator :ctx) (string (value :data)))
+  value))
+ # (print "entry at " (key :data))
+ # (pp entry)
+ (set (status :pkg-access?) nil)
+ (def kw (key :data))
+ # (pp kw)
+ (set (pkg kw) entry)
+ # (pp pkg)
+ validator)
+
+(defn- pkg [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (def name (ast :name))
+ (def pkg @{})
+ (each node data
+  (set (validator :ast) node)
+  (pkg-entry validator pkg))
+ (set (ast :pkg) pkg)
+ # (print "THE PACKAGE")
+ # (pp pkg)
+ (def ctx (validator :ctx))
+ (set (ctx name) ast)
+ validator)
+
+(defn- ns [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (def name (ast :name))
+ (def parent (validator :ctx))
+ (def ctx @{:^parent parent})
+ (def block (data :data))
+ (each node block
+  (set (validator :ast) node)
+  (validate validator))
+ (set (ast :pkg) ctx)
+ (set (parent name) ast)
+ validator)
+
+(defn- loopp [validator]
+ (def ast (validator :ast))
+ (def status (validator :status))
+ (def data (ast :data))
+ (def input (first data))
+ # (print "LOOP INPUT")
+ # (pp input)
+ (def clauses (get data 1))
+ (def input-arity (length (input :data)))
+ (set (ast :arity) input-arity)
+ # (print "input arity to loop " input-arity)
+ (set (validator :ast) input)
+ (validate validator)
+ # harmonize arities
+ (def rest-arities @{})
+ (each clause clauses
+ #  (print "CLAUSE:")
+ #  (pp clause)
+  (def patt (first clause))
+  (def params (patt :data))
+  (def clause-arity (length params))
+ #  (print "checking clause with arity " clause-arity)
+  (def rest-param? (= :splat (get (last params) :type)))
+  (when (and 
+   (not rest-param?) (not= clause-arity input-arity))
+    (array/push (validator :errors)
+     {:node patt :msg "arity mismatch"}))
+  (when rest-param?
+    (set (rest-arities clause-arity) patt)))
+ #  (pp rest-arities)
+  (loop [[arity patt] :pairs rest-arities]
+   (when (< input-arity arity)
+    (array/push (validator :errors)
+     {:node patt :msg "arity mismatch"})))
+ (def loop? (status :loop))
+ (set (status :loop) input-arity)
+ (def tail? (status :tail))
+ (set (status :tail) true)
+ (match-clauses validator clauses)
+ (set (status :loop) loop?)
+ (set (status :tail) tail?)
+ validator)
+
+(defn- recur [validator]
+ (def ast (validator :ast))
+ (def status (validator :status))
+ (def loop-arity (status :loop))
+ (when (not loop-arity)
+  (array/push (validator :errors)
+   {:node ast :msg "recur may only be used inside a loop"})
+  (break validator))
+ (def called-with (get-in ast [:data :data]))
+ (def recur-arity (length called-with))
+ # (print "loop arity " loop-arity)
+ # (print "recur arity" recur-arity)
+ (when (not= recur-arity loop-arity)
+  (array/push (validator :errors)
+   {:node ast :msg "recur must have the same number of args as its loop"}))
+ (when (not (status :tail))
+  (array/push (validator :errors)
+   {:node ast :msg "recur must be in tail position"}))
+ (set (validator :ast) (ast :data))
+ (validate validator))
+
+(defn- repeatt [validator]
+ (def ast (validator :ast))
+ (def [times body] (ast :data))
+ (set (validator :ast) times)
+ (validate validator)
+ (set (validator :ast) body)
+ (validate validator))
+
+(defn- panic [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (set (validator :ast) data)
+ (validate validator))
+
+(defn- testt [validator]
+ (def ast (validator :ast))
+ (def [_ body] (ast :data))
+ (set (validator :ast) body)
+ (validate validator))
+
+(defn- pkg-name [validator]
+ (def ast (validator :ast))
+ (def name (ast :data))
+ (def ctx (validator :ctx))
+ (def pkg (resolve-name ctx name))
+ (when (not pkg)
+  (array/push (validator :errors)
+   {:node ast :msg "unbound name"}))
+ validator)
+
+(defn- pkg-kw [validator]
+ # (print "validating pkg-kw")
+ (def ast (validator :ast))
+ (def pkg-access? (get-in validator [:status :pkg-access?]))
+ # (print "pkg-access? " pkg-access?)
+ (when (not pkg-access?)
+  (array/push (validator :errors)
+   {:node ast :msg "cannot use pkg-kw here"}))
+ validator)
+
+(defn- pkg-pair [validator]
+ # (print "validating pkg-pair")
+ (def ast (validator :ast))
+ (def status (validator :status))
+ (def [_ pkg] (ast :data))
+ (set (status :pkg-access?) true)
+ (set (validator :ast) pkg)
+ (validate validator)
+ (set (status :pkg-access?) nil)
+ validator)
+
+(defn- kw [validator]
+ (def status (validator :status))
+ (set (status :pkg-access?) nil)
+ validator)
+
+(defn- validate* [validator]
+ (def ast (validator :ast))
+ (def type (ast :type))
+ # (print "validating node " type)
+ (cond
+  (has-value? terminals type) validator
+  (has-value? simple-colls type) (simple-coll validator)
+  (case type
+   :keyword (kw validator)
+   :if (iff validator) 
+   :let (lett validator)
+   :script (script validator)
+   :block (block validator)
+   :word (word validator)
+   :fn (fnn validator)
+   :match (matchh validator)
+   :interpolated (interpolated validator)
+   :synthetic (synthetic validator)
+   :do (doo validator)
+   :dict (dict validator)
+   :test (testt validator)
+   :panic (panic validator)
+   :repeat (repeatt validator)
+   :when (whenn validator)
+   :splat (splat validator)
+   :pair (pair validator)
+   :pkg-pair (pkg-pair validator)
+   :ns (ns validator)
+   :pkg (pkg validator)
+   :pkg-name (pkg-name validator)
+   :pkg-kw (pkg-kw validator)
+   :use (usee validator)
+   :loop (loopp validator)
+   :recur (recur validator)
+   :box (box validator)
+   (error (string "unknown node type " type)))))
+
+(set validate validate*)
+
+(defn- cleanup [validator]
+ (def declared (get-in validator [:status :declared] {}))
+ (when (any? declared)
+  (each declaration (keys declared)
+   (array/push (validator :errors) {:node declaration :msg "declared fn, but not defined"})))
+ validator)
+
+(defn valid [ast &opt ctx]
+ (default ctx @{})
+ (set (ctx :^toplevel) true)
+ (def validator (new-validator ast))
+ (def base-ctx @{:^parent ctx})
+ (set (validator :ctx) base-ctx)
+ (validate validator)
+ (cleanup validator))
+
+(import ./base :as b)
+
+# (do
+(comment
+(def source `
+dec (12)
+`)
+(def scanned (s/scan source))
+(def parsed (p/parse scanned))
+(def validated (valid parsed b/ctx))
+# (get-in validated [:status :declared])
+# (validated :ctx)
+)

package.json

@@ -1,20 +0,0 @@
-{
-  "name": "@ludus/rudus",
-  "version": "0.1.3",
-  "description": "A Rust-based Ludus bytecode interpreter.",
-  "type": "module",
-  "main": "pkg/ludus.js",
-  "directories": {},
-  "keywords": [],
-  "author": "Scott Richmond",
-  "license": "GPL-3.0",
-  "files": [
-    "pkg/rudus.js",
-    "pkg/ludus.js",
-    "pkg/rudus_bg.wasm",
-    "pkg/rudus_bg.wasm.d.ts",
-    "pkg/rudus.d.ts"
-  ],
-  "devDependencies": {
-  }
-}

pkg/rudus.js

@@ -403,7 +403,7 @@ function __wbg_get_imports() {
         _assertBoolean(ret);
         return ret;
     };
-    imports.wbg.__wbindgen_closure_wrapper8194 = function() { return logError(function (arg0, arg1, arg2) {
+    imports.wbg.__wbindgen_closure_wrapper8195 = function() { return logError(function (arg0, arg1, arg2) {
         const ret = makeMutClosure(arg0, arg1, 363, __wbg_adapter_20);
         return ret;
     }, arguments) };

sandbox.ld

@@ -1,34 +0,0 @@
-fn inputter () -> {
-  if do input > unbox > empty?
-    then {
-      yield! ()
-      inputter ()
-    }
-    else receive {
-      (:get, pid) -> send (pid, (:reply, unbox (input)))
-      (:flush, pid) -> {
-        send (pid, (:reply, unbox (input)))
-        store! (input, "")
-      }
-      (:clear) -> store! (input, "")
-    }
-  
-}
-
-fn clear_input () -> store! (input, "")
-
-fn read_input () -> {
-  let reader = spawn! (inputter)
-  send (reader, (:get, self ()))
-  receive {
-    (:reply, msg) -> msg
-  }
-}
-
-fn flush_input () -> {
-  let reader = spawn! (inputter)
-  send (reader, (:flush, self ()))
-  receive {
-    (:reply, msg) -> msg
-  }
-}

sandbox_run.txt

@@ -1,444 +0,0 @@
-entering world loop; active process is axolotl_0
-closing over in type at 1: #{:sin fn sin/base, ...
-closing over in eq? at 1: #{:sin fn sin/base, ...
-closing over in eq? at 2: fn eq?
-closing over in first at 1: #{:sin fn sin/base, ...
-closing over in rest at 1: #{:sin fn sin/base, ...
-closing over in inc at 1: #{:sin fn sin/base, ...
-closing over in dec at 1: #{:sin fn sin/base, ...
-closing over in count at 1: #{:sin fn sin/base, ...
-closing over in any? at 1: fn empty?
-closing over in any? at 2: fn not
-closing over in list at 1: #{:sin fn sin/base, ...
-closing over in append at 1: #{:sin fn sin/base, ...
-closing over in fold at 1: fn fold
-closing over in fold at 2: fn first
-closing over in fold at 3: fn rest
-closing over in foldr at 1: fn foldr
-closing over in foldr at 2: fn first
-closing over in foldr at 3: fn rest
-closing over in map at 1: fn map
-closing over in map at 2: fn append
-closing over in map at 3: fn fold
-closing over in filter at 1: fn filter
-closing over in filter at 2: fn append
-closing over in filter at 3: fn fold
-closing over in keep at 1: fn some?
-closing over in keep at 2: fn filter
-closing over in concat at 1: #{:sin fn sin/base, ...
-closing over in concat at 2: fn concat
-closing over in concat at 3: fn fold
-closing over in contains? at 1: fn first
-closing over in contains? at 2: fn eq?
-closing over in contains? at 3: fn rest
-closing over in unbox at 1: #{:sin fn sin/base, ...
-closing over in store! at 1: #{:sin fn sin/base, ...
-closing over in update! at 1: fn unbox
-closing over in update! at 2: fn store!
-closing over in show at 1: #{:sin fn sin/base, ...
-closing over in string at 1: fn show
-closing over in string at 2: fn string
-closing over in string at 3: fn concat
-closing over in join at 1: fn join
-closing over in join at 2: fn concat
-closing over in join at 3: fn fold
-closing over in split at 1: #{:sin fn sin/base, ...
-closing over in trim at 1: #{:sin fn sin/base, ...
-closing over in upcase at 1: #{:sin fn sin/base, ...
-closing over in downcase at 1: #{:sin fn sin/base, ...
-closing over in chars at 1: #{:sin fn sin/base, ...
-closing over in chars/safe at 1: #{:sin fn sin/base, ...
-closing over in strip at 1: fn strip
-closing over in words at 1: fn strip
-closing over in words at 2: fn split
-closing over in words at 3: fn empty?
-closing over in words at 4: fn append
-closing over in words at 5: fn fold
-closing over in sentence at 1: fn join
-closing over in to_number at 1: #{:sin fn sin/base, ...
-closing over in print! at 1: fn string
-closing over in print! at 2: fn map
-closing over in print! at 3: fn join
-closing over in print! at 4: #{:sin fn sin/base, ...
-closing over in print! at 5: box { [] }
-closing over in print! at 6: fn append
-closing over in print! at 7: fn update!
-closing over in report! at 1: fn print!
-closing over in report! at 2: fn show
-closing over in report! at 3: fn concat
-closing over in doc! at 1: #{:sin fn sin/base, ...
-closing over in doc! at 2: fn print!
-closing over in add at 1: #{:sin fn sin/base, ...
-closing over in add at 2: fn add
-closing over in add at 3: fn fold
-closing over in sub at 1: #{:sin fn sin/base, ...
-closing over in sub at 2: fn sub
-closing over in sub at 3: fn fold
-closing over in mult at 1: #{:sin fn sin/base, ...
-closing over in mult at 2: fn mult
-closing over in mult at 3: fn fold
-closing over in div at 1: #{:sin fn sin/base, ...
-closing over in div at 2: fn mult
-closing over in div at 3: fn fold
-closing over in div at 4: fn div
-closing over in div/0 at 1: #{:sin fn sin/base, ...
-closing over in div/0 at 2: fn mult
-closing over in div/0 at 3: fn fold
-closing over in div/0 at 4: fn div/0
-closing over in div/safe at 1: fn div
-closing over in div/safe at 2: fn mult
-closing over in div/safe at 3: fn fold
-closing over in div/safe at 4: fn div/safe
-closing over in inv at 1: fn div
-closing over in inv/0 at 1: fn div/0
-closing over in inv/safe at 1: fn div/safe
-closing over in neg at 1: fn mult
-closing over in gt? at 1: #{:sin fn sin/base, ...
-closing over in gte? at 1: #{:sin fn sin/base, ...
-closing over in lt? at 1: #{:sin fn sin/base, ...
-closing over in lte? at 1: #{:sin fn sin/base, ...
-closing over in between? at 1: fn gte?
-closing over in between? at 2: fn lt?
-closing over in neg? at 1: fn lt?
-closing over in pos? at 1: fn gt?
-closing over in abs at 1: fn neg?
-closing over in abs at 2: fn mult
-closing over in turn/deg at 1: fn mult
-closing over in deg/turn at 1: fn div
-closing over in turn/rad at 1: 6.283185307179586
-closing over in turn/rad at 2: fn mult
-closing over in rad/turn at 1: 6.283185307179586
-closing over in rad/turn at 2: fn div
-closing over in deg/rad at 1: 6.283185307179586
-closing over in deg/rad at 2: fn div
-closing over in deg/rad at 3: fn mult
-closing over in rad/deg at 1: 6.283185307179586
-closing over in rad/deg at 2: fn div
-closing over in rad/deg at 3: fn mult
-closing over in sin at 1: fn turn/rad
-closing over in sin at 2: #{:sin fn sin/base, ...
-closing over in sin at 3: fn deg/rad
-closing over in cos at 1: fn turn/rad
-closing over in cos at 2: #{:sin fn sin/base, ...
-closing over in cos at 3: fn deg/rad
-closing over in tan at 1: fn turn/rad
-closing over in tan at 2: #{:sin fn sin/base, ...
-closing over in tan at 3: fn deg/rad
-closing over in rotate at 1: fn rotate
-closing over in rotate at 2: fn cos
-closing over in rotate at 3: fn mult
-closing over in rotate at 4: fn sin
-closing over in rotate at 5: fn sub
-closing over in rotate at 6: fn add
-closing over in atan/2 at 1: #{:sin fn sin/base, ...
-closing over in atan/2 at 2: fn rad/turn
-closing over in atan/2 at 3: fn atan/2
-closing over in atan/2 at 4: fn rad/deg
-closing over in angle at 1: fn atan/2
-closing over in angle at 2: fn sub
-closing over in mod at 1: #{:sin fn sin/base, ...
-closing over in mod/0 at 1: #{:sin fn sin/base, ...
-closing over in mod/safe at 1: #{:sin fn sin/base, ...
-closing over in even? at 1: fn mod
-closing over in even? at 2: fn eq?
-closing over in odd? at 1: fn mod
-closing over in odd? at 2: fn eq?
-closing over in square at 1: fn mult
-closing over in sqrt at 1: fn neg?
-closing over in sqrt at 2: fn not
-closing over in sqrt at 3: #{:sin fn sin/base, ...
-closing over in sqrt/safe at 1: fn neg?
-closing over in sqrt/safe at 2: fn not
-closing over in sqrt/safe at 3: #{:sin fn sin/base, ...
-closing over in sum_of_squares at 1: fn square
-closing over in sum_of_squares at 2: fn add
-closing over in sum_of_squares at 3: fn sum_of_squares
-closing over in sum_of_squares at 4: fn fold
-closing over in dist at 1: fn sum_of_squares
-closing over in dist at 2: fn sqrt
-closing over in dist at 3: fn dist
-closing over in heading/vector at 1: fn neg
-closing over in heading/vector at 2: fn add
-closing over in heading/vector at 3: fn cos
-closing over in heading/vector at 4: fn sin
-closing over in floor at 1: #{:sin fn sin/base, ...
-closing over in ceil at 1: #{:sin fn sin/base, ...
-closing over in round at 1: #{:sin fn sin/base, ...
-closing over in range at 1: #{:sin fn sin/base, ...
-closing over in at at 1: #{:sin fn sin/base, ...
-closing over in second at 1: fn ordered?
-closing over in second at 2: fn at
-closing over in last at 1: fn ordered?
-closing over in last at 2: fn count
-closing over in last at 3: fn dec
-closing over in last at 4: fn at
-closing over in slice at 1: fn slice
-closing over in slice at 2: fn gte?
-closing over in slice at 3: fn count
-closing over in slice at 4: fn gt?
-closing over in slice at 5: fn neg?
-closing over in slice at 6: #{:sin fn sin/base, ...
-closing over in butlast at 1: fn count
-closing over in butlast at 2: fn dec
-closing over in butlast at 3: fn slice
-closing over in assoc at 1: #{:sin fn sin/base, ...
-closing over in dissoc at 1: #{:sin fn sin/base, ...
-closing over in get at 1: fn get
-closing over in get at 2: #{:sin fn sin/base, ...
-closing over in update at 1: fn get
-closing over in update at 2: fn assoc
-closing over in keys at 1: fn list
-closing over in keys at 2: fn first
-closing over in keys at 3: fn map
-closing over in values at 1: fn list
-closing over in values at 2: fn second
-closing over in values at 3: fn map
-closing over in has? at 1: fn has?
-closing over in has? at 2: fn get
-closing over in has? at 3: fn some?
-closing over in dict at 1: fn assoc
-closing over in dict at 2: fn fold
-closing over in dict at 3: fn list
-closing over in dict at 4: fn dict
-closing over in each! at 1: fn each!
-closing over in random at 1: #{:sin fn sin/base, ...
-closing over in random at 2: fn random
-closing over in random at 3: fn mult
-closing over in random at 4: fn sub
-closing over in random at 5: fn add
-closing over in random at 6: fn count
-closing over in random at 7: fn floor
-closing over in random at 8: fn at
-closing over in random at 9: fn keys
-closing over in random at 10: fn get
-closing over in random_int at 1: fn random
-closing over in random_int at 2: fn floor
-closing over in add_command! at 1: box { [] }
-closing over in add_command! at 2: fn append
-closing over in add_command! at 3: fn update!
-closing over in add_command! at 4: box { #{:penwidth 1,...
-closing over in add_command! at 5: fn unbox
-closing over in add_command! at 6: fn apply_command
-closing over in add_command! at 7: fn store!
-closing over in forward! at 1: fn add_command!
-closing over in back! at 1: fn add_command!
-closing over in left! at 1: fn add_command!
-closing over in right! at 1: fn add_command!
-closing over in penup! at 1: fn add_command!
-closing over in pendown! at 1: fn add_command!
-closing over in pencolor! at 1: fn add_command!
-closing over in penwidth! at 1: fn add_command!
-closing over in background! at 1: fn add_command!
-closing over in home! at 1: fn add_command!
-closing over in clear! at 1: fn add_command!
-closing over in goto! at 1: fn add_command!
-closing over in goto! at 2: fn goto!
-closing over in setheading! at 1: fn add_command!
-closing over in showturtle! at 1: fn add_command!
-closing over in hideturtle! at 1: fn add_command!
-closing over in loadstate! at 1: fn add_command!
-closing over in apply_command at 1: fn assoc
-closing over in apply_command at 2: fn add
-closing over in apply_command at 3: fn update
-closing over in apply_command at 4: fn sub
-closing over in apply_command at 5: fn heading/vector
-closing over in apply_command at 6: fn mult
-closing over in position at 1: box { #{:penwidth 1,...
-closing over in position at 2: fn unbox
-closing over in heading at 1: box { #{:penwidth 1,...
-closing over in heading at 2: fn unbox
-closing over in pendown? at 1: box { #{:penwidth 1,...
-closing over in pendown? at 2: fn unbox
-closing over in pencolor at 1: box { #{:penwidth 1,...
-closing over in pencolor at 2: fn unbox
-closing over in penwidth at 1: box { #{:penwidth 1,...
-closing over in penwidth at 2: fn unbox
-closing over in self at 1: #{:sin fn sin/base, ...
-closing over in send at 1: #{:sin fn sin/base, ...
-closing over in spawn! at 1: #{:sin fn sin/base, ...
-closing over in yield! at 1: #{:sin fn sin/base, ...
-closing over in alive? at 1: #{:sin fn sin/base, ...
-closing over in link! at 1: fn link!
-closing over in link! at 2: #{:sin fn sin/base, ...
-closing over in msgs at 1: #{:sin fn sin/base, ...
-closing over in flush! at 1: #{:sin fn sin/base, ...
-closing over in flush_i! at 1: #{:sin fn sin/base, ...
-closing over in sleep! at 1: #{:sin fn sin/base, ...
-yielded from axolotl_0
-***match clause: : (:set, x)
-binding `x` in sandbox
-stack depth: 3; match depth: 0
-at stack index: 2
-new locals: x@2//1
-resolving binding `x` in sandbox
-locals: x@2//1
-at locals position 2
-leaving scope 1
-releasing binding x@2//1
-leaving scope 0
-***leaving block before pop stack depth: 1
-popping back from 1 to 0
-=== source code ===
-&  fn receive (receiver) -> {
-&   fn looper {
-&    ([], _) -> yield! ()
-&    (xs, i) -> {
-&     print!("looping through messages:", xs)
-&     match receiver (first (xs), i) with {
-&      :does_not_understand -> looper (rest (xs), inc (i))
-&      x -> x
-&    }}
-&  }
-&  print! ("receiving in", self (), "with messages", msgs())
-&  looper (msgs (), 0)
-& }
-
-& fn agent (x) -> receive (fn (msg, i) -> {
-& print!("received msg in agent: ", msg)
-& match msg with {
-&   (:get, pid) -> {
-&     flush_i! (i)
-&     print!("getted from {pid}")
-&     send (pid, (:response, x))
-&     agent (x)
-&   }
-&   (:set, y) -> {flush_i!(i); print!("setted! {y}"); agent (y)}
-&   (:update, f) -> {flush_i!(i);print!("updated: {f}"); agent (f (x))}
-&   y -> {print!("no agent reception match!!!! {y}");:does_not_understand}
-& }
-& })
-
-& fn agent/get (pid) -> {
-&   send (pid, (:get, self ()))
-&   yield! ()
-&   receive (fn (msg, i) -> match msg with {
-&     (:response, x) -> {flush_i! (i); x}
-&   })
-& }
-
-& fn agent/set (pid, val) -> send (pid, (:set, val))
-
-& fn agent/update (pid, f) -> send (pid, (:update, f))
-
-& let counter = spawn! (fn () -> agent (0))
-& agent/set (counter, 12)
-
-match (:set, 12) with {
-  (:set, x) -> x
-}
-
-=== chunk: sandbox ===
-IDX | CODE           | INFO
-0000: constant         00000: :set
-0003: constant         00001: 12
-0006: push_tuple       002
-0008: ***match clause: : (:set, x)
-0010: match_tuple      002
-0012: jump_if_no_match 00028
-0015: load_tuple
-0016: match_depth      001
-0018: match_constant   00000: :set
-0021: jump_if_no_match 00017
-0024: match_depth      000
-0026: match
-0027: binding `x` in sandbox
-0029: stack depth: 3; match depth: 0
-0031: at stack index: 2
-0033: new locals: x@2//1
-0035: jump_if_no_match 00003
-0038: jump             00002
-0041: pop_n            002
-0043: jump_if_no_match 00016
-0046: resolving binding `x` in sandbox
-locals: x@2//1
-0048: at locals position 2
-0050: push_binding     002
-0052: store
-0053: leaving scope 1
-0055: releasing binding x@2//1
-0057: pop_n            002
-0059: jump             00001
-0062: panic_no_match
-0063: load
-0064: store
-0065: leaving scope 0
-0067: ***leaving block before pop stack depth: 1
-0069: popping back from 1 to 0
-0071: pop
-0072: load
-
-
-
-=== vm run ===
-entering world loop; active process is cormorant_0
-0000: [] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0000: constant         00000: :set
-0003: [->:set<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0003: constant         00001: 12
-0006: [->:set<-|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0006: push_tuple       002
-0008: [->(:set, 12)<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0008: ***match clause: : (:set, x)
-0010: [->(:set, 12)<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0010: match_tuple      002
-0012: [->(:set, 12)<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0012: jump_if_no_match 00028
-0015: [->(:set, 12)<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0015: load_tuple
-0016: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0016: match_depth      001
-0018: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0018: match_constant   00000: :set
-0021: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0021: jump_if_no_match 00017
-0024: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0024: match_depth      000
-0026: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0026: match
-0027: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0027: binding `x` in sandbox
-0029: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0029: stack depth: 3; match depth: 0
-0031: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0031: at stack index: 2
-0033: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0033: new locals: x@2//1
-0035: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0035: jump_if_no_match 00003
-0038: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0038: jump             00002
-0043: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0043: jump_if_no_match 00016
-0046: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0046: resolving binding `x` in sandbox
-locals: x@2//1
-0048: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0048: at locals position 2
-0050: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0050: push_binding     002
-0052: [->(:set, 12)<-|:set|12|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0052: store
-0053: [->(:set, 12)<-|:set|12] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0053: leaving scope 1
-0055: [->(:set, 12)<-|:set|12] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0055: releasing binding x@2//1
-0057: [->(:set, 12)<-|:set|12] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0057: pop_n            002
-0059: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0059: jump             00001
-0063: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0063: load
-0064: [->(:set, 12)<-|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
-0064: store
-0065: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0065: leaving scope 0
-0067: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0067: ***leaving block before pop stack depth: 1
-0069: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0069: popping back from 1 to 0
-0071: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0071: pop
-0072: [] (12,_,_,_,_,_,_,_) cormorant_0 {}
-0072: load
-yielded from cormorant_0
-{"result":"12","io":{"stdout":{"proto":["text-stream","0.1.0"],"data":""},"turtle":{"proto":["turtle-graphics","0.1.0"],"data":[]}}}

src/compiler.rs

@@ -1,6 +1,5 @@
 use crate::ast::{Ast, StringPart};
 use crate::chunk::{Chunk, StrPattern};
-use crate::errors::line_number;
 use crate::op::Op;
 use crate::spans::Spanned;
 use crate::value::*;
@@ -1115,6 +1114,7 @@ impl Compiler {
                 self.emit_op(Op::Spawn);
             }
             Receive(clauses) => {
+                self.msg("********starting receive".to_string());
                 let tail_pos = self.tail_pos;
                 self.emit_op(Op::ClearMessage);
                 let receive_begin = self.len();
@@ -1158,7 +1158,8 @@ impl Compiler {
                 }
                 self.pop_n(self.stack_depth - stack_depth);
                 self.emit_op(Op::Load);
-                self.stack_depth += 1;
+                // self.stack_depth += 1;
+                self.msg("********receive completed".to_string());
             }
             MatchClause(..) => unreachable!(),
             Fn(name, body, doc) => {

src/main.rs

@@ -1,12 +1,6 @@
-use phf::phf_map;
 use rudus::value::Value;
 use std::env;
 
-const KEYWORDS: phf::Map<&'static str, Value> = phf_map! {
-    "ok" => Value::keyword("ok"),
-    "err" => Value::keyword("err"),
-}
-
 pub fn main() {
     env::set_var("RUST_BACKTRACE", "1");
     println!("Hello, world.")

src/validator.rs

@@ -103,10 +103,16 @@ impl<'a> Validator<'a> {
     }
 
     fn declare_fn(&mut self, name: String) {
+        if name.is_empty() {
+            return;
+        }
         self.locals.push((name, self.span, FnInfo::Declared));
     }
 
     fn define_fn(&mut self, name: String, info: FnInfo) {
+        if name.is_empty() {
+            return;
+        }
         let i = self.locals.iter().position(|(n, ..)| *n == name).unwrap();
         let new_binding = (name, self.locals[i].1, info);
         self.locals[i] = new_binding;

src/vm.rs

@@ -305,7 +305,7 @@ impl Creature {
             unreachable!("expected keyword pid in monitor");
         };
         if other != self.pid {
-            self.unlink(Value::Keyword(other));
+            self.do_unlink(Value::Keyword(other));
             let mut other = self.zoo.borrow_mut().catch(other);
             other.parents.push(self.pid);
             self.zoo.borrow_mut().release(other);
@@ -322,6 +322,11 @@ impl Creature {
     }
 
     fn unlink(&mut self, other: Value) {
+        self.do_unlink(other);
+        self.push(Value::Keyword("ok"))
+    }
+
+    fn do_unlink(&mut self, other: Value) {
         let Value::Keyword(other) = other else {
             unreachable!("expected keyword pid in unlink")
         };
@@ -331,7 +336,6 @@ impl Creature {
             other.delete_from_siblings(self.pid);
             self.zoo.borrow_mut().release(other);
         }
-        self.push(Value::Keyword("ok"))
     }
 
     fn link(&mut self, other: Value) {
@@ -1324,7 +1328,12 @@ impl Creature {
                 }
                 Return => {
                     if self.debug {
-                        console_log!("== returning from {} ==", self.frame.function.show())
+                        console_log!("== returning from {} ==", self.frame.function.show());
+                        let destination = match self.call_stack.last() {
+                            Some(frame) => frame.function.as_fn().name(),
+                            None => "toplevel",
+                        };
+                        console_log!("== returning to {destination} ==");
                     }
                     let mut value = Value::Nothing;
                     swap(&mut self.register[0], &mut value);