stash work: bugfixes, better errors, etc.

janet/base.janet

@@ -89,12 +89,14 @@
     :string (get-in x [:token :lexeme])
     (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) " "))
+
 (defn doc! [fnn]
   (def {:name name :doc doc :body clauses} fnn)
-  (print "doccing " name)
-  (def patterns (map (fn [x] (-> x first show-patt)) clauses))
   (print name)
-  (print (string/join patterns " "))
+  (print (pretty-patterns fnn))
   (print doc))
 
 (defn- conj!-set [sett value]
@@ -239,5 +241,7 @@
 (def base (let [b @{}]
   (each [k v] (pairs ctx)
     (set (b (keyword k)) v))
-  (table/to-struct b)))
+  b))
+
+(set (base :^type) :dict)
 

janet/errors.janet

@@ -1,10 +1,11 @@
 (import spork/json :as j)
+(try (os/cd "janet") ([_] nil))
 (import /base :as b)
 
 (defn- get-line [source line]
  ((string/split "\n" source) (dec line)))
 
-(defn scan-error [e out] (set (out :errors) e) (j/encode out))
+(defn scan-error [e] (pp e) e)
 
 (defn parse-error [e] 
  (def msg (e :msg))
@@ -13,7 +14,8 @@
  (def source-line (get-line source line-num))
  (print "Parsing error: " msg)
  (print "On line " line-num ":")
- (print source-line))
+ (print source-line)
+ e)
 
 
 (defn validation-error [e]
@@ -26,9 +28,41 @@
   (do
    (print "Validation error: " msg " " (get-in e [:node :data]))
    (print "on line " line-num)
-   (print source-line)
+   (print source-line))
-  )
+  (do
- )
+   (print "Validation error: " msg)
+   (print "on line " line-num)
+   (print source-line)))
+ e)
+
+(defn- fn-no-match [e]
+ (print "Ludus panicked! no match")
+ (def line-num (get-in e [:node :token :line]))
+ (def source (get-in e [:node :token :source]))
+ (def source-line (get-line source line-num))
+ (print "on line " line-num)
+ (def called (e :called))
+ (print "calling " (b/show called))
+ (def value (e :value))
+ (print "with " (b/show value))
+ (print "expecting to match one of")
+ (print (b/pretty-patterns called))
 )
 
-(defn runtime-error [e out] (set (out :errors) e) (j/encode out))
+(defn- generic-panic [e]
+ (def msg (e :msg))
+ (def line-num (get-in e [:node :token :line]))
+ (def source (get-in e [:node :token :source]))
+ (def source-line (get-line source line-num))
+ (print "Ludus panicked! " msg)
+ (print "on line " line-num)
+ (print source-line)
+)
+
+(defn runtime-error [e]
+ (pp e)
+ (def msg (e :msg))
+ (case msg
+  "no match: function call" (fn-no-match e)
+  (generic-panic e)
+ e)

janet/interpreter.janet

@@ -1,7 +1,7 @@
 # A tree walk interpreter for ludus
 
 # for repl imports
-# (try (os/cd "janet") ([_] nil))
+(try (os/cd "janet") ([_] nil))
 
 (import ./base :as b)
 
@@ -36,11 +36,11 @@
     (break {:success false :miss [pattern value]}))
   (def val-len (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]})))
+  (def patt-len (length members))
   (var splat nil)
   (def splat? (= :splat ((last members) :type)))
   (when splat?
@@ -78,6 +78,10 @@
     (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)))
@@ -201,6 +205,8 @@
 (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))
@@ -208,7 +214,7 @@
     (do
       (merge-into ctx (match? :ctx))
       value)
-    (error {:node ast :value value :msg "no match"})))
+    (error {:node ast :value value :msg "no match: let binding"})))
 
 (defn- matchh [ast ctx]
   (def [to-match clauses] (ast :data))
@@ -217,7 +223,7 @@
   (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"}))
+      (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}))
@@ -271,11 +277,14 @@
       (set result (interpret rhs ctx))
       (break)))
   (when (= result :^nothing)
-    (error {:node ast :msg "no match in when"}))
+    (error {:node ast :msg "no match: when form"}))
   result)
 
 (defn- word [ast ctx]
-  (resolve-name (ast :data) 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))
@@ -389,18 +398,20 @@
   # (pp args)
   (def pos (find-index is_placeholder args))
   (def name (string (the-fn :name) " *partial*"))
-  (defn partial-fn [missing]
+  (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 the-fn [;full-args]))
+    (call-fn root-ast the-fn [;full-args]))
   {:^type :applied :name name :body partial-fn})
 
-(defn- call-fn* [the-fn args]
+(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))) 
@@ -408,12 +419,14 @@
       (break (the-fn ;args)))
   (def clauses (the-fn :body))
   (when (= :nothing clauses)
-    (error {:node the-fn :value args :msg "cannot call function before it is defined"}))
+    (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) 0 args)))
   (defn match-fn [i args]
     (when (= len i)
-      (error {:node the-fn :value args :msg "no match"}))
+      (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?
@@ -433,19 +446,19 @@
 
 (set call-fn call-fn*)
 
-(defn- call-partial [the-fn arg] ((the-fn :body) ;arg))
+(defn- call-partial [root-ast the-fn arg] ((the-fn :body) root-ast ;arg))
 
-(defn- apply-synth-term [prev curr]
+(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 prev curr)
+    [:fn :tuple] (call-fn root-ast prev curr)
     [:fn :partial] (partial prev curr)
-    [:function :tuple] (call-fn prev curr)
+    [:function :tuple] (call-fn root-ast prev curr)
-    [:applied :tuple] (call-partial prev curr)
+    [:applied :tuple] (call-partial root-ast prev curr)
     [:keyword :args] (get (first curr) prev :^nil)
     [:dict :keyword] (get prev curr :^nil)
     [:nil :keyword] :^nil
@@ -465,9 +478,9 @@
   (for i 1 (-> terms length dec)
     (def curr (interpret (terms i) ctx))
   #   (print "term " i ": " curr)
-    (set prev (apply-synth-term prev curr)))
+    (set prev (apply-synth-term first-term prev curr)))
   # (print "done with inner terms, applying last term")
-  (apply-synth-term prev (interpret last-term ctx)))
+  (apply-synth-term first-term prev (interpret last-term ctx)))
 
 (defn- doo [ast ctx] 
   (def terms (ast :data))
@@ -475,9 +488,9 @@
   (def last-term (last terms))
   (for i 1 (-> terms length dec)
     (def curr (interpret (terms i) ctx))
-    (set prev (call-fn curr [prev])))
+    (set prev (call-fn (first terms) curr [prev])))
   (def last-fn (interpret last-term ctx))
-  (call-fn last-fn [prev]))
+  (call-fn (first terms) last-fn [prev]))
 
 (defn- pkg [ast ctx] 
   (def members (ast :data))
@@ -504,7 +517,7 @@
   #   (print "calling inner loop fn")
   #   (print "for the " i "th time")
     (when (= len i)
-      (error {:node ast :value args :msg "no match"}))
+      (error {:node ast :value args :msg "no match: loop"}))
     (def clause (clauses i))
     (def [patt guard expr] clause)
     (def match?

janet/ludus.janet

@@ -19,13 +19,28 @@ This new scene will have to return a JSON POJSO:
 {:console "..." :result "..." :draw [...] :errors [...]}
 )
 
+(def prelude-ctx @{:^parent {"base" b/base}})
+
+# (comment
+# (do
+(def prelude-ctx @{:^parent {"base" b/base}})
 (def prelude-src (slurp "prelude.ld"))
 (def prelude-scanned (s/scan prelude-src))
 (def prelude-parsed (p/parse prelude-scanned))
 (def parse-errors (prelude-parsed :errors))
 (when (any? parse-errors) (each err parse-errors (e/parse-error err)))
-(def prelude-validated (v/valid prelude-parsed @{"base" b/base}))
+(def prelude-validated (v/valid prelude-parsed prelude-ctx))
-(each err (prelude-validated :errors) (e/validation-error err))
+(def validation-errors (prelude-validated :errors))
+(when (any? validation-errors) (each err validation-errors (e/validation-error err)))
+(def prelude-pkg (try 
+ (i/interpret (prelude-parsed :ast) prelude-ctx)
+ ([e] e)))
+
+(keys prelude-pkg)
+(prelude-pkg :msg)
+(e/runtime-error prelude-pkg)
+# )
+
 
 (defn run [source]
  (def errors @[])
@@ -35,17 +50,22 @@ This new scene will have to return a JSON POJSO:
  (def out @{:errors errors :draw draw :result result :console console})
  (def scanned (s/scan source))
  (when (any? (scanned :errors))
-  (break (-> :errors scanned (e/scan-error out))))
+  (break (do
+   (each err (scanned :errors)
+    (e/scan-error err)))))
  (def parsed (p/parse scanned))
  (when (any? (parsed :errors))
-  (break (-> :errors parsed (e/parse-error out))))
+  (break (each err (parsed :errors)
- (def validated (v/valid parsed))
+   (e/parse-error err))))
+ (def validated (v/valid parsed prelude-ctx))
  (when (any? (validated :errors))
-  (break (-> :errors validated (e/validation-error out))))
+  (break (each err (validated :errors)
+   (e/validation-error err))))
  (setdyn :out console)
  (try
-  (set result (b/show (i/interpret (parsed :ast) @{:^parent b/base})))
+  (set result (b/show (i/interpret (parsed :ast) prelude-ctx)))
-  ([err] (e/runtime-error err out)))
+  ([err] (setdyn :out stdout) (e/runtime-error err)))
+ (setdyn :out stdout)
  (set (out :result) result)
  (j/encode out))
 
@@ -56,9 +76,11 @@ This new scene will have to return a JSON POJSO:
  (run source))
 
 (def source `
-let foo = fn () -> :bar
+let pi = base :pi
-foo ()
+pi
 `)
 
+b/base
+
 (-> source run j/decode)
 

janet/prelude.ld

@@ -132,12 +132,11 @@ fn dec {
 
 fn count {
 	"Returns the number of elements in a collection (including string)."
-	(xs as :list) -> dec (base :count (xs))
+	(xs as :list) -> base :count (xs)
-	(xs as :tuple) -> dec (base :count (xs))
+	(xs as :tuple) -> base :count (xs)
 	(xs as :dict) -> base :count (xs)
 	(xs as :string) -> base :count (xs)
 	(xs as :set) -> base :count (xs)
-	(xs as :struct) -> dec (base :count (xs))
 }
 
 fn empty? {
@@ -728,7 +727,7 @@ fn coll? {
 	(coll as :list) -> true
 	(coll as :tuple) -> true
 	(coll as :set) -> true
-	(coll as :ns) -> true
+	(coll as :pkg) -> true
 	(_) -> false
 }
 
@@ -742,8 +741,7 @@ fn ordered? {
 fn assoc? {
 	"Returns true if a value is an associative collection: a dict, struct, or namespace."
 	(assoc as :dict) -> true
-	(assoc as :struct) -> true
+	(assoc as :pkg) -> true
-	(assoc as :ns) -> true
 	(_) -> false
 }
 
@@ -763,8 +761,7 @@ fn has? {
 }
 
 fn dict {
-	"Takes an ns, and returns it as a dict. Or, takes a list or tuple of (key, value) tuples and returns it as a dict. Returns dicts unharmed."
+	"Takes a list or tuple of (key, value) tuples and returns it as a dict. Returns dicts unharmed."
-	(ns_ as :ns) -> base :to_dict (ns_)
 	(dict as :dict) -> dict
 	(list as :list) -> fold (assoc, list)
 	(tup as :tuple) -> do tup > list > dict
@@ -795,6 +792,9 @@ fn each! {
 
 let pi = base :pi
 
+print! (base :pi)
+print! (pi)
+
 let tau = mult (2, pi)
 
 fn sin {