From ab48dfa6b3cdcd3682cb8d4c0088737073da55ed Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Sat, 2 Dec 2023 16:14:57 -0500 Subject: [PATCH] Make lots and lots of progress; discover error in pattern matching. --- src/ludus/base.cljc | 23 ++- src/ludus/interpreter.cljc | 61 ++++--- src/ludus/prelude.ld | 335 +++++++++++++++++++++++++++++++++++-- 3 files changed, 369 insertions(+), 50 deletions(-) diff --git a/src/ludus/base.cljc b/src/ludus/base.cljc index d45cbd0..285447c 100644 --- a/src/ludus/base.cljc +++ b/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] - (println (apply str (into [] (map print-show) args))) + :body (fn [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- diff --git a/src/ludus/interpreter.cljc b/src/ludus/interpreter.cljc index c34a36b..09b653b 100644 --- a/src/ludus/interpreter.cljc +++ b/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 "*****Value: " value) - ;(println "*****Pattern: " pattern) + (println "\n\n\n**********Matching tuple") + (println "*****Value: " (show/show value)) + (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 -; ([parsed ctx] -; (let [orig-ctx @ctx] -; (try -; (let [result (interpret-ast parsed ctx)] -; {:result result :ctx ctx}) -; (catch clojure.lang.ExceptionInfo e -; (println "Ludus panicked!") -; (println (ex-message e)) -; {:result :error :ctx (volatile! orig-ctx)}))))) +(defn interpret-repl + ([parsed ctx] + (let [orig-ctx @ctx] + (try + (let [result (interpret-ast parsed ctx)] + {:result result :ctx ctx}) + (catch #?(:clj Throwable :cljs js/Object) e + (println "Ludus panicked!") + (println (ex-message e)) + {: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 diff --git a/src/ludus/prelude.ld b/src/ludus/prelude.ld index 5a9a375..452f7da 100644 --- a/src/ludus/prelude.ld +++ b/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." - (xs as :list) -> base :rest (xs) + "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." - (x) -> base :print (x) + "Sends a text representation of Ludus values to the console." + (...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! -} - -prelude \ No newline at end of file + 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 +} \ No newline at end of file