Make lots and lots of progress; discover error in pattern matching.

src/ludus/base.cljc

@@ -66,18 +66,22 @@
 (def not- {:name "not"
            ::data/type ::data/clj
            :body not})
-
-(def panic! {:name "panic!"
-             ::data/type ::data/clj
-             :body (fn [& args] (throw (ex-info (apply show/show (interpose " " args)) {})))})
-
 (defn- print-show [lvalue]
   (if (string? lvalue) lvalue (show/show lvalue)))
 
+(defn- stringify-args [arglist]
+  (apply str (interpose " " (into [] (map print-show) (rest arglist)))))
+
+(def panic! {:name "panic!"
+             ::data/type ::data/clj
+             :body (fn panic-inner
+                     ([] (panic-inner [::data/list])) 
+                     ([args] (throw (ex-info (stringify-args args) {}))))})
+
 (def print- {:name "print"
              ::data/type ::data/clj
-             :body (fn [& args]
+             :body (fn [args]
-                     (println (apply str (into [] (map print-show) args)))
+                     (println (stringify-args args))
                      :ok)})
 
 (def deref- {:name "deref"
@@ -106,6 +110,10 @@
              ::data/type ::data/clj
              :body assoc})
 
+(def dissoc- {name "dissoc"
+              ::data/type ::data/clj
+              :body dissoc})
+
 (def get- {:name "get"
            ::data/type ::data/clj
            :body (fn 
@@ -304,6 +312,7 @@
            :and and-
            :or or-
            :assoc assoc-
+           :dissoc dissoc-
            :conj conj-
            :get get-
            :type type-

src/ludus/interpreter.cljc

@@ -13,6 +13,15 @@
     [clojure.set]
     [clojure.string]))
 
+(defn prettify-ast [ast]
+  (cond
+    (not (map? ast)) ast
+    (not (:data ast)) (dissoc ast :remaining :token)
+    :else (let [{:keys [type data]} ast]
+            {:type type ;:token token
+             :data (into [] (map prettify-ast) data)})
+    ))
+
 ;; right now this is not very efficient:
 ;; it's got runtime checking
 ;; we should be able to do these checks statically
@@ -59,15 +68,22 @@
             (if (:success match?)
               (do
                 (vswap! ctx-diff #(merge % (:ctx match?)))
-                (println "current context: " (dissoc @ctx-diff ::parent))
+                ;(println "current context: " (dissoc @ctx-diff ::parent))
                 (recur (inc i)))
-              {:success :false :reason (str "Could not match " pattern " with " value)}
+              {:success :false :reason (str "Could not match " pattern " with " (show/show value))}
               )))))))
 
+;; Match-tuple is misbehaving when the first value is a function and the second is a list
+;; Hangs on success!
+;; printlns at top run just fine
+;; println at top of :else - loop happens once
+;; println in :else - loop - if - let binding match? does not happen
+;; that suggets that match is hanging here
+
 (defn- match-tuple [pattern value ctx-vol]
-  ;(println "\n\n\n**********Matching tuple")
+  (println "\n\n\n**********Matching tuple")
-  ;(println "*****Value:   " value)
+  (println "*****Value:   " (show/show value))
-  ;(println "*****Pattern: " pattern)
+  (println "*****Pattern: " (prettify-ast pattern))
   (let [members (:data pattern)
         length (count members)]
     (cond
@@ -86,9 +102,11 @@
       :else 
       (let [ctx-diff (volatile! @ctx-vol)]
         (loop [i length]
+          (println "Matching tuple elements at index " i)
           (if (= 0 i)
             {:success true :ctx @ctx-diff}
             (let [match? (match (nth members (dec i)) (nth value i) ctx-diff)]
+              (println "Maybe a match?: " match?)
               (if (:success match?)
                 (do
                   (vswap! ctx-diff #(merge % (:ctx match?)))
@@ -688,7 +706,7 @@
                                (interpret-ast body new-ctx)))
                            (recur (first clauses) (rest clauses))))
 
-                       (throw (ex-info (str "Match Error: No match found in loop for " input) {:ast ast}))))]
+                       (throw (ex-info (str "Match Error: No match found in loop for " (show/show input)) {:ast ast}))))]
         (if (::data/recur output)
           (recur (:args output))
           output)))))
@@ -854,7 +872,7 @@
     :struct-literal
     (interpret-struct ast ctx)
 
-    (throw (ex-info (str "Unknown AST node type: " (:type ast)) {:ast ast}))))
+    (throw (ex-info (str "Unknown AST node type " (get ast :type :err) " on line " (get-in ast [:token :line])) {:ast ast}))))
 
 (defn get-line [source line]
   (if line
@@ -909,16 +927,16 @@
 ;       (System/exit 67))))
 
 ; ;; TODO: update this to use new parser pipeline & new AST representation
-; (defn interpret-repl
+(defn interpret-repl
-;   ([parsed ctx]
+  ([parsed ctx]
-;    (let [orig-ctx @ctx]
+   (let [orig-ctx @ctx]
-;      (try
+     (try
-;        (let [result (interpret-ast parsed ctx)]
+       (let [result (interpret-ast parsed ctx)]
-;          {:result result :ctx ctx})
+         {:result result :ctx ctx})
-;        (catch clojure.lang.ExceptionInfo e
+       (catch #?(:clj Throwable :cljs js/Object) e
-;          (println "Ludus panicked!")
+         (println "Ludus panicked!")
-;          (println (ex-message e))
+         (println (ex-message e))
-;          {:result :error :ctx (volatile! orig-ctx)})))))
+         {:result :error :ctx (volatile! orig-ctx)})))))
 
 (defn interpret-safe [source parsed ctx]
   (try
@@ -933,15 +951,6 @@
       (throw e)
       )))
 
-(defn prettify-ast [ast]
-  (cond
-    (not (map? ast)) ast
-    (not (:data ast)) (dissoc ast :remaining :token)
-    :else (let [{:keys [type data]} ast]
-            {:type type ;:token token
-             :data (into [] (map prettify-ast) data)})
-    ))
-
 ;; repl
 (comment
   

src/ludus/prelude.ld

@@ -1,8 +1,9 @@
 & this file, uniquely, gets `base` loaded as context. See src/ludus/base.cljc for exports
 
 fn rest {
-	"Returns all but the first element of a list, as a list."
+	"Returns all but the first element of a list or tuple, as a list."
 	(xs as :list) -> base :rest (xs)
+	(xs as :tuple) -> base :rest (xs)
 }
 
 fn inc {
@@ -77,17 +78,9 @@ fn conj {
 	(xs as :set, x) -> base :conj (xs, x)
 }
 
-fn add {
-	"Adds numbers."
-	() -> 0
-	(x as :number) -> x
-	(x as :number, y as :number) -> base :add (x, y)
-	(x as :number, y as :number, ...zs) -> fold (base :add, add (x, y), zs)
-}
-
 fn print {
-	"Sends a text representation of a Ludus value to stdout."
+	"Sends a text representation of Ludus values to the console."
-	(x) -> base :print (x)
+	(...args) -> base :print (args)
 }
 
 fn show {
@@ -119,7 +112,16 @@ fn report {
 		print (x)
 		x
 	}
-	(msg as :string, x) -> print (concat (msg, show (x))) 
+	(msg as :string, x) -> {
+		print (concat (msg, show (x)))
+		x
+	}
+}
+
+fn ref? {
+	"Returns true if a value is a ref."
+	(r as :ref) -> true
+	(_) -> false
 }
 
 fn deref {
@@ -132,6 +134,281 @@ fn set! {
 	(r as :ref, value) -> base :set! (r, value)
 }
 
+fn update! {
+	"Updates a ref by applying a function to its value. Returns the new value."
+	(r as :ref, f as :fn) -> {
+		let current = deref (r)
+		let new = f (current)
+		set! (r, new)
+	}
+}
+
+fn number? {
+	"Returns true if a value is a number."
+	(x as :number) -> true
+	(_) -> false
+}
+
+fn add {
+	"Adds numbers or vectors."
+	() -> 0
+	(x as :number) -> x
+	(x as :number, y as :number) -> base :add (x, y)
+	(x, y, ...zs) -> fold (base :add, zs, base :add (x, y))
+	& add vectors
+	((x1, y1), (x2, y2)) -> (base :add (x1, y1), base :add (x2, y2))
+}
+
+fn sub {
+	"Subtracts numbers or vectors."
+	() -> 0
+	(x as :number) -> x
+	(x as :number, y as :number) -> base :sub (x, y)
+	(x, y, ...zs) -> fold (base :sub, zs, base :sub (x, y))
+	((x1, y1), (x2, y2)) -> (base :sub (x1, x2), base :sub (x2, y2))
+}
+
+fn mult {
+	"Multiplies numbers or vectors."
+	() -> 1
+	(x as :number) -> x
+	(x as :number, y as :number) -> base :mult (x, y)
+	(x, y, ...zs) -> fold (base :mult, mult (x, y), zs)
+	(scalar as :number, (x, y)) -> (mult (x, scalar), mult (y, scalar))
+	((x, y), scalar as :number) -> mult (scalar, (x, y))
+}
+
+fn div {
+	"Divides numbers. Panics on division by zero."
+	(x as :number) -> x
+	(_, 0) -> panic! ("Division by zero.")
+	(x as :number, y as :number) -> base :div (x, y)
+	(x, y, ...zs) -> {
+		let divisor = fold (mult, zs, y)
+		div (x, divisor)
+	}
+}
+
+fn div/0 {
+	"Divides number. Returns 0 on division by zero."
+	(x as :number) -> x
+	(_, 0) -> 0
+	(x as :number, y as :number) -> base :div (x, y)
+	(x, y, ...zs) -> {
+		let divisor = fold (mult, zs, y)
+		div/0 (x, divisor)
+	}
+}
+
+fn zero? {
+	"Returns true if a number is 0."
+	(0) -> true
+	(_) -> false
+}
+
+fn eq? {
+	"Returns true if all arguments have the same value."
+	(x) -> true
+	(x, y) -> base :eq (x, y)
+	(x, y, ...zs) -> loop (y, zs) with {
+		(a, [b]) -> base :eq (a, b)
+		(a, [b, ...cs]) -> if base :eq (a, b)
+			then recur (b, cs)
+			else false 
+	}
+}
+
+fn gt? {
+	"Returns true if numbers are in decreasing order."
+	(x as :number) -> true
+	(x as :number, y as :number) -> base :gt (x, y)
+	(x, y, ...zs) -> loop (y, zs) with {
+		(a, [b]) -> base :gt (a, b)
+		(a, [b, ...cs]) -> if base :gt (a, b)
+			then recur (b, cs)
+			else false 
+	}
+}
+
+fn gte? {
+	"Returns true if numbers are in decreasing or flat order."
+	(x as :number) -> true
+	(x as :number, y as :number) -> base :gte (x, y)
+	(x, y, ...zs) -> loop (y, zs) with {
+		(a, [b]) -> base :gte (a, b)
+		(a, [b, ...cs]) -> if base :gte (a, b)
+			then recur (b, cs)
+			else false
+	}
+}
+
+fn lt? {
+	"Returns true if numbers are in increasing order."
+	(x as :number) -> true
+	(x as :number, y as :number) -> base :lt (x, y)
+	(x, y, ...zs) -> loop (y, zs) with {
+		(a, [b]) -> base :lt (a, b)
+		(a, [b, ...cs]) -> if base :lt (a, b)
+			then recur (b, cs)
+			else false
+	}
+}
+
+fn lte? {
+	"Returns true if numbers are in increasing or flat order."
+	(x as :number) -> true
+	(x as :number, y as :number) -> base :lte (x, y)
+	(x, y, ...zs) -> loop (y, zs) with {
+		(a, [b]) -> base :lte (a, b)
+		(a, [b, ...cs]) -> if base :lte (a, b)
+			then recur (b, cs)
+			else false
+	}
+}
+
+fn neg? {
+	"Returns true if a value is a negative number, otherwise returns false."
+	(x as :number) if lt? (x, 0) -> true
+	(_) -> false
+}
+
+fn pos? {
+	"Returns true if a value is a positive number, otherwise returns false."
+	(x as :number) if gt? (x, 0) -> true
+	(_) -> false
+}
+
+fn nil? {
+	"Returns true if a value is nil."
+	(nil) -> true
+	(_) -> false
+}
+
+fn bool? {
+	"Returns true if a value is of type :boolean."
+	(false) -> true
+	(true) -> true
+	(_) -> false
+}
+
+fn bool {
+	"Returns false if a value is nil or false, otherwise returns true."
+	(nil) -> false
+	(false) -> false
+	(_) -> true
+}
+
+fn not {
+	"Returns false if a value is truthy, true if a value is falsy."
+	(nil) -> true
+	(false) -> true
+	(_) -> false
+}
+
+& TODO: make `and` and `or` special forms which lazily evaluate arguments
+fn and {
+	"Returns true if all values passed in are truthy."
+	() -> true
+	(x) -> bool (x)
+	(x, y) -> base :and (x, y)
+	(x, y, ...zs) -> fold (base :and, zs, base :and (x, y))
+}
+
+fn or {
+	"Returns true if any value passed in is truthy."
+	() -> true
+	(x) -> bool (x)
+	(x, y) -> base :or (x, y)
+	(x, y, ...zs) -> fold (base :or, zs, base :or (x, y))
+}
+
+fn assoc {
+	"Takes a dict, key, and value, and returns a new dict with the key set to value."
+	(d as :dict) -> d
+	(d as :dict, key as :keyword, value) -> base :assoc (d, key, value)
+	(d as :dict, (key as :keyword, value)) -> base :assoc (d, key, value)
+}
+
+fn dissoc {
+	"Takes a dict and a key, and returns a new dict with the key and associated value omitted."
+	(d as :dict) -> d
+	(d as :dict, key as :keyword) -> base :dissoc (d, key)
+}
+
+fn coll? {
+	"Returns true if a value is a collection: dict, struct, list, tuple, or set."
+	(coll as :dict) -> true
+	(coll as :struct) -> true
+	(coll as :list) -> true
+	(coll as :tuple) -> true
+	(coll as :set) -> true
+	(_) -> false
+}
+
+fn ordered? {
+	"Returns true if a value is an indexed collection: list or tuple."
+	(coll as :list) -> true
+	(coll as :tuple) -> true
+	(_) -> false
+}
+
+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 :ns) -> true
+	(_) -> false
+}
+
+fn get {
+	"Takes a dict or struct, key, and optional default value; returns the value at key. If the value is not found, returns nil or the default value. Returns nil or default if the first argument is not a dict or struct."
+	(key as :keyword, coll) -> base :get (key, coll)
+	(key as :keyword, coll, default) -> base :get (key, coll, default)
+}
+
+& TODO: make this less awkward once we have tail recursion
+
+&&&&&&&&& TODO:
+&& Fix bug here:
+&& The second pattern in `each` and `foo` hangs when the first argument is a function
+&& But maybe not other kinds of values (works fine if it's a keyword)
+&& See interpreter.cljc line 76 for more info.
+fn each {
+	"Takes a list and applies a function, presumably with side effects, to each element in the list. Returns nil."
+	(f as :fn, []) -> :empty
+	(f, [x]) -> :one
+	(f, [...xs]) -> :more
+}
+
+fn foo {
+	&(h, []) -> :empty
+	(h, [x]) -> :one
+	(h, [...xs]) -> :more
+}
+
+fn panic! {
+	"Causes Ludus to panic, outputting any arguments as messages."
+	() -> base :panic! ()
+	(...args) -> base :panic! (args)
+}
+
+& base turtle graphics
+& forward, fd (pixels)
+& back, bk (pixels)
+& left, lt (turns)
+& right, rt (turns)
+& penup, pu ()
+& pendown, pd ()
+& pencolor, pc (color)
+& penwidth (pixels)
+& clear ()
+& goto ((x, y))
+& home ()
+& turtlestate () -> @{:position (x, y), :heading turns, :visible boolean, :pen penstate}
+& position () -> (x, y)
+& turtleheading () -> turns
+& penstate () -> @{:down :boolean, :color (r, g, b, a), :width pixels}
+
 ns prelude {
 	first
 	second
@@ -144,7 +421,6 @@ ns prelude {
 	list
 	inc
 	dec
-	add
 	print
 	show
 	prn
@@ -153,6 +429,31 @@ ns prelude {
 	concat
 	deref
 	set!
+	add
+	sub
+	mult
+	div
+	div/0
+	zero?
+	neg?
+	pos?
+	eq?
+	gt?
+	gte?
+	lt?
+	lte?
+	nil?
+	bool?
+	bool
+	not
+	and
+	or
+	coll?
+	ordered?
+	assoc?
+	assoc
+	get
+	each
+	panic!
+	foo
 }
-
-prelude